mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-22 19:44:10 +02:00
Code Activity

optimization for chain of if expressions with common tests

Browse source 
* module/language/tree-il/peval.scm (peval): Optimize common tests in
  chains of "if" expressions, like those generated by matchers.

* test-suite/tests/peval.test ("partial evaluation"): Add a test.
This commit is contained in:
Andy Wingo 2012-05-15 12:18:30 +02:00
parent 1fb39dc55f
commit f49fd9afd6
2 changed files with 95 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

31
test-suite/tests/peval.test
View file

@ -999,4 +999,33 @@
out))))
((lambda (y) (list y)) x))
(let (x) (_) (_)
(apply (primitive list) (lexical x _)))))
(apply (primitive list) (lexical x _))))
;; Here we test that a common test in a chain of ifs gets lifted.
(pass-if-peval resolve-primitives
(if (and (struct? x) (eq? (struct-vtable x) A))
(foo x)
(if (and (struct? x) (eq? (struct-vtable x) B))
(bar x)
(if (and (struct? x) (eq? (struct-vtable x) C))
(baz x)
(qux x))))
(let (failure) (_) ((lambda _
(lambda-case
((() #f #f #f () ())
(apply (toplevel qux) (toplevel x))))))
(if (apply (primitive struct?) (toplevel x))
(if (apply (primitive eq?)
(apply (primitive struct-vtable) (toplevel x))
(toplevel A))
(apply (toplevel foo) (toplevel x))
(if (apply (primitive eq?)
(apply (primitive struct-vtable) (toplevel x))
(toplevel B))
(apply (toplevel bar) (toplevel x))
(if (apply (primitive eq?)
(apply (primitive struct-vtable) (toplevel x))
(toplevel C))
(apply (toplevel baz) (toplevel x))
(apply (lexical failure _)))))
(apply (lexical failure _))))))