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

((lambda ...) ...) fix

Browse source 
* module/language/tree-il/optimize.scm (peval): If it's a lambda in the
  operator position, inline without a nested counter, as it's not
  possible to increase code size.
This commit is contained in:
Andy Wingo 2011-09-27 23:29:10 +02:00
parent 40be30c974
commit 0353a2d817
2 changed files with 9 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -855,8 +855,11 @@ it does not handle <fix> and <let-values>, it should be called before
;; An error, or effecting arguments. ;; An error, or effecting arguments.
(make-application src (for-value orig-proc) (make-application src (for-value orig-proc)
(map for-value orig-args))) (map for-value orig-args)))
((and=> (find-counter key counter) counter-recursive?) ((or (and=> (find-counter key counter) counter-recursive?)
;; A recursive call. Process again in tail context. (lambda? orig-proc))
;; A recursive call, or a lambda in the operator
;; position of the source expression. Process again in
;; tail context.
(loop (make-let src (append req (or opt '())) (loop (make-let src (append req (or opt '()))
gensyms gensyms
(append orig-args (append orig-args

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

@ -793,14 +793,12 @@
(pass-if-peval (pass-if-peval
;; Infinite recursion ;; Infinite recursion
((lambda (x) (x x)) (lambda (x) (x x))) ((lambda (x) (x x)) (lambda (x) (x x)))
(apply (lambda _ (let (x) (_)
((lambda _
(lambda-case (lambda-case
(((x) _ _ _ _ _) (((x) _ _ _ _ _)
(apply (lexical x _) (lexical x _))))) (apply (lexical x _) (lexical x _))))))
(lambda _ (apply (lexical x _) (lexical x _))))
(lambda-case
(((x) _ _ _ _ _)
(apply (lexical x _) (lexical x _)))))))
(pass-if-peval (pass-if-peval
;; First order, aliased primitive. ;; First order, aliased primitive.