X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fboot.lisp;h=e470eb41ce3b7a6d599642a54b0022af6100622f;hb=b83353d9f998e5c0e34604b5593df70c66d2c510;hp=c794df48628b4866db678554acf32cc0501d4deb;hpb=e768e8944cce654692468dae63f819ea1aa520a5;p=sbcl.git

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index c794df4..e470eb4 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -318,8 +318,8 @@ bootstrapping.
       ;; belong here!
       (aver (not morep)))))
 
-(defmacro defmethod (&rest args)
-  (multiple-value-bind (name qualifiers lambda-list body)
+(defmacro defmethod (name &rest args)
+  (multiple-value-bind (qualifiers lambda-list body)
       (parse-defmethod args)
     `(progn
       ;; KLUDGE: this double expansion is quite a monumental
@@ -1312,9 +1312,8 @@ bootstrapping.
                                       applyp))
      &body body
      &environment env)
-  (let* ((all-params (append args (when rest-arg (list rest-arg))))
-         (rebindings (when (or setq-p call-next-method-p)
-                       (mapcar (lambda (x) (list x x)) all-params))))
+  (let* ((rebindings (when (or setq-p call-next-method-p)
+                       (mapcar (lambda (x) (list x x)) parameters-setqd))))
     (if (not (or call-next-method-p setq-p closurep next-method-p-p applyp))
         `(locally
              ,@body)
@@ -1337,7 +1336,6 @@ bootstrapping.
                          (declare (optimize (sb-c:insert-step-conditions 0)))
                          (not (null ,next-method-call))))))
            (let ,rebindings
-             ,@(when rebindings `((declare (ignorable ,@all-params))))
              ,@body)))))
 
 ;;; CMUCL comment (Gerd Moellmann):
@@ -2201,12 +2199,14 @@ bootstrapping.
            (finalize-inheritance ,gf-class)))
      (remf ,all-keys :generic-function-class)
      (remf ,all-keys :environment)
-     (let ((combin (getf ,all-keys :method-combination '.shes-not-there.)))
-       (unless (eq combin '.shes-not-there.)
-         (setf (getf ,all-keys :method-combination)
-               (find-method-combination (class-prototype ,gf-class)
-                                        (car combin)
-                                        (cdr combin)))))
+     (let ((combin (getf ,all-keys :method-combination)))
+       (etypecase combin
+         (cons
+          (setf (getf ,all-keys :method-combination)
+                (find-method-combination (class-prototype ,gf-class)
+                                         (car combin)
+                                         (cdr combin))))
+         ((or null method-combination))))
     (let ((method-class (getf ,all-keys :method-class '.shes-not-there.)))
       (unless (eq method-class '.shes-not-there.)
         (setf (getf ,all-keys :method-class)
@@ -2612,14 +2612,13 @@ bootstrapping.
 ;;; is really implemented.
 (defun parse-defmethod (cdr-of-form)
   (declare (list cdr-of-form))
-  (let ((name (pop cdr-of-form))
-        (qualifiers ())
+  (let ((qualifiers ())
         (spec-ll ()))
     (loop (if (and (car cdr-of-form) (atom (car cdr-of-form)))
               (push (pop cdr-of-form) qualifiers)
               (return (setq qualifiers (nreverse qualifiers)))))
     (setq spec-ll (pop cdr-of-form))
-    (values name qualifiers spec-ll cdr-of-form)))
+    (values qualifiers spec-ll cdr-of-form)))
 
 (defun parse-specializers (generic-function specializers)
   (declare (list specializers))