diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2024-12-08 20:02:12 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-12-08 20:02:12 +0100 |
commit | b590f9cbd4cfca3daa33786186837e77b0824387 (patch) | |
tree | 167b611986cfb9f4eb7ec7e8eeda4851be76914f | |
parent | fb35e1c3273927425e6cca340c6375666fb87be7 (diff) |
Separate parsers for individual variables and function calls
-rw-r--r-- | src/Parser/Expr.hs | 32 |
1 files 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 |