From: Mark Wooding <mdw@distorted.org.uk>
Date: Sat, 10 Aug 2019 02:11:21 +0000 (+0100)
Subject: src/utilities.lisp, doc/misc.tex: Fix up `find-duplicates'.
X-Git-Url: https://git.distorted.org.uk/~mdw/sod/commitdiff_plain/9a3cb4610ab59001fd44c13dcdc6ea206acf0e50

src/utilities.lisp, doc/misc.tex: Fix up `find-duplicates'.

  * Fix the inconsistent ordering behaviour which was the cause of a
    recent bug.  The implementation for lists is rather ugly, but it
    works without consing, which is a bonus.

  * Document the ordering behaviour.  And warn users away from non-
    hash-table-friendly `:test' functions more firmly, especially on
    lists.
---

diff --git a/doc/misc.tex b/doc/misc.tex
index 51767f6..ac89b6c 100644
--- a/doc/misc.tex
+++ b/doc/misc.tex
@@ -513,9 +513,14 @@ be implemented fairly easily using @|merge-lists| below.
   and $y$ are considered equal if and only if @|(funcall @<test> (funcall
   @<key> $x$) (funcall @<key> $y$))| returns non-nil.
 
+  The @<report> function is called as @|(funcall @<report> @<duplicate>
+  @<previous>)|.  Duplicates are reported in order; the @<previous> item is
+  always the first matching item in the sequence.
+
   This function will work for arbitrary @<test> functions, but it will run
-  much more efficiently if @<test> is @|eq|, @|eql|, @|equal|, or @|equalp|
-  (because it can use hash-tables).
+  much more efficiently if @<test> is @|eq|, @|eql|, @|equal|, or @|equalp|,
+  because it can use hash-tables.  (The generic implementation for lists is
+  especially inefficient.)
 \end{describe}
 
 
diff --git a/src/utilities.lisp b/src/utilities.lisp
index a496283..1670f55 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -717,18 +717,18 @@
 			      (setf (gethash k seen) item)))))
 		sequence)))
 	((listp sequence)
-	 (mapl (lambda (tail)
-		 (let* ((item (car tail))
-			(rest (cdr tail))
-			(match (member (funcall key item) rest
-				       :test test :key key)))
-		   (when match (funcall report item (car match)))))
-	       sequence))
+	 (do ((tail sequence (cdr tail))
+	      (i 0 (1+ i)))
+	     ((endp tail))
+	     (let* ((item (car tail))
+		    (match (find (funcall key item) sequence
+				 :test test :key key :end i)))
+	       (when match (funcall report item match)))))
 	((vectorp sequence)
 	 (dotimes (i (length sequence))
 	   (let* ((item (aref sequence i))
 		  (pos (position (funcall key item) sequence
-				 :key key :test test :start (1+ i))))
+				 :key key :test test :end i)))
 	     (when pos (funcall report item (aref sequence pos))))))
 	(t
 	 (error 'type-error :datum sequence :expected-type 'sequence))))