Change NFC_QC to be a boolean-valued table and exploit that.

diff --git a/src/etc/ucd-converter.scm b/src/etc/ucd-converter.scm
index ec6cbe68929c549c40e132c1ae55af961c1a95af..7675d9480e4b46eb47e5f4ccd521ca9ea153e474 100644 (file)
--- a/src/etc/ucd-converter.scm
+++ b/src/etc/ucd-converter.scm
@@ -592,7 +592,8 @@ USA.
 (define (metadata->code-generator metadata)
   (let ((name (metadata-name metadata))
        (type-spec (metadata-type-spec metadata)))
-    (cond ((eq? type-spec 'boolean) code-generator:boolean)
+    (cond ((string=? name "NFC_QC") code-generator:boolean)
+         ((eq? type-spec 'boolean) code-generator:boolean)
          ((eq? type-spec 'ccc) code-generator:ccc)
          ((eq? type-spec 'code-point) code-generator:code-point)
          ((eq? type-spec 'code-point*) code-generator:code-point*)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 2062b386dee1ff23ad2705c12c11c21cad03c2c4..342b68ed9f507b082e320a39543bbf6bb15415a0 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1322,6 +1322,7 @@ USA.
          char-changes-when-lower-cased?
          char-changes-when-upper-cased?
          char-full-composition-exclusion?
+         char-nfc-quick-check?
          char-nfd-quick-check?
          ucd-canonical-cm-second-keys
          ucd-canonical-cm-second-values
@@ -1331,7 +1332,6 @@ USA.
          ucd-cf-value
          ucd-gcb-value
          ucd-lc-value
-         ucd-nfc_qc-value
          ucd-tc-value
          ucd-uc-value
          ucd-wb-value))

diff --git a/src/runtime/ucd-table-nfc_qc.scm b/src/runtime/ucd-table-nfc_qc.scm
index 28825c598659dba505bef1149d073c19f7762c8a..66a97fc946faaf719da0d211c5edac978e338069 100644 (file)
--- a/src/runtime/ucd-table-nfc_qc.scm
+++ b/src/runtime/ucd-table-nfc_qc.scm
@@ -30,27 +30,10 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define (ucd-nfc_qc-value char)
-  (let ((sv (char->integer char)))
-    (vector-ref |ucd-NFC_QC-table-5| (bytevector-u8-ref |ucd-NFC_QC-table-4| (fix:or (fix:lsh (bytevector-u8-ref |ucd-NFC_QC-table-3| (fix:or (fix:lsh (bytevector-u8-ref |ucd-NFC_QC-table-2| (fix:or (fix:lsh (bytevector-u8-ref |ucd-NFC_QC-table-1| (fix:or (fix:lsh (bytevector-u8-ref |ucd-NFC_QC-table-0| (fix:lsh sv -16)) 4) (fix:and 15 (fix:lsh sv -12)))) 4) (fix:and 15 (fix:lsh sv -8)))) 4) (fix:and 15 (fix:lsh sv -4)))) 4) (fix:and 15 sv))))))
+(define (char-nfc-quick-check? char)
+  (char-in-set? char char-set:nfc-quick-check))
 
-(define-deferred |ucd-NFC_QC-table-0|
-  (vector->bytevector '#(0 1 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3)))
-
-(define-deferred |ucd-NFC_QC-table-1|
-  (vector->bytevector '#(0 1 2 3 4 4 4 4 4 4 4 4 4 4 4 5 4 6 4 4 4 4 4 4 4 4 4 4 4 7 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 8 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4)))
-
-(define-deferred |ucd-NFC_QC-table-2|
-  (vector->bytevector '#(0 0 0 1 0 0 2 0 0 3 4 5 6 7 0 8 9 10 0 0 0 0 0 0 0 0 0 11 0 0 0 12 13 14 0 15 0 0 0 0 0 0 16 0 0 0 0 0 17 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 18 19 20 0 0 0 0 21 22 0 23 24 25 0 0 0 0 0 0 0 0 0 0 0 26 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 18 18 27 0 0 0 0 0)))
-
-(define-deferred |ucd-NFC_QC-table-3|
-  (vector->bytevector
-   '#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 2 3 4 5 0 0 6 7 0 0 0 0 0 0 0 0 0 0 0 0 8 0 0 0 0 0 0 0 0 0 0 0 0 0 9 0 10 0 0 0 0 0 11 0 12 0 0 0 0 0 13 0 14 0 0 0 0 0 0 0 0 0 0 0 0 0 11 0 15 0 0 0 0 0 11 0 16 0 0 0 0 0 0 0 17 0 0 0 0 0 0 18 19 0 0 0 0 0 11 0 16 0 0 0 0 0 0 20 21 0 0 0 0 0 0 22 23 24 25 26 22 23 24 0 0 0 0 0 0 11 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 27 28 0 0 29 30 31 0 0 0 0 0 0 32 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 33 0 0 0 34 35 36 37 38 39 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 40 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 41 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 42 0 0 0 0 0 0 0 0 0 0 0 43 0 0 0 0 0 0 44 44 44 44 44 44 44 44 44 44 44 44 44 44 44 44 45 46 47 44 44 44 45 44 44 44 44 44 44 48 0 0 0 49 50 51 52 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 53 0 0 0 0 0 0 16 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 11 0 16 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 54 0 0 0 0 0 0 0 0 0 0 0 0 0 0 21 0 0 0 0 0 0 0 0 0 0 55 56 0 0 0 0 57 58 0 0 0 44 45 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
-
-(define-deferred |ucd-NFC_QC-table-4|
-  (vector->bytevector
-   '#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 2 1 2 2 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 2 2 2 2 2 2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 2 2 0 2 0 0 0 2 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 2 2 0 0 2 0 0 0 0 0 0 0 1 1 0 0 0 0 2 2 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 2 0 0 0 0 0 0 0 0 0 2 0 0 0 0 2 0 0 0 0 2 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 2 0 2 2 0 2 0 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
-      1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 2 0 2 0 2 0 2 0 2 0 2 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 0 2 0 0 0 0 0 0 0 0 0 0 2 0 2 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 2 0 0 2 2 0 0 0 0 0 0 0 0 0 2 0 2 0 2 0 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 0 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 0 2 0 2 0 0 2 2 2 2 2 2 2 2 2 2 0 2 0 2 0 0 2 2 0 0 0 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 2 0 0 0 0 0 0 0 0 0 0 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2 2 2 2 2 0 2 0 2 2 0 2 2 0 2 2 2 2 2 2 2 2 2 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 2 2 2 2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 2 2 2 2 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
-
-(define-deferred |ucd-NFC_QC-table-5|
-  #(yes maybe no))
+(define-deferred char-set:nfc-quick-check
+  (char-set*
+   '((0 . 768)     773           (781 . 783)   784  786  (789 . 795) (796 . 803) (809 . 813) 815  (818 . 824)   (825 . 832)   (838 . 884)   (885 . 894) (895 . 903)   (904 . 1619)  (1622 . 2364) (2365 . 2392) (2400 . 2494) (2495 . 2519) (2520 . 2524) 2526 (2528 . 2611) (2612 . 2614) (2615 . 2649) (2652 . 2654) (2655 . 2878)  (2879 . 2902)   (2904 . 2908)   (2910 . 3006)   (3007 . 3031) (3032 . 3158)   (3159 . 3266) (3267 . 3285) (3287 . 3390)   (3391 . 3415)   (3416 . 3530)   (3531 . 3535)   (3536 . 3551) (3552 . 3907)   (3908 . 3917) (3918 . 3922) (3923 . 3927) (3928 . 3932) (3933 . 3945) (3946 . 3955)   3956            3959            (3961 . 3969)   (3970 . 3987)   (3988 . 3997)   (3998 . 4002)   (4003 . 4007)   (4008 . 4012)    (4013 . 4025)     (4026 . 4142)     (4143 . 4449)
+     (4470 . 4520) (4547 . 6965) (6966 . 8049) 8050 8052 8054        8056        8058        8060 (8062 . 8123) (8124 . 8126) (8127 . 8137) 8138        (8140 . 8147) (8148 . 8155) (8156 . 8163) (8164 . 8171) (8172 . 8174) (8176 . 8185) 8186          8188 (8190 . 8192) (8194 . 8486) (8487 . 8490) (8492 . 9001) (9003 . 10972) (10973 . 12441) (12443 . 63744) (64014 . 64016) 64017         (64019 . 64021) 64031         64033         (64035 . 64037) (64039 . 64042) (64110 . 64112) (64218 . 64285) 64286         (64288 . 64298) 64311         64317         64319         64322         64325         (64335 . 69818) (69819 . 69927) (69928 . 70462) (70463 . 70487) (70488 . 70832) (70833 . 70842) (70843 . 70845) (70846 . 71087) (71088 . 119134) (119141 . 119227) (119233 . 194560) (195102 . 1114112))))

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 6532d9fda5073beb0913e29ae9cf4e726079fdd1..7d58e41c0d7ac90e0e13702316963f934f701877 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -580,40 +580,27 @@ USA.
       (canonical-ordering! (canonical-decomposition string))))
 
 (define (string->nfc string)
-  (if (eq? #t (string-in-nfc? string))
+  (if (string-in-nfc? string)
       string
       (canonical-composition (string->nfd string))))
 
-(define (string-in-nfd? string)
-  (let ((end (string-length string)))
-    (let loop ((i 0) (last-ccc 0))
-      (if (fix:< i end)
-         (let ((char (string-ref string i)))
-           (if (fix:< (char->integer char) #xC0)
-               (loop (fix:+ i 1) 0)
-               (let ((ccc (ucd-ccc-value char)))
-                 (and (or (fix:= ccc 0)
-                          (fix:>= ccc last-ccc))
-                      (char-nfd-quick-check? char)
-                      (loop (fix:+ i 1) ccc)))))
-         #t))))
+(define-integrable (string-nqc-maker cp-limit char-nqc?)
+  (lambda (string)
+    (let ((end (string-length string)))
+      (let loop ((i 0) (last-ccc 0))
+       (if (fix:< i end)
+           (let ((char (string-ref string i)))
+             (if (fix:< (char->integer char) cp-limit)
+                 (loop (fix:+ i 1) 0)
+                 (let ((ccc (ucd-ccc-value char)))
+                   (and (or (fix:= ccc 0) (fix:>= ccc last-ccc))
+                        (char-nqc? char)
+                        (loop (fix:+ i 1) ccc)))))
+           #t)))))
+
+(define string-in-nfd? (string-nqc-maker #xC0 char-nfd-quick-check?))
+(define string-in-nfc? (string-nqc-maker #x300 char-nfc-quick-check?))
 
-(define (string-in-nfc? string)
-  (let ((end (string-length string)))
-    (let loop ((i 0) (last-ccc 0) (result #t))
-      (if (fix:< i end)
-         (let ((char (string-ref string i)))
-           (if (fix:< (char->integer char) #x300)
-               (loop (fix:+ i 1) 0 result)
-               (let ((ccc (ucd-ccc-value char)))
-                 (and (or (fix:= ccc 0)
-                          (fix:>= ccc last-ccc))
-                      (case (ucd-nfc_qc-value char)
-                        ((yes) (loop (fix:+ i 1) ccc result))
-                        ((maybe) (loop (fix:+ i 1) ccc 'maybe))
-                        (else #f))))))
-         result))))
-\f
 (define (canonical-decomposition string)
   (let ((end (string-length string))
        (builder (string-builder '->nfc? #f)))