Commit | Line | Data |
---|---|---|
abdf50aa MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Basic definitions for classes, methods and suchlike | |
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 | ;;;-------------------------------------------------------------------------- | |
1f1d88f5 | 29 | ;;; Classes. |
abdf50aa MW |
30 | |
31 | (defclass sod-class () | |
77027cca MW |
32 | ((name :initarg :name :type string :reader sod-class-name) |
33 | (location :initarg :location :initform (file-location nil) | |
34 | :type file-location :reader file-location) | |
35 | (nickname :initarg :nick :type string :reader sod-class-nickname) | |
36 | (direct-superclasses :initarg :superclasses :type list | |
abdf50aa | 37 | :reader sod-class-direct-superclasses) |
77027cca | 38 | (chain-link :initarg :link :type (or sod-class null) |
1f1d88f5 | 39 | :reader sod-class-chain-link) |
77027cca | 40 | (metaclass :initarg :metaclass :type sod-class |
abdf50aa | 41 | :reader sod-class-metaclass) |
77027cca MW |
42 | (slots :initarg :slots :initform nil |
43 | :type list :accessor sod-class-slots) | |
44 | (instance-initializers :initarg :instance-initializers :initform nil | |
abdf50aa | 45 | :type list |
abdf50aa | 46 | :accessor sod-class-instance-initializers) |
77027cca MW |
47 | (class-initializers :initarg :class-initializers :initform nil |
48 | :type list :accessor sod-class-class-initializers) | |
49 | (messages :initarg :messages :initform nil | |
50 | :type list :accessor sod-class-messages) | |
51 | (methods :initarg :methods :initform nil | |
52 | :type list :accessor sod-class-methods) | |
abdf50aa MW |
53 | |
54 | (class-precedence-list :type list :accessor sod-class-precedence-list) | |
55 | ||
56 | (chain-head :type sod-class :accessor sod-class-chain-head) | |
57 | (chain :type list :accessor sod-class-chain) | |
58 | (chains :type list :accessor sod-class-chains) | |
59 | ||
1f1d88f5 MW |
60 | (ilayout :type ilayout :accessor sod-class-ilayout) |
61 | (effective-methods :type list :accessor sod-class-effective-methods) | |
62 | (vtables :type list :accessor sod-class-vtables) | |
63 | ||
77027cca | 64 | (state :initform nil :type (member nil :finalized broken) |
abdf50aa MW |
65 | :accessor sod-class-state)) |
66 | (:documentation | |
67 | "Classes describe the layout and behaviour of objects. | |
68 | ||
1f1d88f5 | 69 | The NAME, LOCATION, NICKNAME, DIRECT-SUPERCLASSES, CHAIN-LINK and |
abdf50aa MW |
70 | METACLASS slots are intended to be initialized when the class object is |
71 | constructed: | |
72 | ||
73 | * The NAME is the identifier associated with the class in the user's | |
74 | source file. It is used verbatim in the generated C code as a type | |
75 | name, and must be distinct from other file-scope names in any source | |
76 | file which includes the class definition. Furthermore, other names | |
77 | are derived from the class name (most notably the class object | |
78 | NAME__class), which have external linkage and must therefore be | |
79 | distinct from all other identifiers in the program. It is forbidden | |
80 | for a class NAME to begin with an underscore or to contain two | |
81 | consecutive underscores. | |
82 | ||
83 | * The LOCATION identifies where in the source the class was defined. It | |
84 | gets used in error messages. | |
85 | ||
86 | * The NICKNAME is a shorter identifier used to name the class in some | |
87 | circumstances. The uniqueness requirements on NICKNAME are less | |
88 | strict, which allows them to be shorter: no class may have two classes | |
89 | with the same nickname on its class precedence list. Nicknames are | |
90 | used (user-visibly) to distinguish slots and messages defined by | |
91 | different classes, and (invisibly) in the derived names of direct | |
92 | methods. It is forbidden for a nickname to begin with an underscore, | |
93 | or to contain two consecutive underscores. | |
94 | ||
95 | * The DIRECT-SUPERCLASSES are a list of the class's direct superclasses, | |
96 | in the order that they were declared in the source. The class | |
97 | precedence list is computed from the DIRECT-SUPERCLASSES lists of all | |
98 | of the superclasses involved. | |
99 | ||
1f1d88f5 MW |
100 | * The CHAIN-LINK is either NIL or one of the DIRECT-SUPERCLASSES. Class |
101 | chains are a means for recovering most of the benefits of simple | |
102 | hierarchy lost by the introduction of multiple inheritance. A class's | |
103 | superclasses (including itself) are partitioned into chains, | |
104 | consisting of a class, its CHAIN-LINK superclass, that class's | |
105 | CHAIN-LINK, and so on. It is an error if two direct subclasses of any | |
106 | class appear in the same chain (a global property which requires | |
107 | global knowledge of an entire program's class hierarchy in order to | |
108 | determine sensibly). Slots of superclasses in the same chain can be | |
109 | accessed efficiently; there is an indirection needed to access slots | |
110 | of superclasses in other chains. Furthermore, an indirection is | |
111 | required to perform a cross-chain conversion (i.e., converting a | |
112 | pointer to an instance of some class into a pointer to an instance of | |
113 | one of its superclasses in a different chain), an operation which | |
114 | occurs implicitly in effective methods in order to call direct methods | |
115 | defined on cross-chain superclasses. | |
abdf50aa MW |
116 | |
117 | * The METACLASS is the class of the class object. Classes are objects | |
118 | in their own right, and therefore must be instances of some class; | |
119 | this class is the metaclass. Metaclasses can define additional slots | |
120 | and methods to be provided by their instances; a class definition can | |
121 | provide (C constant expression) initial values for the metaclass | |
122 | instance. | |
123 | ||
124 | The next few slots can't usually be set at object-construction time, since | |
125 | the objects need to contain references to the class object itself. | |
126 | ||
127 | * The SLOTS are a list of the slots defined by the class (instances of | |
128 | SOD-SLOT). (The class will also define all of the slots defined by | |
129 | its superclasses.) | |
130 | ||
131 | * The INSTANCE-INITIALIZERS and CLASS-INITIALIZERS are lists of | |
132 | initializers for slots (see SOD-INITIALIZER and subclasses), providing | |
133 | initial values for instances of the class, and for the class's class | |
134 | object itself, respectively. | |
135 | ||
136 | * The MESSAGES are a list of the messages recognized by the class | |
137 | (instances of SOD-MESSAGE and subclasses). (Note that the message | |
138 | need not have any methods defined on it. The class will also | |
139 | recognize all of the messages defined by its superclasses.) | |
140 | ||
141 | * The METHODS are a list of (direct) methods defined on the class | |
142 | (instances of SOD-METHOD and subclasses). Each method provides | |
143 | behaviour to be invoked by a particular message recognized by the | |
144 | class. | |
145 | ||
146 | Other slots are computed from these in order to describe the class's | |
147 | layout and effective methods; this is done by FINALIZE-SOD-CLASS. | |
148 | ||
1f1d88f5 MW |
149 | * The CLASS-PRECEDENCE-LIST is a list of superclasses in a linear order. |
150 | It is computed by the generic function COMPUTE-CLASS-PRECEDENCE-LIST, | |
151 | whose default implementation ensures that the order of superclasses is | |
152 | such that (a) subclasses appear before their superclasses; (b) the | |
153 | direct superclasses of a given class appear in the order in which they | |
154 | were declared by the programmer; and (c) classes always appear in the | |
155 | same relative order in all class precedence lists in the same | |
156 | superclass graph. | |
157 | ||
158 | * The CHAIN-HEAD is the least-specific class in the class's chain. If | |
159 | there is no link class then the CHAIN-HEAD is the class itself. This | |
160 | slot, like the next two, is computed by the generic function | |
161 | COMPUTE-CHAINS. | |
162 | ||
163 | * The CHAIN is the list of classes on the complete primary chain, | |
164 | starting from this class and ending with the CHAIN-HEAD. | |
165 | ||
166 | * The CHAINS are the complete collection of chains (most-to-least | |
167 | specific) for the class and all of its superclasses. | |
168 | ||
169 | * The ILAYOUT describes the layout for an instance of the class. It's | |
170 | quite complicated; see the documentation of the ILAYOUT class for | |
171 | detais. | |
172 | ||
173 | * The EFFECTIVE-METHODS are a list of effective methods, specialized for | |
174 | the class. | |
175 | ||
176 | * The VTABLES are a list of descriptions of vtables for the class. The | |
177 | individual elements are VTABLE objects, which are even more | |
178 | complicated than ILAYOUT structures. See the class documentation for | |
179 | details.")) | |
abdf50aa MW |
180 | |
181 | (defmethod print-object ((class sod-class) stream) | |
1f1d88f5 MW |
182 | (maybe-print-unreadable-object (class stream :type t) |
183 | (princ (sod-class-name class) stream))) | |
184 | ||
185 | ;;;-------------------------------------------------------------------------- | |
186 | ;;; Slots and initializers. | |
187 | ||
188 | (defclass sod-slot () | |
77027cca MW |
189 | ((name :initarg :name :type string :reader sod-slot-name) |
190 | (location :initarg :location :initform (file-location nil) | |
191 | :type file-location :reader file-location) | |
192 | (class :initarg :class :type sod-class :reader sod-slot-class) | |
193 | (type :initarg :type :type c-type :reader sod-slot-type)) | |
1f1d88f5 MW |
194 | (:documentation |
195 | "Slots are units of information storage in instances. | |
196 | ||
197 | Each class defines a number of slots, which function similarly to (data) | |
198 | members in structures. An instance contains all of the slots defined in | |
199 | its class and all of its superclasses. | |
200 | ||
201 | A slot carries the following information. | |
202 | ||
203 | * A NAME, which distinguishes it from other slots defined by the same | |
204 | class. Unlike most (all?) other object systems, slots defined in | |
205 | different classes are in distinct namespaces. There are no special | |
206 | restrictions on slot names. | |
207 | ||
208 | * A LOCATION, which states where in the user's source the slot was | |
209 | defined. This gets used in error messages. | |
210 | ||
211 | * A CLASS, which states which class defined the slot. The slot is | |
212 | available in instances of this class and all of its descendents. | |
213 | ||
214 | * A TYPE, which is the C type of the slot. This must be an object type | |
215 | (certainly not a function type, and it must be a complete type by the | |
216 | time that the user header code has been scanned).")) | |
217 | ||
218 | (defmethod print-object ((slot sod-slot) stream) | |
219 | (maybe-print-unreadable-object (slot stream :type t) | |
220 | (pprint-c-type (sod-slot-type slot) stream | |
221 | (format nil "~A.~A" | |
222 | (sod-class-nickname (sod-slot-class slot)) | |
223 | (sod-slot-name slot))))) | |
224 | ||
225 | (defclass sod-initializer () | |
77027cca MW |
226 | ((slot :initarg :slot :type sod-slot :reader sod-initializer-slot) |
227 | (location :initarg :location :initform (file-location nil) | |
228 | :type file-location :reader file-location) | |
229 | (class :initarg :class :type sod-class :reader sod-initializer-clas) | |
230 | (value-kind :initarg :value-kind :type keyword | |
1f1d88f5 | 231 | :reader sod-initializer-value-kind) |
77027cca | 232 | (value-form :initarg :value-form :type c-fragment |
1f1d88f5 MW |
233 | :reader sod-initializer-value-form)) |
234 | (:documentation | |
235 | "Provides an initial value for a slot. | |
236 | ||
237 | The slots of an initializer are as follows. | |
238 | ||
239 | * The SLOT specifies which slot this initializer is meant to initialize. | |
240 | ||
241 | * The LOCATION states the position in the user's source file where the | |
242 | initializer was found. This gets used in error messages. (Depending | |
243 | on the source layout style, this might differ from the location in the | |
244 | VALUE-FORM C fragment.) | |
245 | ||
246 | * The CLASS states which class defined this initializer. For instance | |
247 | slot initializers (SOD-INSTANCE-INITIALIZER), this will be the same as | |
248 | the SLOT's class, or be one of its descendants. For class slot | |
249 | initializers (SOD-CLASS-INITIALIZER), this will be an instance of the | |
250 | SLOT's class, or an instance of one of its descendants. | |
251 | ||
252 | * The VALUE-KIND states what manner of initializer we have. It can be | |
253 | either :SINGLE, indicating a standalone expression, or :COMPOUND, | |
254 | indicating a compound initializer which must be surrounded by braces | |
255 | on output. | |
256 | ||
257 | * The VALUE-FORM gives the text of the initializer, as a C fragment. | |
258 | ||
259 | Typically you'll see instances of subclasses of this class in the wild | |
260 | rather than instances of this class directly. See SOD-CLASS-INITIALIZER | |
261 | and SOD-INSTANCE-INITIALIZER.")) | |
262 | ||
263 | (defmethod print-object ((initializer sod-initializer) stream) | |
264 | (if *print-escape* | |
265 | (print-unreadable-object (initializer stream :type t) | |
266 | (format stream "~A = ~A" | |
267 | (sod-initializer-slot initializer) | |
268 | initializer)) | |
269 | (format stream "~:[{~A}~;~A~]" | |
270 | (eq (sod-initializer-value-kind initializer) :single) | |
271 | (sod-initializer-value-form initializer)))) | |
272 | ||
273 | (defclass sod-class-initializer (sod-initializer) | |
274 | () | |
275 | (:documentation | |
276 | "Provides an initial value for a class slot. | |
277 | ||
278 | A class slot initializer provides an initial value for a slot in the class | |
279 | object (i.e., one of the slots defined by the class's metaclass). Its | |
280 | VALUE-FORM must have the syntax of an initializer, and its consituent | |
281 | expressions must be constant expressions. | |
282 | ||
283 | See SOD-INITIALIZER for more details.")) | |
284 | ||
285 | (defclass sod-instance-initializer (sod-initializer) | |
286 | () | |
287 | (:documentation | |
288 | "Provides an initial value for a slot in all instances. | |
289 | ||
290 | An instance slot initializer provides an initial value for a slot in | |
291 | instances of the class. Its VALUE-FORM must have the syntax of an | |
292 | initializer. Furthermore, if the slot has aggregate type, then you'd | |
293 | better be sure that your compiler supports compound literals (6.5.2.5) | |
294 | because that's what the initializer gets turned into. | |
295 | ||
296 | See SOD-INITIALIZER for more details.")) | |
297 | ||
298 | ;;;-------------------------------------------------------------------------- | |
299 | ;;; Messages and methods. | |
abdf50aa MW |
300 | |
301 | (defclass sod-message () | |
77027cca MW |
302 | ((name :initarg :name :type string :reader sod-message-name) |
303 | (location :initarg :location :initform (file-location nil) | |
304 | :type file-location :reader file-location) | |
305 | (class :initarg :class :type sod-class :reader sod-message-class) | |
306 | (type :initarg :type :type c-function-type :reader sod-message-type)) | |
abdf50aa MW |
307 | (:documentation |
308 | "Messages the means for stimulating an object to behave. | |
309 | ||
310 | SOD is a single-dispatch object system, like Smalltalk, C++, Python and so | |
311 | on, but unlike CLOS and Dylan. Behaviour is invoked by `sending messages' | |
312 | to objects. A message carries a name (distinguishing it from other | |
313 | messages recognized by the same class), and a number of arguments; the | |
314 | object may return a value in response. Sending a message therefore looks | |
315 | very much like calling a function; indeed, each message bears the static | |
316 | TYPE signature of a function. | |
317 | ||
318 | An object reacts to being sent a message by executing an `effective | |
319 | method', constructed from the direct methods defined on the recpient's | |
320 | (run-time, not necessarily statically-declared) class and its superclasses | |
321 | according to the message's `method combination'. | |
322 | ||
323 | Much interesting work is done by subclasses of SOD-MESSAGE, which (for | |
324 | example) specify method combinations. | |
325 | ||
326 | The slots are as follows. | |
327 | ||
328 | * The NAME distinguishes the message from others defined by the same | |
329 | class. Unlike most (all?) other object systems, messages defined in | |
330 | different classes are in distinct namespaces. It is forbidden for a | |
331 | message name to begin with an underscore, or to contain two | |
332 | consecutive underscores. (Final underscores are fine.) | |
333 | ||
334 | * The LOCATION states where in the user's source the slot was defined. | |
335 | It gets used in error messages. | |
336 | ||
337 | * The CLASS states which class defined the message. | |
338 | ||
339 | * The TYPE is a function type describing the message's arguments and | |
340 | return type. | |
341 | ||
342 | Subclasses can (and probably will) define additional slots.")) | |
343 | ||
1f1d88f5 MW |
344 | (defmethod print-object ((message sod-message) stream) |
345 | (maybe-print-unreadable-object (message stream :type t) | |
346 | (pprint-c-type (sod-message-type message) stream | |
347 | (format nil "~A.~A" | |
348 | (sod-class-nickname (sod-message-class message)) | |
349 | (sod-message-name message))))) | |
350 | ||
abdf50aa | 351 | (defclass sod-method () |
77027cca MW |
352 | ((message :initarg :message :type sod-message :reader sod-method-message) |
353 | (location :initarg :location :initform (file-location nil) | |
354 | :type file-location :reader file-location) | |
355 | (class :initarg :class :type sod-class :reader sod-method-class) | |
356 | (type :initarg :type :type c-function-type :reader sod-method-type) | |
357 | (body :initarg :body :type (or c-fragment null) :reader sod-method-body)) | |
abdf50aa MW |
358 | (:documentation |
359 | "(Direct) methods are units of behaviour. | |
360 | ||
361 | Methods are the unit of behaviour in SOD. Classes define direct methods | |
362 | for particular messages. | |
363 | ||
364 | When a message is received by an instance, all of the methods defined for | |
365 | that message on that instance's (run-time, not static) class and its | |
366 | superclasses are `applicable'. The applicable methods are gathered | |
367 | together and invoked in some way; the details of this are left to the | |
368 | `method combination', determined by the subclass of SOD-MESSAGE. | |
369 | ||
370 | The slots are as follows. | |
371 | ||
372 | * The MESSAGE describes which meessage invokes the method's behaviour. | |
373 | The method is combined with other methods on the same message | |
374 | according to the message's method combination, to form an `effective | |
375 | method'. | |
376 | ||
377 | * The LOCATION states where, in the user's source, the method was | |
378 | defined. This gets used in error messages. (Depending on the user's | |
379 | coding style, this location might be subtly different from the BODY's | |
380 | location.) | |
381 | ||
382 | * The CLASS specifies which class defined the method. This will be | |
383 | either the class of the message, or one of its descendents. | |
384 | ||
385 | * The TYPE gives the type of the method, including its arguments. This | |
386 | will, in general, differ from the type of the message for several | |
387 | reasons. | |
388 | ||
389 | -- Firstly, the method type must include names for all of the | |
390 | method's parameters. The message definition can omit the | |
391 | parameter names (in the same way as a function declaration can). | |
392 | Formally, the message definition can contain abstract | |
393 | declarators, whereas method definitions must not. | |
394 | ||
395 | -- Method combinations may require different parameter or return | |
396 | types. For example, `before' and `after' methods don't | |
397 | contribute to the message's return value, so they must be defined | |
398 | as returning `void'. | |
399 | ||
400 | -- Method combinations may permit methods whose parameter and/or | |
401 | return types don't exactly match the corresponding types of the | |
402 | message. For example, one might have methods with covariant | |
403 | return types and contravariant parameter types. (This sounds | |
404 | nice, but it doesn't actually seem like such a clever idea when | |
405 | you consider that the co-/contravariance must hold among all the | |
406 | applicable methods ordered according to the class precedence | |
407 | list. As a result, a user might have to work hard to build | |
408 | subclasses whose CPLs match the restrictions implied by the | |
409 | method types.) | |
410 | ||
411 | Method objects are fairly passive in the SOD translator. However, | |
412 | subclasses of SOD-MESSAGE may (and probably will) construct instances of | |
413 | subclasses of SOD-METHOD in order to carry the additional metadata they | |
414 | need to keep track of.")) | |
415 | ||
1f1d88f5 MW |
416 | (defmethod print-object ((method sod-method) stream) |
417 | (maybe-print-unreadable-object (method stream :type t) | |
418 | (format stream "~A ~@_~A" | |
419 | (sod-method-message method) | |
420 | (sod-method-class method)))) | |
abdf50aa MW |
421 | |
422 | ;;;-------------------------------------------------------------------------- | |
423 | ;;; Classes as C types. | |
424 | ||
425 | (defclass c-class-type (simple-c-type) | |
77027cca | 426 | ((class :initarg :class :type (or null sod-class) :accessor c-type-class)) |
abdf50aa MW |
427 | (:documentation |
428 | "A SOD class, as a C type. | |
429 | ||
430 | One usually handles classes as pointers, but the type refers to the actual | |
431 | instance structure itself. Or, in fact, just the primary chain of the | |
432 | instance (i.e., the one containing the class's own direct slots) -- which | |
433 | is why dealing with the instance structure directly doesn't make much | |
434 | sense. | |
435 | ||
436 | The CLASS slot will be NIL if the class isn't defined yet, i.e., this | |
437 | entry was constructed by a forward reference operation. | |
438 | ||
439 | The NAME slot inherited from SIMPLE-C-TYPE is here so that we can print | |
440 | the type even when it's a forward reference.")) | |
441 | ||
442 | (defmethod c-type-equal-p and ((type-a c-class-type) | |
443 | (type-b c-class-type)) | |
444 | (eql (c-type-class type-a) (c-type-class type-b))) | |
445 | ||
446 | (defmethod print-c-type (stream (type c-class-type) &optional colon atsign) | |
447 | (declare (ignore colon atsign)) | |
1f1d88f5 MW |
448 | (format stream "~:@<CLASS ~@_~S~{ ~_~S~}~:>" |
449 | (c-type-name type) | |
450 | (c-type-qualifiers type))) | |
abdf50aa MW |
451 | |
452 | (defun find-class-type (name &optional floc) | |
453 | "Look up NAME and return the corresponding C-CLASS-TYPE. | |
454 | ||
455 | Returns two values: TYPE and WINP. | |
456 | ||
457 | * If the type was found, and was a class, returns TYPE. | |
458 | ||
459 | * If no type was found at all, returns NIL. | |
460 | ||
461 | * If a type was found, but it wasn't a class, signals an error at FLOC." | |
462 | ||
463 | (with-default-error-location (floc) | |
464 | (let ((type (gethash name *type-map*))) | |
465 | (typecase type | |
466 | (null nil) | |
467 | (c-class-type type) | |
468 | (t (error "Type `~A' (~A) is not a class" name type)))))) | |
469 | ||
470 | (defun make-class-type (name &optional floc) | |
471 | "Return a class type for NAME, creating it if necessary. | |
472 | ||
473 | FLOC is the location to use in error reports." | |
1f1d88f5 MW |
474 | (let ((name (etypecase name |
475 | (sod-class (sod-class-name name)) | |
476 | (string name)))) | |
477 | (or (find-class-type name floc) | |
478 | (setf (gethash name *type-map*) | |
479 | (make-instance 'c-class-type :name name :class nil))))) | |
abdf50aa MW |
480 | |
481 | (defun find-sod-class (name &optional floc) | |
482 | "Return the SOD-CLASS object with the given NAME. | |
483 | ||
484 | FLOC is the location to use in error reports." | |
485 | (with-default-error-location (floc) | |
1f1d88f5 | 486 | (let ((type (find-class-type name floc))) |
abdf50aa MW |
487 | (cond ((not type) (error "Type `~A' not known" name)) |
488 | (t (let ((class (c-type-class type))) | |
489 | (unless class | |
490 | (error "Class `~A' is incomplete" name)) | |
491 | class)))))) | |
492 | ||
493 | (defun record-sod-class (class &optional (floc class)) | |
494 | "Record CLASS as being a class definition. | |
495 | ||
496 | FLOC is the location to use in error reports." | |
497 | (with-default-error-location (floc) | |
498 | (let* ((name (sod-class-name class)) | |
499 | (type (make-class-type name floc))) | |
500 | (cond ((null type) nil) | |
501 | ((c-type-class type) | |
502 | (cerror* "Class `~A' already defined at ~A" | |
503 | name (file-location (c-type-class type)))) | |
504 | (t | |
505 | (setf (c-type-class type) class)))))) | |
506 | ||
1f1d88f5 MW |
507 | (defun sod-class-type (class) |
508 | "Returns the C type corresponding to CLASS." | |
509 | (find-class-type (sod-class-name class))) | |
abdf50aa | 510 | |
1f1d88f5 MW |
511 | (define-c-type-syntax class (name &rest quals) |
512 | "Returns a type object for the named class." | |
513 | (if quals | |
514 | `(qualify-type (make-class-type ,name) (list ,@quals)) | |
515 | `(make-class-type ,name))) | |
abdf50aa MW |
516 | |
517 | ;;;----- That's all, folks -------------------------------------------------- |