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 1adfcf49f930afeecc961cb7b94c9361f9648932..b2c97ecd0728c5e931aaa0f2376cfa5edad3e24e 100644 (file)
--- 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>=?))
 \f
-(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))