@@ -5,6 +5,9 @@ import ProjectM36.TransactionGraph
55import ProjectM36.RelationalExpression
66import ProjectM36.Error
77import Control.Monad.State
8+import ProjectM36.Tuple
9+import ProjectM36.AtomType
10+import qualified Data.Map as M
811
912-- | The TransGraphRelationalExpression is equivalent to a relational expression except that relation variables can reference points in the transaction graph (at previous points in time).
1013type TransGraphRelationalExpr = RelationalExprBase TransactionIdLookup
@@ -15,10 +18,19 @@ type TransGraphTupleExpr = TupleExprBase TransactionIdLookup
1518
1619type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup
1720
21+type TransGraphAtomExpr = AtomExprBase TransactionIdLookup
22+
23+type TransGraphAttributeExpr = AttributeExprBase TransactionIdLookup
24+
25+-- OUTDATED a previous attempt at this function attempted to convert TransGraphRelationalExpr to RelationalExpr by resolving the transaction lookups. However, there is no way to resolve a FunctionAtomExpr to an Atom without fully evaluating the higher levels (TupleExpr, etc.). An anonymous function expression cannot be serialized, so that workaround is out. Still, I suspect we can reuse the existing static optimizer logic to work on both structures. The current conversion reduces the chance of whole-query optimization due to full-evaluation on top of full-evaluation, so this function would benefit from some re-design.
1826evalTransGraphRelationalExpr :: TransGraphRelationalExpr -> TransactionGraph -> Either RelationalError RelationalExpr
19−evalTransGraphRelationalExpr (MakeRelationFromExprs mAttrs tupleExprs) graph = do
20− tupleExprs' <- mapM (flip evalTransGraphTupleExpr graph) tupleExprs
21− pure $ MakeRelationFromExprs mAttrs tupleExprs'
27+evalTransGraphRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) graph = do
28+ tupleExprs' <- mapM (evalTransGraphTupleExpr graph) tupleExprs
29+ case mAttrExprs of
30+ Nothing -> pure (MakeRelationFromExprs Nothing tupleExprs')
31+ Just attrExprs -> do
32+ attrExprs' <- mapM (evalTransGraphAttributeExpr graph) attrExprs
33+ pure (MakeRelationFromExprs (Just attrExprs') tupleExprs')
2234evalTransGraphRelationalExpr (MakeStaticRelation attrs tupSet) _ = pure (MakeStaticRelation attrs tupSet)
2335evalTransGraphRelationalExpr (ExistingRelation rel) _ = pure (ExistingRelation rel)
2436evalTransGraphRelationalExpr (RelationVariable rvname transLookup) graph = do
@@ -31,7 +43,7 @@ evalTransGraphRelationalExpr (Project attrNames expr) graph = do
3143evalTransGraphRelationalExpr (Union exprA exprB) graph = do
3244 exprA' <- evalTransGraphRelationalExpr exprA graph
3345 exprB' <- evalTransGraphRelationalExpr exprB graph
34− pure (Union exprA' exprB')
46+ pure (Union exprA' exprB')
3547evalTransGraphRelationalExpr (Join exprA exprB) graph = do
3648 exprA' <- evalTransGraphRelationalExpr exprA graph
3749 exprB' <- evalTransGraphRelationalExpr exprB graph
@@ -44,7 +56,7 @@ evalTransGraphRelationalExpr (Difference exprA exprB) graph = do
4456 exprB' <- evalTransGraphRelationalExpr exprB graph
4557 pure (Difference exprA' exprB')
4658evalTransGraphRelationalExpr (Group attrNames attrName expr) graph = do
47− expr' <- evalTransGraphRelationalExpr expr graph
59+ expr' <- evalTransGraphRelationalExpr expr graph
4860 pure (Group attrNames attrName expr')
4961evalTransGraphRelationalExpr (Ungroup attrName expr) graph = do
5062 expr' <- evalTransGraphRelationalExpr expr graph
@@ -66,32 +78,63 @@ evalTransGraphRelationalExpr (Extend extendExpr expr) graph = do
6678 expr' <- evalTransGraphRelationalExpr expr graph
6779 pure (Extend extendExpr' expr')
6880
69−evalTransGraphTupleExpr :: TransGraphTupleExpr -> TransactionGraph -> Either RelationalError TupleExpr
70−evalTransGraphTupleExpr = undefined
81+evalTransGraphTupleExpr :: TransactionGraph -> TransGraphTupleExpr -> Either RelationalError TupleExpr
82+evalTransGraphTupleExpr graph (TupleExpr attrMap) = do
83+ attrAssoc <- mapM (\(attrName, atomExpr) -> do
84+ aExpr <- evalTransGraphAtomExpr graph atomExpr
85+ pure (attrName, aExpr)
86+ ) (M.toList attrMap)
87+ pure (TupleExpr (M.fromList attrAssoc))
88+
89+evalTransGraphAtomExpr :: TransactionGraph -> TransGraphAtomExpr -> Either RelationalError AtomExpr
90+evalTransGraphAtomExpr _ (AttributeAtomExpr aname) = pure $ AttributeAtomExpr aname
91+evalTransGraphAtomExpr _ (NakedAtomExpr atom) = pure $ NakedAtomExpr atom
92+evalTransGraphAtomExpr graph (FunctionAtomExpr funcName args tLookup) = do
93+ trans <- lookupTransaction graph tLookup
94+ --I can't return a FunctionAtomExpr because the function needs to be resolved at a specific context
95+ args' <- mapM (evalTransGraphAtomExpr graph) args
96+ atom <- evalAtomExpr emptyTuple (transactionContext trans) (FunctionAtomExpr funcName args' ())
97+ pure (NakedAtomExpr atom)
98+evalTransGraphAtomExpr graph (RelationAtomExpr expr) = do
99+ expr' <- evalTransGraphRelationalExpr expr graph
100+ pure (RelationAtomExpr expr')
101+evalTransGraphAtomExpr graph (ConstructedAtomExpr dConsName args tLookup) = do
102+ trans <- lookupTransaction graph tLookup
103+ args' <- mapM (evalTransGraphAtomExpr graph) args
104+ atom <- evalAtomExpr emptyTuple (transactionContext trans) (ConstructedAtomExpr dConsName args' ())
105+ pure (NakedAtomExpr atom)
71106
72107evalTransGraphRestrictionPredicateExpr :: TransGraphRestrictionPredicateExpr -> TransactionGraph -> Either RelationalError RestrictionPredicateExpr
73−evalTransGraphRestrictionPredicateExpr = undefined
74−
108+evalTransGraphRestrictionPredicateExpr TruePredicate _ = pure TruePredicate
109+evalTransGraphRestrictionPredicateExpr (AndPredicate exprA exprB) graph = do
110+ exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph
111+ exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph
112+ pure (AndPredicate exprA' exprB')
113+evalTransGraphRestrictionPredicateExpr (OrPredicate exprA exprB) graph = do
114+ exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph
115+ exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph
116+ pure (OrPredicate exprA' exprB')
117+evalTransGraphRestrictionPredicateExpr (NotPredicate expr) graph = do
118+ expr' <- evalTransGraphRestrictionPredicateExpr expr graph
119+ pure (NotPredicate expr')
120+evalTransGraphRestrictionPredicateExpr (RelationalExprPredicate expr) graph = do
121+ expr' <- evalTransGraphRelationalExpr expr graph
122+ pure (RelationalExprPredicate expr')
123+evalTransGraphRestrictionPredicateExpr (AtomExprPredicate expr) graph = do
124+ expr' <- evalTransGraphAtomExpr graph expr
125+ pure (AtomExprPredicate expr')
126+evalTransGraphRestrictionPredicateExpr (AttributeEqualityPredicate attrName expr) graph = do
127+ expr' <- evalTransGraphAtomExpr graph expr
128+ pure (AttributeEqualityPredicate attrName expr')
129+
75130evalTransGraphExtendTupleExpr :: TransGraphExtendTupleExpr -> TransactionGraph -> Either RelationalError ExtendTupleExpr
76−evalTransGraphExtendTupleExpr = undefined
131+evalTransGraphExtendTupleExpr (AttributeExtendTupleExpr attrName expr) graph = do
132+ expr' <- evalTransGraphAtomExpr graph expr
133+ pure (AttributeExtendTupleExpr attrName expr')
77134
78−
79−{-
80−-- | A simple functor which maps all trans graph relational expressions to the standard relational expression, discarding any time travel in the graph.
81−transGraphRelExprToRelExpr :: TransGraphRelationalExpr -> RelationalExpr
82−transGraphRelExprToRelExpr (MakeRelationFromExprs a b) = MakeRelationFromExprs a (transGraphTupleExprToTupleExpr b)
83−transGraphRelExprToRelExpr (MakeStaticRelation a b) = MakeStaticRelation a b
84−transGraphRelExprToRelExpr (ExistingRelation a) = ExistingRelation a
85−transGraphRelExprToRelExpr (RelationVariable (TransGraphRelVarName nam _)) = RelationVariable nam
86−transGraphRelExprToRelExpr (Project a b) = Project a b
87−transGraphRelExprToRelExpr (Union a b) = Union a b
88−transGraphRelExprToRelExpr (Join a b) = Join a b
89−transGraphRelExprToRelExpr (Rename a b c) = Rename a b c
90−transGraphRelExprToRelExpr (Difference a b) = Difference a b
91−transGraphRelExprToRelExpr (Group a b c) = Group a b c
92−transGraphRelExprToRelExpr (Ungroup a b) = Ungroup a b
93−transGraphRelExprToRelExpr (Restrict a b) = Restrict a b
94−transGraphRelExprToRelExpr (Equals a b) = Equals a b
95−transGraphRelExprToRelExpr (NotEquals a b) = NotEquals a b
96−transGraphRelExprToRelExpr (Extend a b) = Extend a b
97−-}
135+evalTransGraphAttributeExpr :: TransactionGraph -> TransGraphAttributeExpr -> Either RelationalError AttributeExpr
136+evalTransGraphAttributeExpr graph (AttributeAndTypeNameExpr attrName tCons tLookup) = do
137+ trans <- lookupTransaction graph tLookup
138+ aType <- atomTypeForTypeConstructor tCons (typeConstructorMapping (transactionContext trans))
139+ pure (NakedAttributeExpr (Attribute attrName aType))
140+evalTransGraphAttributeExpr _ (NakedAttributeExpr attr) = pure (NakedAttributeExpr attr)