From 06ea82e4e3b9c419a632082ddbce7ec5fe933c9c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 17 Mar 2022 19:07:59 -0400 Subject: [PATCH] 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 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.") -- 2.39.2