mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +02:00
Code Activity

peval: Add tests for inlining with both static & dynamic arguments.

Browse source 
* module/language/tree-il/optimize.scm (peval): Improve comment on the
  inlining heuristics.

* test-suite/tests/tree-il.test ("partial evaluation"): Add two tests.
This commit is contained in:
Ludovic Courtès 2011-09-13 14:31:18 +02:00
parent 870dfc609b
commit 1e8ace33d1
2 changed files with 35 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

31
test-suite/tests/tree-il.test
View file

@ -943,6 +943,37 @@
(apply (toplevel frob!) (lexical x _))
(lexical x _))))
(pass-if-peval
;; Inlining stops at recursive calls with dynamic arguments.
(let loop ((x x))
(if (< x 0) x (loop (1- x))))
(letrec (loop) (_) ((lambda (_)
(lambda-case
(((x) #f #f #f () (_))
(if _ _
(apply (lexical loop _)
(apply (primitive 1-)
(lexical x _))))))))
(apply (lexical loop _) (toplevel x))))
(pass-if-peval
;; Inlining stops at recursive calls (mixed static/dynamic arguments).
(let loop ((x x) (y 0))
(if (> y 0)
(loop (1+ x) (1+ y))
(if (< x 0) x (loop (1- x)))))
(letrec (loop) (_) ((lambda (_)
(lambda-case
(((x y) #f #f #f () (_ _))
(if (apply (primitive >)
(lexical y _) (const 0))
_ _)))))
;; call to (loop x 0) is inlined & specialized
(if (apply (primitive <) (toplevel x) (const 0))
(toplevel x)
(apply (lexical loop _)
(apply (primitive 1-) (toplevel x))))))
(pass-if-peval
;; Infinite recursion: `peval' gives up and leaves it as is.
(letrec ((f (lambda (x) (g (1- x))))