0.8.5.3:

[sbcl.git] / src / pcl / boot.lisp

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index b0ba8d2..40c13b4 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -499,11 +499,12 @@ bootstrapping.
                                 env))))
 
 (defun add-method-declarations (name qualifiers lambda-list body env)
+  (declare (ignore env))
   (multiple-value-bind (parameters unspecialized-lambda-list specializers)
       (parse-specialized-lambda-list lambda-list)
     (declare (ignore parameters))
     (multiple-value-bind (real-body declarations documentation)
-       (parse-body body env)
+       (parse-body body)
       (values `(lambda ,unspecialized-lambda-list
                 ,@(when documentation `(,documentation))
                 ;; (Old PCL code used a somewhat different style of
@@ -635,7 +636,7 @@ bootstrapping.
            is not a lambda form."
           method-lambda))
   (multiple-value-bind (real-body declarations documentation)
-      (parse-body (cddr method-lambda) env)
+      (parse-body (cddr method-lambda))
     (let* ((name-decl (get-declaration '%method-name declarations))
           (sll-decl (get-declaration '%method-lambda-list declarations))
           (method-name (when (consp name-decl) (car name-decl)))
@@ -725,7 +726,7 @@ bootstrapping.
            (multiple-value-bind (walked-lambda-body
                                  walked-declarations
                                  walked-documentation)
-               (parse-body (cddr walked-lambda) env)
+               (parse-body (cddr walked-lambda))
              (declare (ignore walked-documentation))
              (when (or next-method-p-p call-next-method-p)
                (setq plist (list* :needs-next-methods-p t plist)))
@@ -1523,8 +1524,6 @@ bootstrapping.
                 *))))
 
 (defun defgeneric-declaration (spec lambda-list)
-  (when (consp spec)
-    (setq spec (get-setf-fun-name (cadr spec))))
   `(ftype ,(ftype-declaration-from-lambda-list lambda-list spec) ,spec))
 \f
 ;;;; early generic function support
@@ -1807,6 +1806,8 @@ bootstrapping.
                                            &allow-other-keys)
   (declare (ignore keys))
   (cond ((and existing (early-gf-p existing))
+        (when lambda-list-p
+          (set-arg-info existing :lambda-list lambda-list))
         existing)
        ((assoc spec *!generic-function-fixups* :test #'equal)
         (if existing
@@ -1906,7 +1907,7 @@ bootstrapping.
                             (method-lambda-list method)))
                     (k (member '&key ll)))
                (if k
-                   (append (ldiff ll (cdr k)) '(&allow-other-keys))
+                   (ldiff ll (cdr k))
                    ll))))
        (arg-info-lambda-list arg-info))))