Change sequence builders to copy small sequences.

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index bd544837d11cf3e699bdc255fe2a12e761247291..9abe8c59b90fce411f66b26d1c85caf2a1e03ee1 100644 (file)
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -123,9 +123,11 @@ USA.
 
 (define (bytevector-builder)
   (let ((builder
-        (make-sequence-builder (lambda () (allocate-bytevector 16))
+        (make-sequence-builder allocate-bytevector
                                bytevector-length
+                               bytevector-u8-ref
                                bytevector-u8-set!
+                               16
                                bytevector-builder:finish-build)))
     (lambda (#!optional object)
       (cond ((default-object? object) ((builder 'build)))

diff --git a/src/runtime/global.scm b/src/runtime/global.scm
index 0aeb00512edc2a26d8e7717090c226cba897b3f1..bf8adf72e9e19e981bfb563e0047389aed4f22bf 100644 (file)
--- a/src/runtime/global.scm
+++ b/src/runtime/global.scm
@@ -580,8 +580,8 @@ USA.
 \f
 ;;;; Builder for vector-like sequences
 
-(define (make-sequence-builder make-buffer sequence-length sequence-set!
-                              finish-build)
+(define (make-sequence-builder make-sequence sequence-length sequence-ref
+                              sequence-set! buffer-length finish-build)
     ;; This is optimized to minimize copying, so it wastes some space.
   (let ((buffers)
        (buffer)
@@ -589,13 +589,13 @@ USA.
 
     (define (reset!)
       (set! buffers '())
-      (set! buffer (make-buffer))
+      (set! buffer (make-sequence buffer-length))
       (set! index 0)
       unspecific)
 
     (define (new-buffer!)
       (set! buffers (cons (cons buffer index) buffers))
-      (set! buffer (make-buffer))
+      (set! buffer (make-sequence buffer-length))
       (set! index 0)
       unspecific)
 
@@ -609,17 +609,23 @@ USA.
          ((not (pair? buffers)) (fix:+ n index))))
 
     (define (append-element! element)
-      (if (not (fix:< index (sequence-length buffer)))
+      (if (not (fix:< index buffer-length))
          (new-buffer!))
       (sequence-set! buffer index element)
       (set! index (fix:+ index 1))
       unspecific)
 
     (define (append-sequence! sequence)
-      (if (fix:> index 0)
-         (new-buffer!))
-      (set! buffers (cons (cons sequence (sequence-length sequence)) buffers))
-      unspecific)
+      (let ((length (sequence-length sequence)))
+       (if (fix:<= length buffer-length)
+           (do ((i 0 (fix:+ i 1)))
+               ((not (fix:< i length)))
+             (append-element! (sequence-ref sequence i)))
+           (begin
+             (if (fix:> index 0)
+                 (new-buffer!))
+             (set! buffers (cons (cons sequence length) buffers))
+             unspecific))))
 
     (define (build)
       (finish-build (reverse (cons (cons buffer index) buffers))))

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 70211868aa97aba8ee0decbe1ee2b38ef3f229c0..8ed2722588b2c5978ebe02fdb1572a5d045ed91b 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -216,9 +216,11 @@ USA.
 
 (define (string-builder)
   (let ((builder
-        (make-sequence-builder (lambda () (full-string-allocate 16))
+        (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)))