mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-15 07:41:09 -08:00
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.
This commit is contained in:
parent
6c818936e0
commit
058bac45b2
1 changed files with 37 additions and 21 deletions
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue