on master help sign in
add relational equality operator to Tutorial D
commitf95e64c4fb7f2513fe8d65f1b95f9f4e15b23004 authorAgentM <agentm@themactionfaction.com> dateTue 27 Jan 2015, 19:45 (12 years ago) parent2f6b871
4 files changed+37−4
RelationExpr.hs+12−1 RelationType.hs+1 TutorialDInterpreter.hs+21−2 TutorialDInterpreterTest.hs+3−1
RelationExpr.hs+12−1
@@ -72,6 +72,17 @@ evalRelationalExpr (Restrict predicateExpr relExpr) = do
7272 Right rel -> case predicateRestrictionFilter context predicateExpr of
7373 Left err -> return $ Left err
7474 Right filterfunc -> return $ restrict filterfunc rel
75+
76+evalRelationalExpr (Equals relExprA relExprB) = do
77+ evaldA <- evalRelationalExpr relExprA
78+ evaldB <- evalRelationalExpr relExprB
79+ case evaldA of
80+ Left err -> return $ Left err
81+ Right relA -> case evaldB of
82+ Left err -> return $ Left err
83+ Right relB -> return $ Right $ if relA == relB then relationTrue else relationFalse
84+
85+
7586
7687emptyDatabaseContext :: DatabaseContext
7788emptyDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,
@@ -130,7 +141,7 @@ supplierProductsRel = case mkRelation attributes tupleSet of
130141 where
131142 attributes = M.fromList [("S#", Attribute "S#" StringAtomType),
132143 ("P#", Attribute "P#" StringAtomType),
133− ("QTY", Attribute "QTY" StringAtomType)]
144+ ("QTY", Attribute "QTY" IntAtomType)]
134145 tupleSet = HS.fromList $ mkRelationTuples attributes [
135146 M.fromList [("S#", StringAtom "S1"), ("P#", StringAtom "P1"), ("QTY", IntAtom 300)],
136147 M.fromList [("S#", StringAtom "S1"), ("P#", StringAtom "P2"), ("QTY", IntAtom 200)],
RelationType.hs+1
@@ -51,6 +51,7 @@ data RelationalExpr where
5151 Group :: S.Set AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
5252 Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr
5353 Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr
54+ Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr
5455
5556{- maybe break this into multiple steps:
56571. check relational types for match (attribute counts) (typechecking step
TutorialDInterpreter.hs+21−2
@@ -61,7 +61,25 @@ attributeAndType = do
6161 case tutDTypeToAtomType attrTypeName of
6262 Just t -> return $ Attribute attrName t
6363 Nothing -> fail (attrTypeName ++ " is not a valid type name.")
64−
64+
65+tupleP :: Parser RelationTuple
66+tupleP = do
67+ reservedOp "tuple"
68+ attrValues <- braces (sepBy tupleAtomP comma)
69+ return $ RelationTuple (M.fromList attrValues)
70+
71+tupleAtomP :: Parser (AttributeName, Atom)
72+tupleAtomP = do
73+ attributeName <- identifier
74+ attrType <- identifier
75+ atom <- parens (stringAtomP <|> intAtomP)
76+ case tutDTypeToAtomType attrType of
77+ Nothing -> fail (attrType ++ " is not a valid type name.")
78+ Just typeA -> if typeA == atomTypeForAtom atom then
79+ return $ (attributeName, atom)
80+ else
81+ fail "type mismatch in tuple generation"
82+
6583--convert Tutorial D type to AtomType
6684tutDTypeToAtomType :: String -> Maybe AtomType
6785tutDTypeToAtomType tutDType = case tutDType of
@@ -139,7 +157,8 @@ relOperators = [
139157 [Postfix groupP],
140158 [Postfix ungroupP],
141159 [Infix (reservedOp "join" >> return Join) AssocLeft],
142− [Infix (reservedOp "union" >> return Union) AssocLeft]
160+ [Infix (reservedOp "union" >> return Union) AssocLeft],
161+ [Infix (reservedOp "=" >> return Equals) AssocNone]
143162 ]
144163
145164relExpr :: Parser RelationalExpr
TutorialDInterpreterTest.hs+3−1
@@ -28,7 +28,9 @@ main = do
2828 ("x:=true where true or false", Right relationTrue),
2929 ("x:=true where false or false", Right relationFalse),
3030 ("x:=true where true and false", Right relationFalse),
31− ("x:=true where true and true", Right relationTrue)
31+ ("x:=true where true and true", Right relationTrue),
32+ ("x:=true=true", Right relationTrue),
33+ ("x:=true=false", Right relationFalse)
3234 ]
3335 simpleAAttributes = M.fromList [("a", Attribute "a" IntAtomType)]
3436 simpleBAttributes = M.fromList [("d", Attribute "d" IntAtomType)]