From 0905fe68591a3dad83f87d5ac805b674c0b88c76 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 1 May 2026 20:25:20 +0200
Subject: Arbitrary type expression as function arguments

---
 src/Parser/Core.hs | 11 +++++++++++
 src/Parser/Expr.hs | 29 ++++++++++++++++++++++-------
 2 files changed, 33 insertions(+), 7 deletions(-)

(limited to 'src/Parser')

diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index e1a4035..c12afdd 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -273,6 +273,17 @@ unifySomeExpr off stype sexpr@(SomeExpr expr)
         _ <- unify off (ExprTypeVar tvar) (someExprType sexpr)
         return sexpr
 
+    | ExprTypeFunction args res <- stype
+    = case someExprType sexpr of
+        ExprTypeFunction args' res' -> do
+            _ <- unify off args args'
+            _ <- unify off res res'
+            return sexpr
+        _ -> do
+            _ <- unify off args (ExprTypeArguments mempty)
+            SomeExpr expr' <- unifySomeExpr off res sexpr
+            return $ SomeExpr $ FunctionAbstraction expr'
+
     | otherwise
     = do
         parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs
index c12d004..16c2b45 100644
--- a/src/Parser/Expr.hs
+++ b/src/Parser/Expr.hs
@@ -162,7 +162,7 @@ quotedString = label "string" $ lexeme $ do
 regex :: TestParser (Expr Regex)
 regex = label "regular expression" $ lexeme $ do
     off <- stateOffset <$> getParserState
-    void $ char '/'
+    void $ try $ char '/' <* notFollowedBy (char '=') -- TODO: better parsing rules for regexes
     let inner = choice
             [ char '/' >> return []
             , takeWhile1P Nothing (`notElem` ['/', '\\', '$']) >>= \s -> (Pure (RegexPart (TL.toStrict s)) :) <$> inner
@@ -418,12 +418,27 @@ constructor = label "constructor" $ do
 functionCall :: TestParser SomeExpr
 functionCall = do
     sline <- getSourceLine
-    (variable <|> constructor) >>= \case
-        SomeExpr e'@(FunVariable argTypes _ _) -> do
-            let check = checkFunctionArguments argTypes
-            args <- functionArguments check (someExpr FunctionTerm) literal (\poff -> lookupVarExpr poff sline . VarName)
-            return $ SomeExpr $ ArgsApp args e'
-        e -> return e
+    off <- stateOffset <$> getParserState
+
+    fun <- variable <|> constructor
+    FunctionArguments margs <- functionArguments (\poff _ e -> return ( poff, e )) (someExpr FunctionTerm) literal (\poff -> lookupVarExpr poff sline . VarName)
+    if M.null margs
+      then return fun
+      else do
+        dict <- newTypeVar
+        res <- newTypeVar
+        SomeExpr (expr :: Expr fa) <- unifySomeExpr off (ExprTypeFunction (ExprTypeVar dict) (ExprTypeVar res)) fun
+        Just (ExprTypeArguments argTypes) <- M.lookup dict <$> gets testTypeUnif
+        args <- fmap (FunctionArguments . M.fromAscList) $ mapM (\( kw, ( poff, e ) ) -> ( kw, ) <$> checkFunctionArguments argTypes poff kw e) $ M.toAscList margs
+        M.lookup res <$> gets testTypeUnif >>= \case
+            Just (ExprTypePrim (_ :: Proxy a))
+                | Just (Refl :: FunctionType a :~: fa) <- eqT
+                -> return $ SomeExpr $ ArgsApp args expr
+                | otherwise -> error $ "type mismatch after function unification: " <> show ( typeRep (Proxy @(FunctionType a)), typeRep (Proxy @fa) )
+            _
+                | Just (Refl :: FunctionType DynamicType :~: fa) <- eqT
+                -> return $ SomeExpr $ ArgsApp args expr
+                | otherwise -> error $ "type mismatch after function unification: " <> show ( typeRep (Proxy @(FunctionType DynamicType)), typeRep (Proxy @fa) )
 
 recordSelector :: SomeExpr -> TestParser SomeExpr
 recordSelector (SomeExpr expr) = do
-- 
cgit v1.2.3