Static instance support.
[sod] / src / classes.lisp
index 603ea98..b21f3c0 100644 (file)
@@ -7,7 +7,7 @@
 
 ;;;----- 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-class-chain-link sod-class-chain-head
          sod-class-chain sod-class-chains
          sod-class-slots
+         sod-class-initargs sod-class-initfrags sod-class-tearfrags
          sod-class-instance-initializers sod-class-class-initializers
          sod-class-messages sod-class-methods
          sod-class-state
-         sod-class-ilayout sod-class-vtables))
+         sod-class-ilayout sod-class-effective-methods sod-class-vtables))
 (defclass sod-class ()
   ((name :initarg :name :type string :reader sod-class-name)
    (location :initarg :location :initform (file-location nil)
                          :accessor sod-class-instance-initializers)
    (class-initializers :initarg :class-initializers :initform nil
                       :type list :accessor sod-class-class-initializers)
+   (initargs :initarg :initargs :initform nil
+            :type list :accessor sod-class-initargs)
+   (initfrags :initarg :initfrags :initform nil
+             :type list :accessor sod-class-initfrags)
+   (tearfrags :initarg :tearfrags :initform nil
+             :type list :accessor sod-class-tearfrags)
    (messages :initarg :messages :initform nil
             :type list :accessor sod-class-messages)
    (methods :initarg :methods :initform nil
            :type list :accessor sod-class-methods)
 
-   (class-precedence-list :type list :accessor sod-class-precedence-list)
+   (class-precedence-list :type list :reader sod-class-precedence-list)
 
-   (type :type c-class-type :accessor sod-class-type)
+   (%type :type c-class-type :reader sod-class-type)
 
-   (chain-head :type sod-class :accessor sod-class-chain-head)
-   (chain :type list :accessor sod-class-chain)
-   (chains :type list :accessor sod-class-chains)
+   (chain-head :type sod-class :reader sod-class-chain-head)
+   (chain :type list :reader sod-class-chain)
+   (chains :type list :reader sod-class-chains)
 
-   (ilayout :type ilayout :accessor sod-class-ilayout)
-   (effective-methods :type list :accessor sod-class-effective-methods)
-   (vtables :type list :accessor sod-class-vtables)
+   (%ilayout :type ilayout :reader sod-class-ilayout)
+   (effective-methods :type list :reader sod-class-effective-methods)
+   (vtables :type list :reader sod-class-vtables)
 
-   (state :initform nil :type (member nil :finalized broken)
-         :accessor sod-class-state))
+   (state :initform nil :type (member nil :finalized :broken)
+         :reader sod-class-state))
   (:documentation
    "Classes describe the layout and behaviour of objects.
 
-   The NAME, LOCATION, NICKNAME, DIRECT-SUPERCLASSES, CHAIN-LINK and
-   METACLASS slots are intended to be initialized when the class object is
-   constructed:
+   The `name', `location', `nickname', `direct-superclasses', `chain-link'
+   and `metaclass' slots are intended to be initialized when the class object
+   is constructed:
 
-     * The NAME is the identifier associated with the class in the user's
+     * The `name' is the identifier associated with the class in the user's
        source file.  It is used verbatim in the generated C code as a type
        name, and must be distinct from other file-scope names in any source
        file which includes the class definition.  Furthermore, other names
        are derived from the class name (most notably the class object
        NAME__class), which have external linkage and must therefore be
        distinct from all other identifiers in the program.  It is forbidden
-       for a class NAME to begin with an underscore or to contain two
+       for a class `name' to begin with an underscore or to contain two
        consecutive underscores.
 
-     * The LOCATION identifies where in the source the class was defined.  It
-       gets used in error messages.
+     * The `location' identifies where in the source the class was defined.
+       It gets used in error messages.
 
-     * The NICKNAME is a shorter identifier used to name the class in some
-       circumstances.  The uniqueness requirements on NICKNAME are less
+     * The `nickname' is a shorter identifier used to name the class in some
+       circumstances.  The uniqueness requirements on `nickname' are less
        strict, which allows them to be shorter: no class may have two classes
        with the same nickname on its class precedence list.  Nicknames are
        used (user-visibly) to distinguish slots and messages defined by
        methods.  It is forbidden for a nickname to begin with an underscore,
        or to contain two consecutive underscores.
 
-     * The DIRECT-SUPERCLASSES are a list of the class's direct superclasses,
-       in the order that they were declared in the source.  The class
-       precedence list is computed from the DIRECT-SUPERCLASSES lists of all
-       of the superclasses involved.
+     * The `direct-superclasses' are a list of the class's direct
+       superclasses, in the order that they were declared in the source.  The
+       class precedence list is computed from the `direct-superclasses' lists
+       of all of the superclasses involved.
 
-     * The CHAIN-LINK is either NIL or one of the DIRECT-SUPERCLASSES.  Class
-       chains are a means for recovering most of the benefits of simple
+     * The `chain-link' is either `nil' or one of the `direct-superclasses'.
+       Class chains are a means for recovering most of the benefits of simple
        hierarchy lost by the introduction of multiple inheritance.  A class's
        superclasses (including itself) are partitioned into chains,
-       consisting of a class, its CHAIN-LINK superclass, that class's
-       CHAIN-LINK, and so on.  It is an error if two direct subclasses of any
-       class appear in the same chain (a global property which requires
+       consisting of a class, its `chain-link' superclass, that class's
+       `chain-link', and so on.  It is an error if two direct subclasses of
+       any class appear in the same chain (a global property which requires
        global knowledge of an entire program's class hierarchy in order to
        determine sensibly).  Slots of superclasses in the same chain can be
        accessed efficiently; there is an indirection needed to access slots
        occurs implicitly in effective methods in order to call direct methods
        defined on cross-chain superclasses.
 
-     * The METACLASS is the class of the class object.  Classes are objects
+     * The `metaclass' is the class of the class object.  Classes are objects
        in their own right, and therefore must be instances of some class;
        this class is the metaclass.  Metaclasses can define additional slots
        and methods to be provided by their instances; a class definition can
    The next few slots can't usually be set at object-construction time, since
    the objects need to contain references to the class object itself.
 
-     * The SLOTS are a list of the slots defined by the class (instances of
+     * The `slots' are a list of the slots defined by the class (instances of
        `sod-slot').  (The class will also define all of the slots defined by
        its superclasses.)
 
-     * The INSTANCE-INITIALIZERS and CLASS-INITIALIZERS are lists of
+     * The `instance-initializers' and `class-initializers' are lists of
        initializers for slots (see `sod-initializer' and subclasses),
        providing initial values for instances of the class, and for the
        class's class object itself, respectively.
 
-     * The MESSAGES are a list of the messages recognized by the class
+     * The `messages' are a list of the messages recognized by the class
        (instances of `sod-message' and subclasses).  (Note that the message
        need not have any methods defined on it.  The class will also
        recognize all of the messages defined by its superclasses.)
 
-     * The METHODS are a list of (direct) methods defined on the class
+     * The `methods' are a list of (direct) methods defined on the class
        (instances of `sod-method' and subclasses).  Each method provides
        behaviour to be invoked by a particular message recognized by the
        class.
    Other slots are computed from these in order to describe the class's
    layout and effective methods; this is done by `finalize-sod-class'.
 
-     * The CLASS-PRECEDENCE-LIST is a list of superclasses in a linear order.
-       It is computed by `compute-class-precedence-list', whose default
-       implementation ensures that the order of superclasses is such that (a)
-       subclasses appear before their superclasses; (b) the direct
+     * The `class-precedence-list' is a list of superclasses in a linear
+       order.  It is computed by `compute-class-precedence-list', whose
+       default implementation ensures that the order of superclasses is such
+       that (a) subclasses appear before their superclasses; (b) the direct
        superclasses of a given class appear in the order in which they were
        declared by the programmer; and (c) classes always appear in the same
        relative order in all class precedence lists in the same superclass
        graph.
 
-     * The CHAIN-HEAD is the least-specific class in the class's chain.  If
-       there is no link class then the CHAIN-HEAD is the class itself.  This
-       slot, like the next two, is computed by the generic function
+     * The `chain-head' is the least-specific class in the class's chain.  If
+       there is no link class then the `chain-head' is the class itself.
+       This slot, like the next two, is computed by the generic function
        `compute-chains'.
 
-     * The CHAIN is the list of classes on the complete primary chain,
-       starting from this class and ending with the CHAIN-HEAD.
+     * The `chain' is the list of classes on the complete primary chain,
+       starting from this class and ending with the `chain-head'.
 
-     * The CHAINS are the complete collection of chains (most-to-least
+     * The `chains' are the complete collection of chains (most-to-least
        specific) for the class and all of its superclasses.
 
    Finally, slots concerning the instance and vtable layout of the class are
-   computed on demand via methods on `slot-unbound'.
+   computed on demand (see `define-on-demand-slot').
 
-     * The ILAYOUT describes the layout for an instance of the class.  It's
-       quite complicated; see the documentation of the ILAYOUT class for
+     * The `ilayout' describes the layout for an instance of the class.  It's
+       quite complicated; see the documentation of the `ilayout' class for
        detais.
 
-     * The EFFECTIVE-METHODS are a list of effective methods, specialized for
-       the class.
+     * The `effective-methods' are a list of effective methods, specialized
+       for the class.
 
-     * The VTABLES are a list of descriptions of vtables for the class.  The
-       individual elements are VTABLE objects, which are even more
-       complicated than ILAYOUT structures.  See the class documentation for
-       details."))
+     * The `vtables' are a list of descriptions of vtables for the class.
+       The individual elements are `vtable' objects, which are even more
+       complicated than `ilayout' structures.  See the class documentation
+       for details."))
 
 (defmethod print-object ((class sod-class) stream)
   (maybe-print-unreadable-object (class stream :type t)
   ((name :initarg :name :type string :reader sod-slot-name)
    (location :initarg :location :initform (file-location nil)
             :type file-location :reader file-location)
-   (class :initarg :class :type sod-class :reader sod-slot-class)
-   (type :initarg :type :type c-type :reader sod-slot-type))
+   (%class :initarg :class :type sod-class :reader sod-slot-class)
+   (%type :initarg :type :type c-type :reader sod-slot-type))
   (:documentation
    "Slots are units of information storage in instances.
 
 
    A slot carries the following information.
 
-     * A NAME, which distinguishes it from other slots defined by the same
+     * A `name', which distinguishes it from other slots defined by the same
        class.  Unlike most (all?) other object systems, slots defined in
        different classes are in distinct namespaces.  There are no special
        restrictions on slot names.
 
-     * A LOCATION, which states where in the user's source the slot was
+     * A `location', which states where in the user's source the slot was
        defined.  This gets used in error messages.
 
-     * A CLASS, which states which class defined the slot.  The slot is
+     * A `class', which states which class defined the slot.  The slot is
        available in instances of this class and all of its descendents.
 
-     * A TYPE, which is the C type of the slot.  This must be an object type
-       (certainly not a function type, and it must be a complete type by the
-       time that the user header code has been scanned)."))
+     * A `type', which is the C type of the slot.  This must be an object
+       type (certainly not a function type, and it must be a complete type by
+       the time that the user header code has been scanned)."))
 
 (defmethod print-object ((slot sod-slot) stream)
   (maybe-print-unreadable-object (slot stream :type t)
                           (sod-slot-name slot)))))
 
 (export '(sod-initializer sod-initializer-slot sod-initializer-class
-         sod-initializer-value-kind sod-initializer-value-form))
+         sod-initializer-value))
 (defclass sod-initializer ()
   ((slot :initarg :slot :type sod-slot :reader sod-initializer-slot)
    (location :initarg :location :initform (file-location nil)
             :type file-location :reader file-location)
-   (class :initarg :class :type sod-class :reader sod-initializer-class)
-   (value-kind :initarg :value-kind :type keyword
-              :reader sod-initializer-value-kind)
-   (value-form :initarg :value-form :type c-fragment
-              :reader sod-initializer-value-form))
+   (%class :initarg :class :type sod-class :reader sod-initializer-class)
+   (value :initarg :value :type c-fragment :reader sod-initializer-value))
   (:documentation
    "Provides an initial value for a slot.
 
    The slots of an initializer are as follows.
 
-     * The SLOT specifies which slot this initializer is meant to initialize.
+     * The `slot' specifies which slot this initializer is meant to
+       initialize.
 
-     * The LOCATION states the position in the user's source file where the
+     * The `location' states the position in the user's source file where the
        initializer was found.  This gets used in error messages.  (Depending
        on the source layout style, this might differ from the location in the
-       VALUE-FORM C fragment.)
+       `value' C fragment.)
 
-     * The CLASS states which class defined this initializer.  For instance
+     * The `class' states which class defined this initializer.  For instance
        slot initializers (`sod-instance-initializer'), this will be the same
-       as the SLOT's class, or be one of its descendants.  For class slot
+       as the `slot''s class, or be one of its descendants.  For class slot
        initializers (`sod-class-initializer'), this will be an instance of
-       the SLOT's class, or an instance of one of its descendants.
-
-     * The VALUE-KIND states what manner of initializer we have.  It can be
-       either `:single', indicating a standalone expression, or `:compound',
-       indicating a compound initializer which must be surrounded by braces
-       on output.
+       the `slot''s class, or an instance of one of its descendants.
 
-     * The VALUE-FORM gives the text of the initializer, as a C fragment.
+     * The `value' gives the text of the initializer, as a C fragment.
 
    Typically you'll see instances of subclasses of this class in the wild
    rather than instances of this class directly.  See `sod-class-initializer'
    and `sod-instance-initializer'."))
 
 (defmethod print-object ((initializer sod-initializer) stream)
-  (if *print-escape*
-      (print-unreadable-object (initializer stream :type t)
-       (format stream "~A = ~A"
-               (sod-initializer-slot initializer)
-               initializer))
-      (format stream "~:[{~A}~;~A~]"
-             (eq (sod-initializer-value-kind initializer) :single)
-             (sod-initializer-value-form initializer))))
+  (with-slots (slot value) initializer
+    (if *print-escape*
+       (print-unreadable-object (initializer stream :type t)
+         (format stream "~A = ~A" slot value))
+       (format stream "~A" value))))
 
 (export 'sod-class-initializer)
 (defclass sod-class-initializer (sod-initializer)
 
    A class slot initializer provides an initial value for a slot in the class
    object (i.e., one of the slots defined by the class's metaclass).  Its
-   VALUE-FORM must have the syntax of an initializer, and its consituent
+   VALUE must have the syntax of an initializer, and its consituent
    expressions must be constant expressions.
 
    See `sod-initializer' for more details."))
    "Provides an initial value for a slot in all instances.
 
    An instance slot initializer provides an initial value for a slot in
-   instances of the class.  Its VALUE-FORM must have the syntax of an
+   instances of the class.  Its `value' must have the syntax of an
    initializer.  Furthermore, if the slot has aggregate type, then you'd
    better be sure that your compiler supports compound literals (6.5.2.5)
    because that's what the initializer gets turned into.
 
    See `sod-initializer' for more details."))
 
+(export '(sod-initarg
+         sod-initarg-class sod-initarg-name sod-initarg-type))
+(defclass sod-initarg ()
+  ((%class :initarg :class :type sod-class :reader sod-initarg-class)
+   (location :initarg :location :initform (file-location nil)
+            :type file-location :reader file-location)
+   (name :initarg :name :type string :reader sod-initarg-name)
+   (%type :initarg :type :type c-type :reader sod-initarg-type))
+  (:documentation
+   "Describes a keyword argument accepted by the initialization function."))
+
+(export '(sod-user-initarg sod-initarg-default))
+(defclass sod-user-initarg (sod-initarg)
+  ((default :initarg :default :type t :reader sod-initarg-default))
+  (:documentation
+   "Describes an initialization argument defined by the user."))
+
+(defmethod print-object ((initarg sod-user-initarg) stream)
+  (maybe-print-unreadable-object (initarg stream :type t)
+    (pprint-c-type (sod-initarg-type initarg) stream
+                  (sod-initarg-name initarg))
+    (awhen (sod-initarg-default initarg)
+      (format stream " = ~A" it))))
+
+(export '(sod-slot-initarg sod-initarg-slot))
+(defclass sod-slot-initarg (sod-initarg)
+  ((slot :initarg :slot :type sod-slot :reader sod-initarg-slot))
+  (:documentation
+   "Describes an initialization argument used to initialize a slot."))
+
+(defmethod print-object ((initarg sod-slot-initarg) stream)
+  (maybe-print-unreadable-object (initarg stream :type t)
+    (pprint-c-type (sod-initarg-type initarg) stream
+                  (sod-initarg-name initarg))
+    (format stream " for ~A" (sod-initarg-slot initarg))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Messages and methods.
 
-(export '(sod-message sod-message-name sod-message-class sod-message-type))
+(export '(sod-message sod-message-name sod-message-readonly-p
+         sod-message-class sod-message-type))
 (defclass sod-message ()
   ((name :initarg :name :type string :reader sod-message-name)
    (location :initarg :location :initform (file-location nil)
             :type file-location :reader file-location)
-   (class :initarg :class :type sod-class :reader sod-message-class)
-   (type :initarg :type :type c-function-type :reader sod-message-type))
+   (readonlyp :initarg :readonly :initform nil :type t
+             :reader sod-message-readonly-p)
+   (%class :initarg :class :type sod-class :reader sod-message-class)
+   (%type :initarg :type :type c-function-type :reader sod-message-type))
   (:documentation
    "Messages are the means for stimulating an object to behave.
 
 
    The slots are as follows.
 
-     * The NAME distinguishes the message from others defined by the same
+     * The `name' distinguishes the message from others defined by the same
        class.  Unlike most (all?) other object systems, messages defined in
        different classes are in distinct namespaces.  It is forbidden for a
        message name to begin with an underscore, or to contain two
        consecutive underscores.  (Final underscores are fine.)
 
-     * The LOCATION states where in the user's source the slot was defined.
+     * The `location' states where in the user's source the slot was defined.
        It gets used in error messages.
 
-     * The CLASS states which class defined the message.
+     * The `readonly' flag indicates whether the message receiver can modify
+       itself in response to this message.  If set, the receiver will be
+       declared `const'.
+
+     * The `class' states which class defined the message.
 
-     * The TYPE is a function type describing the message's arguments and
+     * The `type' is a function type describing the message's arguments and
        return type.
 
    Subclasses can (and probably will) define additional slots."))
   ((message :initarg :message :type sod-message :reader sod-method-message)
    (location :initarg :location :initform (file-location nil)
             :type file-location :reader file-location)
-   (class :initarg :class :type sod-class :reader sod-method-class)
-   (type :initarg :type :type c-function-type :reader sod-method-type)
+   (%class :initarg :class :type sod-class :reader sod-method-class)
+   (%type :initarg :type :type c-function-type :reader sod-method-type)
    (body :initarg :body :type (or c-fragment null) :reader sod-method-body))
   (:documentation
    "(Direct) methods are units of behaviour.
 
    The slots are as follows.
 
-     * The MESSAGE describes which meessage invokes the method's behaviour.
+     * The `message' describes which meessage invokes the method's behaviour.
        The method is combined with other methods on the same message
        according to the message's method combination, to form an `effective
        method'.
 
-     * The LOCATION states where, in the user's source, the method was
+     * The `location' states where, in the user's source, the method was
        defined.  This gets used in error messages.  (Depending on the user's
-       coding style, this location might be subtly different from the BODY's
-       location.)
+       coding style, this location might be subtly different from the
+       `body''s location.)
 
-     * The CLASS specifies which class defined the method.  This will be
+     * The `class' specifies which class defined the method.  This will be
        either the class of the message, or one of its descendents.
 
-     * The TYPE gives the type of the method, including its arguments.  This
-       will, in general, differ from the type of the message for several
+     * The `type' gives the type of the method, including its arguments.
+       This will, in general, differ from the type of the message for several
        reasons.
 
         -- The method type must include names for all of the method's
            (sod-method-message method)
            (sod-method-class method))))
 
+;;;--------------------------------------------------------------------------
+;;; Instances.
+
+(export '(static-instance static-instance-name static-instance-extern-p
+         static-instance-const-p static-instance-class
+         static-instance-initializers))
+(defclass static-instance ()
+  ((name :initarg :name :type string :reader static-instance-name)
+   (location :initarg :location :initform (file-location nil)
+            :type file-location :reader file-location)
+   (externp :initarg :extern :initform nil :type t
+           :reader static-instance-extern-p)
+   (constp :initarg :const :initform t :type t
+          :reader static-instance-const-p)
+   (%class :initarg :class :type sod-class :reader static-instance-class)
+   (initializers :initarg :initializers :initform nil
+                :type list :accessor static-instance-initializers))
+  (:documentation
+   "A static instance is a class instance built at (C) compile time.
+
+   The slots are as follows.
+
+     * The `name' gives the C identifier naming the instance, as a string.
+
+     * The `externp' flag is non-nil if the instance is to be visible outside
+       of the translation unit.
+
+     * The `location' states where, in the user's source, the instance was
+       defined.  This gets used in error messages.
+
+     * The `class' specifies the class of the instance to construct.
+
+     * The `initializers' are a list of `sod-instance-initializer' objects
+       which override any existing slot initializers defined on the class."))
+
+(defmethod print-object ((instance static-instance) stream)
+  (with-slots (name (class %class) externp constp initializers) instance
+    (maybe-print-unreadable-object (instance stream :type t)
+      (format stream "~:[~;extern ~@_~]~:[~;const ~@_~]~A ~@_~A"
+             externp constp class name)
+      (when initializers
+       (princ ": " stream)
+       (pprint-indent :block 2 stream)
+       (let ((first t))
+         (dolist (init initializers)
+           (if first (setf first nil) (princ ", "))
+           (pprint-newline :linear stream)
+           (with-slots (slot (super %class) value) init
+             (format stream "~@<~A.~A = ~2I~@_~A~:>"
+                     (sod-class-nickname super)
+                     (sod-slot-name slot)
+                     value))))))))
+
 ;;;----- That's all, folks --------------------------------------------------