0.9.3.11:
[sbcl.git] / src / code / seq.lisp
index e88cb37..67ade1b 100644 (file)
   (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)
-                   (or (eql test #'eql)
-                       (eql test #'eq)
-                       (eql test #'equal)
-                       (eql test #'equalp))
-                   ; (> (- end start) 20)
-                   (make-hash-table :test test :size (- end start)))))
+         (end (or end (length list)))
+         (hash (and test
+                    (not key)
+                    (not test-not)
+                    (or (eql test #'eql)
+                        (eql test #'eq)
+                        (eql test #'equal)
+                        (eql test #'equalp))
+                    ; (> (- end start) 20)
+                    (make-hash-table :test test :size (- end start)))))
     (do ((index 0 (1+ index)))
         ((= index start))
       (declare (fixnum index))
       (setq splice (cdr (rplacd splice (list (car current)))))
       (setq current (cdr current)))
     (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))))))
-                 (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))
+          ;; 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))))))
+                  (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))
-                                     (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))))
+          ((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))))))
+        (setq current (cdr current))))
     (do ()
         ((atom current))
       (setq splice (cdr (rplacd splice (list (car current)))))