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

git.iko.soy/project-m36

add basic static relational and database context optimizations

commit7d96a23fa83300f3935d58c299b71b67ca78226b authorAgentM <agentm@themactionfaction.com> dateThu 5 Feb 2015, 10:21 (12 years ago) parent44ec3cd

6 files changed+52−15

compare with master

unifiedsplit

Relation.hs+4 RelationExpr.hs+17−3 RelationType.hs+3−4 TutorialDInterpreter.hs+17−1 TutorialDInterpreterTest.hs+5−6 project-m36.cabal+6−1

Relation.hs+4

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

193193 where

194194 unsafeRelValFromAtom :: Atom -> Relation

195195 unsafeRelValFromAtom (RelationAtom rel) = rel

196+ unsafeRelValFromAtom (StringAtom _) = undefined

197+ unsafeRelValFromAtom (IntAtom _) = undefined

196198 _ -> Left $ AttributeIsNotRelationValuedError relvalAttrName

197199

198200--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

207209 where

208210 unsafeRelValFromAtom :: Atom -> Relation

209211 unsafeRelValFromAtom (RelationAtom rel) = rel

212+ unsafeRelValFromAtom (StringAtom _) = undefined

213+ unsafeRelValFromAtom (IntAtom _) = undefined

210214

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

212216restrict 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

105105 supplierProducts = supplierProductsRel

106106

107107suppliersRel = case mkRelation attributes tupleSet of

108+ Left err -> undefined

108109 Right rel -> rel

109110 where

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

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

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

120121

121122productsRel = case mkRelation attributes tupleSet of

123+ Left err -> undefined

122124 Right rel -> rel

123125 where

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

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

137139 ]

138140

139141supplierProductsRel = case mkRelation attributes tupleSet of

142+ Left err -> undefined

140143 Right rel -> rel

141144 where

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

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

242245 return Nothing

243246

244247evalContextExpr (MultipleExpr exprs) = do

245− evald <- mapM evalContextExpr exprs

246− return $ last evald

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

249+ evald <- forM exprs evalContextExpr

250+ --some lifting magic needed here

251+ case catMaybes evald of

252+ [] -> return $ Nothing

253+ err:l -> return $ Just err

247254

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

249256--evalRelVarExpr (Update relVarName updateMap) = do

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

284291

285292-- 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

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

294+

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

288296typeForRelationalExpr expr = do

289297 state <- get

290298 --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

292300 evalRelationalExpr expr

293301

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+

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

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

296310predicateRestrictionFilter context (AndPredicate expr1 expr2) = do

RelationType.hs+3−4

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

5252 Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr

5353 Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr

5454 Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr

55−

5655{- maybe break this into multiple steps:

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

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

59583. execute the plan

6059-}

61− deriving (Show)

60+ deriving (Show,Eq)

6261

6362data DatabaseContext = DatabaseContext {

6463 inclusionDependencies :: HS.HashSet InclusionDependency,

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

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

8483 AddInclusionDependency :: InclusionDependency -> DatabaseExpr

8584 MultipleExpr :: [DatabaseExpr] -> DatabaseExpr

86− deriving (Show)

85+ deriving (Show,Eq)

8786

8887type DatabaseState a = State DatabaseContext a

8988

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

9493 NotPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr

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

9695 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

77import RelationalError

88import RelationExpr

99import RelationTerm

10+import RelationStaticOptimizer

1011import Text.Parsec

1112import Text.Parsec.String

1213import Text.Parsec.Expr

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

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

2930 Token.reservedNames = [],

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

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

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

3233

3334parens = Token.parens lexer

3435reservedOp = Token.reservedOp lexer

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

325326

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

327328interpret 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

328343 Left err -> (Just err, context)

329344 Right parsed -> runState (evalContextExpr parsed) context

345+

330346

331347-- for interpreter-specific operations

332348interpretOps :: DatabaseContext -> String -> TutorialDOperatorResult

TutorialDInterpreterTest.hs+5−6

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

1212 counts <- runTestTT (TestList tests)

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

1414 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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

3435 ("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)]])),

3536 ("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)]])

3637 ]

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

4546 ("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)

4647 ]

4748

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

5150 where

5251 interpreted = case interpret databaseContext tutd of

5352 (Just err, _) -> Left err

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

5554 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

99Executable tutd

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

1111 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

1313

1414Test-Suite test-tutoriald

1515 type: exitcode-stdio-1.0

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

1919Test-Suite test-relation

2020 type: exitcode-stdio-1.0

2121 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

2227 Build-Depends: base,HUnit,Cabal