diff options
Diffstat (limited to 'src/Fun/Syntax.hs')
| -rw-r--r-- | src/Fun/Syntax.hs | 33 |
1 files changed, 30 insertions, 3 deletions
diff --git a/src/Fun/Syntax.hs b/src/Fun/Syntax.hs index 133b7dc..86e8100 100644 --- a/src/Fun/Syntax.hs +++ b/src/Fun/Syntax.hs @@ -1,6 +1,7 @@ module Fun.Syntax where import Data.Either +import Data.List import Fun.Tree data SyntaxError = SyntaxError String @@ -18,13 +19,39 @@ checkFunctionArity (FunctionBlock decl defns) = smaller = defnFirst < declArity in if equality && smaller then Right $ FunctionBlock decl defns - else Left $ [SyntaxError $ "invalid arity in function " ++ (dName decl)] + else Left [SyntaxError msg] + where msg = "invalid arity in function " ++ (dName decl) + +checkMainExistence :: Tree -> Either [SyntaxError] Tree +checkMainExistence tree = + let inProgram bs = filter (\b -> (dName . bDecl) b == "main") bs + oneInProgram (Program bs) = length (inProgram bs) == 1 + inTree ps = map oneInProgram ps + oneInTree (Tree ps) = length (filter (== True) (inTree ps)) == 1 + in if oneInTree tree then Right tree else Left [SyntaxError msg] + where msg = "invalid amount of main functions" + +checkFunctionPatternDistinguishability :: Block -> Either [SyntaxError] Block +checkFunctionPatternDistinguishability f = + let defns (FunctionBlock _ d) = d + patterns = map (pElements . dPattern) $ defns f + unique = (all ((==) 1 . length) . (group . sort)) + in if unique $ patterns then Right f else Left [SyntaxError msg] + where + msg = "pattern not fully distinguishable in function " ++ ((dName . bDecl) f) + +checkFunctionPattern :: Block -> Either [SyntaxError] Block +checkFunctionPattern f = checkFunctionPatternDistinguishability f + +checkFunction :: Block -> Either [SyntaxError] Block +checkFunction f = checkFunctionArity f >>= checkFunctionPattern checkBlock :: Block -> Either [SyntaxError] Block -checkBlock b@(FunctionBlock _ _) = checkFunctionArity b +checkBlock b@(FunctionBlock _ _) = checkFunction b checkProgram :: Program -> Either [SyntaxError] Program checkProgram (Program blocks) = mergeSyntax (map checkBlock blocks) Program checkTree :: Tree -> Either [SyntaxError] Tree -checkTree (Tree programs) = mergeSyntax (map checkProgram programs) Tree +checkTree (Tree programs) = + mergeSyntax (map checkProgram programs) Tree >>= checkMainExistence |