fixed types to be capitalized

This commit is contained in:
macocianradu
2021-11-30 21:20:02 +01:00
parent d14c1de4cf
commit 70baa17a4e
4 changed files with 26 additions and 8 deletions

View File

@@ -40,6 +40,7 @@ library
PrettyPrinter.RosettaObject
PrettyPrinter.Type
Semantic.ExpressionChecker
Semantic.FunctionChecker
Semantic.TypeChecker
other-modules:
Paths_RosettaParser

View File

@@ -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

View File

@@ -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

View File

@@ -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]