Added some predefined functions and fixed printer

Now with some restrictions generated code compiles
This commit is contained in:
macocianradu
2021-12-01 02:54:30 +01:00
parent 5f4f453da5
commit 459c5f0b1d
5 changed files with 40 additions and 12 deletions

View File

@@ -6,6 +6,7 @@ import Prettyprinter
import Model.Function
import PrettyPrinter.General
import PrettyPrinter.Type
import Model.Type
-- show printStatementTree
@@ -15,7 +16,7 @@ printFunction f = show $ vcat [printFunctionSignature f, printFunctionBody f]
-- |Converts the body of a Function into a haskell valid Doc
printFunctionBody :: Function -> Doc a
printFunctionBody (MakeFunction name _ _ _ ex) = pretty name <+> "=" <+> printExpression ex
printFunctionBody (MakeFunction name _ inp _ ex) = pretty name <+> printVariableNames inp <+> "=" <+> printExpression ex
printExpression :: Expression -> Doc a
printExpression (Variable s) = pretty s
printExpression (Int s) = pretty s
@@ -26,11 +27,27 @@ 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 "exists" ex) = "isJust" <+> printExpression ex
printExpression (PostfixExp "is absent" ex) = "isNothing" <+> printExpression ex
printExpression (PostfixExp "single exists" ex) = "length" <+> printExpression ex <+> "==" <+> "1"
printExpression (PostfixExp "multiple exists" ex) = "length" <+> printExpression ex <+> ">" <+> "1"
printExpression (PostfixExp "count" ex) = "length" <+> printExpression ex
printExpression (PostfixExp name ex) = pretty name <+> printExpression ex
-- Equality expressions
printExpression (InfixExp "=" ex1 ex2) = printExpression ex1 <+> "==" <+> printExpression ex2
printExpression (InfixExp "<>" ex1 ex2) = printExpression ex1 <+> "/=" <+> printExpression ex2
printExpression (InfixExp "any =" ex1 ex2) = printExpression ex2 <+> "`elem`" <+> printExpression ex1
printExpression (InfixExp "all <>" ex1 ex2) = printExpression ex2 <+> "`notElem`" <+> printExpression ex1
printExpression (InfixExp "and" ex1 ex2) = printExpression ex1 <+> "&&" <+> printExpression ex2
printExpression (InfixExp "or" ex1 ex2) = printExpression ex1 <+> "||" <+> printExpression ex2
printExpression (InfixExp name ex1 ex2) = printExpression ex1 <+> pretty name <+> printExpression ex2
printExpression (IfSimple cond ex) = "if" <+> printExpression cond <+> "then" <+> printExpression ex <+> "else" <+> "Nothing"
printExpression (IfElse cond ex1 ex2) = "if" <+> printExpression cond <+> "then" <+> printExpression ex1 <+> "else" <+> printExpression ex2
-- |Converts a list of type attributes to a Doc with a list of variable names
printVariableNames :: [TypeAttribute] -> Doc a
printVariableNames vars = foldl (<+>) emptyDoc (map (pretty . attributeName) vars)
-- |Converts a function into a haskell valid Doc representing the signature of the function
printFunctionSignature :: Function -> Doc a
printFunctionSignature (MakeFunction name description inputs output _) =

View File

@@ -5,13 +5,14 @@ import Model.Type
import Semantic.ExpressionChecker
import Semantic.TypeChecker
import Data.Either
import Data.Char
-- |Checks if all the inputs and the out of a function call have valid types, and then checks that the assign-output expression is valid
checkFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] Function
checkFunction (definedTypes, definedFunctions) (MakeFunction name desc inp out ex)
| isRight checkedEx && isRight checkedOut && null (lefts checkedIn) =
case typeMatch (attributeType $ fromRightUnsafe checkedOut, Model.Type.cardinality out) (fromRightUnsafe checkedEx) of
Right _ -> Right $ MakeFunction name desc (rights checkedIn) (fromRightUnsafe checkedOut) ex
Right _ -> Right $ MakeFunction (toLower (head name) : tail name) desc (rights checkedIn) (fromRightUnsafe checkedOut) ex
Left err -> Left [err]
| otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx]
where

View File

@@ -18,12 +18,21 @@ data TypeCheckError =
-- |Checks whether a data type is valid
checkType :: [Type] -> Type -> Either [TypeCheckError] Type
checkType definedTypes (MakeType name super desc attr)
| null (lefts checkedAttr) = Right $ MakeType name super desc (rights checkedAttr)
| null (lefts checkedAttr) = case checkSuper definedTypes super of
Right superChecked -> Right $ MakeType name superChecked desc (rights checkedAttr)
Left err -> Left [err]
| otherwise = Left $ lefts checkedAttr
where checkedAttr = checkAttributes definedTypes attr
where checkedAttr = checkAttributes definedTypes attr
checkType _ (BasicType b) = Right (BasicType b)
checkSuper :: [Type] -> Maybe Type -> Either TypeCheckError (Maybe Type)
checkSuper _ Nothing = Right Nothing
checkSuper definedTypes (Just super) =
case checkAttributeType definedTypes super of
Right sup -> Right (Just sup)
Left err -> Left err
-- |Checks whether all the types of the attributes of a data type are already defined
checkAttributes :: [Type] -> [TypeAttribute] -> [Either TypeCheckError TypeAttribute]
checkAttributes _ [] = []