]> git.eshelyaron.com Git - emacs.git/commitdiff
* lisp/loadup.el (oclosure): Load before `nadvice`
authorStefan Monnier <monnier@iro.umontreal.ca>
Tue, 14 Dec 2021 00:07:32 +0000 (19:07 -0500)
committerStefan Monnier <monnier@iro.umontreal.ca>
Tue, 14 Dec 2021 00:07:32 +0000 (19:07 -0500)
* 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
lisp/emacs-lisp/cl-macs.el
lisp/emacs-lisp/cl-preloaded.el
lisp/emacs-lisp/oclosure.el
lisp/loadup.el

index ecd384d8b0ff2a1fa814a7503de97d1ceb818d91..b7b2d2cd22c0ac978b0383a3f017e0c8ed4fc095 100644 (file)
@@ -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
index f78fdcf0085436f8114837b3df2c750e1132a4a4..d2c2114d139b2bba69343116f1230b99f97081b5 100644 (file)
@@ -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)
index ef60b266f9efbdfbe63d7f609240e88b9124993b..07b0013b5069ed4128587ddfd75d0471692d77e9 100644 (file)
@@ -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.
index a18713616820febbbcc9b71fdd346f768a019b51..9c05f1752c8ed4e7580ea7f754ed19fd5ee490a0 100644 (file)
                                (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
index b5348d1c3f5f88f33d560c0bc9dc9ae3e8f80b8c..46063f9b977f77b7de968a38ccfa3f4c7a65ae6c 100644 (file)
   (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")
 (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"))