From dbfb7c4f285fda49c59648ef16c6d6bfdd4e59bd Mon Sep 17 00:00:00 2001
From: Marvin Borner
Date: Fri, 4 Mar 2022 01:10:12 +0100
Subject: Syntax

---
 src/Fun/Syntax.hs | 30 ++++++++++++++++++++----------
 1 file changed, 20 insertions(+), 10 deletions(-)

(limited to 'src/Fun/Syntax.hs')

diff --git a/src/Fun/Syntax.hs b/src/Fun/Syntax.hs
index ab17215..133b7dc 100644
--- a/src/Fun/Syntax.hs
+++ b/src/Fun/Syntax.hs
@@ -5,16 +5,26 @@ import           Fun.Tree
 
 data SyntaxError = SyntaxError String
 
-syntaxBlock :: Block -> Either [SyntaxError] Block
-syntaxBlock (FunctionBlock decl defns) = Right $ FunctionBlock decl defns
-
 mergeSyntax :: [Either [SyntaxError] a] -> ([a] -> b) -> Either [SyntaxError] b
-mergeSyntax d c = case any isLeft d of
-  True  -> Left $ concat $ lefts d
-  False -> Right $ c $ rights d
+mergeSyntax d c | any isLeft d = Left $ concat $ lefts d
+                | otherwise    = Right $ c $ rights d
+
+checkFunctionArity :: Block -> Either [SyntaxError] Block
+checkFunctionArity (FunctionBlock decl defns) =
+  let declArity   = length $ dTypes decl
+      defnArities = map (length . pElements . dPattern) defns
+      defnFirst   = head defnArities -- can't fail because of parser
+      equality    = all (== defnFirst) defnArities
+      smaller     = defnFirst < declArity
+  in  if equality && smaller
+        then Right $ FunctionBlock decl defns
+        else Left $ [SyntaxError $ "invalid arity in function " ++ (dName decl)]
+
+checkBlock :: Block -> Either [SyntaxError] Block
+checkBlock b@(FunctionBlock _ _) = checkFunctionArity b
 
-syntaxProgram :: Program -> Either [SyntaxError] Program
-syntaxProgram (Program blocks) = mergeSyntax (map syntaxBlock blocks) Program
+checkProgram :: Program -> Either [SyntaxError] Program
+checkProgram (Program blocks) = mergeSyntax (map checkBlock blocks) Program
 
-syntaxTree :: Tree -> Either [SyntaxError] Tree
-syntaxTree (Tree programs) = mergeSyntax (map syntaxProgram programs) Tree
+checkTree :: Tree -> Either [SyntaxError] Tree
+checkTree (Tree programs) = mergeSyntax (map checkProgram programs) Tree
-- 
cgit v1.2.3