Skip to content
Snippets Groups Projects
Commit 3887ffd4 authored by pw's avatar pw
Browse files

Remove an error check in real-remove-method prohibited by ANSI spec.

parent 3163b238
No related branches found
No related tags found
No related merge requests found
...@@ -628,25 +628,24 @@ ...@@ -628,25 +628,24 @@
method))) method)))
(defun real-remove-method (generic-function method) (defun real-remove-method (generic-function method)
(if (neq generic-function (method-generic-function method)) ;; Note: Error check prohibited by ANSI spec removed.
(error "The method ~S is attached to the generic function~@ (when (eq generic-function (method-generic-function method))
~S. It can't be removed from the generic function~@ (let* ((name (generic-function-name generic-function))
to which it is not attached." (specializers (method-specializers method))
method (method-generic-function method)) (methods (generic-function-methods generic-function))
(let* ((name (generic-function-name generic-function)) (new-methods (remove method methods)))
(specializers (method-specializers method)) (setf (method-generic-function method) nil)
(methods (generic-function-methods generic-function)) (setf (generic-function-methods generic-function) new-methods)
(new-methods (remove method methods))) (dolist (specializer (method-specializers method))
(setf (method-generic-function method) nil) (remove-direct-method specializer method))
(setf (generic-function-methods generic-function) new-methods) (set-arg-info generic-function)
(dolist (specializer (method-specializers method)) (when (member name
(remove-direct-method specializer method)) '(make-instance
(set-arg-info generic-function) default-initargs
(when (member name '(make-instance default-initargs allocate-instance shared-initialize initialize-instance))
allocate-instance shared-initialize initialize-instance)) (update-make-instance-function-table (type-class (car specializers))))
(update-make-instance-function-table (type-class (car specializers)))) (update-dfun generic-function)
(update-dfun generic-function) generic-function)))
generic-function)))
(defun compute-applicable-methods-function (generic-function arguments) (defun compute-applicable-methods-function (generic-function arguments)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment