* 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.
(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))
;; 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
(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
(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)
(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.
(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
(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"))