0.8.13.32:

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

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index b531b36..8b0215a 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -712,6 +712,32 @@
                            sb!vm:n-byte-bits)))
      string1))
 
+;;; 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)
+                     *
+                     :policy (> speed (max space safety)))
+  `(block search
+    (let ((end1 (or end1 (length pattern)))
+         (end2 (or end2 (length text))))
+      (do ((index2 start2 (1+ index2)))
+         ((>= index2 end2) nil)
+       (when (do ((index1 start1 (1+ index1))
+                  (index2 index2 (1+ index2)))
+                 ((>= index1 end1) t)
+               (when (= index2 end2)
+                 (return-from search nil))
+               (when (char/= (char pattern index1) (char text index2))
+                 (return nil)))
+         (return index2))))))
+
 ;;; FIXME: It seems as though it should be possible to make a DEFUN
 ;;; %CONCATENATE (with a DEFTRANSFORM to translate constant RTYPE to
 ;;; CTYPE before calling %CONCATENATE) which is comparably efficient,
@@ -796,8 +822,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)
@@ -843,8 +868,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
@@ -937,8 +961,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
@@ -947,8 +970,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
@@ -957,8 +979,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
@@ -1030,8 +1051,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)