78bc7c6 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

add “all but” convenience syntax

78bc7c6AgentM11 years ago

ProjectM36/Attribute.hs+1

compare with master

unifiedsplit

@@ -116,3 +116,4 @@ verifyAttributes attrs = if collapsedAttrs /= attrs then

116

117attributesEqual :: Attributes -> Attributes -> Bool

118attributesEqual attrs1 attrs2 = V.null (attributesDifference attrs1 attrs2)

119+

ProjectM36/Base.hs+6−2

@@ -104,11 +104,11 @@ data RelationalExpr where

104 --in Tutorial D, relational variables pick up the type of the first relation assigned to them

105 --relational variables should also be able to be explicitly-typed like in Haskell

106 RelationVariable :: RelVarName -> RelationalExpr

107− Project :: S.Set AttributeName -> RelationalExpr -> RelationalExpr

107+ Project :: AttributeNames -> RelationalExpr -> RelationalExpr

108 Union :: RelationalExpr -> RelationalExpr -> RelationalExpr

109 Join :: RelationalExpr -> RelationalExpr -> RelationalExpr

110 Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr

111− Group :: S.Set AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr

111+ Group :: AttributeNames -> AttributeName -> RelationalExpr -> RelationalExpr

112 Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr

113 Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr

114 Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr

@@ -227,3 +227,7 @@ instance Show AtomFunction where

227 show aFunc = T.unpack (atomFuncName aFunc) ++ "::" ++ showArgTypes

228 where

229 showArgTypes = concat (L.intersperse "->" $ map show (atomFuncType aFunc))

230+

231+data AttributeNames = AttributeNames (S.Set AttributeName) |

232+ InvertedAttributeNames (S.Set AttributeName)

233+ deriving (Eq, Show)

ProjectM36/Relation.hs+14−21

@@ -9,6 +9,7 @@ import qualified Data.Vector as V

9import ProjectM36.Base

10import ProjectM36.Tuple

11import qualified ProjectM36.Attribute as A

12+import qualified ProjectM36.AttributeNames as AS

12import ProjectM36.TupleSet

13import ProjectM36.TupleSet

13import ProjectM36.Error

14import ProjectM36.Error

14import Prelude hiding (join)

15import Prelude hiding (join)

@@ -79,18 +80,19 @@ union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =

79 where

80 where

80 newtuples = HS.union tupSet1 tupSet2

81 newtuples = HS.union tupSet1 tupSet2

82−project :: S.Set AttributeName -> Relation -> Either RelationalError Relation

83+project :: AttributeNames -> Relation -> Either RelationalError Relation

83project projectionAttrNames rel =

84project projectionAttrNames rel =

84− if not $ A.attributeNamesContained projectionAttrNames (attributeNames rel)

85+ if not $ A.attributeNamesContained selectedAttrNames (attributeNames rel)

85 then Left $ AttributeNameMismatchError ""

86 then Left $ AttributeNameMismatchError ""

86 else

87 else

87 relFold folder (Right $ Relation newAttrs HS.empty) rel

88 relFold folder (Right $ Relation newAttrs HS.empty) rel

88 where

89 where

89− newAttrs = attributesForNames projectionAttrNames rel

90+ selectedAttrNames = A.attributeNameSet newAttrs

91+ newAttrs = AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames

90 folder :: RelationTuple -> Either RelationalError Relation -> Either RelationalError Relation

92 folder :: RelationTuple -> Either RelationalError Relation -> Either RelationalError Relation

91 folder tupleToProject acc = case acc of

93 folder tupleToProject acc = case acc of

92 Left err -> Left err

94 Left err -> Left err

93− Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleProject projectionAttrNames tupleToProject)))

95+ Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleProject selectedAttrNames tupleToProject)))

95rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

97rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

96rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =

98rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =

@@ -127,9 +129,8 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do

127 relFold folder (Right (Relation newAttrs emptyTupleSet)) nonGroupProjection

129 relFold folder (Right (Relation newAttrs emptyTupleSet)) nonGroupProjection

128 where

130 where

129 newAttrs = M.union (attributesForNames nonGroupAttrNames rel) groupAttr

131 newAttrs = M.union (attributesForNames nonGroupAttrNames rel) groupAttr

130− groupAttr = Attribute newAttrName RelationAtomType (attributesForNames nonGroupAttrNames rel)

132+ groupAttr = Attribute newAttrName RelationAtomType (invertedAttributeNames groupAttrNames (attributes rel))

131− newAttrNameSet = S.insert newAttrName nonGroupAttrNames

133+ nonGroupAttrNames = invertAttributeNames (attributes rel) groupAttrNames

132− nonGroupAttrNames = S.difference groupAttrNames (attributeNames rel)

133 --map the projection to add the additional new attribute

134 --map the projection to add the additional new attribute

134 --create the new attribute (a new relation) by filtering and projecting the tupleSet

135 --create the new attribute (a new relation) by filtering and projecting the tupleSet

135 folder tupleFromProjection acc = case acc of

136 folder tupleFromProjection acc = case acc of

@@ -138,26 +139,18 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do

138-}

139-}

139

140

140--algorithm: self-join with image relation

141--algorithm: self-join with image relation

141−group :: S.Set AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

142+group :: AttributeNames -> AttributeName -> Relation -> Either RelationalError Relation

142group groupAttrNames newAttrName rel = do

143group groupAttrNames newAttrName rel = do

143 nonGroupProjection <- project nonGroupAttrNames rel

144 nonGroupProjection <- project nonGroupAttrNames rel

144 relMogrify mogrifier newAttrs nonGroupProjection

145 relMogrify mogrifier newAttrs nonGroupProjection

145 where

146 where

146− newAttrs = A.addAttribute groupAttr (attributesForNames nonGroupAttrNames rel)

147+ newAttrs = A.addAttribute groupAttr (AS.projectionAttributesForAttributeNames (attributes rel) nonGroupAttrNames)

147− groupAttr = Attribute newAttrName (RelationAtomType (attributesForNames groupAttrNames rel))

148+ groupAttr = Attribute newAttrName (RelationAtomType (AS.projectionAttributesForAttributeNames (attributes rel) groupAttrNames))

148− nonGroupAttrNames = A.nonMatchingAttributeNameSet groupAttrNames (attributeNames rel)

149+ nonGroupAttrNames = AS.invertAttributeNames groupAttrNames

149 mogrifier tupIn = tupleExtend tupIn (matchingRelTuple tupIn)

150 mogrifier tupIn = tupleExtend tupIn (matchingRelTuple tupIn)

150 matchingRelTuple tupIn = case imageRelationFor tupIn rel of

151 matchingRelTuple tupIn = case imageRelationFor tupIn rel of

151 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))

152 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))

152 Left _ -> undefined

153 Left _ -> undefined

153−{-

154− folder tupleIn acc = case acc of

155− Left err -> Left err

156− Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleExtend tupleIn (matchingRelTuple tupleIn))))

157− matchingRelTuple groupTuple = case imageRelationFor groupTuple rel of

158− Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))

159− Left _ -> undefined

160−-}

161

154

162--help restriction function

155--help restriction function

163--returns a subrelation of

156--returns a subrelation of

@@ -245,8 +238,8 @@ relFold folder acc (Relation _ tupleSet) = HS.foldr folder acc tupleSet

245imageRelationFor :: RelationTuple -> Relation -> Either RelationalError Relation

238imageRelationFor :: RelationTuple -> Relation -> Either RelationalError Relation

246imageRelationFor matchTuple rel = do

239imageRelationFor matchTuple rel = do

247 restricted <- restrictEq matchTuple rel --restrict across matching tuples

240 restricted <- restrictEq matchTuple rel --restrict across matching tuples

248− project (A.nonMatchingAttributeNameSet (attributeNames rel) (tupleAttributeNameSet matchTuple)) restricted --project across attributes not in rel

241+ let projectionAttrNames = AttributeNames $ A.nonMatchingAttributeNameSet (attributeNames rel) (tupleAttributeNameSet matchTuple)

249−

242+ project projectionAttrNames restricted --project across attributes not in rel

250

243

251--returns a relation-valued attribute image relation for each tuple in rel1

244--returns a relation-valued attribute image relation for each tuple in rel1

252--algorithm:

245--algorithm:

ProjectM36/RelationalExpression.hs+2−2

@@ -22,10 +22,10 @@ evalRelationalExpr (RelationVariable name) = do

22 Just res -> Right res

23 Nothing -> Left $ RelVarNotDefinedError name

25−evalRelationalExpr (Project attrNameSet expr) = do

25+evalRelationalExpr (Project attrNames expr) = do

26 rel <- evalRelationalExpr expr

27 case rel of

28− Right rel2 -> return $ project attrNameSet rel2

28+ Right rel2 -> return $ project attrNames rel2

29 Left err -> return $ Left err

31evalRelationalExpr (Union exprA exprB) = do

ProjectM36/StaticOptimizer.hs+2−1

@@ -3,6 +3,7 @@ import ProjectM36.Base

3import ProjectM36.RelationalExpression

4import ProjectM36.Relation

5import ProjectM36.Error

6+import qualified ProjectM36.AttributeNames as AS

6import ProjectM36.TupleSet

7import ProjectM36.TupleSet

7import Control.Monad.State hiding (join)

8import Control.Monad.State hiding (join)

8import Data.Either (rights, lefts)

9import Data.Either (rights, lefts)

@@ -23,7 +24,7 @@ applyStaticRelationalOptimization (Project attrNameSet expr) = do

23 relType <- typeForRelationalExpr expr

24 relType <- typeForRelationalExpr expr

24 case relType of

25 case relType of

25 Left err -> return $ Left err

26 Left err -> return $ Left err

26− Right relType2 -> if attributeNames relType2 == attrNameSet then

27+ Right relType2 -> if attributeNames relType2 == AS.attributeNameSet attrNameSet then

27 applyStaticRelationalOptimization expr

28 applyStaticRelationalOptimization expr

28 else do

29 else do

29 optimizedSubExpression <- applyStaticRelationalOptimization expr

30 optimizedSubExpression <- applyStaticRelationalOptimization expr

TutorialD/Interpreter/Base.hs+4

@@ -39,6 +39,9 @@ comma = Token.comma lexer

39semi :: Parser String

40semi = Token.semi lexer

42+whiteSpace :: Parser ()

43+whiteSpace = Token.whiteSpace lexer

44+

42--convert Tutorial D type to AtomType

45--convert Tutorial D type to AtomType

43tutDTypeToAtomType :: String -> Maybe AtomType

46tutDTypeToAtomType :: String -> Maybe AtomType

44tutDTypeToAtomType tutDType = case tutDType of

47tutDTypeToAtomType tutDType = case tutDType of

@@ -65,3 +68,4 @@ data TutorialDOperatorResult = QuitResult |

65 DisplayResult StringType |

68 DisplayResult StringType |

66 DisplayErrorResult StringType |

69 DisplayErrorResult StringType |

67 QuietSuccessResult

70 QuietSuccessResult

71+

TutorialD/Interpreter/RelationalExpr.hs+7−5

@@ -16,10 +16,12 @@ import Control.Applicative (liftA, (<*), (*>), (<$>))

16import Data.Functor.Identity (Identity)

18--used in projection

19−attributeListP :: Parser [AttributeName]

19+attributeListP :: Parser AttributeNames

20attributeListP = do

21+ but <- try (string "all but " <* whiteSpace) <|> string ""

22+ let constructor = if but == "" then AttributeNames else InvertedAttributeNames

21 attrs <- sepBy identifier comma

23 attrs <- sepBy identifier comma

22− return $ map T.pack attrs

24+ return $ constructor (S.fromList (map T.pack attrs))

24makeRelationP :: Parser RelationalExpr

26makeRelationP :: Parser RelationalExpr

25makeRelationP = do

27makeRelationP = do

@@ -69,7 +71,7 @@ tupleAtomP = do

69projectP :: Parser (RelationalExpr -> RelationalExpr)

71projectP :: Parser (RelationalExpr -> RelationalExpr)

70projectP = do

72projectP = do

71 attrs <- braces attributeListP

73 attrs <- braces attributeListP

72− return $ Project (S.fromList attrs)

74+ return $ Project attrs

74renameClauseP :: Parser (String, String)

76renameClauseP :: Parser (String, String)

75renameClauseP = do

77renameClauseP = do

@@ -90,7 +92,7 @@ whereClauseP = do

90 boolExpr <- restrictionPredicateP

92 boolExpr <- restrictionPredicateP

91 return $ Restrict boolExpr

93 return $ Restrict boolExpr

93−groupClauseP :: Parser ([AttributeName], String)

95+groupClauseP :: Parser (AttributeNames, String)

94groupClauseP = do

96groupClauseP = do

95 attrs <- braces attributeListP

97 attrs <- braces attributeListP

96 reservedOp "as"

98 reservedOp "as"

@@ -101,7 +103,7 @@ groupP :: Parser (RelationalExpr -> RelationalExpr)

101groupP = do

103groupP = do

102 reservedOp "group"

104 reservedOp "group"

103 (groupAttrList, groupAttrName) <- parens groupClauseP

105 (groupAttrList, groupAttrName) <- parens groupClauseP

104− return $ Group (S.fromList groupAttrList) (T.pack groupAttrName)

106+ return $ Group groupAttrList (T.pack groupAttrName)

105

107

106--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--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.

107ungroupP :: Parser (RelationalExpr -> RelationalExpr)

109ungroupP :: Parser (RelationalExpr -> RelationalExpr)

project-m36.cabal+1

@@ -13,6 +13,7 @@ Library

13 ProjectM36.Transaction.Show,

14 ProjectM36.Base,

15 ProjectM36.Attribute,

16+ ProjectM36.AttributeNames,

16 ProjectM36.Tuple,

17 ProjectM36.Tuple,

17 ProjectM36.TupleSet,

18 ProjectM36.TupleSet,

18 ProjectM36.Atom,

19 ProjectM36.Atom,

test/Relation/StaticOptimizer.hs+1−1

@@ -16,7 +16,7 @@ main = do

16 tests = relationOptTests ++ databaseOptTests

17 optTest optfunc testparams = map (\(name, expr, unopt) -> TestCase $ assertEqual name expr (evalState (optfunc unopt) dateExamples)) $ testparams

18 relationOptTests = optTest applyStaticRelationalOptimization [

19− ("StaticProject", Right $ RelationVariable "S", Project (attributeNames suppliersRel) (RelationVariable "S")),

19+ ("StaticProject", Right $ RelationVariable "S", Project (AttributeNames (attributeNames suppliersRel)) (RelationVariable "S")),

20 ("StaticUnion", Right $ RelationVariable "S", Union (RelationVariable "S") (RelationVariable "S")),

21 ("StaticJoin", Right $ RelationVariable "S", Join (RelationVariable "S") (RelationVariable "S")),

22 ("StaticRestrictTrue", Right $ RelationVariable "S", Restrict TruePredicate (RelationVariable "S")),

test/TutorialD/Interpreter.hs+3−1

@@ -80,7 +80,9 @@ main = do

80 ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S3", StringAtom "Blake", IntAtom 30, StringAtom "Paris"],

81 [StringAtom "S5", StringAtom "Adams", IntAtom 30, StringAtom "Athens"]]),

82 ("x:=S where ^sum(@STATUS)", Left $ AtomTypeMismatchError IntAtomType BoolAtomType),

83− ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]])

83+ ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]]),

84+ --test "all but" attribute inversion syntax

85+ ("x:=S{all but S#} = S{CITY,SNAME,STATUS}",Right $ relationTrue)

84 ]

86 ]