From 731bc63e2e5c9bac2799c299e37d7654579b0716 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 21 Nov 2002 15:55:43 +0000 Subject: [PATCH] 0.7.9.61: Fix destructuring of LOOP WITH where is a tree with NIL in it. ... define and use a somewhat KLUDGEy LOOP-DESTRUCTURING-BIND. --- NEWS | 4 +++- src/code/loop.lisp | 20 +++++++++++++++++++- tests/loop.pure.lisp | 5 +++++ version.lisp-expr | 2 +- 4 files changed, 28 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index e0f8543..0f57910 100644 --- 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 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -760,9 +760,27 @@ code to be loaded. specified-type required-type))) specified-type))) +(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 --- 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 --- 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" -- 1.7.10.4