X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fseqtran.lisp;h=f13cd2e5632216e07e2dec382dec708a9be71001;hb=add57c72c932fbf70c8ba8297154936c908b410e;hp=58b0327c8c445b7ae205fb7508ca623076d9e17d;hpb=57e21c4b62e8c1a1ee7ef59ed2abb0c864fb06bc;p=sbcl.git

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 58b0327..f13cd2e 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -122,8 +122,8 @@
 		       bare))))))))
 
 ;;; Return a DO loop, mapping a function FUN to elements of
-;;; sequences. SEQS is a list of continuations, SEQ-NAMES - list of
-;;; variables, bound to sequences, INTO - a variable, which is used in
+;;; sequences. SEQS is a list of lvars, SEQ-NAMES - list of variables,
+;;; bound to sequences, INTO - a variable, which is used in
 ;;; MAP-INTO. RESULT and BODY are forms, which can use variables
 ;;; FUNCALL-RESULT, containing the result of application of FUN, and
 ;;; INDEX, containing the current position in sequences.
@@ -376,7 +376,7 @@
 
 ;;;; utilities
 
-;;; Return true if CONT's only use is a non-NOTINLINE reference to a
+;;; Return true if LVAR's only use is a non-NOTINLINE reference to a
 ;;; global function with one of the specified NAMES.
 (defun lvar-fun-is (lvar names)
   (declare (type lvar lvar) (list names))
@@ -388,9 +388,9 @@
 		(not (null (member (leaf-source-name leaf) names
 				   :test #'equal))))))))
 
-;;; If CONT is a constant continuation, the return the constant value.
-;;; If it is null, then return default, otherwise quietly give up the
-;;; IR1 transform.
+;;; 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)
@@ -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,
@@ -1030,8 +1056,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)