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