diff options
Diffstat (limited to 'src/Fun/Syntax.hs')
| -rw-r--r-- | src/Fun/Syntax.hs | 30 |
1 files changed, 20 insertions, 10 deletions
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 |