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.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 989ae2e..5d6cfb9 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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"