on 3356ff7 help sign in
project-m36/src/lib/ProjectM36/StaticOptimizer.hs
191 lines 9.6 kB history raw
1module ProjectM36.StaticOptimizer where
2import ProjectM36.Base
3import ProjectM36.RelationalExpression
4import ProjectM36.Relation
5import ProjectM36.Error
6import qualified ProjectM36.AttributeNames as AS
7import ProjectM36.TupleSet
8import Control.Monad.State hiding (join)
9import Data.Either (rights, lefts)
10import Control.Monad.Trans.Reader
11import qualified Data.Map as M
13-- the static optimizer performs optimizations which need not take any specific-relation statistics into account
14-- apply optimizations which merely remove steps to become no-ops: example: projection of a relation across all of its attributes => original relation
16--should optimizations offer the possibility to return errors? If they perform the up-front type-checking, maybe so
17applyStaticRelationalOptimization :: RelationalExpr -> RelationalExprState (Either RelationalError RelationalExpr)
18applyStaticRelationalOptimization e@(MakeStaticRelation _ _) = return $ Right e
20applyStaticRelationalOptimization e@(MakeRelationFromExprs _ _) = return $ Right e
22applyStaticRelationalOptimization e@(ExistingRelation _) = return $ Right e
24applyStaticRelationalOptimization e@(RelationVariable _ _) = return $ Right e
26--remove project of attributes which removes no attributes
27applyStaticRelationalOptimization (Project attrNameSet expr) = do
28 relType <- typeForRelationalExpr expr
29 case relType of
30 Left err -> return $ Left err
31 Right relType2
32 | AS.all == attrNameSet ->
33 applyStaticRelationalOptimization expr
34 | AttributeNames (attributeNames relType2) == attrNameSet ->
35 applyStaticRelationalOptimization expr
36 | otherwise -> do
37 optimizedSubExpression <- applyStaticRelationalOptimization expr
38 case optimizedSubExpression of
39 Left err -> pure $ Left err
40 Right optSubExpr -> pure $ Right $ Project attrNameSet optSubExpr
42applyStaticRelationalOptimization (Union exprA exprB) = do
43 optExprA <- applyStaticRelationalOptimization exprA
44 optExprB <- applyStaticRelationalOptimization exprB
45 case optExprA of
46 Left err -> return $ Left err
47 Right optExprAx -> case optExprB of
48 Left err -> return $ Left err
49 Right optExprBx -> if optExprAx == optExprBx then
50 return (Right optExprAx)
51 else
52 return $ Right $ Union optExprAx optExprBx
54applyStaticRelationalOptimization (Join exprA exprB) = do
55 optExprA <- applyStaticRelationalOptimization exprA
56 optExprB <- applyStaticRelationalOptimization exprB
57 case optExprA of
58 Left err -> return $ Left err
59 Right optExprA2 -> case optExprB of
60 Left err -> return $ Left err
61 Right optExprB2 -> if optExprA == optExprB then --A join A == A
62 return optExprA
63 else
64 return $ Right (Join optExprA2 optExprB2)
66applyStaticRelationalOptimization (Difference exprA exprB) = do
67 optExprA <- applyStaticRelationalOptimization exprA
68 optExprB <- applyStaticRelationalOptimization exprB
69 case optExprA of
70 Left err -> return $ Left err
71 Right optExprA2 -> case optExprB of
72 Left err -> return $ Left err
73 Right optExprB2 -> if optExprA == optExprB then do --A difference A == A where false
74 eEmptyRel <- typeForRelationalExpr optExprA2
75 case eEmptyRel of
76 Left err -> pure (Left err)
77 Right emptyRel -> pure (Right (ExistingRelation emptyRel))
78 else
79 return $ Right (Difference optExprA2 optExprB2)
81applyStaticRelationalOptimization e@Rename{} = return $ Right e
83applyStaticRelationalOptimization (Group oldAttrNames newAttrName expr) =
84 return $ Right $ Group oldAttrNames newAttrName expr
86applyStaticRelationalOptimization (Ungroup attrName expr) =
87 return $ Right $ Ungroup attrName expr
89--remove restriction of nothing
90applyStaticRelationalOptimization (Restrict predicate expr) = do
91 optimizedPredicate <- applyStaticPredicateOptimization predicate
92 case optimizedPredicate of
93 Left err -> return $ Left err
94 Right optimizedPredicate2
95 | optimizedPredicate2 == TruePredicate -> applyStaticRelationalOptimization expr
96 | optimizedPredicate2 == NotPredicate TruePredicate -> do
97 attributesRel <- typeForRelationalExpr expr
98 case attributesRel of
99 Left err -> return $ Left err
100 Right attributesRelA -> return $ Right $ MakeStaticRelation (attributes attributesRelA) emptyTupleSet
101 | otherwise -> do
102 optimizedSubExpression <- applyStaticRelationalOptimization expr
103 case optimizedSubExpression of
104 Left err -> return $ Left err
105 Right optSubExpr -> return $ Right $ Restrict optimizedPredicate2 optSubExpr
107applyStaticRelationalOptimization e@(Equals _ _) = return $ Right e
109applyStaticRelationalOptimization e@(NotEquals _ _) = return $ Right e
111applyStaticRelationalOptimization e@(Extend _ _) = return $ Right e
113applyStaticDatabaseOptimization :: DatabaseContextExpr -> DatabaseState (Either RelationalError DatabaseContextExpr)
114applyStaticDatabaseOptimization x@NoOperation = pure $ Right x
115applyStaticDatabaseOptimization x@(Define _ _) = pure $ Right x
117applyStaticDatabaseOptimization x@(Undefine _) = pure $ Right x
119applyStaticDatabaseOptimization (Assign name expr) = do
120 context <- getStateContext
121 let optimizedExpr = runReader (applyStaticRelationalOptimization expr) (RelationalExprStateElems context)
122 case optimizedExpr of
123 Left err -> return $ Left err
124 Right optimizedExpr2 -> return $ Right (Assign name optimizedExpr2)
126applyStaticDatabaseOptimization (Insert name expr) = do
127 context <- getStateContext
128 let optimizedExpr = runReader (applyStaticRelationalOptimization expr) (RelationalExprStateElems context)
129 case optimizedExpr of
130 Left err -> return $ Left err
131 Right optimizedExpr2 -> return $ Right (Insert name optimizedExpr2)
133applyStaticDatabaseOptimization (Delete name predicate) = do
134 context <- getStateContext
135 let optimizedPredicate = runReader (applyStaticPredicateOptimization predicate) (RelationalExprStateElems context)
136 case optimizedPredicate of
137 Left err -> return $ Left err
138 Right optimizedPredicate2 -> return $ Right (Delete name optimizedPredicate2)
140applyStaticDatabaseOptimization (Update name upmap predicate) = do
141 context <- getStateContext
142 let optimizedPredicate = runReader (applyStaticPredicateOptimization predicate) (RelationalExprStateElems context)
143 case optimizedPredicate of
144 Left err -> return $ Left err
145 Right optimizedPredicate2 -> return $ Right (Update name upmap optimizedPredicate2)
147applyStaticDatabaseOptimization dep@(AddInclusionDependency _ _) = return $ Right dep
149applyStaticDatabaseOptimization (RemoveInclusionDependency name) = return $ Right (RemoveInclusionDependency name)
151applyStaticDatabaseOptimization (AddNotification name triggerExpr resultExpr) = do
152 context <- getStateContext
153 let eTriggerExprOpt = runReader (applyStaticRelationalOptimization triggerExpr) (RelationalExprStateElems context)
154 case eTriggerExprOpt of
155 Left err -> pure $ Left err
156 Right triggerExprOpt -> do
157 let eResultExprOpt = runReader (applyStaticRelationalOptimization resultExpr) (RelationalExprStateElems context)
158 case eResultExprOpt of
159 Left err -> pure $ Left err
160 Right resultExprOpt -> pure (Right (AddNotification name triggerExprOpt resultExprOpt))
162applyStaticDatabaseOptimization notif@(RemoveNotification _) = pure (Right notif)
164applyStaticDatabaseOptimization c@(AddTypeConstructor _ _) = pure (Right c)
165applyStaticDatabaseOptimization c@(RemoveTypeConstructor _) = pure (Right c)
166applyStaticDatabaseOptimization c@(RemoveAtomFunction _) = pure (Right c)
167applyStaticDatabaseOptimization c@(RemoveDatabaseContextFunction _) = pure (Right c)
168applyStaticDatabaseOptimization c@(ExecuteDatabaseContextFunction _ _) = pure (Right c)
170--optimization: from pgsql lists- check for join condition referencing foreign key- if join projection project away the referenced table, then it does not need to be scanned
172--applyStaticDatabaseOptimization (MultipleExpr exprs) = return $ Right $ MultipleExpr exprs
173--for multiple expressions, we must evaluate
174applyStaticDatabaseOptimization (MultipleExpr exprs) = do
175 context <- getStateContext
176 let optExprs = evalState substateRunner (contextWithEmptyTupleSets context, M.empty, False)
177 let errors = lefts optExprs
178 if not (null errors) then
179 return $ Left (head errors)
180 else
181 return $ Right $ MultipleExpr (rights optExprs)
182 where
183 substateRunner = forM exprs $ \expr -> do
184 --a previous expression 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
185 _ <- evalDatabaseContextExpr expr
186 applyStaticDatabaseOptimization expr
187 --this error handling could be improved with some lifting presumably
188 --restore original context
190applyStaticPredicateOptimization :: RestrictionPredicateExpr -> RelationalExprState (Either RelationalError RestrictionPredicateExpr)
191applyStaticPredicateOptimization predicate = return $ Right predicate