src/class-make-proto.lisp: Choose Lisp metaclass more cleverly.

[sod] / src / class-make-proto.lisp

diff --git a/src/class-make-proto.lisp b/src/class-make-proto.lisp
index 0a633de..8b024bd 100644 (file)
--- a/src/class-make-proto.lisp
+++ b/src/class-make-proto.lisp
@@ -33,27 +33,30 @@
   "Construct and return a new SOD class with the given NAME and SUPERCLASSES.
 
    This is the main constructor function for classes.  The protocol works as
   "Construct and return a new SOD class with the given NAME and SUPERCLASSES.
 
    This is the main constructor function for classes.  The protocol works as

-   follows.  The `:lisp-class' property in PSET is checked: if it exists, it
-   must be a symbol naming a (CLOS) class, which is used in place of
+   follows.  The `:lisp-metaclass' property in PSET is checked: if it exists,
+   it must be a symbol naming a (CLOS) class, which is used in place of

    `sod-class'.  All of the arguments are then passed to `make-instance';
    further behaviour is left to the standard CLOS instance construction
    protocol; for example, `sod-class' defines an `:after'-method on
    `shared-initialize'.
 
    Minimal sanity checking is done during class construction; most of it is
    `sod-class'.  All of the arguments are then passed to `make-instance';
    further behaviour is left to the standard CLOS instance construction
    protocol; for example, `sod-class' defines an `:after'-method on
    `shared-initialize'.
 
    Minimal sanity checking is done during class construction; most of it is

-   left for `finalize-sod-class' to do (via `check-sod-class').
-
-   Unused properties in PSET are diagnosed as errors."
+   left for `finalize-sod-class' to do (via `check-sod-class')."

 
   (with-default-error-location (location)
     (let* ((pset (property-set pset))
 
   (with-default-error-location (location)
     (let* ((pset (property-set pset))

-          (class (make-instance (get-property pset :lisp-class :symbol
-                                              'sod-class)
+          (best-class (or (get-property pset :lisp-metaclass :symbol nil)
+                          (if superclasses
+                              (maximum (mapcar #'class-of superclasses)
+                                       #'subtypep
+                                       (format nil "Lisp metaclass for ~A"
+                                               name))
+                              'sod-class)))
+          (class (make-instance best-class

                                 :name name
                                 :superclasses superclasses
                                 :location (file-location location)
                                 :pset pset)))
                                 :name name
                                 :superclasses superclasses
                                 :location (file-location location)
                                 :pset pset)))

-      (check-unused-properties pset)

       class)))
 
 (export 'guess-metaclass)
       class)))
 
 (export 'guess-metaclass)


@@ -74,13 +77,11 @@
 
    This is the main constructor function for slots.  This is a generic
    function primarily so that the CLASS can intervene in the construction
 
    This is the main constructor function for slots.  This is a generic
    function primarily so that the CLASS can intervene in the construction

-   process.  The default method uses the `:lisp-class' property (defaulting
+   process.  The default method uses the `:slot-class' property (defaulting

    to `sod-slot') to choose a (CLOS) class to instantiate.  The slot is then
    constructed by `make-instance' passing the arguments as initargs; further
    behaviour is left to the standard CLOS instance construction protocol; for
    to `sod-slot') to choose a (CLOS) class to instantiate.  The slot is then
    constructed by `make-instance' passing the arguments as initargs; further
    behaviour is left to the standard CLOS instance construction protocol; for

-   example, `sod-slot' defines an `:after'-method on `shared-initialize'.
-
-   Unused properties on PSET are diagnosed as errors."))
+   example, `sod-slot' defines an `:after'-method on `shared-initialize'."))

 
 (export 'make-sod-instance-initializer)
 (defgeneric make-sod-instance-initializer
 
 (export 'make-sod-instance-initializer)
 (defgeneric make-sod-instance-initializer


@@ -93,9 +94,7 @@
    construction process.  The default method looks up the slot using
    `find-instance-slot-by-name', calls `make-sod-initializer-using-slot' to
    actually make the initializer object, and adds it to the appropriate list
    construction process.  The default method looks up the slot using
    `find-instance-slot-by-name', calls `make-sod-initializer-using-slot' to
    actually make the initializer object, and adds it to the appropriate list

-   in CLASS.
-
-   Unused properties on PSET are diagnosed as errors."))
+   in CLASS."))

 
 (export 'make-sod-class-initializer)
 (defgeneric make-sod-class-initializer
 
 (export 'make-sod-class-initializer)
 (defgeneric make-sod-class-initializer


@@ -108,9 +107,7 @@
    construction process.  The default method looks up the slot using
    `find-class-slot-by-name', calls `make-sod-initializer-using-slot' to
    actually make the initializer object, and adds it to the appropriate list
    construction process.  The default method looks up the slot using
    `find-class-slot-by-name', calls `make-sod-initializer-using-slot' to
    actually make the initializer object, and adds it to the appropriate list

-   in CLASS.
-
-   Unused properties on PSET are diagnosed as errors."))
+   in CLASS."))

 
 (export 'make-sod-initializer-using-slot)
 (defgeneric make-sod-initializer-using-slot
 
 (export 'make-sod-initializer-using-slot)
 (defgeneric make-sod-initializer-using-slot


@@ -120,11 +117,11 @@
 
    This generic function does the common work for constructing instance and
    class initializers.  It can usefully be specialized according to both the
 
    This generic function does the common work for constructing instance and
    class initializers.  It can usefully be specialized according to both the

-   class and slot types.  The default method uses the `:lisp-class' property
-   (defaulting to INIT-CLASS) to choose a (CLOS) class to instantiate.  The
-   slot is then constructed by `make-instance' passing the arguments as
-   initargs; further behaviour is left to the standard CLOS instance
-   construction protocol; for example, `sod-initializer' defines an
+   class and slot types.  The default method uses the `:initializer-class'
+   property (defaulting to INIT-CLASS) to choose a (CLOS) class to
+   instantiate.  The slot is then constructed by `make-instance' passing the
+   arguments as initargs; further behaviour is left to the standard CLOS
+   instance construction protocol; for example, `sod-initializer' defines an

    `:after'-method on `shared-initialize'.
 
    Diagnosing unused properties is left for the caller (usually
    `:after'-method on `shared-initialize'.
 
    Diagnosing unused properties is left for the caller (usually


@@ -145,14 +142,13 @@
 
    This is the main constructor function for messages.  This is a generic
    function primarily so that the CLASS can intervene in the construction
 
    This is the main constructor function for messages.  This is a generic
    function primarily so that the CLASS can intervene in the construction

-   process.  The default method uses the `:lisp-class' property (defaulting
-   to `sod-message') to choose a (CLOS) class to instantiate.  The message is
-   then constructed by `make-instance' passing the arguments as initargs;
-   further behaviour is left to the standard CLOS instance construction
-   protocol; for example, `sod-message' defines an `:after'-method on
-   `shared-initialize'.
-
-   Unused properties on PSET are diagnosed as errors."))
+   process.  The default method uses the `:message-class' property to choose
+   a (CLOS) class to instantiate; if no such property is provided but a
+   `combination' property is present, then `aggregating-message' is chosen;
+   otherwise `standard-message' is used.  The message is then constructed by
+   `make-instance' passing the arguments as initargs; further behaviour is
+   left to the standard CLOS instance construction protocol; for example,
+   `sod-message' defines an `:after'-method on `shared-initialize'."))

 
 (export 'make-sod-method)
 (defgeneric make-sod-method
 
 (export 'make-sod-method)
 (defgeneric make-sod-method


@@ -168,9 +164,7 @@
    invokes `make-sod-method-using-message' to make the method object, and
    then adds the method to the class's list of methods.  This split allows
    the message class to intervene in the class selection process, for
    invokes `make-sod-method-using-message' to make the method object, and
    then adds the method to the class's list of methods.  This split allows
    the message class to intervene in the class selection process, for

-   example.
-
-   Unused properties on PSET are diagnosed as errors."))
+   example."))

 
 (export 'make-sod-method-using-message)
 (defgeneric make-sod-method-using-message
 
 (export 'make-sod-method-using-message)
 (defgeneric make-sod-method-using-message


@@ -180,7 +174,7 @@
 
    This is a generic function so that it can be specialized according to both
    a class and -- more particularly -- a message.  The default method uses
 
    This is a generic function so that it can be specialized according to both
    a class and -- more particularly -- a message.  The default method uses

-   the `:lisp-class' property (defaulting to the result of calling
+   the `:method-class' property (defaulting to the result of calling

    `sod-message-method-class') to choose a (CLOS) class to instantiate.  The
    method is then constructed by `make-instance' passing the arguments as
    initargs; further behaviour is left to the standard CLOS instance
    `sod-message-method-class') to choose a (CLOS) class to instantiate.  The
    method is then constructed by `make-instance' passing the arguments as
    initargs; further behaviour is left to the standard CLOS instance


@@ -200,9 +194,9 @@
    "Return the preferred class for methods on MESSAGE.
 
    The message can inspect the PSET to decide on a particular message.  A
    "Return the preferred class for methods on MESSAGE.
 
    The message can inspect the PSET to decide on a particular message.  A

-   `:lisp-class' property will usually override this decision: it's then the
-   programmer's responsibility to ensure that the selected method class is
-   appropriate."))
+   `:method-class' property will usually override this decision: it's then
+   the programmer's responsibility to ensure that the selected method class
+   is appropriate."))

 
 (export 'check-message-type)
 (defgeneric check-message-type (message type)
 
 (export 'check-message-type)
 (defgeneric check-message-type (message type)