Skip to content
Snippets Groups Projects
Commit 5f069f45 authored by toy's avatar toy
Browse files

From Gerd Moellmann, porting Christophe's SBCL's change, with a few

additions to handle the loops

	(loop for i from 1 to 10 collect i always (< i 20))

	(loop ... thereis i collect i)

correctly.
parent 8d312992
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.16 2002/11/25 18:57:29 toy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/loop.lisp,v 1.17 2002/11/26 20:04:08 toy Exp $")
;;;; LOOP Iteration Macro ;;;; LOOP Iteration Macro
...@@ -1116,8 +1116,9 @@ collected result will be returned as the value of the LOOP." ...@@ -1116,8 +1116,9 @@ collected result will be returned as the value of the LOOP."
(setq *loop-emitted-body* t) (setq *loop-emitted-body* t)
(loop-pseudo-body form)) (loop-pseudo-body form))
(defun loop-emit-final-value (form) (defun loop-emit-final-value (&optional (form nil form-supplied-p))
(push (loop-construct-return form) *loop-after-epilogue*) (when form-supplied-p
(push (loop-construct-return form) *loop-after-epilogue*))
(when *loop-final-value-culprit* (when *loop-final-value-culprit*
(loop-warn "LOOP clause is providing a value for the iteration,~@ (loop-warn "LOOP clause is providing a value for the iteration,~@
however one was already established by a ~S clause." however one was already established by a ~S clause."
...@@ -1129,6 +1130,15 @@ collected result will be returned as the value of the LOOP." ...@@ -1129,6 +1130,15 @@ collected result will be returned as the value of the LOOP."
#+(or Genera CLOE) (declare (dbg:error-reporter)) #+(or Genera CLOE) (declare (dbg:error-reporter))
(when *loop-inside-conditional* (when *loop-inside-conditional*
(loop-error "~:[This LOOP~;The LOOP ~:*~S~] clause is not permitted inside a conditional." kwd))) (loop-error "~:[This LOOP~;The LOOP ~:*~S~] clause is not permitted inside a conditional." kwd)))
(defun loop-disallow-anonymous-collectors ()
(when (find-if-not 'loop-collector-name *loop-collection-cruft*)
(loop-error "This LOOP clause is not permitted with anonymous collectors.")))
(defun loop-disallow-aggregate-booleans ()
(when (loop-tmember *loop-final-value-culprit* '(always never thereis))
(loop-error "This anonymous collection LOOP clause is not permitted with aggregate booleans.")))
;;;; Loop Types ;;;; Loop Types
...@@ -1372,6 +1382,8 @@ collected result will be returned as the value of the LOOP." ...@@ -1372,6 +1382,8 @@ collected result will be returned as the value of the LOOP."
(loop-pop-source)))) (loop-pop-source))))
(when (not (symbolp name)) (when (not (symbolp name))
(loop-error "Value accumulation recipient name, ~S, is not a symbol." name)) (loop-error "Value accumulation recipient name, ~S, is not a symbol." name))
(unless name
(loop-disallow-aggregate-booleans))
(unless dtype (unless dtype
(setq dtype (or (loop-optional-type) default-type))) (setq dtype (or (loop-optional-type) default-type)))
(let ((cruft (find (the symbol name) *loop-collection-cruft* (let ((cruft (find (the symbol name) *loop-collection-cruft*
...@@ -1472,6 +1484,7 @@ collected result will be returned as the value of the LOOP." ...@@ -1472,6 +1484,7 @@ collected result will be returned as the value of the LOOP."
(defun loop-do-always (restrictive negate) (defun loop-do-always (restrictive negate)
(let ((form (loop-get-form))) (let ((form (loop-get-form)))
(when restrictive (loop-disallow-conditional)) (when restrictive (loop-disallow-conditional))
(loop-disallow-anonymous-collectors)
(loop-emit-body `(,(if negate 'when 'unless) ,form (loop-emit-body `(,(if negate 'when 'unless) ,form
,(loop-construct-return nil))) ,(loop-construct-return nil)))
(loop-emit-final-value t))) (loop-emit-final-value t)))
...@@ -1482,6 +1495,8 @@ collected result will be returned as the value of the LOOP." ...@@ -1482,6 +1495,8 @@ collected result will be returned as the value of the LOOP."
;;; Under ANSI this is not permitted to appear under conditionalization. ;;; Under ANSI this is not permitted to appear under conditionalization.
(defun loop-do-thereis (restrictive) (defun loop-do-thereis (restrictive)
(when restrictive (loop-disallow-conditional)) (when restrictive (loop-disallow-conditional))
(loop-disallow-anonymous-collectors)
(loop-emit-final-value)
(loop-emit-body `(when (setq ,(loop-when-it-variable) ,(loop-get-form)) (loop-emit-body `(when (setq ,(loop-when-it-variable) ,(loop-get-form))
,(loop-construct-return *loop-when-it-variable*)))) ,(loop-construct-return *loop-when-it-variable*))))
......
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