summaryrefslogtreecommitdiff
path: root/src/Parser/Expr.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-09-28 11:10:03 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-09-28 12:37:17 +0200
commitdf1d8d72a06a7d4b3b8801dce0374e6b0294f628 (patch)
tree0b5aaae9d533ed6a4fdac75198d70ca06f4a3196 /src/Parser/Expr.hs
parent08d319f0105ed4b2fd217e0a9e96333e4c786095 (diff)
Partial application in expression statements
Diffstat (limited to 'src/Parser/Expr.hs')
-rw-r--r--src/Parser/Expr.hs33
1 files changed, 19 insertions, 14 deletions
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs
index 322bb9b..4ed0215 100644
--- a/src/Parser/Expr.hs
+++ b/src/Parser/Expr.hs
@@ -10,6 +10,7 @@ module Parser.Expr (
literal,
variable,
+ checkFunctionArguments,
functionArguments,
) where
@@ -344,20 +345,8 @@ variable = label "variable" $ do
sline <- getSourceLine
name <- varName
lookupVarExpr off sline name >>= \case
- SomeExpr e'@(FunVariable (FunctionArguments argTypes) _ _) -> do
- let check poff kw expr = do
- case M.lookup kw argTypes of
- Just (SomeArgumentType (_ :: ArgumentType expected)) -> do
- withRecovery registerParseError $ do
- void $ unify poff (ExprTypePrim (Proxy @expected)) (someExprType expr)
- return expr
- Nothing -> do
- registerParseError $ FancyError poff $ S.singleton $ ErrorFail $ T.unpack $
- case kw of
- Just (ArgumentKeyword tkw) -> "unexpected parameter with keyword `" <> tkw <> "'"
- Nothing -> "unexpected parameter"
- return expr
-
+ 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
@@ -378,6 +367,22 @@ variable = label "variable" $ do
applyRecordSelector m e (RecordSelector f) = SomeExpr $ App (AnnRecord m) (pure f) e
+checkFunctionArguments :: FunctionArguments SomeArgumentType
+ -> Int -> Maybe ArgumentKeyword -> SomeExpr -> TestParser SomeExpr
+checkFunctionArguments (FunctionArguments argTypes) poff kw expr = do
+ case M.lookup kw argTypes of
+ Just (SomeArgumentType (_ :: ArgumentType expected)) -> do
+ withRecovery registerParseError $ do
+ void $ unify poff (ExprTypePrim (Proxy @expected)) (someExprType expr)
+ return expr
+ Nothing -> do
+ registerParseError $ FancyError poff $ S.singleton $ ErrorFail $ T.unpack $
+ case kw of
+ Just (ArgumentKeyword tkw) -> "unexpected parameter with keyword `" <> tkw <> "'"
+ Nothing -> "unexpected parameter"
+ return expr
+
+
functionArguments :: (Int -> Maybe ArgumentKeyword -> a -> TestParser b) -> TestParser a -> TestParser a -> (Int -> Text -> TestParser a) -> TestParser (FunctionArguments b)
functionArguments check param lit promote = do
args <- parseArgs True