Commit | Line | Data |
---|---|---|
abdf50aa MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Equipment for building classes and friends | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This file is part of the Simple Object Definition system. | |
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 | ;;; Finding things by name | |
30 | ||
31 | (defun find-superclass-by-nick (class nick) | |
32 | "Returns the superclass of CLASS with nickname NICK, or signals an error." | |
1f1d88f5 MW |
33 | |
34 | ;; Slightly tricky. The class almost certainly hasn't been finalized, so | |
35 | ;; trundle through its superclasses and hope for the best. | |
36 | (if (string= nick (sod-class-nickname class)) | |
37 | class | |
38 | (or (some (lambda (super) | |
39 | (find nick (sod-class-precedence-list super) | |
40 | :key #'sod-class-nickname | |
41 | :test #'string=)) | |
42 | (sod-class-direct-superclasses class)) | |
43 | (error "No superclass of `~A' with nickname `~A'" class nick)))) | |
abdf50aa MW |
44 | |
45 | (flet ((find-item-by-name (what class list name key) | |
46 | (or (find name list :key key :test #'string=) | |
1f1d88f5 | 47 | (error "No ~A in class `~A' with name `~A'" what class name)))) |
abdf50aa MW |
48 | |
49 | (defun find-instance-slot-by-name (class super-nick slot-name) | |
50 | (let ((super (find-superclass-by-nick class super-nick))) | |
51 | (find-item-by-name "slot" super (sod-class-slots super) | |
52 | slot-name #'sod-slot-name))) | |
53 | ||
54 | (defun find-class-slot-by-name (class super-nick slot-name) | |
55 | (let* ((meta (sod-class-metaclass class)) | |
56 | (super (find-superclass-by-nick meta super-nick))) | |
57 | (find-item-by-name "slot" super (sod-class-slots super) | |
58 | slot-name #'sod-slot-name))) | |
59 | ||
60 | (defun find-message-by-name (class super-nick message-name) | |
61 | (let ((super (find-superclass-by-nick class super-nick))) | |
62 | (find-item-by-name "message" super (sod-class-messages super) | |
63 | message-name #'sod-message-name)))) | |
64 | ||
65 | ;;;-------------------------------------------------------------------------- | |
66 | ;;; Class construction. | |
67 | ||
68 | (defun make-sod-class (name superclasses pset &optional location) | |
69 | "Construct and return a new SOD class with the given NAME and SUPERCLASSES. | |
70 | ||
71 | This is the main constructor function for classes. The protocol works as | |
72 | follows. The :LISP-CLASS property in PSET is checked: if it exists, it | |
73 | must be a symbol naming a (CLOS) class, which is used in place of | |
74 | SOD-CLASS. All of the arguments are then passed to MAKE-INSTANCE; further | |
75 | behaviour is left to the standard CLOS instance construction protocol; for | |
76 | example, SOD-CLASS defines an :AFTER-method on SHARED-INITIALIZE. | |
77 | ||
78 | Minimal sanity checking is done during class construction; most of it is | |
79 | left for FINALIZE-SOD-CLASS to do (via CHECK-SOD-CLASS). | |
80 | ||
81 | Unused properties in PSET are diagnosed as errors." | |
82 | ||
83 | (with-default-error-location (location) | |
84 | (let ((class (make-instance (get-property pset :lisp-class :symbol | |
85 | 'sod-class) | |
86 | :name name | |
87 | :superclasses superclasses | |
88 | :location (file-location location) | |
89 | :pset pset))) | |
90 | (check-unused-properties pset) | |
91 | class))) | |
92 | ||
93 | (defgeneric guess-metaclass (class) | |
94 | (:documentation | |
95 | "Determine a suitable metaclass for the CLASS. | |
96 | ||
97 | The default behaviour is to choose the most specific metaclass of any of | |
98 | the direct superclasses of CLASS, or to signal an error if that failed.")) | |
99 | ||
100 | (defmethod guess-metaclass ((class sod-class)) | |
101 | "Default metaclass-guessing function for classes. | |
102 | ||
103 | Return the most specific metaclass of any of the CLASS's direct | |
104 | superclasses." | |
105 | (do ((supers (sod-class-direct-superclasses class) (cdr supers)) | |
106 | (meta nil (let ((candidate (sod-class-metaclass (car supers)))) | |
107 | (cond ((null meta) candidate) | |
108 | ((sod-subclass-p meta candidate) meta) | |
109 | ((sod-subclass-p candidate meta) candidate) | |
110 | (t (error "Unable to choose metaclass for `~A'" | |
1f1d88f5 | 111 | class)))))) |
abdf50aa MW |
112 | ((endp supers) meta))) |
113 | ||
114 | (defmethod shared-initialize :after ((class sod-class) slot-names &key pset) | |
115 | "Specific behaviour for SOD class initialization. | |
116 | ||
117 | Properties inspected are as follows: | |
118 | ||
119 | * :METACLASS names the metaclass to use. If unspecified, NIL is stored, | |
120 | and (unless you intervene later) GUESS-METACLASS will be called by | |
121 | FINALIZE-SOD-CLASS to find a suitable default. | |
122 | ||
123 | * :NICK provides a nickname for the class. If unspecified, a default | |
124 | (the class's name, forced to lowercase) will be chosen in | |
125 | FINALIZE-SOD-CLASS. | |
126 | ||
1f1d88f5 | 127 | * :LINK names the chained superclass. If unspecified, this class will |
abdf50aa MW |
128 | be left at the head of its chain." |
129 | ||
1f1d88f5 MW |
130 | ;; If no nickname, copy the class name. It won't be pretty, though. |
131 | (default-slot (class 'nickname) | |
132 | (get-property pset :nick :id (slot-value class 'name))) | |
abdf50aa | 133 | |
1f1d88f5 MW |
134 | ;; If no metaclass, guess one in a (Lisp) class-specific way. |
135 | (default-slot (class 'metaclass) | |
136 | (multiple-value-bind (name floc) (get-property pset :metaclass :id) | |
137 | (if floc | |
138 | (find-sod-class name floc) | |
139 | (guess-metaclass class)))) | |
abdf50aa | 140 | |
1f1d88f5 MW |
141 | ;; If no chain-link, then start a new chain here. |
142 | (default-slot (class 'chain-link) | |
143 | (multiple-value-bind (name floc) (get-property pset :link :id) | |
144 | (if floc | |
145 | (find-sod-class name floc) | |
146 | nil)))) | |
abdf50aa MW |
147 | |
148 | ;;;-------------------------------------------------------------------------- | |
149 | ;;; Slot construction. | |
150 | ||
151 | (defgeneric make-sod-slot (class name type pset &optional location) | |
152 | (:documentation | |
153 | "Construct, add, and attach a new slot with given NAME and TYPE, to CLASS. | |
154 | ||
155 | This is the main constructor function for slots. This is a generic | |
156 | function primarily so that the CLASS can intervene in the construction | |
157 | process. The default method uses the :LISP-CLASS property (defaulting to | |
158 | SOD-SLOT) to choose a (CLOS) class to instantiate. The slot is then | |
159 | constructed by MAKE-INSTANCE passing the arguments as initargs; further | |
160 | behaviour is left to the standard CLOS instance construction protocol; for | |
161 | example, SOD-SLOT defines an :AFTER-method on SHARED-INITIALIZE. | |
162 | ||
163 | Unused properties on PSET are diagnosed as errors.")) | |
164 | ||
165 | (defmethod make-sod-slot | |
166 | ((class sod-class) name type pset &optional location) | |
167 | (with-default-error-location (location) | |
168 | (let ((slot (make-instance (get-property pset :lisp-class :symbol | |
169 | 'sod-slot) | |
170 | :class class | |
171 | :name name | |
172 | :type type | |
173 | :location (file-location location) | |
174 | :pset pset))) | |
175 | (with-slots (slots) class | |
176 | (setf slots (append slots (list slot)))) | |
177 | (check-unused-properties pset)))) | |
178 | ||
179 | (defmethod shared-initialize :after ((slot sod-slot) slot-names &key pset) | |
180 | "This method exists so that it isn't an error to provide a :PSET initarg | |
181 | to (make-instance 'sod-slot ...). It does nothing." | |
182 | (declare (ignore slot-names pset)) | |
183 | nil) | |
184 | ||
185 | ;;;-------------------------------------------------------------------------- | |
186 | ;;; Slot initializer construction. | |
187 | ||
188 | (defgeneric make-sod-instance-initializer | |
189 | (class nick name value-kind value-form pset &optional location) | |
190 | (:documentation | |
191 | "Construct and attach an instance slot initializer, to CLASS. | |
192 | ||
193 | This is the main constructor function for instance initializers. This is | |
194 | a generic function primarily so that the CLASS can intervene in the | |
195 | construction process. The default method looks up the slot using | |
196 | FIND-INSTANCE-SLOT-BY-NAME, calls MAKE-SOD-INITIALIZER-USING-SLOT to | |
197 | actually make the initializer object, and adds it to the appropriate list | |
198 | in CLASS. | |
199 | ||
200 | Unused properties on PSET are diagnosed as errors.")) | |
201 | ||
202 | (defgeneric make-sod-class-initializer | |
203 | (class nick name value-kind value-form pset &optional location) | |
204 | (:documentation | |
205 | "Construct and attach a class slot initializer, to CLASS. | |
206 | ||
207 | This is the main constructor function for class initializers. This is a | |
208 | generic function primarily so that the CLASS can intervene in the | |
209 | construction process. The default method looks up the slot using | |
210 | FIND-CLASS-SLOT-BY-NAME, calls MAKE-SOD-INITIALIZER-USING-SLOT to actually | |
211 | make the initializer object, and adds it to the appropriate list in CLASS. | |
212 | ||
213 | Unused properties on PSET are diagnosed as errors.")) | |
214 | ||
215 | (defgeneric make-sod-initializer-using-slot | |
216 | (class slot init-class value-kind value-form pset location) | |
217 | (:documentation | |
218 | "Common construction protocol for slot initializers. | |
219 | ||
220 | This generic function does the common work for constructing instance and | |
221 | class initializers. It can usefully be specialized according to both the | |
222 | class and slot types. The default method uses the :LISP-CLASS property | |
223 | (defaulting to INIT-CLASS) to choose a (CLOS) class to instantiate. The | |
224 | slot is then constructed by MAKE-INSTANCE passing the arguments as | |
225 | initargs; further behaviour is left to the standard CLOS instance | |
226 | construction protocol; for example, SOD-INITIALIZER defines | |
227 | an :AFTER-method on SHARED-INITIALIZE. | |
228 | ||
229 | Diagnosing unused properties is left for the caller (usually | |
230 | MAKE-SOD-INSTANCE-INITIALIZER or MAKE-SOD-CLASS-INITIALIZER) to do. The | |
231 | caller is also expected to have set WITH-DEFAULT-ERROR-LOCATION if | |
232 | appropriate. | |
233 | ||
234 | You are not expected to call this generic function directly; it's more | |
235 | useful as a place to hang methods for custom initializer classes.")) | |
236 | ||
237 | (defmethod make-sod-instance-initializer | |
238 | ((class sod-class) nick name value-kind value-form pset | |
239 | &optional location) | |
240 | (with-default-error-location (location) | |
241 | (let* ((slot (find-instance-slot-by-name class nick name)) | |
242 | (initializer (make-sod-initializer-using-slot | |
243 | class slot 'sod-instance-initializer | |
244 | value-kind value-form pset | |
245 | (file-location location)))) | |
246 | (with-slots (instance-initializers) class | |
247 | (setf instance-initializers (append instance-initializers | |
248 | (list initializer)))) | |
249 | (check-unused-properties pset)))) | |
250 | ||
251 | (defmethod make-sod-class-initializer | |
252 | ((class sod-class) nick name value-kind value-form pset | |
253 | &optional location) | |
254 | (with-default-error-location (location) | |
255 | (let* ((slot (find-class-slot-by-name class nick name)) | |
256 | (initializer (make-sod-initializer-using-slot | |
257 | class slot 'sod-class-initializer | |
258 | value-kind value-form pset | |
259 | (file-location location)))) | |
260 | (with-slots (class-initializers) class | |
261 | (setf class-initializers (append class-initializers | |
262 | (list initializer)))) | |
263 | (check-unused-properties pset)))) | |
264 | ||
265 | (defmethod make-sod-initializer-using-slot | |
266 | ((class sod-class) (slot sod-slot) | |
267 | init-class value-kind value-form pset location) | |
268 | (make-instance (get-property pset :lisp-class :symbol init-class) | |
269 | :class class | |
270 | :slot slot | |
271 | :value-kind value-kind | |
272 | :value-form value-form | |
273 | :location location | |
274 | :pset pset)) | |
275 | ||
276 | (defmethod shared-initialize :after | |
277 | ((init sod-initializer) slot-names &key pset) | |
278 | "This method exists so that it isn't an error to provide a :PSET initarg | |
279 | to (make-instance 'sod-initializer ...). It does nothing." | |
280 | (declare (ignore slot-names pset)) | |
281 | nil) | |
282 | ||
283 | ;;;-------------------------------------------------------------------------- | |
284 | ;;; Message construction. | |
285 | ||
286 | (defgeneric make-sod-message (class name type pset &optional location) | |
287 | (:documentation | |
288 | "Construct and attach a new message with given NAME and TYPE, to CLASS. | |
289 | ||
290 | This is the main constructor function for messages. This is a generic | |
291 | function primarily so that the CLASS can intervene in the construction | |
292 | process. The default method uses the :LISP-CLASS property (defaulting to | |
293 | SOD-MESSAGE) to choose a (CLOS) class to instantiate. The message is then | |
294 | constructed by MAKE-INSTANCE passing the arguments as initargs; further | |
295 | behaviour is left to the standard CLOS instance construction protocol; for | |
296 | example, SOD-MESSAGE defines an :AFTER-method on SHARED-INITIALIZE. | |
297 | ||
298 | Unused properties on PSET are diagnosed as errors.")) | |
299 | ||
300 | (defgeneric check-message-type (message type) | |
301 | (:documentation | |
302 | "Check that TYPE is a suitable type for MESSAGE. Signal errors if not. | |
303 | ||
304 | This is separated out of SHARED-INITIALIZE, where it's called, so that it | |
305 | can be overridden conveniently by subclasses.")) | |
306 | ||
307 | (defmethod make-sod-message | |
308 | ((class sod-class) name type pset &optional location) | |
309 | (with-default-error-location (location) | |
1f1d88f5 MW |
310 | (let ((message (make-instance (get-property pset :lisp-class :symbol |
311 | 'standard-message) | |
abdf50aa MW |
312 | :class class |
313 | :name name | |
314 | :type type | |
315 | :location (file-location location) | |
316 | :pset pset))) | |
1f1d88f5 MW |
317 | (with-slots (messages) class |
318 | (setf messages (append messages (list message)))) | |
abdf50aa MW |
319 | (check-unused-properties pset)))) |
320 | ||
321 | (defmethod check-message-type ((message sod-message) (type c-function-type)) | |
322 | nil) | |
323 | (defmethod check-message-type ((message sod-message) (type c-type)) | |
324 | (error "Messages must have function type, not ~A" type)) | |
325 | ||
326 | (defmethod shared-initialize :after | |
327 | ((message sod-message) slot-names &key pset) | |
328 | (declare (ignore slot-names pset)) | |
329 | (with-slots (type) message | |
330 | (check-message-type message type))) | |
331 | ||
332 | ;;;-------------------------------------------------------------------------- | |
333 | ;;; Method construction. | |
334 | ||
335 | (defgeneric make-sod-method | |
336 | (class nick name type body pset &optional location) | |
337 | (:documentation | |
338 | "Construct and attach a new method to CLASS. | |
339 | ||
340 | This is the main constructor function for methods. This is a generic | |
341 | function primarily so that the CLASS can intervene in the message lookup | |
342 | process, though this is actually a fairly unlikely occurrence. | |
343 | ||
344 | The default method looks up the message using FIND-MESSAGE-BY-NAME, | |
345 | invokes MAKE-SOD-METHOD-USING-MESSAGE to make the method object, and then | |
346 | adds the method to the class's list of methods. This split allows the | |
347 | message class to intervene in the class selection process, for example. | |
348 | ||
349 | Unused properties on PSET are diagnosed as errors.")) | |
350 | ||
351 | (defgeneric make-sod-method-using-message | |
352 | (message class type body pset location) | |
353 | (:documentation | |
354 | "Main construction subroutine for method construction. | |
355 | ||
356 | This is a generic function so that it can be specialized according to both | |
357 | a class and -- more particularly -- a message. The default method uses | |
1f1d88f5 | 358 | the :LISP-CLASS property (defaulting to calling SOD-MESSAGE-METHOD-CLASS) |
abdf50aa MW |
359 | to choose a (CLOS) class to instantiate. The method is then constructed |
360 | by MAKE-INSTANCE passing the arguments as initargs; further behaviour is | |
361 | left to the standard CLOS instance construction protocol; for example, | |
362 | SOD-METHOD defines an :AFTER-method on SHARED-INITIALIZE. | |
363 | ||
364 | Diagnosing unused properties is left for the caller (usually | |
365 | MAKE-SOD-METHOD) to do. The caller is also expected to have set | |
366 | WITH-DEFAULT-ERROR-LOCATION if appropriate. | |
367 | ||
368 | You are not expected to call this generic function directly; it's more | |
369 | useful as a place to hang methods for custom initializer classes.")) | |
370 | ||
371 | (defgeneric sod-message-method-class (message class pset) | |
372 | (:documentation | |
373 | "Return the preferred class for methods on MESSAGE. | |
374 | ||
375 | The message can inspect the PSET to decide on a particular message. A | |
376 | :LISP-CLASS property will usually override this decision: it's then the | |
377 | programmer's responsibility to ensure that the selected method class is | |
378 | appropriate.")) | |
379 | ||
380 | (defgeneric check-method-type (method message type) | |
381 | (:documentation | |
382 | "Check that TYPE is a suitable type for METHOD. Signal errors if not. | |
383 | ||
384 | This is separated out of SHARED-INITIALIZE, where it's called, so that it | |
385 | can be overridden conveniently by subclasses.")) | |
386 | ||
387 | (defmethod make-sod-method | |
388 | ((class sod-class) nick name type body pset &optional location) | |
389 | (with-default-error-location (location) | |
390 | (let* ((message (find-message-by-name class nick name)) | |
391 | (method (make-sod-method-using-message message class | |
392 | type body pset | |
393 | (file-location location)))) | |
394 | (with-slots (methods) class | |
395 | (setf methods (append methods (list method))))) | |
396 | (check-unused-properties pset))) | |
397 | ||
398 | (defmethod make-sod-method-using-message | |
399 | ((message sod-message) (class sod-class) type body pset location) | |
400 | (make-instance (or (get-property pset :lisp-class :symbol) | |
401 | (sod-message-method-class message class pset)) | |
402 | :message message | |
403 | :class class | |
404 | :type type | |
405 | :body body | |
406 | :location location | |
407 | :pset pset)) | |
408 | ||
409 | (defmethod sod-message-method-class | |
410 | ((message sod-message) (class sod-class) pset) | |
411 | (declare (ignore pset)) | |
412 | 'sod-method) | |
413 | ||
414 | (defmethod check-method-type | |
415 | ((method sod-method) (message sod-message) (type c-type)) | |
416 | (error "Methods must have function type, not ~A" type)) | |
417 | ||
1f1d88f5 | 418 | (defun argument-lists-compatible-p (message-args method-args) |
abdf50aa MW |
419 | "Compare argument lists for compatibility. |
420 | ||
421 | Return true if METHOD-ARGS is a suitable method argument list | |
422 | corresponding to the message argument list MESSAGE-ARGS. This is the case | |
423 | if the lists are the same length, each message argument has a | |
424 | corresponding method argument with the same type, and if the message | |
425 | arguments end in an ellpisis, the method arguments must end with a | |
426 | `va_list' argument. (We can't pass actual variable argument lists around, | |
427 | except as `va_list' objects, which are devilish inconvenient things and | |
428 | require much hacking. See the method combination machinery for details.)" | |
429 | ||
430 | (and (= (length message-args) (length method-args)) | |
431 | (every (lambda (message-arg method-arg) | |
432 | (if (eq message-arg :ellipsis) | |
433 | (eq method-arg (c-type va-list)) | |
434 | (c-type-equal-p (argument-type message-arg) | |
435 | (argument-type method-arg)))) | |
436 | message-args method-args))) | |
437 | ||
438 | (defmethod check-method-type | |
439 | ((method sod-method) (message sod-message) (type c-function-type)) | |
abdf50aa | 440 | (with-slots ((msgtype type)) message |
1f1d88f5 MW |
441 | (unless (c-type-equal-p (c-type-subtype msgtype) |
442 | (c-type-subtype type)) | |
443 | (error "Method return type ~A doesn't match message ~A" | |
444 | (c-type-subtype msgtype) (c-type-subtype type))) | |
445 | (unless (argument-lists-compatible-p (c-function-arguments msgtype) | |
446 | (c-function-arguments type)) | |
447 | (error "Method arguments ~A don't match message ~A" type msgtype)))) | |
448 | ||
449 | (defmethod shared-initialize :after | |
450 | ((method sod-method) slot-names &key pset) | |
451 | (declare (ignore slot-names pset)) | |
abdf50aa MW |
452 | |
453 | ;; Check that the arguments are named if we have a method body. | |
1f1d88f5 | 454 | (with-slots (body type) method |
abdf50aa MW |
455 | (unless (or (not body) |
456 | (every #'argument-name (c-function-arguments type))) | |
1f1d88f5 | 457 | (error "Abstract declarators not permitted in method definitions"))) |
abdf50aa | 458 | |
1f1d88f5 | 459 | ;; Check the method type. |
abdf50aa MW |
460 | (with-slots (message type) method |
461 | (check-method-type method message type))) | |
462 | ||
463 | ;;;-------------------------------------------------------------------------- | |
ddee4bb1 | 464 | ;;; Builder macros. |
1f1d88f5 MW |
465 | |
466 | (defmacro define-sod-class (name (&rest superclasses) &body body) | |
467 | (let ((plist nil) | |
468 | (classvar (gensym "CLASS"))) | |
469 | (loop | |
470 | (when (or (null body) | |
471 | (not (keywordp (car body)))) | |
472 | (return)) | |
473 | (push (pop body) plist) | |
474 | (push (pop body) plist)) | |
475 | `(let ((,classvar (make-sod-class ,name | |
476 | (mapcar #'find-sod-class | |
477 | (list ,@superclasses)) | |
478 | (make-property-set | |
479 | ,@(nreverse plist))))) | |
480 | (macrolet ((message (name type &rest plist) | |
481 | `(make-sod-message ,',classvar ,name (c-type ,type) | |
482 | (make-property-set ,@plist))) | |
483 | (method (nick name type body &rest plist) | |
484 | `(make-sod-method ,',classvar ,nick ,name (c-type ,type) | |
485 | ,body (make-property-set ,@plist))) | |
486 | (slot (name type &rest plist) | |
487 | `(make-sod-slot ,',classvar ,name (c-type ,type) | |
488 | (make-property-set ,@plist))) | |
489 | (instance-initializer | |
490 | (nick name value-kind value-form &rest plist) | |
491 | `(make-sod-instance-initializer ,',classvar ,nick ,name | |
492 | ,value-kind ,value-form | |
493 | (make-property-set | |
494 | ,@plist))) | |
495 | (class-initializer | |
496 | (nick name value-kind value-form &rest plist) | |
497 | `(make-sod-class-initializer ,',classvar ,nick ,name | |
498 | ,value-kind ,value-form | |
499 | (make-property-set | |
500 | ,@plist)))) | |
501 | ,@body | |
502 | (finalize-sod-class ,classvar) | |
ddee4bb1 | 503 | (add-to-module *module* ,classvar))))) |
abdf50aa MW |
504 | |
505 | ;;;----- That's all, folks -------------------------------------------------- |