- (let ((location (slot-definition-location slotd))
- (type-check-function
- (when (safe-p class)
- (slot-definition-type-check-function slotd))))
- (flet ((check (new-value)
- (when type-check-function
- (funcall (the function type-check-function) new-value))
- new-value))
- (typecase location
- (fixnum
- (cond ((std-instance-p object)
- (setf (clos-slots-ref (std-instance-slots object) location)
- (check new-value)))
- ((fsc-instance-p object)
- (setf (clos-slots-ref (fsc-instance-slots object) location)
- (check new-value)))
- (t (bug "unrecognized instance type in ~S"
- '(setf slot-value-using-class)))))
- (cons
- (setf (cdr location) (check new-value)))
- (t
- (instance-structure-protocol-error
- slotd '(setf slot-value-using-class)))))))
+ (let* ((info (slot-definition-info slotd))
+ (location (slot-definition-location slotd))
+ (typecheck (slot-info-typecheck info))
+ (new-value (if typecheck
+ (funcall (the function typecheck) new-value)
+ new-value)))
+ (typecase location
+ (fixnum
+ (cond ((std-instance-p object)
+ (setf (clos-slots-ref (std-instance-slots object) location)
+ new-value))
+ ((fsc-instance-p object)
+ (setf (clos-slots-ref (fsc-instance-slots object) location)
+ new-value))
+ (t (bug "unrecognized instance type in ~S"
+ '(setf slot-value-using-class)))))
+ (cons
+ (setf (cdr location) new-value))
+ (t
+ (instance-structure-protocol-error
+ slotd '(setf slot-value-using-class))))))