X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fboot.lisp;h=40c13b4e63dfa2e807d932d86752950424cfda12;hb=dcf5978d9d33098e868ae6eea28e1b310038c03d;hp=b0ba8d2a8ab42551c131e50382e9523a962ff120;hpb=28b4b70473ad927acb2aee6d3a8cb3f107b02864;p=sbcl.git

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index b0ba8d2..40c13b4 100644
--- 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))
 
 ;;;; 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))))