From e0090a168ad00c8a13c2848e5608d74bf5217e6b Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 1 Dec 2007 17:05:38 +0000 Subject: [PATCH] 1.0.12.10: sequence optimizations: SUBSEQ, part 1 * Compile-time dispatch to VECTOR-SUBSEQ* for vectors whose element-type or simplicity is uncertain. * Compile-time dispatch to SB-SEQUENCE:SUBSEQ for generic sequences. --- package-data-list.lisp-expr | 4 +++- src/compiler/seqtran.lisp | 48 ++++++++++++++++++++++++++----------------- version.lisp-expr | 2 +- 3 files changed, 33 insertions(+), 21 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 989ae2e..5d6cfb9 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1532,7 +1532,9 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "VALUES-TYPE-REST" "VALUES-TYPE-UNION" "VALUES-TYPE-TYPES" "VALUES-TYPES" "VALUES-TYPES-EQUAL-OR-INTERSECT" "VECTOR-T-P" - "VECTOR-NIL-P" "VECTOR-TO-VECTOR*" + "VECTOR-NIL-P" + "VECTOR-SUBSEQ*" + "VECTOR-TO-VECTOR*" "VECTOR-OF-CHECKED-LENGTH-GIVEN-LENGTH" "WITH-ARRAY-DATA" "WITH-CIRCULARITY-DETECTION" "WRONG-NUMBER-OF-INDICES-ERROR" diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 9cd3e8a..3efefa2 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -781,31 +781,41 @@ (type (integer 0 #.sb!xc:array-dimension-limit) j i)) (setf (aref ,dst (1- j)) (aref ,src (1- i)))))) +;;; SUBSEQ, COPY-SEQ + (deftransform subseq ((seq start &optional end) - ((or (simple-unboxed-array (*)) simple-vector) t &optional t) - * :node node) - (let ((array-type (lvar-type seq))) - (unless (array-type-p array-type) - (give-up-ir1-transform)) - (let ((element-type (type-specifier (array-type-specialized-element-type array-type)))) - `(let* ((length (length seq)) - (end (or end length))) - ,(unless (policy node (= safety 0)) - '(progn - (unless (<= 0 start end length) - (sequence-bounding-indices-bad-error seq start end)))) - (let* ((size (- end start)) - (result (make-array size :element-type ',element-type))) - ,(maybe-expand-copy-loop-inline 'seq (if (constant-lvar-p start) - (lvar-value start) - 'start) - 'result 0 'size element-type) - result))))) + (vector t &optional t) + * + :node node) + (let ((type (lvar-type seq))) + (cond + ((and (array-type-p type) + (csubtypep type (specifier-type '(or (simple-unboxed-array (*)) simple-vector)))) + (let ((element-type (type-specifier (array-type-specialized-element-type type)))) + `(let* ((length (length seq)) + (end (or end length))) + ,(unless (policy node (zerop insert-array-bounds-checks)) + '(progn + (unless (<= 0 start end length) + (sequence-bounding-indices-bad-error seq start end)))) + (let* ((size (- end start)) + (result (make-array size :element-type ',element-type))) + ,(maybe-expand-copy-loop-inline 'seq (if (constant-lvar-p start) + (lvar-value start) + 'start) + 'result 0 'size element-type) + result)))) + (t + '(vector-subseq* seq start end))))) (deftransform subseq ((seq start &optional end) (list t &optional t)) `(list-subseq* seq start end)) +(deftransform subseq ((seq start &optional end) + ((and sequence (not vector) (not list)) t &optional t)) + '(sb!sequence:subseq seq start end)) + (deftransform copy-seq ((seq) ((or (simple-unboxed-array (*)) simple-vector)) *) (let ((array-type (lvar-type seq))) (unless (array-type-p array-type) diff --git a/version.lisp-expr b/version.lisp-expr index 8ab1483..f6e611e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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.9" +"1.0.12.10" -- 1.7.10.4