1.0.6.30: clean up FD-SOUT a little bit

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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 8099663..ed87d4c 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -1682,20 +1682,22 @@
     (do ((elt))
         ((= index end))
       (setq elt (aref vector index))
     (do ((elt))
         ((= index end))
       (setq elt (aref vector index))

-      ;; FIXME: Relying on POSITION allowing both :TEST and :TEST-NOT
-      ;; arguments simultaneously is a little fragile, since ANSI says
-      ;; we can't depend on it, so we need to remember to keep that
-      ;; extension in our implementation. It'd probably be better to
-      ;; rewrite this to avoid passing both (as
-      ;; LIST-REMOVE-DUPLICATES* was rewritten ca. sbcl-0.7.12.18).

       (unless (or (and from-end
       (unless (or (and from-end

-                       (position (apply-key key elt) result
-                                 :start start :end jndex
-                                 :test test :test-not test-not :key key))
+                       (if test-not
+                           (position (apply-key key elt) result
+                                     :start start :end jndex
+                                     :test-not test-not :key key)
+                           (position (apply-key key elt) result
+                                     :start start :end jndex
+                                     :test test :key key)))

                   (and (not from-end)
                   (and (not from-end)

-                       (position (apply-key key elt) vector
-                                 :start (1+ index) :end end
-                                 :test test :test-not test-not :key key)))
+                       (if test-not
+                           (position (apply-key key elt) vector
+                                     :start (1+ index) :end end
+                                     :test-not test-not :key key)
+                           (position (apply-key key elt) vector
+                                     :start (1+ index) :end end
+                                     :test test :key key))))

         (setf (aref result jndex) elt)
         (setq jndex (1+ jndex)))
       (setq index (1+ index)))
         (setf (aref result jndex) elt)
         (setq jndex (1+ jndex)))
       (setq index (1+ index)))

@@ -1770,9 +1772,15 @@
          (setf (aref vector jndex) (aref vector index))))
     (declare (fixnum index jndex))
     (setf (aref vector jndex) (aref vector index))
          (setf (aref vector jndex) (aref vector index))))
     (declare (fixnum index jndex))
     (setf (aref vector jndex) (aref vector index))

-    (unless (position (apply-key key (aref vector index)) vector :key key
-                      :start (if from-end start (1+ index)) :test test
-                      :end (if from-end jndex end) :test-not test-not)
+    (unless (if test-not
+                (position (apply-key key (aref vector index)) vector :key key
+                          :start (if from-end start (1+ index))
+                          :end (if from-end jndex end)
+                          :test-not test-not)
+                (position (apply-key key (aref vector index)) vector :key key
+                          :start (if from-end start (1+ index))
+                          :end (if from-end jndex end)
+                          :test test))

       (setq jndex (1+ jndex)))))
 
 (define-sequence-traverser delete-duplicates
       (setq jndex (1+ jndex)))))
 
 (define-sequence-traverser delete-duplicates

@@ -2521,8 +2529,9 @@
          ,@(loop for type in types
                  collect `(,type (,fun (the ,type ,var))))))))
 
          ,@(loop for type in types
                  collect `(,type (,fun (the ,type ,var))))))))
 

-;;; originally in array.lisp; probably best to put it back there and
-;;; make DOSEQUENCE and SEQ-DISPATCH be in early-seq.lisp.
+;;; FIXME: this was originally in array.lisp; it might be better to
+;;; put it back there, and make DOSEQUENCE and SEQ-DISPATCH be in
+;;; a new early-seq.lisp file.

 (defun fill-data-vector (vector dimensions initial-contents)
   (let ((index 0))
     (labels ((frob (axis dims contents)
 (defun fill-data-vector (vector dimensions initial-contents)
   (let ((index 0))
     (labels ((frob (axis dims contents)

@@ -2541,4 +2550,4 @@
                                axis (car dims) contents (length contents)))
                       (sb!sequence:dosequence (content contents)
                         (frob (1+ axis) (cdr dims) content))))))
                                axis (car dims) contents (length contents)))
                       (sb!sequence:dosequence (content contents)
                         (frob (1+ axis) (cdr dims) content))))))

-      (frob 0 dimensions initial-contents))))
\ No newline at end of file
+      (frob 0 dimensions initial-contents))))