on master help sign in
implement rename for Tutorial D
commit7555bfb6ac5de9a5d4d1f8f0002f1a7cd892f9f3 authorAgentM <agentm@themactionfaction.com> dateMon 27 Oct 2014, 10:25 (12 years ago) parent49ed722
4 files changed+25−3
Relation.hs+1−1 RelationExpr.hs+8−1 TutorialDInterpreter.hs+13 TutorialDInterpreterTest.hs+3−1
Relation.hs+1−1
@@ -136,7 +136,7 @@ rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =
136136 mkRelation newAttrs newTupSet
137137 where
138138 attributeValid = attributeNamesContained (S.singleton oldAttrName) (attributeNames rel)
139− newAttrs = M.insert newAttrName (renameAttribute newAttrName (oldAttrs M.! oldAttrName)) oldAttrs
139+ newAttrs = M.delete oldAttrName $ M.insert newAttrName (renameAttribute newAttrName (oldAttrs M.! oldAttrName)) oldAttrs
140140 newTupSet = HS.map tupsetmapper oldTupSet
141141 tupsetmapper tuple = tupleRenameAttribute oldAttrName newAttrName tuple
142142
RelationExpr.hs+8−1
@@ -25,6 +25,7 @@ data RelationalExpr where
2525 Join :: RelationalExpr -> RelationalExpr -> RelationalExpr
2626 Assign :: String -> RelationalExpr -> RelationalExpr
2727 MultipleExpr :: [RelationalExpr] -> RelationalExpr
28+ Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
2829 --Restrict :: RExpr.RestrictionExpr -> RelationalExpr -> RelationalExpr
2930{- maybe break this into multiple steps:
30311. check relational types for match (attribute counts) (typechecking step
@@ -82,7 +83,13 @@ eval (MakeStaticRelation attributes tupleSet) = do
8283 case mkRelation attributes tupleSet of
8384 Right rel -> return $ Right rel
8485 Left err -> return $ Left err
85−
86+
87+eval (Rename oldAttrName newAttrName relExpr) = do
88+ evald <- eval relExpr
89+ case evald of
90+ Right rel -> return $ rename oldAttrName newAttrName rel
91+ Left err -> return $ Left err
92+
8693emptyRelVarContext :: RelVarContext
8794emptyRelVarContext = M.empty
8895
TutorialDInterpreter.hs+13
@@ -79,9 +79,22 @@ assignP = do
7979 relVarName <- identifier
8080 reservedOp ":="
8181 return $ Assign relVarName
82+
83+renameClause = do
84+ oldAttr <- identifier
85+ reservedOp "as"
86+ newAttr <- identifier
87+ return $ (oldAttr, newAttr)
88+
89+renameP :: Parser (RelationalExpr -> RelationalExpr)
90+renameP = do
91+ reservedOp "rename"
92+ (oldAttr, newAttr) <- braces renameClause
93+ return $ Rename oldAttr newAttr
8294
8395relOperators = [
8496 [Postfix projectOp],
97+ [Postfix renameP],
8598 [Infix (reservedOp "join" >> return Join) AssocLeft],
8699 [Infix (reservedOp "union" >> return Union) AssocLeft],
87100 [Prefix (try assignP)]
TutorialDInterpreterTest.hs+3−1
@@ -13,9 +13,11 @@ main = runTestTT (TestList tests)
1313 ("false", Right relationFalse),
1414 ("true union false", Right relationTrue),
1515 ("true; false", Right relationFalse),
16− ("a:=relation{a int}", mkRelation simpleAAttributes HS.empty)
16+ ("a:=relation{a int}", mkRelation simpleAAttributes HS.empty),
17+ ("b:=relation{c int} rename {c as d}", mkRelation simpleBAttributes HS.empty)
1718 ]
1819 simpleAAttributes = M.fromList [("a", Attribute "a" IntAtomType)]
20+ simpleBAttributes = M.fromList [("d", Attribute "d" IntAtomType)]
1921
2022
2123testSimple1 = TestCase $ assertTutdEqual "true" (Right relationTrue)