1.0.12.10: sequence optimizations: SUBSEQ, part 1

[sbcl.git] / src / compiler / seqtran.lisp

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index eafa639..3efefa2 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -289,7 +289,7 @@
       '(let ((length (length vector)))
          (if (<= 0 start (or end length) length)
              (or end length)
-             (sb!impl::signal-bounding-indices-bad-error vector start end)))))
+             (sequence-bounding-indices-bad-error vector start end)))))
 
 (defun specialized-list-seek-function-name (function-name key-functions)
   (or (find-symbol (with-output-to-string (s)
@@ -617,9 +617,9 @@
           ,(unless (policy node (= safety 0))
              `(progn
                  (unless (<= 0 start1 end1 len1)
-                   (sb!impl::signal-bounding-indices-bad-error seq1 start1 end1))
+                   (sequence-bounding-indices-bad-error seq1 start1 end1))
                  (unless (<= 0 start2 end2 len2)
-                   (sb!impl::signal-bounding-indices-bad-error seq2 start2 end2))))
+                   (sequence-bounding-indices-bad-error seq2 start2 end2))))
           ,',(cond
               ((and saetp (valid-bit-bash-saetp-p saetp))
                (let* ((n-element-bits (sb!vm:saetp-n-bits saetp))
@@ -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)
-                      (sb!impl::signal-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)
@@ -837,7 +847,7 @@
         (check-bounds-p (policy node (plusp insert-array-bounds-checks))))
     `(block search
        (flet ((oops (vector start end)
-                (bounding-index-error vector start end)))
+                (sequence-bounding-indices-bad-error vector start end)))
          (let* ((len1 (length pattern))
                 (len2 (length text))
                 (end1 (or end1 len1))
@@ -997,7 +1007,7 @@
                    (declare (type index index))
                    (dolist (i sequence
                             (if (and end (> end index))
-                                (sb!impl::signal-bounding-indices-bad-error
+                                (sequence-bounding-indices-bad-error
                                  sequence start end)
                                 (values find position)))
                      (let ((key-i (funcall key i)))