Added cardinality to type checking

resources/testAll.rosetta

@@ -24,11 +24,11 @@ type ObservationPrimitive:
 func EquityPriceObservation: <"Function specification for the observation of an equity price, based on the attributes of the 'EquityValuation' class.">
    inputs:
       equity int (1..1)
-      valuationDate int (1..1)
+      valuationDate ObservationPrimitive (1..1)
       valuationTime int (0..1)
       timeType TestType (0..1)
       determinationMethod ObservationPrimitive (1..*)
    output:
-      observation ObservationPrimitive (1..1)
+      observation ObservationPrimitive (0..1)
 
    assign-output: if equity exists then valuationDate

src/Model/Type.hs

@@ -40,4 +40,15 @@ data Cardinality =
   | OneBound Integer
     -- |The cardinality of no bounds (ex. * - *)
   | NoBounds 
-  deriving Show
+  deriving Show
+  
+instance Eq Cardinality where
+    (==) (Bounds (x1, x2)) (Bounds (y1, y2))
+        | x1 == y1 && x2 == y2 = True
+        | otherwise = False
+    (==) (OneBound x) (OneBound y) = x == y
+    (==) NoBounds NoBounds = True
+    (==) _ _ = False
+  
+typeAndCardinality :: TypeAttribute -> (Type, Cardinality)
+typeAndCardinality (MakeTypeAttribute _ typ crd _) = (typ, crd)

src/Semantic/ExpressionChecker.hs

@@ -9,55 +9,57 @@ import Semantic.TypeChecker
 -- |A declared variable or function
 data Symbol = Var{
    varName :: String,
-   declaredType :: Type
+   declaredType :: Type,
+   cardinality :: Cardinality
    }
    | Func {
    funcName :: String,
-   argsType :: [Type],
+   argsType :: [(Type, Cardinality)],
-   returnType :: Type
+   returnType :: (Type, Cardinality)
-   }
+   } deriving (Show)
+  
   
 -- |A map of the predefined functions, their arguments and their return type
 defaultMap :: [Symbol]
 defaultMap = [
-  Func "or" [BasicType "Boolean", BasicType "Boolean"] (BasicType "Boolean"),
+  Func "or" [(BasicType "Boolean", Bounds (1, 1)), (BasicType "Boolean", Bounds (1, 1))] (BasicType "Boolean", Bounds (1, 1)),
-  Func "and" [BasicType "Boolean", BasicType "Boolean"] (BasicType "Boolean"),
+  Func "and" [(BasicType "Boolean", Bounds (1, 1)), (BasicType "Boolean", Bounds (1, 1))] (BasicType "Boolean", Bounds (1, 1)),
-  Func "exists" [BasicType "Any"] (BasicType "Boolean"),
+  Func "exists" [(BasicType "Any", Bounds (0, 1))] (BasicType "Boolean", Bounds(1, 1)),
-  Func "is absent" [BasicType "Any"] (BasicType "Boolean"),
+  Func "is absent" [(BasicType "Any", Bounds (0, 1))] (BasicType "Boolean", Bounds (1, 1)),
-  Func "single exists" [BasicType "Any"] (BasicType "Boolean"),
+  Func "single exists" [(BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)),
-  Func "multiple exists" [BasicType "Any"] (BasicType "Boolean"),
+  Func "multiple exists" [(BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)),
-  Func "contains" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "contains" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)),
-  Func "disjoint" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "disjoint" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)),
   
-  Func "=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "=" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
-  Func ">=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func ">=" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
-  Func "<=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "<=" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
-  Func "<>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "<>" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
-  Func ">" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func ">" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
-  Func "<" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "<" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
-  Func "all =" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "all =" [(BasicType "Any", NoBounds), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
-  Func "all <>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "all <>" [(BasicType "Any", NoBounds), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
-  Func "any =" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "any =" [(BasicType "Any", NoBounds), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
-  Func "any <>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "any <>" [(BasicType "Any", NoBounds), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
   
-  Func "+" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "+" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
-  Func "+" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  Func "+" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),
-  Func "-" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "-" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
-  Func "-" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  Func "-" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),
-  Func "*" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "*" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
-  Func "*" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  Func "*" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),
-  Func "/" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "/" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
-  Func "/" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  Func "/" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),
-  Func "^" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "^" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)),
-  Func "^" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  Func "^" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)),
   
-  Func "count" [BasicType "Any"] (BasicType "Integer")
+  Func "count" [(BasicType "Any", NoBounds)] (BasicType "Integer", Bounds (1, 1))
   ]
 
 -- |Checks whether a function is valid (inputs, outputs are of valid type and all variables are defined) and adds it to the symbol table
 addFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] [Symbol]
 addFunction (definedTypes, definedSymbols) (MakeFunction name _ inps out _)
-    | null (lefts checkedInputs) && isRight checkedOutput = Right $ Func name (map attributeType (rights checkedInputs)) (attributeType $ fromRightUnsafe checkedOutput) : allSymbols
+    | null (lefts checkedInputs) && isRight checkedOutput = Right $ Func name (map typeAndCardinality (rights checkedInputs)) (attributeType $ fromRightUnsafe checkedOutput, Model.Type.cardinality out) : allSymbols
     | isLeft checkedOutput = Left [fromLeftUnsafe checkedOutput]
     | otherwise = Left $  lefts checkedInputs 
     where 
@@ -68,15 +70,15 @@ addFunction (definedTypes, definedSymbols) (MakeFunction name _ inps out _)
 -- |Adds a newly defined variable to the symbol table
 addVariables :: [Symbol] -> [TypeAttribute] -> [Symbol]
 addVariables s [] = s
-addVariables s ((MakeTypeAttribute name typ _ _)  : vars) = Var name typ : addVariables s vars
+addVariables s ((MakeTypeAttribute name typ crd _)  : vars) = Var name typ crd : addVariables s vars
         
 -- |Checks the type of a given expression
-checkExpression :: [Symbol] -> Expression -> Either TypeCheckError Type
+checkExpression :: [Symbol] -> Expression -> Either TypeCheckError (Type, Cardinality)
 checkExpression symbolMap (Variable var) = findVarType var symbolMap
-checkExpression _ (Int _) = Right $ BasicType "Integer"
+checkExpression _ (Int _) = Right (BasicType "Integer", Bounds (1, 1))
-checkExpression _ (Real _) = Right $ BasicType "Double"
+checkExpression _ (Real _) = Right (BasicType "Double", Bounds (1, 1))
-checkExpression _ (Boolean _) = Right $ BasicType "Boolean"
+checkExpression _ (Boolean _) = Right (BasicType "Boolean", Bounds (1, 1))
-checkExpression _ Empty = Right $ BasicType "Empty"
+checkExpression _ Empty = Right (BasicType "Empty", Bounds (0, 0))
 checkExpression symbolMap (Parens ex) = checkExpression symbolMap ex
 checkExpression symbolMap (List lst) = checkList symbolMap lst 
 checkExpression symbolMap (PrefixExp name ex) = checkFunctionCall symbolMap name [checkExpression symbolMap ex]
@@ -85,27 +87,35 @@ 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")) = checkExpression symbolMap ex
+    | isRight condType && isRight (typeMatch (fromRightUnsafe condType) (BasicType "Boolean", Bounds (1, 1))) = 
-    | otherwise = Left IfConditionNotBoolean
+        case checkedExp of
-    where condType = checkExpression symbolMap cond
+            -- |The if without else statement always has a cardinality lower bound of 0
+            Right (typ, Bounds(_, x)) -> Right (typ, Bounds(0, x))
+            -- |The unbounded or semi-bounded cardinalities already have 0 included
+            Right x -> Right x
+            Left err -> Left err
+    | otherwise = Left $ IfConditionNotBoolean $ show condType ++ " | " ++ show (getVars symbolMap)
+    where 
+        condType = checkExpression symbolMap cond
+        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")) = Left IfConditionNotBoolean 
+    | 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
+    | isRight ex1Type || isRight ex2Type || isRight (typeMatch (fromRightUnsafe ex1Type) (fromRightUnsafe ex2Type)) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2)
     | otherwise = ex1Type
     where   condType = checkExpression symbolMap cond
             ex1Type = checkExpression symbolMap ex1
             ex2Type = checkExpression symbolMap ex2
 
 -- |Checks that all the expressions in a list have compatible types
-checkList :: [Symbol] -> [Expression] -> Either TypeCheckError Type
+checkList :: [Symbol] -> [Expression] -> Either TypeCheckError (Type, Cardinality)
 checkList symbs exps
-    | isRight typ && fromRightUnsafe typ == BasicType "Any" = Right $ BasicType "Empty"
+    | isRight typ && fromRightUnsafe typ == (BasicType "Any", NoBounds) = Right (BasicType "Empty", Bounds (0, 0))
     | otherwise = typ
-    where typ = checkList1 symbs exps (BasicType "Any") 
+    where typ = checkList1 symbs exps (BasicType "Any", NoBounds) 
 
 -- |Auxiliary function for the check list function
-checkList1 :: [Symbol] -> [Expression] -> Type -> Either TypeCheckError Type
+checkList1 :: [Symbol] -> [Expression] -> (Type, Cardinality) -> Either TypeCheckError (Type, Cardinality)
 checkList1 _ [] typ = Right typ
 checkList1 symbs (ex : exps) typ 
     | isRight exTyp = exTyp
@@ -116,10 +126,10 @@ checkList1 symbs (ex : exps) typ
         match = typeMatch typ (fromRightUnsafe exTyp)
 
 -- |Checks whether the function that is called is already defined with the same argument types
-checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError Type] -> Either TypeCheckError Type
+checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError (Type, Cardinality)] -> Either TypeCheckError (Type, Cardinality)
-checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ concatMap typeName (rights args) ++ "]"
+checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ concatMap (typeName . fst) (rights args) ++ "]"
 checkFunctionCall ((Func n a r):symbolMap) name args
-    | length right /= length args = Left $ ErrorInsideFunction (name ++ ": " ++ show args)
+    | length right /= length args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args))
     | name == n && all isRight (zipWith typeMatch a right) = Right r
     | otherwise = checkFunctionCall symbolMap name args
     where right = rights args
@@ -127,21 +137,46 @@ checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name arg
 
 --Try to match 2nd type to first type
 -- |Checks whether two types are compatible
-typeMatch :: Type -> Type -> Either TypeCheckError Type
+typeMatch :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError (Type, Cardinality)
-typeMatch (BasicType "Any") x = Right x
+typeMatch (BasicType "Any", card1) (x, card2) 
-typeMatch (BasicType "Double") (BasicType "Integer") = Right $ BasicType "Dobule"
+    | isRight card = Right (x, fromRightUnsafe card)
-typeMatch s (BasicType s2)
+    | otherwise = Left $ fromLeftUnsafe card
-    | s == BasicType s2 = Right s
+    where card = cardinalityIncluded card2 card1
-    | otherwise = Left $ TypeMismatch (typeName s) s2
+typeMatch (BasicType "Double", card1) (BasicType "Integer", card2) 
-typeMatch s s2
+    | isRight card = Right (BasicType "Dobule", fromRightUnsafe card)
-    | s == s2 = Right s
+    | otherwise = Left $ fromLeftUnsafe card
-    | isJust $ superType s2 = typeMatch s (fromJust $ superType s2)
+    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)
+    
+-- |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
+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))
+cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2))
+    | x1 >= y1 && x2 <= y2 = Right $ Bounds (x1, x2)
+    | otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (Bounds (y1, y2))
 
 -- |Looks in the symbol map for the type of a variable
-findVarType :: String -> [Symbol] -> Either TypeCheckError Type
+findVarType :: String -> [Symbol] -> Either TypeCheckError (Type, Cardinality)
 findVarType var [] = Left $ UndefinedVariable var
-findVarType x ((Var name typ):symbols) 
+findVarType x ((Var name typ crd):symbols) 
-    | x == name = Right typ
+    | x == name = Right (typ, crd)
     | otherwise = findVarType x symbols
 findVarType x (_:symbols) = findVarType x symbols

src/Semantic/FunctionChecker.hs

@@ -9,7 +9,10 @@ import Data.Either
 -- |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) = Right $ MakeFunction name desc (rights checkedIn) (fromRightUnsafe checkedOut) 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
+            Left err -> Left [err] 
     | otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx]
         where 
             checkedEx = checkExpression definedFunctions ex

src/Semantic/TypeChecker.hs

@@ -6,12 +6,13 @@ import Data.Either
 -- |A datatype for the different types of type check errors
 data TypeCheckError =
    UndefinedType String
-   | IfConditionNotBoolean
+   | IfConditionNotBoolean String
-   | IfExpressionsDifferentTypes
+   | IfExpressionsDifferentTypes String String
    | UndefinedFunction String
    | ErrorInsideFunction String
    | UndefinedVariable String
    | TypeMismatch String String
+   | CardinalityMismatch Cardinality Cardinality
    deriving (Show)
 
 -- |Checks whether a data type is valid