added type checker

src/Model/Type.hs

@@ -1,19 +1,8 @@
 module Model.Type where
 
 import Data.Time.LocalTime()
-import Model.Enum
 
-data BasicType = String 
-    | Integer 
-    | Double 
-    | Boolean 
-    | TimeOfDay
-    deriving (Show)
-
-data Type = 
-    TypeFromBasicType BasicType
-    | TypeFromEnum EnumType
-    | MakeType {
+data Type = MakeType {
         typeName :: String,
         typeDescription :: Maybe String,
         typeAttributes :: [TypeAttribute]

src/Parser/Expression.hs

@@ -125,11 +125,14 @@ eqParser :: Parser Expression
 eqParser =
     do
         s <- sumParser
-        op <- lexeme $ observing (string  "<=" <|> string "=" <|> string "<" <|> string ">" <|> string ">=")
+        op <- lexeme $ observing $ choice $ fmap (try . string . Text.pack) eqFunctions
         case op of
             Left _ -> return s
             Right o -> eqParser >>= \ex -> return $ InfixExp (Text.unpack o) s ex
 
+eqFunctions :: [String]
+eqFunctions = ["=", "<", "<=", ">", ">=", "<>", "all =", "all <>", "any =", "any <>"]
+
 sumParser :: Parser Expression
 sumParser =
     do
@@ -148,10 +151,19 @@ factorParser =
             Left _ -> return p
             Right o -> factorParser >>= \ex -> return $ reverseExpression $ InfixExp [o] p ex
 
+boolOpParser :: Parser Expression
+boolOpParser = 
+    do 
+        p <- postfixParser
+        op <- lexeme $ observing (string "or" <|> string "and")
+        case op of
+            Left _ -> return p
+            Right o -> boolOpParser >>= \ex -> return $ InfixExp (Text.unpack o) p ex
+
 powerParser :: Parser Expression
 powerParser = 
     do
-        p <- postfixParser
+        p <- boolOpParser
         op <- lexeme $ observing $ char '^'
         case op of
             Left _ -> return p
@@ -161,11 +173,14 @@ postfixParser :: Parser Expression
 postfixParser = 
     do
         t <- terminalParser
-        op <- lexeme $ observing (string "exists" <|> string "is absent" <|> string "count" <|> string "only-element")
+        op <- lexeme $ observing $ choice $ fmap (try . string . Text.pack) postfixFunctions
         case op of
             Left _ -> return t
             Right o -> return $ PostfixExp (Text.unpack o) t
 
+postfixFunctions :: [String]
+postfixFunctions = ["exists", "is absent", "count", "only-element", "single exists", "multiple exists"]
+
 --------------------------------------------
 -- Auxiliary  ------------------------------
 --------------------------------------------
@@ -200,4 +215,5 @@ 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"
+testFail = parseTest expressionParser "if[1,as]thenxandoelseaora"
+testOr = parseTest expressionParser "a or b"

src/PrettyPrinter/Type.hs

@@ -5,18 +5,14 @@ module PrettyPrinter.Type where
 import Prettyprinter
 import PrettyPrinter.General
 import Model.Type
-import Model.Enum
 
 printType :: Type -> String
 printType (MakeType name description attributes) =
     show $ printDescription description (vcat [nest 4 $ vcat("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": map printAttribute attributes), "}", ""])
-printType x = show x 
    
 printTypeName :: Type -> String
 printTypeName (MakeType name _ _) = name
-printTypeName (TypeFromBasicType name) = show name
-printTypeName (TypeFromEnum (MakeEnum name _ _)) = name 
-   
+
 printAttribute :: TypeAttribute -> Doc a
 printAttribute (MakeTypeAttribute name typ crd description) =
     printDescription description 

src/Semantic/TypeChecker.hs

@@ -0,0 +1,126 @@
+module Semantic.TypeChecker where
+
+import Model.Type
+import Model.Function
+
+data Symbol = Var{
+  varName :: String,
+  declaredType :: String
+  }
+  | Func {
+  funcName :: String,
+  argsType :: [String],
+  returnType :: String
+  }
+
+defaultMap :: [Symbol]
+defaultMap = [
+  Func "or" ["Boolean", "Boolean"] "Boolean",
+  Func "and" ["Boolean", "Boolean"] "Boolean",
+  Func "exists" ["Any"] "Boolean",
+  Func "is absent" ["Any"] "Boolean",
+  Func "single exists" ["Any"] "Boolean",
+  Func "multiple exists" ["Any"] "Boolean",
+  Func "contains" ["Any", "Any"] "Boolean",
+  Func "disjoint" ["Any", "Any"] "Boolean",
+  
+  Func "=" ["Any", "Any"] "Boolean",
+  Func ">=" ["Any", "Any"] "Boolean",
+  Func "<=" ["Any", "Any"] "Boolean",
+  Func "<>" ["Any", "Any"] "Boolean",
+  Func ">" ["Any", "Any"] "Boolean",
+  Func "<" ["Any", "Any"] "Boolean",
+  Func "all =" ["Any", "Any"] "Boolean",
+  Func "all <>" ["Any", "Any"] "Boolean",
+  Func "any =" ["Any", "Any"] "Boolean",
+  Func "any <>" ["Any", "Any"] "Boolean",
+  
+  Func "+" ["Integer", "Integer"] "Integer",
+  Func "+" ["Double", "Double"] "Double",
+  Func "-" ["Integer", "Integer"] "Integer",
+  Func "-" ["Double", "Double"] "Double",
+  Func "*" ["Integer", "Integer"] "Integer",
+  Func "*" ["Double", "Double"] "Double",
+  Func "/" ["Integer", "Integer"] "Integer",
+  Func "/" ["Double", "Double"] "Double",
+  Func "^" ["Integer", "Integer"] "Integer",
+  Func "^" ["Double", "Double"] "Double",
+  
+  Func "count" ["Any"] "Integer"
+  ]
+
+checkAttributes :: [String] -> [TypeAttribute] -> [String]
+checkAttributes _ [] = []
+checkAttributes definedTypes ((MakeTypeAttribute _ name _ _):as) = checkType definedTypes name : checkAttributes definedTypes as 
+
+checkType :: [String] -> String -> String
+checkType _ "int" = "Integer"
+checkType _ "string" = "String"
+checkType _ "boolean" = "Bool"
+checkType _ "time" = "Time"
+checkType _ "number" = "Double"
+checkType definedTypes name
+    | name `elem` definedTypes = name
+    | otherwise = error "Undefined type: " ++ name
+  
+addDefinedTypes :: [String] -> [Type] -> [String]
+addDefinedTypes l [] = l
+addDefinedTypes l ((MakeType name _ _):ts) = name : 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 -> String
+checkExpression symbolMap (Variable var) = findVar var symbolMap
+checkExpression _ (Int _) = "Integer"
+checkExpression _ (Real _) = "Double"
+checkExpression _ (Boolean _) = "Boolean"
+checkExpression _ Empty = "Empty"
+checkExpression symbolMap (Parens ex) = checkExpression symbolMap ex
+checkExpression _ (List _) = "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)
+    | condType == "Boolean" = checkExpression symbolMap ex
+    | otherwise = error "Expected boolean condition in if statement"
+    where condType = checkExpression symbolMap cond
+checkExpression symbolMap (IfElse cond ex1 ex2)
+    | condType /= "Boolean" = error "Expected boolean condition in if statement" 
+    | not (typeMatch ex1Type ex2Type) = error "Types of then and else branches don't match"
+    | otherwise = ex1Type
+    where   condType = checkExpression symbolMap cond
+            ex1Type = checkExpression symbolMap ex1
+            ex2Type = checkExpression symbolMap ex2
+    
+
+checkFunctionCall :: [Symbol] -> String -> [String] -> String
+checkFunctionCall [] fun args = error "Undefined function: " ++ fun ++ concat args
+checkFunctionCall ((Func n a r):symbolMap) name args
+    | name == n && and (zipWith typeMatch a args) = r
+    | otherwise = checkFunctionCall symbolMap name args
+checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args 
+
+typeMatch :: String -> String -> Bool
+typeMatch "Any" _ = True
+typeMatch _ "Any" = True
+typeMatch s s2 = s == s2
+
+findVar :: String -> [Symbol] -> String
+findVar var [] = error "Undefined variable " ++ var
+findVar x ((Var name typ):symbols) 
+    | x == name = typ
+    | otherwise = findVar x symbols
+findVar x (_:symbols) = findVar x symbols

src/TestFiles/testType.rosetta

@@ -1,13 +1,14 @@
 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.">
-    period periodEnum (1..1) <"A time period, e.g. a day, week, month or year of the stream. If the periodMultiplier values is 0 (zero) then period must contain the value D (day).">
-    testMany testType (0..*) <"Test many">
-    testSome testSomeType (1..*) <"Test some">
-    testMaybeOne testZeroOneType (0..1) <"Test zero or one">
+    testMany TestType (0..*) <"Test many">
+    testSome TestSomeType (1..*) <"Test some">
+    testMaybeOne TestZeroOneType (0..1) <"Test zero or one">
 
-type Period: <"description">
+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.">
-    period periodEnum (1..1) <"A time period, e.g. a day, week, month or year of the stream. If the periodMultiplier values is 0 (zero) then period must contain the value D (day).">
-    testMany testType (0..*) <"Test many">
-    testSome testSomeType (1..*) <"Test some">
-    testMaybeOne testZeroOneType (0..1) <"Test zero or one">
+
+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.">