From c05ed0f126d61f776e369b16ec8df57f39d11508 Mon Sep 17 00:00:00 2001
Message-Id: <c05ed0f126d61f776e369b16ec8df57f39d11508.1715509854.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Sun, 26 Mar 2017 15:16:18 +0100
Subject: [PATCH] src/class-finalize-impl.lisp: Move error reporting to
 `merge-class-lists'.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

This means that `merge-class-lists' now needs a CLASS argument, hence
the noise.
---
 doc/meta.tex                 |  2 +-
 src/class-finalize-impl.lisp | 26 +++++++++++++++-----------
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/doc/meta.tex b/doc/meta.tex
index 726e28b..0710350 100644
--- 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 7b32406..8933773 100644
--- 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.
-- 
[mdw]