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

fix nontail loops within loops

Browse source 
* module/language/tree-il/compile-glil.scm (flatten): Fix compilation of
  loops within loops in non-tail positions. Will add a test case soon,
  but one way to reproduce it was with the following function:

(define (test)
  (let lp ()
    (pk 'zero)
    (let ((fk (lambda ()
                (let ((fk2 (lambda () (pk 'two))))
                  (let ((fk3 (lambda () (if #t (pk 'three) (fk2)))))
                    (if #t
                        (fk3)
                        (fk2)))))))
      (pk 'one)
      (fk))
    (lp)))

One would expect to see a sequence of "zero one three", but in fact zero
only showed once.

This should fix simplex as well.
This commit is contained in:
Andy Wingo 2009-09-01 18:07:29 +02:00
parent 3f12aedb50
commit 7f7b85cbf6
1 changed files with 4 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

7
module/language/tree-il/compile-glil.scm
View file

@ -629,7 +629,7 @@
;; we know the vals are lambdas, we can set them to their local
;; var slots first, then capture their bindings, mutating them in
;; place.
(let ((RA (if (eq? context 'tail) #f (make-label))))
(let ((new-RA (if (or (eq? context 'tail) RA) #f (make-label))))
(for-each
(lambda (x v)
(cond
@ -657,7 +657,7 @@
allocation self emit-code)
(if (lambda-src x)
(emit-code #f (make-glil-source (lambda-src x))))
(comp-fix (lambda-body x) RA)
(comp-fix (lambda-body x) (or RA new-RA))
(emit-code #f (make-glil-unbind))
(emit-label POST)))))
vals
@ -696,7 +696,8 @@
vals
vars)
(comp-tail body)
(emit-label RA)
(if new-RA
(emit-label new-RA))
(emit-code #f (make-glil-unbind))))
((<let-values> src names vars exp body)