diff --git a/RosettaParser.cabal b/RosettaParser.cabal index 59735af..1988952 100644 --- a/RosettaParser.cabal +++ b/RosettaParser.cabal @@ -37,6 +37,7 @@ library PrettyPrinter.Function PrettyPrinter.General PrettyPrinter.Type + Semantic.TypeChecker other-modules: Paths_RosettaParser hs-source-dirs: @@ -44,6 +45,7 @@ library build-depends: base >=4.7 && <5 , megaparsec + , mtl , parser-combinators , prettyprinter , text @@ -61,6 +63,7 @@ executable RosettaParser-exe RosettaParser , base >=4.7 && <5 , megaparsec + , mtl , parser-combinators , prettyprinter , text @@ -79,6 +82,7 @@ test-suite RosettaParser-test RosettaParser , base >=4.7 && <5 , megaparsec + , mtl , parser-combinators , prettyprinter , text diff --git a/app/Main.hs b/app/Main.hs index 26ed7bf..7d3dee6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -3,13 +3,15 @@ module Main where import Parser.Enum import Parser.Type import Parser.Function -import Data.Text +import qualified Data.Text as Text import Text.Megaparsec import PrettyPrinter.Enum import PrettyPrinter.Type import PrettyPrinter.Function import Parser.Expression +import Semantic.TypeChecker import Model.Function +import Model.Type (typeAttributes) main :: IO () main = do @@ -17,38 +19,83 @@ main = do putStrLn "rosetta String: " putStrLn rosettaString putStrLn "\nFinal enum: \n" - case parse enumParser "" (pack rosettaString) of + case parse enumParser "" (Text.pack rosettaString) of Left errorBundle -> print (errorBundlePretty errorBundle) Right enum -> putStrLn $ printEnum enum testEnum :: IO() testEnum = do rosettaString <- readFile "src/TestFiles/testEnum.rosetta" - case parse enumParser "" (pack rosettaString) of + case parse enumParser "" (Text.pack rosettaString) of Left errorBundle -> print (errorBundlePretty errorBundle) Right enum -> do putStrLn $ printEnum enum writeFile "src/TestFiles/typeEnum.hs" (printEnum enum) -testType :: IO() -testType = do +testTypeParser :: IO() +testTypeParser = do rosettaString <- readFile "src/TestFiles/testType.rosetta" - case parse typeParser "" (pack rosettaString) of + case parse typeParser "" (Text.pack rosettaString) of Left errorBundle -> print (errorBundlePretty errorBundle) Right typ -> do putStrLn $ printType typ print typ writeFile "src/TestFiles/typeTest.hs" (printType typ) + +testTypeChecker :: IO () +testTypeChecker = do + rosettaString <- readFile "src/TestFiles/testType.rosetta" + case parse (many typeParser) "" (Text.pack rosettaString) of + Left errorBundle -> print (errorBundlePretty errorBundle) + Right typ -> + do + print $ map (checkAttributes definedTypes . typeAttributes) typ + where definedTypes = addDefinedTypes [] typ testFunc :: IO() testFunc = do rosettaString <- readFile "src/TestFiles/testFunction.rosetta" - case parse functionParser "" (pack rosettaString) of + case parse functionParser "" (Text.pack rosettaString) of Left errorBundle -> print (errorBundlePretty errorBundle) Right fun -> do print $ printFunctionSignature fun print (assignments fun) - writeFile "src/TestFiles/functionTest.hs" (show $ printFunctionSignature fun) \ No newline at end of file + writeFile "src/TestFiles/functionTest.hs" (show $ printFunctionSignature fun) + +testExpTypeChecker :: IO () +testExpTypeChecker = print $ mapExpsToTypes expressions + +mapExpsToTypes :: [String] -> [(String, String)] +mapExpsToTypes [] = [] +mapExpsToTypes (expr: exps) = do + case parse expressionParser "" (Text.pack expr) of + Left errorBundle -> error (errorBundlePretty errorBundle) + Right ex -> (show ex, checkExpression defaultMap ex) :mapExpsToTypes exps + +expressions :: [String] +expressions = [ + --Or Good + "True or False", +-- --Or Bad +-- "1 or False", + --And Good + "False and False", +-- --And Bad +-- "1 and 2", + --Exists Good + "a exists", + --Plus Good + "1.2 + 2.3", +-- --Plus Bad +-- "True + 2", + --If Good + "if True then 2 else 3", +-- --If Bad Cond +-- "if 2 then True else False", + --If Bad exps +-- "if True then 2 else False" + "if True or False then 24 + 15 else 55 + 98 + 35 + 34" + ] \ No newline at end of file diff --git a/package.yaml b/package.yaml index bf40823..7f93a1b 100644 --- a/package.yaml +++ b/package.yaml @@ -23,6 +23,7 @@ dependencies: - base >= 4.7 && < 5 - megaparsec - time +- mtl - prettyprinter - parser-combinators - text diff --git a/src/Model/Type.hs b/src/Model/Type.hs index 29bbb1f..388d14a 100644 --- a/src/Model/Type.hs +++ b/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] diff --git a/src/Parser/Expression.hs b/src/Parser/Expression.hs index 351c9b8..0b73395 100644 --- a/src/Parser/Expression.hs +++ b/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" \ No newline at end of file +testFail = parseTest expressionParser "if[1,as]thenxandoelseaora" +testOr = parseTest expressionParser "a or b" \ No newline at end of file diff --git a/src/PrettyPrinter/Type.hs b/src/PrettyPrinter/Type.hs index 3208443..1518bbe 100644 --- a/src/PrettyPrinter/Type.hs +++ 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 diff --git a/src/Semantic/TypeChecker.hs b/src/Semantic/TypeChecker.hs new file mode 100644 index 0000000..21888cb --- /dev/null +++ b/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 \ No newline at end of file diff --git a/src/TestFiles/testType.rosetta b/src/TestFiles/testType.rosetta index 7aa9021..a6c36e6 100644 --- a/src/TestFiles/testType.rosetta +++ b/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"> \ No newline at end of file + +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."> \ No newline at end of file