src/class-finalize-impl.lisp: Move error reporting to `merge-class-lists'.
[sod] / src / class-finalize-impl.lisp
index 7b32406..8933773 100644 (file)
 ;;; 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.
 
               (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)))
 
   (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)
 
   (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)))))
 
   (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))
 ;;; 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.