Changeset 4350 for trunk/j/src/org/armedbear/lisp/defclass.lisp

Timestamp:

10/13/03 18:43:41 (20 years ago)

Author:

piso

Message:

ADD-METHOD, REMOVE-METHOD: return generic function, not method.

File:

• trunk/j/src/org/armedbear/lisp/defclass.lisp (modified) (5 diffs)

trunk/j/src/org/armedbear/lisp/defclass.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: defclass.lisp,v 1.22 2003-10-13 14:12:26 piso Exp $
+;;; $Id: defclass.lisp,v 1.23 2003-10-13 18:43:41 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -908 +908 @@
     method))
 
-;;; add-method
-
-;;; N.B. This version first removes any existing method on the generic function
-;;; with the same qualifiers and specializers.  It's a pain to develop
-;;; programs without this feature of full CLOS.
-
 (defun add-method (gf method)
-  (let ((old-method
-         (find-method gf (method-qualifiers method)
-                      (method-specializers method) nil)))
-    (when old-method (remove-method gf old-method)))
+  ;; Remove existing method with same qualifiers and specializers (if any).
+  (let ((old-method (find-method gf (method-qualifiers method)
+                                 (method-specializers method) nil)))
+    (when old-method
+      (remove-method gf old-method)))
   (setf (method-generic-function method) gf)
   (push method (generic-function-methods gf))
@@ -924 +919 @@
     (pushnew method (class-direct-methods specializer)))
   (finalize-generic-function gf)
-  method)
+  gf)
 
 (defun remove-method (gf method)
@@ -935 +930 @@
           (remove method (class-direct-methods class))))
   (finalize-generic-function gf)
-  method)
-
-(defun find-method (gf qualifiers specializers
-                       &optional (errorp t))
+  gf)
+
+(defun find-method (gf qualifiers specializers &optional (errorp t))
   (let ((method
          (find-if #'(lambda (method)
@@ -947 +941 @@
                   (generic-function-methods gf))))
     (if (and (null method) errorp)
-        (error "No such method for ~S." (generic-function-name gf))
+        (error "no such method for ~S" (generic-function-name gf))
         method)))