diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2024-09-28 11:10:03 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-09-28 12:37:17 +0200 |
commit | df1d8d72a06a7d4b3b8801dce0374e6b0294f628 (patch) | |
tree | 0b5aaae9d533ed6a4fdac75198d70ca06f4a3196 /src/Parser/Expr.hs | |
parent | 08d319f0105ed4b2fd217e0a9e96333e4c786095 (diff) |
Partial application in expression statements
Diffstat (limited to 'src/Parser/Expr.hs')
-rw-r--r-- | src/Parser/Expr.hs | 33 |
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 |