summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-12-08 20:02:12 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2024-12-08 20:02:12 +0100
commitb590f9cbd4cfca3daa33786186837e77b0824387 (patch)
tree167b611986cfb9f4eb7ec7e8eeda4851be76914f
parentfb35e1c3273927425e6cca340c6375666fb87be7 (diff)
Separate parsers for individual variables and function calls
-rw-r--r--src/Parser/Expr.hs32
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