Change string-builder to normalize to NFC by default.

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 56f778a8a7e007247bd46e0f6755fb7abfe4869f..5618fc982126fb141a0ca37d7788ccea4839228a 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -214,20 +214,29 @@ USA.
 \f
 ;;;; Streaming build
 
-(define (string-builder)
-  (let ((builder
-        (make-sequence-builder full-string-allocate
-                               string-length
-                               string-ref
-                               string-set!
-                               16
-                               string-builder:finish-build)))
-    (lambda (#!optional object)
-      (cond ((default-object? object) ((builder 'build)))
-           ((bitless-char? object) ((builder 'append-element!) object))
-           ((string? object) ((builder 'append-sequence!) object))
-           ((memq object '(empty? count reset!)) ((builder object)))
-           (else (error "Not a char or string:" object))))))
+(define (string-builder . options)
+  (receive (buffer-length ->nfc?)
+      (string-builder-options options 'string-builder)
+    (let ((builder
+          (make-sequence-builder full-string-allocate
+                                 string-length
+                                 string-ref
+                                 string-set!
+                                 buffer-length
+                                 (if ->nfc?
+                                     string-builder:finish-build-nfc
+                                     string-builder:finish-build))))
+      (lambda (#!optional object)
+       (cond ((default-object? object) ((builder 'build)))
+             ((bitless-char? object) ((builder 'append-element!) object))
+             ((string? object) ((builder 'append-sequence!) object))
+             ((memq object '(empty? count reset!)) ((builder object)))
+             (else (error "Not a char or string:" object)))))))
+
+(define-deferred string-builder-options
+  (keyword-option-parser
+   (list (list 'buffer-length positive-fixnum? 16)
+        (list '->nfc? boolean? #t))))
 
 (define (string-builder:finish-build parts)
   (let ((result
@@ -246,6 +255,9 @@ USA.
        ((not (pair? parts)))
       (string-copy! result i (caar parts) 0 (cdar parts)))
     result))
+
+(define (string-builder:finish-build-nfc parts)
+  (string->nfc (string-builder:finish-build parts)))
 \f
 ;;;; Copy
 
@@ -555,7 +567,7 @@ USA.
 \f
 (define (canonical-decomposition string)
   (let ((end (string-length string))
-       (builder (string-builder)))
+       (builder (string-builder '->nfc? #f)))
     (do ((i 0 (fix:+ i 1)))
        ((not (fix:< i end)))
       (let loop ((char (string-ref string i)))
@@ -605,7 +617,7 @@ USA.
 \f
 (define (canonical-composition string)
   (let ((end (string-length string))
-       (builder (string-builder))
+       (builder (string-builder '->nfc? #f))
        (sk ucd-canonical-cm-second-keys)
        (sv ucd-canonical-cm-second-values))
 

diff --git a/tests/runtime/test-string.scm b/tests/runtime/test-string.scm
index 3e12df3ef8e2898d8cfc548e79581bb6da77e27f..d69e694597abb82e3ea6d89bb53c27a1cfd9d472 100644 (file)
--- a/tests/runtime/test-string.scm
+++ b/tests/runtime/test-string.scm
@@ -175,7 +175,7 @@ USA.
      'expression string)))
 
 (define (convert-break-test-case test-case)
-  (let ((builder (string-builder)))
+  (let ((builder (string-builder '->nfc? #f)))
     (let loop ((test-case test-case) (index 0) (breaks '()))
       (let ((breaks
             (if (car test-case)