cse: expressions evaluated for effect do not provide predicates

* module/language/tree-il/cse.scm (cse): When trying to fold
  conditionals, only look at entries in the database that were added in
  test context.

* test-suite/tests/cse.test ("cse"): Add a test case.

diff --git a/module/language/tree-il/cse.scm b/module/language/tree-il/cse.scm
index ceef15f..b8e7229 100644 (file)
--- a/module/language/tree-il/cse.scm
+++ b/module/language/tree-il/cse.scm
@@ -276,11 +276,11 @@
            #f)))
        (_
         (cond
-         ((find-dominating-expression exp effects #f db)
+         ((find-dominating-expression exp effects 'test db)
           ;; We have an EXP fact, so we infer #t.
           (log 'inferring exp #t)
           (make-const (tree-il-src exp) #t))
-         ((find-dominating-expression (negate exp 'test) effects #f db)
+         ((find-dominating-expression (negate exp 'test) effects 'test db)
           ;; We have a (not EXP) fact, so we infer #f.
           (log 'inferring exp #f)
           (make-const (tree-il-src exp) #f))

diff --git a/test-suite/tests/cse.test b/test-suite/tests/cse.test
index ee31285..d01d318 100644 (file)
--- a/test-suite/tests/cse.test
+++ b/test-suite/tests/cse.test
@@ -271,4 +271,19 @@
    (let ((x (car y)))
      (cons x (car y)))
    (let (x) (_) ((apply (primitive car) (toplevel y)))
-        (apply (primitive cons) (lexical x _) (lexical x _)))))
+        (apply (primitive cons) (lexical x _) (lexical x _))))
+
+  ;; Dominating expressions only provide predicates when evaluated in
+  ;; test context.
+  (pass-if-cse
+   (let ((t (car x)))
+     (if (car x)
+         'one
+         'two))
+   ;; Actually this one should reduce in other ways, but this is the
+   ;; current reduction:
+   (begin
+     (apply (primitive car) (toplevel x))
+     (if (apply (primitive car) (toplevel x))
+         (const one)
+         (const two)))))