X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/981b6fb624186a54320cea34e53e16276aee2bdb..refs/heads/mdw/progfmt:/src/class-finalize-proto.lisp

diff --git a/src/class-finalize-proto.lisp b/src/class-finalize-proto.lisp
index fcb8686..7a64ae3 100644
--- a/src/class-finalize-proto.lisp
+++ b/src/class-finalize-proto.lisp
@@ -26,6 +26,46 @@
 (cl:in-package #:sod)
 
 ;;;--------------------------------------------------------------------------
+;;; Finalization error handling.
+
+;; These variables are internal to the implementation.
+(defvar-unbound *finalization-errors*
+  "A list of tokens for errors reported about the class being finalized.
+
+   During finalization, this is bound to a list of tokens corresponding to
+   the problems which have been reported so far via `finalization-error'.")
+(defvar-unbound *finalization-error-token*
+  "The token to store in `*finalization-errors*' in the event of an error.")
+
+(export 'finalization-error)
+(defmacro finalization-error ((token &rest args) &body body)
+  "Check for a kind of finalization error denoted by TOKEN and the ARGS.
+
+   The TOKEN and ARGS are convered into an error token as follows.  If no
+   ARGS are given, then the TOKEN itself is evaluated and used directly;
+   otherwise, the token is a list whose first element is the result of
+   evaluating TOKEN, and the remaining elements are the results of evaluating
+   the ARGS.  Error tokens are compared with `equal'.
+
+   If a finalization error denoted by this token has already been reported,
+   then do nothing: the BODY is not evaluated, and the result is nil.
+   Special exception: a nil token denotes a `generic' error which can be
+   repeated indefintely.
+
+   If the BODY signals an error (and doesn't handle it), then the error token
+   is added to a list of reported errors.  That way, future calls to
+   `finalization-error' with an equal error token won't cause the user to be
+   inundated with duplicate reports."
+  `(let ((*finalization-error-token* ,(if (null args) token
+					  `(list ,token ,@args))))
+     ,@body))
+
+(export 'finalization-failed)
+(defun finalization-failed ()
+  "Give up on finalizing the current class."
+  (throw '%finalization-failed nil))
+
+;;;--------------------------------------------------------------------------
 ;;; Protocol definition.
 
 (export 'compute-cpl)
@@ -52,13 +92,19 @@
    If the chains are ill-formed (i.e., not distinct) then an error is
    signalled."))
 
-(export 'guess-metaclass)
-(defgeneric guess-metaclass (class)
+(export 'check-class-initializer)
+(defgeneric check-class-initializer (slot class)
   (:documentation
-   "Determine a suitable metaclass for the CLASS.
+   "Check that SLOT has an appropriate initializer.
+
+   Signal an appropriate continuable error, possibly protected by
+   `finalization-error'.
 
-   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."))
+   The initializer might come either from the SLOT's defining class (which it
+   already knows), or from the prospective instance CLASS, of which the
+   defining class will be (a superclass of) the metaclass.  Or, if the slot
+   is magical, then the initial value might come from somewhere else and it
+   might be forbidden for a programmer to set it explicitly."))
 
 (export 'check-sod-class)
 (defgeneric check-sod-class (class)
@@ -81,8 +127,11 @@
      * The chosen metaclass is actually a subclass of all of the
        superclasses' metaclasses.
 
-   Returns true if all is well; false (and signals errors) if anything was
-   wrong."))
+   If no attempt has previously been made to finalize the class, then errors
+   are signalled for the problems found.  If finalizing it has been tried
+   before and failed (or this is a recursive attempt to finalize the class)
+   then nil is returned immediately.  Otherwise a non-nil value is
+   returned."))
 
 (export 'finalize-sod-class)
 (defgeneric finalize-sod-class (class)
@@ -103,6 +152,16 @@
 
      * The class is checked for compiance with the well-formedness rules.
 
-     * The layout chains are computed."))
+     * The layout chains are computed.
+
+   Returns a generalized boolean: non-nil if the class has been successfully
+   finalized -- either just now, or if it was finalized already and nothing
+   needed to be done -- or nil if finalization failed -- either just now, or
+   because the class had previously been marked as broken following a failed
+   finalization attempt.
+
+   User methods can assume that the class in question has not yet been
+   finalized.  Errors during finalization can be reported in the usual way.
+   See also `finalization-error' and `finalization-failed' above."))
 
 ;;;----- That's all, folks --------------------------------------------------