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                            (select-minimal-class-property
  50                             superclasses #'class-of #'subtypep 'sod-class
  51                             "Lisp metaclass"
  52                             :present (lambda (class)
  53                                        (format nil "`~S'"
  54                                                (class-name class)))
  55                             :allow-empty t)))
  56            (class (make-instance best-class
  57                                  :name name
  58                                  :superclasses superclasses
  59                                  :location (file-location location)
  60                                  :pset pset)))
  61       class)))
  62
  63 ;;;--------------------------------------------------------------------------
  64 ;;; Slots and slot initializers.
  65
  66 (export 'make-sod-slot)
  67 (defgeneric make-sod-slot (class name type pset &optional location)
  68   (:documentation
  69    "Construct, add, and attach a new slot with given NAME and TYPE, to CLASS.
  70
  71    This is the main constructor function for slots.  This is a generic
  72    function primarily so that the CLASS can intervene in the construction
  73    process.  The default method uses the `:slot-class' property (defaulting
  74    to `sod-slot') to choose a (CLOS) class to instantiate.  The slot is then
  75    constructed by `make-instance' passing the arguments as initargs; further
  76    behaviour is left to the standard CLOS instance construction protocol; for
  77    example, `sod-slot' defines an `:after'-method on `shared-initialize'."))
  78
  79 (export 'make-sod-instance-initializer)
  80 (defgeneric make-sod-instance-initializer
  81     (class nick name value pset &optional location)
  82   (:documentation
  83    "Construct and attach an instance slot initializer, to CLASS.
  84
  85    This is the main constructor function for instance initializers.  This is
  86    a generic function primarily so that the CLASS can intervene in the
  87    construction process.  The default method looks up the slot using
  88    `find-instance-slot-by-name', calls `make-sod-initializer-using-slot' to
  89    actually make the initializer object, and adds it to the appropriate list
  90    in CLASS."))
  91
  92 (export 'make-sod-class-initializer)
  93 (defgeneric make-sod-class-initializer
  94     (class nick name value pset &optional location)
  95   (:documentation
  96    "Construct and attach a class slot initializer, to CLASS.
  97
  98    This is the main constructor function for class initializers.  This is a
  99    generic function primarily so that the CLASS can intervene in the
 100    construction process.  The default method looks up the slot using
 101    `find-class-slot-by-name', calls `make-sod-initializer-using-slot' to
 102    actually make the initializer object, and adds it to the appropriate list
 103    in CLASS."))
 104
 105 (export 'make-sod-initializer-using-slot)
 106 (defgeneric make-sod-initializer-using-slot
 107     (class slot init-class value pset location)
 108   (:documentation
 109    "Common construction protocol for slot initializers.
 110
 111    This generic function does the common work for constructing instance and
 112    class initializers.  It can usefully be specialized according to both the
 113    class and slot types.  The default method uses the `:initializer-class'
 114    property (defaulting to INIT-CLASS) to choose a (CLOS) class to
 115    instantiate.  The slot is then constructed by `make-instance' passing the
 116    arguments as initargs; further behaviour is left to the standard CLOS
 117    instance construction protocol; for example, `sod-initializer' defines an
 118    `:after'-method on `shared-initialize'.
 119
 120    Diagnosing unused properties is left for the caller (usually
 121    `make-sod-instance-initializer' or `make-sod-class-initializer') to do.
 122    The caller is also expected to have set `with-default-error-location' if
 123    appropriate.
 124
 125    You are not expected to call this generic function directly; it's more
 126    useful as a place to hang methods for custom initializer classes."))
 127
 128 (export 'make-sod-user-initarg)
 129 (defgeneric make-sod-user-initarg
 130     (class name type pset &optional default location)
 131   (:documentation
 132    "Attach a user-defined initialization keyword argument to the CLASS.
 133
 134    The new argument has the given NAME and TYPE, and maybe a DEFAULT value.
 135    Currently, initialization arguments are just dumb objects held in a
 136    list."))
 137
 138 (export 'make-sod-slot-initarg)
 139 (defgeneric make-sod-slot-initarg
 140     (class name nick slot-name pset &optional location)
 141   (:documentation
 142    "Attach an initialization keyword argument to a slot by name.
 143
 144    The default method uses `find-instance-slot-by-name' to find the slot, and
 145    `make-slot-initarg-using-slot' to actually make and attach the initarg."))
 146
 147 (export 'make-sod-slot-initarg-using-slot)
 148 (defgeneric make-sod-slot-initarg-using-slot
 149     (class name slot pset &optional location)
 150   (:documentation
 151    "Attach an initialization keyword argument to a SLOT.
 152
 153    The argument's type is taken from the slot type.  Slot initargs can't have
 154    defaults: the slot's most-specific initializer is used instead.
 155
 156    You are not expected to call this generic function directly; it's more
 157    useful as a place to hang methods for custom classes."))
 158
 159 (export 'sod-initarg-argument)
 160 (defgeneric sod-initarg-argument (initarg)
 161   (:documentation "Returns an `argument' object for the initarg."))
 162
 163 (export 'make-sod-class-initfrag)
 164 (defgeneric make-sod-class-initfrag (class frag pset &optional location)
 165   (:documentation
 166    "Attach an initialization fragment FRAG to the CLASS.
 167
 168    Currently, initialization fragments are just dumb objects held in a
 169    list."))
 170
 171 (export 'make-sod-class-tearfrag)
 172 (defgeneric make-sod-class-tearfrag (class frag pset &optional location)
 173   (:documentation
 174    "Attach a teardown fragment FRAG to the CLASS.
 175
 176    Currently, teardown fragments are just dumb objects held in a
 177    list."))
 178
 179 ;;;--------------------------------------------------------------------------
 180 ;;; Messages and methods.
 181
 182 (export 'make-sod-message)
 183 (defgeneric make-sod-message (class name type pset &optional location)
 184   (:documentation
 185    "Construct and attach a new message with given NAME and TYPE, to CLASS.
 186
 187    This is the main constructor function for messages.  This is a generic
 188    function primarily so that the CLASS can intervene in the construction
 189    process.  The default method uses the `:message-class' property to choose
 190    a (CLOS) class to instantiate; if no such property is provided but a
 191    `combination' property is present, then `aggregating-message' is chosen;
 192    otherwise `standard-message' is used.  The message is then constructed by
 193    `make-instance' passing the arguments as initargs; further behaviour is
 194    left to the standard CLOS instance construction protocol; for example,
 195    `sod-message' defines an `:after'-method on `shared-initialize'."))
 196
 197 (export 'make-sod-method)
 198 (defgeneric make-sod-method
 199     (class nick name type body pset &optional location)
 200   (:documentation
 201    "Construct and attach a new method to CLASS.
 202
 203    This is the main constructor function for methods.  This is a generic
 204    function primarily so that the CLASS can intervene in the message lookup
 205    process, though this is actually a fairly unlikely occurrence.
 206
 207    The default method looks up the message using `find-message-by-name',
 208    invokes `make-sod-method-using-message' to make the method object, and
 209    then adds the method to the class's list of methods.  This split allows
 210    the message class to intervene in the class selection process, for
 211    example."))
 212
 213 (export 'make-sod-method-using-message)
 214 (defgeneric make-sod-method-using-message
 215     (message class type body pset location)
 216   (:documentation
 217    "Main construction subroutine for method construction.
 218
 219    This is a generic function so that it can be specialized according to both
 220    a class and -- more particularly -- a message.  The default method uses
 221    the `:method-class' property (defaulting to the result of calling
 222    `sod-message-method-class') to choose a (CLOS) class to instantiate.  The
 223    method is then constructed by `make-instance' passing the arguments as
 224    initargs; further behaviour is left to the standard CLOS instance
 225    construction protocol; for example, `sod-method' defines an
 226    `:after'-method on `shared-initialize'.
 227
 228    Diagnosing unused properties is left for the caller (usually
 229    `make-sod-method') to do.  The caller is also expected to have set
 230    `with-default-error-location' if appropriate.
 231
 232    You are not expected to call this generic function directly; it's more
 233    useful as a place to hang methods for custom method classes."))
 234
 235 (export 'sod-message-method-class)
 236 (defgeneric sod-message-method-class (message class pset)
 237   (:documentation
 238    "Return the preferred class for methods on MESSAGE.
 239
 240    The message can inspect the PSET to decide on a particular message.  A
 241    `:method-class' property will usually override this decision: it's then
 242    the programmer's responsibility to ensure that the selected method class
 243    is appropriate."))
 244
 245 (export 'check-message-type)
 246 (defgeneric check-message-type (message type)
 247   (:documentation
 248    "Check that TYPE is a suitable type for MESSAGE.  Signal errors if not.
 249
 250    This is separated out of `shared-initialize', where it's called, so that
 251    it can be overridden conveniently by subclasses."))
 252
 253 (export 'check-method-type)
 254 (defgeneric check-method-type (method message type)
 255   (:documentation
 256    "Check that TYPE is a suitable type for METHOD.  Signal errors if not.
 257
 258    This is separated out of `shared-initialize', where it's called, so that
 259    it can be overridden conveniently by subclasses."))
 260
 261 ;;;----- That's all, folks --------------------------------------------------