X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fstd-class.lisp;h=3a6b3b98fa752e7c4c01ec06dd00d8500c17e103;hb=760349abe9068fe4e5e3c03013f3533b64602a93;hp=d60c04c3858ed8e0c23a0f20c856b0f26e238188;hpb=f4e8bca5eaa6e6db42299fe2f3852fb2e07508c7;p=sbcl.git

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index d60c04c..3a6b3b9 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -501,8 +501,9 @@
   (setf (slot-value class 'class-eq-specializer)
 	(make-instance 'class-eq-specializer :class class)))
 
-(defmethod reinitialize-instance :before ((class slot-class) &key)
-  (remove-direct-subclasses class (class-direct-superclasses class))
+(defmethod reinitialize-instance :before ((class slot-class) &key direct-superclasses)
+  (dolist (old-super (set-difference (class-direct-superclasses class) direct-superclasses))
+    (remove-direct-subclass old-super class))
   (remove-slot-accessors    class (class-direct-slots class)))
 
 (defmethod reinitialize-instance :after ((class slot-class)
@@ -769,11 +770,6 @@
     (unless (memq class (class-direct-subclasses class))
       (add-direct-subclass super class))))
 
-(defun remove-direct-subclasses (class supers)
-  (let ((old (class-direct-superclasses class)))
-    (dolist (o (set-difference old supers))
-      (remove-direct-subclass o class))))
-
 (defmethod finalize-inheritance ((class std-class))
   (update-class class t))
 
@@ -942,10 +938,10 @@
   (find-class 'standard-direct-slot-definition))
 
 (defun make-direct-slotd (class initargs)
-  (let ((initargs (list* :class class initargs)))
-    (apply #'make-instance
-	   (apply #'direct-slot-definition-class class initargs)
-	   initargs)))
+  (apply #'make-instance
+         (apply #'direct-slot-definition-class class initargs)
+         :class class
+         initargs))
 
 (defmethod compute-slots ((class std-class))
   ;; As specified, we must call COMPUTE-EFFECTIVE-SLOT-DEFINITION once