0.8.20.27:

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

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 8b0215a..b20f4db 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -624,14 +624,16 @@
 ;;; must be SIMPLE-BASE-STRINGs.
 (macrolet ((def (name lessp equalp)
              `(deftransform ,name ((string1 string2 start1 end1 start2 end2)
-                                    (simple-base-string simple-base-string t t t t) *)
+                                   (simple-base-string simple-base-string t t t t) *)
                 `(let* ((end1 (if (not end1) (length string1) end1))
                         (end2 (if (not end2) (length string2) end2))
                         (index (sb!impl::%sp-string-compare
                                 string1 start1 end1 string2 start2 end2)))
                   (if index
-                      (cond ((= index ,(if ',lessp 'end1 'end2)) index)
-                            ((= index ,(if ',lessp 'end2 'end1)) nil)
+                      (cond ((= index end1)
+                             ,(if ',lessp 'index nil))
+                            ((= (+ index (- start2 start1)) end2)
+                             ,(if ',lessp nil 'index))
                             ((,(if ',lessp 'char< 'char>)
                                (schar string1 index)
                                (schar string2
@@ -639,9 +641,9 @@
                                                  (+ index
                                                     (truly-the fixnum
                                                                (- start2
-                                                                 start1))))))
+                                                                  start1))))))
                              index)
-                            (t nil))
+                           (t nil))
                       ,(if ',equalp 'end1 nil))))))
   (def string<* t nil)
   (def string<=* t t)
@@ -712,16 +714,35 @@
                            sb!vm:n-byte-bits)))
      string1))
 
+;;; KLUDGE: This isn't the nicest way of achieving efficient string
+;;; streams, but it does work; a more general framework for this kind
+;;; of optimization, as well as better handling of the possible
+;;; keyword arguments, would be nice.
+#!+sb-unicode
+(deftransform replace ((string1 string2 &key (start1 0) (start2 0)
+                               end1 end2)
+                      ((simple-array character (*))
+                        (simple-array character (*))
+                        &rest t)
+                      *
+                      ;; FIXME: consider replacing this policy test
+                      ;; with some tests for the STARTx and ENDx
+                      ;; indices being valid, conditional on high
+                      ;; SAFETY code.
+                      ;;
+                      ;; FIXME: It turns out that this transform is
+                      ;; critical for the performance of string
+                      ;; streams.  Make this more explicit.
+                      :policy (< (max safety space) 3))
+  `(sb!impl::simple-character-string-replace-from-simple-character-string*
+    string1 string2 start1 end1 start2 end2))
+
 ;;; FIXME: this would be a valid transform for certain excluded cases:
 ;;;   * :TEST 'CHAR= or :TEST #'CHAR=
 ;;;   * :TEST 'EQL   or :TEST #'EQL
 ;;;   * :FROM-END NIL (or :FROM-END non-NIL, with a little ingenuity)
-;;;
-;;; also, it should be noted that there's nothing much in this
-;;; transform (as opposed to the ones for REPLACE and CONCATENATE)
-;;; that particularly limits it to SIMPLE-BASE-STRINGs.
 (deftransform search ((pattern text &key (start1 0) (start2 0) end1 end2)
-                     (simple-base-string simple-base-string &rest t)
+                     (simple-string simple-string &rest t)
                      *
                      :policy (> speed (max space safety)))
   `(block search
@@ -744,6 +765,9 @@
 ;;; at least once DYNAMIC-EXTENT works.
 ;;;
 ;;; FIXME: currently KLUDGEed because of bug 188
+;;;
+;;; FIXME: disabled for sb-unicode: probably want it back
+#!-sb-unicode
 (deftransform concatenate ((rtype &rest sequences)
                           (t &rest (or simple-base-string
                                        (simple-array nil (*))))
@@ -771,7 +795,8 @@
              (declare (ignore rtype))
              (let* (,@lets
                       (res (make-string (truncate (the index (+ ,@all-lengths))
-                                                  sb!vm:n-byte-bits))))
+                                                  sb!vm:n-byte-bits)
+                                        :element-type 'base-char)))
                (declare (type index ,@all-lengths))
                (let (,@(mapcar (lambda (name) `(,name 0)) starts))
                  (declare (type index ,@starts))