From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 7 Oct 2008 08:28:36 +0000 (+0000)
Subject: 1.0.21.10: DEFINE-COMPILER-MACRO and destructuring lambda-lists
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=37200d73dfca16507809778574092cfb998711d5;p=sbcl.git

1.0.21.10: DEFINE-COMPILER-MACRO and destructuring lambda-lists

 * Were broken -- fix by using the special FUNCALL related magic is
   only for the outermost list, not sublists. Reported by Willem
   Broekema.

 * Adjust one of the existing tests to check for this.

 * Record bug 430: nested stack allocation does not work for structures.
---

diff --git a/BUGS b/BUGS
index dd4c15b..e36c391 100644
--- a/BUGS
+++ b/BUGS
@@ -1901,3 +1901,20 @@ generally try to check returns in safe code, so we should here too.)
                       lumps)))
       (setf (aref nodes 0) 2)
       (assert (every #'~= (apply #'concatenate 'list nodes) '(2 3 6 9)))))
+
+430: nested structure constructors do not stack allocate
+
+  (defun nada (x) (declare (ignore x)) nil)
+
+  (declaim (inline make-foo))
+  (defstruct foo bar)
+
+  (defun foo ()
+    (let ((x (list (make-foo))))
+      (declare (dynamic-extent x))
+      (nada x)))
+
+ Result of MAKE-FOO not stack allocated in FOO, because the function
+ HANDLE-NESTED-DYNAMIC-EXTENT-LVARS sees is not
+ %MAKE-STRUCTURE-INSTANCE, but no-yet-eliminated (VARARGS-ENTRY
+ MAKE-FOO).
diff --git a/NEWS b/NEWS
index a6cdaec..80024f9 100644
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,8 @@ changes in sbcl-1.0.22 relative to 1.0.21:
     structure slots correctly. (reported by Cedric St-Jean)
   * bug fix: SERVE-EVENT occasionally signaled an error about bogus
     file descriptors when there were none.
+  * bug fix: DEFINE-COMPILER-MACRO support of destructuring lambda-lists
+    was broken. (reported by Willem Broekema)
 
 changes in sbcl-1.0.21 relative to 1.0.20:
   * new feature: the compiler is able to track the effective type of a
diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index bc233ba..8fb6d8c 100644
--- a/src/code/parse-defmacro.lisp
+++ b/src/code/parse-defmacro.lisp
@@ -109,7 +109,7 @@
     ;; Special case compiler-macros: if car of the form is FUNCALL,
     ;; skip over it for destructuring, pretending cdr of the form is
     ;; the actual form. Save original for &WHOLE.
-    (when (eq context 'define-compiler-macro)
+    (when (and (not sublist) (eq context 'define-compiler-macro))
       (push-let-binding compiler-macro-whole whole-var :system t)
       (push compiler-macro-whole *ignorable-vars*)
       (push-let-binding whole-var whole-var
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index c31a16f..dad96e8 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -1286,20 +1286,21 @@
 
 ;;; FUNCALL forms in compiler macros, lambda-list parsing
 (define-compiler-macro test-cmacro-1
-    (&whole whole a &optional b &rest c &key d)
-  (list whole a b c d))
+    (&whole whole a (a2) &optional b &rest c &key d)
+  (list whole a a2 b c d))
 
-(macrolet ((test (form a b c d)
+(macrolet ((test (form a a2 b c d)
              `(let ((form ',form))
-                (destructuring-bind (whole a b c d)
+                (destructuring-bind (whole a a2 b c d)
                     (funcall (compiler-macro-function 'test-cmacro-1) form nil)
                   (assert (equal whole form))
                   (assert (eql a ,a))
+                  (assert (eql a2 ,a2))
                   (assert (eql b ,b))
                   (assert (equal c ,c))
                   (assert (eql d ,d))))) )
-  (test (funcall 'test-cmacro-1 1 2 :d 3) 1 2 '(:d 3) 3)
-  (test (test-cmacro-1 11 12 :d 13) 11 12 '(:d 13) 13))
+  (test (funcall 'test-cmacro-1 1 (x) 2 :d 3) 1 'x 2 '(:d 3) 3)
+  (test (test-cmacro-1 11 (y) 12 :d 13) 11 'y 12 '(:d 13) 13))
 
 ;;; FUNCALL forms in compiler macros, expansions
 (define-compiler-macro test-cmacro-2 () ''ok)
diff --git a/version.lisp-expr b/version.lisp-expr
index 3fe5b83..f5b2641 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.21.9"
+"1.0.21.10"