src/class-finalize-impl.lisp: Move error reporting to `merge-class-lists'.

This means that `merge-class-lists' now needs a CLASS argument, hence
the noise.

diff --git a/doc/meta.tex b/doc/meta.tex
index 726e28bd6a988f5d67bd0c758f7d807cb45d6dff..07103509c93e928641741e1346281e8a09cbd725 100644 (file)
--- a/doc/meta.tex
+++ b/doc/meta.tex
@@ -330,7 +330,7 @@
 \begin{describe}{gf}{compute-cpl @<class> @> @<list>}
 \end{describe}
 
-\begin{describe}{fun}{merge-class-lists @<lists> @<pick> @> @<list>}
+\begin{describe}{fun}{merge-class-lists @<class> @<lists> @<pick> @> @<list>}
 \end{describe}
 
 \begin{describe}{gf}{compute-chains @<class> @> @<list>}

diff --git a/src/class-finalize-impl.lisp b/src/class-finalize-impl.lisp
index 7b324068b4f97232aaa1d459b633a8f4787b4e23..89337736e136c17d2512f0bc26c968c05f8c3abd 100644 (file)
--- a/src/class-finalize-impl.lisp
+++ b/src/class-finalize-impl.lisp
@@ -51,13 +51,16 @@ (cl:in-package #:sod)
 ;;; Utilities.
 
 (export 'merge-class-lists)
-(defun merge-class-lists (lists pick)
-  "Merge the LISTS of classes, using PICK to break ties.
+(defun merge-class-lists (class lists pick)
+  "Merge the LISTS of subclasses 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."
-  (merge-lists lists :pick pick))
+  (handler-case (merge-lists lists :pick pick)
+    (inconsistent-merge-error ()
+      (error "Failed to compute class precedence list for `~A'"
+            (sod-class-name class)))))
 
 ;;; Tiebreaker functions.
 
@@ -125,7 +128,8 @@ (defun clos-cpl (class)
               (remove-duplicates (cons class
                                        (mappend #'superclasses
                                                 direct-supers))))))
-    (merge-class-lists (mapcar (lambda (c)
+    (merge-class-lists class
+                      (mapcar (lambda (c)
                                 (cons c (sod-class-direct-superclasses c)))
                               (superclasses class))
                       #'clos-tiebreaker)))
@@ -151,7 +155,8 @@ (defun dylan-cpl (class)
 
   (let* ((direct-supers (sod-class-direct-superclasses class))
         (cpls (mapcar #'sod-class-precedence-list direct-supers)))
-    (merge-class-lists (cons (cons class direct-supers) cpls)
+    (merge-class-lists class
+                      (cons (cons class direct-supers) cpls)
                       #'clos-tiebreaker)))
 
 (export 'c3-cpl)
@@ -169,7 +174,8 @@ (defun c3-cpl (class)
 
   (let* ((direct-supers (sod-class-direct-superclasses class))
         (cpls (mapcar #'sod-class-precedence-list direct-supers)))
-    (merge-class-lists (cons (cons class direct-supers) cpls)
+    (merge-class-lists class
+                      (cons (cons class direct-supers) cpls)
                       (lambda (candidates so-far)
                         (declare (ignore so-far))
                         (c3-tiebreaker candidates cpls)))))
@@ -232,7 +238,8 @@ (defun l*loops-cpl (class)
 
   (let ((dfs (flavors-cpl class)))
     (cons class
-         (merge-class-lists (mapcar #'sod-class-precedence-list
+         (merge-class-lists class
+                            (mapcar #'sod-class-precedence-list
                                     (sod-class-direct-superclasses class))
                             (lambda (candidates so-far)
                               (declare (ignore so-far))
@@ -243,10 +250,7 @@ (defun l*loops-cpl (class)
 ;;; Default function.
 
 (defmethod compute-cpl ((class sod-class))
-  (handler-case (c3-cpl class)
-    (inconsistent-merge-error ()
-      (error "Failed to compute class precedence list for `~A'"
-            (sod-class-name class)))))
+  (c3-cpl class))
 
 ;;;--------------------------------------------------------------------------
 ;;; Chains.