1.0.19.27: more ir1 transforms for REPLACE

Supplying START1 or START2 does not inhibit ir1 transforms for
specialized array types.

diff --git a/NEWS b/NEWS
index df60f64..0cfec02 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,8 @@ changes in sbcl-1.0.20 relative to 1.0.19:
     (AREF (THE STRING X) Y) as being CHARACTER.
   * optimization: CLRHASH on empty hash-tables no longer does pointless
     work. (thanks to Alec Berryman)
+  * optimization: REPLACE deftransforms don't punt when :START1 or
+    :START2 is given
   * bug fix: bogus odd-number-of-keywords STYLE-WARNINGs from calls to
     functions with an odd number of &OPTIONAL arguments, a &REST
     argument, and one or more &KEY arguments at the call site.

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 7d5a935..6b4cef7 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -547,22 +547,6 @@
                      :start start
                      :end (%check-generic-sequence-bounds seq start end)))
 \f
-;;;; utilities
-
-;;; If LVAR is a constant lvar, the return the constant value. If it
-;;; is null, then return default, otherwise quietly give up the IR1
-;;; transform.
-;;;
-;;; ### Probably should take an ARG and flame using the NAME.
-(defun constant-value-or-lose (lvar &optional default)
-  (declare (type (or lvar null) lvar))
-  (cond ((not lvar) default)
-        ((constant-lvar-p lvar)
-         (lvar-value lvar))
-        (t
-         (give-up-ir1-transform))))
-
-
 ;;;; hairy sequence transforms
 
 ;;; FIXME: no hairy sequence transforms in SBCL?
@@ -698,51 +682,44 @@
                             (,sequence-type1 ,sequence-type2 &rest t)
                             ,sequence-type1
                             :node node)
-       ,(cond
-         ((and saetp (valid-bit-bash-saetp-p saetp)) nil)
-         ;; If the sequence types are different, SEQ1 and SEQ2 must
-         ;; be distinct arrays, and we can open code the copy loop.
-         ((not (eql sequence-type1 sequence-type2)) nil)
-         ;; If we're not bit-bashing, only allow cases where we
-         ;; can determine the order of copying up front.  (There
-         ;; are actually more cases we can handle if we know the
-         ;; amount that we're copying, but this handles the
-         ;; common cases.)
-         (t '(unless (= (constant-value-or-lose start1 0)
-                      (constant-value-or-lose start2 0))
-              (give-up-ir1-transform))))
        `(let* ((len1 (length seq1))
                (len2 (length seq2))
                (end1 (or end1 len1))
                (end2 (or end2 len2))
-               (replace-len1 (- end1 start1))
-               (replace-len2 (- end2 start2)))
+               (replace-len (min (- end1 start1) (- end2 start2))))
           ,(unless (policy node (= safety 0))
              `(progn
-                 (unless (<= 0 start1 end1 len1)
-                   (sequence-bounding-indices-bad-error seq1 start1 end1))
-                 (unless (<= 0 start2 end2 len2)
-                   (sequence-bounding-indices-bad-error seq2 start2 end2))))
+                (unless (<= 0 start1 end1 len1)
+                  (sequence-bounding-indices-bad-error seq1 start1 end1))
+                (unless (<= 0 start2 end2 len2)
+                  (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))
-                      (bash-function (intern (format nil "UB~D-BASH-COPY"
-                                                     n-element-bits)
-                                             (find-package "SB!KERNEL"))))
-                 `(funcall (function ,bash-function) seq2 start2
-                           seq1 start1 (min replace-len1 replace-len2))))
-              (t
-               ;; We can expand the loop inline here because we
-               ;; would have given up the transform (see above)
-               ;; if we didn't have constant matching start
-               ;; indices.
-               '(do ((i start1 (1+ i))
-                     (j start2 (1+ j))
-                     (end (+ start1
-                             (min replace-len1 replace-len2))))
-                 ((>= i end))
-                 (declare (optimize (insert-array-bounds-checks 0)))
-                 (setf (aref seq1 i) (aref seq2 j)))))
+               ((and saetp (valid-bit-bash-saetp-p saetp))
+                (let* ((n-element-bits (sb!vm:saetp-n-bits saetp))
+                       (bash-function (intern (format nil "UB~D-BASH-COPY"
+                                                      n-element-bits)
+                                              (find-package "SB!KERNEL"))))
+                  `(funcall (function ,bash-function) seq2 start2
+                    seq1 start1 replace-len)))
+               (t
+                `(if (and
+                      ;; If the sequence types are different, SEQ1 and
+                      ;; SEQ2 must be distinct arrays.
+                      ,(eql sequence-type1 sequence-type2)
+                      (eq seq1 seq2) (> start1 start2))
+                     (do ((i (truly-the index (+ start1 replace-len -1))
+                             (1- i))
+                          (j (truly-the index (+ start2 replace-len -1))
+                             (1- j)))
+                         ((< i start1))
+                       (declare (optimize (insert-array-bounds-checks 0)))
+                       (setf (aref seq1 i) (aref seq2 j)))
+                     (do ((i start1 (1+ i))
+                          (j start2 (1+ j))
+                          (end (+ start1 replace-len)))
+                         ((>= i end))
+                       (declare (optimize (insert-array-bounds-checks 0)))
+                       (setf (aref seq1 i) (aref seq2 j))))))
           seq1))))
 
 (macrolet

diff --git a/version.lisp-expr b/version.lisp-expr
index 52e70ee..157799d 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.19.26"
+"1.0.19.27"