summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2017-07-30 21:35:16 -0700
committerKaz Kylheku <kaz@kylheku.com>2017-07-30 21:35:16 -0700
commit0d75889dae241f39bbeaf74b59792e8bd225daf8 (patch)
tree41210e4484fb123fb3f5f2651e01da09920441a2
parent2905dc035ded035c6db2b899c9634994725bcbb2 (diff)
downloadtxr-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.tl17
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