lib/sod-hosted.c (sod_makev): Use two statements rather than tricky expression.

[sod] / src / classes.lisp

;;; -*-lisp-*-
;;;
;;; Class definitions for main classes
;;;
;;; (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)

;;; Note!  You'll notice that none of the classes defined here store property
;;; sets persistently, even though there's a `:pset' keyword argument
;;; accepted by many of the classes' initialization methods.  That's because
;;; part of the pset protocol involves checking that there are no unused
;;; properties, and this typically happens shortly after the appropriate
;;; objects are constructed.  It would be tempting to stash the pset at
;;; initialization time, and then pick some property from it out later -- but
;;; that won't work in general because an error might have been signalled
;;; about that property.  It wouldn't surprise me greatly to discover that
;;; `most' code paths resulted in the property being looked up in time to
;;; avoid the unused-property error, but a subtle change in circumstances
;;; then causes a thing done on demand to be done later, leading to
;;; irritating and misleading errors being reported to the user.  So please
;;; don't do that.

;;;--------------------------------------------------------------------------
;;; Classes.

(export '(sod-class sod-class-name sod-class-nickname
          sod-class-type sod-class-metaclass
          sod-class-direct-superclasses sod-class-precedence-list
          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-effective-methods sod-class-vtables))
(defclass sod-class ()
  ((name :initarg :name :type string :reader sod-class-name)
   (location :initarg :location :initform (file-location nil)
             :type file-location :reader file-location)
   (nickname :initarg :nick :type string :reader sod-class-nickname)
   (direct-superclasses :initarg :superclasses :type list
                        :reader sod-class-direct-superclasses)
   (chain-link :initarg :link :type (or sod-class null)
               :reader sod-class-chain-link)
   (metaclass :initarg :metaclass :type sod-class
              :reader sod-class-metaclass)
   (slots :initarg :slots :initform nil
          :type list :accessor sod-class-slots)
   (instance-initializers :initarg :instance-initializers :initform nil
                          :type list
                          :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 :reader sod-class-precedence-list)

   (%type :type c-class-type :reader sod-class-type)

   (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 :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)
          :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' 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
       consecutive underscores.

     * 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
       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
       different classes, and (invisibly) in the derived names of direct
       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 `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
       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
       of superclasses in other chains.  Furthermore, an indirection is
       required to perform a cross-chain conversion (i.e., converting a
       pointer to an instance of some class into a pointer to an instance of
       one of its superclasses in a different chain), an operation which
       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
       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
       provide (C constant expression) initial values for the metaclass
       instance.

   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
       `sod-slot').  (The class will also define all of the slots defined by
       its superclasses.)

     * 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
       (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
       (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
       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
       `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 `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 (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
       detais.

     * 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."))

(defmethod print-object ((class sod-class) stream)
  (maybe-print-unreadable-object (class stream :type t)
    (princ (sod-class-name class) stream)))

;;;--------------------------------------------------------------------------
;;; Slots and initializers.

(export '(sod-slot sod-slot-name sod-slot-class sod-slot-type))
(defclass sod-slot ()
  ((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))
  (:documentation
   "Slots are units of information storage in instances.

   Each class defines a number of slots, which function similarly to (data)
   members in structures.  An instance contains all of the slots defined in
   its class and all of its superclasses.

   A slot carries the following information.

     * 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
       defined.  This gets used in error messages.

     * 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)."))

(defmethod print-object ((slot sod-slot) stream)
  (maybe-print-unreadable-object (slot stream :type t)
    (pprint-c-type (sod-slot-type slot) stream
                   (format nil "~A.~A"
                           (sod-class-nickname (sod-slot-class slot))
                           (sod-slot-name slot)))))

(export '(sod-initializer sod-initializer-slot sod-initializer-class
          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 :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 `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' C fragment.)

     * 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
       initializers (`sod-class-initializer'), this will be an instance of
       the `slot''s class, or an instance of one of its descendants.

     * 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)
  (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)
  ()
  (:documentation
   "Provides an initial value for a class slot.

   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 must have the syntax of an initializer, and its consituent
   expressions must be constant expressions.

   See `sod-initializer' for more details."))

(export 'sod-instance-initializer)
(defclass sod-instance-initializer (sod-initializer)
  ()
  (:documentation
   "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' 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-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)
   (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.

   SOD is a single-dispatch object system, like Smalltalk, C++, Python and so
   on, but unlike CLOS and Dylan.  Behaviour is invoked by `sending messages'
   to objects.  A message carries a name (distinguishing it from other
   messages recognized by the same class), and a number of arguments; the
   object may return a value in response.  Sending a message therefore looks
   very much like calling a function; indeed, each message bears the static
   TYPE signature of a function.

   An object reacts to being sent a message by executing an `effective
   method', constructed from the direct methods defined on the recpient's
   (run-time, not necessarily statically-declared) class and its superclasses
   according to the message's `method combination'.

   Much interesting work is done by subclasses of `sod-message', which (for
   example) specify method combinations.

   The slots are as follows.

     * 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.
       It gets used in error messages.

     * 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
       return type.

   Subclasses can (and probably will) define additional slots."))

(defmethod print-object ((message sod-message) stream)
  (maybe-print-unreadable-object (message stream :type t)
    (pprint-c-type (sod-message-type message) stream
                   (format nil "~A.~A"
                           (sod-class-nickname (sod-message-class message))
                           (sod-message-name message)))))

(export '(sod-method sod-method-message sod-method-class sod-method-type
          sod-method-body))
(defclass sod-method ()
  ((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)
   (body :initarg :body :type (or c-fragment null) :reader sod-method-body))
  (:documentation
   "(Direct) methods are units of behaviour.

   Methods are the unit of behaviour in SOD.  Classes define direct methods
   for particular messages.

   When a message is received by an instance, all of the methods defined for
   that message on that instance's (run-time, not static) class and its
   superclasses are `applicable'.  The applicable methods are gathered
   together and invoked in some way; the details of this are left to the
   `method combination', determined by the subclass of `sod-message'.

   The slots are as follows.

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

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

         -- The method type must include names for all of the method's
            parameters.  The message definition can omit the parameter
            names (in the same way as a function declaration can).  Formally,
            the message definition can contain abstract declarators, whereas
            method definitions must not.

         -- Method combinations may require different parameter or return
            types.  For example, `before' and `after' methods don't
            contribute to the message's return value, so they must be defined
            as returning `void'.

         -- Method combinations may permit methods whose parameter and/or
            return types don't exactly match the corresponding types of the
            message.  For example, one might have methods with covariant
            return types and contravariant parameter types.  (This sounds
            nice, but it doesn't actually seem like such a clever idea when
            you consider that the co-/contravariance must hold among all the
            applicable methods ordered according to the class precedence
            list.  As a result, a user might have to work hard to build
            subclasses whose CPLs match the restrictions implied by the
            method types.)

   Method objects are fairly passive in the SOD translator.  However,
   subclasses of `sod-message' may (and probably will) construct instances of
   subclasses of `sod-method' in order to carry the additional metadata they
   need to keep track of."))

(defmethod print-object ((method sod-method) stream)
  (maybe-print-unreadable-object (method stream :type t)
    (format stream "~A ~@_~A"
            (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 --------------------------------------------------