1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-19 20:30:29 -08:00

Move EIEIO's C3 linearization code to subr.el

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

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)

View file

@ -323,15 +323,9 @@ supertypes from the most specific to least specific.")
(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)))
(cons (cl--class-name class)
(merge-ordered-lists (mapcar #'cl--class-allparents
(cl--class-parents class)))))
(eval-and-compile
(cl-assert (null (cl--class-parents (cl--find-class 'cl-structure-object)))))

View file

@ -964,49 +964,6 @@ need be... May remove that later...)"
(cdr tuple)
nil)))
;;;
;; Method Invocation order: C3
(defun eieio--c3-candidate (class remaining-inputs)
"Return CLASS if it can go in the result now, otherwise nil."
;; Ensure CLASS is not in any position but the first in any of the
;; element lists of REMAINING-INPUTS.
(and (not (let ((found nil))
(while (and remaining-inputs (not found))
(setq found (member class (cdr (car remaining-inputs)))
remaining-inputs (cdr remaining-inputs)))
found))
class))
(defun eieio--c3-merge-lists (reversed-partial-result remaining-inputs)
"Try to merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order.
If a consistent order does not exist, signal an error."
(setq remaining-inputs (delq nil remaining-inputs))
(if (null remaining-inputs)
;; If all remaining inputs are empty lists, we are done.
(nreverse reversed-partial-result)
;; Otherwise, we try to find the next element of the result. This
;; is achieved by considering the first element of each
;; (non-empty) input list and accepting a candidate if it is
;; consistent with the rests of the input lists.
(let* ((found nil)
(tail remaining-inputs)
(next (progn
(while (and tail (not found))
(setq found (eieio--c3-candidate (caar tail)
remaining-inputs)
tail (cdr tail)))
found)))
(if next
;; The graph is consistent so far, add NEXT to result and
;; merge input lists, dropping NEXT from their heads where
;; applicable.
(eieio--c3-merge-lists
(cons next reversed-partial-result)
(mapcar (lambda (l) (if (eq (cl-first l) next) (cl-rest l) l))
remaining-inputs))
;; The graph is inconsistent, give up
(signal 'inconsistent-class-hierarchy (list remaining-inputs))))))
(defsubst eieio--class/struct-parents (class)
(or (eieio--class-parents class)
`(,eieio-default-superclass)))
@ -1014,14 +971,16 @@ If a consistent order does not exist, signal an error."
(defun eieio--class-precedence-c3 (class)
"Return all parents of CLASS in c3 order."
(let ((parents (eieio--class-parents class)))
(eieio--c3-merge-lists
(list class)
(append
(or
(mapcar #'eieio--class-precedence-c3 parents)
`((,eieio-default-superclass)))
(list parents))))
)
(cons class
(merge-ordered-lists
(append
(or
(mapcar #'eieio--class-precedence-c3 parents)
`((,eieio-default-superclass)))
(list parents))
(lambda (remaining-inputs)
(signal 'inconsistent-class-hierarchy
(list remaining-inputs)))))))
;;;
;; Method Invocation Order: Depth First