[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/oclosure ae0bfc4f75 05/25: * lisp/loadup.el (oclosure): Load bef
From: |
Stefan Monnier |
Subject: |
scratch/oclosure ae0bfc4f75 05/25: * lisp/loadup.el (oclosure): Load before `nadvice` |
Date: |
Fri, 31 Dec 2021 15:40:56 -0500 (EST) |
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"))
- branch scratch/oclosure created (now de320e2003), Stefan Monnier, 2021/12/31
- scratch/oclosure 5574871ec7 09/25: nadvice.el: Use OClosures rather than handmade bytecodes, Stefan Monnier, 2021/12/31
- scratch/oclosure f11349ed20 03/25: * lisp/emacs-lisp/cl-generic.el: Use OClosure for `cl-next-method-p`, Stefan Monnier, 2021/12/31
- scratch/oclosure 230617c90c 16/25: lisp/emacs-lisp/oclosure.el: Signal errors for invalid code, Stefan Monnier, 2021/12/31
- scratch/oclosure e052bb2770 04/25: * lisp/kmacro.el: Use OClosure instead of messing with internals, Stefan Monnier, 2021/12/31
- scratch/oclosure ae493f3513 01/25: OClosure: Hybrids between functions and defstructs, Stefan Monnier, 2021/12/31
- scratch/oclosure ae0bfc4f75 05/25: * lisp/loadup.el (oclosure): Load before `nadvice`,
Stefan Monnier <=
- scratch/oclosure afa68def26 11/25: cl-print.el: Dispatch on `advice` type, Stefan Monnier, 2021/12/31
- scratch/oclosure fe5457ff75 19/25: oclosure.el (oclosure-lambda): Change calling convention, Stefan Monnier, 2021/12/31
- scratch/oclosure d93b0ad4d4 06/25: (interactive-form, function-docstring): New generic functions, Stefan Monnier, 2021/12/31
- scratch/oclosure a444d85977 08/25: Fix bootstrap problems and various misc issues found along the way, Stefan Monnier, 2021/12/31
- scratch/oclosure f44ee8cd53 17/25: oclosure.el (accessor): New type, Stefan Monnier, 2021/12/31
- scratch/oclosure 55a8e92413 20/25: oclosure.el: Add support for mutable slots, Stefan Monnier, 2021/12/31
- scratch/oclosure bc1d94a0d8 21/25: * lisp/emacs-lisp/oclosure.el (Commentary:): Add a few notes, Stefan Monnier, 2021/12/31
- scratch/oclosure 263172dbfb 02/25: lisp/emacs-lisp/oclosure.el: Make it available to cl-generic, Stefan Monnier, 2021/12/31
- scratch/oclosure 3119e59252 07/25: lisp/emacs-lisp/oclosure.el: Rename `oclosure-make` to `oclosure-lambda`, Stefan Monnier, 2021/12/31
- scratch/oclosure 9465a7e59e 10/25: nadvice.el: Restore interactive-form handling, Stefan Monnier, 2021/12/31