src/class-make-impl.lisp: Don't store `nil' in the `metaclass' slot.

Normally we can fill `metaclass' in at construction time, but this is
difficult while we're bootstrapping the class graph.  Previously, we'd
store `nil' in the slot, and expect `bootstrap-classes' to fix things up
later; but actually, the `metaclass' slot is declared to hold only
`sod-class' objects.

Rather than expand the slot type, delay the `guess-metaclass' machinery
until class finalization (moving the code across into the relevant
source files).

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 6bc3b7457a3cb6d3954a3422a0a02ccb61c76171..e99d6df140c05630e74d32a628ad85f55190b2c4 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -151,6 +151,7 @@ class-finalize-proto.lisp
   compute-chains                                generic
   compute-cpl                                   generic
   finalize-sod-class                            generic
+  guess-metaclass                               generic
 
 class-layout-impl.lisp
   sod-class-effective-slot                      class
@@ -218,7 +219,6 @@ class-make-proto.lisp
   check-message-type                            generic
   check-method-type                             generic
   define-sod-class                              macro
-  guess-metaclass                               generic
   make-sod-class                                function
   make-sod-class-initializer                    generic
   make-sod-initializer-using-slot               generic

diff --git a/doc/meta.tex b/doc/meta.tex
index 52a89cfe5560348210d62a5e371598873214c5e6..f412e00c3682326f93d18a37ef90d5af287d5b8f 100644 (file)
--- a/doc/meta.tex
+++ b/doc/meta.tex
@@ -61,9 +61,6 @@
      \dhead{gf}{sod-class-vtables @<class> @> @<list>}}
 \end{describe*}
 
-\begin{describe}{gf}{guess-metaclass @<class> @> @<metaclass>}
-\end{describe}
-
 \begin{describe}{fun}
     {make-sod-class @<name> @<superclasses> @<pset> \&optional @<floc>
       @> @<class>}
@@ -256,6 +253,9 @@
 \begin{describe}{gf}{compute-chains @<class> @> @<list>}
 \end{describe}
 
+\begin{describe}{gf}{guess-metaclass @<class> @> @<metaclass>}
+\end{describe}
+
 \begin{describe}{gf}{check-sod-class @<class>}
 \end{describe}
 

diff --git a/src/class-finalize-impl.lisp b/src/class-finalize-impl.lisp
index 25ce1c22a594587c3eaaa77a3348a8ac80846a34..23d7107b7a88d69a2f4937acd7014f91c52cdc36 100644 (file)
--- a/src/class-finalize-impl.lisp
+++ b/src/class-finalize-impl.lisp
@@ -275,6 +275,35 @@ (defmethod compute-chains ((class sod-class))
                                           (gethash super table))
                                         (cdr class-precedence-list)))))))))
 
+;;;--------------------------------------------------------------------------
+;;; Metaclasses.
+
+(defun maximum (items order what)
+  "Return a maximum item according to the non-strict partial ORDER."
+  (reduce (lambda (best this)
+           (cond ((funcall order best this) best)
+                 ((funcall order this best) this)
+                 (t (error "Unable to choose best ~A." what))))
+         items))
+
+(defmethod guess-metaclass ((class sod-class))
+  "Default metaclass-guessing function for classes.
+
+   Return the most specific metaclass of any of the CLASS's direct
+   superclasses."
+
+  ;; During bootstrapping, our superclasses might not have their own
+  ;; metaclasses resolved yet.  If we find this, then throw `bootstrapping'
+  ;; so that `shared-initialize' on `sod-class' can catch it (or as a shot
+  ;; across the bows of anyone else who calls us).
+  (maximum (mapcar (lambda (super)
+                    (if (slot-boundp super 'metaclass)
+                        (slot-value super 'metaclass)
+                        (throw 'bootstrapping nil)))
+                  (sod-class-direct-superclasses class))
+          #'sod-subclass-p
+          (format nil "metaclass for `~A'" class)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Sanity checking.
 
@@ -352,6 +381,11 @@ (defmethod finalize-sod-class ((class sod-class))
        ;; If this fails, mark the class as a loss.
        (setf (slot-value class 'state) :broken)
 
+       ;; Set up the metaclass if it's not been set already.  This is delayed
+       ;; to give bootstrapping a chance to set up metaclass and superclass
+       ;; circularities.
+       (default-slot (class 'metaclass) (guess-metaclass class))
+
        ;; Finalize all of the superclasses.  There's some special pleading
        ;; here to make bootstrapping work: we don't try to finalize the
        ;; metaclass if we're a root class (no direct superclasses -- because

diff --git a/src/class-finalize-proto.lisp b/src/class-finalize-proto.lisp
index 5bbbd7a3ef8c6dd9d2ed74c11dbb1ce858b528e3..fcb8686cda97030932b6c9a97bc89f375ee581aa 100644 (file)
--- a/src/class-finalize-proto.lisp
+++ b/src/class-finalize-proto.lisp
@@ -52,6 +52,14 @@ (defgeneric compute-chains (class)
    If the chains are ill-formed (i.e., not distinct) then an error is
    signalled."))
 
+(export 'guess-metaclass)
+(defgeneric guess-metaclass (class)
+  (:documentation
+   "Determine a suitable metaclass for the CLASS.
+
+   The default behaviour is to choose the most specific metaclass of any of
+   the direct superclasses of CLASS, or to signal an error if that failed."))
+
 (export 'check-sod-class)
 (defgeneric check-sod-class (class)
   (:documentation

diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp
index 906519b7ac2826007deae310afcca7fff52f094b..f7231ef1e830db41dc3a214688f29948fed89c4f 100644 (file)
--- a/src/class-make-impl.lisp
+++ b/src/class-make-impl.lisp
@@ -28,24 +28,6 @@ (cl:in-package #:sod)
 ;;;--------------------------------------------------------------------------
 ;;; Classes.
 
-(defun maximum (items order what)
-  "Return a maximum item according to the non-strict partial ORDER."
-  (reduce (lambda (best this)
-           (cond ((funcall order best this) best)
-                 ((funcall order this best) this)
-                 (t (error "Unable to choose best ~A." what))))
-         items))
-
-(defmethod guess-metaclass ((class sod-class))
-  "Default metaclass-guessing function for classes.
-
-   Return the most specific metaclass of any of the CLASS's direct
-   superclasses."
-  (maximum (mapcar #'sod-class-metaclass
-                  (sod-class-direct-superclasses class))
-          #'sod-subclass-p
-          (format nil "metaclass for `~A'" class)))
-
 (defmethod shared-initialize :after ((class sod-class) slot-names &key pset)
   "Specific behaviour for SOD class initialization.
 
@@ -67,11 +49,11 @@   (default-slot-from-property (class 'nickname slot-names)
       (pset :nick :id)
     (string-downcase (slot-value class 'name)))
 
-  ;; If no metaclass, guess one in a (Lisp) class-specific way.
+  ;; Set the metaclass if the appropriate property has been provided;
+  ;; otherwise leave it unbound for now, and we'll sort out the mess during
+  ;; finalization.
   (default-slot-from-property (class 'metaclass slot-names)
-      (pset :metaclass :id meta (find-sod-class meta))
-    (and (sod-class-direct-superclasses class)
-        (guess-metaclass class)))
+      (pset :metaclass :id meta (find-sod-class meta)))
 
   ;; If no chain-link, then start a new chain here.
   (default-slot-from-property (class 'chain-link slot-names)

diff --git a/src/class-make-proto.lisp b/src/class-make-proto.lisp
index df4b4f080fa04ee9676d5c32c78f12d9417e0c68..cb12849178ae39acf4a69bdf67626d66d5fdb0ed 100644 (file)
--- a/src/class-make-proto.lisp
+++ b/src/class-make-proto.lisp
@@ -59,14 +59,6 @@ (defun make-sod-class (name superclasses pset &optional location)
                                 :pset pset)))
       class)))
 
-(export 'guess-metaclass)
-(defgeneric guess-metaclass (class)
-  (:documentation
-   "Determine a suitable metaclass for the CLASS.
-
-   The default behaviour is to choose the most specific metaclass of any of
-   the direct superclasses of CLASS, or to signal an error if that failed."))
-
 ;;;--------------------------------------------------------------------------
 ;;; Slots and slot initializers.