Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix parseFailure in the parsers #3355

Draft
wants to merge 3 commits into
base: main
Choose a base branch
from
Draft

Fix parseFailure in the parsers #3355

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
b4db918
remove 'parseFailure' from Juvix parser
lukaszcz Mar 6, 2025
bbedd0d
remove parseFailure from proveArg
lukaszcz Mar 6, 2025
f0eaa14
fix test compilation
lukaszcz Mar 6, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 18 additions & 9 deletions app/Commands/Dev/Anoma/Prove/Options/ProveArg.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,7 @@ import CommonOptions
import Juvix.Data.IntegerWithBase
import Juvix.Parser.Lexer
import Juvix.Prelude.Parsing hiding (many, option)

type Parse = Parsec Void Text
import Juvix.Prelude.Parsing qualified as P

newtype ProveArg' = ProveArg'
{ _proveArg :: Sigma ProveArgTag ProveArgTypeSym0
Expand Down Expand Up @@ -68,6 +67,9 @@ parseProveArg = fromProveArg' <$> parseProveArg'
_argFileSpecDecoding = d
}

data NegativeError = NegativeError
deriving stock (Show)

parseProveArg' :: Parser ProveArg'
parseProveArg' =
option
Expand All @@ -78,14 +80,14 @@ parseProveArg' =
<> helpDoc ("An argument to the program:" <> line <> proveArgTagHelp)
)
where
pProveArgTag :: Parse ProveArgTag
pProveArgTag :: ParsecS r ProveArgTag
pProveArgTag =
choice
[ chunk (show a) $> a
| a :: ProveArgTag <- allElements
]

pAppPath :: Parse (AppPath File)
pAppPath :: ParsecS r (AppPath File)
pAppPath = do
i <- mkPrepath . unpack <$> takeRest
return
Expand All @@ -94,15 +96,15 @@ parseProveArg' =
_pathPath = i
}

pProveArg' :: Parse ProveArg'
pProveArg' :: (Member (Error NegativeError) r) => ParsecS r ProveArg'
pProveArg' = do
dty <- pProveArgTag
withSomeSing dty $ \ty -> do
chunk ":"
a <- pProveArgType ty
return (ProveArg' (ty :&: a))

pProveArgType :: SProveArgTag t -> Parse (ProveArgType t)
pProveArgType :: (Member (Error NegativeError) r) => SProveArgTag t -> ParsecS r (ProveArgType t)
pProveArgType p = do
ret <- case p of
SProveArgTagByteArray -> pAppPath
Expand All @@ -112,13 +114,20 @@ parseProveArg' =
SProveArgTagBase64UnJammed -> pAppPath
SProveArgTagBytesUnJammed -> pAppPath
SProveArgTagNat -> do
off <- getOffset
i <- (^. withLocParam . integerWithBaseValue) <$> integerWithBase'
if
| i < 0 -> parseFailure off "Expected a non-negative integer"
| i < 0 -> P.lift $ throw NegativeError
| otherwise -> return (fromIntegral i)
eof
return ret

pp :: ReadM ProveArg'
pp = eitherReader $ \strInput -> parseHelper pProveArg' (pack strInput)
pp = eitherReader $ \strInput ->
let e =
run
. runError @NegativeError
$ parseHelperS pProveArg' (pack strInput)
in case e of
Left _ -> Left "Expected a non-negative integer"
Right (Left s) -> Left s
Right (Right a) -> Right a
4 changes: 2 additions & 2 deletions app/Commands/Dev/Tree/Repl.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ readProgram f = do
bs <- State.gets (^. replStateBuilderState)
txt <- readFile f
case parseText' bs txt of
Left e -> error (show e)
Left e -> error (renderTextDefault e)
Right bs' ->
State.modify (set replStateBuilderState bs')

Expand All @@ -77,7 +77,7 @@ readNode :: String -> Repl Node
readNode s = do
bs <- State.gets (^. replStateBuilderState)
case parseNodeText' bs replFile (strip (pack s)) of
Left e -> error (show e)
Left e -> error (renderTextDefault e)
Right (bs', n) -> do
State.modify (set replStateBuilderState bs')
return n
Expand Down
35 changes: 17 additions & 18 deletions src/Juvix/Compiler/Asm/Translation/FromSource.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,28 +32,27 @@ parseAsmSig =
_parserSigEmptyExtra = mempty
}

parseText :: Text -> Either MegaparsecError Module
parseText :: Text -> Either ParserError Module
parseText = runParser noFile

parseText' :: BuilderState -> Text -> Either MegaparsecError BuilderState
parseText' :: BuilderState -> Text -> Either ParserError BuilderState
parseText' bs = runParser' bs noFile

runParser :: Path Abs File -> Text -> Either MegaparsecError Module
runParser :: Path Abs File -> Text -> Either ParserError Module
runParser = runParserS parseAsmSig

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

parseCode ::
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
(Members '[Error SimpleParserError, Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
ParsecS r Code
parseCode = P.sepEndBy command (kw delimSemicolon)

command ::
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
ParsecS r Command
command = do
off <- P.getOffset
(txt, i) <- identifierL
let loc = Just i
case txt of
Expand Down Expand Up @@ -141,10 +140,10 @@ command = do
"tsave" ->
parseSave loc True
_ ->
parseFailure off ("unknown instruction: " ++ fromText txt)
parseFailure' i ("unknown instruction: " ++ fromText txt)

parseSave ::
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
Maybe Interval ->
Bool ->
ParsecS r Command
Expand All @@ -165,12 +164,12 @@ parseSave loc isTail = do
)

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

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

instrCall ::
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
ParsecS r InstrCall
instrCall = do
ct <- parseCallType
Expand All @@ -197,7 +196,7 @@ instrCall = do
return (InstrCall ct argsNum)

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

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

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

trueBranch ::
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
ParsecS r Code
trueBranch = do
symbol "true:"
Expand All @@ -221,7 +220,7 @@ trueBranch = do
return c

falseBranch ::
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
ParsecS r Code
falseBranch = do
symbol "false:"
Expand All @@ -230,7 +229,7 @@ falseBranch = do
return c

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

defaultBranch ::
(Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
(Members '[Error SimpleParserError, Reader ParserSig, InfoTableBuilder, State LocalParams] r) =>
ParsecS r Code
defaultBranch = do
symbol "default:"
Expand Down
59 changes: 30 additions & 29 deletions src/Juvix/Compiler/Casm/Translation/FromSource.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,47 +9,48 @@ import Juvix.Extra.Paths
import Juvix.Parser.Error
import Text.Megaparsec qualified as P

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

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

runParser' :: (Member LabelInfoBuilder r) => Address -> FilePath -> Text -> Sem r (Either MegaparsecError [Instruction])
runParser' :: (Member LabelInfoBuilder r) => Address -> FilePath -> Text -> Sem r (Either ParserError [Instruction])
runParser' addr fileName input_ = do
e <- P.runParserT (parseToplevel addr) fileName input_
e <- runError @SimpleParserError $ P.runParserT (parseToplevel addr) fileName input_
return $ case e of
Left err -> Left (MegaparsecError err)
Right instrs -> Right instrs
Left err -> Left (ErrSimpleParserError err)
Right (Left err) -> Left (ErrMegaparsec (MegaparsecError err))
Right (Right instrs) -> Right instrs

parseToplevel :: (Member LabelInfoBuilder r) => Address -> ParsecS r [Instruction]
parseToplevel :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => Address -> ParsecS r [Instruction]
parseToplevel addr = do
instrs <- statements addr
P.eof
return instrs

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

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

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

label :: (Member LabelInfoBuilder r) => Address -> ParsecS r Instruction
label :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => Address -> ParsecS r Instruction
label addr = P.try $ do
off' <- P.getOffset
txt <- identifier
(txt, loc) <- interval identifier
kw kwColon
msym <- lift $ getIdent txt
case msym of
Expand All @@ -61,12 +62,12 @@ label addr = P.try $ do
Just sym -> do
b <- lift $ hasOffset sym
if
| b -> parseFailure off' "duplicate label"
| b -> parseFailure' loc "duplicate label"
| otherwise -> do
lift $ registerLabelAddress sym addr
return $ Label $ LabelRef {_labelRefSymbol = sym, _labelRefName = Just txt}

instruction :: (Member LabelInfoBuilder r) => ParsecS r Instruction
instruction :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
instruction =
parseHint
<|> parseNop
Expand Down Expand Up @@ -107,7 +108,7 @@ parseNop = do
kw kwNop
return Nop

parseAlloc :: (Member LabelInfoBuilder r) => ParsecS r Instruction
parseAlloc :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
parseAlloc = do
kw kwAp
kw kwPlusEq
Expand All @@ -118,7 +119,7 @@ parseAlloc = do
{ _instrAllocSize = i
}

parseRValue :: forall r. (Member LabelInfoBuilder r) => ParsecS r RValue
parseRValue :: forall r. (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r RValue
parseRValue = load <|> binop <|> val
where
load :: ParsecS r RValue
Expand Down Expand Up @@ -166,27 +167,27 @@ parseRValue = load <|> binop <|> val
val :: ParsecS r RValue
val = Val <$> parseValue

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

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

parseOffset :: ParsecS r Offset
parseOffset :: (Member (Error SimpleParserError) r) => ParsecS r Offset
parseOffset =
(kw kwPlus >> offset)
<|> (kw kwMinus >> (negate <$> offset))
<|> return 0

parseMemRef :: ParsecS r MemRef
parseMemRef :: (Member (Error SimpleParserError) r) => ParsecS r MemRef
parseMemRef = do
lbracket
r <- register
off <- parseOffset
rbracket
return MemRef {_memRefReg = r, _memRefOff = off}

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

parseJump :: forall r. (Member LabelInfoBuilder r) => ParsecS r Instruction
parseJump :: forall r. (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
parseJump = do
kw kwJmp
P.try jmpIf <|> jmp
Expand Down Expand Up @@ -240,7 +241,7 @@ parseJump = do
_instrJumpComment = Nothing
}

parseCall :: (Member LabelInfoBuilder r) => ParsecS r Instruction
parseCall :: (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
parseCall = do
kw kwCall
isRel <- parseRel
Expand All @@ -258,19 +259,19 @@ parseReturn = do
kw kwRet
return Return

parseAssert :: ParsecS r Instruction
parseAssert :: (Member (Error SimpleParserError) r) => ParsecS r Instruction
parseAssert = do
kw kwAssert
r <- parseMemRef
return $ Assert $ InstrAssert {_instrAssertValue = r}

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

parseAssign :: forall r. (Member LabelInfoBuilder r) => ParsecS r Instruction
parseAssign :: forall r. (Members '[Error SimpleParserError, LabelInfoBuilder] r) => ParsecS r Instruction
parseAssign = do
res <- parseMemRef
kw kwEq
Expand Down
Loading
Loading