@@ -0,0 +1,140 @@
1+module RelationStaticOptimizer where
2+import RelationType
3+import RelationExpr
4+import Relation
5+import RelationalError
6+import Control.Monad.State hiding (join)
7+import Data.Either (rights, lefts)
8+
9+-- the static optimizer performs optimizations which need not take any specific-relation statistics into account
10+-- apply optimizations which merely remove steps to become no-ops: example: projection of a relation across all of its attributes => original relation
11+
12+--should optimizations offer the possibility to return errors? If they perform the up-front type-checking, maybe so
13+applyStaticRelationalOptimization :: RelationalExpr -> DatabaseState (Either RelationalError RelationalExpr)
14+applyStaticRelationalOptimization e@(MakeStaticRelation _ _) = return $ Right e
15+
16+applyStaticRelationalOptimization e@(RelationVariable _) = return $ Right e
17+
18+--remove project of attributes which removes no attributes
19+applyStaticRelationalOptimization (Project attrNameSet expr) = do
20+ relType <- typeForRelationalExpr expr
21+ case relType of
22+ Left err -> return $ Left err
23+ Right relType -> if attributeNames relType == attrNameSet then
24+ applyStaticRelationalOptimization expr
25+ else do
26+ optimizedSubExpression <- applyStaticRelationalOptimization expr
27+ case optimizedSubExpression of
28+ Left err -> return $ Left err
29+ Right optSubExpr -> return $ Right $ Project attrNameSet optSubExpr
30+
31+applyStaticRelationalOptimization (Union exprA exprB) = do
32+ optExprA <- applyStaticRelationalOptimization exprA
33+ optExprB <- applyStaticRelationalOptimization exprB
34+ case optExprA of
35+ Left err -> return $ Left err
36+ Right optExprAx -> case optExprB of
37+ Left err -> return $ Left err
38+ Right optExprBx -> if optExprAx == optExprBx then
39+ return (Right optExprAx)
40+ else
41+ return $ Right $ Union optExprAx optExprBx
42+
43+applyStaticRelationalOptimization (Join exprA exprB) = do
44+ typeA <- typeForRelationalExpr exprA
45+ typeB <- typeForRelationalExpr exprB
46+ context <- get
47+ case typeA of
48+ Left err -> return $ Left err
49+ Right typeA -> case typeB of
50+ Left err -> return $ Left err
51+ Right typeB -> if typeA == typeB then --no new attributes to add
52+ return $ Right exprA
53+ else do
54+ optExprA <- applyStaticRelationalOptimization exprA
55+ optExprB <- applyStaticRelationalOptimization exprB
56+
57+ case optExprA of
58+ Left err -> return $ Left err
59+ Right optExprA -> case optExprB of
60+ Left err -> return $ Left err
61+ Right optExprB -> return $ Right (Join optExprA optExprB)
62+
63+applyStaticRelationalOptimization e@(Rename _ _ _) = return $ Right e
64+
65+applyStaticRelationalOptimization (Group oldAttrNames newAttrName expr) = do
66+ return $ Right $ Group oldAttrNames newAttrName expr
67+
68+applyStaticRelationalOptimization (Ungroup attrName expr) = do
69+ return $ Right $ Ungroup attrName expr
70+
71+--remove restriction of nothing
72+applyStaticRelationalOptimization (Restrict predicate expr) = do
73+ optimizedPredicate <- applyStaticPredicateOptimization predicate
74+ case optimizedPredicate of
75+ Left err -> return $ Left err
76+ Right optimizedPredicate -> if optimizedPredicate == TruePredicate then
77+ applyStaticRelationalOptimization expr
78+ else do
79+ optimizedSubExpression <- applyStaticRelationalOptimization expr
80+ case optimizedSubExpression of
81+ Left err -> return $ Left err
82+ Right optSubExpr -> return $ Right $ Restrict optimizedPredicate optSubExpr
83+
84+applyStaticRelationalOptimization (Equals exprA exprB) = do
85+ return $ Right $ Equals exprA exprB
86+
87+applyStaticDatabaseOptimization :: DatabaseExpr -> DatabaseState (Either RelationalError DatabaseExpr)
88+applyStaticDatabaseOptimization (Define name attrs) = return $ Right (Define name attrs)
89+
90+applyStaticDatabaseOptimization (Undefine name) = return $ Right (Undefine name)
91+
92+applyStaticDatabaseOptimization (Assign name expr) = do
93+ optimizedExpr <- applyStaticRelationalOptimization expr
94+ case optimizedExpr of
95+ Left err -> return $ Left err
96+ Right optimizedExpr -> return $ Right (Assign name optimizedExpr)
97+
98+applyStaticDatabaseOptimization (Insert name expr) = do
99+ optimizedExpr <- applyStaticRelationalOptimization expr
100+ case optimizedExpr of
101+ Left err -> return $ Left err
102+ Right optimizedExpr -> return $ Right (Insert name optimizedExpr)
103+
104+applyStaticDatabaseOptimization (Delete name predicate) = do
105+ optimizedPredicate <- applyStaticPredicateOptimization predicate
106+ case optimizedPredicate of
107+ Left err -> return $ Left err
108+ Right optimizedPredicate -> return $ Right (Delete name optimizedPredicate)
109+
110+applyStaticDatabaseOptimization (Update name map predicate) = do
111+ optimizedPredicate <- applyStaticPredicateOptimization predicate
112+ case optimizedPredicate of
113+ Left err -> return $ Left err
114+ Right optimizedPredicate -> return $ Right (Update name map optimizedPredicate)
115+
116+applyStaticDatabaseOptimization (AddInclusionDependency dep) = return $ Right (AddInclusionDependency dep)
117+
118+--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
119+
120+--applyStaticDatabaseOptimization (MultipleExpr exprs) = return $ Right $ MultipleExpr exprs
121+--for multiple expressions, we must evaluate
122+applyStaticDatabaseOptimization (MultipleExpr exprs) = do
123+ context <- get
124+ let optExprs = evalState substateRunner (contextWithEmptyTupleSets context)
125+ let errors = lefts optExprs
126+ if length errors > 0 then
127+ return $ Left (head errors)
128+ else
129+ return $ Right $ MultipleExpr (rights optExprs)
130+ where
131+ substateRunner = forM exprs $ \expr -> do
132+ --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
133+ evalContextExpr expr
134+ applyStaticDatabaseOptimization expr
135+ --this error handling could be improved with some lifting presumably
136+ --restore original context
137+
138+
139+applyStaticPredicateOptimization :: RestrictionPredicateExpr -> DatabaseState (Either RelationalError RestrictionPredicateExpr)
140+applyStaticPredicateOptimization predicate = return $ Right predicate