X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fmethods.lisp;h=db593a5dd54f4a5c0d152266d743b7011ded3273;hb=2912f5f6c2acb2da3b9fcc0f5afd1ca89782a9f8;hp=ab5110e8217289d35745032e9e572268d230a2bc;hpb=5b43e28a5a9f0fcdefc2132840492e2e382876c6;p=sbcl.git

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index ab5110e..db593a5 100644
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -409,8 +409,7 @@
 (defmethod initialize-instance :after ((gf standard-generic-function)
 				       &key (lambda-list nil lambda-list-p)
 				       argument-precedence-order)
-  (with-slots (arg-info)
-    gf
+  (with-slots (arg-info) gf
     (if lambda-list-p
 	(set-arg-info gf
 		      :lambda-list lambda-list
@@ -419,25 +418,25 @@
     (when (arg-info-valid-p arg-info)
       (update-dfun gf))))
 
-(defmethod reinitialize-instance :after ((gf standard-generic-function)
-					 &rest args
-					 &key (lambda-list nil lambda-list-p)
-					 (argument-precedence-order
-					  nil argument-precedence-order-p))
-  (with-slots (arg-info)
-    gf
-    (if lambda-list-p
-	(if argument-precedence-order-p
-	    (set-arg-info gf
-			  :lambda-list lambda-list
-			  :argument-precedence-order argument-precedence-order)
-	    (set-arg-info gf
-			  :lambda-list lambda-list))
-	(set-arg-info gf))
-    (when (and (arg-info-valid-p arg-info)
-	       args
-	       (or lambda-list-p (cddr args)))
-      (update-dfun gf))))
+(defmethod reinitialize-instance :around
+    ((gf standard-generic-function) &rest args &key
+     (lambda-list nil lambda-list-p) (argument-precedence-order nil apo-p))
+  (let ((old-mc (generic-function-method-combination gf)))
+    (prog1 (call-next-method)
+      ;; KLUDGE: EQ is too strong a test.
+      (unless (eq old-mc (generic-function-method-combination gf))
+	(flush-effective-method-cache gf))
+      (cond
+	((and lambda-list-p apo-p)
+	 (set-arg-info gf
+		       :lambda-list lambda-list
+		       :argument-precedence-order argument-precedence-order))
+	(lambda-list-p (set-arg-info gf :lambda-list lambda-list))
+	(t (set-arg-info gf)))
+      (when (and (arg-info-valid-p (gf-arg-info gf))
+		 (not (null args))
+		 (or lambda-list-p (cddr args)))
+	(update-dfun gf)))))
 
 (declaim (special *lazy-dfun-compute-p*))
 
@@ -666,9 +665,10 @@
   (let ((types (mapcar #'class-eq-type classes)))
     (multiple-value-bind (methods all-applicable-and-sorted-p)
 	(compute-applicable-methods-using-types gf types)
-      (function-funcall (get-secondary-dispatch-function1
-			 gf methods types nil t all-applicable-and-sorted-p)
-			nil (mapcar #'class-wrapper classes)))))
+      (let ((generator (get-secondary-dispatch-function1
+			gf methods types nil t all-applicable-and-sorted-p)))
+	(make-callable gf methods generator
+		       nil (mapcar #'class-wrapper classes))))))
 
 (defun value-for-caching (gf classes)
   (let ((methods (compute-applicable-methods-using-types