rsc3/sosc/bytevector.rkt

91 lines
2.5 KiB
Racket
Raw Permalink Normal View History

2014-02-15 19:03:37 +00:00
#lang racket
(require rhs/rhs
rnrs/bytevectors-6
rnrs/io/ports-6)
2014-02-15 19:03:37 +00:00
(provide (all-defined-out)
put-bytevector
get-bytevector-n
bytevector-length)
;; JBC-2014 -- looks like all of these have
;; equivalents in Racket...
2014-02-15 19:03:37 +00:00
;; bytevector -> (port -> any) -> any
(define with-input-from-bytevector
(lambda (b f)
(let* ((p (open-bytevector-input-port b))
(r (f p)))
2014-02-15 19:03:37 +00:00
(close-port p)
r)))
;; bytevector -> int -> int -> bytevector
(define bytevector-section
(lambda (v l r)
(let* ((n (- r l))
(w (make-bytevector n 0)))
2014-02-15 19:03:37 +00:00
(bytevector-copy! v l w 0 n)
w)))
;; bytevector -> byte -> int
(define bytevector-find-index
(lambda (v x)
(letrec ((f (lambda (i)
(if (= (bytevector-u8-ref v i) x)
i
(f (+ i 1))))))
2014-02-15 19:03:37 +00:00
(f 0))))
;; Tree bytevector -> bytevector
(define flatten-bytevectors
(lambda (t)
(let* ((l (flatten t))
(n (map bytevector-length l))
(m (sum n))
(v (make-bytevector m)))
2014-02-15 19:03:37 +00:00
(let loop ((i 0)
(l l)
(n n))
(if (null? l)
v
(let ((l0 (car l))
(n0 (car n)))
(bytevector-copy! l0 0 v i n0)
(loop (+ i n0) (cdr l) (cdr n))))))))
2014-02-15 19:03:37 +00:00
;; number a => (bytevector -> int -> a -> ()) -> int -> a
(define bytevector-make-and-set1
(lambda (f k n)
(let ((v (make-bytevector k 0)))
(f v 0 n)
v)))
;; number a => (bytevector -> int -> a -> ()) -> int -> a
(define bytevector-make-and-set
(lambda (f k n)
(let ((v (make-bytevector k 0)))
(f v 0 n (endianness big))
2014-02-15 23:48:21 +00:00
v)))
(module+ test
(require rackunit)
2014-03-04 20:04:13 +00:00
;; test bytevector-section, which is equivalent ot subbytes
(test-begin
(let [(long-vec (bytes 10 20 30 40 50))]
(check-equal? (bytevector-section long-vec 0 2)
(bytes 10 20))
(check-equal? (bytevector-section long-vec 0 (bytes-length long-vec))
long-vec)
(check-equal? (bytevector-section long-vec 1 3)
(subbytes long-vec 1 3))
; check if exceding limits raises exception
(check-exn exn:fail? (λ () (bytevector-section long-vec 0 30)))
2014-03-04 20:04:13 +00:00
(check-exn exn:fail? (λ () (bytevector-section long-vec -1 3)))))
2014-03-04 20:04:13 +00:00
(check-equal? (flatten-bytevectors (list (bytes 10 20) (bytes 30 40) (list (bytes 50 60))))
(bytes 10 20 30 40 50 60)))