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