Parser and type checker almost completely working

Added testing env

src/Model/Enum.hs

@@ -4,10 +4,10 @@ data EnumType = MakeEnum {
     enumName :: String,
     enumDescription :: Maybe String,
     enumValues :: [EnumValue]
-} deriving (Show)
+} deriving (Show, Eq)
 
 data EnumValue = MakeEnumValue {
     enumValueName :: String,
     enumValueDescription :: Maybe String,
     enumValueDisplayName :: Maybe String
-} deriving (Show)
+} deriving (Show, Eq)

src/Model/Function.hs

@@ -12,16 +12,16 @@ data Function =
     }
     deriving (Show)
     
-data Condition =
-    MakeCondition {
-        conditionDescription :: Maybe String,
-        conditionStatement :: Expression
-    }
-    | MakePostCondition {
-        conditionDescription :: Maybe String,
-        conditionStatement :: Expression
-    }
-    deriving (Show)
+--data Condition =
+--    MakeCondition {
+--        conditionDescription :: Maybe String,
+--        conditionStatement :: Expression
+--    }
+--    | MakePostCondition {
+--        conditionDescription :: Maybe String,
+--        conditionStatement :: Expression
+--    }
+--    deriving (Show)
      
 data Expression = Variable String
     | Int String
@@ -36,4 +36,4 @@ data Expression = Variable String
     | InfixExp String Expression Expression
     | IfSimple Expression Expression
     | IfElse Expression Expression Expression
-    deriving (Show)
+    deriving (Eq, Show)

src/Model/Type.hs

@@ -30,9 +30,7 @@ data TypeAttribute = MakeTypeAttribute {
 } deriving (Show)
 
 --TODO use bounded class
-data Cardinality = 
-    ZeroOrOne
-    | ExactlyOne
-    | OneOrMore             -- One or more
-    | ZeroOrMore            -- Zero or more
-    deriving (Show)
+data Cardinality = Bounds (Integer, Integer)
+  | OneBound Integer
+  | NoBounds 
+  deriving Show

src/Parser/Enum.hs

@@ -7,16 +7,14 @@ import Text.Megaparsec.Char
 import Text.Megaparsec
 import Model.Enum
 
---parseTest enumParser "enum periodEnum: <\"description\"> D displayName \"day\" <\"Day\">"
 enumParser :: Parser EnumType
 enumParser = 
     do 
         eName <- enumNameParser
         eDescription <- optional descriptionParser
-        values <- many enumValueParser
+        values <- some enumValueParser
         return (MakeEnum eName eDescription values)
-
---parseTest enumValueParser "D displayName \"day\" <\"Day\">"        
+    
 enumValueParser :: Parser EnumValue
 enumValueParser = 
     do
@@ -38,24 +36,4 @@ enumNameParser =
         _ <- lexeme $ string "enum"
         name <- nameParser
         _ <- lexeme $ char ':'
-        return name 
-
-periodEnum :: EnumType
-periodEnum = MakeEnum 
-    "PeriodEnum" 
-    (Just "The enumerated values to specifie the period, e.g. day, week.")
-    [MakeEnumValue 
-    "D"
-    (Just "Day")
-    Nothing,
-    
-    MakeEnumValue
-    "W"
-    (Just "Week")
-    Nothing,
-    
-    MakeEnumValue
-    "Y"
-    (Just "Year")
-    Nothing
-    ]
+        return name 

src/Parser/Expression.hs

@@ -75,7 +75,7 @@ integerParser :: Parser Expression
 integerParser =
     do
         nr <- lexeme $ some digitChar
-        return $ Int $ show nr
+        return $ Int nr
         
 decimalParser :: Parser Expression
 decimalParser =
@@ -83,7 +83,7 @@ decimalParser =
         nr <- some digitChar
         _ <- char '.'
         real <- lexeme $ many digitChar
-        return $ Real $ show nr ++ "." ++ real
+        return $ Real $ nr ++ "." ++ real
         
 booleanParser :: Parser Expression
 booleanParser =
@@ -202,18 +202,4 @@ precedence "^" = 4
 precedence _ = 100
 
 prefixOperators :: [String]
-prefixOperators = ["-", "not"]
-
-testArith3 = parseTest expressionParser "1 + (2 - 3)"
-testArith4 = parseTest expressionParser "a * b - c * d - e * f = g * h - i * j - k * l"
-testArith5 = parseTest expressionParser "a + b - c * d ^ e"
-testArith6 = parseTest expressionParser "1 - 2 - 3 - 4 - 5 - 6"
-testList = parseTest expressionParser "[1, 2, 3]"
-testList2 = parseTest expressionParser "[1, 2 + 3, e]"
-testFun = parseTest functionCallParser "Function()"
-testFun2 = parseTest functionCallParser "Function(e)"
-testFun3 = parseTest functionCallParser "Function(3, 3+2,e)"
-testIf = parseTest expressionParser "if (Function(2 + 3, e)) then a + b - c * d ^ e -> x else not a exists"
-testEverything = parseTest expressionParser "if [1, Function(3)] then 1 - 2 - 3 * a -> b ^ c"
-testFail = parseTest expressionParser "if[1,as]thenxandoelseaora"
-testOr = parseTest expressionParser "a or b"
+prefixOperators = ["-", "not"]

src/Parser/Type.hs

@@ -7,7 +7,6 @@ import Text.Megaparsec.Char
 import Text.Megaparsec
 import Parser.General 
   
---parseTest typeParser "type Period: <\"description\"> periodMultiplier int (1..1) <\"A time period multiplier\"> period periodEnum (1..1) <\"A time period \">"
 typeParser :: Parser Type
 typeParser = 
     do 
@@ -21,7 +20,7 @@ typeParser =
 superTypeParser :: Parser Type
 superTypeParser =
     do
-        _ <- lexeme $ string "extending"
+        _ <- lexeme $ string "extends"
         name <- pascalNameParser 
         return $ MakeType name Nothing Nothing []
 
@@ -37,55 +36,36 @@ typeAttributeParser =
 cardinalityParser :: Parser Cardinality
 cardinalityParser =
     do
-        parseExactlyOne <|> parseOneOrMore <|> parseZeroOrMore <|> parseZeroOrOne
+        try parseBounded <|> try parseSemiBounded <|> try parseUnbounded
 
-parseOneOrMore :: Parser Cardinality
-parseOneOrMore = 
+parseBounded :: Parser Cardinality
+parseBounded = 
     do
-        _ <- lexeme $ string "(1..*)"
-        return OneOrMore
+        _ <- lexeme $ char '('
+        low <- lexeme $ many digitChar
+        _ <- lexeme $ string ".."
+        up <- lexeme $ many digitChar
+        _ <- lexeme $ char ')'
+        return $ Bounds (read low, read up)
 
 
-parseExactlyOne :: Parser Cardinality
-parseExactlyOne = 
+parseSemiBounded :: Parser Cardinality
+parseSemiBounded = 
     do
-        _ <- lexeme $ string "(1..1)"
-        return ExactlyOne
+        _ <- lexeme $ char '('
+        low <- lexeme $ many digitChar
+        _ <- lexeme $ string "..*)"
+        return $ OneBound $ read low
         
         
-parseZeroOrMore :: Parser Cardinality
-parseZeroOrMore = 
+parseUnbounded :: Parser Cardinality
+parseUnbounded = 
     do
-        _ <- lexeme $ string "(0..*)"
-        return ZeroOrMore
-        
-        
-parseZeroOrOne :: Parser Cardinality
-parseZeroOrOne = 
-    do
-        _ <- lexeme $ string "(0..1)"
-        return ZeroOrOne
+        _ <- lexeme $ string "(*..*)"
+        return NoBounds
 
 typeNameParser :: Parser String
 typeNameParser = 
     do
         _ <- lexeme $ string "type"
-        pascalNameParser
-        
-periodType :: Type
-periodType = MakeType 
-    "Period" 
-    Nothing
-    (Just "A class to define recurring periods or time offsets")
-    [MakeTypeAttribute 
-        "periodMultiplier"
-        (BasicType "Integer")
-        ExactlyOne
-        (Just "A time period multiplier"),
-    
-    MakeTypeAttribute 
-        "period"
-        (MakeType "PeriodEnum" Nothing Nothing [])
-        ExactlyOne
-        (Just "A time period")
-    ]
+        pascalNameParser

src/PrettyPrinter/Type.hs

@@ -8,16 +8,24 @@ import Model.Type
 
 printType :: Type -> String
 printType (MakeType name _ description attributes) =
-    show $ printDescription description (vcat [nest 4 $ vcat("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": map printAttribute attributes), "}", ""])
+    show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": map printAttribute attributes), "}", ""])
 printType (BasicType name) = show $ pretty name
    
+printAttributes :: [TypeAttribute] -> [Doc a]
+printAttributes [] = []
+printAttributes [at] = [printAttribute at]
+printAttributes (at : ats) = (printAttribute at <> ",") : printAttributes ats
+
+   
 printAttribute :: TypeAttribute -> Doc a
 printAttribute (MakeTypeAttribute name typ crd description) =
     printDescription description 
         (pretty name <+> "::" <+> printCardinality (MakeTypeAttribute name typ crd description))   
 
 printCardinality :: TypeAttribute -> Doc a
-printCardinality (MakeTypeAttribute _ typ ExactlyOne _) = pretty (typeName typ)
-printCardinality (MakeTypeAttribute _ typ OneOrMore _) = "[" <> pretty (typeName typ) <> "]"
-printCardinality (MakeTypeAttribute _ typ ZeroOrMore _) = "[" <> pretty (typeName typ) <> "]"
-printCardinality (MakeTypeAttribute _ typ ZeroOrOne _) = "Maybe" <+> pretty (typeName typ)
+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) <> "]"

src/Semantic/ExpressionChecker.hs

@@ -0,0 +1,131 @@
+module Semantic.ExpressionChecker where
+
+import Model.Function
+import Data.Either
+import Data.Maybe
+import Model.Type
+import Semantic.TypeChecker
+  
+data Symbol = Var{
+   varName :: String,
+   declaredType :: Type
+   }
+   | Func {
+   funcName :: String,
+   argsType :: [Type],
+   returnType :: 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 "=" [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 "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 "count" [BasicType "Any"] (BasicType "Integer")
+  ]
+    
+checkExpression :: [Symbol] -> Expression -> Either Type TypeCheckError
+checkExpression symbolMap (Variable var) = findVarType var symbolMap
+checkExpression _ (Int _) = Left $ BasicType "Integer"
+checkExpression _ (Real _) = Left $ BasicType "Double"
+checkExpression _ (Boolean _) = Left $ BasicType "Boolean"
+checkExpression _ Empty = Left $ BasicType "Empty"
+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]
+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])
+checkExpression symbolMap (IfSimple cond ex)
+    | isLeft condType && isLeft (typeMatch (fromLeftUnsafe condType) (BasicType "Boolean")) = checkExpression symbolMap ex
+    | otherwise = Right IfConditionNotBoolean
+    where condType = checkExpression symbolMap cond
+checkExpression symbolMap (IfElse cond ex1 ex2)
+    | isRight condType || isRight (typeMatch (fromLeftUnsafe condType) (BasicType "Boolean")) = Right IfConditionNotBoolean 
+    | isRight ex1Type || isRight ex2Type || isRight (typeMatch (fromLeftUnsafe ex1Type) (fromLeftUnsafe ex2Type)) = Right IfExpressionsDifferentTypes
+    | otherwise = ex1Type
+    where   condType = checkExpression symbolMap cond
+            ex1Type = checkExpression symbolMap ex1
+            ex2Type = checkExpression symbolMap ex2
+
+checkList :: [Symbol] -> [Expression] -> Either Type TypeCheckError
+checkList symbs exps
+    | isLeft typ && fromLeftUnsafe typ == BasicType "Any" = Left $ BasicType "Empty"
+    | otherwise = typ
+    where typ = checkList1 symbs exps (BasicType "Any") 
+
+checkList1 :: [Symbol] -> [Expression] -> Type -> Either Type TypeCheckError
+checkList1 _ [] typ = Left typ
+checkList1 symbs (ex : exps) typ 
+    | isRight exTyp = exTyp
+    | isRight match = match
+    | otherwise = checkList1 symbs exps (fromLeftUnsafe match)
+    where 
+        exTyp = checkExpression symbs ex 
+        match = typeMatch typ (fromLeftUnsafe exTyp)
+
+checkFunctionCall :: [Symbol] -> String -> [Either Type TypeCheckError] -> Either Type TypeCheckError
+checkFunctionCall [] fun args = Right $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ concatMap typeName (lefts args) ++ "]"
+checkFunctionCall ((Func n a r):symbolMap) name args
+    | length left /= length args = Right ErrorInsideFunction
+    | name == n && all isLeft (zipWith typeMatch a left) = Left r
+    | otherwise = checkFunctionCall symbolMap name args
+    where left = lefts args
+checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args 
+
+--Try to match 2nd type to first type
+typeMatch :: Type -> Type -> Either Type TypeCheckError
+typeMatch (BasicType "Any") x = Left x
+typeMatch (BasicType "Double") (BasicType "Integer") = Left $ BasicType "Dobule"
+typeMatch s (BasicType s2)
+    | s == BasicType s2 = Left s
+    | otherwise = Right $ TypeMismatch (typeName s) s2
+typeMatch s s2
+    | s == s2 = Left s
+    | isJust $ superType s2 = typeMatch s (fromJust $ superType s2)
+    | otherwise = Right $ TypeMismatch (typeName s) (typeName s2)
+
+findVarType :: String -> [Symbol] -> Either Type TypeCheckError
+findVarType var [] = Right $ UndefinedVariable var
+findVarType x ((Var name typ):symbols) 
+    | x == name = Left typ
+    | otherwise = findVarType x symbols
+findVarType x (_:symbols) = findVarType x symbols
+
+fromRightUnsafe :: Either a b -> b
+fromRightUnsafe x = case x of
+    Left _ -> error "Value is Left"
+    Right b -> b
+    
+fromLeftUnsafe :: Either a b -> a
+fromLeftUnsafe x = case x of
+    Left a -> a
+    Right _ -> error "Value is Right"

src/Semantic/TypeChecker.hs

@@ -1,65 +1,16 @@
 module Semantic.TypeChecker where
 
 import Model.Type
-import Model.Function
-import Data.Either
-import Data.Maybe
 
 data TypeCheckError =
-    UndefinedType String
-    | IfConditionNotBoolean
-    | IfExpressionsDifferentTypes
-    | UndefinedFunction String
-    | ErrorInsideFunction
-    | UndefinedVariable String
-    | TypeMismatch String String
-    deriving (Show)
-
-data Symbol = Var{
-  varName :: String,
-  declaredType :: Type
-  }
-  | Func {
-  funcName :: String,
-  argsType :: [Type],
-  returnType :: 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 "=" [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 "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 "count" [BasicType "Any"] (BasicType "Integer")
-  ]
+   UndefinedType String
+   | IfConditionNotBoolean
+   | IfExpressionsDifferentTypes
+   | UndefinedFunction String
+   | ErrorInsideFunction
+   | UndefinedVariable String
+   | TypeMismatch String String
+   deriving (Show)
 
 checkAttributes :: [Type] -> [TypeAttribute] -> [Either Type TypeCheckError]
 checkAttributes _ [] = []
@@ -74,85 +25,8 @@ checkType _ (MakeType "time" _ _ _) = Left $ BasicType "Time"
 checkType definedTypes name
     | name `elem` definedTypes = Left name
     | otherwise = Right $ UndefinedType (typeName name)
-  
+    
 addDefinedTypes :: [Type] -> [Type] -> [Type]
 addDefinedTypes l [] = l
 addDefinedTypes l (BasicType _ : ts) = addDefinedTypes l ts
-addDefinedTypes l (t:ts) = t : addDefinedTypes l ts
-
---Variable String
---    | Int String
---    | Real String
---    | Boolean String
---    | Empty
---    | Parens Expression
---    | List [Expression]
---    | Function String [Expression]
---    | PrefixExp String Expression
---    | PostfixExp String Expression
---    | InfixExp String Expression Expression
---    | IfSimple Expression Expression
---    | IfElse Expression Expression Expression
-    
-checkExpression :: [Symbol] -> Expression -> Either Type TypeCheckError
-checkExpression symbolMap (Variable var) = findVarType var symbolMap
-checkExpression _ (Int _) = Left $ BasicType "Integer"
-checkExpression _ (Real _) = Left $ BasicType "Double"
-checkExpression _ (Boolean _) = Left $ BasicType "Boolean"
-checkExpression _ Empty = Left $ BasicType "Empty"
-checkExpression symbolMap (Parens ex) = checkExpression symbolMap ex
---TODO check list has same type
-checkExpression _ (List _) = Left $ BasicType "List" 
-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])
-checkExpression symbolMap (IfSimple cond ex)
-    | isLeft condType && isLeft (typeMatch (fromLeftUnsafe condType) (BasicType "Boolean")) = checkExpression symbolMap ex
-    | otherwise = Right IfConditionNotBoolean
-    where condType = checkExpression symbolMap cond
-checkExpression symbolMap (IfElse cond ex1 ex2)
-    | isRight condType || isRight (typeMatch (fromLeftUnsafe condType) (BasicType "Boolean")) = Right IfConditionNotBoolean 
-    | isRight ex1Type || isRight ex2Type || isRight (typeMatch (fromLeftUnsafe ex1Type) (fromLeftUnsafe ex2Type)) = Right IfExpressionsDifferentTypes
-    | otherwise = ex1Type
-    where   condType = checkExpression symbolMap cond
-            ex1Type = checkExpression symbolMap ex1
-            ex2Type = checkExpression symbolMap ex2
-
-checkFunctionCall :: [Symbol] -> String -> [Either Type TypeCheckError] -> Either Type TypeCheckError
-checkFunctionCall [] fun args = Right $ UndefinedFunction $ "Undefined function: " ++ fun ++ concatMap typeName (lefts args)
-checkFunctionCall ((Func n a r):symbolMap) name args
-    | length left /= length args = Right ErrorInsideFunction
-    | name == n && all isLeft (zipWith typeMatch a left) = Left r
-    | otherwise = checkFunctionCall symbolMap name args
-    where left = lefts args
-checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args 
-
---Try to match 2nd type to first type
-typeMatch :: Type -> Type -> Either Type TypeCheckError
-typeMatch (BasicType "Any") x = Left x
-typeMatch (BasicType "Double") (BasicType "Integer") = Left $ BasicType "Dobule"
-typeMatch s (BasicType s2)
-    | s == BasicType s2 = Left s
-    | otherwise = Right $ TypeMismatch (typeName s) s2
-typeMatch s s2
-    | s == s2 = Left s
-    | isJust $ superType s2 = typeMatch s (fromJust $ superType s2)
-    | otherwise = Right $ TypeMismatch (typeName s) (typeName s2)
-
-findVarType :: String -> [Symbol] -> Either Type TypeCheckError
-findVarType var [] = Right $ UndefinedVariable var
-findVarType x ((Var name typ):symbols) 
-    | x == name = Left typ
-    | otherwise = findVarType x symbols
-findVarType x (_:symbols) = findVarType x symbols
-
-fromRightUnsafe :: Either a b -> b
-fromRightUnsafe x = case x of
-    Left _ -> error "Value is Left"
-    Right b -> b
-    
-fromLeftUnsafe :: Either a b -> a
-fromLeftUnsafe x = case x of
-    Left a -> a
-    Right _ -> error "Value is Right"
+addDefinedTypes l (t:ts) = t : addDefinedTypes l ts

src/TestFiles/functionTest.hs

@@ -1,7 +0,0 @@
-{-Function specification for the observation of an equity price, based on the attributes of the 'EquityValuation' class.-}
-EquityPriceObservation :: Equity
-                       -> AdjustableOrRelativeDate
-                       -> Maybe BusinessCenterTime
-                       -> Maybe TimeTypeEnum
-                       -> [DeterminationMethodEnum]
-                       -> ObservationPrimitive

src/TestFiles/testEnum.rosetta

@@ -1,4 +0,0 @@
-enum PeriodEnum: <"description">
-    D displayName "day" <"Day">
-    M displayName "month" <"Month">
-    Y displayName "year" <"Year">

src/TestFiles/testFunction.rosetta

@@ -1,12 +0,0 @@
-func EquityPriceObservation: <"Function specification for the observation of an equity price, based on the attributes of the 'EquityValuation' class.">
-   inputs:
-      equity Equity (1..1)
-      valuationDate AdjustableOrRelativeDate (1..1)
-      valuationTime BusinessCenterTime (0..1)
-      timeType TimeTypeEnum (0..1)
-      determinationMethod DeterminationMethodEnum (1..*)
-   output:
-      observation ObservationPrimitive (1..1)
-
-   assign-output
-       observation: if asd exists then var2

src/TestFiles/testType.rosetta

@@ -1,14 +0,0 @@
-type Period: <"description">
-    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">
-    testMany TestType (0..*) <"Test many">
-    testSome TestSomeType (1..*) <"Test some">
-    testMaybeOne TestZeroOneType (0..1) <"Test zero or one">
-
-type TestTypeasd: <"description">
-    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">
-
-type TestSomeType: <"description">
-    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">
-
-type TestZeroOneType: <"description">
-    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">

src/TestFiles/typeEnum.hs

@@ -1,13 +0,0 @@
-{-description-}
-data PeriodEnum =
-    {-Day-}
-    D
-    {-Month-}
-    | M
-    {-Year-}
-    | Y
-
-instance Show PeriodEnum where
-    show D = "day"
-    show M = "month"
-    show Y = "year"

src/TestFiles/typeTest.hs

@@ -1,11 +0,0 @@
-{-description-}
-data Period = MakePeriod {
-    {-A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.-}
-    periodMultiplier :: int
-    {-Test many-}
-    testMany :: [TestType]
-    {-Test some-}
-    testSome :: [TestSomeType]
-    {-Test zero or one-}
-    testMaybeOne :: Maybe TestZeroOneType
-}