- (qualifiers (method-qualifiers method))
- (specializers (method-specializers method))
- (existing (get-method generic-function
- qualifiers
- specializers
- nil)))
-
- ;; If there is already a method like this one then we must get
- ;; rid of it before proceeding. Note that we call the generic
- ;; function REMOVE-METHOD to remove it rather than doing it in
- ;; some internal way.
- (when (and existing (similar-lambda-lists-p existing method))
- (remove-method generic-function existing))
-
- (setf (method-generic-function method) generic-function)
- (pushnew method (generic-function-methods generic-function))
- (dolist (specializer specializers)
- (add-direct-method specializer method))
-
- ;; KLUDGE: SET-ARG-INFO contains the error-detecting logic for
- ;; detecting attempts to add methods with incongruent lambda
- ;; lists. However, according to Gerd Moellmann on cmucl-imp,
- ;; it also depends on the new method already having been added
- ;; to the generic function. Therefore, we need to remove it
- ;; again on error:
- (let ((remove-again-p t))
- (unwind-protect
- (progn
- (set-arg-info generic-function :new-method method)
- (setq remove-again-p nil))
- (when remove-again-p
- (remove-method generic-function method))))
- (unless skip-dfun-update-p
- (update-ctors 'add-method
- :generic-function generic-function
- :method method)
- (update-dfun generic-function))
- method)))
+ (qualifiers (method-qualifiers method))
+ (specializers (method-specializers method))
+ (existing (get-method generic-function
+ qualifiers
+ specializers
+ nil)))
+
+ ;; If there is already a method like this one then we must get
+ ;; rid of it before proceeding. Note that we call the generic
+ ;; function REMOVE-METHOD to remove it rather than doing it in
+ ;; some internal way.
+ (when (and existing (similar-lambda-lists-p existing method))
+ (remove-method generic-function existing))
+
+ (setf (method-generic-function method) generic-function)
+ (pushnew method (generic-function-methods generic-function))
+ (dolist (specializer specializers)
+ (add-direct-method specializer method))
+
+ ;; KLUDGE: SET-ARG-INFO contains the error-detecting logic for
+ ;; detecting attempts to add methods with incongruent lambda
+ ;; lists. However, according to Gerd Moellmann on cmucl-imp,
+ ;; it also depends on the new method already having been added
+ ;; to the generic function. Therefore, we need to remove it
+ ;; again on error:
+ (let ((remove-again-p t))
+ (unwind-protect
+ (progn
+ (set-arg-info generic-function :new-method method)
+ (setq remove-again-p nil))
+ (when remove-again-p
+ (remove-method generic-function method))))
+
+ ;; KLUDGE II: ANSI saith that it is not an error to add a
+ ;; method with invalid qualifiers to a generic function of the
+ ;; wrong kind; it's only an error at generic function
+ ;; invocation time; I dunno what the rationale was, and it
+ ;; sucks. Nevertheless, it's probably a programmer error, so
+ ;; let's warn anyway. -- CSR, 2003-08-20
+ (let ((mc (generic-function-method-combination generic-functioN)))
+ (cond
+ ((eq mc *standard-method-combination*)
+ (when (and qualifiers
+ (or (cdr qualifiers)
+ (not (memq (car qualifiers)
+ '(:around :before :after)))))
+ (warn "~@<Invalid qualifiers for standard method combination ~
+ in method ~S:~2I~_~S.~@:>"
+ method qualifiers)))
+ ((short-method-combination-p mc)
+ (let ((mc-name (method-combination-type mc)))
+ (when (or (null qualifiers)
+ (cdr qualifiers)
+ (and (neq (car qualifiers) :around)
+ (neq (car qualifiers) mc-name)))
+ (warn "~@<Invalid qualifiers for ~S method combination ~
+ in method ~S:~2I~_~S.~@:>"
+ mc-name method qualifiers))))))
+
+ (unless skip-dfun-update-p
+ (update-ctors 'add-method
+ :generic-function generic-function
+ :method method)
+ (update-dfun generic-function))
+ generic-function)))