summaryrefslogtreecommitdiff
path: root/src/Parser/Core.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-09-21 21:19:37 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-09-24 20:02:36 +0200
commit274554243235d3013430a48973fd0f25244ac392 (patch)
tree122353115dc3205ba41b1133e0dd20c82c2d3118 /src/Parser/Core.hs
parent0a51c798d1322297f13ce6bc7a500ce5212b5e8e (diff)
Function parameters and calls
Diffstat (limited to 'src/Parser/Core.hs')
-rw-r--r--src/Parser/Core.hs19
1 files changed, 14 insertions, 5 deletions
diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index 2a2fc89..dd2df12 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -60,6 +60,7 @@ lookupVarExpr off name = do
lookupVarType off name >>= \case
ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable name :: Expr a)
ExprTypeVar tvar -> return $ SomeExpr $ DynVariable tvar name
+ ExprTypeFunction args (_ :: Proxy a) -> return $ SomeExpr $ (FunVariable args name :: Expr (FunctionType a))
unify :: Int -> SomeExprType -> SomeExprType -> TestParser SomeExprType
unify _ (ExprTypeVar aname) (ExprTypeVar bname) | aname == bname = do
@@ -122,24 +123,32 @@ unify off a b = do
unifyExpr :: forall a b proxy. (ExprType a, ExprType b) => Int -> proxy a -> Expr b -> TestParser (Expr a)
-unifyExpr off pa x = if
+unifyExpr off pa expr = if
| Just (Refl :: a :~: b) <- eqT
- -> return x
+ -> return expr
- | DynVariable tvar name <- x
+ | DynVariable tvar name <- expr
-> do
_ <- unify off (ExprTypePrim (Proxy :: Proxy a)) (ExprTypeVar tvar)
return $ Variable name
+ | 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"
+
| Just (Refl :: DynamicType :~: b) <- eqT
- , Undefined msg <- x
+ , Undefined msg <- expr
-> do
return $ Undefined msg
| otherwise
-> do
parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
- "couldn't match expected type `" <> textExprType pa <> "' with actual type `" <> textExprType x <> "'"
+ "couldn't match expected type `" <> textExprType pa <> "' with actual type `" <> textExprType expr <> "'"
skipLineComment :: TestParser ()