src/frontend.lisp: Add `--backtrace' option to expose error context.

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

diff --git a/src/class-make-proto.lisp b/src/class-make-proto.lisp
index 692da40..7305807 100644 (file)
--- a/src/class-make-proto.lisp
+++ b/src/class-make-proto.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;

-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; 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
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by


@@ -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
    `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.
+   `shared-initialize'.

 
    Minimal sanity checking is done during class construction; most of it is
 
    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)


@@ -220,74 +214,4 @@
    This is separated out of `shared-initialize', where it's called, so that
    it can be overridden conveniently by subclasses."))
 
    This is separated out of `shared-initialize', where it's called, so that
    it can be overridden conveniently by subclasses."))
 

-;;;--------------------------------------------------------------------------
-;;; Builder macros.
-
-(export 'define-sod-class)
-(defmacro define-sod-class (name (&rest superclasses) &body body)
-  "Construct a new SOD class called NAME in the current module.
-
-   The new class has the named direct SUPERCLASSES, which should be a list of
-   strings.
-
-   The BODY begins with a sequence of alternating keyword/value pairs
-   defining properties for the new class.  The keywords are (obviously) not
-   evaluated, but the value forms are.
-
-   The remainder of the BODY are a sequence of forms to be evaluated as an
-   implicit `progn'.  Additional macros are available to the BODY, to make
-   defining the class easier.
-
-   In the following, NAME is a string giving a C identifier; NICK is a string
-   giving the nickname of a superclass; TYPE is a C type using S-expression
-   notation.
-
-     * message NAME TYPE &rest PLIST
-
-     * method NICK NAME TYPE BODY &rest PLIST
-
-     * slot NAME TYPE &rest PLIST
-
-     * instance-initializer NICK NAME VALUE-KIND VALUE-FORM &rest PLIST
-
-     * class-initializer NICK NAME VALUE-KIND VALUE-FORM &rest PLIST"
-
-  (let ((plist nil)
-       (classvar (gensym "CLASS-")))
-    (loop
-      (when (or (null body)
-               (not (keywordp (car body))))
-       (return))
-      (push (pop body) plist)
-      (push (pop body) plist))
-    `(let ((,classvar (make-sod-class ,name
-                                     (mapcar #'find-sod-class
-                                             (list ,@superclasses))
-                                     (make-property-set
-                                      ,@(nreverse plist)))))
-       (macrolet ((message (name type &rest plist)
-                   `(make-sod-message ,',classvar ,name (c-type ,type)
-                                      (make-property-set ,@plist)))
-                 (method (nick name type body &rest plist)
-                   `(make-sod-method ,',classvar ,nick ,name (c-type ,type)
-                                     ,body (make-property-set ,@plist)))
-                 (slot (name type &rest plist)
-                   `(make-sod-slot ,',classvar ,name (c-type ,type)
-                                   (make-property-set ,@plist)))
-                 (instance-initializer
-                     (nick name value-kind value-form &rest plist)
-                   `(make-sod-instance-initializer ,',classvar ,nick ,name
-                                                   ,value-kind ,value-form
-                                                   (make-property-set
-                                                    ,@plist)))
-                 (class-initializer
-                     (nick name value-kind value-form &rest plist)
-                   `(make-sod-class-initializer ,',classvar ,nick ,name
-                                                ,value-kind ,value-form
-                                                (make-property-set
-                                                 ,@plist))))
-        ,@body
-        (finalize-sod-class ,classvar)
-        (add-to-module *module* ,classvar)))))
-

 ;;;----- That's all, folks --------------------------------------------------
 ;;;----- That's all, folks --------------------------------------------------