X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=58585aa60bf986d61e0f3a4452a86c04b987cf72;hb=b63c4fb9b98fa8188e17ba926e150ba417a74635;hp=9e124dbe37aebb26bae61f6e6ecf1234c224ac03;hpb=8dd43b84a688fde72f6d957c59f7207d539990f7;p=sbcl.git

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 9e124db..58585aa 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -712,16 +712,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 +763,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 +793,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))
@@ -822,8 +845,7 @@
 	     `(deftransform ,name ((predicate sequence from-end start end key)
 				   (function list t t t function)
 				   *
-				   :policy (> speed space)
-				   :important t)
+				   :policy (> speed space))
 		"expand inline"
 		`(let ((index 0)
 		       (find nil)
@@ -869,8 +891,7 @@
 (deftransform %find-position ((item sequence from-end start end key test)
 			      (t list t t t t t)
 			      *
-			      :policy (> speed space)
-			      :important t)
+			      :policy (> speed space))
   "expand inline"
   '(%find-position-if (let ((test-fun (%coerce-callable-to-fun test)))
 			;; The order of arguments for asymmetric tests
@@ -963,8 +984,7 @@
 (deftransform %find-position-if ((predicate sequence from-end start end key)
 				 (function vector t t t function)
 				 *
-				 :policy (> speed space)
-				 :important t)
+				 :policy (> speed space))
   "expand inline"
   (check-inlineability-of-find-position-if sequence from-end)
   '(%find-position-if-vector-macro predicate sequence
@@ -973,8 +993,7 @@
 (deftransform %find-position-if-not ((predicate sequence from-end start end key)
 				     (function vector t t t function)
 				     *
-				     :policy (> speed space)
-				     :important t)
+				     :policy (> speed space))
   "expand inline"
   (check-inlineability-of-find-position-if sequence from-end)
   '(%find-position-if-not-vector-macro predicate sequence
@@ -983,8 +1002,7 @@
 (deftransform %find-position ((item sequence from-end start end key test)
 			      (t vector t t t function function)
 			      *
-			      :policy (> speed space)
-			      :important t)
+			      :policy (> speed space))
   "expand inline"
   (check-inlineability-of-find-position-if sequence from-end)
   '(%find-position-vector-macro item sequence
@@ -1056,8 +1074,8 @@
 ;;;     perhaps it's worth optimizing the -if-not versions in the same
 ;;;     way as the others?
 ;;;
-;;; FIXME: Maybe remove uses of these deprecated functions (and
-;;; definitely of :TEST-NOT) within the implementation of SBCL.
+;;; FIXME: Maybe remove uses of these deprecated functions within the
+;;; implementation of SBCL.
 (macrolet ((define-find-position-if-not (fun-name values-index)
 	       `(deftransform ,fun-name ((predicate sequence &key
 					  from-end (start 0)