- (dolist (method (standard-slot-value/gf gf 'methods))
- (let ((specializers (standard-slot-value/method method 'specializers))
- (qualifiers (plist-value method 'qualifiers)))
- (when (and (null qualifiers)
- (eq (ecase type
- (reader (car specializers))
- (writer (cadr specializers)))
- class))
- (return method)))))
+ (let ((cpl (standard-slot-value/class class 'class-precedence-list))
+ (found-specializer *the-class-t*)
+ (found-method nil))
+ (dolist (method (standard-slot-value/gf gf 'methods) found-method)
+ (let ((specializers (standard-slot-value/method method 'specializers))
+ (qualifiers (plist-value method 'qualifiers)))
+ (when (and (null qualifiers)
+ (let ((subcpl (member (ecase type
+ (reader (car specializers))
+ (writer (cadr specializers)))
+ cpl)))
+ (and subcpl (member found-specializer subcpl))))
+ (setf found-specializer (ecase type
+ (reader (car specializers))
+ (writer (cadr specializers))))
+ (setf found-method method))))))