From c67b3b44229733e1abc15fbe5d8b8ce38c381714 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 20 Feb 2017 19:40:04 -0800
Subject: [PATCH] Implement bytevector-builder.

---
 src/runtime/bytevector.scm | 25 +++++++++++++++++++++++++
 src/runtime/runtime.pkg    |  1 +
 src/runtime/ustring.scm    |  5 +++--
 3 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index dca7b66f8..ced0b4ee4 100644
--- 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))
 
 ;;;; U16 accessors
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a91129471..e580ec291 100644
--- 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 81263b0be..979b3dde9 100644
--- 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))
 
 (define (string-copy! to at from #!optional start end)
-- 
2.25.1