diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser.hs b/plutus-core/plutus-core/src/PlutusCore/Parser.hs index 1dae668c7b8..a7cef6667ef 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Parser.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Parser.hs @@ -27,7 +27,7 @@ varTerm :: Parser PTerm varTerm = Var <$> getSourcePos <*> name tyAbsTerm :: Parser PTerm -tyAbsTerm = TyAbs <$> wordPos "abs" <*> tyName <*> kind <*> term +tyAbsTerm = inParens $ TyAbs <$> wordPos "abs" <*> tyName <*> kind <*> term lamTerm :: Parser PTerm lamTerm = inParens $ LamAbs <$> wordPos "lam" <*> name <*> pType <*> term @@ -44,7 +44,11 @@ conTerm = inParens $ do pure $ Constant p con builtinTerm :: Parser PTerm -builtinTerm = inParens $ Builtin <$> wordPos "builtin" <*> builtinFunction +builtinTerm = inParens $ do + p <- wordPos "builtin" + fn <- builtinFunction + pure $ Builtin p fn + -- Builtin <$> wordPos "builtin" <*> builtinFunction tyInstTerm :: Parser PTerm tyInstTerm = inBraces $ TyInst <$> getSourcePos <*> term <*> pType @@ -61,10 +65,8 @@ errorTerm = inParens $ Error <$> wordPos "error" <*> pType -- | Parser for all PLC terms. term :: Parser PTerm -term = try $ choice - [ inParens term - , varTerm - , tyAbsTerm +term = choice $ map try + [ tyAbsTerm , lamTerm , appTerm , conTerm @@ -73,6 +75,7 @@ term = try $ choice , unwrapTerm , iwrapTerm , errorTerm + , varTerm ] -- | Parse a PLC program. The resulting program will have fresh names. The underlying monad must be capable diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs b/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs index 14ce9222ba6..353c354ccd6 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs @@ -114,13 +114,13 @@ kind = inParens (typeKind <|> funKind) pType :: Parser PType pType = choice [inParens pType - , varType , funType , ifixType , allType , builtinType , lamType , inBrackets appType + , varType ] defaultUniType :: Parser (SomeTypeIn DefaultUni) @@ -131,41 +131,31 @@ defaultUniType = choice , SomeTypeIn DefaultUniString <$ symbol "string" , SomeTypeIn DefaultUniUnit <$ symbol "unit" , SomeTypeIn DefaultUniBool <$ symbol "bool" - , SomeTypeIn DefaultUniProtoList <$ symbol "list" - , SomeTypeIn DefaultUniProtoPair <$ symbol "pair" +-- , SomeTypeIn DefaultUniProtoList <$ symbol "list" +-- , SomeTypeIn DefaultUniProtoPair <$ symbol "pair" -- , SomeTypeIn DefaultUniApply <$ symbol "?" TODO need to make this an operator - , SomeTypeIn DefaultUniData <$ symbol "data" ] - -lbracket :: Parser T.Text -lbracket = symbol "[" -rbracket :: Parser T.Text -rbracket = symbol "]" - -lbrace :: Parser T.Text -lbrace = symbol "{" -rbrace :: Parser T.Text -rbrace = symbol "}" + ] inParens :: Parser a -> Parser a inParens = between (symbol "(") (symbol ")") inBrackets :: Parser a -> Parser a -inBrackets = between lbracket rbracket +inBrackets = between (symbol "[") (symbol "]") inBraces :: Parser a-> Parser a -inBraces = between lbrace rbrace +inBraces = between (symbol "{") (symbol "}") isIdentifierChar :: Char -> Bool isIdentifierChar c = isAlphaNum c || c == '_' || c == '\'' -- | Create a parser that matches the input word and returns its source position. -- This is for attaching source positions to parsed terms/programs. --- getSourcePos is not cheap, don't call it on matching of every token. wordPos :: -- | The word to match T.Text -> Parser SourcePos wordPos w = lexeme $ try $ getSourcePos <* symbol w +-- | The list of parsable default functions and their pretty print correspondence. builtinFnList :: [(DefaultFun, T.Text)] builtinFnList = [ (AddInteger,"addInteger") @@ -223,9 +213,9 @@ builtinFnList = builtinFunction :: Parser DefaultFun builtinFunction = - lexeme $ try $ choice $ + choice $ map - (\(fn, text) -> fn <$ symbol text) + (try . (\(fn, text) -> fn <$ symbol text)) builtinFnList version :: Parser (Version SourcePos) @@ -291,7 +281,7 @@ conBool = choice -- conData = someValue Data? <$ symbol "data" constant :: Parser (Some (ValueOf DefaultUni)) -constant = try $ choice +constant = choice $ map try [ inParens constant , conInt , conChar diff --git a/plutus-core/plutus-ir/src/PlutusIR/Parser.hs b/plutus-core/plutus-ir/src/PlutusIR/Parser.hs index e8033fddb82..f69323e201f 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Parser.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Parser.hs @@ -84,7 +84,7 @@ tyInstTerm :: Parser PTerm tyInstTerm = PIR.mkIterInst <$> getSourcePos <*> pTerm <*> some pType pTerm :: Parser PTerm -pTerm = try $ choice +pTerm = choice $ map try [ inParens pTerm , absTerm , lamTerm