Skip to content
Snippets Groups Projects
Commit 6a72b483 authored by toy's avatar toy
Browse files

From Alexey Dejneka via SBCL:

o Declare WITH-introduced variables
o Compound form must follow INITIALLY, FINALLY, DO.
parent ea2ac38d
No related branches found
No related tags found
No related merge requests found
...@@ -49,7 +49,7 @@ ...@@ -49,7 +49,7 @@
#+cmu #+cmu
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/loop.lisp,v 1.11 2002/07/06 00:58:04 toy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/loop.lisp,v 1.12 2002/07/30 16:40:28 toy Exp $")
;;;; LOOP Iteration Macro ;;;; LOOP Iteration Macro
...@@ -1071,9 +1071,17 @@ collected result will be returned as the value of the LOOP." ...@@ -1071,9 +1071,17 @@ collected result will be returned as the value of the LOOP."
(loop-error "LOOP source code ran out when another token was expected."))) (loop-error "LOOP source code ran out when another token was expected.")))
(defun loop-get-compound-form ()
(let ((form (loop-get-form)))
(unless (consp form)
(loop-error "Compound form expected, but found ~A." form))
form))
(defun loop-get-progn () (defun loop-get-progn ()
(do ((forms (list (loop-pop-source)) (cons (loop-pop-source) forms)) (do ((forms (list (loop-get-compound-form))
(nextform (car *loop-source-code*) (car *loop-source-code*))) (cons (loop-get-compound-form) forms))
(nextform (car *loop-source-code*)
(car *loop-source-code*)))
((atom nextform) ((atom nextform)
(if (null (cdr forms)) (car forms) (cons 'progn (nreverse forms)))))) (if (null (cdr forms)) (car forms) (cons 'progn (nreverse forms))))))
...@@ -1213,6 +1221,7 @@ collected result will be returned as the value of the LOOP." ...@@ -1213,6 +1221,7 @@ collected result will be returned as the value of the LOOP."
(loop-declare-variable name dtype) (loop-declare-variable name dtype)
(push (list name initialization) *loop-variables*)) (push (list name initialization) *loop-variables*))
(t (let ((newvar (loop-gentemp 'loop-destructure-))) (t (let ((newvar (loop-gentemp 'loop-destructure-)))
(loop-declare-variable name dtype)
(push (list newvar initialization) *loop-variables*) (push (list newvar initialization) *loop-variables*)
;; *LOOP-DESETQ-CROCKS* gathered in reverse order. ;; *LOOP-DESETQ-CROCKS* gathered in reverse order.
(setq *loop-desetq-crocks* (setq *loop-desetq-crocks*
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment