Reimplemented dependents. REMOVE-METHOD was not a generic function and did not update dependents.

src/CHANGELOG

@@ -9,6 +9,8 @@ ECL 12.2.2:
 
  - :CDECL was not accepted as an FFI declaration due to a typo.
 
+ - REMOVE-METHOD was not a generic function.
+
 * Visible changes:
 
  - DIRECTORY no longer complains when it finds an inexistent directory
@@ -33,6 +35,10 @@ ECL 12.2.2:
 
  - Implemented and used in the core: VALIDATE-SUPERCLASSES
 
+ - UPDATE-DEPENDENT, MAP-DEPENDENTS and related functions have been fixed. They
+   are now invoked by REMOVE-METHOD and REINITIALIZE-INSTANCE, when acting on
+   generic functions, standard classes, etc.
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***

src/clos/change.lsp

@@ -198,10 +198,6 @@
   (setf (class-finalized-p class) nil)
   (finalize-unless-forward class)
 
-  ;; Now we can call the dependents
-  (map-dependents class #'(lambda (dep)
-                            (apply #'update-dependent class dep initargs)))
-
   class)
 
 (defmethod make-instances-obsolete ((class class))

src/clos/fixup.lsp

@@ -77,6 +77,36 @@
   (declare (ignore class direct-slot initargs))
   (find-class 'standard-writer-method))
 
+;;; ----------------------------------------------------------------------
+;;; DEPENDENT MAINTENANCE PROTOCOL
+;;;
+
+(defmethod add-dependent ((c class) dep)
+  (pushnew dep (class-dependents c)))
+
+(defmethod add-dependent ((c generic-function) dependent)
+  (pushnew dependent (generic-function-dependents c)))
+
+(defmethod remove-dependent ((c class) dep)
+  (setf (class-dependents c)
+        (remove dep (class-dependents c))))
+
+(defmethod remove-dependent ((c standard-generic-function) dep)
+  (setf (generic-function-dependents c)
+        (remove dep (generic-function-dependents c))))
+
+(defmethod map-dependents ((c class) function)
+  (dolist (d (class-dependents c))
+    (funcall function c)))
+
+(defmethod map-dependents ((c standard-generic-function) function)
+  (dolist (d (generic-function-dependents c))
+    (funcall function c)))
+
+(defmethod update-dependent ((object t) (dependents t) &rest initargs)
+  ;; By default UPDATE-DEPENDENT does nothing
+  )
+
 ;;; ----------------------------------------------------------------------
 ;;; Fixup
 
@@ -201,9 +231,6 @@ their lambda lists ~A and ~A are not congruent."
   (compute-g-f-spec-list gf)
   (set-generic-function-dispatch gf)
   ;;
-  ;; Finally update the dependent objects
-  (map-dependents gf #'(lambda (dep) (update-dependents gf dep 'add-method method)))
-  ;;
   gf)
 
 (defun function-to-method (name signature)
@@ -215,17 +242,18 @@ their lambda lists ~A and ~A are not congruent."
     (setf (generic-function-name generic-function) name)
     (fmakunbound aux-name)))
 
-(function-to-method 'add-method '((gf standard-generic-function)
-                                  (method standard-method)))
-
 (defun remove-method (gf method)
   (setf (generic-function-methods gf)
 	(delete method (generic-function-methods gf))
 	(method-generic-function method) nil)
   (si:clear-gfun-hash gf)
-  (map-dependents gf #'(lambda (dep) (update-dependents gf dep 'remove-method method)))
   gf)
 
+(function-to-method 'add-method '((gf standard-generic-function)
+                                  (method standard-method)))
+(function-to-method 'remove-method '((gf standard-generic-function)
+				     (method standard-method)))
+
 ;;; COMPUTE-APPLICABLE-METHODS is used by the core in various places,
 ;;; including instance initialization. This means we cannot just redefine it.
 ;;; Instead, we create an auxiliary function and move definitions from one to
@@ -268,6 +296,8 @@ their lambda lists ~A and ~A are not congruent."
   (error "In method ~A~%No next method given arguments ~A" method args))
 
 (defun no-primary-method (gf &rest args)
+  (print gf)
+  (print args)
   (error "Generic function: ~A. No primary method given arguments: ~S"
 	 (generic-function-name gf) args))
 
@@ -289,30 +319,21 @@ their lambda lists ~A and ~A are not congruent."
   new-value)
 )
 
-;;; ----------------------------------------------------------------------
-;;; DEPENDENT MAINTENANCE PROTOCOL
-;;;
+(defun update-dependents-with-initargs (object initargs)
+  (declare (si::c-local))
+  (map-dependents object #'(lambda (dep) (apply #'update-dependent object dep initargs))))
 
-(function-to-method 'map-dependents '((c standard-generic-function) function))
+(defmethod reinitialize-instance :after ((object class) &rest initargs)
+  (update-dependents-with-initargs object initargs))
 
-(defmethod map-dependents ((c class) function)
-  (dolist (d (class-dependents c))
-    (funcall function c)))
+(defmethod reinitialize-instance :after ((object standard-generic-function) &rest initargs)
+  (update-dependents-with-initargs object initargs))
 
-(function-to-method 'add-dependent '((c standard-generic-function) function))
+(defmethod add-method :after ((gf standard-generic-function) method)
+  (update-dependents-with-initargs gf (list 'add-method method)))
 
-(defmethod add-dependent ((c class) dep)
-  (pushnew dep (class-dependents c)))
-
-(defmethod remove-dependent ((c standard-generic-function) dep)
-  (setf (generic-function-dependents c)
-        (remove dep (generic-function-dependents c))))
-
-(defmethod remove-dependent ((c class) dep)
-  (setf (class-dependents c)
-        (remove dep (class-dependents c))))
-
-(defgeneric update-dependents (object dependents &rest initargs))
+(defmethod remove-method :after ((gf standard-generic-function) method)
+  (update-dependents-with-initargs gf (list 'remove-method method)))
 
 (defclass initargs-updater ()
   ())
@@ -321,14 +342,15 @@ their lambda lists ~A and ~A are not congruent."
   (slot-makunbound a-class 'valid-initargs)
   (mapc #'recursively-update-classes (class-direct-subclasses a-class)))
 
-(defmethod update-dependents ((object generic-function) (dep initargs-updater)
-                               &rest initargs)
+(defmethod update-dependent ((object generic-function) (dep initargs-updater)
+			     &rest initargs)
   (declare (ignore dep initargs object))
   (recursively-update-classes +the-class+))
 
-(setf *clos-booted* 'built-in-class)
-
 (let ((x (make-instance 'initargs-updater)))
   (add-dependent #'shared-initialize x)
   (add-dependent #'initialize-instance x)
   (add-dependent #'allocate-instance x))
+
+(setf *clos-booted* 'map-dependents)
+

src/clos/kernel.lsp

@@ -212,17 +212,6 @@
 ;;; ----------------------------------------------------------------------
 ;;;                                                         early versions
 
-(defun map-dependents (c function)
-  (dolist (d (if (classp c)
-                 (class-dependents c)
-                 (generic-function-dependents c)))
-    (funcall function d)))
-
-(defun add-dependent (c d)
-  (if (classp c)
-      (pushnew d (class-dependents c))
-      (pushnew d (generic-function-dependents c))))
-
 ;;; early version used during bootstrap
 (defun ensure-generic-function (name &key (lambda-list (si::unbound) l-l-p))
   (if (and (fboundp name) (si::instancep (fdefinition name)))

src/clos/method.lsp

@@ -324,8 +324,6 @@ have disappeared."
 	    (rest (si::process-lambda-list (method-lambda-list method) t))))
     (compute-g-f-spec-list gf)
     (set-generic-function-dispatch gf)
-    (dolist (d (generic-function-dependents gf))
-      (update-dependent gf d 'add-method method))
     method))
 
 (defun find-method (gf qualifiers specializers &optional (errorp t))