3 ;;; Class construction protocol
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensible Object Design, an object system for C.
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.
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.
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.
28 ;;;--------------------------------------------------------------------------
31 (export 'guess-metaclass)
32 (defgeneric guess-metaclass (class)
34 "Determine a suitable metaclass for the CLASS.
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."))
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.
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
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')."
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
60 :present (lambda (class)
64 (class (make-instance best-class
66 :superclasses superclasses
67 :location (file-location location)
71 ;;;--------------------------------------------------------------------------
72 ;;; Slots and slot initializers.
74 (export 'make-sod-slot)
75 (defgeneric make-sod-slot (class name type pset &key location)
77 "Construct, add, and attach a new slot with given NAME and TYPE, to CLASS.
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'."))
87 (export 'make-sod-instance-initializer)
88 (defgeneric make-sod-instance-initializer
89 (class nick name value pset &key location inhibit-initargs)
91 "Construct and attach an instance slot initializer, to CLASS.
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
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."))
106 (export 'make-sod-class-initializer)
107 (defgeneric make-sod-class-initializer
108 (class nick name value pset &key location)
110 "Construct and attach a class slot initializer, to CLASS.
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
119 (export 'make-sod-initializer-using-slot)
120 (defgeneric make-sod-initializer-using-slot
121 (class slot init-class value pset location)
123 "Common construction protocol for slot initializers.
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'.
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
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."))
142 (export 'make-sod-user-initarg)
143 (defgeneric make-sod-user-initarg
144 (class name type pset &key default location)
146 "Attach a user-defined initialization keyword argument to the CLASS.
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
152 (export 'make-sod-slot-initarg)
153 (defgeneric make-sod-slot-initarg
154 (class name nick slot-name pset &key location)
156 "Attach an initialization keyword argument to a slot by name.
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."))
161 (export 'make-sod-slot-initarg-using-slot)
162 (defgeneric make-sod-slot-initarg-using-slot
163 (class name slot pset &key location)
165 "Attach an initialization keyword argument to a SLOT.
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.
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."))
173 (export 'sod-initarg-argument)
174 (defgeneric sod-initarg-argument (initarg)
175 (:documentation "Returns an `argument' object for the initarg."))
177 (export 'make-sod-class-initfrag)
178 (defgeneric make-sod-class-initfrag (class frag pset &key location)
180 "Attach an initialization fragment FRAG to the CLASS.
182 Currently, initialization fragments are just dumb objects held in a
185 (export 'make-sod-class-tearfrag)
186 (defgeneric make-sod-class-tearfrag (class frag pset &key location)
188 "Attach a teardown fragment FRAG to the CLASS.
190 Currently, teardown fragments are just dumb objects held in a
193 ;;;--------------------------------------------------------------------------
194 ;;; Messages and methods.
196 (export 'make-sod-message)
197 (defgeneric make-sod-message (class name type pset &key location)
199 "Construct and attach a new message with given NAME and TYPE, to CLASS.
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'."))
211 (export 'make-sod-method)
212 (defgeneric make-sod-method
213 (class nick name type body pset &key location)
215 "Construct and attach a new method to CLASS.
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.
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
227 (export 'make-sod-method-using-message)
228 (defgeneric make-sod-method-using-message
229 (message class type body pset location)
231 "Main construction subroutine for method construction.
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'.
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.
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."))
249 (export 'sod-message-method-class)
250 (defgeneric sod-message-method-class (message class pset)
252 "Return the preferred class for methods on MESSAGE.
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
259 (export 'check-message-type)
260 (defgeneric check-message-type (message type)
262 "Check that TYPE is a suitable type for MESSAGE. Signal errors if not.
264 This is separated out of `shared-initialize', where it's called, so that
265 it can be overridden conveniently by subclasses."))
267 (export 'check-method-type)
268 (defgeneric check-method-type (method message type)
270 "Check that TYPE is a suitable type for METHOD. Signal errors if not.
272 This is separated out of `shared-initialize', where it's called, so that
273 it can be overridden conveniently by subclasses."))
275 ;;;----- That's all, folks --------------------------------------------------