From: Stefan Monnier Date: Tue, 14 Dec 2021 00:07:32 +0000 (-0500) Subject: * lisp/loadup.el (oclosure): Load before `nadvice` X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ae0bfc4f758b47359e4ce8997781222b34795dfb;p=emacs.git * 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. --- diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index ecd384d8b0f..b7b2d2cd22c 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 f78fdcf0085..d2c2114d139 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 ef60b266f9e..07b0013b506 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 a1871361682..9c05f1752c8 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 b5348d1c3f5..46063f9b977 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"))