From ed443d42a21ca937ab6df3739dfa4eef32f4b4af Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 1 Nov 2012 23:12:20 +0900 Subject: [PATCH] adding bytevector procedure --- lib/scheme/base.sld | 2 +- lib/scheme/extras.scm | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lib/scheme/base.sld b/lib/scheme/base.sld index 60fec9ea..f80d5604 100644 --- a/lib/scheme/base.sld +++ b/lib/scheme/base.sld @@ -12,7 +12,7 @@ (srfi 9) (srfi 11) (srfi 39)) (export * + - ... / < <= = => > >= _ abs and append apply assoc assq assv begin - binary-port? boolean? boolean=? bytevector-append + binary-port? boolean? boolean=? bytevector 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 diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm index 1fe35c5f..97ec824d 100644 --- a/lib/scheme/extras.scm +++ b/lib/scheme/extras.scm @@ -165,6 +165,13 @@ (define (string->vector vec . o) (list->vector (apply string->list vec o))) +(define (bytevector . args) + (let* ((len (length args)) + (res (make-bytevector len))) + (do ((i 0 (+ i 1)) (ls args (cdr ls))) + ((null? ls) res) + (bytevector-u8-set! res i (car ls))))) + (define (bytevector-copy! to at from . o) (let* ((start (if (pair? o) (car o) 0)) (end (if (and (pair? o) (pair? (cdr o)))