From 0d75889dae241f39bbeaf74b59792e8bd225daf8 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 30 Jul 2017 21:35:16 -0700 Subject: bugfix: tagbody mustn't expose anonymous block. * share/txr/stdlib/tagbody.tl (tagbody): Use progn for the trivial case, and in the ordinary case, the sys:for-op special form directly rather than the for loop maro. sys:for-op doesn't introduce a block; the for macro is doing that. --- share/txr/stdlib/tagbody.tl | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/share/txr/stdlib/tagbody.tl b/share/txr/stdlib/tagbody.tl index 6fe24a19..7d9057e6 100644 --- a/share/txr/stdlib/tagbody.tl +++ b/share/txr/stdlib/tagbody.tl @@ -34,7 +34,7 @@ (unless start-lbl (push entry-lbl (car bblocks))) (if (and (not start-lbl) (not (cdr bblocks))) - ^(block nil ,*forms nil) + ^(progn nil ,*forms nil) (let* ((lbls [mapcar car bblocks]) (forms [mapcar cdr bblocks]) ;; This trickery transform the individually labeled form @@ -45,13 +45,14 @@ (codes [mapcar car threaded-1])) (unless (eql (length (uniq lbls)) (length lbls)) (throwf 'eval-error "~s: duplicate labels occur" 'tagbody)) - (let* ((basic-code ^(let ((,tb-id (gensym "tb-dyn-id-"))) - (for ((,next-var 0)) - (,next-var) - ((set ,next-var - (block* ,tb-id - (sys:switch ,next-var #(,*codes)) - nil)))))) + (let* ((basic-code ^(let ((,tb-id (gensym "tb-dyn-id-")) + (,next-var 0)) + (sys:for-op () + (,next-var) + ((set ,next-var + (block* ,tb-id + (sys:switch ,next-var #(,*codes)) + nil)))))) ;; pass one: expand inner forms, including tagbody forms. ;; if any inner tagbody forms leave (go ...) forms unexpanded, ;; protect those (go ...)forms from falling victim to the -- cgit v1.2.3