+ (if (class-finalized-p class)
+ ;; required by AMOP, "Reinitialization of Class Metaobjects"
+ (finalize-inheritance class)
+ (update-class class nil))
+ (add-slot-accessors class direct-slots)
+ (make-preliminary-layout class))
+
+(defmethod shared-initialize :after ((class forward-referenced-class)
+ slot-names &key &allow-other-keys)
+ (declare (ignore slot-names))
+ (make-preliminary-layout class))
+
+(defvar *allow-forward-referenced-classes-in-cpl-p* nil)
+
+;;; Give CLASS a preliminary layout if it doesn't have one already, to
+;;; make it known to the type system.
+(defun make-preliminary-layout (class)
+ (flet ((compute-preliminary-cpl (root)
+ (let ((*allow-forward-referenced-classes-in-cpl-p* t))
+ (compute-class-precedence-list root))))
+ (without-package-locks
+ (unless (class-finalized-p class)
+ (let ((name (class-name class)))
+ ;; KLUDGE: This is fairly horrible. We need to make a
+ ;; full-fledged CLASSOID here, not just tell the compiler that
+ ;; some class is forthcoming, because there are legitimate
+ ;; questions one can ask of the type system, implemented in
+ ;; terms of CLASSOIDs, involving forward-referenced classes. So.
+ (let ((layout (make-wrapper 0 class)))
+ (setf (slot-value class 'wrapper) layout)
+ (let ((cpl (compute-preliminary-cpl class)))
+ (setf (layout-inherits layout)
+ (order-layout-inherits
+ (map 'simple-vector #'class-wrapper
+ (reverse (rest cpl))))))
+ (register-layout layout :invalidate t)
+ (set-class-type-translation class (layout-classoid layout)))))
+ (mapc #'make-preliminary-layout (class-direct-subclasses class)))))
+