Skip to content

Commit f665bc9

Browse files
lukaszczlukaszcz
committed
fix test compilation
1 parent a4e409e commit f665bc9

File tree

30 files changed

+269
-229
lines changed

30 files changed

+269
-229
lines changed

‎app/Commands/Dev/Tree/Repl.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ readProgram f = do
5656
bs <- State.gets (^. replStateBuilderState)
5757
txt <- readFile f
5858
case parseText' bs txt of
59-
Left e -> error (show e)
59+
Left e -> error (renderTextDefault e)
6060
Right bs' ->
6161
State.modify (set replStateBuilderState bs')
6262

@@ -77,7 +77,7 @@ readNode :: String -> Repl Node
7777
readNode s = do
7878
bs <- State.gets (^. replStateBuilderState)
7979
case parseNodeText' bs replFile (strip (pack s)) of
80-
Left e -> error (show e)
80+
Left e -> error (renderTextDefault e)
8181
Right (bs', n) -> do
8282
State.modify (set replStateBuilderState bs')
8383
return n

‎src/Juvix/Compiler/Asm/Translation/FromSource.hs

+17-18
Original file line numberDiff line numberDiff line change
@@ -32,28 +32,27 @@ parseAsmSig =
3232
_parserSigEmptyExtra = mempty
3333
}
3434

35-
parseText :: Text -> Either MegaparsecError Module
35+
parseText :: Text -> Either ParserError Module
3636
parseText = runParser noFile
3737

38-
parseText' :: BuilderState -> Text -> Either MegaparsecError BuilderState
38+
parseText' :: BuilderState -> Text -> Either ParserError BuilderState
3939
parseText' bs = runParser' bs noFile
4040

41-
runParser :: Path Abs File -> Text -> Either MegaparsecError Module
41+
runParser :: Path Abs File -> Text -> Either ParserError Module
4242
runParser = runParserS parseAsmSig
4343

44-
runParser' :: BuilderState -> Path Abs File -> Text -> Either MegaparsecError BuilderState
44+
runParser' :: BuilderState -> Path Abs File -> Text -> Either ParserError BuilderState
4545
runParser' = runParserS' parseAsmSig
4646

4747
parseCode ::
48-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
48+
(Members '[Error SimpleParserError, Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
4949
ParsecS r Code
5050
parseCode = P.sepEndBy command (kw delimSemicolon)
5151

5252
command ::
53-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
53+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
5454
ParsecS r Command
5555
command = do
56-
off <- P.getOffset
5756
(txt, i) <- identifierL
5857
let loc = Just i
5958
case txt of
@@ -141,10 +140,10 @@ command = do
141140
"tsave" ->
142141
parseSave loc True
143142
_ ->
144-
parseFailure off ("unknown instruction: " ++ fromText txt)
143+
parseFailure' i ("unknown instruction: " ++ fromText txt)
145144

146145
parseSave ::
147-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
146+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
148147
Maybe Interval ->
149148
Bool ->
150149
ParsecS r Command
@@ -165,12 +164,12 @@ parseSave loc isTail = do
165164
)
166165

167166
value ::
168-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
167+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
169168
ParsecS r Value
170169
value = (Constant <$> constant) <|> (Ref <$> memRef @Code @(Maybe FunctionInfoExtra))
171170

172171
instrAllocClosure ::
173-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
172+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
174173
ParsecS r InstrAllocClosure
175174
instrAllocClosure = do
176175
sym <- funSymbol @Code @(Maybe FunctionInfoExtra) @DirectRef
@@ -183,7 +182,7 @@ instrExtendClosure = do
183182
return $ InstrExtendClosure (fromInteger argsNum)
184183

185184
instrCall ::
186-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
185+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
187186
ParsecS r InstrCall
188187
instrCall = do
189188
ct <- parseCallType
@@ -197,7 +196,7 @@ instrCall = do
197196
return (InstrCall ct argsNum)
198197

199198
parseCallType ::
200-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
199+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
201200
ParsecS r CallType
202201
parseCallType = (kw kwDollar $> CallClosure) <|> (CallFun <$> funSymbol @Code @(Maybe FunctionInfoExtra) @DirectRef)
203202

@@ -207,12 +206,12 @@ instrCallClosures = do
207206
return (InstrCallClosures (fromInteger argsNum))
208207

209208
branchCode ::
210-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
209+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
211210
ParsecS r Code
212211
branchCode = braces parseCode <|> (command >>= \x -> return [x])
213212

214213
trueBranch ::
215-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
214+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
216215
ParsecS r Code
217216
trueBranch = do
218217
symbol "true:"
@@ -221,7 +220,7 @@ trueBranch = do
221220
return c
222221

223222
falseBranch ::
224-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
223+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
225224
ParsecS r Code
226225
falseBranch = do
227226
symbol "false:"
@@ -230,7 +229,7 @@ falseBranch = do
230229
return c
231230

232231
caseBranch ::
233-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
232+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
234233
ParsecS r CaseBranch
235234
caseBranch = do
236235
tag <- P.try $ constrTag @Code @(Maybe FunctionInfoExtra) @DirectRef
@@ -240,7 +239,7 @@ caseBranch = do
240239
return c
241240

242241
defaultBranch ::
243-
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
242+
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
244243
ParsecS r Code
245244
defaultBranch = do
246245
symbol "default:"

‎src/Juvix/Compiler/Casm/Translation/FromSource.hs

+30-29
Original file line numberDiff line numberDiff line change
@@ -9,47 +9,48 @@ import Juvix.Extra.Paths
99
import Juvix.Parser.Error
1010
import Text.Megaparsec qualified as P
1111

12-
parseText :: Text -> Either MegaparsecError (LabelInfo, [Instruction])
12+
parseText :: Text -> Either ParserError (LabelInfo, [Instruction])
1313
parseText = runParser noFile
1414

15-
runParser :: Path Abs File -> Text -> Either MegaparsecError (LabelInfo, [Instruction])
15+
runParser :: Path Abs File -> Text -> Either ParserError (LabelInfo, [Instruction])
1616
runParser fileName input_ =
17-
case run . runLabelInfoBuilder $ runParser' 0 (toFilePath fileName) input_ of
18-
(_, Left err) -> Left err
19-
(li, Right instrs) -> Right (li, instrs)
17+
case run . runLabelInfoBuilder . runError @SimpleParserError $ runParser' 0 (toFilePath fileName) input_ of
18+
(_, Left err) -> Left (ErrSimpleParserError err)
19+
(_, Right (Left err)) -> Left err
20+
(li, Right (Right instrs)) -> Right (li, instrs)
2021

21-
runParser' :: (Member LabelInfoBuilder r) => Address -> FilePath -> Text -> Sem r (Either MegaparsecError [Instruction])
22+
runParser' :: (Member LabelInfoBuilder r) => Address -> FilePath -> Text -> Sem r (Either ParserError [Instruction])
2223
runParser' addr fileName input_ = do
23-
e <- P.runParserT (parseToplevel addr) fileName input_
24+
e <- runError @SimpleParserError $ P.runParserT (parseToplevel addr) fileName input_
2425
return $ case e of
25-
Left err -> Left (MegaparsecError err)
26-
Right instrs -> Right instrs
26+
Left err -> Left (ErrSimpleParserError err)
27+
Right (Left err) -> Left (ErrMegaparsec (MegaparsecError err))
28+
Right (Right instrs) -> Right instrs
2729

28-
parseToplevel :: (Member LabelInfoBuilder r) => Address -> ParsecS r [Instruction]
30+
parseToplevel :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => Address -> ParsecS r [Instruction]
2931
parseToplevel addr = do
3032
instrs <- statements addr
3133
P.eof
3234
return instrs
3335

34-
statements :: (Member LabelInfoBuilder r) => Address -> ParsecS r [Instruction]
36+
statements :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => Address -> ParsecS r [Instruction]
3537
statements addr = do
3638
space
3739
label' addr <|> statement' addr <|> return []
3840

39-
statement' :: (Member LabelInfoBuilder r) => Address -> ParsecS r [Instruction]
41+
statement' :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => Address -> ParsecS r [Instruction]
4042
statement' addr = do
4143
i <- instruction
4244
(i :) <$> statements (addr + 1)
4345

44-
label' :: (Member LabelInfoBuilder r) => Address -> ParsecS r [Instruction]
46+
label' :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => Address -> ParsecS r [Instruction]
4547
label' addr = do
4648
l <- label addr
4749
(l :) <$> statements (addr + 1)
4850

49-
label :: (Member LabelInfoBuilder r) => Address -> ParsecS r Instruction
51+
label :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => Address -> ParsecS r Instruction
5052
label addr = P.try $ do
51-
off' <- P.getOffset
52-
txt <- identifier
53+
(txt, loc) <- interval identifier
5354
kw kwColon
5455
msym <- lift $ getIdent txt
5556
case msym of
@@ -61,12 +62,12 @@ label addr = P.try $ do
6162
Just sym -> do
6263
b <- lift $ hasOffset sym
6364
if
64-
| b -> parseFailure off' "duplicate label"
65+
| b -> parseFailure' loc "duplicate label"
6566
| otherwise -> do
6667
lift $ registerLabelAddress sym addr
6768
return $ Label $ LabelRef {_labelRefSymbol = sym, _labelRefName = Just txt}
6869

69-
instruction :: (Member LabelInfoBuilder r) => ParsecS r Instruction
70+
instruction :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
7071
instruction =
7172
parseHint
7273
<|> parseNop
@@ -107,7 +108,7 @@ parseNop = do
107108
kw kwNop
108109
return Nop
109110

110-
parseAlloc :: (Member LabelInfoBuilder r) => ParsecS r Instruction
111+
parseAlloc :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
111112
parseAlloc = do
112113
kw kwAp
113114
kw kwPlusEq
@@ -118,7 +119,7 @@ parseAlloc = do
118119
{ _instrAllocSize = i
119120
}
120121

121-
parseRValue :: forall r. (Member LabelInfoBuilder r) => ParsecS r RValue
122+
parseRValue :: forall r. (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r RValue
122123
parseRValue = load <|> binop <|> val
123124
where
124125
load :: ParsecS r RValue
@@ -166,27 +167,27 @@ parseRValue = load <|> binop <|> val
166167
val :: ParsecS r RValue
167168
val = Val <$> parseValue
168169

169-
parseValue :: (Member LabelInfoBuilder r) => ParsecS r Value
170+
parseValue :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Value
170171
parseValue = (Imm <$> parseImm) <|> (Ref <$> parseMemRef) <|> (Lab <$> parseLabel)
171172

172173
parseImm :: ParsecS r Immediate
173174
parseImm = (^. withLocParam) <$> integer
174175

175-
parseOffset :: ParsecS r Offset
176+
parseOffset :: (Member (Error SimpleParserError) r) => ParsecS r Offset
176177
parseOffset =
177178
(kw kwPlus >> offset)
178179
<|> (kw kwMinus >> (negate <$> offset))
179180
<|> return 0
180181

181-
parseMemRef :: ParsecS r MemRef
182+
parseMemRef :: (Member (Error SimpleParserError) r) => ParsecS r MemRef
182183
parseMemRef = do
183184
lbracket
184185
r <- register
185186
off <- parseOffset
186187
rbracket
187188
return MemRef {_memRefReg = r, _memRefOff = off}
188189

189-
parseLabel :: (Member LabelInfoBuilder r) => ParsecS r LabelRef
190+
parseLabel :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r LabelRef
190191
parseLabel = do
191192
txt <- identifier
192193
msym <- lift $ getIdent txt
@@ -204,7 +205,7 @@ parseIncAp = (kw delimSemicolon >> kw kwApPlusPlus >> return True) <|> return Fa
204205
parseRel :: ParsecS r Bool
205206
parseRel = (kw kwRel >> return True) <|> (kw kwAbs >> return False) <|> return True
206207

207-
parseJump :: forall r. (Member LabelInfoBuilder r) => ParsecS r Instruction
208+
parseJump :: forall r. (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
208209
parseJump = do
209210
kw kwJmp
210211
P.try jmpIf <|> jmp
@@ -240,7 +241,7 @@ parseJump = do
240241
_instrJumpComment = Nothing
241242
}
242243

243-
parseCall :: (Member LabelInfoBuilder r) => ParsecS r Instruction
244+
parseCall :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
244245
parseCall = do
245246
kw kwCall
246247
isRel <- parseRel
@@ -258,19 +259,19 @@ parseReturn = do
258259
kw kwRet
259260
return Return
260261

261-
parseAssert :: ParsecS r Instruction
262+
parseAssert :: (Member (Error SimpleParserError) r) => ParsecS r Instruction
262263
parseAssert = do
263264
kw kwAssert
264265
r <- parseMemRef
265266
return $ Assert $ InstrAssert {_instrAssertValue = r}
266267

267-
parseTrace :: (Member LabelInfoBuilder r) => ParsecS r Instruction
268+
parseTrace :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
268269
parseTrace = do
269270
kw kwTrace
270271
v <- parseRValue
271272
return $ Trace $ InstrTrace {_instrTraceValue = v}
272273

273-
parseAssign :: forall r. (Member LabelInfoBuilder r) => ParsecS r Instruction
274+
parseAssign :: forall r. (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
274275
parseAssign = do
275276
res <- parseMemRef
276277
kw kwEq

‎src/Juvix/Compiler/Casm/Translation/FromSource/Lexer.hs

+5-4
Original file line numberDiff line numberDiff line change
@@ -7,13 +7,14 @@ where
77

88
import Juvix.Compiler.Casm.Keywords
99
import Juvix.Compiler.Tree.Translation.FromSource.Lexer.Base
10+
import Juvix.Parser.Error.Base
1011
import Juvix.Prelude
1112

12-
offset :: ParsecS r Int16
13-
offset = fromIntegral . (^. withLocParam) <$> number (-(2 ^ (15 :: Int16))) (2 ^ (15 :: Int16))
13+
offset :: (Member (Error SimpleParserError) r) => ParsecS r Int16
14+
offset = fromIntegral . (^. withLocParam) <$> number @SimpleParserError (-(2 ^ (15 :: Int16))) (2 ^ (15 :: Int16))
1415

15-
int :: ParsecS r Int
16-
int = (^. withLocParam) <$> number (-(2 ^ (31 :: Int))) (2 ^ (31 :: Int))
16+
int :: (Member (Error SimpleParserError) r) => ParsecS r Int
17+
int = (^. withLocParam) <$> number @SimpleParserError (-(2 ^ (31 :: Int))) (2 ^ (31 :: Int))
1718

1819
identifier :: ParsecS r Text
1920
identifier = lexeme bareIdentifier

‎src/Juvix/Compiler/Core/Error.hs

+4
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ module Juvix.Compiler.Core.Error where
22

33
import Juvix.Compiler.Core.Language
44
import Juvix.Compiler.Core.Pretty
5+
import Juvix.Parser.Error.Base
56

67
data CoreError = CoreError
78
{ _coreErrorMsg :: AnsiText,
@@ -11,6 +12,9 @@ data CoreError = CoreError
1112

1213
makeLenses ''CoreError
1314

15+
instance FromSimpleParserError CoreError where
16+
fromSimpleParserError e = CoreError (mkAnsiText (e ^. simpleParserErrorMessage)) Nothing (getLoc e)
17+
1418
instance ToGenericError CoreError where
1519
genericError e = ask >>= generr
1620
where

‎src/Juvix/Compiler/Core/Translation/FromSource.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -671,10 +671,10 @@ exprConstUInt8 = P.try $ do
671671
(n, i) <- uint8
672672
return $ mkConstant (Info.singleton (LocationInfo i)) (ConstUInt8 (fromIntegral n))
673673

674-
exprUniverse :: ParsecS r Type
674+
exprUniverse :: (Member (Error CoreError) r) => ParsecS r Type
675675
exprUniverse = do
676676
kw kwType
677-
level <- optional (number 0 128) -- TODO: global Limits.hs file
677+
level <- optional (number @CoreError 0 128) -- TODO: global Limits.hs file
678678
return $ mkUniv' (maybe 0 (^. withLocParam) level)
679679

680680
exprDynamic :: ParsecS r Type

‎src/Juvix/Compiler/Core/Translation/FromSource/Lexer.hs

+5-2
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
13
module Juvix.Compiler.Core.Translation.FromSource.Lexer
24
( module Juvix.Compiler.Core.Translation.FromSource.Lexer,
35
module Juvix.Parser.Lexer,
@@ -7,6 +9,7 @@ where
79

810
import Juvix.Compiler.Core.Keywords
911
import Juvix.Extra.Strings qualified as Str
12+
import Juvix.Parser.Error.Base
1013
import Juvix.Parser.Lexer
1114
import Juvix.Prelude
1215
import Text.Megaparsec as P hiding (sepBy1, sepEndBy1, some)
@@ -36,8 +39,8 @@ uint8 = lexemeInterval uint8'
3639
integer :: ParsecS r (WithLoc Integer)
3740
integer = lexeme integer'
3841

39-
number :: Int -> Int -> ParsecS r (WithLoc Int)
40-
number = number' integer
42+
number :: forall e r. (FromSimpleParserError e, Member (Error e) r) => Int -> Int -> ParsecS r (WithLoc Int)
43+
number = number' @e integer
4144

4245
string :: ParsecS r (Text, Interval)
4346
string = lexemeInterval string'

0 commit comments

Comments
 (0)