adding vector-append and bytevector-append

lib/scheme/base.sld

@@ -12,8 +12,8 @@
           (srfi 9) (srfi 11) (srfi 39))
   (export
    * + - ... / < <= = => > >= _ abs and append apply assoc assq assv begin
-   binary-port?  boolean?  boolean=?  bytevector-copy bytevector-copy!
+   binary-port?  boolean?  boolean=?  bytevector-append
-   bytevector-length
+   bytevector-copy bytevector-copy! bytevector-length
    bytevector-u8-ref bytevector-u8-set!  bytevector?  caar cadr
    call-with-current-continuation call-with-port call-with-values
    call/cc car case cdr cdar cddr ceiling char->integer
@@ -43,7 +43,8 @@
    string-ref string-set!  string<=?  string<?  string=?  string>=?
    string>?  string?  substring symbol->string symbol?  symbol=?  syntax-error
    syntax-rules textual-port?  truncate u8-ready?  unless unquote
-   unquote-splicing utf8->string values vector vector->list vector->string
+   unquote-splicing utf8->string values vector vector-append
+   vector->list vector->string
    vector-copy vector-copy! vector-fill!  vector-for-each vector-length
    vector-map vector-ref vector-set!  vector?  when with-exception-handler
    write-bytevector write-char write-u8 zero?)

lib/scheme/extras.scm

@@ -118,6 +118,16 @@
         ((zero? k) (set-car! ls x))
         (else (list-set! (cdr ls) (- k 1) x))))
 
+(define (vector-append . vecs)
+  (let* ((len (apply + (map vector-length vecs)))
+         (res (make-vector len)))
+    (let lp ((ls vecs) (i 0))
+      (if (null? ls)
+          res
+          (let ((v-len (vector-length (car ls))))
+            (vector-copy! res i (car ls))
+            (lp (cdr ls) (+ i v-len)))))))
+
 (define (vector-map proc vec . lov)
   (if (null? lov)
       (let lp ((i (vector-length vec)) (res '()))
@@ -138,7 +148,7 @@
 (define (vector-copy! to at from . o)
   (let ((start (if (pair? o) (car o) 0))
         (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (vector-length from))))
-    (do ((i at (+ i 1)) (j start (+ i 1)))
+    (do ((i at (+ i 1)) (j start (+ j 1)))
         ((>= j end))
       (vector-set! to i (vector-ref from j)))))
 
@@ -153,7 +163,7 @@
         (end (if (and (pair? o) (pair? (cdr o)))
                  (cadr o)
                  (bytevector-length from))))
-    (do ((i at (+ i 1)) (j start (+ i 1)))
+    (do ((i at (+ i 1)) (j start (+ j 1)))
         ((>= j end))
       (bytevector-u8-set! to i (bytevector-u8-ref from j)))))
 
@@ -162,6 +172,16 @@
       (subbytes vec 0)
       (apply subbytes vec o)))
 
+(define (bytevector-append . vecs)
+  (let* ((len (apply + (map bytevector-length vecs)))
+         (res (make-bytevector len)))
+    (let lp ((ls vecs) (i 0))
+      (if (null? ls)
+          res
+          (let ((v-len (bytevector-length (car ls))))
+            (bytevector-copy! res i (car ls))
+            (lp (cdr ls) (+ i v-len)))))))
+
 ;; Never use this!
 (define (string-copy! to at from . o)
   (let ((start (if (pair? o) (car o) 0))