From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 30 Jan 2017 02:39:57 +0000 (-0800)
Subject: Add substring indices to prefix/suffix tests.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~27
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2de6bd92ac061bf2a48581c0cc4c338fef3f5e41;p=mit-scheme.git

Add substring indices to prefix/suffix tests.

Also simplify the implementations and fix a thinko in the suffix
implementations.
---

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 1adfcf49f..b2c97ecd0 100644
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -459,43 +459,36 @@ USA.
 (define ustring-ci>? (string-comparison-maker %ustring-ci>?))
 (define ustring-ci>=? (string-comparison-maker %ustring-ci>=?))
 
-(define (ustring-prefix? prefix string)
-  (let ((n (ustring-length prefix)))
-    (and (fix:<= n (ustring-length string))
-	 (let loop ((i 0))
-	   (if (fix:< i n)
-	       (and (eq? (ustring-ref prefix i) (ustring-ref string i))
-		    (loop (fix:+ i 1)))
-	       #t)))))
-
-(define (ustring-suffix? suffix string)
-  (let ((n (ustring-length suffix)))
-    (and (fix:<= n (ustring-length string))
-	 (let loop ((i (fix:- n 1)))
-	   (if (fix:>= i 0)
-	       (and (eq? (ustring-ref suffix i) (ustring-ref string i))
-		    (loop (fix:- i 1)))
-	       #t)))))
+(define-integrable (prefix-maker c= caller)
+  (lambda (prefix string #!optional start end)
+    (let* ((end (fix:end-index end (ustring-length string) caller))
+	   (start (fix:start-index start end caller))
+	   (n (ustring-length prefix)))
+      (and (fix:<= n (fix:- end start))
+	   (let loop ((i 0) (j start))
+	     (if (fix:< i n)
+		 (and (c= (ustring-ref prefix i) (ustring-ref string j))
+		      (loop (fix:+ i 1) (fix:+ j 1)))
+		 #t))))))
 
-;; Incorrect implementation
-(define (ustring-prefix-ci? prefix string)
-  (let ((n (ustring-length prefix)))
-    (and (fix:<= n (ustring-length string))
-	 (let loop ((i 0))
-	   (if (fix:< i n)
-	       (and (char-ci=? (ustring-ref prefix i) (ustring-ref string i))
-		    (loop (fix:+ i 1)))
-	       #t)))))
+(define-integrable (suffix-maker c= caller)
+  (lambda (suffix string #!optional start end)
+    (let* ((end (fix:end-index end (ustring-length string) caller))
+	   (start (fix:start-index start end caller))
+	   (n (ustring-length suffix)))
+      (and (fix:<= n (fix:- end start))
+	   (let loop ((i 0) (j (fix:- end n)))
+	     (if (fix:< i n)
+		 (and (c= (ustring-ref suffix i) (ustring-ref string j))
+		      (loop (fix:+ i 1) (fix:+ j 1)))
+		 #t))))))
 
-;; Incorrect implementation
-(define (ustring-suffix-ci? suffix string)
-  (let ((n (ustring-length suffix)))
-    (and (fix:<= n (ustring-length string))
-	 (let loop ((i (fix:- n 1)))
-	   (if (fix:>= i 0)
-	       (and (char-ci=? (ustring-ref suffix i) (ustring-ref string i))
-		    (loop (fix:- i 1)))
-	       #t)))))
+(define ustring-prefix? (prefix-maker eq? 'ustring-prefix?))
+(define ustring-suffix? (suffix-maker eq? 'ustring-suffix?))
+
+;; Incorrect implementations
+(define ustring-prefix-ci? (prefix-maker char-ci=? 'ustring-prefix-ci?))
+(define ustring-suffix-ci? (suffix-maker char-ci=? 'ustring-suffix-ci?))
 
 (define (ustring-head string end)
   (ustring-copy string 0 end))