- class1)
- ;; If one is a subclass of the other, then that is the
- ;; intersection.
- ((let ((subclasses (classoid-subclasses class2)))
- (and subclasses (gethash class1 subclasses)))
- class1)
- ((let ((subclasses (classoid-subclasses class1)))
- (and subclasses (gethash class2 subclasses)))
- class2)
- ;; Otherwise, we can't in general be sure that the
- ;; intersection is empty, since a subclass of both might be
- ;; defined. But we can eliminate it for some special cases.
- ((or (basic-structure-classoid-p class1)
- (basic-structure-classoid-p class2))
- ;; No subclass of both can be defined.
- *empty-type*)
- ((eq (classoid-state class1) :sealed)
- ;; checking whether a subclass of both can be defined:
- (sealed-class-intersection2 class1 class2))
- ((eq (classoid-state class2) :sealed)
- ;; checking whether a subclass of both can be defined:
- (sealed-class-intersection2 class2 class1))
- (t
- ;; uncertain, since a subclass of both might be defined
- nil)))
+ class1)
+ ;; If one is a subclass of the other, then that is the
+ ;; intersection.
+ ((let ((subclasses (classoid-subclasses class2)))
+ (and subclasses (gethash class1 subclasses)))
+ class1)
+ ((let ((subclasses (classoid-subclasses class1)))
+ (and subclasses (gethash class2 subclasses)))
+ class2)
+ ;; Otherwise, we can't in general be sure that the
+ ;; intersection is empty, since a subclass of both might be
+ ;; defined. But we can eliminate it for some special cases.
+ ((or (basic-structure-classoid-p class1)
+ (basic-structure-classoid-p class2))
+ ;; No subclass of both can be defined.
+ *empty-type*)
+ ((eq (classoid-state class1) :sealed)
+ ;; checking whether a subclass of both can be defined:
+ (sealed-class-intersection2 class1 class2))
+ ((eq (classoid-state class2) :sealed)
+ ;; checking whether a subclass of both can be defined:
+ (sealed-class-intersection2 class2 class1))
+ (t
+ ;; uncertain, since a subclass of both might be defined
+ nil)))
+
+;;; KLUDGE: we need this to deal with the special-case INSTANCE and
+;;; FUNCALLABLE-INSTANCE types (which used to be CLASSOIDs until CSR
+;;; discovered that this was incompatible with the MOP class
+;;; hierarchy). See NAMED :COMPLEX-SUBTYPEP-ARG2
+(defvar *non-instance-classoid-types*
+ '(symbol system-area-pointer weak-pointer code-component
+ lra fdefn random-class))