From 38b78e8763833fee8b41ecaf7586558e9b60d254 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Sat, 3 Aug 2019 14:59:40 +0100
Subject: [PATCH] src/utilities.lisp: Convert merge candidates to presentation
 form on the fly.

In `inconsistent-merge-error', retain the raw list of candidates, and
the presentation function, rather than requiring the caller to convert
the candidates when constructing the condition object.  This makes the
list considerably more useful to condition handler code.
---
 doc/SYMBOLS        |  3 +++
 doc/misc.tex       |  6 +++++-
 src/utilities.lisp | 13 +++++++++----
 3 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 96c79c6..6f230a2 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -2328,6 +2328,7 @@ utilities.lisp
   mappend                                       function
   maybe-print-unreadable-object                 macro
   merge-error-candidates                        generic
+  merge-error-present-function                  generic
   merge-lists                                   function
   sb-mop:method-specializers                    generic
   once-only                                     macro
@@ -2381,6 +2382,8 @@ instance-initargs
   cl:standard-object
 merge-error-candidates
   inconsistent-merge-error
+merge-error-present-function
+  inconsistent-merge-error
 sb-mop:method-specializers
   cl:standard-method
 
diff --git a/doc/misc.tex b/doc/misc.tex
index 2d86406..c253630 100644
--- a/doc/misc.tex
+++ b/doc/misc.tex
@@ -160,12 +160,16 @@ These symbols are defined in the @|sod-utilities| package.
 
 \subsection{Merging lists}
 
-\begin{describe}{cls}{inconsistent-merge-error (error) \&key :candidates}
+\begin{describe}{cls}
+    {inconsistent-merge-error (error) \&key :candidates :present}
 \end{describe}
 
 \begin{describe}{gf}{merge-error-candidates @<error> @> @<list>}
 \end{describe}
 
+\begin{describe}{gf}{merge-error-present-function @<error> @> @<function>}
+\end{describe}
+
 \begin{describe}{fun}
     {merge-lists @<lists> \&key :pick (:test \#'eql) :present @> @<list>}
 \end{describe}
diff --git a/src/utilities.lisp b/src/utilities.lisp
index b02fdf4..4935f8b 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -526,17 +526,21 @@
 			 (cdddr neigh-record) best-path)))))))
     dead))
 
-(export '(inconsistent-merge-error merge-error-candidates))
+(export '(inconsistent-merge-error
+	  merge-error-candidates merge-error-present-function))
 (define-condition inconsistent-merge-error (error)
   ((candidates :initarg :candidates
-	       :reader merge-error-candidates))
+	       :reader merge-error-candidates)
+   (present :initarg :present :initform #'identity
+	    :reader merge-error-present-function))
   (:documentation
    "Reports an inconsistency in the arguments passed to `merge-lists'.")
   (:report (lambda (condition stream)
 	     (format stream "Merge inconsistency: failed to decide between ~
 			     ~{~#[~;~A~;~A and ~A~:;~
 				  ~@{~A, ~#[~;and ~A~]~}~]~}"
-		     (merge-error-candidates condition)))))
+		     (mapcar (merge-error-present-function condition)
+			     (merge-error-candidates condition))))))
 
 (export 'merge-lists)
 (defun merge-lists (lists &key pick (test #'eql) (present #'identity))
@@ -593,7 +597,8 @@
 			      candidates))
 	   (winner (cond ((null leasts)
 			  (error 'inconsistent-merge-error
-				 :candidates (mapcar present candidates)))
+				 :candidates candidates
+				 :present present))
 			 ((null (cdr leasts))
 			  (car leasts))
 			 (pick
-- 
2.11.0