From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 7 Oct 2010 00:33:50 +0000 (+0000)
Subject: Don't invoke B-M for one-character patterns in SUBSTRING-SEARCH-ALL.
X-Git-Tag: 20101212-Gtk~54
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=096ee558a39a479b9d7fd2515c231834a059e5f3;p=mit-scheme.git

Don't invoke B-M for one-character patterns in SUBSTRING-SEARCH-ALL.
---

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 4157af4ce..efd443fcd 100644
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -1292,14 +1292,14 @@ USA.
 (define (string-search-all pattern text)
   (guarantee-string pattern 'STRING-SEARCH-ALL)
   (guarantee-string text 'STRING-SEARCH-ALL)
-  (%bm-substring-search-all text 0 (string-length text)
-			    pattern 0 (string-length pattern)))
+  (%substring-search-all text 0 (string-length text)
+			 pattern 0 (string-length pattern)))
 
 (define (substring-search-all pattern text tstart tend)
   (guarantee-string pattern 'SUBSTRING-SEARCH-ALL)
   (guarantee-substring text tstart tend 'SUBSTRING-SEARCH-ALL)
-  (%bm-substring-search-all text tstart tend
-			    pattern 0 (string-length pattern)))
+  (%substring-search-all text tstart tend
+			 pattern 0 (string-length pattern)))
 
 (define (%substring-search-forward text tstart tend pattern pstart pend)
   ;; Returns index of first matched char, or #F.
@@ -1351,6 +1351,27 @@ USA.
 				  pattern pstart pend-1)
 		     tend
 		     (loop (fix:- tend 1)))))))))
+
+(define (%substring-search-all text tstart tend pattern pstart pend)
+  (let ((plen (fix:- pend pstart)))
+    (cond ((fix:= plen 1)
+	   (let ((c (string-ref pattern pstart)))
+	     (let loop ((ti tend) (occurrences '()))
+	       (let ((index (%substring-find-previous-char text tstart ti c)))
+		 (if index
+		     (loop index (cons index occurrences))
+		     occurrences)))))
+	  #;    ;This may not be worthwhile -- I have no measurements.
+	  ((fix:< plen 4)
+	   (let loop ((ti tend) (occurrences '()))
+	     (let ((index
+		    (%dumb-substring-search-backward text tstart ti
+						     pattern pstart pend)))
+	       (if index
+		   (loop (fix:+ index (fix:- plen 1)) (cons index occurrences))
+		   occurrences))))
+	  (else
+	   (%bm-substring-search-all text tstart tend pattern pstart pend)))))
 
 ;;;; Boyer-Moore String Search