master 06ea82e4e3: Remove some early-bootstrap dependencies for `advice`

[Stefan Monnier]

branch: master
commit 06ea82e4e3b9c419a632082ddbce7ec5fe933c9c
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

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

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 7b11c0c815..295512d51e 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 0d0b5b5158..5d2a7c03ac 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 f1a617f850..780f5daac7 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 81172c584d..faeb9188e4 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 accc119e2b..83f27e0dbb 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.")