summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/language/tree-il/cse.scm4
-rw-r--r--test-suite/tests/cse.test17
2 files changed, 18 insertions, 3 deletions
diff --git a/module/language/tree-il/cse.scm b/module/language/tree-il/cse.scm
index ceef15f70..b8e722967 100644
--- 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 ee3128511..d01d31874 100644
--- 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)))))