on master help sign in
implement group and ungroup operators for Tutorial D
444ab48AgentM
RelationExpr.hs+14
@@ -24,6 +24,8 @@ data RelationalExpr where
24 Assign :: String -> RelationalExpr -> RelationalExpr
24 Assign :: String -> RelationalExpr -> RelationalExpr
25 MultipleExpr :: [RelationalExpr] -> RelationalExpr
25 MultipleExpr :: [RelationalExpr] -> RelationalExpr
26 Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
26 Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
27+ Group :: S.Set AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
28+ Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr
27 --Restrict :: RExpr.RestrictionExpr -> RelationalExpr -> RelationalExpr
29 --Restrict :: RExpr.RestrictionExpr -> RelationalExpr -> RelationalExpr
28{- maybe break this into multiple steps:
30{- maybe break this into multiple steps:
291. check relational types for match (attribute counts) (typechecking step
311. check relational types for match (attribute counts) (typechecking step
@@ -87,6 +89,18 @@ eval (Rename oldAttrName newAttrName relExpr) = do
87 case evald of
89 case evald of
88 Right rel -> return $ rename oldAttrName newAttrName rel
90 Right rel -> return $ rename oldAttrName newAttrName rel
89 Left err -> return $ Left err
91 Left err -> return $ Left err
92+
93+eval (Group oldAttrNameSet newAttrName relExpr) = do
94+ evald <- eval relExpr
95+ case evald of
96+ Right rel -> return $ group oldAttrNameSet newAttrName rel
97+ Left err -> return $ Left err
98+
99+eval (Ungroup attrName relExpr) = do
100+ evald <- eval relExpr
101+ case evald of
102+ Right rel -> return $ ungroup attrName rel
103+ Left err -> return $ Left err
90
104
91emptyRelVarContext :: RelVarContext
105emptyRelVarContext :: RelVarContext
92emptyRelVarContext = M.empty
106emptyRelVarContext = M.empty
TutorialDInterpreter.hs+24−3
@@ -17,7 +17,7 @@ import System.Console.Readline
17lexer :: Token.TokenParser ()
17lexer :: Token.TokenParser ()
18lexer = Token.makeTokenParser tutD
18lexer = Token.makeTokenParser tutD
19 where tutD = emptyDef {
19 where tutD = emptyDef {
20− Token.reservedOpNames = ["join", "where", "union"],
20+ Token.reservedOpNames = ["join", "where", "union", "group", "ungroup"],
21 Token.reservedNames = [],
21 Token.reservedNames = [],
22 Token.identStart = letter,
22 Token.identStart = letter,
23 Token.identLetter = alphaNum}
23 Token.identLetter = alphaNum}
@@ -32,7 +32,7 @@ semi = Token.semi lexer
32
32
33--used in projection
33--used in projection
34attributeList :: Parser [AttributeName]
34attributeList :: Parser [AttributeName]
35−attributeList = braces (sepBy identifier comma)
35+attributeList = sepBy identifier comma
36
36
37makeRelation :: Parser RelationalExpr
37makeRelation :: Parser RelationalExpr
38makeRelation = do
38makeRelation = do
@@ -72,7 +72,7 @@ relTerm = parens relExpr
72 <|> relVarP
72 <|> relVarP
73
73
74projectOp = do
74projectOp = do
75− attrs <- attributeList
75+ attrs <- braces attributeList
76 return $ Project (S.fromList attrs)
76 return $ Project (S.fromList attrs)
77
77
78assignP = do
78assignP = do
@@ -91,10 +91,31 @@ renameP = do
91 reservedOp "rename"
91 reservedOp "rename"
92 (oldAttr, newAttr) <- braces renameClause
92 (oldAttr, newAttr) <- braces renameClause
93 return $ Rename oldAttr newAttr
93 return $ Rename oldAttr newAttr
94+
95+groupClause = do
96+ attrs <- braces attributeList
97+ reservedOp "as"
98+ newAttrName <- identifier
99+ return $ (attrs, newAttrName)
100+
101+groupP :: Parser (RelationalExpr -> RelationalExpr)
102+groupP = do
103+ reservedOp "group"
104+ (groupAttrList, groupAttrName) <- parens groupClause
105+ return $ Group (S.fromList groupAttrList) groupAttrName
106+
107+--in "Time and Relational Theory" (2014), Date's Tutorial D grammar for ungroup takes one attribute, while in previous books, it take multiple arguments. Let us assume that nested ungroups are the same as multiple attributes.
108+ungroupP :: Parser (RelationalExpr -> RelationalExpr)
109+ungroupP = do
110+ reservedOp "ungroup"
111+ rvaAttrName <- identifier
112+ return $ Ungroup rvaAttrName
113+
94
114
95relOperators = [
115relOperators = [
96 [Postfix projectOp],
116 [Postfix projectOp],
97 [Postfix renameP],
117 [Postfix renameP],
118+ [Postfix groupP],
98 [Infix (reservedOp "join" >> return Join) AssocLeft],
119 [Infix (reservedOp "join" >> return Join) AssocLeft],
99 [Infix (reservedOp "union" >> return Union) AssocLeft],
120 [Infix (reservedOp "union" >> return Union) AssocLeft],
100 [Prefix (try assignP)]
121 [Prefix (try assignP)]