diff --git a/RosettaParser.cabal b/RosettaParser.cabal index ce0482e..34cf789 100644 --- a/RosettaParser.cabal +++ b/RosettaParser.cabal @@ -40,6 +40,7 @@ library PrettyPrinter.RosettaObject PrettyPrinter.Type Semantic.ExpressionChecker + Semantic.FunctionChecker Semantic.TypeChecker other-modules: Paths_RosettaParser diff --git a/app/Main.hs b/app/Main.hs index aba9e81..c18fa35 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -12,6 +12,7 @@ import PrettyPrinter.Type import PrettyPrinter.Function import Semantic.TypeChecker import Semantic.ExpressionChecker +import Semantic.FunctionChecker import Model.Function import Model.Type import System.Environment.Blank (getArgs) @@ -26,7 +27,7 @@ main = do case parse rosettaParser "" (Text.pack rosettaString) of Left errorBundle -> print (errorBundlePretty errorBundle) Right objs -> do - putStrLn $ printObjects (definedTypes, definedFunctions) objs + writeFile (args !! 1) (printObjects (definedTypes, definedFunctions) objs) where definedFunctions = addNewFunctions (definedTypes, defaultMap) objs definedTypes = addNewTypes [] objs @@ -39,15 +40,15 @@ printObjects (t, s) objs printObject :: ([Type], [Symbol]) -> RosettaObject -> Either [TypeCheckError] String printObject (definedTypes, _) (TypeObject t) - | isRight checked = Right $ printType t + | isRight checked = Right $ printType $ fromRightUnsafe checked | otherwise = Left $ fromLeftUnsafe checked where checked = checkType definedTypes t printObject _ (EnumObject e) = Right $ printEnum e -printObject (_, definedFunctions) (FunctionObject (MakeFunction name desc inp out ex)) - | isRight checked = Right $ printFunction (MakeFunction name desc inp out ex) - | otherwise = Left [fromLeftUnsafe checked] +printObject (definedTypes, definedFunctions) (FunctionObject fun) + | isRight checked = Right $ printFunction $ fromRightUnsafe checked + | otherwise = Left $ fromLeftUnsafe checked where - checked = checkExpression definedFunctions ex + checked = checkFunction (definedTypes, definedFunctions) fun addNewFunctions :: ([Type], [Symbol]) -> [RosettaObject] -> [Symbol] addNewFunctions (_, s) [] = s diff --git a/src/PrettyPrinter/Function.hs b/src/PrettyPrinter/Function.hs index b72090f..c573600 100644 --- a/src/PrettyPrinter/Function.hs +++ b/src/PrettyPrinter/Function.hs @@ -24,9 +24,9 @@ printExpression (Parens ex) = "(" <> printExpression ex <> ")" printExpression (List ex) = list (map printExpression ex) printExpression (Function name ex) = pretty name <> tupled (map printExpression ex) printExpression (PrefixExp name ex) = pretty name <+> printExpression ex -printExpression (PostfixExp name ex) = printExpression ex <+> pretty name +printExpression (PostfixExp name ex) = pretty name <+> printExpression ex printExpression (InfixExp name ex1 ex2) = printExpression ex1 <+> pretty name <+> printExpression ex2 -printExpression (IfSimple cond ex) = "if" <+> printExpression cond <+> "then" <+> printExpression ex +printExpression (IfSimple cond ex) = "if" <+> printExpression cond <+> "then" <+> printExpression ex <+> "else" <+> "pure ()" printExpression (IfElse cond ex1 ex2) = "if" <+> printExpression cond <+> "then" <+> printExpression ex1 <+> "else" <+> printExpression ex2 printFunctionSignature :: Function -> Doc a diff --git a/src/Semantic/FunctionChecker.hs b/src/Semantic/FunctionChecker.hs new file mode 100644 index 0000000..c8e1134 --- /dev/null +++ b/src/Semantic/FunctionChecker.hs @@ -0,0 +1,16 @@ +module Semantic.FunctionChecker where + +import Model.Function +import Model.Type +import Semantic.ExpressionChecker +import Semantic.TypeChecker +import Data.Either + +checkFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] Function +checkFunction (definedTypes, definedFunctions) (MakeFunction name desc inp out ex) + | isRight checkedEx && isRight checkedOut && null (lefts checkedIn) = Right $ MakeFunction name desc (rights checkedIn) (fromRightUnsafe checkedOut) ex + | otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx] + where + checkedEx = checkExpression definedFunctions ex + checkedIn = checkAttributes definedTypes inp + checkedOut = head $ checkAttributes definedTypes [out] \ No newline at end of file