0.7.9.61:

	Fix destructuring of LOOP WITH <x> where <x> is a tree with NIL
		in it.
	... define and use a somewhat KLUDGEy LOOP-DESTRUCTURING-BIND.

diff --git a/NEWS b/NEWS
index e0f8543..0f57910 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1402,8 +1402,10 @@ changes in sbcl-0.7.10 relative to sbcl-0.7.9:
     ** NCONC accepts any object as its last argument;
     ** :COUNT argument to sequence functions may be BIGNUM; (thanks to
        Gerd Moellman)
-    ** Loop-package does not require a package to be explicitely
+    ** loop-for-as-package does not require a package to be explicitely
        specified;
+    ** LOOP WITH now treats NIL in the d-var-spec correctly as an
+       ignored binding;
   * fixed bug 166: compiler preserves "there is a way to go"
     invariant when deleting code.
   * fixed bug 172: macro lambda lists with required arguments after

diff --git a/src/code/loop.lisp b/src/code/loop.lisp
index d03284b..a1cec36 100644 (file)
--- a/src/code/loop.lisp
+++ b/src/code/loop.lisp
@@ -760,9 +760,27 @@ code to be loaded.
                           specified-type required-type)))
        specified-type)))
 \f
+(defun subst-gensyms-for-nil (tree)
+  (declare (special *ignores*))
+  (cond
+    ((null tree) (car (push (gensym "LOOP-IGNORED-VAR-") *ignores*)))
+    ((atom tree) tree)
+    (t (cons (subst-gensyms-for-nil (car tree))
+            (subst-gensyms-for-nil (cdr tree))))))
+    
+(sb!int:defmacro-mundanely loop-destructuring-bind
+    (lambda-list arg-list &rest body)
+  (let ((*ignores* nil))
+    (declare (special *ignores*))
+    (let ((d-var-lambda-list (subst-gensyms-for-nil lambda-list)))
+      `(destructuring-bind ,d-var-lambda-list
+          ,arg-list
+        (declare (ignore ,@*ignores*))
+         ,@body))))
+
 (defun loop-build-destructuring-bindings (crocks forms)
   (if crocks
-      `((destructuring-bind ,(car crocks) ,(cadr crocks)
+      `((loop-destructuring-bind ,(car crocks) ,(cadr crocks)
         ,@(loop-build-destructuring-bindings (cddr crocks) forms)))
       forms))
 

diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp
index 307129b..067f7ef 100644 (file)
--- a/tests/loop.pure.lisp
+++ b/tests/loop.pure.lisp
@@ -110,3 +110,8 @@
              (loop named foo do (loop-finish) finally (return :good))
              :bad)
            :good))
+
+(assert (= (loop with (a nil) = '(1 2) return a) 1))
+(assert (= (loop with (nil a) = '(1 2) return a) 2))
+(assert (= (loop with (a . nil) = '(1 2) return a) 1))
+(assert (equal (loop with (nil . a) = '(1 2) return a) '(2)))

diff --git a/version.lisp-expr b/version.lisp-expr
index a851108..8f69244 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.9.60"
+"0.7.9.61"