;;; -*-lisp-*-
;;;
;;; Class finalization protocol
;;;
;;; (c) 2009 Straylight/Edgeware
;;;

;;;----- Licensing notice ---------------------------------------------------
;;;
;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; SOD is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with SOD; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

(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)
(defgeneric compute-cpl (class)
  (:documentation
   "Returns the class precedence list for CLASS."))

(export 'compute-chains)
(defgeneric compute-chains (class)
  (:documentation
   "Compute the layout chains for CLASS.

   Returns the following three values.

     * the head of the class's primary chain;

     * the class's primary chain as a list, most- to least-specific; and

     * the complete collection of chains, as a list of lists, each most- to
       least-specific, with the primary chain first.

   These values will be stored in the CHAIN-HEAD, CHAIN and CHAINS slots.

   If the chains are ill-formed (i.e., not distinct) then an error is
   signalled."))

(export 'check-class-initializer)
(defgeneric check-class-initializer (slot class)
  (:documentation
   "Check that SLOT has an appropriate initializer.

   Signal an appropriate continuable error, possibly protected by
   `finalization-error'.

   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)
  (:documentation
   "Check the CLASS for validity.

   This is done as part of class finalization.  The checks performed are as
   follows.

     * The class name and nickname, and the names of messages, obey the
       rules (see VALID-NAME-P).

     * The messages and slots have distinct names.

     * The classes in the class-precedence-list have distinct nicknames.

     * The chain-link is actually a proper (though not necessarily direct)
       superclass.

     * The chosen metaclass is actually a subclass of all of the
       superclasses' metaclasses.

   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)
  (:documentation
   "Computes all of the gory details about a class.

   Once one has stopped inserting methods and slots and so on into a class,
   one needs to finalize it to determine the layout structure and the class
   precedence list and so on.  More precisely that gets done is this:

     * Related classes (i.e., direct superclasses and the metaclass) are
       finalized if they haven't been already.

     * If you've been naughty and failed to store a list of slots or
       whatever, then an empty list is inserted.

     * The class precedence list is computed and stored.

     * The class is checked for compiance with the well-formedness rules.

     * 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 --------------------------------------------------