diff --git a/lib/scheme/base.sld b/lib/scheme/base.sld index d8e79c55..7f7b784d 100644 --- a/lib/scheme/base.sld +++ b/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! - bytevector-length + binary-port? boolean? boolean=? bytevector-append + 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? 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?) diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm index eef89c9b..f0593d8c 100644 --- a/lib/scheme/extras.scm +++ b/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))