Bug in CLOS !?

[Roger Kehr <kehr@iti.informatik.th-darmstadt.de>]

	Hello,

I'm not sure if I made some error in my investigation but it seems
that the CLOS-method "remove-method" does not work as expected.

The following dialog was verified with clisp-1996-04-17 and
clisp-1995-06-23:

> (use-package 'clos)
T
> (setq foo1 (defmethod foo ((x number)) (print x)))
#<STANDARD-METHOD (#<BUILT-IN-CLASS NUMBER>)>
> (setq foo2 (defmethod foo ((x string)) (print x)))
#<STANDARD-METHOD (#<BUILT-IN-CLASS STRING>)>
> (compute-applicable-methods #'foo '(1))
(#<STANDARD-METHOD (#<BUILT-IN-CLASS NUMBER>)>)
> (compute-applicable-methods #'foo '("abc"))
(#<STANDARD-METHOD (#<BUILT-IN-CLASS STRING>)>)

until now everything works as expected...

> (remove-method #'foo foo1)
#<GENERIC-FUNCTION FOO>
> (compute-applicable-methods #'foo '(1))
(#<STANDARD-METHOD (#<BUILT-IN-CLASS NUMBER>)>)   .... why? should be removed
> (remove-method #'foo foo2)
#<GENERIC-FUNCTION FOO>
> (compute-applicable-methods #'foo '("abc"))
(#<STANDARD-METHOD (#<BUILT-IN-CLASS STRING>)>)   .... ???


In clos.lsp I found the following code responsible for removing a
method from a generic function:

]; Entfernen einer Methode von einer generischen Funktion:
](defun std-remove-method (gf method)
]  (let ((old-method (find method (gf-methods gf)
]			  :key #'std-method-initfunction)))
]    (when old-method
]      (warn-if-gf-already-called gf)
]      (warn
]       #L{
]       DEUTSCH "Methode ~S in ~S wird entfernt."
]       ENGLISH "Removing method ~S in ~S"
]       FRANCAIS "On retire la méthode ~S de ~S."
]       }
]       old-method gf
]      )
]      (cond ((eq gf |#'initialize-instance|) (note-ii-change method))
]            ((eq gf |#'reinitialize-instance|) (note-ri-change method))
]            ((eq gf |#'shared-initialize|) (note-si-change method))
]      )
]      (setf (gf-methods gf) (remove old-method (gf-methods gf)))
]      (finalize-fast-gf gf)
]  ) )
]  gf
])

The first let binds `old-method' to the method to be removed. I
redefined the function by replacing the

	:key #'std-method-initfunction

with

	:test #'methods-agree-p

which was borrowed from the function "std-add-method" that is the part
of "defmethod" which also allows redefinition of methods. The finding
of the correct method is here implemented with a different call:

	(find method (gf-methods gf) :test #'methods-agree-p)))


]; Hinzufügen einer Methode zu einer generischen Funktion:
](defun std-add-method (gf method)
]  ; 28.1.6.4. congruent lambda lists
]  (let ((gf-sign (gf-signature gf))
]
] ...
]
]  ; Methode ist fertig. Eintragen:
]  (warn-if-gf-already-called gf)
]  (let ((old-method (find method (gf-methods gf) :test #'methods-agree-p)))
]    (cond ((eq gf |#'initialize-instance|) (note-ii-change method))
]          ((eq gf |#'reinitialize-instance|) (note-ri-change method))
]          ((eq gf |#'shared-initialize|) (note-si-change method))
]    )
]    (setf (gf-methods gf)
]          (cons method
]                (if old-method
]                  (progn
]                    (warn
]                     #L{
]                     DEUTSCH "Methode ~S in ~S wird ersetzt."
]                     ENGLISH "Replacing method ~S in ~S"
]                     FRANCAIS "On remplace la méthode ~S dans ~S."
]                     }
]                     old-method gf
]                    )
]                    (remove old-method (gf-methods gf))
]                  )
]                  (gf-methods gf)
]    )     )     )
]    (finalize-fast-gf gf)
]  )
]  gf
])

After redefining "std-remove-method" to

]; Entfernen einer Methode von einer generischen Funktion:
](defun std-remove-method (gf method)
]  (let ((old-method (find method (gf-methods gf)
]			  :test #'methods-agree-p)))
]    (when old-method
]      (warn-if-gf-already-called gf)
]      (warn
]       #L{
]       DEUTSCH "Methode ~S in ~S wird entfernt."
]       ENGLISH "Removing method ~S in ~S"
]       FRANCAIS "On retire la méthode ~S de ~S."
]       }
]       old-method gf
]      )
]      (cond ((eq gf |#'initialize-instance|) (note-ii-change method))
]            ((eq gf |#'reinitialize-instance|) (note-ri-change method))
]            ((eq gf |#'shared-initialize|) (note-si-change method))
]      )
]      (setf (gf-methods gf) (remove old-method (gf-methods gf)))
]      (finalize-fast-gf gf)
]  ) )
]  gf
])

everything works fine for me now!

It is a bug or a feature?

Bye


--
----------------------------------------------------------------------
Roger Kehr  	kehr@iti.informatik.th-darmstadt.de
----------------------------------------------------------------------