7d96a23 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

add basic static relational and database context optimizations

7d96a23AgentM12 years ago

Relation.hs+4

compare with master

unifiedsplit

@@ -193,6 +193,8 @@ tupleUngroup relvalAttrName newAttrs tuple@(RelationTuple tupMap) = case (tupMap

193 where

194 unsafeRelValFromAtom :: Atom -> Relation

195 unsafeRelValFromAtom (RelationAtom rel) = rel

196+ unsafeRelValFromAtom (StringAtom _) = undefined

197+ unsafeRelValFromAtom (IntAtom _) = undefined

196 _ -> Left $ AttributeIsNotRelationValuedError relvalAttrName

198 _ -> Left $ AttributeIsNotRelationValuedError relvalAttrName

197

199

198--this is a hack needed because the relation attributes are untyped so we must dig into the relval to get the attribute names

200--this is a hack needed because the relation attributes are untyped so we must dig into the relval to get the attribute names

@@ -207,6 +209,8 @@ attributesForRelval relvalAttrName relIn@(Relation attrs tupleSet) = attributes

207 where

209 where

208 unsafeRelValFromAtom :: Atom -> Relation

210 unsafeRelValFromAtom :: Atom -> Relation

209 unsafeRelValFromAtom (RelationAtom rel) = rel

211 unsafeRelValFromAtom (RelationAtom rel) = rel

212+ unsafeRelValFromAtom (StringAtom _) = undefined

213+ unsafeRelValFromAtom (IntAtom _) = undefined

210

214

211restrict :: (RelationTuple -> Bool) -> Relation -> Either RelationalError Relation

215restrict :: (RelationTuple -> Bool) -> Relation -> Either RelationalError Relation

212restrict filter (Relation attrs tupset) = Right $ Relation attrs $ HS.filter filter tupset

216restrict filter (Relation attrs tupset) = Right $ Relation attrs $ HS.filter filter tupset

RelationExpr.hs+17−3

@@ -105,6 +105,7 @@ dateExamples = DatabaseContext { inclusionDependencies = HS.empty, -- add foreig

105 supplierProducts = supplierProductsRel

106

107suppliersRel = case mkRelation attributes tupleSet of

108+ Left err -> undefined

108 Right rel -> rel

109 Right rel -> rel

109 where

110 where

110 attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

111 attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

@@ -119,6 +120,7 @@ suppliersRel = case mkRelation attributes tupleSet of

119 M.fromList [("S#", StringAtom "S5"), ("SNAME", StringAtom "Adams"), ("STATUS", IntAtom 30), ("CITY", StringAtom "Athens")]]

120 M.fromList [("S#", StringAtom "S5"), ("SNAME", StringAtom "Adams"), ("STATUS", IntAtom 30), ("CITY", StringAtom "Athens")]]

120

121

121productsRel = case mkRelation attributes tupleSet of

122productsRel = case mkRelation attributes tupleSet of

123+ Left err -> undefined

122 Right rel -> rel

124 Right rel -> rel

123 where

125 where

124 attributes = M.fromList [("P#", Attribute "P#" StringAtomType),

126 attributes = M.fromList [("P#", Attribute "P#" StringAtomType),

@@ -137,6 +139,7 @@ productsRel = case mkRelation attributes tupleSet of

137 ]

139 ]

138

140

139supplierProductsRel = case mkRelation attributes tupleSet of

141supplierProductsRel = case mkRelation attributes tupleSet of

142+ Left err -> undefined

140 Right rel -> rel

143 Right rel -> rel

141 where

144 where

142 attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

145 attributes = M.fromList [("S#", Attribute "S#" StringAtomType),

@@ -242,8 +245,12 @@ evalContextExpr (AddInclusionDependency dep) = do

242 return Nothing

245 return Nothing

243

246

244evalContextExpr (MultipleExpr exprs) = do

247evalContextExpr (MultipleExpr exprs) = do

248+ --the multiple expressions must pass the same context around- not the old unmodified context

245− evald <- mapM evalContextExpr exprs

249+ evald <- forM exprs evalContextExpr

250+ --some lifting magic needed here

251+ case catMaybes evald of

246− return $ last evald

252+ [] -> return $ Nothing

253+ err:l -> return $ Just err

247

254

248-- restrict relvar to get affected tuples, update tuples, delete restriction from relvar, relvar = relvar union updated tuples

255-- restrict relvar to get affected tuples, update tuples, delete restriction from relvar, relvar = relvar union updated tuples

249--evalRelVarExpr (Update relVarName updateMap) = do

256--evalRelVarExpr (Update relVarName updateMap) = do

@@ -284,13 +291,20 @@ checkConstraint (InclusionDependency name subDep superDep) = do

284

291

285-- the type of a relational expression is equal to the relation attribute set returned from executing the relational expression; therefore, the type can be cheaply derived by evaluating a relational expression and ignoring and tuple processing

292-- the type of a relational expression is equal to the relation attribute set returned from executing the relational expression; therefore, the type can be cheaply derived by evaluating a relational expression and ignoring and tuple processing

286-- furthermore, the type of a relational expression is the resultant header of the evaluated empty-tupled relation

293-- furthermore, the type of a relational expression is the resultant header of the evaluated empty-tupled relation

294+

287typeForRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

295typeForRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

288typeForRelationalExpr expr = do

296typeForRelationalExpr expr = do

289 state <- get

297 state <- get

290 --replace the relationVariables context element with a cloned set of relation devoid of tuples

298 --replace the relationVariables context element with a cloned set of relation devoid of tuples

291− put $ DatabaseContext (inclusionDependencies state) $ M.map (\rel -> Relation (attributes rel) emptyTupleSet) (relationVariables state)

299+ put $ contextWithEmptyTupleSets state

292 evalRelationalExpr expr

300 evalRelationalExpr expr

293

301

302+--returns a database context with all tuples removed

303+--this is useful for type checking and optimization

304+contextWithEmptyTupleSets :: DatabaseContext -> DatabaseContext

305+contextWithEmptyTupleSets contextIn = DatabaseContext (inclusionDependencies contextIn) $ M.map (\rel -> Relation (attributes rel) emptyTupleSet) (relationVariables contextIn)

306+

307+

294{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}

308{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}

295predicateRestrictionFilter :: DatabaseContext -> RestrictionPredicateExpr -> Either RelationalError (RelationTuple -> Bool)

309predicateRestrictionFilter :: DatabaseContext -> RestrictionPredicateExpr -> Either RelationalError (RelationTuple -> Bool)

296predicateRestrictionFilter context (AndPredicate expr1 expr2) = do

310predicateRestrictionFilter context (AndPredicate expr1 expr2) = do

RelationType.hs+3−4

@@ -52,13 +52,12 @@ data RelationalExpr where

52 Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr

53 Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr

54 Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr

55−

56{- maybe break this into multiple steps:

55{- maybe break this into multiple steps:

571. check relational types for match (attribute counts) (typechecking step

561. check relational types for match (attribute counts) (typechecking step

582. create an execution plan (another system of nodes, another GADT)

572. create an execution plan (another system of nodes, another GADT)

593. execute the plan

583. execute the plan

60-}

59-}

61− deriving (Show)

60+ deriving (Show,Eq)

63data DatabaseContext = DatabaseContext {

62data DatabaseContext = DatabaseContext {

64 inclusionDependencies :: HS.HashSet InclusionDependency,

63 inclusionDependencies :: HS.HashSet InclusionDependency,

@@ -83,7 +82,7 @@ data DatabaseExpr where

83 Update :: String -> M.Map String Atom -> RestrictionPredicateExpr -> DatabaseExpr -- needs restriction support

82 Update :: String -> M.Map String Atom -> RestrictionPredicateExpr -> DatabaseExpr -- needs restriction support

84 AddInclusionDependency :: InclusionDependency -> DatabaseExpr

83 AddInclusionDependency :: InclusionDependency -> DatabaseExpr

85 MultipleExpr :: [DatabaseExpr] -> DatabaseExpr

84 MultipleExpr :: [DatabaseExpr] -> DatabaseExpr

86− deriving (Show)

85+ deriving (Show,Eq)

88type DatabaseState a = State DatabaseContext a

87type DatabaseState a = State DatabaseContext a

@@ -94,4 +93,4 @@ data RestrictionPredicateExpr where

94 NotPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr

93 NotPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr

95 RelationalExprPredicate :: RelationalExpr -> RestrictionPredicateExpr --type must be same as true and false relations (no attributes)

94 RelationalExprPredicate :: RelationalExpr -> RestrictionPredicateExpr --type must be same as true and false relations (no attributes)

96 AttributeEqualityPredicate :: AttributeName -> Atom -> RestrictionPredicateExpr -- relationalexpr must result in relation with single tuple

95 AttributeEqualityPredicate :: AttributeName -> Atom -> RestrictionPredicateExpr -- relationalexpr must result in relation with single tuple

97− deriving (Show)

96+ deriving (Show, Eq)

TutorialDInterpreter.hs+17−1

@@ -7,6 +7,7 @@ import RelationTupleSet

7import RelationalError

8import RelationExpr

9import RelationTerm

10+import RelationStaticOptimizer

10import Text.Parsec

11import Text.Parsec

11import Text.Parsec.String

12import Text.Parsec.String

12import Text.Parsec.Expr

13import Text.Parsec.Expr

@@ -28,7 +29,7 @@ lexer = Token.makeTokenParser tutD

28 Token.reservedOpNames = ["join", "where", "union", "group", "ungroup"],

29 Token.reservedOpNames = ["join", "where", "union", "group", "ungroup"],

29 Token.reservedNames = [],

30 Token.reservedNames = [],

30 Token.identStart = letter <|> char '_',

31 Token.identStart = letter <|> char '_',

31− Token.identLetter = alphaNum <|> char '_'}

32+ Token.identLetter = alphaNum <|> char '_' <|> char '#'} -- # needed for Date examples

33parens = Token.parens lexer

34parens = Token.parens lexer

34reservedOp = Token.reservedOp lexer

35reservedOp = Token.reservedOp lexer

@@ -325,8 +326,23 @@ example9 = "relA := relation { SNO CHAR }"

325

326

326interpret :: DatabaseContext -> String -> (Maybe RelationalError, DatabaseContext)

327interpret :: DatabaseContext -> String -> (Maybe RelationalError, DatabaseContext)

327interpret context tutdstring = case parseString tutdstring of

328interpret context tutdstring = case parseString tutdstring of

329+ Left err -> (Just err, context)

330+ Right parsed -> runState (evaluator parsed) context

331+ where

332+ evaluator expr = do

333+ context <- get

334+ optExpr <- applyStaticDatabaseOptimization expr

335+ --case optExpr of

336+ case optExpr of

337+ Left err -> return $ Just err

338+ Right optExprA -> evalContextExpr optExprA

339+

340+--no optimization

341+interpretNO :: DatabaseContext -> String -> (Maybe RelationalError, DatabaseContext)

342+interpretNO context tutdstring = case parseString tutdstring of

328 Left err -> (Just err, context)

343 Left err -> (Just err, context)

329 Right parsed -> runState (evalContextExpr parsed) context

344 Right parsed -> runState (evalContextExpr parsed) context

345+

330

346

331-- for interpreter-specific operations

347-- for interpreter-specific operations

332interpretOps :: DatabaseContext -> String -> TutorialDOperatorResult

348interpretOps :: DatabaseContext -> String -> TutorialDOperatorResult

TutorialDInterpreterTest.hs+5−6

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

12 counts <- runTestTT (TestList tests)

13 if errors counts + failures counts > 0 then exitFailure else exitSuccess

14 where

15− tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext tutd expected) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples tutd expected) dateExampleRelTests

15+ tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext expected tutd) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples expected tutd) dateExampleRelTests

16 simpleRelTests = [("x:=true", Right relationTrue),

17 ("x:=false", Right relationFalse),

18 ("x:=true union false", Right relationTrue),

@@ -22,6 +22,7 @@ main = do

22 ("y:=relation{b int, c int}; x:=y{c}", mkRelation simpleProjectionAttributes HS.empty),

23 ("x:=relation{tuple{a char(\"spam\"), b int(5)}}", mkRelation simpleCAttributes (HS.fromList $ map RelationTuple [M.fromList [("a", StringAtom "spam"),("b",IntAtom 5)]])),

24 ("constraint failc true in false; x:=true", Left $ InclusionDependencyCheckError "failc"),

25+ ("x:=y; x:=true", Left $ RelVarNotDefinedError "y"),

25 ("x:=true where true", Right relationTrue),

26 ("x:=true where true", Right relationTrue),

26 ("x:=true where false", Right relationFalse),

27 ("x:=true where false", Right relationFalse),

27 ("x:=true where true or false", Right relationTrue),

28 ("x:=true where true or false", Right relationTrue),

@@ -30,7 +31,7 @@ main = do

30 ("x:=true where true and true", Right relationTrue),

31 ("x:=true where true and true", Right relationTrue),

31 ("x:=true=true", Right relationTrue),

32 ("x:=true=true", Right relationTrue),

32 ("x:=true=false", Right relationFalse),

33 ("x:=true=false", Right relationFalse),

33− ("x:=true; undefine x", Right relationTrue),

34+ ("x:=true; undefine x", Left (RelVarNotDefinedError "x")),

34 ("x:=relation {b int, a char}; insert x relation{tuple{b int(5), a char(\"spam\")}}", mkRelation simpleCAttributes (HS.fromList [RelationTuple $ M.fromList [("a", StringAtom "spam"), ("b", IntAtom 5)]])),

35 ("x:=relation {b int, a char}; insert x relation{tuple{b int(5), a char(\"spam\")}}", mkRelation simpleCAttributes (HS.fromList [RelationTuple $ M.fromList [("a", StringAtom "spam"), ("b", IntAtom 5)]])),

35 ("x:=relation{tuple{b int(5),a char(\"spam\")},tuple{b int(6),a char(\"sam\")}}; delete x where b=6", mkRelation simpleCAttributes $ HS.fromList [RelationTuple $ M.fromList [("a", StringAtom "spam"), ("b", IntAtom 5)]])

36 ("x:=relation{tuple{b int(5),a char(\"spam\")},tuple{b int(6),a char(\"sam\")}}; delete x where b=6", mkRelation simpleCAttributes $ HS.fromList [RelationTuple $ M.fromList [("a", StringAtom "spam"), ("b", IntAtom 5)]])

36 ]

37 ]

@@ -45,12 +46,10 @@ main = do

45 ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\(RelationTuple tupMap) -> RelationTuple $ if tupMap M.! "SNAME" == StringAtom "Blake" then M.insert "CITY" (StringAtom "Boston") tupMap else tupMap) s)

46 ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\(RelationTuple tupMap) -> RelationTuple $ if tupMap M.! "SNAME" == StringAtom "Blake" then M.insert "CITY" (StringAtom "Boston") tupMap else tupMap) s)

46 ]

47 ]

48−testSimple1 = TestCase $ assertTutdEqual basicDatabaseContext "true" (Right relationTrue)

49−

50−assertTutdEqual databaseContext tutd expected = assertEqual tutd interpreted expected

49+assertTutdEqual databaseContext expected tutd = assertEqual tutd expected interpreted

51 where

50 where

52 interpreted = case interpret databaseContext tutd of

51 interpreted = case interpret databaseContext tutd of

53 (Just err, _) -> Left err

52 (Just err, _) -> Left err

54 (Nothing, context) -> case M.lookup "x" (relationVariables context) of

53 (Nothing, context) -> case M.lookup "x" (relationVariables context) of

55 Nothing -> Left $ RelVarNotDefinedError "x"

54 Nothing -> Left $ RelVarNotDefinedError "x"

56− Just rel -> Right rel

55+ Just rel -> Right rel

project-m36.cabal+6−1

@@ -9,7 +9,7 @@ Cabal-Version: >= 1.2

9Executable tutd

10 Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory

11 main-is: tutd.hs

12− GHC-Options: -fwarn-unused-imports -fwarn-unused-binds

12+ GHC-Options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns

14Test-Suite test-tutoriald

15 type: exitcode-stdio-1.0

@@ -19,4 +19,9 @@ Test-Suite test-tutoriald

19Test-Suite test-relation

20 type: exitcode-stdio-1.0

21 main-is: RelationTest.hs

22+ Build-Depends: base,HUnit,Cabal

23+

24+Test-Suite test-static-optimizer

25+ type: exitcode-stdio-1.0

26+ main-is: RelationStaticOptimizerTest.hs

22 Build-Depends: base,HUnit,Cabal

27 Build-Depends: base,HUnit,Cabal