Changeset 13968


Ignore:
Timestamp:
06/16/12 10:45:26 (9 years ago)
Author:
rschlatte
Message:

Ensure add-method calls remove-method

  • also move some error checks out of the fast path + into standard path for non-standard metaclasses
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13965 r13968  
    19231923
    19241924(defun std-add-method (gf method)
    1925   (when (and (method-generic-function method)
    1926              (not (eql gf (method-generic-function method))))
    1927     (error 'simple-error
    1928            :format-control "~S is already a method of ~S, cannot add to ~S."
    1929            :format-arguments (list method (method-generic-function method) gf)))
    1930   ;; Remove existing method with same qualifiers and specializers (if any).
     1925  ;; calls sites need to make sure that method is either a method of the
     1926  ;; given gf or does not have a gf.
    19311927  (let ((old-method (%find-method gf (std-method-qualifiers method)
    19321928                                 (method-specializers method) nil)))
    19331929    (when old-method
    1934       (std-remove-method gf old-method)))
     1930      (if (and (eq (class-of gf) +the-standard-generic-function-class+)
     1931               (eq (class-of old-method) +the-standard-method-class+))
     1932          (std-remove-method gf old-method)
     1933          (remove-method gf old-method))))
    19351934  (setf (std-slot-value method 'sys::%generic-function) gf)
    19361935  (push method (generic-function-methods gf))
     
    39513950               qualifiers specializers errorp))
    39523951
     3952;;; AMOP pg. 167
    39533953(defgeneric add-method (generic-function method))
    39543954
     3955(defmethod add-method :before ((generic-function generic-function)
     3956                               (method method))
     3957  (when (and (method-generic-function method)
     3958             (not (eql generic-function (method-generic-function method))))
     3959    (error 'simple-error
     3960           :format-control "~S is already a method of ~S, cannot add to ~S."
     3961           :format-arguments (list method (method-generic-function method)
     3962                                   generic-function)))
     3963  (check-method-lambda-list (generic-function-name generic-function)
     3964                            (method-lambda-list method)
     3965                            (generic-function-lambda-list generic-function)))
     3966
    39553967(defmethod add-method ((generic-function standard-generic-function)
    3956                        (method method))
    3957   (let ((method-lambda-list (method-lambda-list method))
    3958         (gf-lambda-list (generic-function-lambda-list generic-function)))
    3959     (check-method-lambda-list (%generic-function-name generic-function)
    3960                               method-lambda-list gf-lambda-list))
     3968                       (method standard-method))
    39613969  (std-add-method generic-function method))
    39623970
    3963 (defmethod add-method :after ((generic-function standard-generic-function)
     3971(defmethod add-method :after ((generic-function generic-function)
    39643972                              (method method))
    39653973  (map-dependents generic-function
     
    39703978
    39713979(defmethod remove-method ((generic-function standard-generic-function)
    3972                           (method method))
     3980                          (method standard-method))
    39733981  (std-remove-method generic-function method))
    39743982
    3975 (defmethod remove-method :after ((generic-function standard-generic-function)
     3983(defmethod remove-method :after ((generic-function generic-function)
    39763984                                 (method method))
    39773985  (map-dependents generic-function
Note: See TracChangeset for help on using the changeset viewer.