- (omethods (compute-applicable-methods gf orig-args))
- (nmethods (compute-applicable-methods gf cnm-args)))
- (unless (equal omethods nmethods)
- (error "~@<The set of methods ~S applicable to argument~P ~
- ~{~S~^, ~} to call-next-method is different from ~
- the set of methods ~S applicable to the original ~
- method argument~P ~{~S~^, ~}.~@:>"
- nmethods (length cnm-args) cnm-args omethods
- (length orig-args) orig-args)))))
+ (nreq (generic-function-nreq gf)))
+ (declare (fixnum nreq))
+ ;; 2. Requirement arguments pairwise: if all are EQL, the applicable
+ ;; methods must be the same. This takes care of the relatively common
+ ;; case of twiddling with &KEY arguments without being horribly
+ ;; expensive.
+ (unless (do ((orig orig-args (cdr orig))
+ (args cnm-args (cdr args))
+ (n nreq (1- nreq)))
+ ((zerop n) t)
+ (unless (and orig args (eql (car orig) (car args)))
+ (return nil)))
+ ;; 3. Only then do the full check.
+ (let ((omethods (compute-applicable-methods gf orig-args))
+ (nmethods (compute-applicable-methods gf cnm-args)))
+ (unless (equal omethods nmethods)
+ (error "~@<The set of methods ~S applicable to argument~P ~
+ ~{~S~^, ~} to call-next-method is different from ~
+ the set of methods ~S applicable to the original ~
+ method argument~P ~{~S~^, ~}.~@:>"
+ nmethods (length cnm-args) cnm-args omethods
+ (length orig-args) orig-args)))))))