1.0.12.13: sequence optimizations: SUBSEQ, part 3

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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index eba8389..cefc59b 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -358,21 +358,38 @@
 ;;;; so we worry about dealing with END being supplied or defaulting
 ;;;; to NIL at this level.
 
-(defun vector-subseq* (sequence start &optional end)
+(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))
-  (declare (type (or null index) end))
-  (when (null end)
-    (setf end (length sequence)))
-  (unless (<= 0 start end (length sequence))
-    (sequence-bounding-indices-bad-error sequence start end))
-  (do ((old-index start (1+ old-index))
-       (new-index 0 (1+ new-index))
-       (copy (%make-sequence-like sequence (- end start))))
-      ((= old-index end) copy)
-    (declare (fixnum old-index new-index))
-    (setf (aref copy new-index)
-          (aref sequence old-index))))
+  (declare (type index start)
+           (type (or null index) end))
+  (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))))))
 
 (defun list-subseq* (sequence start end)
   (declare (type list sequence)