diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt index c05b9152bb6b407b54d7f7a63a60f139dbe86713..7f780970aa4fa9b5f1240849eb2cd93f24c941ee 100644 --- a/general-info/release-19a.txt +++ b/general-info/release-19a.txt @@ -237,6 +237,8 @@ New in this release: warning is printed at method load time. An error is signaled if the generic function is called with arguments such that the method is used. + - Redefining a generic function with a different method + combination now recomputes effective methods. * Improvements to Hemlock, the Emacs-like editor: diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp index 984b09c557bd2872c737a137cd276e34e4d7ba55..88f4a16ae9820f54128d49714b65870727e12f48 100644 --- a/pcl/dfun.lisp +++ b/pcl/dfun.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.34 2003/08/25 20:10:41 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.35 2003/08/27 09:02:00 gerd Exp $") (in-package :pcl) @@ -1690,19 +1690,11 @@ And so, we are saved. (values pred pred))) -;;; -;;; NOTE: We are assuming a restriction on user code that the method -;;; combination must not change once it is connected to the -;;; generic function. -;;; -;;; This has to be legal, because otherwise any kind of method -;;; lookup caching couldn't work. See this by saying that this -;;; cache, is just a backing cache for the fast cache. If that -;;; cache is legal, this one must be too. -;;; -;;; Don't clear this table! -;;; -(defvar *effective-method-table* (make-hash-table :test 'eq)) +(defvar *effective-method-cache* (make-hash-table :test 'eq)) + +(defun flush-effective-method-cache (gf) + (dolist (method (generic-function-methods gf)) + (remhash method *effective-method-cache*))) (defun get-secondary-dispatch-function (gf methods types &optional method-alist wrappers) @@ -1727,8 +1719,8 @@ And so, we are saved. (lambda (&rest args) (apply #'no-applicable-method gf args)))) (let* ((key (car methods)) - (ht-value (or (gethash key *effective-method-table*) - (setf (gethash key *effective-method-table*) + (ht-value (or (gethash key *effective-method-cache*) + (setf (gethash key *effective-method-cache*) (cons nil nil))))) (if (and (null (cdr methods)) all-applicable-p ; the most common case (null method-alist-p) wrappers-p (not function-p)) diff --git a/pcl/methods.lisp b/pcl/methods.lisp index 4890da1d35c4c25205b293be8e0735acb40e3ea6..16f4982fe13316befbc10eb6e4f2a346f0cb6f64 100644 --- a/pcl/methods.lisp +++ b/pcl/methods.lisp @@ -26,7 +26,7 @@ ;;; (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.41 2003/07/29 12:13:24 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.42 2003/08/27 09:02:00 gerd Exp $") (in-package :pcl) @@ -521,8 +521,7 @@ (defmethod initialize-instance :after ((gf standard-generic-function) &key (lambda-list nil lambda-list-p) argument-precedence-order) - (with-slots (arg-info) - gf + (with-slots (arg-info) gf (if lambda-list-p (set-arg-info gf :lambda-list lambda-list @@ -531,24 +530,34 @@ (when (arg-info-valid-p arg-info) (update-dfun gf)))) -(defmethod reinitialize-instance :after ((gf standard-generic-function) - &rest args - &key (lambda-list nil lambda-list-p) - (argument-precedence-order - nil argument-precedence-order-p)) - (with-slots (arg-info) gf - (if lambda-list-p - (if argument-precedence-order-p - (set-arg-info gf - :lambda-list lambda-list - :argument-precedence-order argument-precedence-order) - (set-arg-info gf - :lambda-list lambda-list)) - (set-arg-info gf)) - (when (and (arg-info-valid-p arg-info) - args - (or lambda-list-p (cddr args))) - (update-dfun gf)))) +(defmethod reinitialize-instance :around + ((gf standard-generic-function) &rest args &key + (lambda-list nil lambda-list-p) + (argument-precedence-order nil argument-precedence-order-p)) + (let ((old-mc (generic-function-method-combination gf))) + (prog1 (call-next-method) + ;; + ;; Remove cached emf entries if the method combination might + ;; have changed in a way that makes re-computing emfs necesasry. + ;; EQ catches more cases than strictly necessary, but it is good + ;; enough. + (unless (eq old-mc (generic-function-method-combination gf)) + (flush-effective-method-cache gf)) + ;; + ;; Update the gf's arg-info. + (if lambda-list-p + (if argument-precedence-order-p + (set-arg-info gf :lambda-list lambda-list + :argument-precedence-order + argument-precedence-order) + (set-arg-info gf :lambda-list lambda-list)) + (set-arg-info gf)) + ;; + ;; Update the gf's dfun, if possible. + (when (and (arg-info-valid-p (gf-arg-info gf)) + (not (null args)) + (or lambda-list-p (cddr args))) + (update-dfun gf)))))) (defun compute-applicable-methods-function (gf arguments)