chiark - git - mdw - sod/blob - src/class-make-proto.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Class construction protocol
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensible Object Design, an object system for C.
  11 ;;;
  12 ;;; SOD is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; SOD is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with SOD; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 (cl:in-package #:sod)
  27
  28 ;;;--------------------------------------------------------------------------
  29 ;;; Classes.
  30
  31 (export 'make-sod-class)
  32 (defun make-sod-class (name superclasses pset &optional location)
  33   "Construct and return a new SOD class with the given NAME and SUPERCLASSES.
  34
  35    This is the main constructor function for classes.  The protocol works as
  36    follows.  The `:lisp-metaclass' property in PSET is checked: if it exists,
  37    it must be a symbol naming a (CLOS) class, which is used in place of
  38    `sod-class'.  All of the arguments are then passed to `make-instance';
  39    further behaviour is left to the standard CLOS instance construction
  40    protocol; for example, `sod-class' defines an `:after'-method on
  41    `shared-initialize'.
  42
  43    Minimal sanity checking is done during class construction; most of it is
  44    left for `finalize-sod-class' to do (via `check-sod-class')."
  45
  46   (with-default-error-location (location)
  47     (let* ((pset (property-set pset))
  48            (best-class (or (get-property pset :lisp-metaclass :symbol nil)
  49                            (if superclasses
  50                                (maximum (mapcar #'class-of superclasses)
  51                                         #'subtypep
  52                                         (format nil "Lisp metaclass for ~A"
  53                                                 name))
  54                                'sod-class)))
  55            (class (make-instance best-class
  56                                  :name name
  57                                  :superclasses superclasses
  58                                  :location (file-location location)
  59                                  :pset pset)))
  60       class)))
  61
  62 ;;;--------------------------------------------------------------------------
  63 ;;; Slots and slot initializers.
  64
  65 (export 'make-sod-slot)
  66 (defgeneric make-sod-slot (class name type pset &optional location)
  67   (:documentation
  68    "Construct, add, and attach a new slot with given NAME and TYPE, to CLASS.
  69
  70    This is the main constructor function for slots.  This is a generic
  71    function primarily so that the CLASS can intervene in the construction
  72    process.  The default method uses the `:slot-class' property (defaulting
  73    to `sod-slot') to choose a (CLOS) class to instantiate.  The slot is then
  74    constructed by `make-instance' passing the arguments as initargs; further
  75    behaviour is left to the standard CLOS instance construction protocol; for
  76    example, `sod-slot' defines an `:after'-method on `shared-initialize'."))
  77
  78 (export 'make-sod-instance-initializer)
  79 (defgeneric make-sod-instance-initializer
  80     (class nick name value-kind value-form pset &optional location)
  81   (:documentation
  82    "Construct and attach an instance slot initializer, to CLASS.
  83
  84    This is the main constructor function for instance initializers.  This is
  85    a generic function primarily so that the CLASS can intervene in the
  86    construction process.  The default method looks up the slot using
  87    `find-instance-slot-by-name', calls `make-sod-initializer-using-slot' to
  88    actually make the initializer object, and adds it to the appropriate list
  89    in CLASS."))
  90
  91 (export 'make-sod-class-initializer)
  92 (defgeneric make-sod-class-initializer
  93     (class nick name value-kind value-form pset &optional location)
  94   (:documentation
  95    "Construct and attach a class slot initializer, to CLASS.
  96
  97    This is the main constructor function for class initializers.  This is a
  98    generic function primarily so that the CLASS can intervene in the
  99    construction process.  The default method looks up the slot using
 100    `find-class-slot-by-name', calls `make-sod-initializer-using-slot' to
 101    actually make the initializer object, and adds it to the appropriate list
 102    in CLASS."))
 103
 104 (export 'make-sod-initializer-using-slot)
 105 (defgeneric make-sod-initializer-using-slot
 106     (class slot init-class value-kind value-form pset location)
 107   (:documentation
 108    "Common construction protocol for slot initializers.
 109
 110    This generic function does the common work for constructing instance and
 111    class initializers.  It can usefully be specialized according to both the
 112    class and slot types.  The default method uses the `:initializer-class'
 113    property (defaulting to INIT-CLASS) to choose a (CLOS) class to
 114    instantiate.  The slot is then constructed by `make-instance' passing the
 115    arguments as initargs; further behaviour is left to the standard CLOS
 116    instance construction protocol; for example, `sod-initializer' defines an
 117    `:after'-method on `shared-initialize'.
 118
 119    Diagnosing unused properties is left for the caller (usually
 120    `make-sod-instance-initializer' or `make-sod-class-initializer') to do.
 121    The caller is also expected to have set `with-default-error-location' if
 122    appropriate.
 123
 124    You are not expected to call this generic function directly; it's more
 125    useful as a place to hang methods for custom initializer classes."))
 126
 127 ;;;--------------------------------------------------------------------------
 128 ;;; Messages and methods.
 129
 130 (export 'make-sod-message)
 131 (defgeneric make-sod-message (class name type pset &optional location)
 132   (:documentation
 133    "Construct and attach a new message with given NAME and TYPE, to CLASS.
 134
 135    This is the main constructor function for messages.  This is a generic
 136    function primarily so that the CLASS can intervene in the construction
 137    process.  The default method uses the `:message-class' property to choose
 138    a (CLOS) class to instantiate; if no such property is provided but a
 139    `combination' property is present, then `aggregating-message' is chosen;
 140    otherwise `standard-message' is used.  The message is then constructed by
 141    `make-instance' passing the arguments as initargs; further behaviour is
 142    left to the standard CLOS instance construction protocol; for example,
 143    `sod-message' defines an `:after'-method on `shared-initialize'."))
 144
 145 (export 'make-sod-method)
 146 (defgeneric make-sod-method
 147     (class nick name type body pset &optional location)
 148   (:documentation
 149    "Construct and attach a new method to CLASS.
 150
 151    This is the main constructor function for methods.  This is a generic
 152    function primarily so that the CLASS can intervene in the message lookup
 153    process, though this is actually a fairly unlikely occurrence.
 154
 155    The default method looks up the message using `find-message-by-name',
 156    invokes `make-sod-method-using-message' to make the method object, and
 157    then adds the method to the class's list of methods.  This split allows
 158    the message class to intervene in the class selection process, for
 159    example."))
 160
 161 (export 'make-sod-method-using-message)
 162 (defgeneric make-sod-method-using-message
 163     (message class type body pset location)
 164   (:documentation
 165    "Main construction subroutine for method construction.
 166
 167    This is a generic function so that it can be specialized according to both
 168    a class and -- more particularly -- a message.  The default method uses
 169    the `:method-class' property (defaulting to the result of calling
 170    `sod-message-method-class') to choose a (CLOS) class to instantiate.  The
 171    method is then constructed by `make-instance' passing the arguments as
 172    initargs; further behaviour is left to the standard CLOS instance
 173    construction protocol; for example, `sod-method' defines an
 174    `:after'-method on `shared-initialize'.
 175
 176    Diagnosing unused properties is left for the caller (usually
 177    `make-sod-method') to do.  The caller is also expected to have set
 178    `with-default-error-location' if appropriate.
 179
 180    You are not expected to call this generic function directly; it's more
 181    useful as a place to hang methods for custom method classes."))
 182
 183 (export 'sod-message-method-class)
 184 (defgeneric sod-message-method-class (message class pset)
 185   (:documentation
 186    "Return the preferred class for methods on MESSAGE.
 187
 188    The message can inspect the PSET to decide on a particular message.  A
 189    `:method-class' property will usually override this decision: it's then
 190    the programmer's responsibility to ensure that the selected method class
 191    is appropriate."))
 192
 193 (export 'check-message-type)
 194 (defgeneric check-message-type (message type)
 195   (:documentation
 196    "Check that TYPE is a suitable type for MESSAGE.  Signal errors if not.
 197
 198    This is separated out of `shared-initialize', where it's called, so that
 199    it can be overridden conveniently by subclasses."))
 200
 201 (export 'check-method-type)
 202 (defgeneric check-method-type (method message type)
 203   (:documentation
 204    "Check that TYPE is a suitable type for METHOD.  Signal errors if not.
 205
 206    This is separated out of `shared-initialize', where it's called, so that
 207    it can be overridden conveniently by subclasses."))
 208
 209 ;;;----- That's all, folks --------------------------------------------------