From: Nikodemus S. <de...@us...> - 2007-12-05 15:16:10
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv25052/src/compiler Modified Files: seqtran.lisp Log Message: 1.0.12.16: sequence optimizations: FILL * Use DEFUN instead of DEFINE-SEQUENCE-TRAVERSER for FILL: the dispatched to functions do all the necessary checking, and do it better since they know more about the types. * New function: STRING-FILL*. * Rewrite VECTOR-FILL* and LIST-FILL* for efficiency. * Macros VECTOR-FILL and LIST-FILL were expanded only in VECTOR-FILL* and LIST-FILL* -- get rid of them. * Compile-time dispatch to STRING-FILL*, VECTOR-FILL*, LIST-FILL*, and SB-SEQUENCE:FILL. * Comment above %CHECK-VECTOR-SEQUENC-BOUNDS no longer applies, delete it. Index: seqtran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v retrieving revision 1.86 retrieving revision 1.87 diff -u -d -r1.86 -r1.87 --- seqtran.lisp 1 Dec 2007 18:57:59 -0000 1.86 +++ seqtran.lisp 5 Dec 2007 15:16:03 -0000 1.87 @@ -408,29 +408,44 @@ (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))) ;;;; utilities |