Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv29487/src/code
Modified Files:
seq.lisp
Log Message:
1.0.12.12: sequence optimizations: SUBSEQ, part 2
* New function: STRING-SUBSEQ*, and a compile-time dispatch to it with
the element-type or simplicity is uncertain.
* Slightly better VECTOR-SUBSEQ*.
Index: seq.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/seq.lisp,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -d -r1.77 -r1.78
--- seq.lisp 30 Nov 2007 14:18:32 -0000 1.77
+++ seq.lisp 1 Dec 2007 18:06:11 -0000 1.78
@@ -358,21 +358,36 @@
;;;; 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))))
+ (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))
+ (setf (aref copy new-index)
+ (aref data old-index))))))
(defun list-subseq* (sequence start end)
(declare (type list sequence)
|