X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=3f70b073aacc2ce3afdc037cf9dcea5e64b799ce;hb=6bbc22725d3bf663726ed9adca544e39316364a6;hp=78cb9dc91dacf55ddeefe9d25a68f44d84833893;hpb=2de1b72f4bec82ad5289f33a84b34fe9cb62bd0a;p=sbcl.git

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 78cb9dc..3f70b07 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -668,8 +668,10 @@
      (define-one-transform (sequence-type1 sequence-type2)
        (make-replace-transform nil sequence-type1 sequence-type2)))
   (define-replace-transforms)
-  (define-one-transform simple-base-string (simple-array character (*)))
-  (define-one-transform (simple-array character (*)) simple-base-string))
+  #!+sb-unicode
+  (progn
+   (define-one-transform (simple-array base-char (*)) (simple-array character (*)))
+   (define-one-transform (simple-array character (*)) (simple-array base-char (*)))))
 
 ;;; Expand simple cases of UB<SIZE>-BASH-COPY inline.  "simple" is
 ;;; defined as those cases where we are doing word-aligned copies from
@@ -734,7 +736,8 @@
            (do ((i end (1- i)))
                ((<= i ,src-word))
              (setf (sb!kernel:%vector-raw-bits dst (1- i))
-                   (sb!kernel:%vector-raw-bits src (1- i)))))))))
+                   (sb!kernel:%vector-raw-bits src (1- i))))
+           (values))))))
 
 #.(loop for i = 1 then (* i 2)
         collect `(deftransform ,(intern (format nil "UB~D-BASH-COPY" i)
@@ -1275,3 +1278,43 @@
                     (effective-find-position-key key))))))
   (define-find-position-if-not find-if-not 0)
   (define-find-position-if-not position-if-not 1))
+
+(macrolet ((define-trimmer-transform (fun-name leftp rightp)
+             `(deftransform ,fun-name ((char-bag string)
+                                       (t simple-string))
+                (let ((find-expr
+                       (if (constant-lvar-p char-bag)
+                           ;; If the bag is constant, use MEMBER
+                           ;; instead of FIND, since we have a
+                           ;; deftransform for MEMBER that can
+                           ;; open-code all of the comparisons when
+                           ;; the list is constant. -- JES, 2007-12-10
+                           `(not (member (schar string index)
+                                         ',(coerce (lvar-value char-bag) 'list)
+                                         :test #'char=))
+                           '(not (find (schar string index) char-bag :test #'char=)))))
+                  `(flet ((char-not-in-bag (index)
+                            ,find-expr))
+                     (let* ((end (length string))
+                            (left-end (if ,',leftp
+                                          (do ((index 0 (1+ index)))
+                                              ((or (= index (the fixnum end))
+                                                   (char-not-in-bag index))
+                                               index)
+                                            (declare (fixnum index)))
+                                          0))
+                            (right-end (if ,',rightp
+                                           (do ((index (1- end) (1- index)))
+                                               ((or (< index left-end)
+                                                    (char-not-in-bag index))
+                                                (1+ index))
+                                             (declare (fixnum index)))
+                                           end)))
+                       (if (and (eql left-end 0)
+                                (eql right-end (length string)))
+                           string
+                           (subseq string left-end right-end))))))))
+  (define-trimmer-transform string-left-trim t nil)
+  (define-trimmer-transform string-right-trim nil t)
+  (define-trimmer-transform string-trim t t))
+