From 7b118f8a767addd8c869bf83506f48d28dcd7b94 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Fri, 6 Jul 2018 23:36:21 +0100
Subject: [PATCH] src/: Make `find-class-initializer' be a proper part of the
 interface.

---
 doc/SYMBOLS                 |  3 +++
 doc/layout.tex              |  4 ++++
 src/class-layout-impl.lisp  |  8 ++++++++
 src/class-layout-proto.lisp | 13 +++++++++++++
 src/class-output.lisp       |  9 ---------
 5 files changed, 28 insertions(+), 9 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 4edbdd2..9af73e1 100644
--- 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
--- 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
--- 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
--- 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
--- 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))
-- 
2.11.0