Change string-match and string-search to require NFC inputs.

This is because comparison requires that the strings be in the same
normalization form, and these procedures return indices into the strings.  We
can't normalize them after the call, because then the returned indices will
refer to strings that are potentially different from the arguments.

Since nearly all strings are in NFC by default this should not be a serious
drawback.

Additionally, the -ci versions of these procedures have been eliminated,
basically for the same reason.  If the caller needs that functionality they
should call string-foldcase themselves.

Note that this doesn't affect comparisons that don't return indices.

diff --git a/src/compiler/base/infnew.scm b/src/compiler/base/infnew.scm
index ef9fc11a7987f6503c9d637210960f9fb484b22d..03e29207cbf2f1df2e154b9baff4432e77442685 100644 (file)
--- a/src/compiler/base/infnew.scm
+++ b/src/compiler/base/infnew.scm
@@ -365,14 +365,16 @@ USA.
                          (suffix-number y)))))))
 
 (define (standard-name? string prefix)
-  (let ((index (string-match-forward-ci string prefix))
-       (end (string-length string)))
-    (and (= index (string-length prefix))
-        (>= (- end index) 2)
-        (let ((next (string-ref string index)))
-          (or (char=? #\- next)
-              (char=? #\_ next)))
-        (let loop ((index (1+ index)))
-          (or (= index end)
-              (and (char-numeric? (string-ref string index))
-                   (loop (1+ index))))))))
\ No newline at end of file
+  (let ((string (string-foldcase string))
+       (prefix (string-foldcase prefix)))
+    (let ((index (string-match-forward string prefix))
+         (end (string-length string)))
+      (and (= index (string-length prefix))
+          (>= (- end index) 2)
+          (let ((next (string-ref string index)))
+            (or (char=? #\- next)
+                (char=? #\_ next)))
+          (let loop ((index (1+ index)))
+            (or (= index end)
+                (and (char-numeric? (string-ref string index))
+                     (loop (1+ index)))))))))
\ No newline at end of file

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 27a04059aaebb51570c086706fcd6a3e27c332f1..eb2fc87771f54dfb4cda5f58afb7653ede146c62 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1016,9 +1016,7 @@ USA.
          string-lower-case?
          string-map
          string-match-backward
-         string-match-backward-ci
          string-match-forward
-         string-match-forward-ci
          string-null?
          string-pad-left
          string-pad-right

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index c517e90c2a8d9987d4961d800e0310ed5ebad400..9691cf22b41189a81c8827bc9e279a71b9137752 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -79,6 +79,7 @@ USA.
   (register-predicate! string? 'string)
   (register-predicate! mutable-string? 'mutable-string '<= string?)
   (register-predicate! immutable-string? 'immutable-string '<= string?)
+  (register-predicate! nfc-string? 'nfc-string '<= string?)
   (register-predicate! legacy-string? 'legacy-string
                       '<= string?
                       '<= mutable-string?)
@@ -701,6 +702,8 @@ USA.
 ;;;; Match
 
 (define (string-match-forward string1 string2)
+  (guarantee nfc-string? string1 'string-match-forward)
+  (guarantee nfc-string? string2 'string-match-forward)
   (let ((end1 (string-length string1))
        (end2 (string-length string2)))
     (let ((end (fix:min end1 end2)))
@@ -711,11 +714,9 @@ USA.
            (loop (fix:+ i 1))
            i)))))
 
-(define (string-match-forward-ci string1 string2)
-  (string-match-forward (string-foldcase string1)
-                       (string-foldcase string2)))
-
 (define (string-match-backward string1 string2)
+  (guarantee nfc-string? string1 'string-match-backward)
+  (guarantee nfc-string? string2 'string-match-backward)
   (let ((s1 (fix:- (string-length string1) 1)))
     (let loop ((i s1) (j (fix:- (string-length string2) 1)))
       (if (and (fix:>= i 0)
@@ -726,10 +727,6 @@ USA.
                (fix:- j 1))
          (fix:- s1 i)))))
 
-(define (string-match-backward-ci string1 string2)
-  (string-match-backward (string-foldcase string1)
-                        (string-foldcase string2)))
-
 (define (string-prefix? prefix string #!optional start end)
   (%string-prefix? (string->nfc prefix)
                   (string->nfc (string-slice string start end))))
@@ -838,6 +835,10 @@ USA.
 \f
 ;;;; Normalization
 
+(define (nfc-string? string)
+  (and (string? string)
+       (string-in-nfc? string)))
+
 (define (string-in-nfc? string)
   (cond ((legacy-string? string)
         #t)
@@ -1485,6 +1486,8 @@ USA.
 
 (define-integrable (string-matcher caller matcher)
   (lambda (pattern text #!optional start end)
+    (guarantee nfc-string? pattern caller)
+    (guarantee nfc-string? text caller)
     (let ((pend (string-length pattern)))
       (if (fix:= 0 pend)
          (error:bad-range-argument pend caller))