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:
parent
378daa5fa5
commit
4d1ae11279
2 changed files with 18 additions and 3 deletions
|
@ -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))
|
||||
|
|
|
@ -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)))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue