mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +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

7
module/language/tree-il/optimize.scm
View file

@ -251,9 +251,10 @@ it should be called before `fix-letrec'."
(args (map (cut loop <> env calls) orig-args)) (args (map (cut loop <> env calls) orig-args))
(args* (map maybe-unconst orig-args args)) (args* (map maybe-unconst orig-args args))
(app (make-application src proc args*))) (app (make-application src proc args*)))
;; If ARGS are constants and this call hasn't already been ;; If at least one of ARGS is static (to avoid infinite
;; expanded before (to avoid infinite recursion), then ;; inlining) and this call hasn't already been expanded
;; expand it (todo: emit an infinite recursion warning.) ;; before (to avoid infinite recursion), then expand it
;; (todo: emit an infinite recursion warning.)
(if (and (any const*? args) (if (and (any const*? args)
(not (member (cons proc args) calls))) (not (member (cons proc args) calls)))
(match proc (match proc

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

@ -943,6 +943,37 @@
(apply (toplevel frob!) (lexical x _)) (apply (toplevel frob!) (lexical x _))
(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 (pass-if-peval
;; Infinite recursion: `peval' gives up and leaves it as is. ;; Infinite recursion: `peval' gives up and leaves it as is.
(letrec ((f (lambda (x) (g (1- x)))) (letrec ((f (lambda (x) (g (1- x))))