From 489173a51e3020f7e0f73208c92ba0a03e21e048 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Sat, 7 Jul 2018 00:08:11 +0100
Subject: [PATCH] src/class-output.lisp: Generate more general class-object
 macros.

We need a macro picking out the most specific class in each of the
metaclass's chains.  If the root metaclass is the most specific class in
its chain then the existing `Foo__class' macro will do for one of these.
---
 doc/structures.tex    | 13 +++++++++++--
 lib/sod-structs.3     | 33 ++++++++++++++++++++++++++++++++-
 src/class-output.lisp | 11 +++++++++--
 3 files changed, 52 insertions(+), 5 deletions(-)

diff --git a/doc/structures.tex b/doc/structures.tex
index 7121692..a36ae82 100644
--- a/doc/structures.tex
+++ b/doc/structures.tex
@@ -637,13 +637,22 @@ defined for the sake of completeness.
 Finally, the class object is defined as
 \begin{prog}
   extern const struct $R$__ilayout $C$__classobj;               \\
-  \#define $C$__class (\&$C$__classobj.$j$.$r$)
+  \#define $C$__class (\&$C$__classobj.$j$.$r$)                 \\
+  \#define $C$__cls_$k$ (\&$C$__classobj.$k$.$n$)               \\
+  \quad$\vdots$
 \end{prog}
 The exported symbol @|$C$__classobj| contains the entire class instance.
 This is usually rather unwieldy.  The macro @|$C$__class| is usable as a
 pointer of type @|const $R$~*|, where $R$ is the root metaclass of $C$, i.e.,
 the metaclass of the least specific superclass of $C$; usually this is
-@|const SodClass~*|.
+@|const SodClass~*|.  For each chain of $C$'s metaclass, a macro
+@|$C$__cls_$k$| is defined, usable as a pointer of type @|const $N$~*|, where
+$K$ and $N$ are the chain's head and tail classes (i.e., the least- and
+most-specific classes in the chain) respectively; this macro is
+\emph{omitted} if $N = R$, i.e., in the common case where $C$'s metaclass is
+precisely the root metaclass, since the existing @|$C$__class| macro is
+already sufficient.
+
 
 %%%----- That's all, folks --------------------------------------------------
 
diff --git a/lib/sod-structs.3 b/lib/sod-structs.3
index 48364cc..11134c8 100644
--- a/lib/sod-structs.3
+++ b/lib/sod-structs.3
@@ -1114,6 +1114,12 @@ Finally, the class object is defined as
 .B #define
 .IB C __class
 .BI (& C __classobj. j . r )
+.br
+.B #define
+.IB C __cls_ k
+.BI (& C __classobj. k . n )
+.br
+\&...
 .PP
 The exported symbol
 .IB C __classobj
@@ -1132,7 +1138,32 @@ is the root metaclass of
 i.e., the metaclass of the least specific superclass of
 .IR C ;
 usually this is
-.BR "const SodClass *" .
+.BR "const SodClass\ *" .
+For each chain of
+.IR C 's
+metaclass, a macro
+.IB C __cls_ k
+is defined, usable as a pointer of type
+.B const
+.IR N \ \c
+.BR * ,
+where
+.I K
+and
+.I N
+are the chain's head and tail classes
+(i.e., the least- and most-specific classes in the chain)
+respectively;
+this macro is
+.I omitted
+if
+.IR N "\ =\ " R ,
+i.e., in the common case where
+.IR C 's
+metaclass is precisely the root metaclass,
+since the existing
+.IB C __class
+macro is already sufficient.
 .
 .\"--------------------------------------------------------------------------
 .SH SEE ALSO
diff --git a/src/class-output.lisp b/src/class-output.lisp
index 8d1d93e..dec1e4e 100644
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -94,10 +94,17 @@
 	   (metaroot (find-root-metaclass class)))
        (format stream "/* The class object. */~@
 		       extern const struct ~A ~A__classobj;~@
-		       #define ~:*~A__class (&~:*~A__classobj.~A.~A)~2%"
+		       #define ~:*~A__class (&~:*~A__classobj.~A.~A)~%"
 	       (ilayout-struct-tag metaclass) class
 	       (sod-class-nickname (sod-class-chain-head metaroot))
-	       (sod-class-nickname metaroot)))))
+	       (sod-class-nickname metaroot))
+       (dolist (chain (sod-class-chains metaclass))
+	 (let ((tail (car chain)))
+	   (unless (eq tail metaroot)
+	     (format stream "#define ~A__cls_~A (&~2:*~A__classobj.~A.~A)~%"
+		     class (sod-class-nickname (sod-class-chain-head tail))
+		     (sod-class-nickname tail)))))
+       (terpri stream))))
 
   ;; Maybe generate an islots structure.
   (when (sod-class-slots class)
-- 
2.11.0