Replace *-function vars with generic functions in cl-generic.

* lisp/emacs-lisp/cl-generic.el (cl--generic-generalizer): New struct.
(cl-generic-tagcode-function, cl-generic-tag-types-function): Remove.
(cl--generic-t-generalizer): New const.
(cl--generic-make-method): Rename from `cl--generic-method-make'.
(cl--generic-make): Change calling convention.
(cl--generic): Add `options' field.
(cl-generic-function-options): New function.
(cl-defgeneric): Rewrite handling of options.  Add support for :method
options and allow the use of a default body.
(cl-generic-define): Save options in the corresponding new field.
(cl-defmethod): Fix ordering of qualifiers.
(cl-generic-define-method): Use cl-generic-generalizers.
(cl--generic-get-dispatcher): Change calling convention, and change
calling convention of the returned function as well so as to take the
list of methods separately from the generic function object, so that it
can receive the original generic function object.
(cl--generic-make-next-function): New function, extracted from
cl--generic-make-function.
(cl--generic-make-function): Use it.
(cl-generic-method-combination-function): Remove.
(cl--generic-cyclic-definition): New error.
(cl-generic-call-method): Take a generic function object rather than
its name.
(cl-method-qualifiers): New alias.
(cl--generic-build-combined-method): Use cl-generic-combine-methods,
don't segregate by qualifiers here any more.
(cl--generic-standard-method-combination): Segregate by qualifiers
here instead.  Add support for the `:extra' qualifier.
(cl--generic-cache-miss): Move earlier, adjust to new calling convention.
(cl-generic-generalizers, cl-generic-combine-methods):
New generic functions.
(cl-no-next-method, cl-no-applicable-method, cl-no-primary-method):
Use the new "default method in defgeneric" functionality, change
calling convention to receive a generic function object.
(cl--generic-head-used): New var.
(cl--generic-head-generalizer, cl--generic-eql-generalizer)
(cl--generic-struct-generalizer, cl--generic-typeof-generalizer):
New consts.
* lisp/emacs-lisp/eieio-core.el (eieio--generic-generalizer)
(eieio--generic-subclass-generalizer): New consts.
(cl-generic-generalizers): New methods.
* lisp/emacs-lisp/eieio-compat.el (eieio--generic-static-symbol-generalizer)
(eieio--generic-static-object-generalizer): New consts.
(cl-generic-generalizers) <(head eieio--static)>: New method.
* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
Unfold closures like lambdas.

1 files changed, 32 insertions, 24 deletions

diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index 7468c040e10..ee8e731b043 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -124,30 +124,38 @@ Summary:
        (defgeneric ,method ,args)
        (eieio--defmethod ',method ',key ',class #',code))))
 
-(add-function :before-until cl-generic-tagcode-function
-              #'eieio--generic-static-tagcode)
-(defun eieio--generic-static-tagcode (type name)
-  (and (eq 'eieio--static (car-safe type))
-       `(40 . (cond
-               ((symbolp ,name) (eieio--class-v ,name))
-               ((vectorp ,name) (aref ,name 0))))))
-
-(add-function :around cl-generic-tag-types-function
-              #'eieio--generic-static-tag-types)
-(defun eieio--generic-static-tag-types (orig-fun tag)
-  (cond
-   ((or (eieio--class-p tag)
-        (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))))
-    (let ((superclasses (funcall orig-fun tag))
-          (types ()))
-      ;; Interleave: (subclass <foo>) (eieio--static <foo>) <subclass <bar>) ..
-      (dolist (superclass superclasses)
-        (push superclass types)
-        (push `(eieio--static
-                ,(if (consp superclass) (cadr superclass) superclass))
-              types))
-      (nreverse types)))
-   (t (funcall orig-fun tag))))
+(defconst eieio--generic-static-symbol-generalizer
+  (cl-generic-make-generalizer
+   ;; Give it a slightly higher priority than `subclass' so that the
+   ;; interleaved list comes before subclass's non-interleaved list.
+   61 (lambda (name) `(and (symbolp ,name) (eieio--class-v ,name)))
+   (lambda (tag)
+     (when (eieio--class-p tag)
+       (let ((superclasses (eieio--generic-subclass-specializers tag))
+             (specializers ()))
+         (dolist (superclass superclasses)
+           (push superclass specializers)
+           (push `(eieio--static ,(cadr superclass)) specializers))
+         (nreverse specializers))))))
+(defconst eieio--generic-static-object-generalizer
+  (cl-generic-make-generalizer
+   ;; Give it a slightly higher priority than `class' so that the
+   ;; interleaved list comes before the class's non-interleaved list.
+   51 #'cl--generic-struct-tag
+   (lambda (tag)
+     (and (symbolp tag) (boundp tag) (setq tag (symbol-value tag))
+          (eieio--class-p tag)
+          (let ((superclasses (eieio--class-precedence-list tag))
+                (specializers ()))
+            (dolist (superclass superclasses)
+              (setq superclass (eieio--class-symbol superclass))
+              (push superclass specializers)
+              (push `(eieio--static ,superclass) specializers))
+            (nreverse specializers))))))
+
+(cl-defmethod cl-generic-generalizers ((_specializer (head eieio--static)))
+  (list eieio--generic-static-symbol-generalizer
+        eieio--generic-static-object-generalizer))
 
 ;;;###autoload
 (defun eieio--defgeneric-init-form (method doc-string)