Simplify the use of UPDATE-DEPENDENT, incorporating it into the core methods,...

Simplify the use of UPDATE-DEPENDENT, incorporating it into the core methods, instead of using :AFTER. This eliminates problems with non-compliant code redefining SHARED-INITIALIZE and friends.
parent 94454151
......@@ -77,36 +77,6 @@
(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
......@@ -230,6 +200,8 @@ their lambda lists ~A and ~A are not congruent."
;; the same one, we just update the spec-how list of the generic function.
(compute-g-f-spec-list gf)
(set-generic-function-dispatch gf)
;; iv) Update dependents.
(update-dependents gf (list 'add-method method))
;;
gf)
......@@ -247,6 +219,7 @@ their lambda lists ~A and ~A are not congruent."
(delete method (generic-function-methods gf))
(method-generic-function method) nil)
(si:clear-gfun-hash gf)
(update-dependents gf (list 'remove-method method))
gf)
(function-to-method 'add-method '((gf standard-generic-function)
......@@ -319,21 +292,36 @@ their lambda lists ~A and ~A are not congruent."
new-value)
)
(defun update-dependents-with-initargs (object initargs)
(declare (si::c-local))
(map-dependents object #'(lambda (dep) (apply #'update-dependent object dep initargs))))
;;; ----------------------------------------------------------------------
;;; DEPENDENT MAINTENANCE PROTOCOL
;;;
(defmethod reinitialize-instance :after ((object class) &rest initargs)
(update-dependents-with-initargs object initargs))
(defmethod add-dependent ((c class) dep)
(pushnew dep (class-dependents c)))
(defmethod reinitialize-instance :after ((object standard-generic-function) &rest initargs)
(update-dependents-with-initargs object initargs))
(defmethod add-dependent ((c generic-function) dependent)
(pushnew dependent (generic-function-dependents c)))
(defmethod add-method :after ((gf standard-generic-function) method)
(update-dependents-with-initargs gf (list 'add-method method)))
(defmethod remove-dependent ((c class) dep)
(setf (class-dependents c)
(remove dep (class-dependents c))))
(defmethod remove-method :after ((gf standard-generic-function) method)
(update-dependents-with-initargs gf (list 'remove-method method)))
(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 d)))
(defmethod map-dependents ((c standard-generic-function) function)
(dolist (d (generic-function-dependents c))
(funcall function d)))
(defgeneric update-dependent (object dependent &rest initargs))
;; After this, update-dependents will work
(setf *clos-booted* 'map-dependents)
(defclass initargs-updater ()
())
......@@ -351,6 +339,3 @@ their lambda lists ~A and ~A are not congruent."
(add-dependent #'shared-initialize x)
(add-dependent #'initialize-instance x)
(add-dependent #'allocate-instance x))
(setf *clos-booted* 'map-dependents)
......@@ -177,6 +177,7 @@
(declare (ignore initargs slot-names))
(call-next-method)
(compute-g-f-spec-list gfun)
(update-dependents gfun initargs)
gfun)
(defun associate-methods-to-gfun (gfun &rest methods)
......
......@@ -194,6 +194,10 @@
return t
append k)))
(defun update-dependents (object initargs)
(when *clos-booted*
(map-dependents object #'(lambda (dep) (apply #'update-dependent object dep initargs)))))
(defmethod shared-initialize ((class std-class) slot-names &rest initargs &key
(optimize-slot-access (list *optimize-slot-access*))
sealedp)
......@@ -201,6 +205,7 @@
(setf (slot-value class 'optimize-slot-access) (first optimize-slot-access)
(slot-value class 'sealedp) (and sealedp t))
(setf class (call-next-method))
(update-dependents class initargs)
class)
(defmethod add-direct-subclass ((parent class) child)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment