1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00

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.
This commit is contained in:
Andy Wingo 2012-06-22 12:25:34 +02:00
parent 378daa5fa5
commit 4d1ae11279
2 changed files with 18 additions and 3 deletions

View file

@ -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))

View file

@ -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)))))