Changeset 13830
- Timestamp:
- 01/29/12 23:40:50 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r13827 r13830 1778 1778 1779 1779 (defun std-add-method (gf method) 1780 (when (method-generic-function method) 1780 (when (and (method-generic-function method) 1781 (not (eql gf (method-generic-function method)))) 1781 1782 (error 'simple-error 1782 :format-control " ADD-METHOD: ~S is already a method of~S."1783 :format-arguments (list method (method-generic-function method) )))1783 :format-control "~S is already a method of ~S, cannot add to ~S." 1784 :format-arguments (list method (method-generic-function method) gf))) 1784 1785 ;; Remove existing method with same qualifiers and specializers (if any). 1785 1786 (let ((old-method (%find-method gf (std-method-qualifiers method) … … 1790 1791 (push method (generic-function-methods gf)) 1791 1792 (dolist (specializer (method-specializers method)) 1792 (when (typep specializer 'class) ;; FIXME What about EQL specializer objects? 1793 ;; FIXME use add-direct-method here (AMOP pg. 165)) 1794 (when (typep specializer 'class) 1793 1795 (pushnew method (class-direct-methods specializer)))) 1794 1796 (finalize-standard-generic-function gf) … … 1798 1800 (setf (generic-function-methods gf) 1799 1801 (remove method (generic-function-methods gf))) 1800 (setf (std-slot-value method 'generic-function) gf)1802 (setf (std-slot-value method 'generic-function) nil) 1801 1803 (dolist (specializer (method-specializers method)) 1802 (when (typep specializer 'class) ;; FIXME What about EQL specializer objects? 1804 ;; FIXME use remove-direct-method here (AMOP pg. 227) 1805 (when (typep specializer 'class) 1803 1806 (setf (class-direct-methods specializer) 1804 1807 (remove method (class-direct-methods specializer)))))
Note: See TracChangeset
for help on using the changeset viewer.