src/utilities.lisp, src/class-finalize-impl.lisp: Improve error reports.

  * Arrange for `inconsistent-merge-error' to present the list of
    candidates more pleasantly for human reading.

  * Give `merge-lists' a new argument to turn items into presentable
    names.

  * Make a wrapper function for merging lists of classes to apply the
    right kind of presentation.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index e167b0307db49a33beed7dd42d75edcfab245651..36a700b39c42757e613f02be1916be876f4ac3d0 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -196,6 +196,7 @@ class-finalize-impl.lisp
   dylan-cpl                                     function
   flavors-cpl                                   function
   l*loops-cpl                                   function
+  merge-class-lists                             function
   python-cpl                                    function
 
 class-finalize-proto.lisp

diff --git a/doc/meta.tex b/doc/meta.tex
index 640473e73a80c46c689c68d1e80366f75c3305ed..7de1fbeb0b1404b650d6b86c5061dae3f590842e 100644 (file)
--- a/doc/meta.tex
+++ b/doc/meta.tex
@@ -304,6 +304,9 @@
 \begin{describe}{gf}{compute-cpl @<class> @> @<list>}
 \end{describe}
 
+\begin{describe}{fun}{merge-class-lists @<lists> @<pick> @> @<list>}
+\end{describe}
+
 \begin{describe}{gf}{compute-chains @<class> @> @<list>}
 \end{describe}
 

diff --git a/doc/misc.tex b/doc/misc.tex
index 87ddf4d6f7e5d746333f9fee2bffc508809e1936..ae1fd2b49f248b5ff5273994c9db182f6ac890f6 100644 (file)
--- a/doc/misc.tex
+++ b/doc/misc.tex
@@ -136,7 +136,7 @@ These symbols are defined in the @|sod-utilities| package.
 \end{describe}
 
 \begin{describe}{fun}
-    {merge-lists @<lists> \&key :pick (:test \#'eql) @> @<list>}
+    {merge-lists @<lists> \&key :pick (:test \#'eql) :present @> @<list>}
 \end{describe}
 
 \begin{describe}{mac}

diff --git a/src/class-finalize-impl.lisp b/src/class-finalize-impl.lisp
index 5abcc6e90359ef9169899f1ebbc4362d0a95260c..aea50583f97964d8b8ca616cf49a456eaa65f8db 100644 (file)
--- a/src/class-finalize-impl.lisp
+++ b/src/class-finalize-impl.lisp
@@ -48,6 +48,22 @@ (cl:in-package #:sod)
 ;; Superclass Linearization for Dylan' for more detail.
 ;; http://www.webcom.com/haahr/dylan/linearization-oopsla96.html
 
+;;; Utilities.
+
+(export 'merge-class-lists)
+(defun merge-class-lists (lists pick)
+  "Merge the LISTS of classes, 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.  Also, this wrapper
+   provides a standard presentation function so that any errors are presented
+   properly."
+  (merge-lists lists
+              :pick pick
+              :present (lambda (class)
+                         (format nil "`~A'" (sod-class-name class)))))
+
 ;;; Tiebreaker functions.
 
 (defun clos-tiebreaker (candidates so-far)
@@ -117,11 +133,11 @@ (defun clos-cpl (class)
               (remove-duplicates (cons class
                                        (mappend #'superclasses
                                                 direct-supers))))))
-    (merge-lists (mapcar (lambda (class)
-                          (cons class
-                                (sod-class-direct-superclasses class)))
-                        (superclasses class))
-                :pick #'clos-tiebreaker)))
+    (merge-class-lists
+     (mapcar (lambda (class)
+              (cons class (sod-class-direct-superclasses class)))
+            (superclasses class))
+     #'clos-tiebreaker)))
 
 (export 'dylan-cpl)
 (defun dylan-cpl (class)
@@ -143,9 +159,10 @@ (defun dylan-cpl (class)
    you're going to lose anyway."
 
   (let ((direct-supers (sod-class-direct-superclasses class)))
-    (merge-lists (cons (cons class direct-supers)
-                      (mapcar #'sod-class-precedence-list direct-supers))
-                :pick #'clos-tiebreaker)))
+    (merge-class-lists
+     (cons (cons class direct-supers)
+          (mapcar #'sod-class-precedence-list direct-supers))
+     #'clos-tiebreaker)))
 
 (export 'c3-cpl)
 (defun c3-cpl (class)
@@ -162,8 +179,8 @@ (defun c3-cpl (class)
 
   (let* ((direct-supers (sod-class-direct-superclasses class))
         (cpls (mapcar #'sod-class-precedence-list direct-supers)))
-    (merge-lists (cons (cons class direct-supers) cpls)
-                :pick (lambda (candidates so-far)
+    (merge-class-lists (cons (cons class direct-supers) cpls)
+                      (lambda (candidates so-far)
                         (declare (ignore so-far))
                         (c3-tiebreaker candidates cpls)))))
 
@@ -224,13 +241,14 @@ (defun l*loops-cpl (class)
    precedence order i.e., the direct-superclasses list orderings."
 
   (let ((dfs (flavors-cpl class)))
-    (cons class (merge-lists (mapcar #'sod-class-precedence-list
+    (cons class
+         (merge-class-lists (mapcar #'sod-class-precedence-list
                                     (sod-class-direct-superclasses class))
-                            :pick (lambda (candidates so-far)
-                                    (declare (ignore so-far))
-                                    (dolist (class dfs)
-                                      (when (member class candidates)
-                                        (return class))))))))
+                            (lambda (candidates so-far)
+                              (declare (ignore so-far))
+                              (dolist (class dfs)
+                                (when (member class candidates)
+                                  (return class))))))))
 
 ;;; Default function.
 

diff --git a/src/utilities.lisp b/src/utilities.lisp
index 49ac335e6579652b1e238cc2548e9cf6ebf1fb7c..1d58fa307ba8b81f58b0c018e7aa718571dfa981 100644 (file)
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -446,11 +446,13 @@ (define-condition inconsistent-merge-error (error)
   (:documentation
    "Reports an inconsistency in the arguments passed to `merge-lists'.")
   (:report (lambda (condition stream)
-            (format stream "Merge inconsistency: failed to decide among ~A"
+            (format stream "Merge inconsistency: failed to decide between ~
+                            ~{~#[~;~A~;~A and ~A~:;~
+                                 ~@{~A, ~#[~;and ~A~]~}~]~}"
                     (merge-error-candidates condition)))))
 
 (export 'merge-lists)
-(defun merge-lists (lists &key pick (test #'eql))
+(defun merge-lists (lists &key pick (test #'eql) (present #'identity))
   "Return a merge of the given LISTS.
 
    The resulting list contains the items of the given LISTS, with duplicates
@@ -458,7 +460,10 @@ (defun merge-lists (lists &key pick (test #'eql))
    the input LISTS in the sense that if A precedes B in some input list then
    A will also precede B in the output list.  If the lists aren't consistent
    (e.g., some list contains A followed by B, and another contains B followed
-   by A) then an error of type `inconsistent-merge-error' is signalled.
+   by A) then an error of type `inconsistent-merge-error' is signalled.  The
+   offending items are filtered for presentation through the PRESENT function
+   before being attached to the condition, so as to produce a more useful
+   diagnostic message.
 
    Item equality is determined by TEST.
 
@@ -500,7 +505,7 @@ (defun merge-lists (lists &key pick (test #'eql))
                              candidates))
           (winner (cond ((null leasts)
                          (error 'inconsistent-merge-error
-                                :candidates candidates))
+                                :candidates (mapcar present candidates)))
                         ((null (cdr leasts))
                          (car leasts))
                         (pick