Implement bytevector-builder.

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index dca7b66f85ffa51ca8a9173c8541803a18ad5d33..ced0b4ee4bc62b4ef9492feceaf74afbf4b811ca 100644 (file)
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -121,6 +121,31 @@ USA.
   (if (default-object? modulus)
       ((ucode-primitive string-hash) bytevector)
       ((ucode-primitive string-hash-mod) bytevector modulus)))
+
+(define (bytevector-builder)
+  (let ((builder
+        (make-sequence-builder (lambda () (allocate-bytevector 16))
+                               bytevector-length
+                               bytevector-u8-set!
+                               bytevector-builder:finish-build)))
+    (lambda (#!optional object)
+      (cond ((default-object? object) ((builder 'build)))
+           ((byte? object) ((builder 'append-element!) object))
+           ((bytevector? object) ((builder 'append-sequence!) object))
+           ((memq object '(empty? count reset!)) ((builder object)))
+           (else (error "Not a byte or bytevector:" object))))))
+
+(define (bytevector-builder:finish-build parts)
+  (let ((result
+        (do ((parts parts (cdr parts))
+             (n 0 (fix:+ n (cdar parts))))
+            ((not (pair? parts))
+             (allocate-bytevector n)))))
+    (do ((parts parts (cdr parts))
+        (i 0 (fix:+ i (cdar parts))))
+       ((not (pair? parts)))
+      (bytevector-copy! result i (caar parts) 0 (cdar parts)))
+    result))
 \f
 ;;;; U16 accessors
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a91129471acb35174cfa5c8ae4c8dc4bc31d1e21..e580ec2915333c635d7a7b8b1dbb3bbda46a9c50 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1194,6 +1194,7 @@ USA.
          (byte? u8?)
          bytevector
          bytevector-append
+         bytevector-builder
          bytevector-copy
          bytevector-copy!
          bytevector-fill!

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 81263b0be940dc7faafdff16f7092084723a784c..979b3dde9b0bef4d1d0f5799fc8bf8cbbb1f6614 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -237,8 +237,9 @@ USA.
                  (legacy-string-allocate n)
                  (full-string-allocate n))))))
     (do ((parts parts (cdr parts))
-        (i 0 (string-copy! result i (caar parts) 0 (cdar parts))))
-       ((not (pair? parts))))
+        (i 0 (fix:+ i (cdar parts))))
+       ((not (pair? parts)))
+      (string-copy! result i (caar parts) 0 (cdar parts)))
     result))
 \f
 (define (string-copy! to at from #!optional start end)