From f262a6af3694b41828ffb8e62a800f8a3ed4e4aa Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Sat, 19 Feb 2022 14:20:02 -0500
Subject: (macroexp-warn-and-return): Fix bug#53618

* lisp/emacs-lisp/macroexp.el (macroexp-warn-and-return):
Reorder arguments to preserve compatibility with that of Emacs-28.
(macroexp--unfold-lambda, macroexp--expand-all):
* lisp/emacs-lisp/pcase.el (pcase-compile-patterns, pcase--u1):
* lisp/emacs-lisp/gv.el (gv-ref):
* lisp/emacs-lisp/eieio.el (defclass):
* lisp/emacs-lisp/eieio-core.el (eieio-oref, eieio-oref-default)
(eieio-oset-default):
* lisp/emacs-lisp/easy-mmode.el (define-minor-mode):
* lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet, cl-defstruct):
* lisp/emacs-lisp/cl-generic.el (cl-defmethod):
* lisp/emacs-lisp/byte-run.el (defmacro, defun):
* lisp/emacs-lisp/bindat.el (bindat--type): Adjust accordingly.
---
 lisp/emacs-lisp/cl-generic.el | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 5e0e0834fff..b44dda6f9d4 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -499,7 +499,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
              lambda-doc                 ; documentation string
              def-body)))                ; part to be debugged
   (let ((qualifiers nil)
-        (org-name name))
+        (orig-name name))
     (while (cl-generic--method-qualifier-p args)
       (push args qualifiers)
       (setq args (pop body)))
@@ -514,9 +514,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
                    (byte-compile-warning-enabled-p 'obsolete name))
                (let* ((obsolete (get name 'byte-obsolete-info)))
                  (macroexp-warn-and-return
-                  org-name
                   (macroexp--obsolete-warning name obsolete "generic function")
-                  nil)))
+                  nil nil nil orig-name)))
          ;; You could argue that `defmethod' modifies rather than defines the
          ;; function, so warnings like "not known to be defined" are fair game.
          ;; But in practice, it's common to use `cl-defmethod'
-- 
cgit v1.2.3


From 693484d36b1326aebd895314570167ca8da87d69 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Thu, 17 Mar 2022 10:07:35 -0400
Subject: * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Warn suspicious args

---
 lisp/emacs-lisp/cl-generic.el | 11 +++++++++++
 1 file changed, 11 insertions(+)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b44dda6f9d4..7b11c0c8159 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -262,6 +262,16 @@ DEFAULT-BODY, if present, is used as the body of a default method.
          (declarations nil)
          (methods ())
          (options ())
+         (warnings
+          (let ((nonsymargs
+                 (delq nil (mapcar (lambda (arg) (unless (symbolp arg) arg))
+                                   args))))
+            (when nonsymargs
+              (list
+               (macroexp-warn-and-return
+                (format "Non-symbol arguments to cl-defgeneric: %s"
+                        (mapconcat #'prin1-to-string nonsymargs ""))
+                nil nil nil nonsymargs)))))
          next-head)
     (while (progn (setq next-head (car-safe (car options-and-methods)))
                   (or (keywordp next-head)
@@ -284,6 +294,7 @@ DEFAULT-BODY, if present, is used as the body of a default method.
       (setq name (gv-setter (cadr name))))
     `(prog1
          (progn
+           ,@warnings
            (defalias ',name
              (cl-generic-define ',name ',args ',(nreverse options))
              ,(if (consp doc)           ;An expression rather than a constant.
-- 
cgit v1.2.3


From 06ea82e4e3b9c419a632082ddbce7ec5fe933c9c Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Thu, 17 Mar 2022 19:07:59 -0400
Subject: Remove some early-bootstrap dependencies for `advice`

The dependencies between `advice`, cl-generic`, `bytecomp`, `cl-lib`,
`simple`, `help`, ... were becoming unmanageable.
Break the reliance on `advice` (which includes making sure the
compiler is not needed during the early bootstrap).

* lisp/simple.el (pre-redisplay-function): Set without using `add-function`.

* lisp/loadup.el (advice, simple): Move to after `cl-generic`.

* lisp/help.el (command-error-function): Set without using `add-function`.
(help-command-error-confusable-suggestions): Explicitly call
`command-error-default-function` instead.

* lisp/emacs-lisp/cl-macs.el (pcase--mutually-exclusive-p): Don't
optimize during early-bootstrap.

* lisp/emacs-lisp/cl-generic.el (cl--generic-lambda): Tiny simplification.
(cl-defmethod): Label the obsolescence warning as it should.
(cl--generic-compiler): New variable.
(cl--generic-get-dispatcher): Use it.
(cl--generic-prefill-dispatchers): Make freshly made dispatchers.
---
 lisp/emacs-lisp/cl-generic.el | 36 +++++++++++++++++++++++++++---------
 lisp/emacs-lisp/cl-macs.el    |  5 +++--
 lisp/help.el                  | 15 +++++++++++----
 lisp/loadup.el                |  4 ++--
 lisp/simple.el                |  8 +++++---
 5 files changed, 48 insertions(+), 20 deletions(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 7b11c0c8159..295512d51ef 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -392,9 +392,9 @@ the specializer used will be the one returned by BODY."
                                    . ,(lambda () spec-args))
                                  macroexpand-all-environment)))
       (require 'cl-lib)        ;Needed to expand `cl-flet' and `cl-function'.
-      (when (assq 'interactive (cadr fun))
+      (when (assq 'interactive body)
         (message "Interactive forms not supported in generic functions: %S"
-                 (assq 'interactive (cadr fun))))
+                 (assq 'interactive body)))
       ;; First macroexpand away the cl-function stuff (e.g. &key and
       ;; destructuring args, `declare' and whatnot).
       (pcase (macroexpand fun macroenv)
@@ -526,7 +526,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
                (let* ((obsolete (get name 'byte-obsolete-info)))
                  (macroexp-warn-and-return
                   (macroexp--obsolete-warning name obsolete "generic function")
-                  nil nil nil orig-name)))
+                  nil (list 'obsolete name) nil orig-name)))
          ;; You could argue that `defmethod' modifies rather than defines the
          ;; function, so warnings like "not known to be defined" are fair game.
          ;; But in practice, it's common to use `cl-defmethod'
@@ -614,6 +614,14 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
 
 (defvar cl--generic-dispatchers (make-hash-table :test #'equal))
 
+(defvar cl--generic-compiler
+  ;; Don't byte-compile the dispatchers if cl-generic itself is not
+  ;; 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 (consp (lambda (x) (+ x 1)))
+      (lambda (exp) (eval exp t)) #'byte-compile))
+
 (defun cl--generic-get-dispatcher (dispatch)
   (with-memoization
       ;; We need `copy-sequence` here because this `dispatch' object might be
@@ -658,7 +666,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
       ;; FIXME: For generic functions with a single method (or with 2 methods,
       ;; one of which always matches), using a tagcode + hash-table is
       ;; overkill: better just use a `cl-typep' test.
-      (byte-compile
+      (funcall
+       cl--generic-compiler
        `(lambda (generic dispatches-left methods)
           ;; FIXME: We should find a way to expand `with-memoize' once
           ;; and forall so we don't need `subr-x' when we get here.
@@ -886,11 +895,20 @@ those methods.")
     (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
-                ,@(apply #'append
-                         (mapcar #'cl-generic-generalizers specializers))
-                ,cl--generic-t-generalizer))))
+  (let ((fun
+         ;; Let-bind cl--generic-dispatchers so we *re*compute the function
+         ;; from scratch, since the one in the cache may be non-compiled!
+         (let ((cl--generic-dispatchers (make-hash-table))
+               ;; When compiling `cl-generic' during bootstrap, make sure
+               ;; we prefill with compiled dispatchers even though the loaded
+               ;; `cl-generic' is still interpreted.
+               (cl--generic-compiler
+                (if (featurep 'bytecomp) #'byte-compile cl--generic-compiler)))
+           (cl--generic-get-dispatcher
+            `(,arg-or-context
+              ,@(apply #'append
+                       (mapcar #'cl-generic-generalizers specializers))
+              ,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
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 0d0b5b51587..5d2a7c03ac4 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3279,8 +3279,9 @@ the form NAME which is a shorthand for (NAME NAME)."
             (funcall orig pred1
                      (cl--defstruct-predicate t2))))
      (funcall orig pred1 pred2))))
-(advice-add 'pcase--mutually-exclusive-p
-            :around #'cl--pcase-mutually-exclusive-p)
+(when (fboundp 'advice-add)           ;Not available during bootstrap.
+  (advice-add 'pcase--mutually-exclusive-p
+              :around #'cl--pcase-mutually-exclusive-p))
 
 
 (defun cl-struct-sequence-type (struct-type)
diff --git a/lisp/help.el b/lisp/help.el
index f1a617f8500..780f5daac73 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -621,7 +621,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
 	 (enable-recursive-minibuffers t)
 	 val)
      (setq val (completing-read (format-prompt "Where is command" fn)
-		                obarray 'commandp t nil nil
+		                obarray #'commandp t nil nil
 		                (and fn (symbol-name fn))))
      (list (unless (equal val "") (intern val))
 	   current-prefix-arg)))
@@ -2147,7 +2147,10 @@ the suggested string to use instead.  See
                   confusables ", ")
        string))))
 
-(defun help-command-error-confusable-suggestions (data _context _signal)
+(defun help-command-error-confusable-suggestions (data context signal)
+  ;; Delegate most of the work to the original default value of
+  ;; `command-error-function' implemented in C.
+  (command-error-default-function data context signal)
   (pcase data
     (`(void-variable ,var)
      (let ((suggestions (help-uni-confusable-suggestions
@@ -2156,8 +2159,12 @@ the suggested string to use instead.  See
          (princ (concat "\n  " suggestions) t))))
     (_ nil)))
 
-(add-function :after command-error-function
-              #'help-command-error-confusable-suggestions)
+(when (eq command-error-function #'command-error-default-function)
+  ;; Override the default set in the C code.
+  ;; This is not done using `add-function' so as to loosen the bootstrap
+  ;; dependencies.
+  (setq command-error-function
+        #'help-command-error-confusable-suggestions))
 
 (define-obsolete-function-alias 'help-for-help-internal #'help-for-help "28.1")
 
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 81172c584d7..faeb9188e49 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -196,11 +196,9 @@
   (setq definition-prefixes new))
 
 (load "button")                  ;After loaddefs, because of define-minor-mode!
-(load "emacs-lisp/nadvice")
 (load "emacs-lisp/cl-preloaded")
 (load "obarray")        ;abbrev.el is implemented in terms of obarrays.
 (load "abbrev")         ;lisp-mode.el and simple.el use define-abbrev-table.
-(load "simple")
 
 (load "help")
 
@@ -251,6 +249,8 @@
 (let ((max-specpdl-size (max max-specpdl-size 1800)))
   ;; A particularly demanding file to load; 1600 does not seem to be enough.
   (load "emacs-lisp/cl-generic"))
+(load "simple")
+(load "emacs-lisp/nadvice")
 (load "minibuffer") ;Needs cl-generic (and define-minor-mode).
 (load "frame")
 (load "startup")
diff --git a/lisp/simple.el b/lisp/simple.el
index accc119e2b3..83f27e0dbb4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6545,9 +6545,11 @@ is set to the buffer displayed in that window.")
         (with-current-buffer (window-buffer win)
           (run-hook-with-args 'pre-redisplay-functions win))))))
 
-(add-function :before pre-redisplay-function
-              #'redisplay--pre-redisplay-functions)
-
+(when (eq pre-redisplay-function #'ignore)
+  ;; Override the default set in the C code.
+  ;; This is not done using `add-function' so as to loosen the bootstrap
+  ;; dependencies.
+  (setq pre-redisplay-function #'redisplay--pre-redisplay-functions))
 
 (defvar-local mark-ring nil
   "The list of former marks of the current buffer, most recent first.")
-- 
cgit v1.2.3


From 6f973faa912a5ac1ba643c6f5deb0c02baa0ba6d Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Wed, 30 Mar 2022 13:54:56 -0400
Subject: cl-generic: Use OClosures for `cl--generic-isnot-nnm-p`

Rewrite the handling of `cl-no-next-method` to get rid of the hideous
hack used in `cl--generic-isnot-nnm-p` and also to try and move
some of the cost to the construction of the effective method rather
than its invocation.  This speeds up method calls measurably when
there's a `cl-call-next-method` in the body.

* lisp/loadup.el ("emacs-lisp/oclosure"): Load.

* lisp/emacs-lisp/oclosure.el (oclosure-define): Remove workaround now
that we're preloaded.

* lisp/emacs-lisp/cl-generic.el (cl--generic-method): Rename `uses-cnm`
to `call-con` to reflect it's not a boolean any more.
(cl-defmethod): Adjust to the new name and new values.
(cl-generic-define-method): Adjust to the new name.
(cl--generic-lambda): Use the new `curried` calling convention.
(cl--generic-no-next-method-function): Delete function.
(cl--generic-nnm): New type.
(cl-generic-call-method): Rewrite to support the various
calling conventions.
(cl--generic-nnm-sample, cl--generic-cnm-sample): Delete consts.
(cl--generic-isnot-nnm-p): Rewrite using `oclosure-type`.
(cl--generic-method-info): Add support for new calling convention.
---
 lisp/emacs-lisp/cl-generic.el | 162 ++++++++++++++++++++++++------------------
 lisp/emacs-lisp/oclosure.el   |   2 -
 lisp/loadup.el                |   1 +
 3 files changed, 95 insertions(+), 70 deletions(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 295512d51ef..279f73f36a2 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -144,13 +144,20 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
 (cl-defstruct (cl--generic-method
                (:constructor nil)
                (:constructor cl--generic-make-method
-                (specializers qualifiers uses-cnm function))
+                (specializers qualifiers call-con function))
                (:predicate nil))
   (specializers nil :read-only t :type list)
   (qualifiers   nil :read-only t :type (list-of atom))
-  ;; USES-CNM is a boolean indicating if FUNCTION expects an extra argument
-  ;; holding the next-method.
-  (uses-cnm     nil :read-only t :type boolean)
+  ;; 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))
 
 (cl-defstruct (cl--generic
@@ -400,6 +407,8 @@ the specializer used will be the one returned by BODY."
       (pcase (macroexpand fun macroenv)
         (`#'(lambda ,args . ,body)
          (let* ((parsed-body (macroexp-parse-body body))
+                (nm (make-symbol "cl--nm"))
+                (arglist (make-symbol "cl--args"))
                 (cnm (make-symbol "cl--cnm"))
                 (nmp (make-symbol "cl--nmp"))
                 (nbody (macroexpand-all
@@ -412,15 +421,49 @@ the specializer used will be the one returned by BODY."
                 ;; is used.
                 ;; FIXME: Also, optimize the case where call-next-method is
                 ;; only called with explicit arguments.
-                (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
-           (cons (not (not uses-cnm))
-                 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
-                      ,@(car parsed-body)
-                      ,(if (not (assq nmp uses-cnm))
-                           nbody
-                         `(let ((,nmp (lambda ()
-                                        (cl--generic-isnot-nnm-p ,cnm))))
-                            ,nbody))))))
+                (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody))
+                (λ-lift (mapcar #'car uses-cnm)))
+           (if (not uses-cnm)
+               (cons nil
+                     `#'(lambda (,@args)
+                          ,@(car parsed-body)
+                          ,nbody))
+             (cons 'curried
+                   `#'(lambda (,nm) ;Called when constructing the effective method.
+                        (let ((,nmp (if (cl--generic-isnot-nnm-p ,nm)
+                                        #'always #'ignore)))
+                          ;; This `(λ (&rest x) .. (apply (λ (args) ..) x))'
+                          ;; dance is needed because we need to get the original
+                          ;; args as a list when `cl-call-next-method' is
+                          ;; called with no arguments.  It's important to
+                          ;; capture it as a list since it needs to distinguish
+                          ;; the nil case from the absent case in optional
+                          ;; arguments and it needs to properly remember the
+                          ;; original value if `nbody' mutates some of its
+                          ;; formal args.
+                          ;; FIXME: This `(λ (&rest ,arglist)' could be skipped
+                          ;; when we know `cnm' is always called with args, and
+                          ;; it could be implemented more efficiently if `cnm'
+                          ;; is always called directly and there are no
+                          ;; `&optional' args.
+                          (lambda (&rest ,arglist)
+                            ,@(let* ((prebody (car parsed-body))
+                                     (ds (if (stringp (car prebody))
+                                             prebody
+                                           (setq prebody (cons nil prebody))))
+                                     (usage (help-split-fundoc (car ds) nil)))
+                                (unless usage
+                                  (setcar ds (help-add-fundoc-usage (car ds)
+                                                                    args)))
+                                prebody)
+                            (let ((,cnm (lambda (&rest args)
+                                          (apply ,nm (or args ,arglist)))))
+                              ;; This `apply+lambda' basically parses
+                              ;; `arglist' according to `args'.
+                              ;; A destructuring-bind would do the trick
+                              ;; as well when/if it's more efficient.
+                              (apply (lambda (,@λ-lift ,@args) ,nbody)
+                                     ,@λ-lift ,arglist)))))))))
         (f (error "Unexpected macroexpansion result: %S" f))))))
 
 (put 'cl-defmethod 'function-documentation
@@ -518,11 +561,9 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
       (require 'gv)
       (declare-function gv-setter "gv" (name))
       (setq name (gv-setter (cadr name))))
-    (pcase-let* ((`(,uses-cnm . ,fun) (cl--generic-lambda args body)))
+    (pcase-let* ((`(,call-con . ,fun) (cl--generic-lambda args body)))
       `(progn
          ,(and (get name 'byte-obsolete-info)
-               (or (not (fboundp 'byte-compile-warning-enabled-p))
-                   (byte-compile-warning-enabled-p 'obsolete name))
                (let* ((obsolete (get name 'byte-obsolete-info)))
                  (macroexp-warn-and-return
                   (macroexp--obsolete-warning name obsolete "generic function")
@@ -534,7 +575,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
          ;; The ",'" is a no-op that pacifies check-declare.
          (,'declare-function ,name "")
          (cl-generic-define-method ',name ',(nreverse qualifiers) ',args
-                                   ,uses-cnm ,fun)))))
+                                   ',call-con ,fun)))))
 
 (defun cl--generic-member-method (specializers qualifiers methods)
   (while
@@ -552,7 +593,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
   `(,name ,qualifiers . ,specializers))
 
 ;;;###autoload
-(defun cl-generic-define-method (name qualifiers args uses-cnm function)
+(defun cl-generic-define-method (name qualifiers args call-con function)
   (pcase-let*
       ((generic (cl-generic-ensure-function name))
        (`(,spec-args . ,_) (cl--generic-split-args args))
@@ -561,7 +602,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
                                    spec-arg (cdr spec-arg)))
                              spec-args))
        (method (cl--generic-make-method
-                specializers qualifiers uses-cnm function))
+                specializers qualifiers call-con function))
        (mt (cl--generic-method-table generic))
        (me (cl--generic-member-method specializers qualifiers mt))
        (dispatches (cl--generic-dispatches generic))
@@ -738,29 +779,38 @@ for all those different tags in the method-cache.")
                   (list (cl--generic-name generic)))
         f))))
 
-(defun cl--generic-no-next-method-function (generic method)
-  (lambda (&rest args)
-    (apply #'cl-no-next-method generic method args)))
+(oclosure-define (cl--generic-nnm)
+  "Special type for `call-next-method's that just call `no-next-method'.")
 
 (defun cl-generic-call-method (generic method &optional fun)
   "Return a function that calls METHOD.
 FUN is the function that should be called when METHOD calls
 `call-next-method'."
-  (if (not (cl--generic-method-uses-cnm method))
-      (cl--generic-method-function method)
-    (let ((met-fun (cl--generic-method-function method))
-          (next (or fun (cl--generic-no-next-method-function
-                         generic method))))
-      (lambda (&rest args)
-        (apply met-fun
-               ;; FIXME: This sucks: passing just `next' would
-               ;; be a lot more efficient than the lambda+apply
-               ;; quasi-η, but we need this to implement the
-               ;; "if call-next-method is called with no
-               ;; arguments, then use the previous arguments".
-               (lambda (&rest cnm-args)
-                 (apply next (or cnm-args args)))
-               args)))))
+  (let ((met-fun (cl--generic-method-function method)))
+    (pcase (cl--generic-method-call-con method)
+      ('nil met-fun)
+      ('curried
+       (funcall met-fun (or fun
+                            (oclosure-lambda (cl--generic-nnm) (&rest args)
+                              (apply #'cl-no-next-method generic method
+                                     args)))))
+      ;; FIXME: backward compatibility with old convention for `.elc' files
+      ;; compiled before the `curried' convention.
+      (_
+       (lambda (&rest args)
+         (apply met-fun
+                (if fun
+                    ;; FIXME: This sucks: passing just `next' would
+                    ;; be a lot more efficient than the lambda+apply
+                    ;; quasi-η, but we need this to implement the
+                    ;; "if call-next-method is called with no
+                    ;; arguments, then use the previous arguments".
+                    (lambda (&rest cnm-args)
+                      (apply fun (or cnm-args args)))
+                  (oclosure-lambda (cl--generic-nnm) (&rest cnm-args)
+                    (apply #'cl-no-next-method generic method
+                           (or cnm-args args))))
+                args))))))
 
 ;; Standard CLOS name.
 (defalias 'cl-method-qualifiers #'cl--generic-method-qualifiers)
@@ -926,36 +976,9 @@ those methods.")
   "Standard support for :after, :before, :around, and `:extra NAME' qualifiers."
   (cl--generic-standard-method-combination generic methods))
 
-(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function t t))
-(defconst cl--generic-cnm-sample
-  (funcall (cl--generic-build-combined-method
-            nil (list (cl--generic-make-method () () t #'identity)))))
-
 (defun cl--generic-isnot-nnm-p (cnm)
   "Return non-nil if CNM is the function that calls `cl-no-next-method'."
-  ;; ¡Big Gross Ugly Hack!
-  ;; `next-method-p' just sucks, we should let it die.  But EIEIO did support
-  ;; it, and some packages use it, so we need to support it.
-  (catch 'found
-    (cl-assert (function-equal cnm cl--generic-cnm-sample))
-    (if (byte-code-function-p cnm)
-        (let ((cnm-constants (aref cnm 2))
-              (sample-constants (aref cl--generic-cnm-sample 2)))
-          (dotimes (i (length sample-constants))
-            (when (function-equal (aref sample-constants i)
-                                  cl--generic-nnm-sample)
-              (throw 'found
-                     (not (function-equal (aref cnm-constants i)
-                                          cl--generic-nnm-sample))))))
-      (cl-assert (eq 'closure (car-safe cl--generic-cnm-sample)))
-      (let ((cnm-env (cadr cnm)))
-        (dolist (vb (cadr cl--generic-cnm-sample))
-          (when (function-equal (cdr vb) cl--generic-nnm-sample)
-            (throw 'found
-                   (not (function-equal (cdar cnm-env)
-                                        cl--generic-nnm-sample))))
-          (setq cnm-env (cdr cnm-env)))))
-    (error "Haven't found no-next-method-sample in cnm-sample")))
+  (not (eq (oclosure-type cnm) 'cl--generic-nnm)))
 
 ;;; Define some pre-defined generic functions, used internally.
 
@@ -1031,9 +1054,12 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
 (defun cl--generic-method-info (method)
   (let* ((specializers (cl--generic-method-specializers method))
          (qualifiers   (cl--generic-method-qualifiers method))
-         (uses-cnm     (cl--generic-method-uses-cnm method))
+         (call-con     (cl--generic-method-call-con method))
          (function     (cl--generic-method-function method))
-         (args (help-function-arglist function 'names))
+         (args (help-function-arglist (if (not (eq call-con 'curried))
+                                          function
+                                        (funcall function #'ignore))
+                                      'names))
          (docstring (documentation function))
          (qual-string
           (if (null qualifiers) ""
@@ -1044,7 +1070,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
                       (let ((split (help-split-fundoc docstring nil)))
                         (if split (cdr split) docstring))))
          (combined-args ()))
-    (if uses-cnm (setq args (cdr args)))
+    (if (eq t call-con) (setq args (cdr args)))
     (dolist (specializer specializers)
       (let ((arg (if (eq '&rest (car args))
                      (intern (format "arg%d" (length combined-args)))
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index f5a21151f13..db108bd7bee 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -248,8 +248,6 @@ list of slot properties.  The currently known properties are the following:
        ,(when options (macroexp-warn-and-return name
                        (format "Ignored options: %S" options)
                        nil))
-       (eval-when-compile (unless (fboundp 'oclosure--define)
-                            (load "oclosure.el")))
        (eval-and-compile
          (oclosure--define ',name ,docstring ',parent-names ',slots
                            ,@(when predicate `(:predicate ',predicate))))
diff --git a/lisp/loadup.el b/lisp/loadup.el
index faeb9188e49..6ca699f9016 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -197,6 +197,7 @@
 
 (load "button")                  ;After loaddefs, because of define-minor-mode!
 (load "emacs-lisp/cl-preloaded")
+(load "emacs-lisp/oclosure")          ;Used by cl-generic
 (load "obarray")        ;abbrev.el is implemented in terms of obarrays.
 (load "abbrev")         ;lisp-mode.el and simple.el use define-abbrev-table.
 
-- 
cgit v1.2.3


From af0ea35ea00725d2700a5215b56b725dc0d88d0d Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Thu, 31 Mar 2022 13:36:40 +0200
Subject: Tweak how functions are formatted in Implementation in *Help*

* lisp/emacs-lisp/cl-generic.el (cl--generic-describe): Include
the function name in the implementations (bug#54628).  This
clarifies what we're talking about here, and avoids getting
(function ...) translated into #'...
---
 lisp/emacs-lisp/cl-generic.el | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 279f73f36a2..5cbdb9523ac 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1098,7 +1098,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
         (dolist (method (cl--generic-method-table generic))
           (let* ((info (cl--generic-method-info method)))
             ;; FIXME: Add hyperlinks for the types as well.
-            (insert (format "%s%S" (nth 0 info) (nth 1 info)))
+            (insert (format "%s%S" (nth 0 info) (cons function (nth 1 info))))
             (let* ((met-name (cl--generic-load-hist-format
                               function
                               (cl--generic-method-qualifiers method)
-- 
cgit v1.2.3


From ff067408e460c02e69c5b7fd06a03c9b12a5744b Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Fri, 1 Apr 2022 08:54:55 -0400
Subject: OClosure: Add support for defmethod dispatch

* lisp/emacs-lisp/oclosure.el (oclosure--class): Add slot `allparents`.
(oclosure--class-make): Add corresponding arg `allparents`.
(oclosure, oclosure--build-class): Pass the new arg to the constructor.
(oclosure--define): Make the predicate function understand subtyping.

* lisp/emacs-lisp/cl-preloaded.el (cl--class-allparents): Move from
`cl-generic.el`.

* lisp/emacs-lisp/cl-generic.el (cl--generic-class-parents): Move to
`cl-preloaded.el` and rename to `cl--class-allparents`.
Adjust all callers.
(cl--generic-oclosure-tag, cl-generic--oclosure-specializers): New functions.
(cl-generic-generalizers) <oclosure-struct>: New generalizer.

* test/lisp/emacs-lisp/oclosure-tests.el (oclosure-test-gen):
New generic function.
(oclosure-test): Add test for dispatch on oclosure types.
---
 lisp/emacs-lisp/cl-generic.el          | 51 +++++++++++++++++++++++++---------
 lisp/emacs-lisp/cl-preloaded.el        | 11 ++++++++
 lisp/emacs-lisp/oclosure.el            | 16 +++++++----
 test/lisp/emacs-lisp/oclosure-tests.el | 13 +++++++++
 4 files changed, 73 insertions(+), 18 deletions(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 5cbdb9523ac..32a5fe5e54b 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1126,7 +1126,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
                  (let ((sclass (cl--find-class specializer))
                        (tclass (cl--find-class type)))
                    (when (and sclass tclass)
-                     (member specializer (cl--generic-class-parents tclass))))))
+                     (member specializer (cl--class-allparents tclass))))))
            (setq applies t)))
     applies))
 
@@ -1255,22 +1255,11 @@ These match if the argument is `eql' to VAL."
   ;; Use exactly the same code as for `typeof'.
   `(if ,name (type-of ,name) 'null))
 
-(defun cl--generic-class-parents (class)
-  (let ((parents ())
-        (classes (list class)))
-    ;; BFS precedence.  FIXME: Use a topological sort.
-    (while (let ((class (pop classes)))
-             (cl-pushnew (cl--class-name class) parents)
-             (setq classes
-                   (append classes
-                           (cl--class-parents class)))))
-    (nreverse parents)))
-
 (defun cl--generic-struct-specializers (tag &rest _)
   (and (symbolp tag)
        (let ((class (get tag 'cl--class)))
          (when (cl-typep class 'cl-structure-class)
-           (cl--generic-class-parents class)))))
+           (cl--class-allparents class)))))
 
 (cl-generic-define-generalizer cl--generic-struct-generalizer
   50 #'cl--generic-struct-tag
@@ -1353,6 +1342,42 @@ Used internally for the (major-mode MODE) context specializers."
                     (progn (cl-assert (null modes)) mode)
                   `(derived-mode ,mode . ,modes))))
 
+;;; Dispatch on OClosure type
+
+;; It would make sense to put this into `oclosure.el' except that when
+;; `oclosure.el' is loaded `cl-defmethod' is not available yet.
+
+(defun cl--generic-oclosure-tag (name &rest _)
+  `(oclosure-type ,name))
+
+(defun cl-generic--oclosure-specializers (tag &rest _)
+  (and (symbolp tag)
+       (let ((class (cl--find-class tag)))
+         (when (cl-typep class 'oclosure--class)
+           (oclosure--class-allparents class)))))
+
+(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
+  ;; non-nil for an OClosure as well.
+  51 #'cl--generic-oclosure-tag
+  #'cl-generic--oclosure-specializers)
+
+(cl-defmethod cl-generic-generalizers :extra "oclosure-struct" (type)
+  "Support for dispatch on types defined by `oclosure-define'."
+  (or
+   (when (symbolp type)
+     ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than
+     ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can
+     ;; take place without requiring cl-lib.
+     (let ((class (cl--find-class type)))
+       (and (cl-typep class 'oclosure--class)
+            (list cl-generic--oclosure-generalizer))))
+   (cl-call-next-method)))
+
+(cl--generic-prefill-dispatchers 0 oclosure)
+
 ;;; Support for unloading.
 
 (cl-defmethod loadhist-unload-element ((x (head cl-defmethod)))
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 6aa45526d84..93713f506d2 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -305,6 +305,17 @@ supertypes from the most specific to least specific.")
 (cl-assert (cl--class-p (cl--find-class 'cl-structure-class)))
 (cl-assert (cl--class-p (cl--find-class 'cl-structure-object)))
 
+(defun cl--class-allparents (class)
+  (let ((parents ())
+        (classes (list class)))
+    ;; BFS precedence.  FIXME: Use a topological sort.
+    (while (let ((class (pop classes)))
+             (cl-pushnew (cl--class-name class) parents)
+             (setq classes
+                   (append classes
+                           (cl--class-parents class)))))
+    (nreverse parents)))
+
 ;; Make sure functions defined with cl-defsubst can be inlined even in
 ;; packages which do not require CL.  We don't put an autoload cookie
 ;; directly on that function, since those cookies only go to cl-loaddefs.
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index db108bd7bee..c37a5352a3a 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -131,16 +131,17 @@
 (cl-defstruct (oclosure--class
                (:constructor nil)
                (:constructor oclosure--class-make
-                ( name docstring slots parents
+                ( name docstring slots parents allparents
                   &aux (index-table (oclosure--index-table slots))))
                (:include cl--class)
                (:copier nil))
-  "Metaclass for OClosure classes.")
+  "Metaclass for OClosure classes."
+  (allparents nil :read-only t :type (list-of symbol)))
 
 (setf (cl--find-class 'oclosure)
       (oclosure--class-make 'oclosure
                             "The root parent of all OClosure classes"
-                            nil nil))
+                            nil nil '(oclosure)))
 (defun oclosure--p (oclosure)
   (not (not (oclosure-type oclosure))))
 
@@ -283,7 +284,9 @@ list of slot properties.  The currently known properties are the following:
     (oclosure--class-make name docstring slotdescs
                           (if (cdr parent-names)
                               (oclosure--class-parents parent-class)
-                            (list parent-class)))))
+                            (list parent-class))
+                          (cons name (oclosure--class-allparents
+                                      parent-class)))))
 
 (defmacro oclosure--define-functions (name copiers)
   (let* ((class (cl--find-class name))
@@ -324,7 +327,10 @@ list of slot properties.  The currently known properties are the following:
                               &rest props)
   (let* ((class (oclosure--build-class name docstring parent-names slots))
          (pred (lambda (oclosure)
-                 (eq name (oclosure-type oclosure))))
+                 (let ((type (oclosure-type oclosure)))
+                   (when type
+                     (memq name (oclosure--class-allparents
+                                 (cl--find-class type)))))))
          (predname (or (plist-get props :predicate)
                        (intern (format "%s--internal-p" name)))))
     (setf (cl--find-class name) class)
diff --git a/test/lisp/emacs-lisp/oclosure-tests.el b/test/lisp/emacs-lisp/oclosure-tests.el
index e7e76fa4bda..c72a9dbd7ad 100644
--- a/test/lisp/emacs-lisp/oclosure-tests.el
+++ b/test/lisp/emacs-lisp/oclosure-tests.el
@@ -29,6 +29,16 @@
   "Simple OClosure."
   fst snd name)
 
+(cl-defmethod oclosure-test-gen ((_x compiled-function)) "#<bytecode>")
+
+(cl-defmethod oclosure-test-gen ((_x cons)) "#<cons>")
+
+(cl-defmethod oclosure-test-gen ((_x oclosure))
+  (format "#<oclosure:%s>" (cl-call-next-method)))
+
+(cl-defmethod oclosure-test-gen ((_x oclosure-test))
+  (format "#<oclosure-test:%s>" (cl-call-next-method)))
+
 (ert-deftest oclosure-test ()
   (let* ((i 42)
          (ocl1 (oclosure-lambda (oclosure-test (fst 1) (snd 2) (name "hi"))
@@ -51,6 +61,9 @@
     (should (equal (funcall (oclosure-test-copy1 ocl1 9)) '(9 2 44)))
     (should (cl-typep ocl1 'oclosure-test))
     (should (cl-typep ocl1 'oclosure))
+    (should (member (oclosure-test-gen ocl1)
+                    '("#<oclosure-test:#<oclosure:#<cons>>>"
+                      "#<oclosure-test:#<oclosure:#<bytecode>>>")))
     ))
 
 (ert-deftest oclosure-test-limits ()
-- 
cgit v1.2.3


From 6cb688684065ca74b14263fcc22036cededa2bbe Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Fri, 1 Apr 2022 10:02:32 -0400
Subject: cl-generic: Rework obsolescence checks for defmethod

* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Silence obsolescence
warnings in the included methods.
(cl-defmethod): Reuse standard obsolescence checks.

* lisp/emacs-lisp/seq.el (seq-contains): Remove redundant
`with-suppressed-warnings`.
---
 lisp/emacs-lisp/cl-generic.el | 18 ++++++++----------
 lisp/emacs-lisp/seq.el        | 15 +++++++--------
 2 files changed, 15 insertions(+), 18 deletions(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 32a5fe5e54b..1e820adaff6 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -308,8 +308,10 @@ DEFAULT-BODY, if present, is used as the body of a default method.
                   `(help-add-fundoc-usage ,doc ',args)
                 (help-add-fundoc-usage doc args)))
            :autoload-end
-           ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
-                     (nreverse methods)))
+           ,(when methods
+              `(with-suppressed-warnings ((obsolete ,name))
+                 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
+                           (nreverse methods)))))
        ,@(mapcar (lambda (declaration)
                    (let ((f (cdr (assq (car declaration)
                                        defun-declarations-alist))))
@@ -552,8 +554,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
                     cl--generic-edebug-make-name nil]
              lambda-doc                 ; documentation string
              def-body)))                ; part to be debugged
-  (let ((qualifiers nil)
-        (orig-name name))
+  (let ((qualifiers nil))
     (while (cl-generic--method-qualifier-p args)
       (push args qualifiers)
       (setq args (pop body)))
@@ -563,18 +564,15 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
       (setq name (gv-setter (cadr name))))
     (pcase-let* ((`(,call-con . ,fun) (cl--generic-lambda args body)))
       `(progn
-         ,(and (get name 'byte-obsolete-info)
-               (let* ((obsolete (get name 'byte-obsolete-info)))
-                 (macroexp-warn-and-return
-                  (macroexp--obsolete-warning name obsolete "generic function")
-                  nil (list 'obsolete name) nil orig-name)))
          ;; You could argue that `defmethod' modifies rather than defines the
          ;; function, so warnings like "not known to be defined" are fair game.
          ;; But in practice, it's common to use `cl-defmethod'
          ;; without a previous `cl-defgeneric'.
          ;; The ",'" is a no-op that pacifies check-declare.
          (,'declare-function ,name "")
-         (cl-generic-define-method ',name ',(nreverse qualifiers) ',args
+         ;; We use #' to quote `name' so as to trigger an
+         ;; obsolescence warning when applicable.
+         (cl-generic-define-method #',name ',(nreverse qualifiers) ',args
                                    ',call-con ,fun)))))
 
 (defun cl--generic-member-method (specializers qualifiers methods)
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 1bcb844d8e9..133d3c9e118 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -403,15 +403,14 @@ found or not."
         (setq count (+ 1 count))))
     count))
 
-(with-suppressed-warnings ((obsolete seq-contains))
-  (cl-defgeneric seq-contains (sequence elt &optional testfn)
-    "Return the first element in SEQUENCE that is equal to ELT.
+(cl-defgeneric seq-contains (sequence elt &optional testfn)
+  "Return the first element in SEQUENCE that is equal to ELT.
 Equality is defined by TESTFN if non-nil or by `equal' if nil."
-    (declare (obsolete seq-contains-p "27.1"))
-    (seq-some (lambda (e)
-                (when (funcall (or testfn #'equal) elt e)
-                  e))
-              sequence)))
+  (declare (obsolete seq-contains-p "27.1"))
+  (seq-some (lambda (e)
+              (when (funcall (or testfn #'equal) elt e)
+                e))
+            sequence))
 
 (cl-defgeneric seq-contains-p (sequence elt &optional testfn)
   "Return non-nil if SEQUENCE contains an element equal to ELT.
-- 
cgit v1.2.3


From 338f5667f46282f9b40c25bbf9704566069ec950 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sat, 2 Apr 2022 15:19:05 +0200
Subject: Further tweaks to cl--generic-describe

* lisp/emacs-lisp/cl-generic.el (cl--generic-describe): Further
tweak the look of the implementation output.
---
 lisp/emacs-lisp/cl-generic.el | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 1e820adaff6..2ca84b019fc 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1096,7 +1096,13 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
         (dolist (method (cl--generic-method-table generic))
           (let* ((info (cl--generic-method-info method)))
             ;; FIXME: Add hyperlinks for the types as well.
-            (insert (format "%s%S" (nth 0 info) (cons function (nth 1 info))))
+            (if (length> (nth 0 info) 0)
+                (insert (format "%s%S" (nth 0 info)
+                                (let ((print-quoted nil))
+                                  (nth 1 info))))
+              ;; Make the non-":extra" bits look more like `C-h f'
+              ;; output.
+              (insert (format "%S" (cons function (nth 1 info)))))
             (let* ((met-name (cl--generic-load-hist-format
                               function
                               (cl--generic-method-qualifiers method)
-- 
cgit v1.2.3


From 773d4104a592fda4366d8db27d0307ee23de8bfe Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 4 Apr 2022 12:48:47 +0200
Subject: Further fixes for cl--generic-describe and (function ...)

* lisp/emacs-lisp/cl-generic.el (cl--generic-describe): Fix the #'
problem for defmethods, too (bug#54628).
---
 lisp/emacs-lisp/cl-generic.el | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 2ca84b019fc..179310c145b 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1096,13 +1096,12 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
         (dolist (method (cl--generic-method-table generic))
           (let* ((info (cl--generic-method-info method)))
             ;; FIXME: Add hyperlinks for the types as well.
-            (if (length> (nth 0 info) 0)
-                (insert (format "%s%S" (nth 0 info)
-                                (let ((print-quoted nil))
-                                  (nth 1 info))))
-              ;; Make the non-":extra" bits look more like `C-h f'
-              ;; output.
-              (insert (format "%S" (cons function (nth 1 info)))))
+            (let ((print-quoted nil))
+              (if (length> (nth 0 info) 0)
+                  (insert (format "%s%S" (nth 0 info) (nth 1 info)))
+                ;; Make the non-":extra" bits look more like `C-h f'
+                ;; output.
+                (insert (format "%S" (cons function (nth 1 info))))))
             (let* ((met-name (cl--generic-load-hist-format
                               function
                               (cl--generic-method-qualifiers method)
-- 
cgit v1.2.3


From 0a151b7c29c46ae67ae92d0960e199ae84b3a48b Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Mon, 25 Apr 2022 15:41:04 -0400
Subject: cl-generic.el: Upcase formal args in `C-h o`

Try and improve the display of methods in `C-h o` by moving
the qualifiers to a separate line and upcasing the formal args.
It still needs love, tho.

* lisp/emacs-lisp/cl-generic.el: Upcase formal args in `C-h o`
(cl--generic-upcase-formal-args): New function.
(cl--generic-describe): Use it.
---
 lisp/emacs-lisp/cl-generic.el | 35 +++++++++++++++++++++++++++--------
 1 file changed, 27 insertions(+), 8 deletions(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 179310c145b..200af057cd7 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1078,6 +1078,19 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
     (setq combined-args (append (nreverse combined-args) args))
     (list qual-string combined-args doconly)))
 
+(defun cl--generic-upcase-formal-args (args)
+  (mapcar (lambda (arg)
+            (cond
+             ((symbolp arg)
+              (let ((name (symbol-name arg)))
+                (if (eq ?& (aref name 0)) arg
+                  (intern (upcase name)))))
+             ((consp arg)
+              (cons (intern (upcase (symbol-name (car arg))))
+                    (cdr arg)))
+             (t arg)))
+          args))
+
 (add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
 (defun cl--generic-describe (function)
   ;; Supposedly this is called from help-fns, so help-fns should be loaded at
@@ -1094,14 +1107,20 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
         (insert (propertize "Implementations:\n\n" 'face 'bold))
         ;; Loop over fanciful generics
         (dolist (method (cl--generic-method-table generic))
-          (let* ((info (cl--generic-method-info method)))
+          (pcase-let*
+              ((`(,qualifiers ,args ,doc) (cl--generic-method-info method)))
             ;; FIXME: Add hyperlinks for the types as well.
-            (let ((print-quoted nil))
-              (if (length> (nth 0 info) 0)
-                  (insert (format "%s%S" (nth 0 info) (nth 1 info)))
-                ;; Make the non-":extra" bits look more like `C-h f'
-                ;; output.
-                (insert (format "%S" (cons function (nth 1 info))))))
+            (let ((print-quoted nil)
+                  (quals (if (length> qualifiers 0)
+                             (concat (substring qualifiers
+                                                0 (string-match " *\\'"
+                                                                qualifiers))
+                                     "\n")
+                           "")))
+              (insert (format "%s%S"
+                              quals
+                              (cons function
+                                    (cl--generic-upcase-formal-args args)))))
             (let* ((met-name (cl--generic-load-hist-format
                               function
                               (cl--generic-method-qualifiers method)
@@ -1113,7 +1132,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
                                          'help-function-def met-name file
                                          'cl-defmethod)
                 (insert (substitute-command-keys "'.\n"))))
-            (insert "\n" (or (nth 2 info) "Undocumented") "\n\n")))))))
+            (insert "\n" (or doc "Undocumented") "\n\n")))))))
 
 (defun cl--generic-specializers-apply-to-type-p (specializers type)
   "Return non-nil if a method with SPECIALIZERS applies to TYPE."
-- 
cgit v1.2.3


From 49910adf872a98d9c144d34478a53ecb3e01856f Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Fri, 24 Jun 2022 10:54:01 +0200
Subject: Fix cl-generic bootstrap problems

* lisp/sqlite-mode.el (require):
* lisp/net/eudc.el (require):
* lisp/arc-mode.el (require): Require subr-x, since these files
are using macros from there.
* lisp/emacs-lisp/subr-x.el (with-memoization): Move from here...
* lisp/subr.el (with-memoization): ... to here, as it's used from
the preloaded cl-generic.el file.

* lisp/emacs-lisp/cl-generic.el (cl--generic-compiler): Don't use
the autoloaded `byte-compile' function during bootstrap.
(cl--generic-get-dispatcher): Don't require subr-x, either.

cl-generic has been preloaded since 2015, and most usages of it (in
preloaded files) work fine.  In particular, using `cl-defgeneric' is
unproblematic.  However, `cl-defmethod' would end up pulling in the
byte compiler (at load time), which would make it impossible to use
`cl-defmethod' in pre-loaded files, and this change fixes that (but
possibly not in the most self-evidently correct way).
---
 lisp/arc-mode.el                    |  1 +
 lisp/emacs-lisp/cl-generic.el       |  9 ++++-----
 lisp/emacs-lisp/subr-x.el           | 13 -------------
 lisp/net/eudc.el                    |  1 +
 lisp/sqlite-mode.el                 |  1 +
 lisp/subr.el                        | 12 ++++++++++++
 test/lisp/custom-tests.el           |  1 +
 test/lisp/emacs-lisp/cconv-tests.el |  1 +
 8 files changed, 21 insertions(+), 18 deletions(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 1c5faa1152b..c52f2a44322 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -101,6 +101,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
 
 ;; -------------------------------------------------------------------------
 ;;; Section: Configuration.
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 200af057cd7..6c5813959fa 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -658,8 +658,10 @@ 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 (consp (lambda (x) (+ x 1)))
-      (lambda (exp) (eval exp t)) #'byte-compile))
+  (if (or (consp (lambda (x) (+ x 1)))
+          (not (featurep 'bytecomp)))
+      (lambda (exp) (eval exp t))
+    #'byte-compile))
 
 (defun cl--generic-get-dispatcher (dispatch)
   (with-memoization
@@ -708,9 +710,6 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
       (funcall
        cl--generic-compiler
        `(lambda (generic dispatches-left methods)
-          ;; FIXME: We should find a way to expand `with-memoize' once
-          ;; and forall so we don't need `subr-x' when we get here.
-          (eval-when-compile (require 'subr-x))
           (let ((method-cache (make-hash-table :test #'eql)))
             (lambda (,@fixedargs &rest args)
               (let ,bindings
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 5c3dff62c8a..b0de5d155ac 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -290,19 +290,6 @@ as the new values of the bound variables in the recursive invocation."
       (cl-labels ((,name ,fargs . ,body)) #',name)
       . ,aargs)))
 
-(defmacro with-memoization (place &rest code)
-  "Return the value of CODE and stash it in PLACE.
-If PLACE's value is non-nil, then don't bother evaluating CODE
-and return the value found in PLACE instead."
-  (declare (indent 1) (debug (gv-place body)))
-  (gv-letplace (getter setter) place
-    `(or ,getter
-         ,(macroexp-let2 nil val (macroexp-progn code)
-            `(progn
-               ,(funcall setter val)
-               ,val)))))
-
-
 ;;;###autoload
 (defun string-pixel-width (string)
   "Return the width of STRING in pixels."
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 808d2ca509c..1d9dbbeb754 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -48,6 +48,7 @@
 (require 'wid-edit)
 (require 'cl-lib)
 (require 'eudc-vars)
+(eval-when-compile (require 'subr-x))
 
 ;;{{{      Internal cooking
 
diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el
index 66e2e487d9c..fb2ceab383f 100644
--- a/lisp/sqlite-mode.el
+++ b/lisp/sqlite-mode.el
@@ -24,6 +24,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(eval-when-compile (require 'subr-x))
 
 (declare-function sqlite-execute "sqlite.c")
 (declare-function sqlite-more-p "sqlite.c")
diff --git a/lisp/subr.el b/lisp/subr.el
index 04eec977bb6..075bfb95b7b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6912,4 +6912,16 @@ CONDITION."
         (push buf bufs)))
     bufs))
 
+(defmacro with-memoization (place &rest code)
+  "Return the value of CODE and stash it in PLACE.
+If PLACE's value is non-nil, then don't bother evaluating CODE
+and return the value found in PLACE instead."
+  (declare (indent 1) (debug (gv-place body)))
+  (gv-letplace (getter setter) place
+    `(or ,getter
+         ,(macroexp-let2 nil val (macroexp-progn code)
+            `(progn
+               ,(funcall setter val)
+               ,val)))))
+
 ;;; subr.el ends here
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index 77bb337d6aa..d1effaa72a8 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -24,6 +24,7 @@
 
 (require 'wid-edit)
 (require 'cus-edit)
+(require 'bytecomp)
 
 (ert-deftest custom-theme--load-path ()
   "Test `custom-theme--load-path' behavior."
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index 0668e44ba51..9904c6a969c 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -24,6 +24,7 @@
 (require 'ert)
 (require 'cl-lib)
 (require 'generator)
+(require 'bytecomp)
 
 (ert-deftest cconv-tests-lambda-:documentation ()
   "Docstring for lambda can be specified with :documentation."
-- 
cgit v1.2.3


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: (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(-)

(limited to 'lisp/emacs-lisp/cl-generic.el')

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)
-- 
cgit v1.2.3