8ea9b8c · project-m36 · git.iko.soy

git.iko.soy/project-m36

WIP implement inclusion dependency

8ea9b8cAgentM10 years ago

src/lib/ProjectM36/Base.hs+1−1

@@ -1,4 +1,4 @@

1−{-# LANGUAGE ExistentialQuantification,BangPatterns,DeriveGeneric,DeriveAnyClass, TypeSynonymInstances, FlexibleInstances #-}

1+{-# LANGUAGE ExistentialQuantification,BangPatterns,DeriveGeneric,DeriveAnyClass, TypeSynonymInstances, FlexibleInstances, DeriveFoldable #-}

2{-# OPTIONS_GHC -fno-warn-orphans #-}

3module ProjectM36.Base where

4import qualified Data.Map as M

src/lib/ProjectM36/InclusionDependency.hs+1−1

@@ -5,6 +5,7 @@ import ProjectM36.Error

5import ProjectM36.Relation

6import qualified Data.Map as M

7import qualified Data.Text as T

8+import qualified Data.Set as S

9inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation

10inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation

10inclusionDependenciesAsRelation incDeps = do

11inclusionDependenciesAsRelation incDeps = do

@@ -17,4 +18,3 @@ inclusionDependenciesAsRelation incDeps = do

17 incDepAsAtoms (name, (InclusionDependency exprA exprB)) = [TextAtom name,

18 incDepAsAtoms (name, (InclusionDependency exprA exprB)) = [TextAtom name,

18 TextAtom (T.pack (show exprA)),

19 TextAtom (T.pack (show exprA)),

19 TextAtom (T.pack (show exprB))]

20 TextAtom (T.pack (show exprB))]

20−

src/lib/ProjectM36/RelationalExpression.hs+63−4

@@ -9,9 +9,11 @@ import ProjectM36.AtomType

9import ProjectM36.AtomFunctionBody

10import ProjectM36.DataTypes.Primitive

11import ProjectM36.AtomFunction

12+import ProjectM36.StaticOptimizer

12import qualified ProjectM36.Attribute as A

13import qualified ProjectM36.Attribute as A

13import qualified Data.Map as M

14import qualified Data.Map as M

14import qualified Data.HashSet as HS

15import qualified Data.HashSet as HS

16+import qualified Data.Set as S

15import Control.Monad.State hiding (join)

17import Control.Monad.State hiding (join)

16import Control.Exception

18import Control.Exception

17import Data.Maybe

19import Data.Maybe

@@ -25,6 +27,8 @@ import Control.Monad.Trans.Except

25import GHC

27import GHC

26import GHC.Paths

28import GHC.Paths

30+import Debug.Trace

31+

28-- we need to pass around a higher level RelationTuple and Attributes in order to solve #52

32-- we need to pass around a higher level RelationTuple and Attributes in order to solve #52

29data RelationalExprStateElems = RelationalExprStateTupleElems DatabaseContext RelationTuple | -- used when fully evaluating a relexpr

33data RelationalExprStateElems = RelationalExprStateTupleElems DatabaseContext RelationTuple | -- used when fully evaluating a relexpr

30 RelationalExprStateAttrsElems DatabaseContext Attributes | --used when evaluating the type of a relexpr

34 RelationalExprStateAttrsElems DatabaseContext Attributes | --used when evaluating the type of a relexpr

@@ -420,11 +424,14 @@ updateTupleWithAtomExprs exprMap context tupIn = do

420

424

421--run verification on all constraints

425--run verification on all constraints

422checkConstraints :: DatabaseContext -> Maybe RelationalError

426checkConstraints :: DatabaseContext -> Maybe RelationalError

423−checkConstraints context = case failures of

427+checkConstraints context = case optimizedIncDepMap of

428+ Left err -> Just err

429+ Right filteredIncDepMap -> case failures filteredIncDepMap of

424− [] -> Nothing

430+ [] -> Nothing

425− l:_ -> Just l

431+ l -> Just (MultipleErrors l)

426 where

432 where

433+ optimizedIncDepMap = filterInclusionDependenciesForValidation deps

427− failures = M.elems $ M.mapMaybeWithKey checkIncDep deps

434+ failures incDeps = M.elems $ M.mapMaybeWithKey checkIncDep incDeps

428 deps = inclusionDependencies context

435 deps = inclusionDependencies context

429 eval expr = evalState (evalRelationalExpr expr) (RelationalExprStateElems context)

436 eval expr = evalState (evalRelationalExpr expr) (RelationalExprStateElems context)

430 checkIncDep depName (InclusionDependency subsetExpr supersetExpr) = do

437 checkIncDep depName (InclusionDependency subsetExpr supersetExpr) = do

@@ -688,3 +695,55 @@ evalTupleExpr attrs (TupleExpr tupMap) = runExceptT $ do

688 _ <- either throwE pure (validateTuple tup' tConss)

695 _ <- either throwE pure (validateTuple tup' tConss)

689 pure tup'

696 pure tup'

690

697

698+ -- | Return all relation variable names mentioned in the relational expression. This is used by the constraint static optimizer to determine which relvars are relevant.

699+relationVariableNames :: Show a => RelationalExprBase a -> S.Set RelVarName

700+relationVariableNames relExpr = foldRelationalExprs (\names re -> case re of

701+ RelationVariable name _ -> S.insert name names

702+ _ -> names) S.empty relExpr

703+

704+-- | Return all the unit RelationalExprs. This is useful, for example, for finding all mentions of relation

705+foldRelationalExprs :: (b -> RelationalExprBase a -> b) -> b -> RelationalExprBase a -> b

706+foldRelationalExprs func accum expr = case expr of

707+ e@(MakeRelationFromExprs _ tupleExprs) -> foldl func accum (e : concatMap tupleExprRelationalExprs tupleExprs)

708+ e@(MakeStaticRelation _ _) -> folder e []

709+ e@(ExistingRelation _) -> folder e []

710+ e@(RelationVariable _ _) -> folder e []

711+ e@(Project _ expr2) -> folder e [expr2]

712+ e@(Union exprA exprB) -> folder e [exprA, exprB]

713+ e@(Join exprA exprB) -> folder e [exprA, exprB]

714+ e@(Rename _ _ expr2) -> folder e [expr2]

715+ e@(Difference exprA exprB) -> folder e [exprA, exprB]

716+ e@(Group _ _ expr2) -> folder e [expr2]

717+ e@(Ungroup _ expr2) -> folder e [expr2]

718+ e@(Restrict predi expr2) -> folder e (expr2 : restrictionPredicateRelationalExprs predi)

719+ e@(Equals exprA exprB) -> folder e [exprA, exprB]

720+ e@(NotEquals exprA exprB) -> folder e [exprA, exprB]

721+ e@(Extend extendExpr expr2) -> folder e (expr2 : extendTupleRelationalExprs extendExpr)

722+ where

723+ folder e exprs = func (foldl (foldRelationalExprs func) accum exprs) e

724+

725+-- | Scan tupleExpr to return RelationExprs.

726+tupleExprRelationalExprs :: TupleExprBase a -> [RelationalExprBase a]

727+tupleExprRelationalExprs (TupleExpr amap) = concat (map atomExprRelationalExprs (M.elems amap))

728+

729+atomExprRelationalExprs :: AtomExprBase a -> [RelationalExprBase a]

730+atomExprRelationalExprs (FunctionAtomExpr _ exprs _) = concatMap atomExprRelationalExprs exprs

731+atomExprRelationalExprs (RelationAtomExpr expr) = [expr]

732+atomExprRelationalExprs (ConstructedAtomExpr _ exprs _) = concatMap atomExprRelationalExprs exprs

733+atomExprRelationalExprs _ = []

734+

735+restrictionPredicateRelationalExprs :: RestrictionPredicateExprBase a -> [RelationalExprBase a]

736+restrictionPredicateRelationalExprs predi = case predi of

737+ TruePredicate -> []

738+ AndPredicate exprA exprB -> restrictionPredicateRelationalExprs exprA ++ restrictionPredicateRelationalExprs exprB

739+ OrPredicate exprA exprB -> restrictionPredicateRelationalExprs exprA ++ restrictionPredicateRelationalExprs exprB

740+ NotPredicate expr -> restrictionPredicateRelationalExprs expr

741+ RelationalExprPredicate relExpr -> foldRelationalExprs (\acc expr -> expr : acc) [] relExpr

742+ AtomExprPredicate atomExpr -> atomExprRelationalExprs atomExpr

743+ AttributeEqualityPredicate _ atomExpr -> atomExprRelationalExprs atomExpr

744+

745+extendTupleRelationalExprs :: ExtendTupleExprBase a -> [RelationalExprBase a]

746+extendTupleRelationalExprs (AttributeExtendTupleExpr _ atomExpr) = atomExprRelationalExprs atomExpr

747+

748+relvarReferences :: InclusionDependency -> S.Set RelVarName

749+relvarReferences (InclusionDependency super sub) = S.union (relationVariableNames super) (relationVariableNames sub)

src/lib/ProjectM36/StaticOptimizer.hs+84−2

@@ -1,12 +1,15 @@

1module ProjectM36.StaticOptimizer where

2import ProjectM36.Base

3−import ProjectM36.RelationalExpression

3+--import ProjectM36.RelationalExpression

4import ProjectM36.Relation

5import ProjectM36.Error

6+import ProjectM36.InclusionDependency

6import qualified ProjectM36.AttributeNames as AS

7import qualified ProjectM36.AttributeNames as AS

7import ProjectM36.TupleSet

8import ProjectM36.TupleSet

8import Control.Monad.State hiding (join)

9import Control.Monad.State hiding (join)

9import Data.Either (rights, lefts)

10import Data.Either (rights, lefts)

11+import qualified Data.Set as S

12+import qualified Data.Map as M

11-- the static optimizer performs optimizations which need not take any specific-relation statistics into account

14-- the static optimizer performs optimizations which need not take any specific-relation statistics into account

12-- apply optimizations which merely remove steps to become no-ops: example: projection of a relation across all of its attributes => original relation

15-- apply optimizations which merely remove steps to become no-ops: example: projection of a relation across all of its attributes => original relation

@@ -183,4 +186,83 @@ applyStaticDatabaseOptimization (MultipleExpr exprs) = do

183 --restore original context

186 --restore original context

184

187

185applyStaticPredicateOptimization :: RestrictionPredicateExpr -> RelationalExprState (Either RelationalError RestrictionPredicateExpr)

188applyStaticPredicateOptimization :: RestrictionPredicateExpr -> RelationalExprState (Either RelationalError RestrictionPredicateExpr)

186−applyStaticPredicateOptimization predicate = return $ Right predicate

189+applyStaticPredicateOptimization predicate = return $ Right predicate

190+

191+-- | Potentially optimize away constraints which need not be checked- they are tautologically valid because the update cannot possibly violate the constraint.

192+data Validation = NoValidationNeeded |

193+ ValidationNeeded |

194+ Violated --sometimes, we statically know that the inclusion dependency will be violated

195+ deriving (Eq, Show, Ord)

196+

197+filterInclusionDependenciesForValidation :: DatabaseContextExpr -> InclusionDependencies -> Either RelationalError InclusionDependencies

198+filterInclusionDependenciesForValidation context incDeps = if M.size errors > 0 then

199+ Left (MultipleErrors errors)

200+ else

201+ Right needValidation

202+ where

203+ violated = M.filter ((==) Violated) validationMap

204+ errors = map InclusionDependencyCheckError (M.elems violated)

205+ validationMap = M.map (inclusionDependencyValidation context) incDeps

206+ needValidation = M.filter ((==) ValidationNeeded) validationMap

207+

208+

209+inclusionDependencyValidation :: DatabaseContextExpr -> InclusionDependency -> Validation

210+

211+inclusionDependencyValidation NoOperation _ = NoValidationNeeded

212+

213+-- a new relvar cannot possibly part of any constraint

214+inclusionDependencyValidation (Define _ _) _ = NoValidationNeeded

215+

216+-- if there are any foreign keys pointing to the relvar, then

217+inclusionDependencyValidation (Undefine name) incDep = if

218+ _nameInIncDep name incDep then

219+ Violated

220+ else

221+ NoValidationNeeded

222+

223+inclusionDependencyValidation (Assign name _) incDep = _nameInIncDepValidation name incDep

224+

225+inclusionDependencyValidation (Insert name _) incDep = _nameInIncDepValidation name incDep

226+

227+inclusionDependencyValidation (Delete name _) incDep = _nameInIncDepValidation name incDep

228+

229+inclusionDependencyValidation (Update name _ _) incDep = _nameInIncDepValidation name incDep

230+

231+--inc deps can't violate another inc dep- there is no change in relvars

232+inclusionDependencyValidation (AddInclusionDependency _ _) _ = NoValidationNeeded

233+

234+inclusionDependencyValidation (RemoveInclusionDependency _) _ = NoValidationNeeded

235+

236+inclusionDependencyValidation (AddNotification _ _ _) _ = NoValidationNeeded

237+

238+inclusionDependencyValidation (RemoveNotification _) _ = NoValidationNeeded

239+

240+inclusionDependencyValidation (AddTypeConstructor _ _) _ = NoValidationNeeded

241+

242+inclusionDependencyValidation (RemoveTypeConstructor _) _ = NoValidationNeeded

243+

244+inclusionDependencyValidation (RemoveAtomFunction _) _ = NoValidationNeeded

245+

246+inclusionDependencyValidation (MultipleExpr exprs) incDep = checkValidation validationSet

247+ where

248+ validationSet = S.fromList (map (flip inclusionDependencyValidation incDep) exprs)

249+

250+_nameInIncDep :: RelVarName -> InclusionDependency -> Bool

251+_nameInIncDep name incDep = S.member name (relvarReferences incDep)

252+

253+_nameInIncDepValidation :: RelVarName -> InclusionDependency -> Validation

254+_nameInIncDepValidation name incDep = if _nameInIncDep name incDep then

255+ ValidationNeeded

256+ else

257+ NoValidationNeeded

258+

259+-- | Return what validation is needed after looking at optimizations over multiple expressions.

260+checkValidation :: S.Set Validation -> Validation

261+checkValidation vSet = if S.member Violated vSet then

262+ Violated

263+ else if S.member ValidationNeeded vSet || S.null vSet then

264+ ValidationNeeded

265+ else

266+ NoValidationNeeded

267+

268+

test/Relation/StaticOptimizer.hs+17−1

@@ -4,16 +4,19 @@ import ProjectM36.RelationalExpression

4import ProjectM36.DateExamples

5import ProjectM36.TupleSet

6import ProjectM36.StaticOptimizer

7+import ProjectM36.Key

8+import ProjectM36.InclusionDependency

7import System.Exit

9import System.Exit

8import Control.Monad.State

10import Control.Monad.State

9import Test.HUnit

11import Test.HUnit

12+import qualified Data.Set as S

11main :: IO ()

14main :: IO ()

12main = do

15main = do

13 tcounts <- runTestTT (TestList tests)

16 tcounts <- runTestTT (TestList tests)

14 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess

17 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess

15 where

18 where

16− tests = relationOptTests ++ databaseOptTests

19+ tests = relationOptTests ++ databaseOptTests ++ [testIncDepOptimizer]

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

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

18 relvar nam = RelationVariable nam ()

21 relvar nam = RelationVariable nam ()

19 relationOptTests = optTest applyStaticRelationalOptimization (mkRelationalExprState dateExamples) [

22 relationOptTests = optTest applyStaticRelationalOptimization (mkRelationalExprState dateExamples) [

@@ -34,3 +37,16 @@ main = do

34 MultipleExpr [Assign "z" (Restrict TruePredicate (relvar "s")),

37 MultipleExpr [Assign "z" (Restrict TruePredicate (relvar "s")),

35 Assign "z" (Restrict TruePredicate (relvar "s"))])

38 Assign "z" (Restrict TruePredicate (relvar "s"))])

36 ]

39 ]

40+

41+-- test that the static optimizer doesn't eliminate inclusion dependencies improperly

42+testIncDepOptimizer :: Test

43+testIncDepOptimizer = TestCase $ do

44+ --simple case: an insert not mentioning the incdep need not be validated

45+ let incDep1 = inclusionDependencyForKey (AttributeNames (S.singleton "attrX")) (RelationVariable "rv" ())

46+ (InclusionDependency i1 _) = incDep1

47+ putStrLn (show i1)

48+ putStrLn (show (relationVariableNames i1))

49+ assertEqual "relevant relvar names" (S.singleton "rv") (relvarReferences incDep1)

50+ assertEqual "irrelevant insert" NoValidationNeeded (inclusionDependencyValidation (Insert "rv2" (RelationVariable "x" ())) incDep1)

51+ assertEqual "relevant insert" ValidationNeeded (inclusionDependencyValidation (Insert "rv" (RelationVariable "x" ())) incDep1)

52+