lisp/emacs-lisp/oclosure.el: Make it available to cl-generic

* lisp/loadup.el: Load `oclosure`.

* lisp/emacs-lisp/oclosure.el: Don't use `cl-lib` at runtime.
(oclosure--copy): Use `named-let` instead of `cl-mapcar`.
(oclosure--struct-tag, oclosure--struct-specializers, oclosure--struct-generalizer)
(cl-generic-generalizers): Move cl-generic support to cl-generic.

* lisp/emacs-lisp/cl-generic.el (cl--generic-oclosure-tag)
(cl-generic--oclosure-specializers, cl-generic--oclosure-generalizer)
(cl-generic-generalizers): Move OClosure support from `oclosure.el`.
This commit is contained in:
Stefan Monnier 2021-12-13 11:00:04 -05:00
parent ae493f3513
commit 263172dbfb
5 changed files with 35 additions and 33 deletions

View file

@ -3089,7 +3089,7 @@ Use \\[dired-hide-all] to (un)hide all directories."
(dired-next-subdir 1 t))))
;;;###autoload
(defun dired-hide-all (&optional ignored)
(defun dired-hide-all (&optional _ignored)
"Hide all subdirectories, leaving only their header lines.
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."

View file

@ -1293,6 +1293,33 @@ Used internally for the (major-mode MODE) context specializers."
(progn (cl-assert (null modes)) mode)
`(derived-mode ,mode . ,modes))))
;;; Dispatch on OClosure type
(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)
(cl--generic-class-parents class)))))
(cl-generic-define-generalizer cl-generic--oclosure-generalizer
50 #'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)))
;;; Support for unloading.
(cl-defmethod loadhist-unload-element ((x (head cl-defmethod)))

View file

@ -41,7 +41,7 @@
;;; Code:
(require 'cl-lib)
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'subr-x)) ;For `named-let'.
(cl-defstruct (oclosure--class
@ -251,7 +251,10 @@
(let ((env (cadr oclosure)))
`(closure
(,(car env)
,@(cl-mapcar (lambda (b v) (cons (car b) v)) (cdr env) args)
,@(named-let loop ((env (cdr env)) (args args))
(when args
(cons (cons (caar env) (car args))
(loop (cdr env) (cdr args)))))
,@(nthcdr (1+ (length args)) env))
,@(nthcdr 2 oclosure)))))
@ -272,34 +275,5 @@
(eq oclosure--type-sym (caar (cadr oclosure)))
(cdar (cadr oclosure)))))
;;; Support for cl-generic
(defun oclosure--struct-tag (name &rest _)
`(oclosure-type ,name))
(defun oclosure--struct-specializers (tag &rest _)
(and (symbolp tag)
(let ((class (cl--find-class tag)))
(when (cl-typep class 'oclosure--class)
(cl--generic-class-parents class)))))
(cl-generic-define-generalizer oclosure--struct-generalizer
50 #'oclosure--struct-tag
#'oclosure--struct-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 oclosure--struct-generalizer))))
(cl-call-next-method)))
(provide 'oclosure)
;;; oclosure.el ends here

View file

@ -247,6 +247,7 @@
(load "language/cham")
(load "indent")
(load "emacs-lisp/oclosure") ;Used by cl-generic
(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"))

View file

@ -1168,7 +1168,7 @@ Press \\<xwidget-webkit-isearch-mode-map>\\[xwidget-webkit-isearch-exit] to exit
(xwidget-webkit-goto-history xwidget-webkit-history--session id))
(xwidget-webkit-history-reload))
(defun xwidget-webkit-history-reload (&rest ignored)
(defun xwidget-webkit-history-reload (&rest _ignored)
"Reload the current history buffer."
(interactive)
(setq tabulated-list-entries nil)