scratch/oclosure ae0bfc4f75 05/25: * lisp/loadup.el (oclosure): Load before `nadvice`

[Stefan Monnier]

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

    * lisp/loadup.el (oclosure): Load before `nadvice`
    
    * lisp/loadup.el (oclosure): Load before `nadvice`.
    
    * lisp/emacs-lisp/cl-generic.el (cl--generic-class-parents): Move to
    `cl-preloaded.el`.
    (cl--generic-struct-specializers, cl-generic--oclosure-specializers)
    (cl--generic-specializers-apply-to-type-p): Use its new name.
    
    * lisp/emacs-lisp/cl-preloaded.el (cl--class-allparents): New function
    moved from `cl-generic.el`.
    
    * lisp/emacs-lisp/oclosure.el (oclosure-define): Use it.
    
    * lisp/emacs-lisp/cl-macs.el (pcase--mutually-exclusive-p):
    Don't advise if `nadvice` has not yet been loaded.
---
 lisp/emacs-lisp/cl-generic.el   | 18 +++++-------------
 lisp/emacs-lisp/cl-macs.el      |  5 +++--
 lisp/emacs-lisp/cl-preloaded.el | 11 +++++++++++
 lisp/emacs-lisp/oclosure.el     |  2 +-
 lisp/loadup.el                  |  4 ++--
 5 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index ecd384d8b0..b7b2d2cd22 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1040,7 +1040,7 @@ MET-NAME is as returned by 
`cl--generic-load-hist-format'."
                  (let ((sclass (cl--find-class specializer))
                        (tclass (cl--find-class type)))
                    (when (and sclass tclass)
-                     (member specializer (cl--generic-class-parents 
tclass))))))
+                     (member specializer (cl--class-allparents tclass))))))
            (setq applies t)))
     applies))
 
@@ -1169,22 +1169,14 @@ These match if the argument is `eql' to VAL."
   ;; Use exactly the same code as for `typeof'.
   `(if ,name (type-of ,name) 'null))
 
-(defun cl--generic-class-parents (class)
-  (let ((parents ())
-        (classes (list class)))
-    ;; BFS precedence.  FIXME: Use a topological sort.
-    (while (let ((class (pop classes)))
-             (cl-pushnew (cl--class-name class) parents)
-             (setq classes
-                   (append classes
-                           (cl--class-parents class)))))
-    (nreverse parents)))
+(define-obsolete-function-alias 'cl--generic-class-parents
+  #'cl--class-allparents "29.1")
 
 (defun cl--generic-struct-specializers (tag &rest _)
   (and (symbolp tag)
        (let ((class (get tag 'cl--class)))
          (when (cl-typep class 'cl-structure-class)
-           (cl--generic-class-parents class)))))
+           (cl--class-allparents class)))))
 
 (cl-generic-define-generalizer cl--generic-struct-generalizer
   50 #'cl--generic-struct-tag
@@ -1276,7 +1268,7 @@ Used internally for the (major-mode MODE) context 
specializers."
   (and (symbolp tag)
        (let ((class (cl--find-class tag)))
          (when (cl-typep class 'oclosure--class)
-           (cl--generic-class-parents class)))))
+           (cl--class-allparents class)))))
 
 (cl-generic-define-generalizer cl-generic--oclosure-generalizer
   50 #'cl--generic-oclosure-tag
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index f78fdcf008..d2c2114d13 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3282,8 +3282,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/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index ef60b266f9..07b0013b50 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -305,6 +305,17 @@ supertypes from the most specific to least specific.")
 (cl-assert (cl--class-p (cl--find-class 'cl-structure-class)))
 (cl-assert (cl--class-p (cl--find-class 'cl-structure-object)))
 
+(defun cl--class-allparents (class)
+  (let ((parents ())
+        (classes (list class)))
+    ;; BFS precedence.  FIXME: Use a topological sort.
+    (while (let ((class (pop classes)))
+             (cl-pushnew (cl--class-name class) parents)
+             (setq classes
+                   (append classes
+                           (cl--class-parents class)))))
+    (nreverse parents)))
+
 ;; Make sure functions defined with cl-defsubst can be inlined even in
 ;; packages which do not require CL.  We don't put an autoload cookie
 ;; directly on that function, since those cookies only go to cl-loaddefs.
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index a187136168..9c05f1752c 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -148,7 +148,7 @@
                                (cl--make-slot-descriptor field nil nil
                                                          '((:read-only . t))))
                              slots)))
-         (allparents (apply #'append (mapcar #'cl--generic-class-parents
+         (allparents (apply #'append (mapcar #'cl--class-allparents
                                              parents)))
          (class (oclosure--class-make name docstring slotdescs parents
                                  (delete-dups
diff --git a/lisp/loadup.el b/lisp/loadup.el
index b5348d1c3f..46063f9b97 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -195,8 +195,9 @@
   (setq definition-prefixes new))
 
 (load "button")                  ;After loaddefs, because of define-minor-mode!
-(load "emacs-lisp/nadvice")
 (load "emacs-lisp/cl-preloaded")
+(load "emacs-lisp/oclosure")          ;Used by cl-generic and nadvice
+(load "emacs-lisp/nadvice")
 (load "obarray")        ;abbrev.el is implemented in terms of obarrays.
 (load "abbrev")         ;lisp-mode.el and simple.el use define-abbrev-table.
 (load "simple")
@@ -247,7 +248,6 @@
 (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"))