diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2017-07-30 21:35:16 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2017-07-30 21:35:16 -0700 |
commit | 0d75889dae241f39bbeaf74b59792e8bd225daf8 (patch) | |
tree | 41210e4484fb123fb3f5f2651e01da09920441a2 | |
parent | 2905dc035ded035c6db2b899c9634994725bcbb2 (diff) | |
download | txr-0d75889dae241f39bbeaf74b59792e8bd225daf8.tar.gz txr-0d75889dae241f39bbeaf74b59792e8bd225daf8.tar.bz2 txr-0d75889dae241f39bbeaf74b59792e8bd225daf8.zip |
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.
-rw-r--r-- | share/txr/stdlib/tagbody.tl | 17 |
1 files 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 |