0.9.3.4:

[sbcl.git] / src / code / seq.lisp

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index a43e2f7..e88cb37 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -1549,6 +1549,7 @@
   (let* ((result (list ())) ; Put a marker on the beginning to splice with.
          (splice result)
          (current list)
+        (end (or end (length list)))
         (hash (and test
                    (not key)
                    (not test-not)
@@ -1556,37 +1557,43 @@
                        (eql test #'eq)
                        (eql test #'equal)
                        (eql test #'equalp))
-                   ; (> (if end (- end start) (- (length list) start)) 20)
-                   (make-hash-table :test test))))
+                   ; (> (- end start) 20)
+                   (make-hash-table :test test :size (- end start)))))
     (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))
-      (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
+    (if hash
+       (do ((index start (1+ index)))
+           ((or (and end (= index (the fixnum end)))
+                (atom current)))
+         (declare (fixnum index))
+         ;; The hash table contains links from values that are
+         ;; already in result to the cons cell *preceding* theirs
+         ;; in the list.  That is, for each value v in the list,
+         ;; v and (cadr (gethash v hash)) are equal under TEST.
+         (let ((prev (gethash (car current) hash)))
+           (cond
+            ((not prev)
+             (setf (gethash (car current) hash) splice)
+             (setq splice (cdr (rplacd splice (list (car current))))))
+            ((not from-end)
+             (let* ((old (cdr prev))
+                    (next (cdr old)))
+               (if 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
+                         splice (cdr (rplacd splice (list (car current))))))
+                 (setf (car old) (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))
@@ -1610,8 +1617,8 @@
                                                  (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)))
+           (setq splice (cdr (rplacd splice (list (car current))))))
+       (setq current (cdr current))))
     (do ()
         ((atom current))
       (setq splice (cdr (rplacd splice (list (car current)))))