Made super mandatory. Everything extends Object

This commit is contained in:
macocianradu
2022-02-17 13:13:55 +01:00
parent 07d4cc73e0
commit 6005594afb
11 changed files with 149 additions and 81 deletions

View File

@@ -73,7 +73,7 @@ addNewFunctions (t, s) (_:os) = addNewFunctions (t, s) os
addNewTypes :: [Type] -> [RosettaObject] -> [Type] addNewTypes :: [Type] -> [RosettaObject] -> [Type]
addNewTypes l [] = l addNewTypes l [] = l
addNewTypes defined (TypeObject o: os) = addDefinedTypes (addNewTypes defined os) [o] addNewTypes defined (TypeObject o: os) = addDefinedTypes (addNewTypes defined os) [o]
addNewTypes defined (EnumObject (MakeEnum name _ _): os) = addDefinedTypes (addNewTypes defined os) [MakeType name Nothing Nothing []] addNewTypes defined (EnumObject (MakeEnum name _ _): os) = addDefinedTypes (addNewTypes defined os) [MakeType name (BasicType "Object") Nothing []]
addNewTypes defined (_ :os) = addNewTypes defined os addNewTypes defined (_ :os) = addNewTypes defined os
-- |Parses any supported Rosetta types into a list of RosettaObject -- |Parses any supported Rosetta types into a list of RosettaObject

View File

@@ -0,0 +1,20 @@
type A: <"description">
a int (1..1) <"A">
type B extending A: <"description">
b int (1..1) <"B">
type C extending A: <"description">
c int (1..1) <"C">
type D extending B: <"description">
d int (1..1) <"D">
type F extending B: <"description">
f int (1..1) <"F">
type G extending C: <"description">
g int (1..1) <"G">
type H extending C: <"description">
h int (1..1) <"H">

View File

@@ -5,7 +5,7 @@ import Data.Time.LocalTime()
-- |The representation of a Rosetta data type -- |The representation of a Rosetta data type
data Type = MakeType { data Type = MakeType {
typeName :: String, typeName :: String,
superType :: Maybe Type, superType :: Type,
typeDescription :: Maybe String, typeDescription :: Maybe String,
typeAttributes :: [TypeAttribute] typeAttributes :: [TypeAttribute]
} }
@@ -49,6 +49,23 @@ instance Eq Cardinality where
(==) (OneBound x) (OneBound y) = x == y (==) (OneBound x) (OneBound y) = x == y
(==) NoBounds NoBounds = True (==) NoBounds NoBounds = True
(==) _ _ = False (==) _ _ = False
-- |A function used to add two cardinalities
addBounds :: Cardinality -> Cardinality -> Cardinality
addBounds (Bounds (x1, x2)) (Bounds (y1, y2)) = Bounds (x1 + y1, x2 + y2)
addBounds (Bounds (x1, _)) (OneBound y1) = OneBound (x1 + y1)
addBounds (Bounds (x1, _)) NoBounds = OneBound x1
addBounds (OneBound x1) (Bounds (y1, y2)) = addBounds (Bounds (y1, y2)) (OneBound x1)
addBounds (OneBound x1) (OneBound y1) = OneBound (x1 + y1)
addBounds (OneBound x1) NoBounds = OneBound x1
addBounds NoBounds (Bounds (y1, y2)) = addBounds (Bounds (y1, y2)) NoBounds
addBounds NoBounds (OneBound y1) = addBounds (OneBound y1) NoBounds
addBounds NoBounds NoBounds = NoBounds
-- |Custom operator for adding cardinalities
infixl 5 .+
(.+) :: Cardinality -> Cardinality -> Cardinality
(.+) = addBounds
typeAndCardinality :: TypeAttribute -> (Type, Cardinality) typeAndCardinality :: TypeAttribute -> (Type, Cardinality)
typeAndCardinality (MakeTypeAttribute _ typ crd _) = (typ, crd) typeAndCardinality (MakeTypeAttribute _ typ crd _) = (typ, crd)

View File

@@ -52,5 +52,5 @@ attributeParser =
typ <- try (pascalNameParser <|> camelNameParser) typ <- try (pascalNameParser <|> camelNameParser)
crd <- cardinalityParser crd <- cardinalityParser
desc <- optional descriptionParser desc <- optional descriptionParser
return $ MakeTypeAttribute nam (MakeType typ Nothing Nothing []) crd desc return $ MakeTypeAttribute nam (MakeType typ (BasicType "Object") Nothing []) crd desc

View File

@@ -5,6 +5,7 @@ module Parser.Type where
import Model.Type import Model.Type
import Text.Megaparsec.Char import Text.Megaparsec.Char
import Text.Megaparsec import Text.Megaparsec
import Data.Maybe
import Parser.General import Parser.General
-- |Parses a type declaration statement in Rosetta into an Type -- |Parses a type declaration statement in Rosetta into an Type
@@ -16,7 +17,7 @@ typeParser =
_ <- lexeme $ char ':' _ <- lexeme $ char ':'
tDescription <- optional descriptionParser tDescription <- optional descriptionParser
tAttributes <- many $ try typeAttributeParser tAttributes <- many $ try typeAttributeParser
return (MakeType tName tSuper tDescription tAttributes) if isJust tSuper then return (MakeType tName (fromJust tSuper) tDescription tAttributes) else return (MakeType tName (BasicType "Object") tDescription tAttributes)
-- |Parses the super class declaration statement in Rosetta into an Type -- |Parses the super class declaration statement in Rosetta into an Type
superTypeParser :: Parser Type superTypeParser :: Parser Type
@@ -24,7 +25,7 @@ superTypeParser =
do do
_ <- lexeme $ string "extends" _ <- lexeme $ string "extends"
name <- pascalNameParser name <- pascalNameParser
return $ MakeType name Nothing Nothing [] return $ MakeType name (BasicType "Object") Nothing []
-- |Parses a declared type attribute in Rosetta into a TypeAttribute -- |Parses a declared type attribute in Rosetta into a TypeAttribute
typeAttributeParser :: Parser TypeAttribute typeAttributeParser :: Parser TypeAttribute
@@ -34,7 +35,7 @@ typeAttributeParser =
aType <- try nameParser aType <- try nameParser
card <- cardinalityParser card <- cardinalityParser
desc <- optional descriptionParser desc <- optional descriptionParser
return (MakeTypeAttribute aName (MakeType aType Nothing Nothing []) card desc) return (MakeTypeAttribute aName (MakeType aType (BasicType "Object") Nothing []) card desc)
-- |Parses the cardinality of a type attribute in Rosetta into a Cardinality -- |Parses the cardinality of a type attribute in Rosetta into a Cardinality
cardinalityParser :: Parser Cardinality cardinalityParser :: Parser Cardinality

View File

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

View File

@@ -86,7 +86,7 @@ checkExpression symbolMap (PostfixExp name ex) = checkFunctionCall symbolMap nam
checkExpression symbolMap (InfixExp name ex1 ex2) = checkFunctionCall symbolMap name (checkExpression symbolMap ex1: [checkExpression symbolMap ex2]) checkExpression symbolMap (InfixExp name ex1 ex2) = checkFunctionCall symbolMap name (checkExpression symbolMap ex1: [checkExpression symbolMap ex2])
-- |Checks if the condition of an if expression is of type boolean, and then checks the expression of the then statement -- |Checks if the condition of an if expression is of type boolean, and then checks the expression of the then statement
checkExpression symbolMap (IfSimple cond ex) checkExpression symbolMap (IfSimple cond ex)
| isRight condType && isRight (typeMatch (fromRightUnsafe condType) (BasicType "Boolean", Bounds (1, 1))) = | isRight condType && isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1) =
case checkedExp of case checkedExp of
-- |The if without else statement always has a cardinality lower bound of 0 -- |The if without else statement always has a cardinality lower bound of 0
Right (typ, Bounds(_, x)) -> Right (typ, Bounds(0, x)) Right (typ, Bounds(_, x)) -> Right (typ, Bounds(0, x))
@@ -99,8 +99,11 @@ checkExpression symbolMap (IfSimple cond ex)
checkedExp = checkExpression symbolMap 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 -- |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) checkExpression symbolMap (IfElse cond ex1 ex2)
| isLeft condType || isLeft (typeMatch (fromRightUnsafe condType) (BasicType "Boolean", Bounds (1, 1))) = Left $ IfConditionNotBoolean $ show cond | isLeft condType || isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1) = Left $ IfConditionNotBoolean $ show cond
| isLeft ex1Type || isLeft ex2Type || isLeft (typeMatch (fromRightUnsafe ex1Type) (fromRightUnsafe ex2Type)) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2) | isLeft ex1Type || isLeft ex2Type ||
-- |Both branches must resolve to the same type and cardinality
isLeft (typeMatch (fst $ fromRightUnsafe ex1Type) (fst $ fromRightUnsafe ex2Type)) ||
snd (fromRightUnsafe ex1Type) /= snd (fromRightUnsafe ex2Type) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2)
| otherwise = ex1Type | otherwise = ex1Type
where condType = checkExpression symbolMap cond where condType = checkExpression symbolMap cond
ex1Type = checkExpression symbolMap ex1 ex1Type = checkExpression symbolMap ex1
@@ -108,69 +111,82 @@ checkExpression symbolMap (IfElse cond ex1 ex2)
-- |Checks that all the expressions in a list have compatible types -- |Checks that all the expressions in a list have compatible types
checkList :: [Symbol] -> [Expression] -> Either TypeCheckError (Type, Cardinality) checkList :: [Symbol] -> [Expression] -> Either TypeCheckError (Type, Cardinality)
checkList symbs exps checkList _ [] = Right (BasicType "Empty", Bounds(0, 0))
| isRight typ && fromRightUnsafe typ == (BasicType "Any", NoBounds) = Right (BasicType "Empty", Bounds (0, 0)) checkList symbs (ex : exps)
| isRight typ = checkList1 symbs exps (fromRightUnsafe typ)
| otherwise = typ | otherwise = typ
where typ = checkList1 symbs exps (BasicType "Any", NoBounds) where typ = checkExpression symbs ex
-- |Auxiliary function for the check list function -- |Auxiliary function for the check list function
checkList1 :: [Symbol] -> [Expression] -> (Type, Cardinality) -> Either TypeCheckError (Type, Cardinality) checkList1 :: [Symbol] -> [Expression] -> (Type, Cardinality) -> Either TypeCheckError (Type, Cardinality)
checkList1 _ [] typ = Right typ checkList1 _ [] typ = Right typ
checkList1 symbs (ex : exps) typ checkList1 symbs (ex : exps) typ
| isRight exTyp = exTyp | isLeft exTyp = exTyp
| isRight match = match | not match = Left $ TypeMismatch (typeName $ fst typ) (typeName $ fst (fromRightUnsafe exTyp))
| otherwise = checkList1 symbs exps (fromRightUnsafe match) | otherwise = checkList1 symbs exps (fst typ, crd)
where where
exTyp = checkExpression symbs ex exTyp = checkExpression symbs ex
match = typeMatch typ (fromRightUnsafe exTyp) match = fst typ == fst (fromRightUnsafe exTyp)
crd = snd typ .+ snd (fromRightUnsafe exTyp)
-- |Checks whether the function that is called is already defined with the same argument types -- |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 :: [Symbol] -> String -> [Either TypeCheckError (Type, Cardinality)] -> Either TypeCheckError (Type, Cardinality)
checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ show (rights args) ++ "]" checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ show (rights args) ++ "]"
checkFunctionCall ((Func n a r):symbolMap) name args checkFunctionCall ((Func n a r):symbolMap) name args
| length right /= length args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args)) | length right /= length args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args))
| name == n && all isRight (zipWith typeMatch a right) = Right r | name == n && all isRight (zipWith typeIncluded a right) = Right r
| otherwise = checkFunctionCall symbolMap name args | otherwise = checkFunctionCall symbolMap name args
where right = rights args where
right = rights args
checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args
--Try to match 2nd type to first type typeIncluded :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError Bool
typeIncluded (t1, c1) (t2, c2)
| isSubType t1 t2 && cardinalityIncluded c1 c2 = Right True
| isSubType t1 t2 = Left $ CardinalityMismatch c1 c2
| otherwise = Left $ TypeMismatch (typeName t1) (typeName t2)
-- |Checks whether two types are compatible -- |Checks whether two types are compatible
typeMatch :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError (Type, Cardinality) typeMatch :: Type -> Type -> Either TypeCheckError Type
typeMatch (BasicType "Any", card1) (x, card2) -- |An object matches only with object
| isRight card = Right (x, fromRightUnsafe card) typeMatch (BasicType "Object") _ = Right $ BasicType "Object"
| otherwise = Left $ fromLeftUnsafe card typeMatch _ (BasicType "Object") = Right $ BasicType "Object"
where card = cardinalityIncluded card2 card1 -- |Any matches with any type
typeMatch (BasicType "Double", card1) (BasicType "Integer", card2) typeMatch (BasicType "Any") x = Right x
| isRight card = Right (BasicType "Dobule", fromRightUnsafe card) typeMatch x (BasicType "Any") = Right x
| otherwise = Left $ fromLeftUnsafe card -- |Integer can be a double
where card = cardinalityIncluded card2 card1 typeMatch (BasicType "Integer") (BasicType "Double") = Right (BasicType "Double")
--typeMatch (s, card1) (BasicType s2, card2) typeMatch (BasicType "Double") (BasicType "Integer") = Right (BasicType "Double")
-- | s == BasicType s2 = case cardinalityIncluded card1 card2 of -- |First check x with all the supertypes of y, then go higher on the supertypes of x and repeat
-- Right card -> Right (s, card) typeMatch x y
-- Left err -> Left err | x == y = Right x
-- | otherwise = Left $ TypeMismatch (typeName s) s2 | isRight match = Right $ fromRightUnsafe match
typeMatch (s, card1) (s2, card2) | otherwise = typeMatch (superType x) y
| s == s2 = case cardinalityIncluded card2 card1 of where match = typeMatch x (superType y)
Right card -> Right (s, card)
Left err -> Left err
| isJust $ superType s2 = typeMatch (s, card1) (fromJust $ superType s2, card2)
| otherwise = Left $ TypeMismatch (typeName s) (typeName s2)
-- |Checks whether the first cardinality is included into the second one and returns the most restricted cardinality -- |Checks whether the first argument is a subtype of the second argument
cardinalityIncluded :: Cardinality -> Cardinality -> Either TypeCheckError Cardinality isSubType :: Type -> Type -> Bool
cardinalityIncluded x NoBounds = Right x isSubType (BasicType "Integer") (BasicType "Double") = True
cardinalityIncluded NoBounds x = Left $ CardinalityMismatch NoBounds x isSubType _ (BasicType "Any") = True
isSubType _ (BasicType "Object") = False
isSubType x y
| x == y = True
| otherwise = isSubType (superType x) y
-- |Checks whether the first cardinality is included into the second one
cardinalityIncluded :: Cardinality -> Cardinality -> Bool
cardinalityIncluded _ NoBounds = True
cardinalityIncluded NoBounds _ = False
cardinalityIncluded (OneBound x) (OneBound y) cardinalityIncluded (OneBound x) (OneBound y)
| x >= y = Right $ OneBound x | x >= y = True
| otherwise = Left $ CardinalityMismatch (OneBound x) (OneBound y) | otherwise = False
cardinalityIncluded (Bounds (x1, x2)) (OneBound y) cardinalityIncluded (Bounds (x1, _)) (OneBound y)
| x1 >= y = Right $ Bounds (x1, x2) | x1 >= y = True
| otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (OneBound y) | otherwise = False
cardinalityIncluded (OneBound x) (Bounds (y1, y2)) = Left $ CardinalityMismatch (OneBound x) (Bounds (y1, y2)) cardinalityIncluded (OneBound _) (Bounds (_, _)) = False
cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2)) cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2))
| x1 >= y1 && x2 <= y2 = Right $ Bounds (x1, x2) | x1 >= y1 && x2 <= y2 = True
| otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (Bounds (y1, y2)) | otherwise = False
-- |Looks in the symbol map for the type of a variable -- |Looks in the symbol map for the type of a variable
findVarType :: String -> [Symbol] -> Either TypeCheckError (Type, Cardinality) findVarType :: String -> [Symbol] -> Either TypeCheckError (Type, Cardinality)

View File

@@ -7,11 +7,11 @@ import Semantic.TypeChecker
import Data.Either import Data.Either
import Data.Char 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 -- |Checks if all the inputs and the output 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 :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] Function
checkFunction (definedTypes, symbols) (MakeFunction name desc inp out ex) checkFunction (definedTypes, symbols) (MakeFunction name desc inp out ex)
| isRight checkedEx && isRight checkedOut && null (lefts checkedIn) = | isRight checkedEx && isRight checkedOut && null (lefts checkedIn) =
case typeMatch (attributeType $ fromRightUnsafe checkedOut, Model.Type.cardinality out) (fromRightUnsafe checkedEx) of case typeIncluded (attributeType $ fromRightUnsafe checkedOut, Model.Type.cardinality out) (fromRightUnsafe checkedEx) of
Right _ -> Right $ MakeFunction (toLower (head name) : tail 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] Left err -> Left [err]
| otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx] | otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx]

View File

@@ -18,20 +18,22 @@ data TypeCheckError =
-- |Checks whether a data type is valid -- |Checks whether a data type is valid
checkType :: [Type] -> Type -> Either [TypeCheckError] Type checkType :: [Type] -> Type -> Either [TypeCheckError] Type
checkType definedTypes (MakeType name super desc attr) checkType definedTypes (MakeType name super desc attr)
| null (lefts checkedAttr) = case checkSuper definedTypes super of | null (lefts checkedAttr) = case populateSuper definedTypes definedTypes super of
Right superChecked -> Right $ MakeType name superChecked desc (rights checkedAttr) Right superPopulated -> Right $ MakeType name superPopulated desc (rights checkedAttr)
Left err -> Left [err] Left err -> Left [err]
| otherwise = Left $ lefts checkedAttr | otherwise = Left $ lefts checkedAttr
where checkedAttr = checkAttributes definedTypes attr where checkedAttr = checkAttributes definedTypes attr
checkType _ (BasicType b) = Right (BasicType b) checkType _ (BasicType b) = Right (BasicType b)
populateSuper :: [Type] -> [Type] -> Type -> Either TypeCheckError Type
checkSuper :: [Type] -> Maybe Type -> Either TypeCheckError (Maybe Type) populateSuper _ _ (BasicType "Object") = Right (BasicType "Object")
checkSuper _ Nothing = Right Nothing populateSuper _ _ (BasicType _) = Left $ UndefinedType "Can't extend basic types"
checkSuper definedTypes (Just super) = populateSuper _ [] t = Left $ UndefinedType (typeName t)
case checkAttributeType definedTypes super of populateSuper allTypes (currType : types) (MakeType t super d a)
Right sup -> Right (Just sup) | typeName currType == typeName super = case populateSuper allTypes allTypes currType of
Right superChecked -> Right $ MakeType t superChecked d a
Left err -> Left err Left err -> Left err
| otherwise = populateSuper allTypes types (MakeType t super d a)
-- |Checks whether all the types of the attributes of a data type are already defined -- |Checks whether all the types of the attributes of a data type are already defined
checkAttributes :: [Type] -> [TypeAttribute] -> [Either TypeCheckError TypeAttribute] checkAttributes :: [Type] -> [TypeAttribute] -> [Either TypeCheckError TypeAttribute]

View File

@@ -40,7 +40,9 @@ spec = do
exps :: [Expression] exps :: [Expression]
exps = [ exps = [
-- 1
InfixExp "+" (Int "1") (Parens (InfixExp "-" (Int "2") (Int "3"))), InfixExp "+" (Int "1") (Parens (InfixExp "-" (Int "2") (Int "3"))),
-- 2
InfixExp "=" InfixExp "="
(InfixExp "-" (InfixExp "-"
(InfixExp "-" (InfixExp "-"
@@ -52,17 +54,27 @@ exps = [
(InfixExp "*" (Variable "g") (Variable "h")) (InfixExp "*" (Variable "g") (Variable "h"))
(InfixExp "*" (Variable "i") (Variable "j"))) (InfixExp "*" (Variable "i") (Variable "j")))
(InfixExp "*" (Variable "k") (Variable "l"))), (InfixExp "*" (Variable "k") (Variable "l"))),
-- 3
InfixExp "-" (InfixExp "+" (Variable "a") (Variable "b")) (InfixExp "*" (Variable "c") (InfixExp "^" (Variable "d") (Variable "e"))), InfixExp "-" (InfixExp "+" (Variable "a") (Variable "b")) (InfixExp "*" (Variable "c") (InfixExp "^" (Variable "d") (Variable "e"))),
-- 4
InfixExp "-" (InfixExp "-" (InfixExp "-" (InfixExp "-" (InfixExp "-" (Int "1") (Int "2")) (Int "3")) (Int "4")) (Int "5")) (Int "6"), InfixExp "-" (InfixExp "-" (InfixExp "-" (InfixExp "-" (InfixExp "-" (Int "1") (Int "2")) (Int "3")) (Int "4")) (Int "5")) (Int "6"),
-- 5
List [Int "1", Int "2", Int "3"], List [Int "1", Int "2", Int "3"],
-- 6
List [Int "1", InfixExp "+" (Int "2") (Int "3"), Variable "e"], List [Int "1", InfixExp "+" (Int "2") (Int "3"), Variable "e"],
-- 7
Function "Function" [], Function "Function" [],
-- 8
Function "Function" [Variable "e"], Function "Function" [Variable "e"],
-- 9
Function "Function" [Int "3", InfixExp "+" (Int "3") (Int "2"), Variable "e"], Function "Function" [Int "3", InfixExp "+" (Int "3") (Int "2"), Variable "e"],
-- 10
IfElse (Function "Function" [InfixExp "+" (Int "2") (Int "3"), Variable "e"]) IfElse (Function "Function" [InfixExp "+" (Int "2") (Int "3"), Variable "e"])
(InfixExp "-" (InfixExp "+" (Variable "a") (Variable "b")) (InfixExp "*" (Variable "c") (InfixExp "^" (Variable "d") (Variable "e->x")))) (InfixExp "-" (InfixExp "+" (Variable "a") (Variable "b")) (InfixExp "*" (Variable "c") (InfixExp "^" (Variable "d") (Variable "e->x"))))
(PrefixExp "not" (PostfixExp "exists" (Variable "a"))), (PrefixExp "not" (PostfixExp "exists" (Variable "a"))),
-- 11
IfSimple (List [Int "1", Function "Function" [Int "3"]]) (InfixExp "-" (InfixExp "-" (Int "1") (Int "2")) (InfixExp "*" (Int "3") (InfixExp "^" (Variable "a->b") (Variable "c")))), IfSimple (List [Int "1", Function "Function" [Int "3"]]) (InfixExp "-" (InfixExp "-" (Int "1") (Int "2")) (InfixExp "*" (Int "3") (InfixExp "^" (Variable "a->b") (Variable "c")))),
-- 12
InfixExp "or" (Variable "a") (Variable "b") InfixExp "or" (Variable "a") (Variable "b")
] ]

View File

@@ -36,42 +36,42 @@ types :: [Type]
types = [ types = [
MakeType {typeName = "Period", MakeType {typeName = "Period",
typeDescription = Just "description", typeDescription = Just "description",
superType = Nothing, superType = MakeType "Something" (BasicType "Object") Nothing [],
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" Nothing Nothing [], cardinality = Bounds(1, 1), typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1),
attributeDescription = Just "A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days."}, attributeDescription = Just "A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days."},
MakeTypeAttribute {attributeName = "testMany", attributeType = MakeType "TestType" Nothing Nothing [], cardinality = OneBound 0, MakeTypeAttribute {attributeName = "testMany", attributeType = MakeType "TestType" (BasicType "Object") Nothing [], cardinality = OneBound 0,
attributeDescription = Just "Test many"}, attributeDescription = Just "Test many"},
MakeTypeAttribute {attributeName = "testSome", attributeType = MakeType "TestSomeType" Nothing Nothing [], cardinality = OneBound 1, MakeTypeAttribute {attributeName = "testSome", attributeType = MakeType "TestSomeType" (BasicType "Object") Nothing [], cardinality = OneBound 1,
attributeDescription = Just "Test some"}, attributeDescription = Just "Test some"},
MakeTypeAttribute {attributeName = "testMaybeOne", attributeType = MakeType "TestZeroOneType" Nothing Nothing [], cardinality = Bounds (0, 1), MakeTypeAttribute {attributeName = "testMaybeOne", attributeType = MakeType "TestZeroOneType" (BasicType "Object") Nothing [], cardinality = Bounds (0, 1),
attributeDescription = Just "Test zero or one"}, attributeDescription = Just "Test zero or one"},
MakeTypeAttribute {attributeName = "testAll", attributeType = MakeType "Test" Nothing Nothing [], cardinality = Bounds (2, 15), MakeTypeAttribute {attributeName = "testAll", attributeType = MakeType "Test" (BasicType "Object") Nothing [], cardinality = Bounds (2, 15),
attributeDescription = Just "Test all"}]}, attributeDescription = Just "Test all"}]},
MakeType {typeName = "TestType", MakeType {typeName = "TestType",
typeDescription = Nothing, typeDescription = Nothing,
superType = Nothing, superType = BasicType "Object",
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" Nothing Nothing [], cardinality = Bounds(1, 1), typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1),
attributeDescription = Nothing}]}, attributeDescription = Nothing}]},
MakeType {typeName = "TestSomeType", MakeType {typeName = "TestSomeType",
typeDescription = Just "description", typeDescription = Just "description",
superType = Nothing, superType = BasicType "Object",
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" Nothing Nothing [], cardinality = Bounds(1, 1), typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1),
attributeDescription = Just "A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days."}]}, attributeDescription = Just "A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days."}]},
MakeType {typeName = "TestZeroOneType", MakeType {typeName = "TestZeroOneType",
typeDescription = Nothing, typeDescription = Nothing,
superType = Just $ MakeType "Period" Nothing Nothing [], superType = MakeType "Period" (BasicType "Object") Nothing [],
typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" Nothing Nothing [], cardinality = Bounds(1, 1), typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1),
attributeDescription = Nothing}]}, attributeDescription = Nothing}]},
MakeType {typeName = "WrongCardinality", superType = Nothing, typeDescription = Just "description", typeAttributes = []}, MakeType {typeName = "WrongCardinality", superType = BasicType "Object", typeDescription = Just "description", typeAttributes = []},
MakeType {typeName = "WrongCardinality2", superType = Nothing, typeDescription = Just "description", typeAttributes = []}, MakeType {typeName = "WrongCardinality2", superType = BasicType "Object", typeDescription = Just "description", typeAttributes = []},
MakeType {typeName = "MissingType", superType = Nothing, typeDescription = Just "description", typeAttributes = []} MakeType {typeName = "MissingType", superType = BasicType "Object", typeDescription = Just "description", typeAttributes = []}
] ]