From ac4403ea7a86643ef4068daed658eb4d173cec59 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Tue, 4 Oct 2011 22:44:52 +0900 Subject: [PATCH] simple bytevector io utils --- lib/scheme/extras.scm | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm index 5525d0c6..713913f0 100644 --- a/lib/scheme/extras.scm +++ b/lib/scheme/extras.scm @@ -31,6 +31,35 @@ (close-port port) res)) +(define (read-bytevector n . o) + (if (zero? n) + "" + (let ((res (read-string n (if (pair? o) (car o) (current-input-port))))) + (if (equal? res "") + (read-char (open-input-string res)) + (string->utf8 res))))) + +(define (read-bytevector! vec start end . o) + (if (>= start end) + 0 + (let* ((res (read-bytevector! + (- end start) + (if (pair? o) (car o) (current-input-port)))) + (len (bytevector-length res))) + (cond + ((zero? len) + (read-char (open-input-string ""))) + (else + (do ((i 0 (+ i 1))) + ((>= i len) len) + (bytevector-u8-set! vec (+ i start) (bytevector-u8-ref res i)))))))) + +(define (write-bytevector vec . o) + (apply write-string (utf8->string vec) o)) + +(define (write-partial-bytevector vec start end . o) + (apply write-string (utf8->string (bytevector-copy-partial vec start end)) o)) + (define (make-list n . o) (let ((init (and (pair? o) (car o)))) (let lp ((i 0) (res '()))