on master help sign in
additional static predicate truth detection
commit5b44309e4390a50f91542bb09228e5b436c47615 authorAgentM <agentm@themactionfaction.com> dateTue 31 Oct 2017, 16:36 (9 years ago) parent13c8b81
3 files changed+47−17
src/lib/ProjectM36/StaticOptimizer.hs+19−12 test/Relation/StaticOptimizer.hs+27−4 test/TutorialD/Interpreter.hs+1−1
src/lib/ProjectM36/StaticOptimizer.hs+19−12
@@ -101,8 +101,8 @@ applyStaticRelationalOptimization (Restrict predicate expr) = do
101101 case optimizedPredicate of
102102 Left err -> pure $ Left err
103103 Right optimizedPredicate2
104− | optimizedPredicate2 == TruePredicate -> applyStaticRelationalOptimization expr -- remove predicate entirely
105− | optimizedPredicate2 == NotPredicate TruePredicate -> do -- replace where false predicate with empty relation with attributes from relexpr
104+ | isTrueExpr optimizedPredicate2 -> applyStaticRelationalOptimization expr -- remove predicate entirely
105+ | isFalseExpr optimizedPredicate2 -> do -- replace where false predicate with empty relation with attributes from relexpr
106106 attributesRel <- typeForRelationalExpr expr
107107 case attributesRel of
108108 Left err -> pure $ Left err
@@ -212,7 +212,7 @@ applyStaticPredicateOptimization predi = do
212212 eOptPred2 <- applyStaticPredicateOptimization pred2
213213 case eOptPred2 of
214214 Left err -> pure (Left err)
215− Right optPred2 -> do
215+ Right optPred2 ->
216216 if optPred1 == optPred2 then
217217 pure (Right optPred1)
218218 else
@@ -226,15 +226,10 @@ applyStaticPredicateOptimization predi = do
226226 eOptPred2 <- applyStaticPredicateOptimization pred2
227227 case eOptPred2 of
228228 Left err -> pure (Left err)
229− Right optPred2 ->
230− if optPred1 == optPred2 then
231− pure (Right optPred1)
232− else if optPred1 == TruePredicate then -- True or x -> True
233− pure (Right optPred1)
234− else if optPred2 == TruePredicate then
235− pure (Right optPred2)
236− else
237− pure (Right (OrPredicate optPred1 optPred2))
229+ Right optPred2 | optPred1 == optPred2 -> pure (Right optPred1)
230+ | isTrueExpr optPred1 -> pure (Right optPred1) -- True or x -> True
231+ | isTrueExpr optPred2 -> pure (Right optPred2)
232+ | otherwise -> pure (Right (OrPredicate optPred1 optPred2))
238233 AttributeEqualityPredicate attrNameA (AttributeAtomExpr attrNameB) ->
239234 if attrNameA == attrNameB then
240235 pure (Right TruePredicate)
@@ -251,6 +246,18 @@ applyStaticPredicateOptimization predi = do
251246 let attrMap = findStaticRestrictionPredicates optPred in
252247 pure (Right (replaceStaticAtomExprs optPred attrMap))
253248
249+--determines if an atom expression is tautologically true
250+isTrueExpr :: RestrictionPredicateExpr -> Bool
251+isTrueExpr TruePredicate = True
252+isTrueExpr (AtomExprPredicate (NakedAtomExpr (BoolAtom True))) = True
253+isTrueExpr _ = False
254+
255+--determines if an atom expression is tautologically false
256+isFalseExpr :: RestrictionPredicateExpr -> Bool
257+isFalseExpr (NotPredicate expr) = isTrueExpr expr
258+isFalseExpr (AtomExprPredicate (NakedAtomExpr (BoolAtom False))) = True
259+isFalseExpr _ = False
260+
254261-- determine if the created relation can statically be determined to be empty
255262isEmptyRelationExpr :: RelationalExpr -> Bool
256263isEmptyRelationExpr (MakeRelationFromExprs _ []) = True
test/Relation/StaticOptimizer.hs+27−4
@@ -2,6 +2,7 @@ import ProjectM36.Base
22import ProjectM36.Relation
33import ProjectM36.RelationalExpression
44import ProjectM36.DateExamples
5+import ProjectM36.Error
56import ProjectM36.TupleSet
67import ProjectM36.StaticOptimizer
78import System.Exit
@@ -14,7 +15,8 @@ main = do
1415 tcounts <- runTestTT (TestList tests)
1516 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
1617 where
17− tests = relationOptTests ++ databaseOptTests
18+ tests = relationOptTests ++ databaseOptTests ++ [testTransitiveOptimization,
19+ testImpossiblePredicates]
1820 optDBCTest = map (\(name, expr, unopt) -> TestCase $ assertEqual name expr (evalState (applyStaticDatabaseOptimization unopt) (freshDatabaseState dateExamples)))
1921 relvar nam = RelationVariable nam ()
2022 startState = mkRelationalExprState dateExamples
@@ -22,9 +24,7 @@ main = do
2224 relationOptTests = optRelTest [
2325 ("StaticProject", Right $ relvar "s", Project (AttributeNames (attributeNames suppliersRel)) (relvar "s")),
2426 ("StaticUnion", Right $ relvar "s", Union (relvar "s") (relvar "s")),
25− ("StaticJoin", Right $ relvar "s", Join (relvar "s") (relvar "s")),
26− ("StaticRestrictTrue", Right $ relvar "s", Restrict TruePredicate (relvar "s")),
27− ("StaticRestrictFalse", Right $ MakeStaticRelation (attributes suppliersRel) emptyTupleSet, Restrict (NotPredicate TruePredicate) (relvar "s"))
27+ ("StaticJoin", Right $ relvar "s", Join (relvar "s") (relvar "s"))
2828 ]
2929 databaseOptTests = optDBCTest [
3030 ("StaticAssign",
@@ -37,3 +37,26 @@ main = do
3737 MultipleExpr [Assign "z" (Restrict TruePredicate (relvar "s")),
3838 Assign "z" (Restrict TruePredicate (relvar "s"))])
3939 ]
40+
41+testTransitiveOptimization :: Test
42+testTransitiveOptimization = TestCase $ do
43+ let expr atomexpr = AndPredicate (AttributeEqualityPredicate "a" (NakedAtomExpr (IntegerAtom 300))) (AttributeEqualityPredicate "b" atomexpr)
44+ exprIn = expr (AttributeAtomExpr "a")
45+ exprOut = expr (NakedAtomExpr (IntegerAtom 300))
46+ assertEqual "transitive property" (Right exprOut) (runReader (applyStaticPredicateOptimization exprIn) (RelationalExprStateElems dateExamples))
47+
48+optRelExpr :: RelationalExpr -> Either RelationalError RelationalExpr
49+optRelExpr expr = runReader (applyStaticRelationalOptimization expr) (RelationalExprStateElems dateExamples)
50+
51+testImpossiblePredicates :: Test
52+testImpossiblePredicates = TestCase $ do
53+ let tautTrue = Restrict (AtomExprPredicate (NakedAtomExpr (BoolAtom True))) rel
54+ tautTrue2 = Restrict TruePredicate rel
55+ tautFalse = Restrict (AtomExprPredicate (NakedAtomExpr (BoolAtom False))) rel
56+ tautFalse2 = Restrict (NotPredicate TruePredicate) rel
57+ emptyRel = MakeStaticRelation (attributes suppliersRel) emptyTupleSet
58+ rel = RelationVariable "s" ()
59+ assertEqual "remove tautology where true" (Right rel) (optRelExpr tautTrue)
60+ assertEqual "remove tautology where true2" (Right rel) (optRelExpr tautTrue2)
61+ assertEqual "remove tautology where false" (Right emptyRel) (optRelExpr tautFalse)
62+ assertEqual "remove tautology where false2" (Right emptyRel) (optRelExpr tautFalse2)
test/TutorialD/Interpreter.hs+1−1
@@ -498,7 +498,7 @@ testRestrictionPredicateExprs = TestCase $ do
498498 executeTutorialD sessionId dbconn "x:=s where status=20 or status=10"
499499 eRvOr <- executeRelationalExpr sessionId dbconn (RelationVariable "x" ())
500500 let expectedRelOr = restrict (\tuple ->
501− pure (elem (atomForAttributeName "status" tuple) [Right (IntegerAtom 10), Right (IntegerAtom 20)])) suppliersRel
501+ pure (atomForAttributeName "status" tuple `elem` [Right (IntegerAtom 10), Right (IntegerAtom 20)])) suppliersRel
502502 assertEqual "status 20 or 10" expectedRelOr eRvOr
503503 -- and
504504 executeTutorialD sessionId dbconn "x:=s where status=20 and status=10"