A more efficient algorithm for remove-duplicates on lists when there

is no :key or :test-not argument and :test is one of the standardly
acceptable arguments for make-hash-table.  The previous algorithm
ran in O(n^2) time; this algorithm runs in O(n) time, n the length
of the list.

diff --git a/BUGS b/BUGS
index b53bde0..5b549dc 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -2111,3 +2111,7 @@ WORKAROUND:
   A simpler example:
 
   (compile nil '(lambda (x) (the (not (eql #\a)) x)))
+
+  (partially fixed in 0.9.3.1, but a better representation for these
+   types is needed.)
+

diff --git a/NEWS b/NEWS
index 536dd66..dee4379 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,8 @@
 ;;;; -*- coding: utf-8; -*-
+changes in sbcl-0.9.4 relative to sbcl-0.9.3:
+  * optimizations: REMOVE-DUPLICATES now runs in linear time on
+    lists in some cases.  This partially fixes bug 384.
+
 changes in sbcl-0.9.3 relative to sbcl-0.9.2:
   * New feature: Experimental support for bivalent streams: streams
     opened with :element-type :default now allow character and binary

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 92fc34a..a43e2f7 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -1548,40 +1548,69 @@
   (declare (fixnum start))
   (let* ((result (list ())) ; Put a marker on the beginning to splice with.
          (splice result)
-         (current list))
+         (current list)
+        (hash (and test
+                   (not key)
+                   (not test-not)
+                   (or (eql test #'eql)
+                       (eql test #'eq)
+                       (eql test #'equal)
+                       (eql test #'equalp))
+                   ; (> (if end (- end start) (- (length list) start)) 20)
+                   (make-hash-table :test test))))
     (do ((index 0 (1+ index)))
         ((= index start))
       (declare (fixnum index))
+      ;; (if hash (setf (gethash (car current) hash) splice))
       (setq splice (cdr (rplacd splice (list (car current)))))
       (setq current (cdr current)))
     (do ((index start (1+ index)))
         ((or (and end (= index (the fixnum end)))
              (atom current)))
       (declare (fixnum index))
-      (if (or (and from-end
-                   (not (if test-not
-                            (member (apply-key key (car current))
-                                    (nthcdr (1+ start) result)
-                                    :test-not test-not
-                                    :key key)
-                            (member (apply-key key (car current))
-                                    (nthcdr (1+ start) result)
-                                    :test test
-                                    :key key))))
-              (and (not from-end)
-                   (not (do ((it (apply-key key (car current)))
-                             (l (cdr current) (cdr l))
-                             (i (1+ index) (1+ i)))
-                            ((or (atom l) (and end (= i (the fixnum end))))
-                             ())
-                          (declare (fixnum i))
-                          (if (if test-not
-                                  (not (funcall test-not
-                                                it
-                                                (apply-key key (car l))))
-                                  (funcall test it (apply-key key (car l))))
-                              (return t))))))
-          (setq splice (cdr (rplacd splice (list (car current))))))
+      (cond
+       (hash
+       (let ((prev (gethash (car current) hash)))
+         (cond
+          ((not prev)
+           (setf (gethash (car current) hash) splice)
+           (setq splice (cdr (rplacd splice (list (car current))))))
+          (from-end nil)
+          (t
+           (let ((old (cdr prev)))
+             (let ((next (cdr old)))
+               (when next
+                 (let ((next-val (car next)))
+                   ;; (assert (eq (gethash next-val hash) old))
+                   (setf (cdr prev) next
+                         (gethash next-val hash) prev
+                         (gethash (car current) hash) splice
+                         splice (cdr (rplacd splice (list (car current)))))))))))))
+       (t
+       (if (or (and from-end
+                    (not (if test-not
+                             (member (apply-key key (car current))
+                                     (nthcdr (1+ start) result)
+                                     :test-not test-not
+                                     :key key)
+                           (member (apply-key key (car current))
+                                   (nthcdr (1+ start) result)
+                                   :test test
+                                   :key key))))
+               (and (not from-end)
+                    (not (do ((it (apply-key key (car current)))
+                              (l (cdr current) (cdr l))
+                              (i (1+ index) (1+ i)))
+                             ((or (atom l) (and end (= i (the fixnum end))))
+                              ())
+                           (declare (fixnum i))
+                           (if (if test-not
+                                   (not (funcall test-not
+                                                 it
+                                                 (apply-key key (car l))))
+                                 (funcall test it (apply-key key (car l))))
+                               (return t))))))
+           (setq splice (cdr (rplacd splice (list (car current))))))))
       (setq current (cdr current)))
     (do ()
         ((atom current))

diff --git a/version.lisp-expr b/version.lisp-expr
index 189d325..8b044a6 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.3"
+"0.9.3.1"