+;; Standard CLOS name.
+(defalias 'cl-method-qualifiers #'cl--generic-method-qualifiers)
+
+(defun cl--generic-standard-method-combination (generic methods)
+ (let ((mets-by-qual ()))
+ (dolist (method methods)
+ (let ((qualifiers (cl-method-qualifiers method)))
+ (if (eq (car qualifiers) :extra) (setq qualifiers (cddr qualifiers)))
+ (unless (member qualifiers '(() (:after) (:before) (:around)))
+ (error "Unsupported qualifiers in function %S: %S"
+ (cl--generic-name generic) qualifiers))
+ (push method (alist-get (car qualifiers) mets-by-qual))))
+ (cond
+ ((null mets-by-qual)
+ (lambda (&rest args)
+ (apply #'cl-no-applicable-method generic args)))
+ ((null (alist-get nil mets-by-qual))
+ (lambda (&rest args)
+ (apply #'cl-no-primary-method generic args)))
+ (t
+ (let* ((fun nil)
+ (ab-call (lambda (m) (cl-generic-call-method generic m)))
+ (before
+ (mapcar ab-call (reverse (cdr (assoc :before mets-by-qual)))))
+ (after (mapcar ab-call (cdr (assoc :after mets-by-qual)))))
+ (dolist (method (cdr (assoc nil mets-by-qual)))
+ (setq fun (cl-generic-call-method generic method fun)))
+ (when (or after before)
+ (let ((next fun))
+ (setq fun (lambda (&rest args)
+ (dolist (bf before)
+ (apply bf args))
+ (prog1
+ (apply next args)
+ (dolist (af after)
+ (apply af args)))))))
+ (dolist (method (cdr (assoc :around mets-by-qual)))
+ (setq fun (cl-generic-call-method generic method fun)))
+ fun)))))
+
+(defun cl--generic-cache-miss (generic
+ dispatch-arg dispatches-left methods-left types)
+ (let ((methods '()))
+ (dolist (method methods-left)
+ (let* ((specializer (or (if (integerp dispatch-arg)
+ (nth dispatch-arg
+ (cl--generic-method-specializers method))
+ (cdr (assoc dispatch-arg
+ (cl--generic-method-specializers method))))
+ t))
+ (m (member specializer types)))
+ (when m
+ (push (cons (length m) method) methods))))
+ ;; Sort the methods, most specific first.
+ ;; It would be tempting to sort them once and for all in the method-table
+ ;; rather than here, but the order might depend on the actual argument
+ ;; (e.g. for multiple inheritance with defclass).
+ (setq methods (nreverse (mapcar #'cdr (sort methods #'car-less-than-car))))
+ (cl--generic-make-next-function generic dispatches-left methods)))
+
+(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
+how to extract a \"tag\" from an object which will then let us check if this
+object matches the specializer. A typical example of a \"tag\" would be the
+type of an object. It's called a `generalizer' because it
+takes a specific object and returns a more general approximation,
+denoting a set of objects to which it belongs.
+A generalizer gives us the chunk of code which the
+dispatch function needs to use to extract the \"tag\" of an object, as well
+as a function which turns this tag into an ordered list of
+`specializers' that this object matches.
+The code which extracts the tag should be as fast as possible.
+The tags should be chosen according to the following rules:
+- The tags should not be too specific: similar objects which match the
+ same list of specializers should ideally use the same (`eql') tag.
+ This insures that the cached computation of the applicable
+ methods for one object can be reused for other objects.
+- Corollary: objects which don't match any of the relevant specializers
+ should ideally all use the same tag (typically nil).
+ This insures that this cache does not grow unnecessarily large.
+- Two different generalizers G1 and G2 should not use the same tag
+ unless they use it for the same set of objects. IOW, if G1.tag(X1) =
+ G2.tag(X2) then G1.tag(X1) = G2.tag(X1) = G1.tag(X2) = G2.tag(X2).
+- If G1.priority > G2.priority and G1.tag(X1) = G1.tag(X2) and this tag is
+ non-nil, then you have to make sure that the G2.tag(X1) = G2.tag(X2).
+ This is because the method-cache is only indexed with the first non-nil
+ tag (by order of decreasing priority).")
+
+(cl-defgeneric cl-generic-combine-methods (generic methods)
+ "Build the effective method made of METHODS.
+It should return a function that expects the same arguments as the methods, and
+ calls those methods in some appropriate order.
+GENERIC is the generic function (mostly used for its name).
+METHODS is the list of the selected methods.
+The METHODS list is sorted from most specific first to most generic last.
+The function can use `cl-generic-call-method' to create functions that call those
+methods.")
+
+;; Temporary definition to let the next defmethod succeed.
+(fset 'cl-generic-generalizers
+ (lambda (_specializer) (list cl--generic-t-generalizer)))
+(fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination)
+
+(cl-defmethod cl-generic-generalizers (specializer)
+ "Support for the catch-all t specializer."
+ (if (eq specializer t) (list cl--generic-t-generalizer)
+ (error "Unknown specializer %S" specializer)))
+
+(eval-when-compile
+ ;; This macro is brittle and only really important in order to be
+ ;; able to preload cl-generic without also preloading the byte-compiler,
+ ;; So we use `eval-when-compile' so as not keep it available longer than
+ ;; strictly needed.
+(defmacro cl--generic-prefill-dispatchers (arg-or-context specializer)
+ (unless (integerp arg-or-context)
+ (setq arg-or-context `(&context . ,arg-or-context)))
+ (unless (fboundp 'cl--generic-get-dispatcher)
+ (require 'cl-generic))
+ (let ((fun (cl--generic-get-dispatcher
+ `(,arg-or-context ,@(cl-generic-generalizers specializer)
+ ,cl--generic-t-generalizer))))
+ ;; Recompute dispatch at run-time, since the generalizers may be slightly
+ ;; different (e.g. byte-compiled rather than interpreted).
+ ;; FIXME: There is a risk that the run-time generalizer is not equivalent
+ ;; to the compile-time one, in which case `fun' may not be correct
+ ;; any more!
+ `(let ((dispatch `(,',arg-or-context
+ ,@(cl-generic-generalizers ',specializer)
+ ,cl--generic-t-generalizer)))
+ ;; (message "Prefilling for %S with \n%S" dispatch ',fun)
+ (puthash dispatch ',fun cl--generic-dispatchers)))))
+
+(cl-defmethod cl-generic-combine-methods (generic methods)
+ "Standard support for :after, :before, :around, and `:extra NAME' qualifiers."
+ (cl--generic-standard-method-combination generic methods))