Working generation, need to add list functions

src/Model/Enum.hs

@@ -1,4 +1,5 @@
 module Model.Enum where
+import Model.Type
 
 -- |The representation of a Rosetta enum data type
 data EnumType = MakeEnum {
@@ -12,4 +13,11 @@ data EnumValue = MakeEnumValue {
     enumValueName :: String,
     enumValueDescription :: Maybe String,
     enumValueDisplayName :: Maybe String
-} deriving (Show, Eq)
+} deriving (Show, Eq)
+
+convertEnumToType :: EnumType -> Type
+convertEnumToType (MakeEnum name desc val) = MakeType name (BasicType "Object") desc (map (convertValueToAttribute typ) val) [MakeCondition Nothing (Keyword "one-of")] 
+    where typ = MakeType name (BasicType "Object") desc [] [MakeCondition Nothing (Keyword "one-of")] 
+
+convertValueToAttribute :: Type -> EnumValue -> TypeAttribute
+convertValueToAttribute typ (MakeEnumValue name desc _) = MakeTypeAttribute name typ (Bounds (0, 1)) Nothing

src/Model/Function.hs

@@ -15,6 +15,7 @@ data FunctionSignature =
 data Function = 
     MakeFunction {
         signature :: FunctionSignature,
+        aliases :: [(String, Expression)],
         assignment :: [(Expression, Expression)]
     }
     deriving (Show)
@@ -22,6 +23,7 @@ data Function =
 data ExplicitFunction = 
     MakeExplicitFunction {
         sign :: FunctionSignature,
+        explicitAliases :: [(String, ExplicitExpression)],
         explicitAssignment :: [(ExplicitExpression, ExplicitExpression)] 
     }
     deriving Show

src/Model/Type.hs

@@ -36,6 +36,7 @@ data Expression = Variable String
     | Int String
     | Real String
     | Boolean String
+    | Enum String String
     | Empty
     | Parens Expression
     | List [Expression]
@@ -51,8 +52,9 @@ data ExplicitExpression = ExplicitEmpty
     | ExplicitVariable {name :: String, returnCoercion :: Coercion}
     | Value {name :: String, returnCoercion :: Coercion}
     | ExplicitList [ExplicitExpression]
+    | ExplicitEnumCall {name :: String, val :: String, returnCoercion :: Coercion}
     | ExplicitKeyword String
-    | ExplicitParens ExplicitExpression
+    | ExplicitParens {expression :: ExplicitExpression, returnCoercion :: Coercion}
     | ExplicitPath {super :: ExplicitExpression, sub :: ExplicitExpression, returnCoercion :: Coercion}
     | ExplicitFunction {name :: String, args :: [(ExplicitExpression, Coercion)], returnCoercion :: Coercion}
     | ExplicitIfSimple {cond :: (ExplicitExpression, Coercion), block1 :: (ExplicitExpression, Coercion), returnCoercion :: Coercion}
@@ -64,23 +66,25 @@ changeCoercion (ExplicitVariable n _) c = ExplicitVariable n c
 changeCoercion (Value n _) c = Value n c
 changeCoercion (ExplicitList e) _ = ExplicitList e
 changeCoercion (ExplicitKeyword n) _ = ExplicitKeyword n
-changeCoercion (ExplicitParens e) _ = ExplicitParens e
+changeCoercion (ExplicitParens e _) c = ExplicitParens e c 
 changeCoercion (ExplicitPath s n _) c = ExplicitPath s n c
 changeCoercion (ExplicitFunction n args _) c = ExplicitFunction n args c 
 changeCoercion (ExplicitIfSimple cond block _) c = ExplicitIfSimple cond block c
-changeCoercion (ExplicitIfElse cond block block2 _) c = ExplicitIfElse cond block block2 c       
+changeCoercion (ExplicitIfElse cond block block2 _) c = ExplicitIfElse cond block block2 c    
+changeCoercion (ExplicitEnumCall n val _) c = ExplicitEnumCall n val c    
 
 instance Show ExplicitExpression where
     show (ExplicitVariable name coer) = show $ "Variable: " ++ name
     show (Value name coer) = show $ "Value: " ++ name
     show (ExplicitList lst) = concatMap show lst
     show (ExplicitKeyword name) = show $ "Keyword: " ++ name
-    show (ExplicitParens name) = show $ "(" ++ show name ++ ")"
+    show (ExplicitParens name coer) = show $ "(" ++ show name ++ ")"
     show (ExplicitPath super sub coer) = show $ "(->" ++ show super ++ " " ++ show sub ++ ")"
     show (ExplicitFunction name args coer) = show $ name ++ "(" ++ concatMap show args ++ ")" 
     show (ExplicitIfSimple cond block coer) = show $ "if" ++ show cond ++ " then " ++ show block
     show (ExplicitIfElse cond block1 block2 coer) = show $ "if" ++ show cond ++ " then " ++ show block1 ++ " else " ++ show block2
     show ExplicitEmpty = show "Empty"
+    show (ExplicitEnumCall n val coer) = show $ "Enumcall: " ++ n ++ "->" ++ val
 
 data TypeCoercion =
     MakeIdCoercion {toType :: Type}

src/Parser/Enum.hs

@@ -25,7 +25,8 @@ enumValueParser =
         vName <- try nameParser
         dName <- optional enumValueDisplayNameParser
         vDescription <- optional descriptionParser
-        return (MakeEnumValue vName vDescription dName)
+        let name = if head vName == '_' then 'X' : tail vName else vName in
+            return (MakeEnumValue name vDescription dName)
 
 
 -- |Parses the display name of a Rosetta enum value into a String

src/Parser/Expression.hs

@@ -39,7 +39,7 @@ ifParser :: Parser Expression
 ifParser =
     do
         _ <- lexeme $ string "if"
-        condition <- lexeme $ between (char '(') (char ')') expressionParser <|> expressionParser
+        condition <- lexeme $ expressionParser <|> between (char '(') (char ')') expressionParser
         _ <- lexeme $ string "then"
         expr <- expressionParser
         els <- observing $ lexeme $ string "else"
@@ -69,10 +69,14 @@ listParser =
 variableParser :: Parser Expression
 variableParser =
     do
-        name <- camelNameParser
-        if name == "endDate," then error "lool"
-        else return $ Variable name
-        --Variable <$> camelNameParser
+        Variable <$> camelNameParser
+
+enumValueParser :: Parser Expression
+enumValueParser =
+    do
+        enum <- pascalNameParser
+        _ <- lexeme $ string "->"
+        Enum enum <$> pascalNameParser
 
 -- |Parses an integer in Rosetta into an Expression
 integerParser :: Parser Expression
@@ -118,6 +122,7 @@ terminalParser =
              try emptyParser,
              try decimalParser,
              try variableParser,
+             try enumValueParser,
              integerParser
             ]
 

src/Parser/Function.hs

@@ -20,7 +20,18 @@ functionParser =
         fDescription <- optional descriptionParser
         fInput <- inputAttributesParser
         fOutput <- outputAttributeParser
-        MakeFunction (MakeFunctionSignature fName fDescription fInput fOutput) <$> many assignmentParser
+        aliases <- many aliasParser
+        MakeFunction (MakeFunctionSignature fName fDescription fInput fOutput) aliases <$> many assignmentParser
+
+-- |Parses an alias definition from a function
+aliasParser :: Parser (String, Expression)
+aliasParser =
+    do 
+        _ <- lexeme $ string "alias"
+        name <- camelNameParser
+        _ <- lexeme $ char ':'
+        assign <- expressionParser
+        return (name, assign)
 
 -- parseTest assignmentParser (Text.pack "assign-output observable -> exchangeRate -> from: from")
 -- |Parses the output assignment statement from a function in Rosetta into an Expression

src/PrettyPrinter/Enum.hs

@@ -11,35 +11,35 @@ printEnum :: EnumType -> String
 printEnum (MakeEnum name description values) =
     show $ printDescription description 
         (vcat ["data" <+> pretty name <+> "=", 
-        indent 4 (printEnumValues values),
+        indent 4 (printEnumValues name values), indent 4 "deriving (Eq)",
         "",
-        printDisplayNames name values, emptyDoc])
+        printDisplayNames name values]) <> emptyDoc <> emptyDoc
     
 -- |Converts a list of EnumValues into a haskell valid Doc
-printEnumValues :: [EnumValue] -> Doc a
-printEnumValues [] = ""
-printEnumValues (x:xs) = vcat (printFirstEnumValue x: map printEnumValue xs)
+printEnumValues :: String -> [EnumValue] -> Doc a
+printEnumValues _ [] = ""
+printEnumValues enumName (x:xs) = vcat (printFirstEnumValue enumName x: map (printEnumValue enumName) xs)
 
 -- |Converts the first EnumValue (in haskell without the '|') into a haskell valid Doc
-printFirstEnumValue :: EnumValue -> Doc a
-printFirstEnumValue (MakeEnumValue name description _) =
-    printDescription description (pretty name)
+printFirstEnumValue :: String -> EnumValue -> Doc a
+printFirstEnumValue enumName (MakeEnumValue name description _) =
+    printDescription description (pretty enumName <> pretty name)
 
 -- |Converts a non-first EnumValue (in haskell with the '|') into a haskell valid Doc
-printEnumValue :: EnumValue -> Doc a
-printEnumValue (MakeEnumValue name description _) = 
-    printDescription description ("|" <+> pretty name)
+printEnumValue :: String -> EnumValue -> Doc a
+printEnumValue enumName (MakeEnumValue name description _) = 
+    printDescription description ("|" <+> pretty enumName <> pretty name)
         
 -- |Converts the display names of an EnumType into a haskell valid Doc
 printDisplayNames :: String -> [EnumValue] -> Doc a
 printDisplayNames name values = 
-    nest 4 $ vcat ("instance Show" <+> pretty name <+> "where": map printDisplayName values)
+    nest 4 $ vcat ("instance Show" <+> pretty name <+> "where": map (printDisplayName name) values)
         
 -- |Converts a single display name into a haskell valid Doc
-printDisplayName :: EnumValue -> Doc a
-printDisplayName (MakeEnumValue name _ (Just display)) =
-    "show" <+> pretty name <+> "= \"" <> pretty display <> "\"" 
-printDisplayName (MakeEnumValue name _ Nothing) =
-    "show" <+> pretty name <+> "= \"" <> pretty name <> "\""
+printDisplayName :: String -> EnumValue -> Doc a
+printDisplayName enumName (MakeEnumValue name _ (Just display)) =
+    "show" <+> pretty enumName <> pretty name <+> "= \"" <> pretty display <> "\"" 
+printDisplayName enumName (MakeEnumValue name _ Nothing) =
+    "show" <+> pretty enumName <> pretty name <+> "= \"" <> pretty name <> "\""
         
         

src/PrettyPrinter/Expression.hs

@@ -8,17 +8,21 @@ import Semantic.ExpressionChecker(coercionIncluded)
 import Utils.Utils
 
 printExpression :: ExplicitExpression -> Doc a
-printExpression ExplicitEmpty = "[]" 
+printExpression ExplicitEmpty = "[]"
 printExpression (ExplicitVariable name coer) = printCoercion coer $ pretty name
 printExpression (Value s coer) = printCoercion coer $ pretty s
 printExpression (ExplicitKeyword k) = pretty k
-printExpression (ExplicitParens ex) = "(" <> printExpression ex <> ")"
+printExpression (ExplicitEnumCall name val coer) = printCoercion coer $ pretty name <> pretty val
+printExpression (ExplicitParens ex c) = "(" <> printExpression ex <> ")"
 printExpression (ExplicitList ex)  = list [printExpression x | x <- ex]
-printExpression (ExplicitPath ex1 ex2 returnCoerce) = printCoercion (returnCoercion ex1) (printExpression ex1) <+> "->" <+> printCoercion (returnCoercion ex2) (printExpression ex2)
+printExpression (ExplicitPath ex1 (ExplicitVariable var ret) returnCoerce) =
+    pretty (uncapitalize $ typeName $ coercionType $ typeCoercion $ returnCoercion ex1) <> pretty (capitalize var) <+> 
+    enclose "(" ")" (printExpression ex1)
+printExpression ExplicitPath {} = error "This should never happen. Path Expression 2nd argument is not variable"
 printExpression (ExplicitFunction "exists" args returnCoerce) = printCoercion returnCoerce "isJust" <+> printCoercion (snd $ head args) (printExpression (fst $ head args))
 printExpression (ExplicitFunction "is absent" args returnCoerce) = printCoercion returnCoerce "isNothing" <+> printCoercion (snd $ head args) (printExpression (fst $ head args))
 printExpression (ExplicitFunction "single exists" args returnCoerce) = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args)) <+> "==" <+> "1"
-printExpression (ExplicitFunction "multiple exists" args returnCoerce) = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args)) <+> ">" <+> "1" 
+printExpression (ExplicitFunction "multiple exists" args returnCoerce) = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args)) <+> ">" <+> "1"
 printExpression (ExplicitFunction "count" args returnCoerce) = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args))
 -- Equality expressions
 -- [a] a all = 
@@ -30,19 +34,19 @@ printExpression (ExplicitFunction "all <>" args returnCoerce) = printCoercion (s
 printExpression (ExplicitFunction "all =" args returnCoerce) = "all (Eq)" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args)) <+> printCoercion (snd $ head args) (printExpression (fst $ head args))
 printExpression (ExplicitFunction "and" args returnCoerce) = printCoercion (snd $ head args) (printExpression (fst $ head args)) <+> "&&" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args))
 printExpression (ExplicitFunction "or" args returnCoerce) = printCoercion (snd $ head args) (printExpression (fst $ head args)) <+> "||" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args))
-printExpression (ExplicitFunction name args returnCoerce) = 
-    if null printedArgs then pretty (uncapitalize name) 
+printExpression (ExplicitFunction name args returnCoerce) =
+    if null printedArgs then pretty (uncapitalize name)
     else  "(" <> pretty (uncapitalize name) <+> printCoercion returnCoerce (hsep printedArgs) <> ")"
     where printedArgs = zipWith printCoercion [c | (e,c) <- args] [printExpression e | (e, c) <- args]
-printExpression (ExplicitIfSimple cond thenBlock returnCoercion) = 
-    "if" <+> printCoercion (snd cond) (printExpression (fst cond)) <+> 
-    "then" <+> printCoercion (snd thenBlock) (printExpression (fst thenBlock)) <+> 
+printExpression (ExplicitIfSimple cond thenBlock returnCoercion) =
+    "if" <+> printCoercion (snd cond) (printExpression (fst cond)) <+>
+    "then" <+> printCoercion (snd thenBlock) (printExpression (fst thenBlock)) <+>
     "else" <+> case MakeCoercion [MakeIdCoercion $ coercionType $ typeCoercion returnCoercion] (MakeCardinalityIdCoercion (Bounds (0, 0))) `coercionIncluded` returnCoercion of
         Left err -> error $ show err
         Right c -> printCoercion c emptyDoc
-printExpression (ExplicitIfElse cond thenBlock elseBlock returnCoercion) = 
-    "if" <+> printCoercion (snd cond) (printExpression (fst cond)) <+> 
-    "then" <+> printCoercion (snd thenBlock) (printExpression (fst thenBlock)) <+> 
+printExpression (ExplicitIfElse cond thenBlock elseBlock returnCoercion) =
+    "if" <+> printCoercion (snd cond) (printExpression (fst cond)) <+>
+    "then" <+> printCoercion (snd thenBlock) (printExpression (fst thenBlock)) <+>
     "else" <+> printCoercion (snd elseBlock) (printExpression (fst elseBlock))
 
 -- |Converts a coercion into a haskell string

src/PrettyPrinter/Function.hs

@@ -36,16 +36,20 @@ instance Show AssignmentTree where
 
 -- |Converts a Function into a haskell valid String
 printFunction :: ExplicitFunction -> String
-printFunction f = show $ vcat [printFunctionSignature (sign f), printFunctionBody f, emptyDoc]
+printFunction f = show $ vcat [printFunctionSignature (sign f), printFunctionBody f, line]
 
 -- |Converts the body of a Function into a haskell valid Doc
 printFunctionBody :: ExplicitFunction -> Doc a
-printFunctionBody (MakeExplicitFunction (MakeFunctionSignature name _ inp out) ex) =
+printFunctionBody (MakeExplicitFunction (MakeFunctionSignature name _ inp out) alias ex) =
     pretty name <+> printVariableNames inp <+> "=" <+> 
-    printAssignmentTree (head $ mergeAssignmentTrees [convertToAssignmentTree (fst exp) (AssignmentLeaf (snd exp)) | exp <- ex])
+    nest 4 (vsep (map printAlias alias ++
+    [printAssignmentTree (head $ mergeAssignmentTrees [convertToAssignmentTree (fst exp) (AssignmentLeaf (snd exp)) | exp <- ex])]))
     --error $ show $ mergeAssignmentTrees [convertToAssignmentTree (fst exp) (AssignmentLeaf (snd exp)) | exp <- ex]
 
 
+printAlias :: (String, ExplicitExpression) -> Doc a
+printAlias (name, exp) = "let" <+> pretty name <+> "=" <+> printExpression exp <+> "in"   
+
 -- |Converts a function into a haskell valid Doc representing the signature of the function
 printFunctionSignature :: FunctionSignature -> Doc a
 printFunctionSignature (MakeFunctionSignature name description inputs output) =

src/PrettyPrinter/Type.hs

@@ -12,12 +12,12 @@ printType :: Type -> String
 printType (MakeType name (MakeType super _ _ _ _) description attributes conditions) = printType (MakeType name (BasicType "Object") description (superToAttribute super:attributes) conditions)
 printType (MakeType name (BasicType "Object") description attributes conditions) = 
     show $ printTypeName name description <+>
-    printAttributes name conditions attributes
+    printAttributes name conditions attributes <> line <> line
 printType (MakeType _ (BasicType _) _ _ _) = error "Can't extend basic types"
 printType (BasicType name) = show $ pretty name
    
 printTypeName :: String -> Maybe String -> Doc a
-printTypeName name desc = printDescription desc (line <> "data" <+> pretty name <+> "=") 
+printTypeName name desc = printDescription desc ("data" <+> pretty name <+> "=") 
 
 -- |Creates an attribute that accesses the super type
 superToAttribute :: String -> TypeAttribute
@@ -27,9 +27,9 @@ superToAttribute typ = MakeTypeAttribute "super" (MakeType typ (BasicType "Objec
 printAttributes :: String -> [Condition] -> [TypeAttribute] -> Doc a
 printAttributes objName conditions ats
     | MakeCondition Nothing (Keyword "one-of") `elem` conditions || length ats < 2 = vcat [nest 4 $ vcat $ 
-        zipWith (<>) ("" : repeat "| ") (map (printSumType objName) ats) ++ map printCondition conditions, emptyDoc, emptyDoc] 
+        zipWith (<>) ("" : repeat "| ") (map (printSumType objName) ats) ++ map printCondition conditions, " deriving (Eq)"]
     | otherwise = vcat [nest 4 $ vcat ("Make" <> pretty objName <+> "{" : 
-        reverse (zipWith (<>) (reverse (map (printAttribute objName) ats)) ("" : repeat ",")) ++ map printCondition conditions), "}", emptyDoc, emptyDoc]
+        punctuate comma (map (printAttribute objName) ats) ++ map printCondition conditions), "}"] <+> "deriving (Eq)"
    
 -- |Converts a TypeAttribute into a haskell valid Doc
 printAttribute :: String -> TypeAttribute -> Doc a

src/Semantic/ExpressionChecker.hs

@@ -41,6 +41,8 @@ defaultMap = [
   Func "contains" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
   Func "disjoint" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds (1, 1)),
 
+  Func "=" [(BasicType "Any", Bounds(1, 1)), (BasicType "Any", Bounds(1, 1))] (BasicType "Boolean", Bounds(1, 1)),
+  Func "=" [(BasicType "Any", Bounds(0, 1)), (BasicType "Any", Bounds(0, 1))] (BasicType "Boolean", Bounds(1, 1)),
   Func "=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
   Func ">=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
   Func "<=" [(BasicType "Any", OneBound 0), (BasicType "Any", OneBound 0)] (BasicType "Boolean", Bounds(1, 1)),
@@ -68,7 +70,7 @@ defaultMap = [
 
 -- |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 (MakeFunctionSignature name _ inps out) _) =
+addFunction (definedTypes, definedSymbols) (MakeFunction (MakeFunctionSignature name _ inps out) _ _) =
     case head $ checkAttributes definedTypes [out] of
         Left err -> Left [err]
         Right checkedOutput -> if null (lefts checkedInputs)
@@ -92,6 +94,12 @@ checkExpression _ _ (Int val) = Right $ Value val $ MakeCoercion [MakeIdCoercion
 checkExpression _ _ (Real val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Double")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
 checkExpression _ _ (Boolean val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
 checkExpression _ _ Empty = Right $ Value "empty" $ MakeCoercion [MakeIdCoercion (BasicType "Empty")] (MakeCardinalityIdCoercion (Bounds (0, 0)))
+checkExpression defT symbolMap (Enum enum val) = case getType enum  defT of 
+    Left err -> Left err
+    Right typ -> if val `elem` map attributeName (typeAttributes typ) 
+        then Right $ ExplicitEnumCall enum val $ MakeCoercion [MakeIdCoercion typ] (MakeCardinalityIdCoercion (Bounds (1, 1)))  
+        else Left $ UndefinedVariable val
+
 checkExpression _ _ (Keyword k) = Right $ ExplicitKeyword k
 checkExpression defT symbolMap (PathExpression ex1 (Variable b)) =
     case checkExpression defT symbolMap ex1 of
@@ -107,7 +115,7 @@ checkExpression _ _ (PathExpression _ ex) = Left $ UnsupportedExpressionInPathEx
 checkExpression defT symbolMap (Parens ex) =
     case checkExpression defT symbolMap ex of
         Left err -> Left err
-        Right exp -> Right $ ExplicitParens exp
+        Right exp -> Right $ ExplicitParens exp (returnCoercion exp)
 checkExpression defT symbolMap (List lst) = checkList defT symbolMap lst
 checkExpression defT symbolMap (PrefixExp name ex) = checkFunctionCall symbolMap name [checkExpression defT symbolMap ex]
 checkExpression defT symbolMap (Function name exps) = checkFunctionCall symbolMap name (map (checkExpression defT symbolMap) exps)
@@ -181,21 +189,28 @@ checkList1 defT symbs (ex : exps) typ =
 
 -- |Checks whether the function that is called is already defined with the same argument types
 checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError ExplicitExpression ] -> Either TypeCheckError ExplicitExpression
-checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ show (rights args) ++ "]"
+checkFunctionCall [] fun args = error $ show args --Left $ UndefinedFunction $ "Undefined function: " ++ fun ++ " [" ++ show (rights args) ++ "]"
 checkFunctionCall ((Func n a r):symbolMap) name args
-    | length (rights args) /= length args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args))
-    | name == n && all isRight coerce = Right $ ExplicitFunction name (zip (rights args) (rights coerce)) (MakeCoercion [MakeIdCoercion (fst r)] (MakeCardinalityIdCoercion (snd r)))
+    | not $ null $ lefts args = Left $ ErrorInsideFunction (name ++ ": " ++ show args ++ show (lefts args))
+    | name == n = if all isRight coerce then Right $ ExplicitFunction name (zip (rights args) (rights coerce)) (MakeCoercion [MakeIdCoercion (fst r)] (MakeCardinalityIdCoercion (snd r)))
+        else error $ show argCoerce
     | otherwise = checkFunctionCall symbolMap name args
     where
         argCoerce = map returnCoercion (rights args)
         coerce = zipWith coercionIncluded argCoerce (map createCoercion a)
 checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args
 
+getType :: String -> [Type] -> Either TypeCheckError Type
+getType t [] = Left $ UndefinedType t
+getType typ (t : ts) 
+    | typ == typeName t = Right t
+    | otherwise = getType typ ts 
+
 typeIncluded :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError Coercion
 typeIncluded (t1, c1) (t2, c2) =
     case t1 `isSubType` t2 of
         Left err -> Left err
-        Right typeCoercion ->
+        Right typeCoercion -> 
             case c1 `cardinalityIncluded` c2 of
                 Left err -> Left err
                 Right cardCoercion -> Right $ MakeCoercion typeCoercion cardCoercion
@@ -238,6 +253,7 @@ findAttributeType var (t : ts)
 -- |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 t (BasicType "Any") = Right [MakeIdCoercion t]
 isSubType (BasicType x) y
     | x == typeName y = Right [MakeIdCoercion y]
     | otherwise = Left $ TypeMismatch x (typeName y)
@@ -250,12 +266,12 @@ isSubType x y
 -- |Finds the type attributes from a type in the symbol table
 getTypeAttributes :: [Type] -> Type -> [TypeAttribute]
 getTypeAttributes [] t = []
-getTypeAttributes (defT : ts) t 
-    | typeName defT == typeName t = 
-        [MakeTypeAttribute {attributeName = attributeName attr, 
-            attributeType = toHaskell (attributeType attr), 
-            Model.Type.cardinality = if MakeCondition Nothing (Keyword "one-of") `elem` conditions defT then Bounds (1,1) else Model.Type.cardinality attr, 
-            attributeDescription = attributeDescription attr} 
+getTypeAttributes (defT : ts) t
+    | typeName defT == typeName t =
+        [MakeTypeAttribute {attributeName = attributeName attr,
+            attributeType = toHaskell (attributeType attr),
+            Model.Type.cardinality = if MakeCondition Nothing (Keyword "one-of") `elem` conditions defT then Bounds (1,1) else Model.Type.cardinality attr,
+            attributeDescription = attributeDescription attr}
             | attr <- typeAttributes defT]
     | otherwise = getTypeAttributes ts t
 

src/Semantic/FunctionChecker.hs

@@ -10,24 +10,27 @@ 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] ExplicitFunction
-checkFunction (definedTypes, symbols) (MakeFunction (MakeFunctionSignature name desc inp out) ex) =
+checkFunction (definedTypes, symbols) (MakeFunction (MakeFunctionSignature name desc inp out) alias ex) =
     let checkedIn = checkAttributes definedTypes inp in
     if null $ lefts checkedIn
         then
-            case head $ checkAttributes definedTypes [out] of
+            let symbolTable = addVariables symbols (rights checkedIn) in
+            case addAliases definedTypes symbolTable alias of
                 Left err -> Left [err]
-                Right checkedOut -> case checkAssignment definedTypes (addVariables symbols (checkedOut : rights checkedIn)) ex of
-                    Left err -> Left err
-                    Right checkedEx -> Right $ MakeExplicitFunction (MakeFunctionSignature (toLower (head name) : tail name) desc (rights checkedIn) checkedOut) checkedEx
+                Right checkedAlias -> case head $ checkAttributes definedTypes [out] of
+                    Left err -> Left [err]
+                    Right checkedOut -> case checkAssignment definedTypes (addVariables (fst checkedAlias) [checkedOut]) ex of
+                                Left err -> Left err
+                                Right checkedEx -> Right $ MakeExplicitFunction (MakeFunctionSignature (toLower (head name) : tail name) desc (rights checkedIn) checkedOut) (snd checkedAlias) checkedEx
         else
             Left $ lefts checkedIn
 
 checkAssignment :: [Type] -> [Symbol] -> [(Expression, Expression)] -> Either [TypeCheckError] [(ExplicitExpression, ExplicitExpression)]
 checkAssignment _ _ [] = Right []
 checkAssignment defT symbs ((assign, ex): assigns) =
+    -- Here we use only tail symbs, beacuse the head of the symbol table is the out variable, and that can't be used in the expression body
     case checkExpression defT (tail symbs) ex of
     Left err -> Left [err]
-    -- Here we use only tail symbs, beacuse the head of the symbol table is the out variable, and that can't be used in the expression body
     Right checkedExp -> case checkExpression defT symbs assign of
         Left err -> Left [err]
         Right checkedA -> case checkAssignment defT symbs assigns of
@@ -35,4 +38,14 @@ checkAssignment defT symbs ((assign, ex): assigns) =
                 -- Add a final explicit transformation to match the expected output
                 Right checked -> case returnCoercion checkedExp `coercionIncluded` returnCoercion checkedA of
                     Left err -> Left [err]
-                    Right c -> Right $ (checkedA, changeCoercion checkedExp c) : checked
+                    Right c -> Right $ (checkedA, changeCoercion checkedExp c) : checked
+
+addAliases :: [Type] -> [Symbol] -> [(String, Expression)] -> Either TypeCheckError ([Symbol], [(String, ExplicitExpression)])
+addAliases definedTypes symbolMap [] = Right (symbolMap, [])
+addAliases definedTypes symbolMap (alias : aliases) = 
+    case checkExpression definedTypes symbolMap (snd alias) of
+        Left err -> Left err
+        Right ex -> case add of
+            Left err -> Left err
+            Right added -> Right (fst added, (fst alias, ex) : snd added)
+            where add = addAliases definedTypes (addVariables symbolMap [MakeTypeAttribute (fst alias) (coercionType $ typeCoercion $ returnCoercion ex) (toCardinality $ cardinalityCoercion $ returnCoercion ex) Nothing]) aliases