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 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 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 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 (export 'make-sod-user-initarg)
 128 (defgeneric make-sod-user-initarg
 129     (class name type pset &optional default location)
 130   (:documentation
 131    "Attach a user-defined initialization keyword argument to the CLASS.
 132
 133    The new argument has the given NAME and TYPE, and maybe a DEFAULT value.
 134    Currently, initialization arguments are just dumb objects held in a
 135    list."))
 136
 137 (export 'make-sod-slot-initarg)
 138 (defgeneric make-sod-slot-initarg
 139     (class name nick slot-name pset &optional location)
 140   (:documentation
 141    "Attach an initialization keyword argument to a slot by name.
 142
 143    The default method uses `find-instance-slot-by-name' to find the slot, and
 144    `make-slot-initarg-using-slot' to actually make and attach the initarg."))
 145
 146 (export 'make-sod-slot-initarg-using-slot)
 147 (defgeneric make-sod-slot-initarg-using-slot
 148     (class name slot pset &optional location)
 149   (:documentation
 150    "Attach an initialization keyword argument to a SLOT.
 151
 152    The argument's type is taken from the slot type.  Slot initargs can't have
 153    defaults: the slot's most-specific initializer is used instead.
 154
 155    You are not expected to call this generic function directly; it's more
 156    useful as a place to hang methods for custom classes."))
 157
 158 (export 'sod-initarg-argument)
 159 (defgeneric sod-initarg-argument (initarg)
 160   (:documentation "Returns an `argument' object for the initarg."))
 161
 162 (export 'make-sod-class-initfrag)
 163 (defgeneric make-sod-class-initfrag (class frag pset &optional location)
 164   (:documentation
 165    "Attach an initialization fragment FRAG to the CLASS.
 166
 167    Currently, initialization fragments are just dumb objects held in a
 168    list."))
 169
 170 (export 'make-sod-class-tearfrag)
 171 (defgeneric make-sod-class-tearfrag (class frag pset &optional location)
 172   (:documentation
 173    "Attach a teardown fragment FRAG to the CLASS.
 174
 175    Currently, teardown fragments are just dumb objects held in a
 176    list."))
 177
 178 ;;;--------------------------------------------------------------------------
 179 ;;; Messages and methods.
 180
 181 (export 'make-sod-message)
 182 (defgeneric make-sod-message (class name type pset &optional location)
 183   (:documentation
 184    "Construct and attach a new message with given NAME and TYPE, to CLASS.
 185
 186    This is the main constructor function for messages.  This is a generic
 187    function primarily so that the CLASS can intervene in the construction
 188    process.  The default method uses the `:message-class' property to choose
 189    a (CLOS) class to instantiate; if no such property is provided but a
 190    `combination' property is present, then `aggregating-message' is chosen;
 191    otherwise `standard-message' is used.  The message is then constructed by
 192    `make-instance' passing the arguments as initargs; further behaviour is
 193    left to the standard CLOS instance construction protocol; for example,
 194    `sod-message' defines an `:after'-method on `shared-initialize'."))
 195
 196 (export 'make-sod-method)
 197 (defgeneric make-sod-method
 198     (class nick name type body pset &optional location)
 199   (:documentation
 200    "Construct and attach a new method to CLASS.
 201
 202    This is the main constructor function for methods.  This is a generic
 203    function primarily so that the CLASS can intervene in the message lookup
 204    process, though this is actually a fairly unlikely occurrence.
 205
 206    The default method looks up the message using `find-message-by-name',
 207    invokes `make-sod-method-using-message' to make the method object, and
 208    then adds the method to the class's list of methods.  This split allows
 209    the message class to intervene in the class selection process, for
 210    example."))
 211
 212 (export 'make-sod-method-using-message)
 213 (defgeneric make-sod-method-using-message
 214     (message class type body pset location)
 215   (:documentation
 216    "Main construction subroutine for method construction.
 217
 218    This is a generic function so that it can be specialized according to both
 219    a class and -- more particularly -- a message.  The default method uses
 220    the `:method-class' property (defaulting to the result of calling
 221    `sod-message-method-class') to choose a (CLOS) class to instantiate.  The
 222    method is then constructed by `make-instance' passing the arguments as
 223    initargs; further behaviour is left to the standard CLOS instance
 224    construction protocol; for example, `sod-method' defines an
 225    `:after'-method on `shared-initialize'.
 226
 227    Diagnosing unused properties is left for the caller (usually
 228    `make-sod-method') to do.  The caller is also expected to have set
 229    `with-default-error-location' if appropriate.
 230
 231    You are not expected to call this generic function directly; it's more
 232    useful as a place to hang methods for custom method classes."))
 233
 234 (export 'sod-message-method-class)
 235 (defgeneric sod-message-method-class (message class pset)
 236   (:documentation
 237    "Return the preferred class for methods on MESSAGE.
 238
 239    The message can inspect the PSET to decide on a particular message.  A
 240    `:method-class' property will usually override this decision: it's then
 241    the programmer's responsibility to ensure that the selected method class
 242    is appropriate."))
 243
 244 (export 'check-message-type)
 245 (defgeneric check-message-type (message type)
 246   (:documentation
 247    "Check that TYPE is a suitable type for MESSAGE.  Signal errors if not.
 248
 249    This is separated out of `shared-initialize', where it's called, so that
 250    it can be overridden conveniently by subclasses."))
 251
 252 (export 'check-method-type)
 253 (defgeneric check-method-type (method message type)
 254   (:documentation
 255    "Check that TYPE is a suitable type for METHOD.  Signal errors if not.
 256
 257    This is separated out of `shared-initialize', where it's called, so that
 258    it can be overridden conveniently by subclasses."))
 259
 260 ;;;----- That's all, folks --------------------------------------------------