Made super mandatory. Everything extends Object

2026-03-18 13:00:08 +00:00 · 2022-02-17 13:13:55 +01:00
parent 07d4cc73e0
commit 6005594afb
11 changed files with 149 additions and 81 deletions
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -73,7 +73,7 @@ addNewFunctions (t, s) (_:os) = addNewFunctions (t, s) os
 addNewTypes :: [Type] -> [RosettaObject] -> [Type]
 addNewTypes l [] = l
 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

 -- |Parses any supported Rosetta types into a list of RosettaObject
--- a/resources/Types/testType8.rosetta
+++ b/resources/Types/testType8.rosetta
@@ -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">
--- a/src/Model/Type.hs
+++ b/src/Model/Type.hs
@@ -5,7 +5,7 @@ import Data.Time.LocalTime()
 -- |The representation of a Rosetta data type
 data Type = MakeType {
        typeName :: String,
-        superType :: Maybe Type,
+        superType :: Type,
        typeDescription :: Maybe String,
        typeAttributes :: [TypeAttribute]
    }
@@ -49,6 +49,23 @@ instance Eq Cardinality where
    (==) (OneBound x) (OneBound y) = x == y
    (==) NoBounds NoBounds = True
    (==) _ _ = 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 (MakeTypeAttribute _ typ crd _) = (typ, crd)
--- a/src/Parser/Function.hs
+++ b/src/Parser/Function.hs
@@ -52,5 +52,5 @@ attributeParser =
        typ <- try (pascalNameParser <|> camelNameParser)
        crd <- cardinalityParser
        desc <- optional descriptionParser
-        return $ MakeTypeAttribute nam (MakeType typ Nothing Nothing []) crd desc
+        return $ MakeTypeAttribute nam (MakeType typ (BasicType "Object") Nothing []) crd desc
        
--- a/src/Parser/Type.hs
+++ b/src/Parser/Type.hs
@@ -5,6 +5,7 @@ module Parser.Type where
 import Model.Type
 import Text.Megaparsec.Char
 import Text.Megaparsec
+import Data.Maybe
 import Parser.General 
  
 -- |Parses a type declaration statement in Rosetta into an Type
@@ -16,7 +17,7 @@ typeParser =
        _ <- lexeme $ char ':'
        tDescription <- optional descriptionParser
        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
 superTypeParser :: Parser Type
@@ -24,7 +25,7 @@ superTypeParser =
    do
        _ <- lexeme $ string "extends"
        name <- pascalNameParser 
-        return $ MakeType name Nothing Nothing []
+        return $ MakeType name (BasicType "Object") Nothing []

 -- |Parses a declared type attribute in Rosetta into a TypeAttribute
 typeAttributeParser :: Parser TypeAttribute
@@ -34,7 +35,7 @@ typeAttributeParser =
        aType <- try nameParser
        card <- cardinalityParser
        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
 cardinalityParser :: Parser Cardinality
--- a/src/PrettyPrinter/Type.hs
+++ b/src/PrettyPrinter/Type.hs
@@ -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 name super:attributes))
-printType (MakeType _ (Just (BasicType _)) _ _) = error "Can't extend basic types"
-printType (MakeType name Nothing description attributes) =
+printType (MakeType name (MakeType super _ _ _) description attributes) = printType (MakeType name (BasicType "Object") description (superToAttribute name super:attributes))
+printType (MakeType name (BasicType "Object") description attributes) =
    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
   
 -- |Creates an attribute that accesses the super type
 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 
 printAttributes :: [TypeAttribute] -> [Doc a]
--- a/src/Semantic/ExpressionChecker.hs
+++ b/src/Semantic/ExpressionChecker.hs
@@ -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])
 -- |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)
-    | 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
            -- |The if without else statement always has a cardinality lower bound of 0
            Right (typ, Bounds(_, x)) -> Right (typ, Bounds(0, x))
@@ -99,8 +99,11 @@ 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)
-    | 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)
+    | isLeft condType || isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1) = Left $ IfConditionNotBoolean $ show cond
+    | 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
    where   condType = checkExpression symbolMap cond
            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
 checkList :: [Symbol] -> [Expression] -> Either TypeCheckError (Type, Cardinality)
-checkList symbs exps
-    | isRight typ && fromRightUnsafe typ == (BasicType "Any", NoBounds) = Right (BasicType "Empty", Bounds (0, 0))
+checkList _ [] = Right (BasicType "Empty", Bounds(0, 0))
+checkList symbs (ex : exps)
+    | isRight typ = checkList1 symbs exps (fromRightUnsafe typ) 
    | otherwise = typ
-    where typ = checkList1 symbs exps (BasicType "Any", NoBounds) 
-
+    where typ = checkExpression symbs ex
+    
 -- |Auxiliary function for the check list function
 checkList1 :: [Symbol] -> [Expression] -> (Type, Cardinality) -> Either TypeCheckError (Type, Cardinality)
 checkList1 _ [] typ = Right typ
 checkList1 symbs (ex : exps) typ 
-    | isRight exTyp = exTyp
-    | isRight match = match
-    | otherwise = checkList1 symbs exps (fromRightUnsafe match)
+    | isLeft exTyp = exTyp
+    | not match = Left $ TypeMismatch (typeName $ fst typ) (typeName $ fst (fromRightUnsafe exTyp))
+    | otherwise = checkList1 symbs exps (fst typ, crd)
    where 
        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
 checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError (Type, Cardinality)] -> Either TypeCheckError (Type, Cardinality)
 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
+    | name == n && all isRight (zipWith typeIncluded a right) = Right r
    | otherwise = checkFunctionCall symbolMap name args
-    where right = rights args
+    where 
+        right = rights 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
-typeMatch :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError (Type, Cardinality)
-typeMatch (BasicType "Any", card1) (x, card2) 
-    | isRight card = Right (x, fromRightUnsafe card)
-    | otherwise = Left $ fromLeftUnsafe card
-    where card = cardinalityIncluded card2 card1
-typeMatch (BasicType "Double", card1) (BasicType "Integer", card2) 
-    | isRight card = Right (BasicType "Dobule", fromRightUnsafe card)
-    | otherwise = Left $ fromLeftUnsafe card
-    where card = cardinalityIncluded card2 card1
--typeMatch (s, card1) (BasicType s2, card2)
--    | s == BasicType s2 = case cardinalityIncluded card1 card2 of
--        Right card -> Right (s, card)
--        Left err -> Left err 
--    | otherwise = Left $ TypeMismatch (typeName s) s2
-typeMatch (s, card1) (s2, card2)
-    | s == s2 = case cardinalityIncluded card2 card1 of
-        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)
+typeMatch :: Type -> Type -> Either TypeCheckError Type
+-- |An object matches only with object
+typeMatch (BasicType "Object") _ = Right $ BasicType "Object"
+typeMatch _ (BasicType "Object") = Right $ BasicType "Object"
+-- |Any matches with any type
+typeMatch (BasicType "Any") x = Right x
+typeMatch x (BasicType "Any") = Right x
+-- |Integer can be a double
+typeMatch (BasicType "Integer") (BasicType "Double") = Right (BasicType "Double")
+typeMatch (BasicType "Double") (BasicType "Integer") = Right (BasicType "Double")
+-- |First check x with all the supertypes of y, then go higher on the supertypes of x and repeat
+typeMatch x y 
+    | x == y = Right x
+    | isRight match = Right $ fromRightUnsafe match 
+    | otherwise = typeMatch (superType x) y
+    where match = typeMatch x (superType y)
    
-- |Checks whether the first cardinality is included into the second one and returns the most restricted cardinality
-cardinalityIncluded :: Cardinality -> Cardinality -> Either TypeCheckError Cardinality
-cardinalityIncluded x NoBounds = Right x
-cardinalityIncluded NoBounds x = Left $ CardinalityMismatch NoBounds x
+-- |Checks whether the first argument is a subtype of the second argument
+isSubType :: Type -> Type -> Bool
+isSubType (BasicType "Integer") (BasicType "Double") = True
+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)
-    | x >= y = Right $ OneBound x
-    | otherwise = Left $ CardinalityMismatch (OneBound x) (OneBound y)
-cardinalityIncluded (Bounds (x1, x2)) (OneBound y)
-    | x1 >= y = Right $ Bounds (x1, x2)
-    | otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (OneBound y)
-cardinalityIncluded (OneBound x) (Bounds (y1, y2)) = Left $ CardinalityMismatch (OneBound x) (Bounds (y1, y2))
+    | x >= y = True
+    | otherwise = False
+cardinalityIncluded (Bounds (x1, _)) (OneBound y)
+    | x1 >= y = True
+    | otherwise = False
+cardinalityIncluded (OneBound _) (Bounds (_, _)) = False
 cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2))
-    | x1 >= y1 && x2 <= y2 = Right $ Bounds (x1, x2)
-    | otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (Bounds (y1, y2))
+    | x1 >= y1 && x2 <= y2 = True
+    | otherwise = False

 -- |Looks in the symbol map for the type of a variable
 findVarType :: String -> [Symbol] -> Either TypeCheckError (Type, Cardinality)
--- a/src/Semantic/FunctionChecker.hs
+++ b/src/Semantic/FunctionChecker.hs
@@ -7,11 +7,11 @@ 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
+-- |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 (definedTypes, symbols) (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
+        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
            Left err -> Left [err] 
    | otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx]
--- a/src/Semantic/TypeChecker.hs
+++ b/src/Semantic/TypeChecker.hs
@@ -18,20 +18,22 @@ 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) = case checkSuper definedTypes super of
-        Right superChecked -> Right $ MakeType name superChecked desc (rights checkedAttr)
+    | null (lefts checkedAttr) = case populateSuper definedTypes definedTypes super of
+        Right superPopulated -> Right $ MakeType name superPopulated desc (rights checkedAttr)
        Left err -> Left [err]
    | otherwise = Left $ lefts checkedAttr  
    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)
+populateSuper :: [Type] -> [Type] -> Type -> Either TypeCheckError Type
+populateSuper _ _ (BasicType "Object") = Right (BasicType "Object")
+populateSuper _ _ (BasicType _) = Left $ UndefinedType "Can't extend basic types"
+populateSuper _ [] t = Left $ UndefinedType (typeName t)
+populateSuper allTypes (currType : types) (MakeType t super d a) 
+    | typeName currType == typeName super = case populateSuper allTypes allTypes currType of
+        Right superChecked -> Right $ MakeType t superChecked d a
        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
 checkAttributes :: [Type] -> [TypeAttribute] -> [Either TypeCheckError TypeAttribute]
--- a/test/Parser/ExpressionSpec.hs
+++ b/test/Parser/ExpressionSpec.hs
@@ -40,7 +40,9 @@ spec = do

 exps :: [Expression]
 exps = [
+    -- 1
    InfixExp "+" (Int "1") (Parens (InfixExp "-" (Int "2") (Int "3"))),
+    -- 2
    InfixExp "=" 
        (InfixExp "-" 
            (InfixExp "-" 
@@ -52,17 +54,27 @@ exps = [
                (InfixExp "*" (Variable "g") (Variable "h"))
                (InfixExp "*" (Variable "i") (Variable "j")))
            (InfixExp "*" (Variable "k") (Variable "l"))),
+    -- 3
    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"),
+    -- 5
    List [Int "1", Int "2", Int "3"],
+    -- 6
    List [Int "1", InfixExp "+" (Int "2") (Int "3"), Variable "e"],
+    -- 7
    Function "Function" [],
+    -- 8
    Function "Function" [Variable "e"],
+    -- 9
    Function "Function" [Int "3", InfixExp "+" (Int "3") (Int "2"), Variable "e"],
+    -- 10
    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"))))
         (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")))),
+    -- 12
    InfixExp "or" (Variable "a") (Variable "b")
  ]
                
--- a/test/Parser/TypeSpec.hs
+++ b/test/Parser/TypeSpec.hs
@@ -36,42 +36,42 @@ types :: [Type]
 types = [
    MakeType {typeName = "Period",
        typeDescription = Just "description",
-        superType = Nothing,
-        typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" Nothing Nothing [], cardinality = Bounds(1, 1), 
+        superType = MakeType "Something" (BasicType "Object") Nothing [],
+        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."},
-            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"},
-            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"},
-            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"},
-            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"}]},
            
    MakeType {typeName = "TestType",
        typeDescription = Nothing,
-        superType = Nothing,
-        typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" Nothing Nothing [], cardinality = Bounds(1, 1), 
+        superType = BasicType "Object",
+        typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1), 
            attributeDescription = Nothing}]},
        
        
    MakeType {typeName = "TestSomeType",
        typeDescription = Just "description",
-        superType = Nothing,
-        typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" Nothing Nothing [], cardinality = Bounds(1, 1), 
+        superType = BasicType "Object",
+        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."}]},
        
        
    MakeType {typeName = "TestZeroOneType",
        typeDescription = Nothing,
-        superType = Just $ MakeType "Period" Nothing Nothing [],
-        typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" Nothing Nothing [], cardinality = Bounds(1, 1), 
+        superType = MakeType "Period" (BasicType "Object") Nothing [],
+        typeAttributes = [MakeTypeAttribute {attributeName = "periodMultiplier", attributeType = MakeType "int" (BasicType "Object") Nothing [], cardinality = Bounds(1, 1), 
            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 = []}

    ]