@@ -1,3 +1,6 @@
1+{-# LANGUAGE TypeSynonymInstances #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE FlexibleContexts #-}
14module ProjectM36.StaticOptimizer where
25import ProjectM36.Base
36import ProjectM36.GraphRefRelationalExpr
@@ -18,12 +21,26 @@ import Data.Functor.Identity
1821import qualified Data.Map as M
1922import qualified Data.Set as S
2023
21−type StaticOptimizerEnv = RelationalExprEnv
22−
23−type StaticOptimizerMonad a = ReaderT StaticOptimizerEnv (ExceptT RelationalError Identity) a
2424-- the static optimizer performs optimizations which need not take any specific-relation statistics into account
2525
26−type GraphRefStaticOptimizerMonad a = ReaderT (Maybe DatabaseContext, TransactionGraph) (ExceptT RelationalError Identity) a
26+data GraphRefSOptRelationalExprEnv =
27+ GraphRefSOptRelationalExprEnv
28+ {
29+ ore_graph :: TransactionGraph,
30+ ore_mcontext :: Maybe DatabaseContext
31+ }
32+
33+type GraphRefSOptRelationalExprM a = ReaderT GraphRefSOptRelationalExprEnv (ExceptT RelationalError Identity) a
34+
35+data GraphRefSOptDatabaseContextExprEnv =
36+ GraphRefSOptDatabaseContextExprEnv
37+ {
38+ odce_graph :: TransactionGraph,
39+ odce_context :: DatabaseContext, --not optional for DatabaseContextExpr evaluation
40+ odce_transId :: TransactionId -- parent if context is committed- needed because MultipleExpr optimization requires running the DatabaseContextExprs (with empty relvars)
41+ }
42+
43+type GraphRefSOptDatabaseContextExprM a = ReaderT GraphRefSOptDatabaseContextExprEnv (ExceptT RelationalError Identity) a
2744
2845-- | A temporary function to be replaced by IO-based implementation.
2946optimizeAndEvalRelationalExpr :: RelationalExprEnv -> RelationalExpr -> Either RelationalError Relation
@@ -32,28 +49,44 @@ optimizeAndEvalRelationalExpr env expr = do
3249 graph = re_graph env
3350 ctx = re_context env
3451 gfEnv = freshGraphRefRelationalExprEnv (Just ctx) graph
35− optExpr <- runGraphRefStaticOptimizerMonad (Just ctx) (re_graph env) (fullOptimizeGraphRefRelationalExpr gfExpr)
52+ optExpr <- runGraphRefSOptRelationalExprM (Just ctx) (re_graph env) (fullOptimizeGraphRefRelationalExpr gfExpr)
3653 runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr optExpr)
3754
38−askGraph :: GraphRefStaticOptimizerMonad TransactionGraph
39−askGraph = snd <$> ask
55+class Monad m => AskGraphContext m where
56+ askGraph :: m TransactionGraph
57+ askContext :: m DatabaseContext
58+
59+instance AskGraphContext (ReaderT GraphRefSOptDatabaseContextExprEnv (ExceptT RelationalError Identity)) where
60+ askGraph = odce_graph <$> ask
61+ askContext = odce_context <$> ask
4062
41−askContext :: GraphRefStaticOptimizerMonad DatabaseContext
42−askContext = do
43− mctx <- fst <$> ask
44− case mctx of
45− Nothing -> throwError NoUncommittedContextInEvalError
46− Just ctx -> pure ctx
63+instance AskGraphContext (ReaderT GraphRefSOptRelationalExprEnv (ExceptT RelationalError Identity)) where
64+ askGraph = ore_graph <$> ask
65+ askContext = do
66+ mctx <- ore_mcontext <$> ask
67+ case mctx of
68+ Nothing -> throwError NoUncommittedContextInEvalError
69+ Just ctx -> pure ctx
4770
48−askMaybeContext :: GraphRefStaticOptimizerMonad (Maybe DatabaseContext)
49−askMaybeContext = fst <$> ask
71+askTransId :: GraphRefSOptDatabaseContextExprM TransactionId
72+askTransId = odce_transId <$> ask
5073
74+askMaybeContext :: GraphRefSOptRelationalExprM (Maybe DatabaseContext)
75+askMaybeContext = ore_mcontext <$> ask
76+
77+optimizeDatabaseContextExpr :: DatabaseContextExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr
78+optimizeDatabaseContextExpr expr = do
79+ let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextExpr expr)
80+ optimizeGraphRefDatabaseContextExpr gfExpr
81+
5182optimizeAndEvalDatabaseContextExpr :: Bool -> DatabaseContextExpr -> DatabaseContextEvalMonad ()
5283optimizeAndEvalDatabaseContextExpr optimize expr = do
5384 graph <- dce_graph <$> ask
85+ transId <- dce_transId <$> ask
86+ context <- getStateContext
5487 let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextExpr expr)
5588 eOptExpr = if optimize then
56− runGraphRefStaticOptimizerMonad Nothing graph (optimizeGraphRefDatabaseContextExpr gfExpr)
89+ runGraphRefSOptDatabaseContextExprM transId context graph (optimizeGraphRefDatabaseContextExpr gfExpr)
5790 else
5891 pure gfExpr
5992 case eOptExpr of
@@ -64,31 +97,76 @@ optimizeAndEvalDatabaseContextExpr optimize expr = do
6497optimizeAndEvalTransGraphRelationalExpr :: TransactionGraph -> TransGraphRelationalExpr -> Either RelationalError Relation
6598optimizeAndEvalTransGraphRelationalExpr graph tgExpr = do
6699 gfExpr <- TGRE.process (TransGraphEvalEnv graph) tgExpr
67− optExpr <- runGraphRefStaticOptimizerMonad Nothing graph (fullOptimizeGraphRefRelationalExpr gfExpr)
100+ optExpr <- runGraphRefSOptRelationalExprM Nothing graph (fullOptimizeGraphRefRelationalExpr gfExpr)
68101 let gfEnv = freshGraphRefRelationalExprEnv Nothing graph
69102 runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr optExpr)
70103
71104optimizeAndEvalDatabaseContextIOExpr :: DatabaseContextIOExpr -> DatabaseContextIOEvalMonad (Either RelationalError ())
72105optimizeAndEvalDatabaseContextIOExpr expr = do
73− env <- getDBCIORelationalExprEnv
106+ transId <- dbcio_transId <$> ask
107+ ctx <- getDBCIOContext
108+ graph <- dbcio_graph <$> ask
74109 let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextIOExpr expr)
75− eOptExpr = runStaticOptimizerMonad env (optimizeDatabaseContextIOExpr gfExpr)
110+ eOptExpr = runGraphRefSOptDatabaseContextExprM transId ctx graph (optimizeDatabaseContextIOExpr gfExpr)
76111 case eOptExpr of
77112 Left err -> pure (Left err)
78113 Right optExpr ->
79114 evalGraphRefDatabaseContextIOExpr optExpr
80115
81−
116+{-
82117runStaticOptimizerMonad :: RelationalExprEnv -> StaticOptimizerMonad a -> Either RelationalError a
83118runStaticOptimizerMonad env m = runIdentity (runExceptT (runReaderT m env))
119+-}
120+
121+runGraphRefSOptRelationalExprM ::
122+ Maybe DatabaseContext ->
123+ TransactionGraph ->
124+ GraphRefSOptRelationalExprM a ->
125+ Either RelationalError a
126+runGraphRefSOptRelationalExprM mctx graph m = runIdentity (runExceptT (runReaderT m env))
127+ where
128+ env = GraphRefSOptRelationalExprEnv {
129+ ore_graph = graph,
130+ ore_mcontext = mctx
131+ }
132+
84133
85−runGraphRefStaticOptimizerMonad :: Maybe DatabaseContext -> TransactionGraph -> GraphRefStaticOptimizerMonad a -> Either RelationalError a
86−runGraphRefStaticOptimizerMonad ctx graph m = runIdentity (runExceptT (runReaderT m (ctx, graph)))
87−
88−optimizeGraphRefRelationalExpr' :: Maybe DatabaseContext -> TransactionGraph -> GraphRefRelationalExpr -> Either RelationalError GraphRefRelationalExpr
89−optimizeGraphRefRelationalExpr' mctx graph expr = runIdentity (runExceptT (runReaderT (optimizeGraphRefRelationalExpr expr) (mctx,graph)))
90−
91−fullOptimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefStaticOptimizerMonad GraphRefRelationalExpr
134+runGraphRefSOptDatabaseContextExprM ::
135+ TransactionId ->
136+ DatabaseContext ->
137+ TransactionGraph ->
138+ GraphRefSOptDatabaseContextExprM a ->
139+ Either RelationalError a
140+runGraphRefSOptDatabaseContextExprM tid ctx graph m =
141+ runIdentity (runExceptT (runReaderT m env))
142+ where
143+ env = GraphRefSOptDatabaseContextExprEnv {
144+ odce_graph = graph,
145+ odce_context = ctx,
146+ odce_transId = tid
147+ }
148+
149+optimizeGraphRefRelationalExpr' ::
150+ Maybe DatabaseContext ->
151+ TransactionGraph ->
152+ GraphRefRelationalExpr ->
153+ Either RelationalError GraphRefRelationalExpr
154+optimizeGraphRefRelationalExpr' mctx graph expr =
155+ runIdentity (runExceptT (runReaderT (optimizeGraphRefRelationalExpr expr) env))
156+ where
157+ env = GraphRefSOptRelationalExprEnv {
158+ ore_graph = graph,
159+ ore_mcontext = mctx
160+ }
161+
162+-- | optimize relational expression within database context expr monad
163+liftGraphRefRelExpr :: GraphRefSOptRelationalExprM a -> GraphRefSOptDatabaseContextExprM a
164+liftGraphRefRelExpr m = do
165+ context <- odce_context <$> ask
166+ graph <- odce_graph <$> ask
167+ lift $ except $ runGraphRefSOptRelationalExprM (Just context) graph m
168+
169+fullOptimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr
92170fullOptimizeGraphRefRelationalExpr expr = do
93171 optExpr <- optimizeGraphRefRelationalExpr expr
94172 let optExpr' = applyStaticRestrictionPushdown (applyStaticRestrictionCollapse optExpr)
@@ -97,7 +175,7 @@ fullOptimizeGraphRefRelationalExpr expr = do
97175-- apply optimizations which merely remove steps to become no-ops: example: projection of a relation across all of its attributes => original relation
98176
99177--should optimizations offer the possibility to pure errors? If they perform the up-front type-checking, maybe so
100−optimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefStaticOptimizerMonad GraphRefRelationalExpr
178+optimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr
101179optimizeGraphRefRelationalExpr e@(MakeStaticRelation _ _) = pure e
102180
103181optimizeGraphRefRelationalExpr e@(MakeRelationFromExprs _ _) = pure e
@@ -109,8 +187,9 @@ optimizeGraphRefRelationalExpr e@(RelationVariable _ _) = pure e
109187--remove project of attributes which removes no attributes
110188optimizeGraphRefRelationalExpr (Project attrNameSet expr) = do
111189 graph <- askGraph
190+ mctx <- askMaybeContext
112191 let relType = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr expr)
113− gfEnv = freshGraphRefRelationalExprEnv Nothing graph
192+ gfEnv = freshGraphRefRelationalExprEnv mctx graph
114193 case relType of
115194 Left err -> throwError err
116195 Right relType2
@@ -171,12 +250,13 @@ optimizeGraphRefRelationalExpr (Ungroup attrName expr) =
171250--remove restriction of nothing
172251optimizeGraphRefRelationalExpr (Restrict predicate expr) = do
173252 graph <- askGraph
253+ mctx <- askMaybeContext
174254 optimizedPredicate <- applyStaticPredicateOptimization predicate
175255 case optimizedPredicate of
176256 optimizedPredicate' | isTrueExpr optimizedPredicate' -> optimizeGraphRefRelationalExpr expr -- remove predicate entirely
177257 optimizedPredicate' | isFalseExpr optimizedPredicate' -> do -- replace where false predicate with empty relation with attributes from relexpr
178258 let attributesRel = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr expr)
179− gfEnv = freshGraphRefRelationalExprEnv Nothing graph
259+ gfEnv = freshGraphRefRelationalExprEnv mctx graph
180260 case attributesRel of
181261 Left err -> throwError err
182262 Right attributesRelA -> pure $ MakeStaticRelation (attributes attributesRelA) emptyTupleSet
@@ -193,18 +273,18 @@ optimizeGraphRefRelationalExpr e@(Extend _ _) = pure e
193273optimizeGraphRefRelationalExpr e@(With _ _) = pure e
194274
195275-- database context expr
196−optimizeGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> GraphRefStaticOptimizerMonad GraphRefDatabaseContextExpr
276+optimizeGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr
197277optimizeGraphRefDatabaseContextExpr x@NoOperation = pure x
198278optimizeGraphRefDatabaseContextExpr x@(Define _ _) = pure x
199279
200280optimizeGraphRefDatabaseContextExpr x@(Undefine _) = pure x
201281
202282optimizeGraphRefDatabaseContextExpr (Assign name expr) = do
203− optExpr <- optimizeGraphRefRelationalExpr expr
283+ optExpr <- liftGraphRefRelExpr (fullOptimizeGraphRefRelationalExpr expr)
204284 pure $ Assign name optExpr
205285
206286optimizeGraphRefDatabaseContextExpr (Insert targetName expr) = do
207− optimizedExpr <- fullOptimizeGraphRefRelationalExpr expr
287+ optimizedExpr <- liftGraphRefRelExpr (fullOptimizeGraphRefRelationalExpr expr)
208288 if isEmptyRelationExpr optimizedExpr then -- if we are trying to insert an empty relation, do nothing
209289 pure NoOperation
210290 else
@@ -215,10 +295,10 @@ optimizeGraphRefDatabaseContextExpr (Insert targetName expr) = do
215295 _ -> pure (Insert targetName optimizedExpr)
216296
217297optimizeGraphRefDatabaseContextExpr (Delete name predicate) =
218− Delete name <$> applyStaticPredicateOptimization predicate
298+ Delete name <$> liftGraphRefRelExpr (applyStaticPredicateOptimization predicate)
219299
220300optimizeGraphRefDatabaseContextExpr (Update name upmap predicate) =
221− Update name upmap <$> applyStaticPredicateOptimization predicate
301+ Update name upmap <$> liftGraphRefRelExpr (applyStaticPredicateOptimization predicate)
222302
223303optimizeGraphRefDatabaseContextExpr dep@(AddInclusionDependency _ _) = pure dep
224304
@@ -240,14 +320,28 @@ optimizeGraphRefDatabaseContextExpr c@(ExecuteDatabaseContextFunction _ _) = pur
240320
241321--applyStaticDatabaseOptimization (MultipleExpr exprs) = pure $ Right $ MultipleExpr exprs
242322--for multiple expressions, we must evaluate
243−optimizeGraphRefDatabaseContextExpr x@(MultipleExpr _) = pure x
323+optimizeGraphRefDatabaseContextExpr (MultipleExpr exprs) = do
244324 --a previous expression in the exprs list could create a relvar; we don't want to miss it, so we clear the tuples and execute the expression to get an empty relation in the relvar
245−-- unimplemented
246−{- let processEmptyRelVars env = env { relationVariables = mkEmptyRelVars (relationVariables env) }
247− MultipleExpr <$> local processEmptyRelVars (mapM applyStaticDatabaseOptimization exprs)-}
325+ context <- askContext
326+ graph <- askGraph
327+ parentId <- askTransId
328+
329+ let emptyRvs ctx = ctx { relationVariables = mkEmptyRelVars (relationVariables ctx) }
330+ dbcEnv = mkDatabaseContextEvalEnv parentId graph
331+ folder (ctx, expracc) expr = do
332+ --optimize the expr and run it against empty relvars to add it to the context
333+ case runGraphRefSOptDatabaseContextExprM parentId ctx graph (optimizeGraphRefDatabaseContextExpr expr) of
334+ Left err -> throwError err
335+ Right optExpr ->
336+ case runDatabaseContextEvalMonad ctx dbcEnv (evalGraphRefDatabaseContextExpr optExpr) of
337+ Left err -> throwError err
338+ Right dbcState ->
339+ pure (emptyRvs $ dbc_context dbcState, expracc ++ [optExpr])
248340
341+ (_, exprs') <- foldM folder (context,[]) exprs
342+ pure (MultipleExpr exprs')
249343
250−applyStaticPredicateOptimization :: GraphRefRestrictionPredicateExpr -> GraphRefStaticOptimizerMonad GraphRefRestrictionPredicateExpr
344+applyStaticPredicateOptimization :: GraphRefRestrictionPredicateExpr -> GraphRefSOptRelationalExprM GraphRefRestrictionPredicateExpr
251345applyStaticPredicateOptimization predi = do
252346 optPred <- case predi of
253347-- where x and x => where x
@@ -340,7 +434,7 @@ isStaticAtomExpr FunctionAtomExpr{} = False
340434isStaticAtomExpr RelationAtomExpr{} = False
341435
342436--if the projection of a join only uses the attributes from one of the expressions and there is a foreign key relationship between the expressions, we know that the join is inconsequential and can be removed
343−applyStaticJoinElimination :: GraphRefRelationalExpr -> GraphRefStaticOptimizerMonad GraphRefRelationalExpr
437+applyStaticJoinElimination :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr
344438applyStaticJoinElimination expr@(Project attrNameSet (Join exprA exprB)) = do
345439 graph <- askGraph
346440 case inSameTransaction exprA exprB of
@@ -480,5 +574,5 @@ applyStaticRestrictionPushdown expr = case expr of
480574 Extend n (applyStaticRestrictionPushdown sub)
481575
482576-- no optimizations available
483−optimizeDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> StaticOptimizerMonad GraphRefDatabaseContextIOExpr
577+optimizeDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextIOExpr
484578optimizeDatabaseContextIOExpr x = pure x