+;;; 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))
+
+;;;--------------------------------------------------------------------------