@@ -42,6 +42,7 @@ import ProjectM36.NormalizeExpr
4242import ProjectM36.WithNameExpr
4343import Test.QuickCheck
4444import qualified Data.Functor.Foldable as Fold
45+import Control.Applicative
4546#ifdef PM36_HASKELL_SCRIPTING
4647import GHC hiding (getContext)
4748import Control.Exception
@@ -298,14 +299,15 @@ evalGraphRefDatabaseContextExpr (Assign relVarName expr) = do
298299
299300evalGraphRefDatabaseContextExpr (Insert relVarName relExpr) = do
300301 gfExpr <- relVarByName relVarName
301− let optExpr = applyStaticUnionCollapse (Union
302− gfExpr
303− relExpr)
302+ let optExpr = applyUnionCollapse (Union
303+ relExpr
304+ gfExpr)
304305 evalGraphRefDatabaseContextExpr (Assign relVarName optExpr)
305306
306307evalGraphRefDatabaseContextExpr (Delete relVarName predicate) = do
307308 gfExpr <- relVarByName relVarName
308− setRelVar relVarName (Restrict (NotPredicate predicate) gfExpr)
309+ let optExpr = applyRestrictionCollapse (Restrict (NotPredicate predicate) gfExpr)
310+ setRelVar relVarName optExpr
309311
310312--union of restricted+updated portion and the unrestricted+unupdated portion
311313evalGraphRefDatabaseContextExpr (Update relVarName atomExprMap pred') = do
@@ -1351,13 +1353,40 @@ instance ResolveGraphRefTransactionMarker GraphRefAtomExpr where
13511353--convert series of simple Union queries into MakeStaticRelation
13521354-- this is especially useful for long, nested applications of Union with simple tuples
13531355-- Union (MakeRelation x y) (MakeRelation x y') -> MakeRelation x (y + y')
1354−applyStaticUnionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr
1355−applyStaticUnionCollapse = Fold.cata opt
1356+
1357+--MakeRelationFromExprs Nothing (TupleExprs UncommittedContextMarker [TupleExpr (fromList [("name", NakedAtomExpr (TextAtom "steve"))])])
1358+
1359+applyUnionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr
1360+applyUnionCollapse = Fold.cata opt
13561361 where
1362+ opt :: RelationalExprBaseF GraphRefTransactionMarker GraphRefRelationalExpr -> GraphRefRelationalExpr
1363+ opt (UnionF exprA exprB) | exprA == exprB = exprA
13571364 opt (UnionF
1358− a@(MakeStaticRelation attrsA tupsA)
1359− b@(MakeStaticRelation attrsB tupsB)) = if attrsA == attrsB then
1360− MakeStaticRelation attrsA (tupleSetUnion attrsA tupsA tupsB)
1361− else
1362− Union a b
1365+ exprA@(MakeRelationFromExprs mAttrs1 tupExprs1)
1366+ exprB@(MakeRelationFromExprs mAttrs2 tupExprs2)) | tupExprs1 == tupExprs2 = MakeRelationFromExprs (mAttrs1 <|> mAttrs2) tupExprs1
1367+ | tupExprsNull tupExprs1 = exprB
1368+ | tupExprsNull tupExprs2 = exprA
13631369 opt x = Fold.embed x
1370+ tupExprsNull (TupleExprs _ []) = True
1371+ tupExprsNull _ = False
1372+
1373+
1374+--UPDATE optimization- find matching where clause in "lower" levels of renaming
1375+--update x where y=1 set (x:=5,z:=10); update x where y=1 set(x:=6,z:=11)
1376+-- =>
1377+-- update x where y=1 set (x:=6,z:=11)
1378+-- future opt: match individual attributes update x where y=1 set (x:=5); update x where y=1 set (z:=11) => update x where y=1 set (x:=5,z:=11)
1379+
1380+--strategy: try to collapse the top-level update (union (restrict pred MakeRelationFromExpr) expr) if it contains the same predicate and resultant relation
1381+
1382+--DELETE optimization
1383+-- if a restriction matches a previous restriction, combine them
1384+-- O(1) since it only scans at the top level, critical in benchmarks generating redundant deletions
1385+applyRestrictionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr
1386+applyRestrictionCollapse orig@(Restrict npred@(NotPredicate _) expr) =
1387+ case expr of
1388+ orig'@(Restrict npred'@(NotPredicate _) _) | npred == npred' -> orig'
1389+ _ -> orig
1390+applyRestrictionCollapse expr = expr
1391+
1392+