Use canonical caseless matching for symbols.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a9f3c926b2e519f35314ea9345b14245abfbf997..d98ccbeb1213ed865ed86a9f00c3610cd0d6e342 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -974,6 +974,7 @@ USA.
          string
          string*
          string->list
+         string->nfd
          string->vector
          string-any
          string-append
@@ -987,6 +988,7 @@ USA.
          string-ci>?
          string-compare
          string-compare-ci
+         string-canonical-foldcase
          string-copy
          string-copy!
          string-count
@@ -1290,6 +1292,7 @@ USA.
          char-set:changes-when-case-folded
          ucd-nt-value)
   (export (runtime ustring)
+         char-changes-when-case-folded?
          char-changes-when-lower-cased?
          char-changes-when-upper-cased?
          char-nfd-quick-check?

diff --git a/src/runtime/symbol.scm b/src/runtime/symbol.scm
index 12e398d72dfed326a3762d69b35328955dccec6c..4b31d7bc582e2ec7f1318e07b1681143c800bed7 100644 (file)
--- a/src/runtime/symbol.scm
+++ b/src/runtime/symbol.scm
@@ -101,7 +101,7 @@ USA.
   (if (ascii-string? string)
       ;; Needed during cold load.
       (%legacy-string->bytevector (ascii-string-foldcase string))
-      (string->utf8 (string-foldcase string))))
+      (string->utf8 (string-canonical-foldcase string))))
 
 (define (ascii-string? string)
   (and (legacy-string? string)

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 978656060591c51bf4278c60e145bf97956c5a2a..366b9a5382fea74713376ee52eb0a5c5be4cfce1 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -474,22 +474,40 @@ USA.
                (loop (fix:+ index 1))))))))
 
 (define (string-lower-case? string)
-  (let* ((nfd (string->nfd string))
-        (end (string-length nfd)))
+  (nfd-string-lower-case? (string->nfd string)))
+
+(define (string-upper-case? string)
+  (nfd-string-upper-case? (string->nfd string)))
+
+(define (nfd-string-lower-case? nfd)
+  (let ((end (string-length nfd)))
     (let loop ((i 0))
       (if (fix:< i end)
          (and (not (char-changes-when-lower-cased? (string-ref nfd i)))
               (loop (fix:+ i 1)))
          #t))))
 
-(define (string-upper-case? string)
-  (let* ((nfd (string->nfd string))
-        (end (string-length nfd)))
+(define (nfd-string-upper-case? nfd)
+  (let ((end (string-length nfd)))
     (let loop ((i 0))
       (if (fix:< i end)
          (and (not (char-changes-when-upper-cased? (string-ref nfd i)))
               (loop (fix:+ i 1)))
          #t))))
+
+(define (nfd-string-case-folded? nfd)
+  (let ((end (string-length nfd)))
+    (let loop ((i 0))
+      (if (fix:< i end)
+         (and (not (char-changes-when-case-folded? (string-ref nfd i)))
+              (loop (fix:+ i 1)))
+         #t))))
+
+(define (string-canonical-foldcase string)
+  (let ((nfd (string->nfd string)))
+    (if (nfd-string-case-folded? nfd)
+       nfd
+       (string->nfd (string-foldcase string)))))
 \f
 ;;;; Normalization