From 7f7b85cbf68a8b83e1ad7bc78379cf2764fc9a1b Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 1 Sep 2009 18:07:29 +0200 Subject: [PATCH] fix nontail loops within loops * 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. --- module/language/tree-il/compile-glil.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm index 86b610f94..9de5c8858 100644 --- a/module/language/tree-il/compile-glil.scm +++ b/module/language/tree-il/compile-glil.scm @@ -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)))) (( src names vars exp body)