[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/fcr 76b2766: * lisp/loadup.el (fcr): Load before `nadvice`
From: |
Stefan Monnier |
Subject: |
scratch/fcr 76b2766: * lisp/loadup.el (fcr): Load before `nadvice` |
Date: |
Mon, 13 Dec 2021 19:07:40 -0500 (EST) |
branch: scratch/fcr
commit 76b27662fd7002287790aca1d07cb789a3316f18
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* lisp/loadup.el (fcr): Load before `nadvice`
* lisp/loadup.el (fcr): Load before `nadvice`.
* lisp/emacs-lisp/cl-generic.el (cl--generic-class-parents): Move to
`cl-preloaded.el`.
(cl--generic-struct-specializers, cl-generic--fcr-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/fcr.el (fcr-defstruct): 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/fcr.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 fa7f736..7c46e74 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 'fcr--class)
- (cl--generic-class-parents class)))))
+ (cl--class-allparents class)))))
(cl-generic-define-generalizer cl-generic--fcr-generalizer
50 #'cl--generic-fcr-tag
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index f78fdcf..d2c2114 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 ef60b26..07b0013 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/fcr.el b/lisp/emacs-lisp/fcr.el
index dd9687b..86ebcf3 100644
--- a/lisp/emacs-lisp/fcr.el
+++ b/lisp/emacs-lisp/fcr.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 (fcr--class-make name docstring slotdescs parents
(delete-dups
diff --git a/lisp/loadup.el b/lisp/loadup.el
index dec26ed..d1ed8ba 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/fcr") ;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/fcr") ;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"))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- scratch/fcr 76b2766: * lisp/loadup.el (fcr): Load before `nadvice`,
Stefan Monnier <=