Fixed ifelse and added newlines at printing

This commit is contained in:
macocianradu
2021-12-01 15:05:06 +01:00
parent 459c5f0b1d
commit 9ea420e337
6 changed files with 22 additions and 12 deletions

View File

@@ -13,7 +13,7 @@ printEnum (MakeEnum name description values) =
(vcat ["data" <+> pretty name <+> "=",
indent 4 (printEnumValues values),
"",
printDisplayNames name values])
printDisplayNames name values, emptyDoc])
-- |Converts a list of EnumValues into a haskell valid Doc
printEnumValues :: [EnumValue] -> Doc a

View File

@@ -12,7 +12,7 @@ import Model.Type
-- |Converts a Function into a haskell valid String
printFunction :: Function -> String
printFunction f = show $ vcat [printFunctionSignature f, printFunctionBody f]
printFunction f = show $ vcat [printFunctionSignature f, printFunctionBody f, emptyDoc]
-- |Converts the body of a Function into a haskell valid Doc
printFunctionBody :: Function -> Doc a

View File

@@ -8,15 +8,15 @@ import Model.Type
-- |Converts an EnumType into a haskell valid String
printType :: Type -> String
printType (MakeType name (Just (MakeType super _ _ _)) description attributes) = printType (MakeType name Nothing description (superToAttribute super:attributes))
printType (MakeType name (Just (MakeType super _ _ _)) description attributes) = printType (MakeType name Nothing description (superToAttribute name super:attributes))
printType (MakeType _ (Just (BasicType _)) _ _) = error "Can't extend basic types"
printType (MakeType name Nothing description attributes) =
show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": printAttributes attributes), "}", ""])
show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": printAttributes attributes), "}", "", emptyDoc])
printType (BasicType name) = show $ pretty name
-- |Creates an attribute that accesses the super type
superToAttribute :: String -> TypeAttribute
superToAttribute name = MakeTypeAttribute "super" (MakeType name Nothing Nothing []) (Bounds (1, 1)) (Just "Pointer to super class")
superToAttribute :: String -> String -> TypeAttribute
superToAttribute name typ = MakeTypeAttribute ("super" ++ name) (MakeType typ Nothing Nothing []) (Bounds (1, 1)) (Just "Pointer to super class")
-- |Converts a list of TypeAttributes into a list of haskell valid Docs
printAttributes :: [TypeAttribute] -> [Doc a]

View File

@@ -100,8 +100,8 @@ checkExpression symbolMap (IfSimple cond ex)
checkedExp = checkExpression symbolMap ex
-- |Checks if the condition of the if statement is of type boolean, and then checks that both the then and else statements have the same type
checkExpression symbolMap (IfElse cond ex1 ex2)
| isRight condType || isRight (typeMatch (fromRightUnsafe condType) (BasicType "Boolean", Bounds (1, 1))) = Left $ IfConditionNotBoolean $ show cond
| isRight ex1Type || isRight ex2Type || isRight (typeMatch (fromRightUnsafe ex1Type) (fromRightUnsafe ex2Type)) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2)
| isLeft condType || isLeft (typeMatch (fromRightUnsafe condType) (BasicType "Boolean", Bounds (1, 1))) = Left $ IfConditionNotBoolean $ show cond
| isLeft ex1Type || isLeft ex2Type || isLeft (typeMatch (fromRightUnsafe ex1Type) (fromRightUnsafe ex2Type)) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2)
| otherwise = ex1Type
where condType = checkExpression symbolMap cond
ex1Type = checkExpression symbolMap ex1
@@ -127,7 +127,7 @@ checkList1 symbs (ex : exps) typ
-- |Checks whether the function that is called is already defined with the same argument types
checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError (Type, Cardinality)] -> Either TypeCheckError (Type, Cardinality)
checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ concatMap (typeName . fst) (rights args) ++ "]"
checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ show (rights args) ++ "]"
checkFunctionCall ((Func n a r):symbolMap) name args
| length right /= length args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args))
| name == n && all isRight (zipWith typeMatch a right) = Right r