From 63c760840e9761a471b313f11c4ebb6d0371ecc9 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 27 Feb 2017 21:10:06 -0800
Subject: [PATCH] Fix implementations of string-prefix-ci? and
 string-suffix-ci?.

---
 src/runtime/ustring.scm | 59 ++++++++++++++++++++---------------------
 1 file changed, 29 insertions(+), 30 deletions(-)

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 0bbb33e31..6eb5414e5 100644
--- 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))))
 
 ;;;; Case
 
-- 
2.25.1