src/class-finalize-impl.lisp: Move error reporting to `merge-class-lists'.
[sod] / src / class-finalize-impl.lisp
CommitLineData
abdf50aa
MW
1;;; -*-lisp-*-
2;;;
dea4d055 3;;; Class finalization implementation
abdf50aa
MW
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.
abdf50aa
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;;;--------------------------------------------------------------------------
dea4d055 29;;; Class precedence lists.
abdf50aa 30
dea4d055
MW
31;; Just for fun, we implement a wide selection of precedence list algorithms.
32;; C3 seems to be clearly the best, with fewer sharp edges for the unwary.
abdf50aa
MW
33;;
34;; The extended precedence graph (EPG) is constructed by adding edges to the
35;; superclass graph. If A and B are classes, then write A < B if A is a
36;; (maybe indirect) subclass of B. For every two classes A and B, and for
37;; every /maximal/ subclass of both A and B (i.e., every C for which C < A
38;; and C < B, but there does not exist D such that D < A, D < B and C < D):
39;; if A precedes B in C's direct superclass list, then draw an edge A -> B,
40;; otherwise draw the edge B -> A.
41;;
42;; A linearization respects the EPG if, whenever A precedes B in the
43;; linearization, there is a path from A to B. The EPG can be cyclic; in
44;; that case, we don't care which order the classes in the cycle are
45;; linearized.
46;;
47;; See Barrett, Cassels, Haahr, Moon, Playford, Withington, `A Monotonic
48;; Superclass Linearization for Dylan' for more detail.
49;; http://www.webcom.com/haahr/dylan/linearization-oopsla96.html
50
e2838dc5
MW
51;;; Utilities.
52
53(export 'merge-class-lists)
c05ed0f1
MW
54(defun merge-class-lists (class lists pick)
55 "Merge the LISTS of subclasses of CLASS, using PICK to break ties.
e2838dc5
MW
56
57 This is a convenience wrapper around the main `merge-lists' function.
58 Given that class linearizations (almost?) always specify a custom
c05a4977 59 tiebreaker function, this isn't a keyword argument."
c05ed0f1
MW
60 (handler-case (merge-lists lists :pick pick)
61 (inconsistent-merge-error ()
62 (error "Failed to compute class precedence list for `~A'"
63 (sod-class-name class)))))
e2838dc5 64
dea4d055
MW
65;;; Tiebreaker functions.
66
abdf50aa
MW
67(defun clos-tiebreaker (candidates so-far)
68 "The CLOS linearization tiebreaker function.
69
bf090e02
MW
70 Intended for use with `merge-lists'. Returns the member of CANDIDATES
71 which has a direct subclass furthest to the right in the list SO-FAR.
abdf50aa
MW
72
73 This must disambiguate. The SO-FAR list cannot be empty, since the class
74 under construction precedes all of the others. If two classes share a
75 direct subclass then that subclass's direct superclasses list must order
76 them relative to each other."
77
566c6a6a
MW
78 (dolist (class so-far)
79 (dolist (candidate candidates)
80 (when (member candidate (sod-class-direct-superclasses class))
81 (return-from clos-tiebreaker candidate))))
82 (error "SOD INTERNAL ERROR: Failed to break tie in CLOS"))
abdf50aa 83
dea4d055
MW
84(defun c3-tiebreaker (candidates cpls)
85 "The C3 linearization tiebreaker function.
86
bf090e02
MW
87 Intended for use with `merge-lists'. Returns the member of CANDIDATES
88 which appears in the earliest element of CPLS, which should be the list of
89 the class precedence lists of the direct superclasses of the class in
dea4d055
MW
90 question, in the order specified in the class declaration.
91
92 The only class in the class precedence list which does not appear in one
93 of these lists is the new class itself, which must precede all of the
94 others.
95
96 This must disambiguate, since if two classes are in the same class
97 precedence list, then one must appear in it before the other, which
98 provides an ordering between them. (In this situation we return the one
99 that matches earliest anyway, which would still give the right answer.)
100
101 Note that this will merge the CPLs of superclasses /as they are/, not
102 necessarily as C3 would have computed them. This ensures monotonicity
103 assuming that the superclass CPLs are already monotonic. If they aren't,
104 you're going to lose anyway."
105
106 (dolist (cpl cpls)
107 (dolist (candidate candidates)
108 (when (member candidate cpl)
109 (return-from c3-tiebreaker candidate))))
a1985b3c 110 (error "SOD INTERNAL ERROR: Failed to break tie in C3"))
dea4d055
MW
111
112;;; Linearization functions.
113
11e41ddf 114(export 'clos-cpl)
abdf50aa
MW
115(defun clos-cpl (class)
116 "Compute the class precedence list of CLASS using CLOS linearization rules.
117
118 We merge the direct-superclass lists of all of CLASS's superclasses,
bf090e02 119 disambiguating using `clos-tiebreaker'.
abdf50aa
MW
120
121 The CLOS linearization preserves local class ordering, but is not
122 monotonic, and does not respect the extended precedence graph. CLOS
123 linearization will succeed whenever Dylan or C3 linearization succeeds;
124 the converse is not true."
125
126 (labels ((superclasses (class)
127 (let ((direct-supers (sod-class-direct-superclasses class)))
128 (remove-duplicates (cons class
1f1d88f5
MW
129 (mappend #'superclasses
130 direct-supers))))))
c05ed0f1
MW
131 (merge-class-lists class
132 (mapcar (lambda (c)
5d55bdaa
MW
133 (cons c (sod-class-direct-superclasses c)))
134 (superclasses class))
135 #'clos-tiebreaker)))
abdf50aa 136
11e41ddf 137(export 'dylan-cpl)
abdf50aa
MW
138(defun dylan-cpl (class)
139 "Compute the class precedence list of CLASS using Dylan linearization
140 rules.
141
142 We merge the direct-superclass list of CLASS with the full class
143 precedence lists of its direct superclasses, disambiguating using
bf090e02 144 `clos-tiebreaker'. (Inductively, these lists will be consistent with the
abdf50aa
MW
145 CPLs of indirect superclasses, since those CPLs' orderings are reflected
146 in the CPLs of the direct superclasses.)
147
148 The Dylan linearization preserves local class ordering and is monotonic,
149 but does not respect the extended precedence graph.
150
151 Note that this will merge the CPLs of superclasses /as they are/, not
152 necessarily as Dylan would have computed them. This ensures monotonicity
153 assuming that the superclass CPLs are already monotonic. If they aren't,
154 you're going to lose anyway."
155
5d55bdaa
MW
156 (let* ((direct-supers (sod-class-direct-superclasses class))
157 (cpls (mapcar #'sod-class-precedence-list direct-supers)))
c05ed0f1
MW
158 (merge-class-lists class
159 (cons (cons class direct-supers) cpls)
5d55bdaa 160 #'clos-tiebreaker)))
abdf50aa 161
11e41ddf 162(export 'c3-cpl)
abdf50aa
MW
163(defun c3-cpl (class)
164 "Compute the class precedence list of CLASS using C3 linearization rules.
165
166 We merge the direct-superclass list of CLASS with the full class
167 precedence lists of its direct superclasses, disambiguating using
bf090e02 168 `c3-tiebreaker'.
abdf50aa
MW
169
170 The C3 linearization preserves local class ordering, is monotonic, and
171 respects the extended precedence graph. It is the linearization used in
172 Python, Perl 6 and other languages. It is the recommended linearization
173 for SOD."
174
175 (let* ((direct-supers (sod-class-direct-superclasses class))
176 (cpls (mapcar #'sod-class-precedence-list direct-supers)))
c05ed0f1
MW
177 (merge-class-lists class
178 (cons (cons class direct-supers) cpls)
e2838dc5 179 (lambda (candidates so-far)
abdf50aa
MW
180 (declare (ignore so-far))
181 (c3-tiebreaker candidates cpls)))))
182
11e41ddf 183(export 'flavors-cpl)
abdf50aa
MW
184(defun flavors-cpl (class)
185 "Compute the class precedence list of CLASS using Flavors linearization
186 rules.
187
188 We do a depth-first traversal of the superclass graph, ignoring duplicates
189 of classes we've already visited. Interestingly, this has the property of
190 being able to tolerate cyclic superclass graphs, though defining cyclic
191 graphs is syntactically impossible in SOD.
192
193 This linearization has few other redeeming features, however. In
194 particular, the top class tends not to be at the end of the CPL, despite
195 it being unequivocally less specific than any other class."
196
197 (let ((done nil))
198 (labels ((walk (class)
199 (unless (member class done)
200 (push class done)
201 (dolist (super (sod-class-direct-superclasses class))
202 (walk super)))))
203 (walk class)
204 (nreverse done))))
205
11e41ddf 206(export 'python-cpl)
abdf50aa
MW
207(defun python-cpl (class)
208 "Compute the class precedence list of CLASS using the documented Python 2.2
209 linearization rules.
210
211 We do a depth-first traversal of the superclass graph, retaining only the
212 last occurrence of each class visited.
213
214 This linearization has few redeeming features. It was never actually
215 implemented; the true Python 2.2 linearization seems closer to (but
216 different from) L*LOOPS."
217
218 (let ((done nil))
219 (labels ((walk (class)
220 (push class done)
221 (dolist (super (sod-class-direct-superclasses class))
222 (walk super))))
223 (walk class)
224 (delete-duplicates (nreverse done)))))
225
11e41ddf 226(export 'l*loops-cpl)
abdf50aa
MW
227(defun l*loops-cpl (class)
228 "Compute the class precedence list of CLASS using L*LOOPS linearization
229 rules.
230
231 We merge the class precedence lists of the direct superclasses of CLASS,
232 disambiguating by choosing the earliest candidate which appears in a
233 depth-first walk of the superclass graph.
234
235 The L*LOOPS rules are monotonic and respect the extended precedence
236 graph. However (unlike Dylan and CLOS) they don't respect local
237 precedence order i.e., the direct-superclasses list orderings."
238
239 (let ((dfs (flavors-cpl class)))
e2838dc5 240 (cons class
c05ed0f1
MW
241 (merge-class-lists class
242 (mapcar #'sod-class-precedence-list
abdf50aa 243 (sod-class-direct-superclasses class))
e2838dc5
MW
244 (lambda (candidates so-far)
245 (declare (ignore so-far))
246 (dolist (class dfs)
247 (when (member class candidates)
248 (return class))))))))
abdf50aa 249
dea4d055 250;;; Default function.
abdf50aa
MW
251
252(defmethod compute-cpl ((class sod-class))
c05ed0f1 253 (c3-cpl class))
abdf50aa
MW
254
255;;;--------------------------------------------------------------------------
dea4d055
MW
256;;; Chains.
257
258(defmethod compute-chains ((class sod-class))
259 (with-default-error-location (class)
260 (with-slots (chain-link class-precedence-list) class
261 (let* ((head (if chain-link
262 (sod-class-chain-head chain-link)
263 class))
264 (chain (cons class (and chain-link
265 (sod-class-chain chain-link))))
ab7e7521 266 (state (make-inheritance-path-reporter-state class))
dea4d055
MW
267 (table (make-hash-table)))
268
269 ;; Check the chains. We work through each superclass, maintaining a
270 ;; hash table keyed by class. If we encounter a class C which links
271 ;; to L, then we store C as L's value; if L already has a value then
272 ;; we've found an error. By the end of all of this, the classes
273 ;; which don't have an entry are the chain tails.
274 (dolist (super class-precedence-list)
ab7e7521
MW
275 (let* ((link (sod-class-chain-link super))
276 (found (and link (gethash link table))))
277 (cond ((not found) (setf (gethash link table) super))
278 (t
279 (cerror* "Conflicting chains in class `~A': ~
280 (`~A' and `~A' both link to `~A')"
281 class super found link)
282 (report-inheritance-path state super)
283 (report-inheritance-path state found)))))
dea4d055
MW
284
285 ;; Done.
286 (values head chain
287 (cons chain
288 (mapcar #'sod-class-chain
289 (remove-if (lambda (super)
290 (gethash super table))
291 (cdr class-precedence-list)))))))))
292
293;;;--------------------------------------------------------------------------
981b6fb6
MW
294;;; Metaclasses.
295
981b6fb6
MW
296(defmethod guess-metaclass ((class sod-class))
297 "Default metaclass-guessing function for classes.
298
299 Return the most specific metaclass of any of the CLASS's direct
300 superclasses."
301
302 ;; During bootstrapping, our superclasses might not have their own
303 ;; metaclasses resolved yet. If we find this, then throw `bootstrapping'
304 ;; so that `shared-initialize' on `sod-class' can catch it (or as a shot
305 ;; across the bows of anyone else who calls us).
e45a106d
MW
306 (finalization-error (:bad-metaclass)
307 (select-minimal-class-property (sod-class-direct-superclasses class)
308 (lambda (super)
309 (if (slot-boundp super 'metaclass)
310 (slot-value super 'metaclass)
311 (throw 'bootstrapping nil)))
312 #'sod-subclass-p class "metaclass")))
981b6fb6
MW
313
314;;;--------------------------------------------------------------------------
dea4d055
MW
315;;; Sanity checking.
316
317(defmethod check-sod-class ((class sod-class))
318 (with-default-error-location (class)
319
320 ;; Check the names of things are valid.
ab7e7521
MW
321 (flet ((check-list (list what namefunc)
322 (dolist (item list)
323 (let ((name (funcall namefunc item)))
324 (unless (valid-name-p name)
325 (cerror*-with-location item
326 "Invalid ~A name `~A' ~
327 in class `~A'"
328 what name class))))))
329 (unless (valid-name-p (sod-class-name class))
330 (cerror* "Invalid class name `~A'" class))
331 (unless (valid-name-p (sod-class-nickname class))
332 (cerror* "Invalid class nickname `~A' for class `~A'"
333 (sod-class-nickname class) class))
334 (check-list (sod-class-messages class) "message" #'sod-message-name)
335 (check-list (sod-class-slots class) "slot" #'sod-slot-name))
336
337 ;; Check that the class doesn't define conflicting things.
338 (labels ((check-list (list keyfunc complain)
339 (let ((seen (make-hash-table :test #'equal)))
dea4d055 340 (dolist (item list)
ab7e7521
MW
341 (let* ((key (funcall keyfunc item))
342 (found (gethash key seen)))
343 (if found (funcall complain item found)
344 (setf (gethash key seen) item))))))
345 (simple-previous (previous)
346 (info-with-location previous "Previous definition was here"))
347 (simple-complain (what namefunc)
348 (lambda (item previous)
349 (cerror*-with-location item
350 "Duplicate ~A `~A' in class `~A'"
351 what (funcall namefunc item) class)
352 (simple-previous previous))))
353
354 ;; Make sure direct slots have distinct names.
355 (check-list (sod-class-slots class) #'sod-slot-name
356 (simple-complain "slot name" #'sod-slot-name))
357
358 ;; Make sure there's at most one initializer for each slot.
359 (flet ((check-initializer-list (list kind)
360 (check-list list #'sod-initializer-slot
361 (lambda (initializer previous)
362 (let ((slot
363 (sod-initializer-slot initializer)))
364 (cerror*-with-location initializer
365 "Duplicate ~
366 initializer for ~
367 ~A slot `~A' ~
368 in class `~A'"
369 kind slot class)
370 (simple-previous previous))))))
371 (check-initializer-list (sod-class-instance-initializers class)
372 "instance")
373 (check-initializer-list (sod-class-class-initializers class)
374 "class"))
375
376 ;; Make sure messages have distinct names.
377 (check-list (sod-class-messages class) #'sod-message-name
378 (simple-complain "message name" #'sod-message-name))
379
380 ;; Make sure methods are sufficiently distinct.
381 (check-list (sod-class-methods class) #'sod-method-function-name
382 (lambda (method previous)
383 (cerror*-with-location method
384 "Duplicate ~A direct method ~
385 for message `~A' ~
386 in classs `~A'"
387 (sod-method-description method)
388 (sod-method-message method)
389 class)
390 (simple-previous previous)))
391
392 ;; Make sure superclasses have distinct nicknames.
393 (let ((state (make-inheritance-path-reporter-state class)))
394 (check-list (sod-class-precedence-list class) #'sod-class-nickname
395 (lambda (super previous)
396 (cerror*-with-location class
397 "Duplicate nickname `~A' ~
398 in superclasses of `~A': ~
399 used by `~A' and `~A'"
400 (sod-class-nickname super)
401 class super previous)
402 (report-inheritance-path state super)
403 (report-inheritance-path state previous)))))
dea4d055
MW
404
405 ;; Check that the CHAIN-TO class is actually a proper superclass. (This
406 ;; eliminates hairy things like a class being its own link.)
ab7e7521
MW
407 (let ((link (sod-class-chain-link class)))
408 (unless (or (not link)
409 (member link (cdr (sod-class-precedence-list class))))
410 (cerror* "In `~A~, chain-to class `~A' is not a proper superclass"
411 class link)))
dea4d055 412
b2983f35
MW
413 ;; Check that the initargs declare compatible types. Duplicate entries,
414 ;; even within a class, are harmless, but at most one initarg in any
415 ;; class should declare a default value.
ab7e7521
MW
416 (let ((seen (make-hash-table :test #'equal))
417 (state (make-inheritance-path-reporter-state class)))
418 (dolist (super (sod-class-precedence-list class))
419 (dolist (initarg (reverse (sod-class-initargs super)))
420 (let* ((initarg-name (sod-initarg-name initarg))
421 (initarg-type (sod-initarg-type initarg))
422 (initarg-default (sod-initarg-default initarg))
423 (found (gethash initarg-name seen))
424 (found-type (and found (sod-initarg-type found)))
425 (found-default (and found (sod-initarg-default found)))
426 (found-class (and found (sod-initarg-class found)))
427 (found-location (and found (file-location found))))
428 (with-default-error-location (initarg)
429 (cond ((not found)
430 (setf (gethash initarg-name seen) initarg))
431 ((not (c-type-equal-p initarg-type found-type))
432 (cerror* "Inititalization argument `~A' defined ~
433 with incompatible types: ~
434 ~A in class `~A', but ~A in class `~A'"
435 initarg-name initarg-type super
436 found-type found-class found-location)
437 (report-inheritance-path state super))
438 ((and initarg-default found-default
439 (eql super found-class))
440 (cerror* "Initialization argument `~A' redefined ~
441 with default value"
442 initarg-name)
443 (info-with-location found-location
444 "Previous definition is here"))
445 (initarg-default
446 (setf (gethash initarg-name seen) initarg))))))))
b2983f35 447
dea4d055
MW
448 ;; Check for circularity in the superclass graph. Since the superclasses
449 ;; should already be acyclic, it suffices to check that our class is not
450 ;; a superclass of any of its own direct superclasses.
451 (let ((circle (find-if (lambda (super)
452 (sod-subclass-p super class))
453 (sod-class-direct-superclasses class))))
454 (when circle
ab7e7521
MW
455 (cerror* "`~A' is already a superclass of `~A'" class circle)
456 (report-inheritance-path (make-inheritance-path-reporter-state class)
457 circle)))
dea4d055
MW
458
459 ;; Check that the class has a unique root superclass.
460 (find-root-superclass class)
461
462 ;; Check that the metaclass is a subclass of each direct superclass's
463 ;; metaclass.
ab7e7521
MW
464 (finalization-error (:bad-metaclass)
465 (let ((meta (sod-class-metaclass class)))
466 (dolist (super (sod-class-direct-superclasses class))
467 (let ((supermeta (sod-class-metaclass super)))
468 (unless (sod-subclass-p meta supermeta)
469 (cerror* "Metaclass `~A' of `~A' isn't a subclass of `~A'"
470 meta class supermeta)
471 (info-with-location super
472 "Direct superclass `~A' defined here ~
473 has metaclass `~A'"
474 super supermeta))))))))
dea4d055
MW
475
476;;;--------------------------------------------------------------------------
477;;; Finalization.
478
32bb097f
MW
479(defmethod finalize-sod-class :around ((class sod-class))
480 "Common functionality for `finalize-sod-class'.
dea4d055 481
32bb097f
MW
482 * If an attempt to finalize the CLASS has been made before, then we
483 don't try again. Similarly, attempts to finalize a class recursively
484 will fail.
dea4d055 485
32bb097f
MW
486 * A condition handler is established to keep track of whether any errors
487 are signalled during finalization. The CLASS is only marked as
488 successfully finalized if no (unhandled) errors are encountered."
dea4d055
MW
489 (with-default-error-location (class)
490 (ecase (sod-class-state class)
491 ((nil)
492
32bb097f 493 ;; If this fails, leave the class marked as a loss.
16f9fb72 494 (setf (slot-value class 'state) :broken)
dea4d055 495
e45a106d
MW
496 ;; Invoke the finalization method proper. If it signals any
497 ;; continuable errors, take note of them so that we can report failure
498 ;; properly.
499 ;;
500 ;; Catch: we get called recursively to clean up superclasses and
501 ;; metaclasses, but there should only be one such handler, so don't
502 ;; add another. (In turn, this means that other methods mustn't
503 ;; actually trap their significant errors.)
504 (let ((have-handler-p (boundp '*finalization-errors*))
505 (*finalization-errors* nil)
506 (*finalization-error-token* nil))
507 (catch '%finalization-failed
508 (if have-handler-p (call-next-method)
509 (handler-bind ((error (lambda (cond)
510 (declare (ignore cond))
511 (pushnew *finalization-error-token*
512 *finalization-errors*
513 :test #'equal)
514 :decline)))
515 (call-next-method)))
516 (when *finalization-errors* (finalization-failed))
517 (setf (slot-value class 'state) :finalized)
518 t)))
dea4d055 519
32bb097f 520 ;; If the class is broken, we're not going to be able to fix it now.
dea4d055
MW
521 (:broken
522 nil)
523
32bb097f 524 ;; If we already finalized it, there's no point doing it again.
dea4d055
MW
525 (:finalized
526 t))))
abdf50aa 527
32bb097f
MW
528(defmethod finalize-sod-class ((class sod-class))
529
530 ;; CLONE-AND-HACK WARNING: Note that `bootstrap-classes' has a (very brief)
531 ;; clone of the CPL and chain establishment code. If the interface changes
532 ;; then `bootstrap-classes' will need to be changed too.
533
534 ;; Set up the metaclass if it's not been set already. This is delayed
535 ;; to give bootstrapping a chance to set up metaclass and superclass
536 ;; circularities.
537 (default-slot (class 'metaclass) (guess-metaclass class))
538
539 ;; Finalize all of the superclasses. There's some special pleading here to
540 ;; make bootstrapping work: we don't try to finalize the metaclass if we're
541 ;; a root class (no direct superclasses -- because in that case the
542 ;; metaclass will have to be a subclass of us!), or if it's equal to us.
e45a106d
MW
543 ;; This is enough to tie the knot at the top of the class graph. If we
544 ;; can't manage this then we're doomed.
545 (flet ((try-finalizing (what other-class)
546 (unless (finalize-sod-class other-class)
547 (cerror* "Class `~A' has broken ~A `~A'" class what other-class)
548 (info-with-location other-class
549 "Class `~A' defined here" other-class)
550 (finalization-failed))))
551 (let ((supers (sod-class-direct-superclasses class))
552 (meta (sod-class-metaclass class)))
553 (dolist (super supers)
554 (try-finalizing "direct superclass" super))
555 (unless (or (null supers) (eq class meta))
556 (try-finalizing "metaclass" meta))))
32bb097f
MW
557
558 ;; Stash the class's type.
559 (setf (slot-value class '%type)
560 (make-class-type (sod-class-name class)))
561
562 ;; Clobber the lists of items if they've not been set.
563 (dolist (slot '(slots instance-initializers class-initializers
564 messages methods))
565 (unless (slot-boundp class slot)
566 (setf (slot-value class slot) nil)))
567
e45a106d
MW
568 ;; If the CPL hasn't been done yet, compute it. If we can't manage this
569 ;; then there's no hope at all.
570 (unless (slot-boundp class 'class-precedence-list)
571 (restart-case
572 (setf (slot-value class 'class-precedence-list) (compute-cpl class))
573 (continue () :report "Continue"
574 (finalization-failed))))
32bb097f
MW
575
576 ;; Check that the class is fairly sane.
577 (check-sod-class class)
578
579 ;; Determine the class's layout.
580 (setf (values (slot-value class 'chain-head)
581 (slot-value class 'chain)
582 (slot-value class 'chains))
583 (compute-chains class)))
584
abdf50aa 585;;;----- That's all, folks --------------------------------------------------