Fix implementations of string-prefix-ci? and string-suffix-ci?.

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 0bbb33e31d67791e463e1d7495aec393661fa1b1..6eb5414e584f93f52611c30ace05ff345afda160 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -396,36 +396,35 @@ USA.
   (string-match-backward (string-foldcase string1)
                         (string-foldcase string2)))
 
-(define-integrable (prefix-maker c= caller)
-  (lambda (prefix string #!optional start end)
-    (let* ((end (fix:end-index end (string-length string) caller))
-          (start (fix:start-index start end caller))
-          (n (string-length prefix)))
-      (and (fix:<= n (fix:- end start))
-          (let loop ((i 0) (j start))
-            (if (fix:< i n)
-                (and (c= (string-ref prefix i) (string-ref string j))
-                     (loop (fix:+ i 1) (fix:+ j 1)))
-                #t))))))
-
-(define-integrable (suffix-maker c= caller)
-  (lambda (suffix string #!optional start end)
-    (let* ((end (fix:end-index end (string-length string) caller))
-          (start (fix:start-index start end caller))
-          (n (string-length suffix)))
-      (and (fix:<= n (fix:- end start))
-          (let loop ((i 0) (j (fix:- end n)))
-            (if (fix:< i n)
-                (and (c= (string-ref suffix i) (string-ref string j))
-                     (loop (fix:+ i 1) (fix:+ j 1)))
-                #t))))))
-
-(define string-prefix? (prefix-maker eq? 'string-prefix?))
-(define string-suffix? (suffix-maker eq? 'string-suffix?))
-
-;;; Incorrect implementation: should do string-foldcase on both args.
-(define string-prefix-ci? (prefix-maker char-ci=? 'string-prefix-ci?))
-(define string-suffix-ci? (suffix-maker char-ci=? 'string-suffix-ci?))
+(define (string-prefix? prefix string #!optional start end)
+  (let* ((end (fix:end-index end (string-length string) 'string-prefix?))
+        (start (fix:start-index start end 'string-prefix?))
+        (n (string-length prefix)))
+    (and (fix:<= n (fix:- end start))
+        (let loop ((i 0) (j start))
+          (if (fix:< i n)
+              (and (eq? (string-ref prefix i) (string-ref string j))
+                   (loop (fix:+ i 1) (fix:+ j 1)))
+              #t)))))
+
+(define (string-suffix? suffix string #!optional start end)
+  (let* ((end (fix:end-index end (string-length string) 'string-suffix?))
+        (start (fix:start-index start end 'string-suffix?))
+        (n (string-length suffix)))
+    (and (fix:<= n (fix:- end start))
+        (let loop ((i 0) (j (fix:- end n)))
+          (if (fix:< i n)
+              (and (eq? (string-ref suffix i) (string-ref string j))
+                   (loop (fix:+ i 1) (fix:+ j 1)))
+              #t)))))
+
+(define (string-prefix-ci? prefix string #!optional start end)
+  (string-prefix? (string-foldcase prefix)
+                 (string-foldcase (string-slice string start end))))
+
+(define (string-suffix-ci? suffix string #!optional start end)
+  (string-suffix? (string-foldcase suffix)
+                 (string-foldcase (string-slice string start end))))
 \f
 ;;;; Case