* lisp/loadup.el ("emacs-lisp/cl-generic"): Preload
* src/lisp.mk (lisp): Add emacs-lisp/cl-generic.elc. * lisp/emacs-lisp/cl-generic.el (cl-generic-define-method): Avoid defalias for closures which are not immutable. (cl--generic-prefill-dispatchers): New macro. Use it to prefill the dispatchers table with various entries. * lisp/emacs-lisp/ert.el (emacs-lisp-mode-hook): * lisp/emacs-lisp/seq.el (emacs-lisp-mode-hook): Use add-hook.
This commit is contained in:
parent
8d69f38a94
commit
37ab2245f2
5 changed files with 43 additions and 15 deletions
|
@ -438,7 +438,16 @@ which case this method will be invoked when the argument is `eql' to VAL.
|
|||
;; the generic function.
|
||||
current-load-list)
|
||||
;; For aliases, cl--generic-name gives us the actual name.
|
||||
(defalias (cl--generic-name generic) gfun))))
|
||||
(funcall
|
||||
(if purify-flag
|
||||
;; BEWARE! Don't purify this function definition, since that leads
|
||||
;; to memory corruption if the hash-tables it holds are modified
|
||||
;; (the GC doesn't trace those pointers).
|
||||
#'fset
|
||||
;; But do use `defalias' in the normal case, so that it interacts
|
||||
;; properly with nadvice, e.g. for tracing/debug-on-entry.
|
||||
#'defalias)
|
||||
(cl--generic-name generic) gfun))))
|
||||
|
||||
(defmacro cl--generic-with-memoization (place &rest code)
|
||||
(declare (indent 1) (debug t))
|
||||
|
@ -696,6 +705,25 @@ methods.")
|
|||
(if (eq specializer t) (list cl--generic-t-generalizer)
|
||||
(error "Unknown specializer %S" specializer)))
|
||||
|
||||
(defmacro cl--generic-prefill-dispatchers (arg-or-context specializer)
|
||||
(unless (integerp arg-or-context)
|
||||
(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 ,@(cl-generic-generalizers specializer)
|
||||
,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
|
||||
;; to the compile-time one, in which case `fun' may not be correct
|
||||
;; any more!
|
||||
`(let ((dispatch `(,',arg-or-context
|
||||
,@(cl-generic-generalizers ',specializer)
|
||||
,cl--generic-t-generalizer)))
|
||||
;; (message "Prefilling for %S with \n%S" dispatch ',fun)
|
||||
(puthash dispatch ',fun cl--generic-dispatchers))))
|
||||
|
||||
(cl-defmethod cl-generic-combine-methods (generic methods)
|
||||
"Standard support for :after, :before, :around, and `:extra NAME' qualifiers."
|
||||
(cl--generic-standard-method-combination generic methods))
|
||||
|
@ -869,17 +897,6 @@ Can only be used from within the lexical body of a primary or around method."
|
|||
80 (lambda (name) `(gethash (car-safe ,name) cl--generic-head-used))
|
||||
(lambda (tag) (if (eq (car-safe tag) 'head) (list tag)))))
|
||||
|
||||
;; Pre-fill the cl--generic-dispatchers table.
|
||||
;; We have two copies of `(0 ...)' but we can't share them via `let' because
|
||||
;; they're not used at the same time (one is compile-time, one is run-time).
|
||||
(puthash `(0 ,cl--generic-head-generalizer ,cl--generic-t-generalizer)
|
||||
(eval-when-compile
|
||||
(unless (fboundp 'cl--generic-get-dispatcher)
|
||||
(require 'cl-generic))
|
||||
(cl--generic-get-dispatcher
|
||||
`(0 ,cl--generic-head-generalizer ,cl--generic-t-generalizer)))
|
||||
cl--generic-dispatchers)
|
||||
|
||||
(cl-defmethod cl-generic-generalizers :extra "head" (specializer)
|
||||
"Support for the `(head VAL)' specializers."
|
||||
;; We have to implement `head' here using the :extra qualifier,
|
||||
|
@ -890,6 +907,8 @@ Can only be used from within the lexical body of a primary or around method."
|
|||
(gethash (cadr specializer) cl--generic-head-used) specializer)
|
||||
(list cl--generic-head-generalizer)))
|
||||
|
||||
(cl--generic-prefill-dispatchers 0 (head eql))
|
||||
|
||||
;;; Support for (eql <val>) specializers.
|
||||
|
||||
(defvar cl--generic-eql-used (make-hash-table :test #'eql))
|
||||
|
@ -904,6 +923,9 @@ Can only be used from within the lexical body of a primary or around method."
|
|||
(puthash (cadr specializer) specializer cl--generic-eql-used)
|
||||
(list cl--generic-eql-generalizer))
|
||||
|
||||
(cl--generic-prefill-dispatchers 0 (eql nil))
|
||||
(cl--generic-prefill-dispatchers window-system (eql nil))
|
||||
|
||||
;;; Support for cl-defstructs specializers.
|
||||
|
||||
(defun cl--generic-struct-tag (name)
|
||||
|
@ -960,6 +982,8 @@ Can only be used from within the lexical body of a primary or around method."
|
|||
(list cl--generic-struct-generalizer))))
|
||||
(cl-call-next-method)))
|
||||
|
||||
(cl--generic-prefill-dispatchers 0 cl--generic-generalizer)
|
||||
|
||||
;;; Dispatch on "system types".
|
||||
|
||||
(defconst cl--generic-typeof-types
|
||||
|
@ -998,6 +1022,8 @@ Can only be used from within the lexical body of a primary or around method."
|
|||
(list cl--generic-typeof-generalizer)))
|
||||
(cl-call-next-method)))
|
||||
|
||||
(cl--generic-prefill-dispatchers 0 integer)
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "cl-loaddefs.el"
|
||||
;; End:
|
||||
|
|
|
@ -2537,7 +2537,7 @@ To be used in the ERT results buffer."
|
|||
(add-to-list 'minor-mode-alist '(ert--current-run-stats
|
||||
(:eval
|
||||
(ert--tests-running-mode-line-indicator))))
|
||||
(add-to-list 'emacs-lisp-mode-hook 'ert--activate-font-lock-keywords)
|
||||
(add-hook 'emacs-lisp-mode-hook #'ert--activate-font-lock-keywords)
|
||||
|
||||
(defun ert--unload-function ()
|
||||
"Unload function to undo the side-effects of loading ert.el."
|
||||
|
@ -2548,7 +2548,7 @@ To be used in the ERT results buffer."
|
|||
nil)
|
||||
|
||||
(defvar ert-unload-hook '())
|
||||
(add-hook 'ert-unload-hook 'ert--unload-function)
|
||||
(add-hook 'ert-unload-hook #'ert--unload-function)
|
||||
|
||||
|
||||
(provide 'ert)
|
||||
|
|
|
@ -442,7 +442,7 @@ If no element is found, return nil."
|
|||
(unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
|
||||
;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
|
||||
;; we automatically highlight macros.
|
||||
(add-to-list 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
|
||||
(add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
|
||||
|
||||
(provide 'seq)
|
||||
;;; seq.el ends here
|
||||
|
|
|
@ -193,6 +193,7 @@
|
|||
(load "language/cham")
|
||||
|
||||
(load "indent")
|
||||
(load "emacs-lisp/cl-generic")
|
||||
(load "frame")
|
||||
(load "startup")
|
||||
(load "term/tty-colors")
|
||||
|
|
|
@ -113,6 +113,7 @@ lisp = \
|
|||
$(lispsource)/language/cham.elc \
|
||||
$(lispsource)/indent.elc \
|
||||
$(lispsource)/window.elc \
|
||||
$(lispsource)/emacs-lisp/cl-generic.elc \
|
||||
$(lispsource)/frame.elc \
|
||||
$(lispsource)/term/tty-colors.elc \
|
||||
$(lispsource)/font-core.elc \
|
||||
|
|
Loading…
Add table
Reference in a new issue