From 4b3dca0efff0b8c2c52ec3f08d166af7c1eaaac7 Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Mon, 25 Nov 2002 18:57:29 +0000
Subject: [PATCH] A better solution for the loop destructuring bug.  From Gerd
 Moellmann who got this from SBCL.

---
 code/loop.lisp | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/code/loop.lisp b/code/loop.lisp
index ba6ddabe2..fc13757a3 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.15 2002/11/22 18:13:08 toy Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/loop.lisp,v 1.16 2002/11/25 18:57:29 toy Exp $")
 
 ;;;; LOOP Iteration Macro
 
@@ -985,11 +985,22 @@ collected result will be returned as the value of the LOOP."
 
 
 
-
+(defun subst-gensyms-for-nil (tree)
+  (declare (special *ignores*))
+  (cond
+    ((null tree) (car (push (loop-gentemp) *ignores*)))
+    ((atom tree) tree)
+    (t (cons (subst-gensyms-for-nil (car tree))
+	     (subst-gensyms-for-nil (cdr tree))))))
+ 
 (defun loop-build-destructuring-bindings (crocks forms)
   (if crocks
-      `((destructuring-bind ,(car crocks) ,(cadr crocks)
-        ,@(loop-build-destructuring-bindings (cddr crocks) forms)))
+      (let ((*ignores* ()))
+	(declare (special *ignores*))
+	`((destructuring-bind ,(subst-gensyms-for-nil (car crocks))
+	      ,(cadr crocks)
+	    (declare (ignore ,@*ignores*))
+	    ,@(loop-build-destructuring-bindings (cddr crocks) forms))))
       forms))
 
 (defun loop-translate (*loop-source-code* *loop-macro-environment* *loop-universe*)
-- 
GitLab