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 6f4ba71..cc02671 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -296,17 +296,18 @@
   "Return a sequence of the given TYPE and LENGTH, with elements initialized
   to INITIAL-ELEMENT."
   (declare (fixnum length))
-  (let* ((adjusted-type
-          (typecase type
+  (let* ((expanded-type (typexpand type))
+         (adjusted-type
+          (typecase expanded-type
             (atom (cond
-                    ((eq type 'string) '(vector character))
-                    ((eq type 'simple-string) '(simple-array character (*)))
+                    ((eq expanded-type 'string) '(vector character))
+                    ((eq expanded-type 'simple-string) '(simple-array character (*)))
                     (t type)))
             (cons (cond
-                    ((eq (car type) 'string) `(vector character ,@(cdr type)))
-                    ((eq (car type) 'simple-string)
-                     `(simple-array character ,(if (cdr type)
-                                                   (cdr type)
+                    ((eq (car expanded-type) 'string) `(vector character ,@(cdr expanded-type)))
+                    ((eq (car expanded-type) 'simple-string)
+                     `(simple-array character ,(if (cdr expanded-type)
+                                                   (cdr expanded-type)
                                                    '(*))))
                     (t type)))
             (t type)))
@@ -376,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)
@@ -877,7 +857,8 @@
 (macrolet ((def (name element-type)
              `(defun ,name (&rest sequences)
                 (declare (dynamic-extent sequences)
-                         (optimize speed))
+                         (optimize speed)
+                         (optimize (sb!c::insert-array-bounds-checks 0)))
                 (let* ((lengths (mapcar #'length sequences))
                        (result (make-array (the integer (apply #'+ lengths))
                                            :element-type ',element-type))
@@ -2181,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)
@@ -2189,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)
@@ -2206,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