- (cond
- ((csubtypep class (specifier-type 'funcallable-instance))
- (values 'funcallable-instance-p '%funcallable-instance-layout))
- ((csubtypep class (specifier-type 'instance))
- (values '%instancep '%instance-layout))
- (t
- (values '(lambda (x) (declare (ignore x)) t) 'layout-of)))
- (cond
- ((and (eq (classoid-state class) :sealed) layout
- (not (classoid-subclasses class)))
- ;; Sealed and has no subclasses.
- (let ((n-layout (gensym)))
- `(and (,pred object)
- (let ((,n-layout (,get-layout object)))
- ,@(when (policy *lexenv* (>= safety speed))
- `((when (layout-invalid ,n-layout)
- (%layout-invalid-error object ',layout))))
- (eq ,n-layout ',layout)))))
- ((and (typep class 'basic-structure-classoid) layout)
- ;; structure type tests; hierarchical layout depths
- (let ((depthoid (layout-depthoid layout))
- (n-layout (gensym)))
- `(and (,pred object)
- (let ((,n-layout (,get-layout object)))
- ,@(when (policy *lexenv* (>= safety speed))
- `((when (layout-invalid ,n-layout)
- (%layout-invalid-error object ',layout))))
- (if (eq ,n-layout ',layout)
- t
- (and (> (layout-depthoid ,n-layout)
- ,depthoid)
- (locally (declare (optimize (safety 0)))
- (eq (svref (layout-inherits ,n-layout)
- ,depthoid)
- ',layout))))))))
+ (cond
+ ((csubtypep class (specifier-type 'funcallable-instance))
+ (values 'funcallable-instance-p '%funcallable-instance-layout))
+ ((csubtypep class (specifier-type 'instance))
+ (values '%instancep '%instance-layout))
+ (t
+ (values '(lambda (x) (declare (ignore x)) t) 'layout-of)))
+ (cond
+ ((and (eq (classoid-state class) :sealed) layout
+ (not (classoid-subclasses class)))
+ ;; Sealed and has no subclasses.
+ (let ((n-layout (gensym)))
+ `(and (,pred object)
+ (let ((,n-layout (,get-layout object)))
+ ,@(when (policy *lexenv* (>= safety speed))
+ `((when (layout-invalid ,n-layout)
+ (%layout-invalid-error object ',layout))))
+ (eq ,n-layout ',layout)))))
+ ((and (typep class 'basic-structure-classoid) layout)
+ ;; structure type tests; hierarchical layout depths
+ (let ((depthoid (layout-depthoid layout))
+ (n-layout (gensym)))
+ `(and (,pred object)
+ (let ((,n-layout (,get-layout object)))
+ ,@(when (policy *lexenv* (>= safety speed))
+ `((when (layout-invalid ,n-layout)
+ (%layout-invalid-error object ',layout))))
+ (if (eq ,n-layout ',layout)
+ t
+ (and (> (layout-depthoid ,n-layout)
+ ,depthoid)
+ (locally (declare (optimize (safety 0)))
+ (eq (svref (layout-inherits ,n-layout)
+ ,depthoid)
+ ',layout))))))))