From 7a9353d444cf656eed1eae865afd73565cba5a29 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Wed, 29 Jun 2022 08:58:13 -0400
Subject: [PATCH] (cl--generic-compiler): Revert last change

That change (introduced to circumvent an error now that `seq.el` is
preloaded) caused all dispatchers to be left uncompiled, which slows down
method dispatch very significantly.  Fix the problem in the old way,
i.e. by adding an explicit call to `cl--generic-prefill-dispatchers`.

* lisp/emacs-lisp/cl-generic.el (cl--generic-compiler): Revert last change.
Add (cl--generic-prefill-dispatchers 1 integer) instead to handle
the new dispatchers needed for `seq.el`.
(cl--generic-prefill-generalizer-sample): New function.
(cl--generic-get-dispatcher): Use it to signal an error giving precise
instructions for what to do if we're about the load the byte-compiler
during the preload.
(cl--generic-oclosure-generalizer): Rename from
`cl-generic--oclosure-generalizer` for consistency with all
other generalizers.
---
 lisp/emacs-lisp/cl-generic.el | 43 +++++++++++++++++++++++++++++++----
 1 file changed, 39 insertions(+), 4 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 6c5813959fa..0560ddda268 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -658,9 +658,13 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
   ;; compiled.  Otherwise the byte-compiler and all the code on
   ;; which it depends needs to be usable before cl-generic is loaded,
   ;; which imposes a significant burden on the bootstrap.
-  (if (or (consp (lambda (x) (+ x 1)))
-          (not (featurep 'bytecomp)))
+  (if (consp (lambda (x) (+ x 1)))
       (lambda (exp) (eval exp t))
+    ;; But do byte-compile the dispatchers once bootstrap is passed:
+    ;; the performance difference is substantial (like a 5x speedup on
+    ;; the `eieio' elisp-benchmark)).
+    ;; To avoid loading the byte-compiler during the final preload,
+    ;; see `cl--generic-prefill-dispatchers'.
     #'byte-compile))
 
 (defun cl--generic-get-dispatcher (dispatch)
@@ -668,6 +672,22 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
       ;; We need `copy-sequence` here because this `dispatch' object might be
       ;; modified by side-effect in `cl-generic-define-method' (bug#46722).
       (gethash (copy-sequence dispatch) cl--generic-dispatchers)
+
+    (when (and purify-flag ;FIXME: Is this a reliable test of the final dump?
+               (eq cl--generic-compiler #'byte-compile))
+      ;; We don't want to preload the byte-compiler!!
+      (error
+       "Missing cl-generic dispatcher in the prefilled cache!
+Missing for: %S
+You might need to add: %S"
+       (mapcar (lambda (x) (if (cl--generic-generalizer-p x)
+                          (cl--generic-generalizer-name x)
+                        x))
+               dispatch)
+       `(cl--generic-prefill-dispatchers
+         ,@(delq nil (mapcar #'cl--generic-prefill-generalizer-sample
+                             dispatch)))))
+
     ;; (message "cl--generic-get-dispatcher (%S)" dispatch)
     (let* ((dispatch-arg (car dispatch))
            (generalizers (cdr dispatch))
@@ -932,6 +952,20 @@ those methods.")
   (if (eq specializer t) (list cl--generic-t-generalizer)
     (error "Unknown specializer %S" specializer)))
 
+(defun cl--generic-prefill-generalizer-sample (x)
+  "Return an example specializer."
+  (if (not (cl--generic-generalizer-p x))
+      x
+    (pcase (cl--generic-generalizer-name x)
+      ('cl--generic-t-generalizer nil)
+      ('cl--generic-head-generalizer '(head 'x))
+      ('cl--generic-eql-generalizer '(eql 'x))
+      ('cl--generic-struct-generalizer 'cl--generic)
+      ('cl--generic-typeof-generalizer 'integer)
+      ('cl--generic-derived-generalizer '(derived-mode c-mode))
+      ('cl--generic-oclosure-generalizer 'oclosure)
+      (_ x))))
+
 (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,
@@ -1329,6 +1363,7 @@ See the full list and their hierarchy in `cl--typeof-types'."
    (cl-call-next-method)))
 
 (cl--generic-prefill-dispatchers 0 integer)
+(cl--generic-prefill-dispatchers 1 integer)
 (cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer)
 
 ;;; Dispatch on major mode.
@@ -1377,7 +1412,7 @@ Used internally for the (major-mode MODE) context specializers."
          (when (cl-typep class 'oclosure--class)
            (oclosure--class-allparents class)))))
 
-(cl-generic-define-generalizer cl-generic--oclosure-generalizer
+(cl-generic-define-generalizer cl--generic-oclosure-generalizer
   ;; Give slightly higher priority than the struct specializer, so that
   ;; for a generic function with methods dispatching structs and on OClosures,
   ;; we first try `oclosure-type' before `type-of' since `type-of' will return
@@ -1394,7 +1429,7 @@ Used internally for the (major-mode MODE) context specializers."
      ;; take place without requiring cl-lib.
      (let ((class (cl--find-class type)))
        (and (cl-typep class 'oclosure--class)
-            (list cl-generic--oclosure-generalizer))))
+            (list cl--generic-oclosure-generalizer))))
    (cl-call-next-method)))
 
 (cl--generic-prefill-dispatchers 0 oclosure)
-- 
2.39.5