scratch/oclosure 263172dbfb 02/25: lisp/emacs-lisp/oclosure.el: Make it available to cl-generic

[Stefan Monnier]

branch: scratch/oclosure
commit 263172dbfb929eaa7eb028a60e07011844786ba1
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    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`.
---
 lisp/dired-aux.el             |  2 +-
 lisp/emacs-lisp/cl-generic.el | 27 +++++++++++++++++++++++++++
 lisp/emacs-lisp/oclosure.el   | 36 +++++-------------------------------
 lisp/loadup.el                |  1 +
 lisp/xwidget.el               |  2 +-
 5 files changed, 35 insertions(+), 33 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 5301a3a27f..56c7e191e1 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -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."
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 9de47e4987..152a7a2afa 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -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)))
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 22ce26c1f8..524b71a5a4 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -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
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 71d6a501b9..b5348d1c3f 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -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"))
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index ce9839ebd3..64a1b1bcda 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -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)