summaryrefslogtreecommitdiff
path: root/src/Parser/Core.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Parser/Core.hs')
-rw-r--r--src/Parser/Core.hs18
1 files changed, 13 insertions, 5 deletions
diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index ab6079a..f40889a 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -134,11 +134,19 @@ unifyExpr off pa expr = if
| Just (Refl :: FunctionType a :~: b) <- eqT
-> do
- case exprArgs expr of
- remaining
- | anull remaining -> return (FunctionEval expr)
- | otherwise -> parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
- "missing function arguments"
+ let FunctionArguments remaining = exprArgs expr
+ showType ( Nothing, SomeArgumentType atype ) = "`<" <> textExprType atype <> ">'"
+ showType ( Just (ArgumentKeyword kw), SomeArgumentType atype ) = "`" <> kw <> " <" <> textExprType atype <> ">'"
+ err = parseError . FancyError off . S.singleton . ErrorFail . T.unpack
+
+ defaults <- forM (M.toAscList remaining) $ \case
+ arg@(_, SomeArgumentType NoDefault) -> err $ "missing " <> showType arg <> " argument"
+ (kw, SomeArgumentType (ExprDefault def)) -> return (kw, SomeExpr def)
+ (kw, SomeArgumentType atype@ContextDefault) -> do
+ SomeExpr context <- gets testContext
+ context' <- unifyExpr off atype context
+ return (kw, SomeExpr context')
+ return (FunctionEval $ ArgsApp (FunctionArguments $ M.fromAscList defaults) expr)
| Just (Refl :: DynamicType :~: b) <- eqT
, Undefined msg <- expr