Package: emacs;
Reported by: "Pierre L. Nageoire" <devel <at> pollock-nageoire.net>
Date: Thu, 10 Jul 2025 09:38:02 UTC
Severity: normal
Found in version 31.0.50
View this message in rfc822 format
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: Pip Cet <pipcet <at> protonmail.com> Cc: 78989 <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org>, "Pierre L. Nageoire" <devel <at> pollock-nageoire.net> Subject: bug#78989: 31.0.50; classes and methods inheritance (defclass) seq-contains-p Date: Sat, 12 Jul 2025 00:15:55 -0400
>> in which case inheriting from both A and B is simply not supported
>> because we can't create a merged linearization of the parents which
>> is monotonic (i.e. obeys the existing linearization in both parents).
> That's a very strong restriction on the possible inheritance graphs.
It's not: as long as there's no cycle, it's always possible to change
the details of the definition of A and/or B such that they still have
the same set of parents but their parents' ordering can be
merged consistently.
> My proposal is to use the order that superclasses were listed in to
> break the tie if there are several topologically consistent orderings to
> choose from,
That's what my patch does, yes.
> but not to give up as long as there is a topologically
> consistent ordering.
I don't think it's worth the trouble, and most other languages out there
don't either: just complain and let the programmer fix the problem.
Given ELisp's tradition, we would probably want to "degrade gracefully",
i.e. find some "reasonable" ordering, but we should mainly complain and
expect the programmers to fix the problem, so the exact behavior when we
gracefully degrade is not super important.
> If we want to impose it, we clearly need to modify defclass (in
> addition to cl--class-allparents) to complain about it.
Feel free.
> What is there to gain from such a restriction? Is it really just to
> make cl-defmethod behave more predictably in weird corner cases?
It lets the language provide clean semantics, yes.
>>> Then the cl-generic code won't work...
>> AFAIK it's good enough for most languages, so I hope it should be good
>> enough for us.
> It's certainly not true that "most" languages will give you a
> linearization in which a parent is considered more specific than a
> child.
AFAIK the ordering and restrictions we get with the patch I proposed, is
basically the same as used in at least Python, CLOS, Raku (and Dylan,
obviously).
>> - We should emit some warning when faced with such an
>> inconsistent hierarchy.
>> [ Note: the hierarchy is not globally inconsistent, but it becomes
>> inconsistent because linearization is performed
>> piecemeal/locally/modularly, so by the time we're faced with an
>> inconsistency we'd have to go back and choose different
>> linearizations for some of the existing classes. ]
>
> I'm not sure how you define "globally inconsistent". The hierarchy is
> "inconsistent" in the sense that the Dylan algorithm would throw the
> "Inconsistent precedence graph" error; it is consistent in the sense
> that there are no cycles.
We agree.
> If we want this restriction, we need to die unconditionally when
> encountering cases that we consider "inconsistent"; a warning is not
> enough, and the current behavior of doing something random such as
> considering the universal class more specific than a user-defined class
> is simply a bug.
I think we can tweak the current code so we don't get such
pathologically poor behavior as Pierre encountered (e.g. patch below),
so I'm not sure it's worth signaling an error, but I'm not fundamentally
opposed to signaling an error.
> I don't think there's anything "inconsistent" about the code the OP
> provided; it should just work, without any reordering of superclasses.
The Dylan algorithm would signal an error on his code.
CLOS would as well:
% clisp
[...]
[1]> (defclass my-a () ())
#<STANDARD-CLASS MY-A>
[2]> (defclass my-b (my-a) ())
#<STANDARD-CLASS MY-B>
[3]> (defclass my-y (my-a my-b) ())
*** - DEFCLASS MY-Y: inconsistent precedence graph, cycle
(#<STANDARD-CLASS MY-B> #<STANDARD-CLASS MY-A>)
The following restarts are available:
ABORT :R1 Abort main loop
Break 1 [4]>
>> - We should give more control to the programmer to impose a particular
>> choice of linearization. To mimic what CLOS does, we could use the
>> patch below.
> IMHO, most programmers don't really care about specifying superclasses
> in any particular order. They just want an order that's topologically
> consistent, and I assume many of them would be quite upset if we
> informed them they have to tsort their superclasses manually to satisfy
> a "consistency" property they never depend on.
AFAIK it's not very common to list both parents A and B when A is itself
a parent of B.
> Adding additional constraints (passing another list to
> merge-ordered-lists) will make this problem worse, not better.
Depends what you mean by "this problem". Maybe it signals hierarchy
inconsistencies more often, yes, but it makes them more deterministic,
and there's always a way for the programmer to change the parents arg in
`defclass`es so as to eliminate the inconsistencies (whereas IIRC with
the current code, it's not always possible to eliminate the
inconsistencies by changing only the parents args of `defclass`es).
Stefan
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 263a9b85225..71b4a863b30 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -285,8 +285,14 @@ cl--copy-slot-descriptor
(defun cl--class-allparents (class)
(cons (cl--class-name class)
- (merge-ordered-lists (mapcar #'cl--class-allparents
- (cl--class-parents class)))))
+ (let* ((parents (cl--class-parents class))
+ (aps (mapcar #'cl--class-allparents parents)))
+ (if (null (cdr aps)) ;; Single-inheritance fast-path.
+ (car aps)
+ (merge-ordered-lists
+ ;; Add the list of immediate parents, to control which
+ ;; linearization is chosen. doi:10.1145/236337.236343
+ (nconc aps (list (mapcar #'cl--class-name parents))))))))
(cl-defstruct (built-in-class
(:include cl--class)
diff --git a/lisp/subr.el b/lisp/subr.el
index 69f6e4dbab8..d04e16a30ee 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2860,38 +2860,54 @@ merge-ordered-lists
;; [C3](https://en.wikipedia.org/wiki/C3_linearization)
(let ((result '()))
(setq lists (remq nil lists)) ;Don't mutate the original `lists' argument.
- (while (cdr (setq lists (delq nil lists)))
- ;; 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* ((next nil)
- (tail lists))
- (while tail
- (let ((candidate (caar tail))
- (other-lists lists))
- ;; Ensure CANDIDATE is not in any position but the first
- ;; in any of the element lists of LISTS.
- (while other-lists
- (if (not (memql candidate (cdr (car other-lists))))
- (setq other-lists (cdr other-lists))
- (setq candidate nil)
- (setq other-lists nil)))
- (if (not candidate)
- (setq tail (cdr tail))
- (setq next candidate)
- (setq tail nil))))
+ (while (cdr lists)
+ ;; Try to find the next element of the result. This is achieved
+ ;; by considering the first element of each input list and accepting
+ ;; a candidate if it is consistent with the rest of the input lists.
+ (let* ((find-next
+ (lambda (lists)
+ (let ((next nil)
+ (tail lists))
+ (while tail
+ (let ((candidate (caar tail))
+ (other-lists lists))
+ ;; Ensure CANDIDATE is not in any position but the first
+ ;; in any of the element lists of LISTS.
+ (while other-lists
+ (if (not (memql candidate (cdr (car other-lists))))
+ (setq other-lists (cdr other-lists))
+ (setq candidate nil)
+ (setq other-lists nil)))
+ (if (not candidate)
+ (setq tail (cdr tail))
+ (setq next candidate)
+ (setq tail nil))))
+ next)))
+ (next (funcall find-next lists)))
(unless next ;; The graph is inconsistent.
- (setq next (funcall (or error-function #'caar) lists))
- (unless (assoc next lists #'eql)
- (error "Invalid candidate returned by error-function: %S" next)))
+ (let ((tail lists))
+ ;; Try and reduce the "remaining-list" such that its `caar`
+ ;; participates in the inconsistency (is part of an actual cycle).
+ (while (and (cdr tail) (null (funcall find-next (cdr tail))))
+ (setq tail (cdr tail)))
+ (setq next (funcall (or error-function
+ (lambda (remaining-lists)
+ (message "Inconsistent hierarchy: %S"
+ remaining-lists)
+ (caar remaining-lists)))
+ tail))
+ (unless (assoc next lists #'eql)
+ (error "Invalid candidate returned by error-function: %S" next))
+ ;; Break the cycle, while keeping other dependencies.
+ (dolist (list lists) (setcdr list (remq next (cdr list))))))
;; The graph is consistent so far, add NEXT to result and
;; merge input lists, dropping NEXT from their heads where
;; applicable.
(push next result)
(setq lists
- (mapcar (lambda (l) (if (eql (car l) next) (cdr l) l))
- lists))))
+ (delq nil
+ (mapcar (lambda (l) (if (eql (car l) next) (cdr l) l))
+ lists)))))
(if (null result) (car lists) ;; Common case.
(append (nreverse result) (car lists)))))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.