Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Class construction protocol | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
e0808c47 | 10 | ;;; This file is part of the Sensible Object Design, an object system for C. |
dea4d055 MW |
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 | ||
73eceea6 MW |
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 | ||
dea4d055 | 39 | (export 'make-sod-class) |
81054f01 | 40 | (defun make-sod-class (name superclasses pset &key location) |
dea4d055 MW |
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 | |
52a79ab8 MW |
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 | |
dea4d055 MW |
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 | |
3109662a | 49 | `shared-initialize'. |
dea4d055 MW |
50 | |
51 | Minimal sanity checking is done during class construction; most of it is | |
048d0b2d | 52 | left for `finalize-sod-class' to do (via `check-sod-class')." |
dea4d055 MW |
53 | |
54 | (with-default-error-location (location) | |
55 | (let* ((pset (property-set pset)) | |
4f5ac503 | 56 | (best-class (or (get-property pset :lisp-metaclass :symbol nil) |
6e92afa7 MW |
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))) | |
4f5ac503 | 64 | (class (make-instance best-class |
dea4d055 MW |
65 | :name name |
66 | :superclasses superclasses | |
67 | :location (file-location location) | |
68 | :pset pset))) | |
dea4d055 MW |
69 | class))) |
70 | ||
dea4d055 MW |
71 | ;;;-------------------------------------------------------------------------- |
72 | ;;; Slots and slot initializers. | |
73 | ||
74 | (export 'make-sod-slot) | |
81054f01 | 75 | (defgeneric make-sod-slot (class name type pset &key location) |
dea4d055 MW |
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 | |
52a79ab8 | 81 | process. The default method uses the `:slot-class' property (defaulting |
dea4d055 MW |
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 | |
048d0b2d | 85 | example, `sod-slot' defines an `:after'-method on `shared-initialize'.")) |
dea4d055 MW |
86 | |
87 | (export 'make-sod-instance-initializer) | |
88 | (defgeneric make-sod-instance-initializer | |
03570bbb | 89 | (class nick name value pset &key location inhibit-initargs) |
dea4d055 MW |
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 | |
03570bbb MW |
98 | in CLASS. |
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.")) | |
dea4d055 MW |
105 | |
106 | (export 'make-sod-class-initializer) | |
107 | (defgeneric make-sod-class-initializer | |
81054f01 | 108 | (class nick name value pset &key location) |
dea4d055 MW |
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 | |
048d0b2d | 117 | in CLASS.")) |
dea4d055 MW |
118 | |
119 | (export 'make-sod-initializer-using-slot) | |
120 | (defgeneric make-sod-initializer-using-slot | |
a888e3ac | 121 | (class slot init-class value pset location) |
dea4d055 MW |
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 | |
52a79ab8 MW |
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 | |
dea4d055 MW |
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 | ||
b2983f35 MW |
142 | (export 'make-sod-user-initarg) |
143 | (defgeneric make-sod-user-initarg | |
81054f01 | 144 | (class name type pset &key default location) |
b2983f35 MW |
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 | |
81054f01 | 154 | (class name nick slot-name pset &key location) |
b2983f35 MW |
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 | |
81054f01 | 163 | (class name slot pset &key location) |
b2983f35 MW |
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 | ||
a42893dd | 177 | (export 'make-sod-class-initfrag) |
81054f01 | 178 | (defgeneric make-sod-class-initfrag (class frag pset &key location) |
a42893dd MW |
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) | |
81054f01 | 186 | (defgeneric make-sod-class-tearfrag (class frag pset &key location) |
a42893dd MW |
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 | ||
dea4d055 MW |
193 | ;;;-------------------------------------------------------------------------- |
194 | ;;; Messages and methods. | |
195 | ||
196 | (export 'make-sod-message) | |
81054f01 | 197 | (defgeneric make-sod-message (class name type pset &key location) |
dea4d055 MW |
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 | |
d145f6df MW |
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'.")) | |
dea4d055 MW |
210 | |
211 | (export 'make-sod-method) | |
212 | (defgeneric make-sod-method | |
81054f01 | 213 | (class nick name type body pset &key location) |
dea4d055 MW |
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 | |
048d0b2d | 225 | example.")) |
dea4d055 MW |
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 | |
52a79ab8 | 235 | the `:method-class' property (defaulting to the result of calling |
dea4d055 MW |
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 | |
52a79ab8 MW |
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.")) | |
dea4d055 MW |
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 | ||
dea4d055 | 275 | ;;;----- That's all, folks -------------------------------------------------- |