Add 'copy? option to string-builder.

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index 939e52438dac13cfae8b299118b529b6c0ef9f53..3332a62eb1b1a85dffc0fc02ad573ec6306c9d3d 100644 (file)
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -122,6 +122,7 @@ USA.
                                bytevector-length
                                bytevector-u8-ref
                                bytevector-u8-set!
+                               (lambda (bv) bv)
                                16
                                bytevector-builder:finish-build)))
     (lambda (#!optional object)

diff --git a/src/runtime/global.scm b/src/runtime/global.scm
index bf8adf72e9e19e981bfb563e0047389aed4f22bf..1ab2a8357078f7bb4bc1804719c4ad671514e707 100644 (file)
--- a/src/runtime/global.scm
+++ b/src/runtime/global.scm
@@ -581,7 +581,8 @@ USA.
 ;;;; Builder for vector-like sequences
 
 (define (make-sequence-builder make-sequence sequence-length sequence-ref
-                              sequence-set! buffer-length finish-build)
+                              sequence-set! sequence-copy buffer-length
+                              finish-build)
     ;; This is optimized to minimize copying, so it wastes some space.
   (let ((buffers)
        (buffer)
@@ -624,7 +625,9 @@ USA.
            (begin
              (if (fix:> index 0)
                  (new-buffer!))
-             (set! buffers (cons (cons sequence length) buffers))
+             (set! buffers
+                   (cons (cons (sequence-copy sequence) length)
+                         buffers))
              unspecific))))
 
     (define (build)

diff --git a/src/runtime/stringio.scm b/src/runtime/stringio.scm
index 27d00f90d3ab8cb07e8b2508e7c75e4408e05d11..42cc1fd7be19587631b0444258e0b55641576981 100644 (file)
--- a/src/runtime/stringio.scm
+++ b/src/runtime/stringio.scm
@@ -183,7 +183,8 @@ USA.
       (with-output-to-port port thunk))))
 \f
 (define (open-output-string)
-  (make-textual-port string-output-type (make-ostate (string-builder) 0)))
+  (make-textual-port string-output-type
+                    (make-ostate (string-builder 'copy? #t) 0)))
 
 (define-structure ostate
   (builder #f read-only #t)
@@ -208,7 +209,7 @@ USA.
 (define (string-out/write-substring port string start end)
   (let ((os (textual-port-state port))
        (n (fix:- end start)))
-    ((ostate-builder os) (string-copy string start end))
+    ((ostate-builder os) (string-slice string start end))
     (update-column-for-substring! os string start end)
     n))
 

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 6a235e6b90217ea1538bfd10346d00a8d283c7a3..0aa76852f02c4b1ca80361b100f5bfe601b97d8f 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -226,7 +226,7 @@ USA.
              (else (error "Not a char or string:" object)))))))
 
 (define (make-string-builder options)
-  (receive (buffer-length ->nfc?)
+  (receive (buffer-length ->nfc? copy?)
       (string-builder-options options 'string-builder)
     (let ((tracker (max-cp-tracker)))
       (combine-tracker-and-builder
@@ -235,13 +235,15 @@ USA.
                              string-length
                              string-ref
                              string-set!
+                             (if copy? string-copy (lambda (s) s))
                              buffer-length
                              (string-builder-finish ->nfc? (tracker 'get)))))))
 
 (define-deferred string-builder-options
   (keyword-option-parser
    (list (list 'buffer-length positive-fixnum? 16)
-        (list '->nfc? boolean? #t))))
+        (list '->nfc? boolean? #t)
+        (list 'copy? boolean? #f))))
 \f
 (define (max-cp-tracker)
   (let ((max-cp 0))