From b590f9cbd4cfca3daa33786186837e77b0824387 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 8 Dec 2024 20:02:12 +0100 Subject: Separate parsers for individual variables and function calls --- src/Parser/Expr.hs | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs index 024ea6b..5ff3f15 100644 --- a/src/Parser/Expr.hs +++ b/src/Parser/Expr.hs @@ -233,7 +233,7 @@ someExpr = join inner "expression" term = label "term" $ choice [ parens inner , return <$> literal - , return <$> variable + , return <$> functionCall ] table = [ [ prefix "-" $ [ SomeUnOp (negate @Integer) @@ -356,25 +356,29 @@ variable = label "variable" $ do off <- stateOffset <$> getParserState sline <- getSourceLine name <- varName - lookupVarExpr off sline name >>= \case + e <- lookupVarExpr off sline name + recordSelector e <|> return e + +functionCall :: TestParser SomeExpr +functionCall = do + sline <- getSourceLine + variable >>= \case SomeExpr e'@(FunVariable argTypes _ _) -> do let check = checkFunctionArguments argTypes args <- functionArguments check someExpr literal (\poff -> lookupVarExpr poff sline . VarName) return $ SomeExpr $ ArgsApp args e' - e -> do - recordSelector e <|> return e + e -> return e +recordSelector :: SomeExpr -> TestParser SomeExpr +recordSelector (SomeExpr expr) = do + void $ osymbol "." + off <- stateOffset <$> getParserState + m <- identifier + let err = parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat + [ T.pack "value of type ", textExprType expr, T.pack " does not have member '", m, T.pack "'" ] + e' <- maybe err return $ applyRecordSelector m expr <$> lookup m recordMembers + recordSelector e' <|> return e' where - recordSelector :: SomeExpr -> TestParser SomeExpr - recordSelector (SomeExpr e) = do - void $ osymbol "." - off <- stateOffset <$> getParserState - m <- identifier - let err = parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.concat - [ T.pack "value of type ", textExprType e, T.pack " does not have member '", m, T.pack "'" ] - e' <- maybe err return $ applyRecordSelector m e <$> lookup m recordMembers - recordSelector e' <|> return e' - applyRecordSelector :: ExprType a => Text -> Expr a -> RecordSelector a -> SomeExpr applyRecordSelector m e (RecordSelector f) = SomeExpr $ App (AnnRecord m) (pure f) e -- cgit v1.2.3