| 1 | ;;; -*-lisp-*- |
| 2 | ;;; |
| 3 | ;;; Class definitions for main classes |
| 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 | ;;; Note! You'll notice that none of the classes defined here store property |
| 29 | ;;; sets persistently, even though there's a `:pset' keyword argument |
| 30 | ;;; accepted by many of the classes' initialization methods. That's because |
| 31 | ;;; part of the pset protocol involves checking that there are no unused |
| 32 | ;;; properties, and this typically happens shortly after the appropriate |
| 33 | ;;; objects are constructed. It would be tempting to stash the pset at |
| 34 | ;;; initialization time, and then pick some property from it out later -- but |
| 35 | ;;; that won't work in general because an error might have been signalled |
| 36 | ;;; about that property. It wouldn't surprise me greatly to discover that |
| 37 | ;;; `most' code paths resulted in the property being looked up in time to |
| 38 | ;;; avoid the unused-property error, but a subtle change in circumstances |
| 39 | ;;; then causes a thing done on demand to be done later, leading to |
| 40 | ;;; irritating and misleading errors being reported to the user. So please |
| 41 | ;;; don't do that. |
| 42 | |
| 43 | ;;;-------------------------------------------------------------------------- |
| 44 | ;;; Classes. |
| 45 | |
| 46 | (export '(sod-class sod-class-name sod-class-nickname |
| 47 | sod-class-type sod-class-metaclass |
| 48 | sod-class-direct-superclasses sod-class-precedence-list |
| 49 | sod-class-chain-link sod-class-chain-head |
| 50 | sod-class-chain sod-class-chains |
| 51 | sod-class-slots |
| 52 | sod-class-initargs sod-class-initfrags sod-class-tearfrags |
| 53 | sod-class-instance-initializers sod-class-class-initializers |
| 54 | sod-class-messages sod-class-methods |
| 55 | sod-class-state |
| 56 | sod-class-ilayout sod-class-effective-methods sod-class-vtables)) |
| 57 | (defclass sod-class () |
| 58 | ((name :initarg :name :type string :reader sod-class-name) |
| 59 | (location :initarg :location :initform (file-location nil) |
| 60 | :type file-location :reader file-location) |
| 61 | (nickname :initarg :nick :type string :reader sod-class-nickname) |
| 62 | (direct-superclasses :initarg :superclasses :type list |
| 63 | :reader sod-class-direct-superclasses) |
| 64 | (chain-link :initarg :link :type (or sod-class null) |
| 65 | :reader sod-class-chain-link) |
| 66 | (metaclass :initarg :metaclass :type sod-class |
| 67 | :reader sod-class-metaclass) |
| 68 | (slots :initarg :slots :initform nil |
| 69 | :type list :accessor sod-class-slots) |
| 70 | (instance-initializers :initarg :instance-initializers :initform nil |
| 71 | :type list |
| 72 | :accessor sod-class-instance-initializers) |
| 73 | (class-initializers :initarg :class-initializers :initform nil |
| 74 | :type list :accessor sod-class-class-initializers) |
| 75 | (initargs :initarg :initargs :initform nil |
| 76 | :type list :accessor sod-class-initargs) |
| 77 | (initfrags :initarg :initfrags :initform nil |
| 78 | :type list :accessor sod-class-initfrags) |
| 79 | (tearfrags :initarg :tearfrags :initform nil |
| 80 | :type list :accessor sod-class-tearfrags) |
| 81 | (messages :initarg :messages :initform nil |
| 82 | :type list :accessor sod-class-messages) |
| 83 | (methods :initarg :methods :initform nil |
| 84 | :type list :accessor sod-class-methods) |
| 85 | |
| 86 | (class-precedence-list :type list :reader sod-class-precedence-list) |
| 87 | |
| 88 | (%type :type c-class-type :reader sod-class-type) |
| 89 | |
| 90 | (chain-head :type sod-class :reader sod-class-chain-head) |
| 91 | (chain :type list :reader sod-class-chain) |
| 92 | (chains :type list :reader sod-class-chains) |
| 93 | |
| 94 | (%ilayout :type ilayout :reader sod-class-ilayout) |
| 95 | (effective-methods :type list :reader sod-class-effective-methods) |
| 96 | (vtables :type list :reader sod-class-vtables) |
| 97 | |
| 98 | (state :initform nil :type (member nil :finalized :broken) |
| 99 | :reader sod-class-state)) |
| 100 | (:documentation |
| 101 | "Classes describe the layout and behaviour of objects. |
| 102 | |
| 103 | The `name', `location', `nickname', `direct-superclasses', `chain-link' |
| 104 | and `metaclass' slots are intended to be initialized when the class object |
| 105 | is constructed: |
| 106 | |
| 107 | * The `name' is the identifier associated with the class in the user's |
| 108 | source file. It is used verbatim in the generated C code as a type |
| 109 | name, and must be distinct from other file-scope names in any source |
| 110 | file which includes the class definition. Furthermore, other names |
| 111 | are derived from the class name (most notably the class object |
| 112 | NAME__class), which have external linkage and must therefore be |
| 113 | distinct from all other identifiers in the program. It is forbidden |
| 114 | for a class `name' to begin with an underscore or to contain two |
| 115 | consecutive underscores. |
| 116 | |
| 117 | * The `location' identifies where in the source the class was defined. |
| 118 | It gets used in error messages. |
| 119 | |
| 120 | * The `nickname' is a shorter identifier used to name the class in some |
| 121 | circumstances. The uniqueness requirements on `nickname' are less |
| 122 | strict, which allows them to be shorter: no class may have two classes |
| 123 | with the same nickname on its class precedence list. Nicknames are |
| 124 | used (user-visibly) to distinguish slots and messages defined by |
| 125 | different classes, and (invisibly) in the derived names of direct |
| 126 | methods. It is forbidden for a nickname to begin with an underscore, |
| 127 | or to contain two consecutive underscores. |
| 128 | |
| 129 | * The `direct-superclasses' are a list of the class's direct |
| 130 | superclasses, in the order that they were declared in the source. The |
| 131 | class precedence list is computed from the `direct-superclasses' lists |
| 132 | of all of the superclasses involved. |
| 133 | |
| 134 | * The `chain-link' is either `nil' or one of the `direct-superclasses'. |
| 135 | Class chains are a means for recovering most of the benefits of simple |
| 136 | hierarchy lost by the introduction of multiple inheritance. A class's |
| 137 | superclasses (including itself) are partitioned into chains, |
| 138 | consisting of a class, its `chain-link' superclass, that class's |
| 139 | `chain-link', and so on. It is an error if two direct subclasses of |
| 140 | any class appear in the same chain (a global property which requires |
| 141 | global knowledge of an entire program's class hierarchy in order to |
| 142 | determine sensibly). Slots of superclasses in the same chain can be |
| 143 | accessed efficiently; there is an indirection needed to access slots |
| 144 | of superclasses in other chains. Furthermore, an indirection is |
| 145 | required to perform a cross-chain conversion (i.e., converting a |
| 146 | pointer to an instance of some class into a pointer to an instance of |
| 147 | one of its superclasses in a different chain), an operation which |
| 148 | occurs implicitly in effective methods in order to call direct methods |
| 149 | defined on cross-chain superclasses. |
| 150 | |
| 151 | * The `metaclass' is the class of the class object. Classes are objects |
| 152 | in their own right, and therefore must be instances of some class; |
| 153 | this class is the metaclass. Metaclasses can define additional slots |
| 154 | and methods to be provided by their instances; a class definition can |
| 155 | provide (C constant expression) initial values for the metaclass |
| 156 | instance. |
| 157 | |
| 158 | The next few slots can't usually be set at object-construction time, since |
| 159 | the objects need to contain references to the class object itself. |
| 160 | |
| 161 | * The `slots' are a list of the slots defined by the class (instances of |
| 162 | `sod-slot'). (The class will also define all of the slots defined by |
| 163 | its superclasses.) |
| 164 | |
| 165 | * The `instance-initializers' and `class-initializers' are lists of |
| 166 | initializers for slots (see `sod-initializer' and subclasses), |
| 167 | providing initial values for instances of the class, and for the |
| 168 | class's class object itself, respectively. |
| 169 | |
| 170 | * The `messages' are a list of the messages recognized by the class |
| 171 | (instances of `sod-message' and subclasses). (Note that the message |
| 172 | need not have any methods defined on it. The class will also |
| 173 | recognize all of the messages defined by its superclasses.) |
| 174 | |
| 175 | * The `methods' are a list of (direct) methods defined on the class |
| 176 | (instances of `sod-method' and subclasses). Each method provides |
| 177 | behaviour to be invoked by a particular message recognized by the |
| 178 | class. |
| 179 | |
| 180 | Other slots are computed from these in order to describe the class's |
| 181 | layout and effective methods; this is done by `finalize-sod-class'. |
| 182 | |
| 183 | * The `class-precedence-list' is a list of superclasses in a linear |
| 184 | order. It is computed by `compute-class-precedence-list', whose |
| 185 | default implementation ensures that the order of superclasses is such |
| 186 | that (a) subclasses appear before their superclasses; (b) the direct |
| 187 | superclasses of a given class appear in the order in which they were |
| 188 | declared by the programmer; and (c) classes always appear in the same |
| 189 | relative order in all class precedence lists in the same superclass |
| 190 | graph. |
| 191 | |
| 192 | * The `chain-head' is the least-specific class in the class's chain. If |
| 193 | there is no link class then the `chain-head' is the class itself. |
| 194 | This slot, like the next two, is computed by the generic function |
| 195 | `compute-chains'. |
| 196 | |
| 197 | * The `chain' is the list of classes on the complete primary chain, |
| 198 | starting from this class and ending with the `chain-head'. |
| 199 | |
| 200 | * The `chains' are the complete collection of chains (most-to-least |
| 201 | specific) for the class and all of its superclasses. |
| 202 | |
| 203 | Finally, slots concerning the instance and vtable layout of the class are |
| 204 | computed on demand (see `define-on-demand-slot'). |
| 205 | |
| 206 | * The `ilayout' describes the layout for an instance of the class. It's |
| 207 | quite complicated; see the documentation of the `ilayout' class for |
| 208 | detais. |
| 209 | |
| 210 | * The `effective-methods' are a list of effective methods, specialized |
| 211 | for the class. |
| 212 | |
| 213 | * The `vtables' are a list of descriptions of vtables for the class. |
| 214 | The individual elements are `vtable' objects, which are even more |
| 215 | complicated than `ilayout' structures. See the class documentation |
| 216 | for details.")) |
| 217 | |
| 218 | (defmethod print-object ((class sod-class) stream) |
| 219 | (maybe-print-unreadable-object (class stream :type t) |
| 220 | (princ (sod-class-name class) stream))) |
| 221 | |
| 222 | ;;;-------------------------------------------------------------------------- |
| 223 | ;;; Slots and initializers. |
| 224 | |
| 225 | (export '(sod-slot sod-slot-name sod-slot-class sod-slot-type)) |
| 226 | (defclass sod-slot () |
| 227 | ((name :initarg :name :type string :reader sod-slot-name) |
| 228 | (location :initarg :location :initform (file-location nil) |
| 229 | :type file-location :reader file-location) |
| 230 | (%class :initarg :class :type sod-class :reader sod-slot-class) |
| 231 | (%type :initarg :type :type c-type :reader sod-slot-type)) |
| 232 | (:documentation |
| 233 | "Slots are units of information storage in instances. |
| 234 | |
| 235 | Each class defines a number of slots, which function similarly to (data) |
| 236 | members in structures. An instance contains all of the slots defined in |
| 237 | its class and all of its superclasses. |
| 238 | |
| 239 | A slot carries the following information. |
| 240 | |
| 241 | * A `name', which distinguishes it from other slots defined by the same |
| 242 | class. Unlike most (all?) other object systems, slots defined in |
| 243 | different classes are in distinct namespaces. There are no special |
| 244 | restrictions on slot names. |
| 245 | |
| 246 | * A `location', which states where in the user's source the slot was |
| 247 | defined. This gets used in error messages. |
| 248 | |
| 249 | * A `class', which states which class defined the slot. The slot is |
| 250 | available in instances of this class and all of its descendents. |
| 251 | |
| 252 | * A `type', which is the C type of the slot. This must be an object |
| 253 | type (certainly not a function type, and it must be a complete type by |
| 254 | the time that the user header code has been scanned).")) |
| 255 | |
| 256 | (defmethod print-object ((slot sod-slot) stream) |
| 257 | (maybe-print-unreadable-object (slot stream :type t) |
| 258 | (pprint-c-type (sod-slot-type slot) stream |
| 259 | (format nil "~A.~A" |
| 260 | (sod-class-nickname (sod-slot-class slot)) |
| 261 | (sod-slot-name slot))))) |
| 262 | |
| 263 | (export '(sod-initializer sod-initializer-slot sod-initializer-class |
| 264 | sod-initializer-value)) |
| 265 | (defclass sod-initializer () |
| 266 | ((slot :initarg :slot :type sod-slot :reader sod-initializer-slot) |
| 267 | (location :initarg :location :initform (file-location nil) |
| 268 | :type file-location :reader file-location) |
| 269 | (%class :initarg :class :type sod-class :reader sod-initializer-class) |
| 270 | (value :initarg :value :type c-fragment :reader sod-initializer-value)) |
| 271 | (:documentation |
| 272 | "Provides an initial value for a slot. |
| 273 | |
| 274 | The slots of an initializer are as follows. |
| 275 | |
| 276 | * The `slot' specifies which slot this initializer is meant to |
| 277 | initialize. |
| 278 | |
| 279 | * The `location' states the position in the user's source file where the |
| 280 | initializer was found. This gets used in error messages. (Depending |
| 281 | on the source layout style, this might differ from the location in the |
| 282 | `value' C fragment.) |
| 283 | |
| 284 | * The `class' states which class defined this initializer. For instance |
| 285 | slot initializers (`sod-instance-initializer'), this will be the same |
| 286 | as the `slot''s class, or be one of its descendants. For class slot |
| 287 | initializers (`sod-class-initializer'), this will be an instance of |
| 288 | the `slot''s class, or an instance of one of its descendants. |
| 289 | |
| 290 | * The `value' gives the text of the initializer, as a C fragment. |
| 291 | |
| 292 | Typically you'll see instances of subclasses of this class in the wild |
| 293 | rather than instances of this class directly. See `sod-class-initializer' |
| 294 | and `sod-instance-initializer'.")) |
| 295 | |
| 296 | (defmethod print-object ((initializer sod-initializer) stream) |
| 297 | (with-slots (slot value) initializer |
| 298 | (if *print-escape* |
| 299 | (print-unreadable-object (initializer stream :type t) |
| 300 | (format stream "~A = ~A" slot value)) |
| 301 | (format stream "~A" value)))) |
| 302 | |
| 303 | (export 'sod-class-initializer) |
| 304 | (defclass sod-class-initializer (sod-initializer) |
| 305 | () |
| 306 | (:documentation |
| 307 | "Provides an initial value for a class slot. |
| 308 | |
| 309 | A class slot initializer provides an initial value for a slot in the class |
| 310 | object (i.e., one of the slots defined by the class's metaclass). Its |
| 311 | VALUE must have the syntax of an initializer, and its consituent |
| 312 | expressions must be constant expressions. |
| 313 | |
| 314 | See `sod-initializer' for more details.")) |
| 315 | |
| 316 | (export 'sod-instance-initializer) |
| 317 | (defclass sod-instance-initializer (sod-initializer) |
| 318 | () |
| 319 | (:documentation |
| 320 | "Provides an initial value for a slot in all instances. |
| 321 | |
| 322 | An instance slot initializer provides an initial value for a slot in |
| 323 | instances of the class. Its `value' must have the syntax of an |
| 324 | initializer. Furthermore, if the slot has aggregate type, then you'd |
| 325 | better be sure that your compiler supports compound literals (6.5.2.5) |
| 326 | because that's what the initializer gets turned into. |
| 327 | |
| 328 | See `sod-initializer' for more details.")) |
| 329 | |
| 330 | (export '(sod-initarg |
| 331 | sod-initarg-class sod-initarg-name sod-initarg-type)) |
| 332 | (defclass sod-initarg () |
| 333 | ((%class :initarg :class :type sod-class :reader sod-initarg-class) |
| 334 | (location :initarg :location :initform (file-location nil) |
| 335 | :type file-location :reader file-location) |
| 336 | (name :initarg :name :type string :reader sod-initarg-name) |
| 337 | (%type :initarg :type :type c-type :reader sod-initarg-type)) |
| 338 | (:documentation |
| 339 | "Describes a keyword argument accepted by the initialization function.")) |
| 340 | |
| 341 | (export '(sod-user-initarg sod-initarg-default)) |
| 342 | (defclass sod-user-initarg (sod-initarg) |
| 343 | ((default :initarg :default :type t :reader sod-initarg-default)) |
| 344 | (:documentation |
| 345 | "Describes an initialization argument defined by the user.")) |
| 346 | |
| 347 | (defmethod print-object ((initarg sod-user-initarg) stream) |
| 348 | (maybe-print-unreadable-object (initarg stream :type t) |
| 349 | (pprint-c-type (sod-initarg-type initarg) stream |
| 350 | (sod-initarg-name initarg)) |
| 351 | (awhen (sod-initarg-default initarg) |
| 352 | (format stream " = ~A" it)))) |
| 353 | |
| 354 | (export '(sod-slot-initarg sod-initarg-slot)) |
| 355 | (defclass sod-slot-initarg (sod-initarg) |
| 356 | ((slot :initarg :slot :type sod-slot :reader sod-initarg-slot)) |
| 357 | (:documentation |
| 358 | "Describes an initialization argument used to initialize a slot.")) |
| 359 | |
| 360 | (defmethod print-object ((initarg sod-slot-initarg) stream) |
| 361 | (maybe-print-unreadable-object (initarg stream :type t) |
| 362 | (pprint-c-type (sod-initarg-type initarg) stream |
| 363 | (sod-initarg-name initarg)) |
| 364 | (format stream " for ~A" (sod-initarg-slot initarg)))) |
| 365 | |
| 366 | ;;;-------------------------------------------------------------------------- |
| 367 | ;;; Messages and methods. |
| 368 | |
| 369 | (export '(sod-message sod-message-name sod-message-readonly-p |
| 370 | sod-message-class sod-message-type)) |
| 371 | (defclass sod-message () |
| 372 | ((name :initarg :name :type string :reader sod-message-name) |
| 373 | (location :initarg :location :initform (file-location nil) |
| 374 | :type file-location :reader file-location) |
| 375 | (readonlyp :initarg :readonly :initform nil :type t |
| 376 | :reader sod-message-readonly-p) |
| 377 | (%class :initarg :class :type sod-class :reader sod-message-class) |
| 378 | (%type :initarg :type :type c-function-type :reader sod-message-type)) |
| 379 | (:documentation |
| 380 | "Messages are the means for stimulating an object to behave. |
| 381 | |
| 382 | SOD is a single-dispatch object system, like Smalltalk, C++, Python and so |
| 383 | on, but unlike CLOS and Dylan. Behaviour is invoked by `sending messages' |
| 384 | to objects. A message carries a name (distinguishing it from other |
| 385 | messages recognized by the same class), and a number of arguments; the |
| 386 | object may return a value in response. Sending a message therefore looks |
| 387 | very much like calling a function; indeed, each message bears the static |
| 388 | TYPE signature of a function. |
| 389 | |
| 390 | An object reacts to being sent a message by executing an `effective |
| 391 | method', constructed from the direct methods defined on the recpient's |
| 392 | (run-time, not necessarily statically-declared) class and its superclasses |
| 393 | according to the message's `method combination'. |
| 394 | |
| 395 | Much interesting work is done by subclasses of `sod-message', which (for |
| 396 | example) specify method combinations. |
| 397 | |
| 398 | The slots are as follows. |
| 399 | |
| 400 | * The `name' distinguishes the message from others defined by the same |
| 401 | class. Unlike most (all?) other object systems, messages defined in |
| 402 | different classes are in distinct namespaces. It is forbidden for a |
| 403 | message name to begin with an underscore, or to contain two |
| 404 | consecutive underscores. (Final underscores are fine.) |
| 405 | |
| 406 | * The `location' states where in the user's source the slot was defined. |
| 407 | It gets used in error messages. |
| 408 | |
| 409 | * The `readonly' flag indicates whether the message receiver can modify |
| 410 | itself in response to this message. If set, the receiver will be |
| 411 | declared `const'. |
| 412 | |
| 413 | * The `class' states which class defined the message. |
| 414 | |
| 415 | * The `type' is a function type describing the message's arguments and |
| 416 | return type. |
| 417 | |
| 418 | Subclasses can (and probably will) define additional slots.")) |
| 419 | |
| 420 | (defmethod print-object ((message sod-message) stream) |
| 421 | (maybe-print-unreadable-object (message stream :type t) |
| 422 | (pprint-c-type (sod-message-type message) stream |
| 423 | (format nil "~A.~A" |
| 424 | (sod-class-nickname (sod-message-class message)) |
| 425 | (sod-message-name message))))) |
| 426 | |
| 427 | (export '(sod-method sod-method-message sod-method-class sod-method-type |
| 428 | sod-method-body)) |
| 429 | (defclass sod-method () |
| 430 | ((message :initarg :message :type sod-message :reader sod-method-message) |
| 431 | (location :initarg :location :initform (file-location nil) |
| 432 | :type file-location :reader file-location) |
| 433 | (%class :initarg :class :type sod-class :reader sod-method-class) |
| 434 | (%type :initarg :type :type c-function-type :reader sod-method-type) |
| 435 | (body :initarg :body :type (or c-fragment null) :reader sod-method-body)) |
| 436 | (:documentation |
| 437 | "(Direct) methods are units of behaviour. |
| 438 | |
| 439 | Methods are the unit of behaviour in SOD. Classes define direct methods |
| 440 | for particular messages. |
| 441 | |
| 442 | When a message is received by an instance, all of the methods defined for |
| 443 | that message on that instance's (run-time, not static) class and its |
| 444 | superclasses are `applicable'. The applicable methods are gathered |
| 445 | together and invoked in some way; the details of this are left to the |
| 446 | `method combination', determined by the subclass of `sod-message'. |
| 447 | |
| 448 | The slots are as follows. |
| 449 | |
| 450 | * The `message' describes which meessage invokes the method's behaviour. |
| 451 | The method is combined with other methods on the same message |
| 452 | according to the message's method combination, to form an `effective |
| 453 | method'. |
| 454 | |
| 455 | * The `location' states where, in the user's source, the method was |
| 456 | defined. This gets used in error messages. (Depending on the user's |
| 457 | coding style, this location might be subtly different from the |
| 458 | `body''s location.) |
| 459 | |
| 460 | * The `class' specifies which class defined the method. This will be |
| 461 | either the class of the message, or one of its descendents. |
| 462 | |
| 463 | * The `type' gives the type of the method, including its arguments. |
| 464 | This will, in general, differ from the type of the message for several |
| 465 | reasons. |
| 466 | |
| 467 | -- The method type must include names for all of the method's |
| 468 | parameters. The message definition can omit the parameter |
| 469 | names (in the same way as a function declaration can). Formally, |
| 470 | the message definition can contain abstract declarators, whereas |
| 471 | method definitions must not. |
| 472 | |
| 473 | -- Method combinations may require different parameter or return |
| 474 | types. For example, `before' and `after' methods don't |
| 475 | contribute to the message's return value, so they must be defined |
| 476 | as returning `void'. |
| 477 | |
| 478 | -- Method combinations may permit methods whose parameter and/or |
| 479 | return types don't exactly match the corresponding types of the |
| 480 | message. For example, one might have methods with covariant |
| 481 | return types and contravariant parameter types. (This sounds |
| 482 | nice, but it doesn't actually seem like such a clever idea when |
| 483 | you consider that the co-/contravariance must hold among all the |
| 484 | applicable methods ordered according to the class precedence |
| 485 | list. As a result, a user might have to work hard to build |
| 486 | subclasses whose CPLs match the restrictions implied by the |
| 487 | method types.) |
| 488 | |
| 489 | Method objects are fairly passive in the SOD translator. However, |
| 490 | subclasses of `sod-message' may (and probably will) construct instances of |
| 491 | subclasses of `sod-method' in order to carry the additional metadata they |
| 492 | need to keep track of.")) |
| 493 | |
| 494 | (defmethod print-object ((method sod-method) stream) |
| 495 | (maybe-print-unreadable-object (method stream :type t) |
| 496 | (format stream "~A ~@_~A" |
| 497 | (sod-method-message method) |
| 498 | (sod-method-class method)))) |
| 499 | |
| 500 | ;;;-------------------------------------------------------------------------- |
| 501 | ;;; Instances. |
| 502 | |
| 503 | (export '(static-instance static-instance-name static-instance-extern-p |
| 504 | static-instance-const-p static-instance-class |
| 505 | static-instance-initializers)) |
| 506 | (defclass static-instance () |
| 507 | ((name :initarg :name :type string :reader static-instance-name) |
| 508 | (location :initarg :location :initform (file-location nil) |
| 509 | :type file-location :reader file-location) |
| 510 | (externp :initarg :extern :initform nil :type t |
| 511 | :reader static-instance-extern-p) |
| 512 | (constp :initarg :const :initform t :type t |
| 513 | :reader static-instance-const-p) |
| 514 | (%class :initarg :class :type sod-class :reader static-instance-class) |
| 515 | (initializers :initarg :initializers :initform nil |
| 516 | :type list :accessor static-instance-initializers)) |
| 517 | (:documentation |
| 518 | "A static instance is a class instance built at (C) compile time. |
| 519 | |
| 520 | The slots are as follows. |
| 521 | |
| 522 | * The `name' gives the C identifier naming the instance, as a string. |
| 523 | |
| 524 | * The `externp' flag is non-nil if the instance is to be visible outside |
| 525 | of the translation unit. |
| 526 | |
| 527 | * The `location' states where, in the user's source, the instance was |
| 528 | defined. This gets used in error messages. |
| 529 | |
| 530 | * The `class' specifies the class of the instance to construct. |
| 531 | |
| 532 | * The `initializers' are a list of `sod-instance-initializer' objects |
| 533 | which override any existing slot initializers defined on the class.")) |
| 534 | |
| 535 | (defmethod print-object ((instance static-instance) stream) |
| 536 | (with-slots (name (class %class) externp constp initializers) instance |
| 537 | (maybe-print-unreadable-object (instance stream :type t) |
| 538 | (format stream "~:[~;extern ~@_~]~:[~;const ~@_~]~A ~@_~A" |
| 539 | externp constp class name) |
| 540 | (when initializers |
| 541 | (princ ": " stream) |
| 542 | (pprint-indent :block 2 stream) |
| 543 | (let ((first t)) |
| 544 | (dolist (init initializers) |
| 545 | (if first (setf first nil) (princ ", ")) |
| 546 | (pprint-newline :linear stream) |
| 547 | (with-slots (slot (super %class) value) init |
| 548 | (format stream "~@<~A.~A = ~2I~@_~A~:>" |
| 549 | (sod-class-nickname super) |
| 550 | (sod-slot-name slot) |
| 551 | value)))))))) |
| 552 | |
| 553 | ;;;----- That's all, folks -------------------------------------------------- |