;;; Utilities.
+(export 'report-class-list-merge-error)
+(defun report-class-list-merge-error (class lists error)
+ "Report a failure to merge superclasseses.
+
+ Here, CLASS is the class whose class precedence list we're trying to
+ compute; the LISTS are the individual superclass orderings being merged;
+ and ERROR is an `inconsistent-merge-error' describing the problem that was
+ encountered.
+
+ Each of the LISTS is assumed to begin with the class from which the
+ corresponding constraint originates; see `merge-class-lists'."
+
+ (let* ((state (make-inheritance-path-reporter-state class))
+ (candidates (merge-error-candidates error))
+ (focus (remove-duplicates
+ (remove nil
+ (mapcar (lambda (list)
+ (cons (car list)
+ (remove-if-not
+ (lambda (item)
+ (member item candidates))
+ list)))
+ lists)
+ :key #'cddr)
+ :test #'equal :key #'cdr)))
+
+ (cerror*-with-location class "Ill-formed superclass graph: ~
+ can't construct class precedence list ~
+ for `~A'"
+ class)
+ (dolist (offenders focus)
+ (let ((super (car offenders)))
+ (info-with-location super
+ "~{Class `~A' orders `~A' before ~
+ ~#[<BUG>~;`~A'~;`~A' and `~A'~:;~
+ ~@{`~A', ~#[~;and `~A'~]~}~]~}"
+ offenders)
+ (report-inheritance-path state super)))))
+
(export 'merge-class-lists)
(defun merge-class-lists (class lists pick)
- "Merge the LISTS of subclasses of CLASS, using PICK to break ties.
+ "Merge the LISTS of superclasses of CLASS, using PICK to break ties.
This is a convenience wrapper around the main `merge-lists' function.
Given that class linearizations (almost?) always specify a custom
- tiebreaker function, this isn't a keyword argument."
+ tiebreaker function, this isn't a keyword argument.
+
+ If a merge error occurs, this function translates it into a rather more
+ useful form, and tries to provide helpful notes.
+
+ For error reporting purposes, it's assumed that each of the LISTS begins
+ with the class from which the corresponding constraint originates. This
+ initial class does double-duty: it is also considered to be part of the
+ list for the purpose of the merge."
+
(handler-case (merge-lists lists :pick pick)
- (inconsistent-merge-error ()
- (error "Failed to compute class precedence list for `~A'"
- (sod-class-name class)))))
+ (inconsistent-merge-error (error)
+ (report-class-list-merge-error class lists error)
+ (continue error))))
;;; Tiebreaker functions.