From 9210c78beb8c592745442cf3885debaf96ffe4ce Mon Sep 17 00:00:00 2001 From: macocianradu Date: Wed, 1 Dec 2021 01:40:26 +0100 Subject: [PATCH] Added cardinality to type checking --- resources/testAll.rosetta | 4 +- src/Model/Type.hs | 13 ++- src/Semantic/ExpressionChecker.hs | 163 ++++++++++++++++++------------ src/Semantic/FunctionChecker.hs | 5 +- src/Semantic/TypeChecker.hs | 5 +- 5 files changed, 120 insertions(+), 70 deletions(-) diff --git a/resources/testAll.rosetta b/resources/testAll.rosetta index 292504f..8a04822 100644 --- a/resources/testAll.rosetta +++ b/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 \ No newline at end of file diff --git a/src/Model/Type.hs b/src/Model/Type.hs index ce9d8da..77323d9 100644 --- a/src/Model/Type.hs +++ b/src/Model/Type.hs @@ -40,4 +40,15 @@ data Cardinality = | OneBound Integer -- |The cardinality of no bounds (ex. * - *) | NoBounds - deriving Show \ No newline at end of file + 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) \ No newline at end of file diff --git a/src/Semantic/ExpressionChecker.hs b/src/Semantic/ExpressionChecker.hs index c974419..bf89bcf 100644 --- a/src/Semantic/ExpressionChecker.hs +++ b/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], - returnType :: Type - } + argsType :: [(Type, Cardinality)], + 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 "and" [BasicType "Boolean", BasicType "Boolean"] (BasicType "Boolean"), - Func "exists" [BasicType "Any"] (BasicType "Boolean"), - Func "is absent" [BasicType "Any"] (BasicType "Boolean"), - Func "single exists" [BasicType "Any"] (BasicType "Boolean"), - Func "multiple exists" [BasicType "Any"] (BasicType "Boolean"), - Func "contains" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func "disjoint" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), + Func "or" [(BasicType "Boolean", Bounds (1, 1)), (BasicType "Boolean", Bounds (1, 1))] (BasicType "Boolean", Bounds (1, 1)), + Func "and" [(BasicType "Boolean", Bounds (1, 1)), (BasicType "Boolean", Bounds (1, 1))] (BasicType "Boolean", Bounds (1, 1)), + Func "exists" [(BasicType "Any", Bounds (0, 1))] (BasicType "Boolean", Bounds(1, 1)), + Func "is absent" [(BasicType "Any", Bounds (0, 1))] (BasicType "Boolean", Bounds (1, 1)), + Func "single exists" [(BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)), + Func "multiple exists" [(BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)), + Func "contains" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)), + Func "disjoint" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)), - Func "=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func ">=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func "<=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func "<>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func ">" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func "<" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func "all =" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func "all <>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func "any =" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), - Func "any <>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"), + Func "=" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)), + Func ">=" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)), + Func "<=" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)), + Func "<>" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)), + Func ">" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)), + Func "<" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)), + Func "all =" [(BasicType "Any", NoBounds), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)), + Func "all <>" [(BasicType "Any", NoBounds), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)), + Func "any =" [(BasicType "Any", NoBounds), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)), + Func "any <>" [(BasicType "Any", NoBounds), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)), - Func "+" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"), - Func "+" [BasicType "Double", BasicType "Double"] (BasicType "Double"), - Func "-" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"), - Func "-" [BasicType "Double", BasicType "Double"] (BasicType "Double"), - Func "*" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"), - Func "*" [BasicType "Double", BasicType "Double"] (BasicType "Double"), - Func "/" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"), - Func "/" [BasicType "Double", BasicType "Double"] (BasicType "Double"), - Func "^" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"), - Func "^" [BasicType "Double", BasicType "Double"] (BasicType "Double"), + Func "+" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)), + Func "+" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)), + Func "-" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)), + Func "-" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)), + Func "*" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)), + Func "*" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)), + Func "/" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)), + Func "/" [(BasicType "Double", Bounds (1, 1)), (BasicType "Double", Bounds (1, 1))] (BasicType "Double", Bounds (1, 1)), + Func "^" [(BasicType "Integer", Bounds (1, 1)), (BasicType "Integer", Bounds (1, 1))] (BasicType "Integer", Bounds (1, 1)), + 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 _ (Real _) = Right $ BasicType "Double" -checkExpression _ (Boolean _) = Right $ BasicType "Boolean" -checkExpression _ Empty = Right $ BasicType "Empty" +checkExpression _ (Int _) = Right (BasicType "Integer", Bounds (1, 1)) +checkExpression _ (Real _) = Right (BasicType "Double", Bounds (1, 1)) +checkExpression _ (Boolean _) = Right (BasicType "Boolean", Bounds (1, 1)) +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 - | otherwise = Left IfConditionNotBoolean - where condType = checkExpression symbolMap cond + | isRight condType && isRight (typeMatch (fromRightUnsafe condType) (BasicType "Boolean", 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)) + -- |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 ex1Type || isRight ex2Type || isRight (typeMatch (fromRightUnsafe ex1Type) (fromRightUnsafe ex2Type)) = Left IfExpressionsDifferentTypes + | 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) | 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 [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ concatMap typeName (rights args) ++ "]" +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 ((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 (BasicType "Any") x = Right x -typeMatch (BasicType "Double") (BasicType "Integer") = Right $ BasicType "Dobule" -typeMatch s (BasicType s2) - | s == BasicType s2 = Right s - | otherwise = Left $ TypeMismatch (typeName s) s2 -typeMatch s s2 - | s == s2 = Right s - | isJust $ superType s2 = typeMatch s (fromJust $ superType s2) +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) + +-- |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) - | x == name = Right typ +findVarType x ((Var name typ crd):symbols) + | x == name = Right (typ, crd) | otherwise = findVarType x symbols findVarType x (_:symbols) = findVarType x symbols \ No newline at end of file diff --git a/src/Semantic/FunctionChecker.hs b/src/Semantic/FunctionChecker.hs index d87bfab..adfb4b7 100644 --- a/src/Semantic/FunctionChecker.hs +++ b/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 diff --git a/src/Semantic/TypeChecker.hs b/src/Semantic/TypeChecker.hs index 21b9b4b..9aff846 100644 --- a/src/Semantic/TypeChecker.hs +++ b/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 - | IfExpressionsDifferentTypes + | IfConditionNotBoolean String + | IfExpressionsDifferentTypes String String | UndefinedFunction String | ErrorInsideFunction String | UndefinedVariable String | TypeMismatch String String + | CardinalityMismatch Cardinality Cardinality deriving (Show) -- |Checks whether a data type is valid