mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Move EIEIO's C3 linearization code to subr.el

Browse source 
The code was used to linearize the EIEIO class hierarchy, since
it results in saner results than things like BFS or DFS.
By moving it to `subr.el` we get to benefit from that same
advantage both in `cl--class-allparents` and
in `derived-mode-all-parents`.

* lisp/subr.el (merge-ordered-lists): New function.
(derived-mode-all-parents): Use it to improve parent ordering.

* lisp/emacs-lisp/eieio-core.el (eieio--c3-candidate)
(eieio--c3-merge-lists): Delete functions, replaced by
`merge-ordered-lists`.
(eieio--class-precedence-c3): Use `merge-ordered-lists`.

* lisp/emacs-lisp/cl-preloaded.el (cl--class-allparents):
Use `merge-ordered-lists` to improve parent ordering.
* lisp/emacs-lisp/cl-macs.el (cl--struct-all-parents): Delete function.
(cl--pcase-mutually-exclusive-p): Use `cl--class-allparents` instead.
This commit is contained in:
Stefan Monnier 2023-11-07 18:57:03 -05:00
parent 8323394bc8
commit fbb897b7af
5 changed files with 77 additions and 89 deletions
Download patch file Download diff file Expand all files Collapse all files

17
lisp/emacs-lisp/cl-macs.el
View file

@ -3337,19 +3337,6 @@ To see the documentation for a defined struct type, use
;;; Add cl-struct support to pcase
;;In use by comp.el
(defun cl--struct-all-parents (class) ;FIXME: Merge with `cl--class-allparents'
(when (cl--struct-class-p class)
(let ((res ())
(classes (list class)))
;; BFS precedence.
(while (let ((class (pop classes)))
(push class res)
(setq classes
(append classes
(cl--class-parents class)))))
(nreverse res))))
;;;###autoload
(pcase-defmacro cl-struct (type &rest fields)
"Pcase patterns that match cl-struct EXPVAL of type TYPE.
@ -3395,8 +3382,8 @@ the form NAME which is a shorthand for (NAME NAME)."
(let ((c1 (cl--find-class t1))
(c2 (cl--find-class t2)))
(and c1 c2
(not (or (memq c1 (cl--struct-all-parents c2))
(memq c2 (cl--struct-all-parents c1)))))))
(not (or (memq t1 (cl--class-allparents c2))
(memq t2 (cl--class-allparents c1)))))))
(let ((c1 (and (symbolp t1) (cl--find-class t1))))
(and c1 (cl--struct-class-p c1)
(funcall orig (cl--defstruct-predicate t1)