From 058bac45b2f64dee35e26e22b00bafde41aa5aec Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Jan 2026 22:34:32 -0500 Subject: cl-generic.el: Avoid an O(N^2) behavior When N methods are defined, don't (re)build the dispatch function each time since it takes O(N) time to build it. * lisp/emacs-lisp/cl-generic.el (cl--generic-method): Add docstring. (cl--generic): New `lazy-function` slot. (cl--generic-make-function): Use it and delay building the dispatch function until the next call. [toplevel]: Simplify the bootstrap hacks a bit. --- lisp/emacs-lisp/cl-generic.el | 58 +++++++++++++++++++++++++++---------------- 1 file changed, 37 insertions(+), 21 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index ea73ce766f5..d501a421ea2 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -154,17 +154,22 @@ also passed as second argument to SPECIALIZERS-FUNCTION." (:constructor cl--generic-make-method (specializers qualifiers call-con function)) (:predicate nil)) + "Type of `cl-generic' method objects. +FUNCTION holds a function containing the actual code of the method. +SPECIALIZERS holds the list of specializers (as long as the number of +mandatory arguments of the method). +QUALIFIERS holds the list of qualifiers. +CALL-CON indicates the calling convention expected by FUNCTION: +- nil: FUNCTION is just a normal function with no extra arguments for + `call-next-method' or `next-method-p' (which it hence can't use). +- `curried': FUNCTION is a curried function that first takes the + \"next combined method\" and returns the resulting combined method. + It can distinguish `next-method-p' by checking if that next method + is `cl--generic-isnot-nnm-p'. +- t: FUNCTION takes the `call-next-method' function as an extra first + argument." (specializers nil :read-only t :type list) (qualifiers nil :read-only t :type (list-of atom)) - ;; CALL-CON indicates the calling convention expected by FUNCTION: - ;; - nil: FUNCTION is just a normal function with no extra arguments for - ;; `call-next-method' or `next-method-p' (which it hence can't use). - ;; - `curried': FUNCTION is a curried function that first takes the - ;; "next combined method" and return the resulting combined method. - ;; It can distinguish `next-method-p' by checking if that next method - ;; is `cl--generic-isnot-nnm-p'. - ;; - t: FUNCTION takes the `call-next-method' function as its first (extra) - ;; argument. (call-con nil :read-only t :type symbol) (function nil :read-only t :type function)) @@ -181,7 +186,10 @@ also passed as second argument to SPECIALIZERS-FUNCTION." ;; The most important dispatch is last in the list (and the least is first). (dispatches nil :type (list-of (cons natnum (list-of generalizers)))) (method-table nil :type (list-of cl--generic-method)) - (options nil :type list)) + (options nil :type list) + ;; This slot holds the function we put into `symbol-function' before + ;; the actual dispatch function has been computed. + (lazy-function nil)) (defun cl-generic-function-options (generic) "Return the options of the generic function GENERIC." @@ -658,8 +666,6 @@ The set of acceptable TYPEs (also called \"specializers\") is defined ;; Keep the ordering; important for methods with :extra qualifiers. (mapcar (lambda (x) (if (eq x (car me)) method x)) mt))) (let ((sym (cl--generic-name generic)) ; Actual name (for aliases). - ;; FIXME: Try to avoid re-constructing a new function if the old one - ;; is still valid (e.g. still empty method cache)? (gfun (cl--generic-make-function generic))) (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format (cl--generic-name generic) @@ -827,9 +833,24 @@ You might need to add: %S" ,@fixedargs args))))))))) (defun cl--generic-make-function (generic) - (cl--generic-make-next-function generic - (cl--generic-dispatches generic) - (cl--generic-method-table generic))) + "Return the function to put into the `symbol-function' of GENERIC." + ;; The function we want is the one that performs the dispatch, + ;; but that function depends on the set of methods and needs to be + ;; flushed/recomputed when the set of methods changes. + ;; To avoid reconstructing such a method N times for N `cl-defmethod', + ;; we construct the dispatch function lazily: + ;; we first return a "lazy" function, which waits until the + ;; first call to the method to really compute the dispatch function, + ;; at which point we replace the dummy with the real one. + (with-memoization (cl--generic-lazy-function generic) + (lambda (&rest args) + (let ((real + (cl--generic-make-next-function generic + (cl--generic-dispatches generic) + (cl--generic-method-table generic)))) + (let ((current-load-list nil)) + (defalias (cl--generic-name generic) real)) + (apply real args))))) (defun cl--generic-make-next-function (generic dispatches methods) (let* ((dispatch @@ -985,10 +1006,6 @@ FUN is the function that should be called when METHOD calls (setq methods (nreverse (mapcar #'cdr (sort methods #'car-less-than-car)))) (cl--generic-make-next-function generic dispatches-left methods))) -(unless (ignore-errors (cl-generic-generalizers t)) - ;; Temporary definition to let the next defgenerics succeed. - (fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination)) - (cl-defgeneric cl-generic-generalizers (specializer) "Return a list of generalizers for a given SPECIALIZER. To each kind of `specializer', corresponds a `generalizer' which describes @@ -1031,8 +1048,7 @@ those methods.") (unless (ignore-errors (cl-generic-generalizers t)) ;; Temporary definition to let the next defmethod succeed. (fset 'cl-generic-generalizers - (lambda (specializer) - (if (eq t specializer) (list cl--generic-t-generalizer)))) + (lambda (_specializer) (list cl--generic-t-generalizer))) (fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination)) (cl-defmethod cl-generic-generalizers (specializer) -- cgit v1.2.1