Reimplemented CLOS dependents so that they can be used for bootstrapping

src/clos/fixup.lsp

@@ -202,12 +202,17 @@ their lambda lists ~A and ~A are not congruent."
   ;;
   gf)
 
-(setf (method-function
-       (eval '(defmethod false-add-method ((gf standard-generic-function)
-					   (method standard-method)))))
-      #'add-method)
-(setf (fdefinition 'add-method) #'false-add-method)
-(setf (generic-function-name #'add-method) 'add-method)
+(defun function-to-method (name signature)
+  (let* ((aux-name 'temp-method)
+         (method (eval `(defmethod ,aux-name ,signature)))
+         (generic-function (fdefinition aux-name)))
+    (setf (method-function method) (fdefinition name))
+    (setf (fdefinition name) generic-function)
+    (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)
@@ -249,3 +254,30 @@ their lambda lists ~A and ~A are not congruent."
       (t (error "~A is not a class." new-value))))
   new-value)
 )
+
+;;; ----------------------------------------------------------------------
+;;; DEPENDENT MAINTENANCE PROTOCOL
+;;;
+
+(function-to-method 'map-dependents '((c standard-generic-function) function))
+
+(defmethod map-dependents ((c class) function)
+  (dolist (d (class-dependents c))
+    (funcall function c)))
+
+(function-to-method 'add-dependent '((c standard-generic-function) function))
+
+(defmethod add-dependent ((c class) dep)
+  (pushnew c (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))
+
+(setf *clos-booted* t)

src/clos/generic.lsp

@@ -244,6 +244,9 @@
 	   (simple-program-error "The special operator ~A is not a valid name for a generic function" name))
 	  ((macro-function name)
 	   (simple-program-error "The symbol ~A is bound to a macro and is not a valid name for a generic function" name))
+          ((not *clos-booted*)
+           (setf (fdefinition (or traced name))
+		 (apply #'ensure-generic-function-using-class nil name args))
+           (fdefinition name))
 	  (t
-	   (simple-program-error "The symbol ~A is bound to an ordinary function and is not a valid name for a generic function" name))
-	  )))
+	   (simple-program-error "The symbol ~A is bound to an ordinary function and is not a valid name for a generic function" name)))))

src/clos/kernel.lsp

@@ -16,6 +16,8 @@
 
 (in-package "CLOS")
 
+(defparameter *clos-booted* nil)
+
 (defconstant *default-method-cache-size* 64 "Size of hash tables for methods")
 
 ;;;----------------------------------------------------------------------
@@ -79,7 +81,8 @@
       (size :accessor class-size)
       (sealedp :initarg :sealedp :initform nil :accessor class-sealedp)
       (prototype)
-      (dependents :initform nil :accessor class-dependents))))
+      (dependents :initform nil :accessor class-dependents)
+      (valid-initargs :initform nil :accessor class-valid-initargs))))
 
 ;#.(create-accessors +class-slots+ 'class)
 
@@ -207,6 +210,17 @@
 ;;; ----------------------------------------------------------------------
 ;;;                                                         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/standard.lsp

@@ -77,23 +77,6 @@
 	)))
   instance)
 
-;;; ----------------------------------------------------------------------
-;;; DEPENDENT MAINTENANCE PROTOCOL
-;;;
-
-(defmethod map-dependents ((c class) function)
-  (print 'map-dependents)
-  (print (length (class-dependents c)))
-  (dolist (d (class-dependents c))
-    (funcall function c)))
-
-(defmethod add-dependent ((c class) dep)
-  (pushnew c (class-dependents c)))
-
-(defmethod remove-dependent ((c class) dep)
-  (setf (class-dependents c)
-        (remove dep (class-dependents c))))
-
 ;;; ----------------------------------------------------------------------
 ;;; CLASSES INITIALIZATION AND REINITIALIZATION
 ;;;

src/clos/stdmethod.lsp

@@ -28,21 +28,6 @@
   #.(remove-accessors +standard-generic-function-slots+)
   (:metaclass 'funcallable-standard-class))
 
-;;;
-;;; GENERIC-FUNCTION DEPENDENT MAINTENANCE PROTOCOL
-;;;
-
-(defmethod map-dependents ((c standard-generic-function) function)
-  (dolist (d (generic-function-dependents c))
-    (funcall function c)))
-
-(defmethod add-dependent ((c standard-generic-function) dep)
-  (pushnew c (generic-function-dependents c)))
-
-(defmethod remove-dependent ((c standard-generic-function) dep)
-  (setf (generic-function-dependents c)
-        (remove dep (generic-function-dependents c))))
-
 ;;;----------------------------------------------------------------------
 ;;; Method
 ;;; ----------------------------------------------------------------------
@@ -71,4 +56,3 @@
 (defclass standard-reader-method (standard-accessor-method) ())
 
 (defclass standard-writer-method (standard-accessor-method) ())
-