src/: Make `find-class-initializer' be a proper part of the interface.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 4edbdd2..9af73e1 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -239,6 +239,7 @@ class-layout-proto.lisp
   effective-slot-class                          generic
   effective-slot-direct-slot                    generic
   effective-slot-initializer                    generic
+  find-class-initializer                        generic
   find-slot-initargs                            generic
   find-slot-initializer                         generic
   ichain                                        class
@@ -1106,6 +1107,8 @@ finalize-module
 finalize-sod-class
   sod-class
   sod-class [:around]
+find-class-initializer
+  effective-slot sod-class
 find-slot-initargs
   sod-class sod-slot
 find-slot-initializer

diff --git a/doc/layout.tex b/doc/layout.tex
index e42b83f..b106aa4 100644 (file)
--- a/doc/layout.tex
+++ b/doc/layout.tex
@@ -68,6 +68,10 @@
     {find-slot-initializer @<class> @<slot> @> @<init-or-nil>}
 \end{describe}
 
+\begin{describe}{gf}
+    {find-class-initializer @<slot> @<class> @> @<init-or-nil>}
+\end{describe}
+
 \begin{describe}{gf}{find-slot-initargs @<class> @<slot> @> @<list>}
 \end{describe}
 

diff --git a/src/class-layout-impl.lisp b/src/class-layout-impl.lisp
index 452e683..119996e 100644 (file)
--- a/src/class-layout-impl.lisp
+++ b/src/class-layout-impl.lisp
@@ -56,6 +56,14 @@
                 :initializer (find-slot-initializer class slot)
                 :initargs (find-slot-initargs class slot)))
 
+(defmethod find-class-initializer ((slot effective-slot) (class sod-class))
+  (let ((dslot (effective-slot-direct-slot slot)))
+    (or (some (lambda (super)
+               (find dslot (sod-class-class-initializers super)
+                     :key #'sod-initializer-slot))
+             (sod-class-precedence-list class))
+       (effective-slot-initializer slot))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Special-purpose slot objects.
 

diff --git a/src/class-layout-proto.lisp b/src/class-layout-proto.lisp
index 927700f..c919892 100644 (file)
--- a/src/class-layout-proto.lisp
+++ b/src/class-layout-proto.lisp
@@ -68,6 +68,19 @@
    SLOT is a direct slot defined on CLASS or one of its superclasses.
    (Metaclass initializers are handled using a different mechanism.)"))
 
+(export 'find-class-initializer)
+(defgeneric find-class-initializer (slot class)
+  (:documentation
+   "Return an initializer value (any printable value) for a class slot SLOT.
+
+   The initializer might come either from the SLOT's defining class (which it
+   already knows), or from the instance CLASS, of which the defining class is
+   be (a superclass of) the metaclass.
+
+   This is used as part of `has-class-initializer-p' and the default output
+   hook for `effective-slot': if you override both of those then you don't
+   need to override this too."))
+
 ;;;--------------------------------------------------------------------------
 ;;; Instance layout.
 

diff --git a/src/class-output.lisp b/src/class-output.lisp
index ee77a2c..8d1d93e 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -654,15 +654,6 @@ const struct ~A ~A__classobj = {~%"
               (vtable-name class chain-head)
               (sod-class-nickname chain-tail))))))
 
-(defgeneric find-class-initializer (slot class)
-  (:method ((slot effective-slot) (class sod-class))
-    (let ((dslot (effective-slot-direct-slot slot)))
-      (or (some (lambda (super)
-                 (find dslot (sod-class-class-initializers super)
-                       :key #'sod-initializer-slot))
-               (sod-class-precedence-list class))
-         (effective-slot-initializer slot)))))
-
 (defgeneric output-class-initializer (slot instance stream)
   (:method ((slot sod-class-effective-slot) (instance sod-class) stream)
     (let ((func (effective-slot-initializer-function slot))