From 5f069f452107c55356e0229197400886331af9c2 Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Tue, 26 Nov 2002 20:04:08 +0000
Subject: [PATCH] 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.
---
 code/loop.lisp | 21 ++++++++++++++++++---
 1 file changed, 18 insertions(+), 3 deletions(-)

diff --git a/code/loop.lisp b/code/loop.lisp
index fc13757a3..5dfb71c87 100644
--- a/code/loop.lisp
+++ b/code/loop.lisp
@@ -49,7 +49,7 @@
 
 #+cmu
 (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
 
@@ -1116,8 +1116,9 @@ collected result will be returned as the value of the LOOP."
   (setq *loop-emitted-body* t)
   (loop-pseudo-body form))
 
-(defun loop-emit-final-value (form)
-  (push (loop-construct-return form) *loop-after-epilogue*)
+(defun loop-emit-final-value (&optional (form nil form-supplied-p))
+  (when form-supplied-p
+    (push (loop-construct-return form) *loop-after-epilogue*))
   (when *loop-final-value-culprit*
     (loop-warn "LOOP clause is providing a value for the iteration,~@
 	        however one was already established by a ~S clause."
@@ -1129,6 +1130,15 @@ collected result will be returned as the value of the LOOP."
   #+(or Genera CLOE) (declare (dbg:error-reporter))
   (when *loop-inside-conditional*
     (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
@@ -1372,6 +1382,8 @@ collected result will be returned as the value of the LOOP."
 		(loop-pop-source))))
     (when (not (symbolp name))
       (loop-error "Value accumulation recipient name, ~S, is not a symbol." name))
+    (unless name
+      (loop-disallow-aggregate-booleans))
     (unless dtype
       (setq dtype (or (loop-optional-type) default-type)))
     (let ((cruft (find (the symbol name) *loop-collection-cruft*
@@ -1472,6 +1484,7 @@ collected result will be returned as the value of the LOOP."
 (defun loop-do-always (restrictive negate)
   (let ((form (loop-get-form)))
     (when restrictive (loop-disallow-conditional))
+    (loop-disallow-anonymous-collectors)
     (loop-emit-body `(,(if negate 'when 'unless) ,form
 		      ,(loop-construct-return nil)))
     (loop-emit-final-value t)))
@@ -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.
 (defun loop-do-thereis (restrictive)
   (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-construct-return *loop-when-it-variable*))))
 
-- 
GitLab