diff options
-rw-r--r-- | module/language/tree-il/cse.scm | 4 | ||||
-rw-r--r-- | test-suite/tests/cse.test | 17 |
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))))) |