X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fparse-defmacro.lisp;h=48576799bb5dae3ce8dfab57388e79fd9c0d5876;hb=6caf3ed5713773cb423f46bf40a29f2438c97c78;hp=613f9c021bac540583790802646697b65afb94f6;hpb=df92b0d5b1064d7660ac551737bafa2e24f37a82;p=sbcl.git

diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index 613f9c0..4857679 100644
--- a/src/code/parse-defmacro.lisp
+++ b/src/code/parse-defmacro.lisp
@@ -39,6 +39,9 @@
                        ((:default-default *default-default*))
                        (error-fun 'error)
                        (wrap-block t))
+  (unless (listp lambda-list)
+    (bad-type lambda-list 'list "~S lambda-list is not a list: ~S"
+              context lambda-list))
   (multiple-value-bind (forms declarations documentation)
       (parse-body body :doc-string-allowed doc-string-allowed)
     (let ((*arg-tests* ())
@@ -51,6 +54,8 @@
                                       :error-fun error-fun
                                       :anonymousp anonymousp)
         (values `(let* (,@(nreverse *system-lets*))
+                   #-sb-xc-host
+                   (declare (muffle-conditions sb!ext:code-deletion-note))
                    ,@(when *ignorable-vars*
                        `((declare (ignorable ,@*ignorable-vars*))))
                    ,@*arg-tests*
@@ -107,7 +112,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
@@ -319,8 +324,7 @@
                                          :maximum ,explicit-maximum))))))
               *arg-tests*))
       (when key-seen
-        (let ((problem (gensym "KEY-PROBLEM-"))
-              (info (gensym "INFO-")))
+        (with-unique-names (problem info)
           (push `(multiple-value-bind (,problem ,info)
                      (verify-keywords ,rest-name
                                       ',keys