on master help sign in
implement group and ungroup operators for Tutorial D
commit444ab482d1ac673622484423a4176e0f88ebd3d5 authorAgentM <agentm@themactionfaction.com> dateSun 9 Nov 2014, 10:31 (12 years ago) parent5cc025d
2 files changed+38−3
RelationExpr.hs+14 TutorialDInterpreter.hs+24−3
RelationExpr.hs+14
@@ -24,6 +24,8 @@ data RelationalExpr where
2424 Assign :: String -> RelationalExpr -> RelationalExpr
2525 MultipleExpr :: [RelationalExpr] -> RelationalExpr
2626 Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
27+ Group :: S.Set AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
28+ Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr
2729 --Restrict :: RExpr.RestrictionExpr -> RelationalExpr -> RelationalExpr
2830{- maybe break this into multiple steps:
29311. check relational types for match (attribute counts) (typechecking step
@@ -87,6 +89,18 @@ eval (Rename oldAttrName newAttrName relExpr) = do
8789 case evald of
8890 Right rel -> return $ rename oldAttrName newAttrName rel
8991 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
90104
91105emptyRelVarContext :: RelVarContext
92106emptyRelVarContext = M.empty
TutorialDInterpreter.hs+24−3
@@ -17,7 +17,7 @@ import System.Console.Readline
1717lexer :: Token.TokenParser ()
1818lexer = Token.makeTokenParser tutD
1919 where tutD = emptyDef {
20− Token.reservedOpNames = ["join", "where", "union"],
20+ Token.reservedOpNames = ["join", "where", "union", "group", "ungroup"],
2121 Token.reservedNames = [],
2222 Token.identStart = letter,
2323 Token.identLetter = alphaNum}
@@ -32,7 +32,7 @@ semi = Token.semi lexer
3232
3333--used in projection
3434attributeList :: Parser [AttributeName]
35−attributeList = braces (sepBy identifier comma)
35+attributeList = sepBy identifier comma
3636
3737makeRelation :: Parser RelationalExpr
3838makeRelation = do
@@ -72,7 +72,7 @@ relTerm = parens relExpr
7272 <|> relVarP
7373
7474projectOp = do
75− attrs <- attributeList
75+ attrs <- braces attributeList
7676 return $ Project (S.fromList attrs)
7777
7878assignP = do
@@ -91,10 +91,31 @@ renameP = do
9191 reservedOp "rename"
9292 (oldAttr, newAttr) <- braces renameClause
9393 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+
94114
95115relOperators = [
96116 [Postfix projectOp],
97117 [Postfix renameP],
118+ [Postfix groupP],
98119 [Infix (reservedOp "join" >> return Join) AssocLeft],
99120 [Infix (reservedOp "union" >> return Union) AssocLeft],
100121 [Prefix (try assignP)]