faster FIND and POSITION on bit-vectors

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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index d37da2c..cc02671 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -377,38 +377,17 @@
 ;;;; so we worry about dealing with END being supplied or defaulting
 ;;;; to NIL at this level.
 
-(defun string-subseq* (sequence start end)
-  (with-array-data ((data sequence)
-                    (start start)
-                    (end end)
-                    :force-inline t
-                    :check-fill-pointer t)
-    (declare (optimize (speed 3) (safety 0)))
-    (string-dispatch ((simple-array character (*))
-                      (simple-array base-char (*))
-                      (vector nil))
-        data
-        (subseq data start end))))
-
 (defun vector-subseq* (sequence start end)
   (declare (type vector sequence))
   (declare (type index start)
-           (type (or null index) end))
+           (type (or null index) end)
+           (optimize speed))
   (with-array-data ((data sequence)
                     (start start)
                     (end end)
                     :check-fill-pointer t
                     :force-inline t)
-    (let* ((copy (%make-sequence-like sequence (- end start)))
-           (setter (!find-data-vector-setter copy))
-           (reffer (!find-data-vector-reffer data)))
-      (declare (optimize (speed 3) (safety 0)))
-      (do ((old-index start (1+ old-index))
-           (new-index 0 (1+ new-index)))
-          ((= old-index end) copy)
-        (declare (index old-index new-index))
-        (funcall setter copy new-index
-                 (funcall reffer data old-index))))))
+    (funcall (!find-vector-subseq-fun data) data start end)))
 
 (defun list-subseq* (sequence start end)
   (declare (type list sequence)
@@ -2183,7 +2162,7 @@
 (macrolet (;; shared logic for defining %FIND-POSITION and
            ;; %FIND-POSITION-IF in terms of various inlineable cases
            ;; of the expression defined in FROB and VECTOR*-FROB
-           (frobs ()
+           (frobs (&optional bit-frob)
              `(seq-dispatch sequence-arg
                (frob sequence-arg from-end)
                (with-array-data ((sequence sequence-arg :offset-var offset)
@@ -2191,14 +2170,27 @@
                                  (end end)
                                  :check-fill-pointer t)
                  (multiple-value-bind (f p)
-                     (macrolet ((frob2 () '(if from-end
-                                            (frob sequence t)
-                                            (frob sequence nil))))
+                     (macrolet ((frob2 () `(if from-end
+                                               (frob sequence t)
+                                               (frob sequence nil))))
                        (typecase sequence
                          #!+sb-unicode
                          ((simple-array character (*)) (frob2))
                          ((simple-array base-char (*)) (frob2))
-                         (t (vector*-frob sequence))))
+                         ,@(when bit-frob
+                             `((simple-bit-vector
+                                (if (and (eq #'identity key)
+                                         (or (eq #'eq test)
+                                             (eq #'eql test)
+                                             (eq #'equal test)))
+                                    (let ((p (%bit-position (the bit item) sequence
+                                                            from-end start end)))
+                                      (if p
+                                          (values item p)
+                                          (values nil nil)))
+                                    (vector*-frob sequence)))))
+                         (t
+                          (vector*-frob sequence))))
                    (declare (type (or index null) p))
                    (values f (and p (the index (- p offset)))))))))
   (defun %find-position (item sequence-arg from-end start end key test)
@@ -2208,7 +2200,7 @@
                (vector*-frob (sequence)
                  `(%find-position-vector-macro item ,sequence
                                                from-end start end key test)))
-      (frobs)))
+      (frobs t)))
   (defun %find-position-if (predicate sequence-arg from-end start end key)
     (macrolet ((frob (sequence from-end)
                  `(%find-position-if predicate ,sequence