Changed to explicit functions

(idk if work, still need to add printing)

src/Model/Function.hs

@@ -1,14 +1,26 @@
 module Model.Function where
 
-import Model.Type (TypeAttribute, Expression)
+import Model.Type (TypeAttribute, Expression, ExplicitExpression)
   
--- |The representation of a Rosetta function type
+data FunctionSignature = 
-data Function = 
+    MakeFunctionSignature {
-    MakeFunction {
         functionName :: String,
         functionDescription :: Maybe String,
         inputParameters :: [TypeAttribute],
-        outputParameter :: TypeAttribute,
+        outputParameter :: TypeAttribute
+    }
+    deriving (Show)
+
+-- |The representation of a Rosetta function type
+data Function = 
+    MakeFunction {
+        signature :: FunctionSignature,
         assignment :: Expression
     }
-    deriving (Show)
+    deriving (Show)
+
+data ExplicitFunction = 
+    MakeExplicitFunction {
+        sign :: FunctionSignature,
+        explicitAssignment :: ExplicitExpression 
+    }

src/Model/Type.hs

@@ -1,5 +1,4 @@
 module Model.Type where
-
 -- |The representation of a Rosetta data type
 data Type = MakeType {
         typeName :: String,
@@ -14,9 +13,9 @@ data Type = MakeType {
     deriving (Show)
 
 instance Eq Type where
-    (==) (MakeType name _ _ _ _) (MakeType name2 _ _ _ _) 
+    (==) (MakeType name _ _ _ _) (MakeType name2 _ _ _ _)
         | name == name2 = True
-        | otherwise = False 
+        | otherwise = False
     (==) (BasicType name) (BasicType name2)
         | name == name2 = True
         | otherwise = False
@@ -27,7 +26,7 @@ data Condition = MakeCondition {
     conditionDescription :: Maybe String,
     expressionExpression :: Expression
 } deriving (Show)
-     
+
 -- |The representation of an expression
 data Expression = Variable String
     | Int String
@@ -44,6 +43,31 @@ data Expression = Variable String
     | IfElse Expression Expression Expression
     deriving (Eq, Show)
 
+data ExplicitExpression = ExplicitEmpty
+    | ExplicitVariable {name :: String, returnCoercion :: Coercion}
+    | Value {returnCoercion :: Coercion}
+    | ExplicitList [ExplicitExpression]
+    | ExplicitParens ExplicitExpression
+    | ExplicitFunction {name :: String, args :: [Coercion], returnCoercion :: Coercion}
+    | ExplicitIfSimple {cond :: Coercion, returnCoercion :: Coercion}
+    | ExplicitIfEsle {cond :: Coercion, args :: [Coercion], returnCoercion :: Coercion}
+    deriving (Show)
+
+data TypeCoercion =
+    MakeIdCoercion {toType :: Type}
+    | MakeSuperCoercion {fromType :: Type, toType :: Type}
+    | MakeTypeCoercion {fromType :: Type, toType :: Type, transformType :: String}
+    deriving (Show)
+
+data CardinalityCoercion =
+    MakeCardinalityIdCoercion {toCardinality :: Cardinality}
+    | MakeCardinalityCoercion {fromCardinality :: Cardinality, toCardinality :: Cardinality, transformCardinality :: String}
+    deriving (Show)
+
+-- |Used to handle polymorphism in Rosetta
+data Coercion = MakeCoercion {typeCoercion :: [TypeCoercion], cardinalityCoercion :: CardinalityCoercion} deriving(Show)
+
+
 -- |The representation of an attribute of a data type
 data TypeAttribute = MakeTypeAttribute {
     attributeName :: String,
@@ -53,27 +77,22 @@ data TypeAttribute = MakeTypeAttribute {
 } deriving (Show)
 
 -- |The representation of cardinality
-data Cardinality = 
+data Cardinality =
     -- |The cardinality between two bounds (ex. 2 - 5)
   Bounds (Integer, Integer)
     -- |The cardinality starting from one bound until infinity (ex. 5 - *)
   | OneBound Integer
-    -- |The cardinality of no bounds (ex. * - *)
-  | NoBounds 
   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
 
 -- |Function to create the smallest cardinality that includes two others
 smallestBound  :: Cardinality -> Cardinality -> Cardinality
-smallestBound NoBounds _ = NoBounds
-smallestBound _ NoBounds = NoBounds
 smallestBound (OneBound x) (OneBound y) = OneBound $ min x y
 smallestBound (OneBound x) (Bounds (y, _)) = smallestBound (OneBound x) (OneBound y)
 smallestBound (Bounds (x, _)) (OneBound y) = smallestBound (OneBound x) (OneBound y)
@@ -83,53 +102,34 @@ smallestBound (Bounds (x1, x2)) (Bounds (y1, y2)) = Bounds (min x1 y1, max x2 y2
 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)
 
-    
--- |Checks whether the first argument is a subtype of the second argument
-isSubType :: Type -> Type -> Bool
-isSubType (BasicType "Integer") (BasicType "Double") = True
-isSubType _ (BasicType "Object") = True
-isSubType _ (BasicType "Any") = False
-isSubType (BasicType x) y 
-    | x == typeName y = True
-    | otherwise = False
-isSubType x y 
-    | typeName x == typeName 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 = 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 = True
-    | otherwise = False
-
 toHaskell :: Type -> Type
 toHaskell a
     | typeName a == "int" = BasicType "Integer"
     | typeName a == "boolean" = BasicType "Boolean"
     | typeName a == "real" = BasicType "Double"
-    | otherwise = a
+    | otherwise = a
+
+coercionType :: [TypeCoercion] -> Type
+coercionType [] = BasicType "Empty"
+coercionType [x] = toType x 
+coercionType (x:rst) = coercionType rst
+
+-- |Gets the final cardinality from a list of coercions
+coercionCardinality :: [CardinalityCoercion] -> Cardinality
+coercionCardinality [] = OneBound 0
+coercionCardinality [x] = toCardinality x
+coercionCardinality (x:rst) = coercionCardinality rst
+
+createCoercion :: (Type, Cardinality) -> Coercion
+createCoercion (t, c) = MakeCoercion [MakeIdCoercion t] (MakeCardinalityIdCoercion c)

src/Parser/Function.hs

@@ -20,7 +20,7 @@ functionParser =
         fDescription <- optional descriptionParser
         fInput <- inputAttributesParser
         fOutput <- outputAttributeParser
-        MakeFunction fName fDescription fInput fOutput <$> assignmentParser
+        MakeFunction (MakeFunctionSignature fName fDescription fInput fOutput) <$> assignmentParser
 
 -- |Parses the output assignment statement from a function in Rosetta into an Expression
 assignmentParser :: Parser Expression

src/Parser/Type.hs

@@ -44,7 +44,7 @@ typeAttributeParser =
 
 -- |Parses the cardinality of a type attribute in Rosetta into a Cardinality
 cardinalityParser :: Parser Cardinality
-cardinalityParser = try parseBounded <|> try parseSemiBounded <|> try parseUnbounded
+cardinalityParser = try parseBounded <|> try parseSemiBounded
 
 -- |Parser the condition of a type attribute in Rosetta into a Condition
 conditionParser :: Parser Condition 
@@ -74,13 +74,6 @@ parseSemiBounded =
         low <- lexeme $ many digitChar
         _ <- lexeme $ string "..*)"
         return $ OneBound $ read low
-        
--- |Parses an unbounded cardinality statement in Rosetta into a Cardinality
-parseUnbounded :: Parser Cardinality
-parseUnbounded = 
-    do
-        _ <- lexeme $ string "(*..*)"
-        return NoBounds
 
 -- |Parses the name of a type in Rosetta into a String
 typeNameParser :: Parser String

src/PrettyPrinter/Type.hs

@@ -37,7 +37,6 @@ printCardinality (MakeTypeAttribute _ typ (Bounds (x, y)) _)
     | x == 0 && y == 1 = "Maybe" <+> pretty (typeName typ)
     | x == 1 && y == 1 = pretty (typeName typ)
     | otherwise = "[" <> pretty (typeName typ) <> "]"
-printCardinality (MakeTypeAttribute _ typ NoBounds _) = "[" <> pretty (typeName typ) <> "]"
 printCardinality (MakeTypeAttribute _ typ (OneBound _) _) = "[" <> pretty (typeName typ) <> "]"
 
 printCondition :: Condition -> Doc a

src/Semantic/ExpressionChecker.hs

@@ -36,21 +36,21 @@ defaultMap = [
   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 "single exists" [(BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
-  Func "multiple exists" [(BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)),
+  Func "multiple exists" [(BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
-  Func "contains" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)),
+  Func "contains" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
-  Func "disjoint" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds (1, 1)),
+  Func "disjoint" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
   
-  Func "=" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
+  Func "=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
-  Func ">=" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
+  Func ">=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
-  Func "<=" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
+  Func "<=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
-  Func "<>" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
+  Func "<>" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
-  Func ">" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
+  Func ">" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
-  Func "<" [(BasicType "Any", NoBounds), (BasicType "Any", NoBounds)] (BasicType "Boolean", Bounds(1, 1)),
+  Func "<" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
-  Func "all =" [(BasicType "Any", NoBounds), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
+  Func "all =" [(BasicType "Any", OneBound 0), (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 "all <>" [(BasicType "Any", OneBound 0), (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", OneBound 0), (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", OneBound 0), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", 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)),
@@ -63,20 +63,21 @@ defaultMap = [
   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", NoBounds)] (BasicType "Integer", Bounds (1, 1))
+  Func "count" [(BasicType "Any", OneBound 0)] (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 _)
+addFunction (definedTypes, definedSymbols) (MakeFunction (MakeFunctionSignature name _ inps out) _) =
-    | null (lefts checkedInputs) && isRight checkedOutput = if name `elem` map funcName definedSymbols
+    case head $ checkAttributes definedTypes [out] of
-        then Left [MultipleDeclarations name]
+        Left err -> Left [err]
-        else Right $ Func name (map typeAndCardinality (rights checkedInputs)) (attributeType $ fromRightUnsafe checkedOutput, Model.Type.cardinality out) : definedSymbols
+        Right checkedOutput -> if null (lefts checkedInputs)
-    | isLeft checkedOutput = Left [fromLeftUnsafe checkedOutput]
+            then if name `elem` map funcName definedSymbols
-    | otherwise = Left $  lefts checkedInputs 
+                then Left [MultipleDeclarations name]
+                else Right $ Func name (map typeAndCardinality (rights checkedInputs)) (attributeType checkedOutput, Model.Type.cardinality out) : definedSymbols
+            else Left $ lefts checkedInputs
     where 
         checkedInputs = checkAttributes definedTypes inps
-        checkedOutput = head $ checkAttributes definedTypes [out]
         
 -- |Adds a newly defined variable to the symbol table
 addVariables :: [Symbol] -> [TypeAttribute] -> [Symbol]
@@ -84,76 +85,107 @@ addVariables s [] = s
 addVariables s ((MakeTypeAttribute name typ crd _)  : vars) = Var name (toHaskell typ) crd : addVariables s vars
         
 -- |Checks the type of a given expression
-checkExpression :: [Symbol] -> Expression -> Either TypeCheckError (Type, Cardinality)
+checkExpression :: [Symbol] -> Expression -> Either TypeCheckError ExplicitExpression  
-checkExpression symbolMap (Variable var) = findVarType var symbolMap
+checkExpression symbolMap (Variable var) = findVarType var symbolMap 
-checkExpression _ (Int _) = Right (BasicType "Integer", Bounds (1, 1))
+checkExpression _ (Int _) = Right $ Value $ MakeCoercion [MakeIdCoercion (BasicType "Integer")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
-checkExpression _ (Real _) = Right (BasicType "Double", Bounds (1, 1))
+checkExpression _ (Real _) = Right $ Value $ MakeCoercion [MakeIdCoercion (BasicType "Double")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
-checkExpression _ (Boolean _) = Right (BasicType "Boolean", Bounds (1, 1))
+checkExpression _ (Boolean _) = Right $ Value $ MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
-checkExpression _ Empty = Right (BasicType "Empty", Bounds (0, 0))
+checkExpression _ Empty = Right $ Value $ MakeCoercion [MakeIdCoercion (BasicType "Empty")] (MakeCardinalityIdCoercion (Bounds (0, 0)))
-checkExpression symbolMap (Parens ex) = checkExpression symbolMap ex
+checkExpression symbolMap (Parens ex) = 
+    case checkExpression symbolMap ex of
+        Left err -> Left err
+        Right exp -> Right $ ExplicitParens exp
 checkExpression symbolMap (List lst) = checkList symbolMap lst 
 checkExpression symbolMap (PrefixExp name ex) = checkFunctionCall symbolMap name [checkExpression symbolMap ex]
 checkExpression symbolMap (Function name exps) = checkFunctionCall symbolMap name (map (checkExpression symbolMap) exps)
 checkExpression symbolMap (PostfixExp name ex) = checkFunctionCall symbolMap name [checkExpression symbolMap ex]
 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)
+checkExpression symbolMap (IfSimple cond ex) =
-    | isRight condType && isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1) = 
+    case checkExpression symbolMap cond of
-        case checkedExp of
+        Left err -> Left $ IfConditionNotBoolean $ show err
-            Right (typ, Bounds(_, x)) -> Right (typ, Bounds(0, x))
+        Right condType -> case coercionType conditionPreCoercion `isSubType` BasicType "Boolean" of
-            Right x -> Right x
+            Left err -> Left $ IfConditionNotBoolean $ show cond ++ " :: " ++ show (coercionType conditionPreCoercion)
-            Left err -> Left err
+            Right condCoerce -> 
-    | otherwise = Left $ IfConditionNotBoolean $ show condType
+                case checkExpression symbolMap ex of
-    where 
+                    Left err -> Left err
-        condType = checkExpression symbolMap cond
+                    Right thenCoerce -> 
-        checkedExp = checkExpression symbolMap ex
+                        Right $ ExplicitIfSimple 
+                            (MakeCoercion (condCoerce ++ conditionPreCoercion) (cardinalityCoercion $ returnCoercion condType)) (returnCoercion thenCoerce)
+            where
+                conditionPreCoercion = typeCoercion $ returnCoercion condType
 -- |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 || not (isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1)) = Left $ IfConditionNotBoolean $ show cond ++ " :: " ++ show condType
+    case checkExpression symbolMap cond of
-    | otherwise = case checkExpression symbolMap ex1 of
+        Left err -> Left $ IfConditionNotBoolean $ show err
-        Left err -> Left $ ErrorInsideFunction $ show err
+        Right condType -> 
-        Right ex1Type -> case checkExpression symbolMap ex2 of
+            case coercionType conditionPreCoercion `isSubType` BasicType "Boolean" of
-            Left err -> Left $ ErrorInsideFunction $ show err
+                Left err -> Left $ IfConditionNotBoolean $ show cond ++ " :: " ++ show (coercionType conditionPreCoercion)
-            Right ex2Type -> Right (typeMatch (fst ex1Type) (fst ex2Type), smallestBound (snd ex1Type) (snd ex2Type))
+                Right condCoerce -> 
-    where   condType = checkExpression symbolMap cond
+                    case checkExpression symbolMap ex1 of
+                        Left err -> Left $ ErrorInsideFunction $ show err
+                        Right ex1Checked -> case checkExpression symbolMap ex2 of
+                            Left err -> Left $ ErrorInsideFunction $ show err
+                            Right ex2Checked -> Right $ ExplicitIfEsle 
+                                (MakeCoercion (condCoerce ++ conditionPreCoercion) (cardinalityCoercion $ returnCoercion condType)) 
+                                (returnCoercion ex1Checked : [returnCoercion ex2Checked]) (returnCoercion ex1Checked)
+                            --(typeMatch ex1Type ex2Type, smallestBound ex1Card ex2Type)
+            where
+                conditionPreCoercion = typeCoercion $ returnCoercion condType
+                
 
+-- |TODO Handle nested lists and lists with parens
 -- |Checks that all the expressions in a list have compatible types
-checkList :: [Symbol] -> [Expression] -> Either TypeCheckError (Type, Cardinality)
+checkList :: [Symbol] -> [Expression] -> Either TypeCheckError ExplicitExpression
-checkList _ [] = Right (BasicType "Empty", Bounds(0, 0))
+checkList _ [] = Right $ ExplicitList [ExplicitEmpty]
-checkList symbs (ex : exps)
+checkList symbs (ex : exps) =
-    | isRight typ = checkList1 symbs exps (fromRightUnsafe typ) 
+    case checkExpression symbs ex of
-    | otherwise = typ
+        Left err -> Left err
-    where typ = checkExpression symbs ex
+        Right x -> 
+            case checkList1 symbs exps (coercionType $ typeCoercion $ returnCoercion x, toCardinality $ cardinalityCoercion $ returnCoercion x) of
+                Left err -> Left err
+                Right exp -> Right $ ExplicitList exp
     
 -- |Auxiliary function for the check list function
-checkList1 :: [Symbol] -> [Expression] -> (Type, Cardinality) -> Either TypeCheckError (Type, Cardinality)
+checkList1 :: [Symbol] -> [Expression] -> (Type, Cardinality) -> Either TypeCheckError [ExplicitExpression]
-checkList1 _ [] typ = Right typ
+checkList1 _ [] typ = Right [ExplicitEmpty]
-checkList1 symbs (ex : exps) typ 
+checkList1 symbs (ex : exps) typ =
-    | isLeft exTyp = exTyp
+    case checkExpression symbs ex of
-    | sub = checkList1 symbs exps (fst typ, smallestBound (snd $ fromRightUnsafe exTyp) (snd typ))
+        Left err -> Left err
-    | sup = checkList1 symbs exps (fst $ fromRightUnsafe exTyp, smallestBound (snd $ fromRightUnsafe exTyp) (snd typ))
+        Right exCo -> 
-    | otherwise = Left $ TypeMismatch (typeName $ fst typ) (typeName $ fst (fromRightUnsafe exTyp))
+            case fst typ `isSubType` exTyp of
-    where 
+                Left err -> Left err
-        exTyp = checkExpression symbs ex 
+                Right _ -> 
-        sub = isSubType (fst typ) (fst (fromRightUnsafe exTyp))
+                    case checkList1 symbs exps (exTyp, smallestBound exCard (snd typ)) of
-        sup = isSubType (fst (fromRightUnsafe  exTyp)) (fst typ)
+                        Left err -> Left err
+                        Right explicitEx -> Right [ExplicitList explicitEx] 
+                where
+                    exTyp = coercionType $ typeCoercion $ returnCoercion exCo
+                    exCard = toCardinality $ cardinalityCoercion $ returnCoercion exCo
 
 -- |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 ExplicitExpression ] -> Either TypeCheckError ExplicitExpression  
 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))
+    | length (rights args) /= length args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args))
-    | name == n && all isRight (zipWith typeIncluded right a) = Right r
+    | name == n && all isRight coerce = Right $ ExplicitFunction name (rights coerce) (MakeCoercion [MakeIdCoercion (fst r)] (MakeCardinalityIdCoercion (snd r))) 
     | otherwise = checkFunctionCall symbolMap name args
     where 
-        right = rights args
+        argCoerce = map returnCoercion (rights args)
+        coerce = zipWith coercionIncluded argCoerce (map createCoercion a)
 checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args 
 
-typeIncluded :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError Bool
+typeIncluded :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError Coercion
-typeIncluded (t1, c1) (t2, c2)
+typeIncluded (t1, c1) (t2, c2) =
-    | t1 `isSubType` t2 && cardinalityIncluded c1 c2 = Right True
+    case t1 `isSubType` t2 of
-    | t1 `isSubType` t2 = Left $ CardinalityMismatch c1 c2
+        Left err -> Left err
-    | otherwise = Left $ TypeMismatch (typeName t1) (typeName t2)
+        Right typeCoercion ->
+            case c1 `cardinalityIncluded` c2 of
+                Left err -> Left err
+                Right cardCoercion -> Right $ MakeCoercion typeCoercion cardCoercion
+
+coercionIncluded :: Coercion -> Coercion -> Either TypeCheckError Coercion 
+coercionIncluded c1 c2 = (coercionType (typeCoercion c1), coercionCardinality [cardinalityCoercion c1]) `typeIncluded` (coercionType (typeCoercion c2), coercionCardinality [cardinalityCoercion c2])  
 
 -- |Finds the most specific super type of the two types
 typeMatch :: Type -> Type -> Type
@@ -163,18 +195,51 @@ typeMatch x (BasicType "Any") = x
 -- |Integer can be a double
 -- typeMatch (BasicType "Integer") (BasicType "Double") = BasicType "Double"
 -- typeMatch (BasicType "Double") (BasicType "Integer") = BasicType "Double"
-typeMatch x (BasicType y) 
+typeMatch x (BasicType y) =
-    | x `isSubType` BasicType y = x
+    case x `isSubType` BasicType y of
-    | otherwise = BasicType "Object"
+        Left err -> BasicType "Object"
+        Right _ -> BasicType y
 -- |First check x with all the supertypes of y, then go higher on the supertypes of x and repeat
-typeMatch x y
+typeMatch x y = case x `isSubType` y of
-    | x `isSubType` y = x
+        Left err -> typeMatch x (superType y)
-    | otherwise = typeMatch x (superType y)
+        Right _ -> y
 
 -- |Looks in the symbol map for the type of a variable
-findVarType :: String -> [Symbol] -> Either TypeCheckError (Type, Cardinality)
+findVarType :: String -> [Symbol] -> Either TypeCheckError ExplicitExpression  
 findVarType var [] = Left $ UndefinedVariable var
 findVarType x ((Var name typ crd):symbols)
-    | x == name = Right (typ, crd)
+    | x == name = Right $ ExplicitVariable x (MakeCoercion [MakeIdCoercion typ] (MakeCardinalityIdCoercion crd))
     | otherwise = findVarType x symbols
-findVarType x (_:symbols) = findVarType x symbols
+findVarType x (_:symbols) = findVarType x symbols
+
+-- |Checks whether the first argument is a subtype of the second argument
+isSubType :: Type -> Type -> Either TypeCheckError [TypeCoercion]
+isSubType (BasicType "Integer") (BasicType "Double") = Right [MakeTypeCoercion (BasicType "Integer") (BasicType "Double") "fromInteger"]
+isSubType (BasicType x) y 
+    | x == typeName y = Right [MakeTypeCoercion y y "id"]
+    | otherwise = Left $ TypeMismatch x (typeName y) 
+isSubType x y 
+    | typeName x == typeName y = Right [MakeTypeCoercion x y "id"]
+    | otherwise = case isSubType (superType x) y of
+        Left e -> Left e
+        Right transforms -> Right $ MakeTypeCoercion x y "super" : transforms
+
+-- |Checks whether the first cardinality is included into the second one 
+cardinalityIncluded :: Cardinality -> Cardinality -> Either TypeCheckError CardinalityCoercion
+-- |Special Cases
+cardinalityIncluded (Bounds (0, 0)) (Bounds (0, 1)) = Right $ MakeCardinalityCoercion (Bounds (0, 0)) (Bounds (0, 1)) "Nothing"
+cardinalityIncluded (Bounds (0, 0)) (OneBound 0) = Right $ MakeCardinalityCoercion (Bounds (0, 0)) (OneBound 0) "[]"
+cardinalityIncluded (Bounds (0, 1)) (OneBound 0) = Right $ MakeCardinalityCoercion (Bounds (0, 1)) (OneBound 0) "[Just]"
+cardinalityIncluded (Bounds (1, 1)) (Bounds (0, 1)) = Right $ MakeCardinalityCoercion (Bounds (0, 1)) (Bounds (0, 1)) "Just"
+cardinalityIncluded (Bounds (1, 1)) (OneBound 1) = Right $ MakeCardinalityCoercion (Bounds (0, 1)) (OneBound 1) "[]"
+-- |General
+cardinalityIncluded (OneBound x) (OneBound y)
+    | x >= y = Right $ MakeCardinalityCoercion (OneBound x) (OneBound y) "id"
+    | otherwise = Left $ CardinalityMismatch (OneBound x) (OneBound y)
+cardinalityIncluded (Bounds (x1, y1)) (OneBound y)
+    | x1 >= y = Right $ MakeCardinalityCoercion (Bounds (x1, y1)) (OneBound y) "id"
+    | otherwise = Left $ CardinalityMismatch (Bounds (x1, y1)) (OneBound y)
+cardinalityIncluded (OneBound x) (Bounds (x2, y2)) = Left $ CardinalityMismatch (OneBound x) (Bounds (x2, y2))
+cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2))
+    | x1 >= y1 && x2 <= y2 = Right $ MakeCardinalityCoercion (Bounds (x1, x2)) (Bounds (y1, y2)) "id"
+    | otherwise = Left $ CardinalityMismatch (Bounds (x1, x2)) (Bounds (y1, y2))

src/Semantic/FunctionChecker.hs

@@ -9,15 +9,17 @@ import Data.Char
 import Utils.Utils
 
 -- |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] ExplicitFunction
-checkFunction (definedTypes, symbols) (MakeFunction name desc inp out ex)
+checkFunction (definedTypes, symbols) (MakeFunction (MakeFunctionSignature name desc inp out) ex) =
-    | isRight checkedEx && isRight checkedOut && null (lefts checkedIn) = 
+    if null $ lefts checkedIn
-        case typeIncluded (fromRightUnsafe checkedEx) (attributeType $ fromRightUnsafe checkedOut, Model.Type.cardinality out) of
+        then
-            Right _ -> Right $ MakeFunction (toLower (head name) : tail name) desc (rights checkedIn) (fromRightUnsafe checkedOut) ex
+            case head $ checkAttributes definedTypes [out] of
-            Left err -> Left [err] 
+                Left err -> Left [err]
-    | otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx]
+                Right checkedOut -> case checkExpression (addVariables symbols inp) ex of
-        where 
+                    Left err -> Left [err]
-            checkedIn = checkAttributes definedTypes inp
+                    Right checkedEx -> case returnCoercion checkedEx `coercionIncluded` createCoercion (attributeType checkedOut, Model.Type.cardinality out) of
-            localEnv = addVariables symbols inp
+                        Left err -> Left [err]
-            checkedEx = checkExpression localEnv ex
+                        Right _ -> Right $ MakeExplicitFunction (MakeFunctionSignature (toLower (head name) : tail name) desc (rights checkedIn) checkedOut) checkedEx
-            checkedOut = head $ checkAttributes definedTypes [out]
+        else
+            Left $ lefts checkedIn
+    where checkedIn = checkAttributes definedTypes inp

src/Semantic/TypeChecker.hs

@@ -41,10 +41,10 @@ populateSuper allTypes (currType : types) (MakeType t super d a c)
 -- |Checks whether all the types of the attributes of a data type are already defined
 checkAttributes :: [Type] -> [TypeAttribute] -> [Either TypeCheckError TypeAttribute]
 checkAttributes _ [] = []
-checkAttributes definedTypes ((MakeTypeAttribute name typ crd desc):as)
+checkAttributes definedTypes ((MakeTypeAttribute name typ crd desc):as) =
-    | isRight checked = Right (MakeTypeAttribute name (fromRightUnsafe checked) crd desc) : checkAttributes definedTypes as
+    case checkAttributeType definedTypes typ of
-    | otherwise = Left (fromLeftUnsafe checked) : checkAttributes definedTypes as
+        Left err -> Left err : checkAttributes definedTypes as
-    where checked = checkAttributeType definedTypes typ 
+        Right checked -> Right (MakeTypeAttribute name checked crd desc) : checkAttributes definedTypes as 
 
 -- |Checks whether a type is predefined or in the symbol table
 checkAttributeType :: [Type] -> Type -> Either TypeCheckError Type

src/Utils/Utils.hs

@@ -84,18 +84,4 @@ checkDuplicates :: Eq a => [a] -> [a]
 checkDuplicates [] = []
 checkDuplicates (a : as)
     | a `elem` as = a : checkDuplicates as
-    | otherwise = checkDuplicates as
+    | otherwise = checkDuplicates as
-
--- |Auxiliary function to get the right value from an either that stops with an error if the value is left
--- used when it is certain that the value will be right
-fromRightUnsafe :: Either a b -> b
-fromRightUnsafe x = case x of
-    Left a -> error "Value is Left"
-    Right b -> b
-    
--- |Auxiliary function to get the left value from an either that stops with an error if the value is right
--- used when it is certain that the value will be left
-fromLeftUnsafe :: Either a b -> a
-fromLeftUnsafe x = case x of
-    Left a -> a
-    Right _ -> error "Value is Right"