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.
This commit is contained in:
parent
751c8f88c4
commit
06ea82e4e3
5 changed files with 48 additions and 20 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
15
lisp/help.el
15
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")
|
||||
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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.")
|
||||
|
|
Loading…
Add table
Reference in a new issue