git.iko.soy/project-m36
on 49ed722 help sign in
project-m36/TutorialDInterpreter.hs
115 lines 3.3 kB history raw
1module TutorialDInterpreter where
2import RelationType
3import Relation
4import RelationExpr
5import RelationTuple
6import Text.Parsec
7import Text.Parsec.String
8import Text.Parsec.Expr
9import Text.Parsec.Language
10import qualified Text.Parsec.Token as Token
11import qualified Data.Set as S
12import qualified Data.HashSet as HS
13import qualified Data.Map as M
14import Control.Applicative ((<$), (<*), (*>), liftA, liftA2)
15import Control.Monad.State
17lexer :: Token.TokenParser ()
18lexer = Token.makeTokenParser tutD
19 where tutD = emptyDef {
20 Token.reservedOpNames = ["join", "where", "union"],
21 Token.reservedNames = [],
22 Token.identStart = letter,
23 Token.identLetter = alphaNum}
25parens = Token.parens lexer
26reservedOp = Token.reservedOp lexer
27reserved = Token.reserved lexer
28braces = Token.braces lexer
29identifier = Token.identifier lexer
30comma = Token.comma lexer
31semi = Token.semi lexer
33--used in projection
34attributeList :: Parser [AttributeName]
35attributeList = braces (sepBy identifier comma)
37makeRelation :: Parser RelationalExpr
38makeRelation = do
39 reservedOp "relation"
40 attrs <- makeAttributes
41 return $ MakeStaticRelation attrs HS.empty
43--used in relation creation
44makeAttributes :: Parser Attributes
45makeAttributes = do
46 attrList <- braces (sepBy attributeAndType comma)
47 return $ M.fromList $ map toAttributeAssocList attrList
48 where
49 toAttributeAssocList attr@(Attribute attrName _) = (attrName, attr)
51attributeAndType :: Parser Attribute
52attributeAndType = do
53 attrName <- identifier
54 attrTypeName <- identifier
55 --convert type name into type
56 case tutDTypeToAtomType attrTypeName of
57 Just t -> return $ Attribute attrName t
58 Nothing -> fail (attrTypeName ++ " is not a valid type name.")
60--convert Tutorial D type to AtomType
61tutDTypeToAtomType :: String -> Maybe AtomType
62tutDTypeToAtomType tutDType = case tutDType of
63 "char" -> Just StringAtomType
64 "int" -> Just IntAtomType
65 _ -> Nothing
67relVarP :: Parser RelationalExpr
68relVarP = liftA RelationVariable identifier
70relTerm = parens relExpr
71 <|> makeRelation
72 <|> relVarP
74projectOp = do
75 attrs <- attributeList
76 return $ Project (S.fromList attrs)
78assignP = do
79 relVarName <- identifier
80 reservedOp ":="
81 return $ Assign relVarName
83relOperators = [
84 [Postfix projectOp],
85 [Infix (reservedOp "join" >> return Join) AssocLeft],
86 [Infix (reservedOp "union" >> return Union) AssocLeft],
87 [Prefix (try assignP)]
88 ]
90relExpr :: Parser RelationalExpr
91relExpr = buildExpressionParser relOperators relTerm
93multipleRelExpr :: Parser RelationalExpr
94multipleRelExpr = do
95 exprs <- sepBy1 relExpr semi
96 return $ MultipleExpr exprs
98parseString :: String -> RelationalExpr
99parseString str = case parse multipleRelExpr "" str of
100 Left err -> error $ show err
101 Right r -> r
103example1 = "relA {a,b, c}"
104example2 = "relA join relB"
105example3 = "relA join relB {x,y,z}"
106example4 = "(relA) {x,y,z}"
107example5 = "relA union relB"
108example6 = "rv1 := true"
109example7 = "rv1 := relA union relB"
110example8 = "relA := true; relB := false"
111example9 = "relA := relation { SNO CHAR }"
113interpret :: RelVarContext -> String -> (Either RelationalError Relation, RelVarContext)
114interpret context tutdstring = runState (eval (parseString tutdstring)) context