src/: Guess the metaclass early, unless we're explicitly bootstrapping.
authorMark Wooding <mdw@distorted.org.uk>
Fri, 6 Jul 2018 22:18:01 +0000 (23:18 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Mon, 9 Jul 2018 11:02:06 +0000 (12:02 +0100)
Otherwise we hit unbound-slot errors if we try to resolve class
initializers.

Introduce an internal property `%bootstrapping' to tell the class
initialization machinery to leave the metaclass slot alone, and use this
in `bootstrap-classes'.  Otherwise, have the `sod-class'
`shared-initialize' method go off and call `guess-metaclass'
immediately.

Move `guess-metaclass' back into `class-make-impl.lisp' and fix up the
documentation stubs.

This partially reverts 981b6fb624186a54320cea34e53e16276aee2bdb.

doc/SYMBOLS
doc/meta.tex
src/builtin.lisp
src/class-finalize-impl.lisp
src/class-finalize-proto.lisp
src/class-make-impl.lisp
src/class-make-proto.lisp

index 54a38ff..4edbdd2 100644 (file)
@@ -207,7 +207,6 @@ class-finalize-proto.lisp
   finalization-error                            macro
   finalization-failed                           function
   finalize-sod-class                            generic
-  guess-metaclass                               generic
 
 class-layout-impl.lisp
   sod-class-effective-slot                      class
@@ -280,6 +279,7 @@ class-make-impl.lisp
 class-make-proto.lisp
   check-message-type                            generic
   check-method-type                             generic
+  guess-metaclass                               generic
   make-sod-class                                function
   make-sod-class-initfrag                       generic
   make-sod-class-initializer                    generic
index 24a7af8..44d8afd 100644 (file)
@@ -99,6 +99,9 @@
       \nlret @<object>}
 \end{describe}
 
+\begin{describe}{gf}{guess-metaclass @<class> @> @<metaclass>}
+\end{describe}
+
 \begin{describe}{fun}
     {sod-subclass-p @<class-a> @<class-b> @> @<generalized-boolean>}
 \end{describe}
 \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}
 
index 7357752..5897da0 100644 (file)
@@ -517,9 +517,11 @@ static const SodClass *const ~A__cpl[] = {
    instance of `SodClass', and `SodClass' is a subclass of `SodObject' (and
    an instance of itself)."
   (let* ((sod-object (make-sod-class "SodObject" nil
-                                    (make-property-set :nick 'obj)))
+                                    (make-property-set :nick 'obj
+                                                       :%bootstrapping t)))
         (sod-class (make-sod-class "SodClass" (list sod-object)
-                                   (make-property-set :nick 'cls)))
+                                   (make-property-set :nick 'cls
+                                                      :%bootstrapping t)))
         (classes (list sod-object sod-class)))
 
     ;; Attach the built-in messages.
index 772ad6f..e7fc45a 100644 (file)
                                         (cdr class-precedence-list)))))))))
 
 ;;;--------------------------------------------------------------------------
-;;; Metaclasses.
-
-(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).
-  (finalization-error (:bad-metaclass)
-    (select-minimal-class-property (sod-class-direct-superclasses class)
-                                  (lambda (super)
-                                    (if (slot-boundp super 'metaclass)
-                                        (slot-value super 'metaclass)
-                                        (throw 'bootstrapping nil)))
-                                  #'sod-subclass-p class "metaclass")))
-
-;;;--------------------------------------------------------------------------
 ;;; Sanity checking.
 
 (defmethod check-sod-class ((class sod-class))
   ;; clone of the CPL and chain establishment code.  If the interface changes
   ;; then `bootstrap-classes' will need to be changed too.
 
-  ;; 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 in that case the
index 2f589b8..edd1bad 100644 (file)
    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
index d719cc6..5a897d4 100644 (file)
 ;;;--------------------------------------------------------------------------
 ;;; Classes.
 
+(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."
+
+  (select-minimal-class-property (sod-class-direct-superclasses class)
+                                #'sod-class-metaclass
+                                #'sod-subclass-p class "metaclass"))
+
 (defmethod shared-initialize :after ((class sod-class) slot-names &key pset)
   "Specific behaviour for SOD class initialization.
 
        `finalize-sod-class'.
 
      * `:link' names the chained superclass.  If unspecified, this class will
-       be left at the head of its chain."
+       be left at the head of its chain.
+
+   Usually, the class's metaclass is determined here, either direcly from the
+   `:metaclass' property or by calling `guess-metaclass'.  Guessing is
+   inhibited if the `:%bootstrapping' property is non-nil."
 
   ;; If no nickname, copy the class name.  It won't be pretty, though.
   (default-slot-from-property (class 'nickname slot-names)
       (pset :nick :id)
     (string-downcase (slot-value class 'name)))
 
-  ;; 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)))
+  ;; Set the metaclass if the appropriate property has been provided or we're
+  ;; not bootstreapping; otherwise leave it unbound for now, and trust the
+  ;; caller to sort out the mess.
+  (multiple-value-bind (meta floc) (get-property pset :metaclass :id)
+    (cond (floc
+          (setf (slot-value class 'metaclass)
+                (with-default-error-location (floc)
+                  (find-sod-class meta))))
+         ((not (get-property pset :%bootstrapping :boolean))
+          (default-slot (class 'metaclass slot-names)
+            (guess-metaclass class)))))
 
   ;; If no chain-link, then start a new chain here.
   (default-slot-from-property (class 'chain-link slot-names)
index 0e3c5d7..2e1fe7c 100644 (file)
 ;;;--------------------------------------------------------------------------
 ;;; Classes.
 
+(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 'make-sod-class)
 (defun make-sod-class (name superclasses pset &optional location)
   "Construct and return a new SOD class with the given NAME and SUPERCLASSES.