unparsing of directory pathnames as files. Analogously,
SB-EXT:PARSE-NATIVE-NAMESTRING takes an AS-DIRECTORY, forcing a
filename to parse into a directory pathname.
- * optimization: SUBSEQ and COPY-SEQ are 30-80% faster for strings
- and vectors whose element-type or simplicity is not fully known at
- compile-time.
+ * optimizations: COPY-SEQ, FILL, and SUBSEQ are 30-80% faster for
+ strings and vectors whose element-type or simplicity is not fully
+ known at compile-time.
* bug fix: COPY-SEQ on lists did not signal a type-error on improper
lists in safe code.
* bug fix: some sequence functions elided bounds checking when
"%ASSOC-TEST-NOT"
"%ASIN" "%ASINH"
"%ATAN" "%ATAN2" "%ATANH" "%CALLER-FRAME-AND-PC"
- "%CHECK-BOUND" "%CHECK-VECTOR-SEQUENCE-BOUNDS"
+ "%CHECK-BOUND"
+ "%CHECK-GENERIC-SEQUENCE-BOUNDS"
+ "%CHECK-VECTOR-SEQUENCE-BOUNDS"
"%CLOSURE-FUN" "%CLOSURE-INDEX-REF"
"%COMPARE-AND-SWAP-CAR"
"%COMPARE-AND-SWAP-CDR"
#!+(or x86-64 x86) "%LEA"
"LEXENV" "LEXENV-DESIGNATOR" "LINE-LENGTH"
"LIST-COPY-SEQ*"
+ "LIST-FILL*"
"LIST-SUBSEQ*"
"ANSI-STREAM"
"ANSI-STREAM-BIN" "ANSI-STREAM-BOUT" "ANSI-STREAM-CLOSE"
"SINGLE-VALUE-TYPE" "SINGLE-VALUE-SPECIFIER-TYPE"
"SPECIALIZABLE" "SPECIALIZABLE-VECTOR" "SPECIFIER-TYPE"
"STACK-REF" "STREAM-DESIGNATOR" "STRING-DESIGNATOR"
+ "STRING-FILL*"
"STRING-SUBSEQ*"
"STRUCTURE-RAW-SLOT-TYPE-AND-SIZE" "SUB-GC"
"SYMBOLS-DESIGNATOR"
"VALUES-TYPE-TYPES" "VALUES-TYPES"
"VALUES-TYPES-EQUAL-OR-INTERSECT" "VECTOR-T-P"
"VECTOR-NIL-P"
+ "VECTOR-FILL*"
"VECTOR-SUBSEQ*"
"VECTOR-TO-VECTOR*"
"VECTOR-OF-CHECKED-LENGTH-GIVEN-LENGTH" "WITH-ARRAY-DATA"
\f
;;;; utilities
+(defun %check-generic-sequence-bounds (seq start end)
+ (let ((length (sb!sequence:length seq)))
+ (if (<= 0 start (or end length) length)
+ (or end length)
+ (sequence-bounding-indices-bad-error seq start end))))
+
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *sequence-keyword-info*
\f
;;;; FILL
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro vector-fill (sequence item start end)
- `(do ((index ,start (1+ index)))
- ((= index (the fixnum ,end)) ,sequence)
- (declare (fixnum index))
- (setf (aref ,sequence index) ,item)))
-
-(sb!xc:defmacro list-fill (sequence item start end)
- `(do ((current (nthcdr ,start ,sequence) (cdr current))
- (index ,start (1+ index)))
- ((or (atom current) (and end (= index (the fixnum ,end))))
- sequence)
- (declare (fixnum index))
- (rplaca current ,item)))
-
-) ; EVAL-WHEN
-
-;;; The support routines for FILL are used by compiler transforms, so we
-;;; worry about dealing with END being supplied or defaulting to NIL
-;;; at this level.
-
(defun list-fill* (sequence item start end)
- (declare (list sequence))
- (list-fill sequence item start end))
+ (declare (type list sequence)
+ (type unsigned-byte start)
+ (type (or null unsigned-byte) end))
+ (flet ((oops ()
+ (sequence-bounding-indices-bad-error sequence start end)))
+ (let ((pointer sequence))
+ (unless (zerop start)
+ ;; If START > 0 the list cannot be empty. So CDR down to it
+ ;; START-1 times, check that we still have something, then CDR
+ ;; the final time.
+ ;;
+ ;; If START was zero, the list may be empty if END is NIL or
+ ;; also zero.
+ (unless (= start 1)
+ (setf pointer (nthcdr (1- start) pointer)))
+ (if pointer
+ (pop pointer)
+ (oops))
+ (if end
+ (let ((n (- end start)))
+ (declare (integer n))
+ (when (minusp n)
+ (oops))
+ (when (plusp n)
+ (loop repeat n
+ do (rplaca pointer item))))
+ (loop while pointer
+ do (setf pointer (cdr (rplaca pointer item)))))))))
(defun vector-fill* (sequence item start end)
- (declare (vector sequence))
- (when (null end) (setq end (length sequence)))
- (vector-fill sequence item start end))
+ (with-array-data ((data sequence)
+ (start start)
+ (end end)
+ :force-inline t
+ :check-fill-pointer t)
+ (let ((setter (!find-data-vector-setter data)))
+ (declare (optimize (speed 3) (safety 0)))
+ (do ((index start (1+ index)))
+ ((= index end) sequence)
+ (declare (index index))
+ (funcall setter data index item)))))
-(define-sequence-traverser fill (sequence item &rest args &key start end)
- #!+sb-doc "Replace the specified elements of SEQUENCE with ITEM."
+(defun string-fill* (sequence item start end)
+ (declare (string sequence))
+ (with-array-data ((data sequence)
+ (start start)
+ (end end)
+ :force-inline t
+ :check-fill-pointer t)
+ (macrolet ((frob ()
+ `(locally (declare (optimize (safety 0) (speed 3)))
+ (do ((i start (1+ i)))
+ ((= i end) sequence)
+ (declare (index i))
+ (setf (aref data i) item)))))
+ (etypecase data
+ #!+sb-unicode
+ ((simple-array character (*))
+ (let ((item (locally (declare (optimize (safety 3)))
+ (the character item))))
+ (frob)))
+ ((simple-array base-char (*))
+ (let ((item (locally (declare (optimize (safety 3)))
+ (the base-char item))))
+ (frob)))))))
+
+(defun fill (sequence item &key (start 0) end)
+ #!+sb-doc
+ "Replace the specified elements of SEQUENCE with ITEM."
(seq-dispatch sequence
- (list-fill* sequence item start end)
- (vector-fill* sequence item start end)
- (apply #'sb!sequence:fill sequence item args)))
+ (list-fill* sequence item start end)
+ (vector-fill* sequence item start end)
+ (sb!sequence:fill sequence item
+ :start start
+ :end (%check-generic-sequence-bounds sequence start end))))
\f
;;;; REPLACE
;;; %CHECK-VECTOR-SEQUENCE-BOUNDS is used to verify that the START and
;;; END arguments are valid bounding indices.
-;;;
-;;; FIXME: This causes a certain amount of double checking that could
-;;; be avoided, as if the string passes this (more stringent) test it
-;;; will automatically pass the tests in WITH-ARRAY-DATA. Fixing this
-;;; would necessitate rearranging the transforms (maybe converting to
-;;; strings in the unasterisked versions and using this in the
-;;; transforms conditional on SAFETY>SPEED,SPACE).
(defun %check-vector-sequence-bounds (vector start end)
(%check-vector-sequence-bounds vector start end))
(rplacd splice (cdr x))))
(t (setq splice x)))))
-(deftransform fill ((seq item &key (start 0) (end (length seq)))
- (vector t &key (:start t) (:end index))
+(deftransform fill ((seq item &key (start 0) (end nil))
+ (list t &key (:start t) (:end t)))
+ '(list-fill* seq item start end))
+
+(deftransform fill ((seq item &key (start 0) (end nil))
+ (vector t &key (:start t) (:end t))
*
- :policy (> speed space))
- "open code"
- (let ((element-type (upgraded-element-type-specifier-or-give-up seq)))
- (values
- `(with-array-data ((data seq)
- (start start)
- (end end)
- :check-fill-pointer t)
- (declare (type (simple-array ,element-type 1) data))
- (declare (type fixnum start end))
- (do ((i start (1+ i)))
- ((= i end) seq)
- (declare (type index i))
- ;; WITH-ARRAY-DATA did our range checks once and for all, so
- ;; it'd be wasteful to check again on every AREF...
- (declare (optimize (safety 0)))
- (setf (aref data i) item)))
- ;; ... though we still need to check that the new element can fit
- ;; into the vector in safe code. -- CSR, 2002-07-05
- `((declare (type ,element-type item))))))
+ :node node)
+ (let ((type (lvar-type seq))
+ (element-type (type-specifier (extract-upgraded-element-type seq))))
+ (cond ((and (neq '* element-type) (policy node (> speed space)))
+ (values
+ `(with-array-data ((data seq)
+ (start start)
+ (end end)
+ :check-fill-pointer t)
+ (declare (type (simple-array ,element-type 1) data))
+ (declare (type index start end))
+ ;; WITH-ARRAY-DATA did our range checks once and for all, so
+ ;; it'd be wasteful to check again on every AREF...
+ (declare (optimize (safety 0) (speed 3)))
+ (do ((i start (1+ i)))
+ ((= i end) seq)
+ (declare (type index i))
+ (setf (aref data i) item)))
+ ;; ... though we still need to check that the new element can fit
+ ;; into the vector in safe code. -- CSR, 2002-07-05
+ `((declare (type ,element-type item)))))
+ ((csubtypep type (specifier-type 'string))
+ '(string-fill* seq item start end))
+ (t
+ '(vector-fill* seq item start end)))))
+
+(deftransform fill ((seq item &key (start 0) (end nil))
+ ((and sequence (not vector) (not list)) t &key (:start t) (:end t)))
+ `(sb!sequence:fill seq item
+ :start start
+ :end (%check-generic-sequence-bounds seq start end)))
\f
;;;; utilities
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.12.15"
+"1.0.12.16"
projects / sbcl.git / commitdiff