conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Added bytevector-copy and bytevector-fill!

This commit is contained in:
Abdulaziz Ghuloum 2007-05-15 14:33:50 -04:00
parent f630177d17
commit 1e364d3186
3 changed files with 29 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

29
src/ikarus.bytevectors.ss
View File

@ -2,12 +2,14 @@
(library (ikarus bytevectors)
(export make-bytevector bytevector-length bytevector-s8-ref
bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!
bytevector-copy! u8-list->bytevector bytevector->u8-list)
bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-fill! bytevector-copy)
(import
(except (ikarus)
make-bytevector bytevector-length bytevector-s8-ref
bytevector-u8-ref bytevector-u8-set! bytevector-s8-set!
bytevector-copy! u8-list->bytevector bytevector->u8-list)
bytevector-copy! u8-list->bytevector bytevector->u8-list
bytevector-fill! bytevector-copy)
(ikarus system $fx)
(ikarus system $pairs)
(ikarus system $bytevectors))
@ -30,6 +32,15 @@
($bytevector-fill (make-bytevector k) 0 k fill)
(error 'make-bytevector "~s is not a valid fill" fill))]))
(define bytevector-fill!
(lambda (x fill)
(unless (bytevector? x)
(error 'bytevector-fill! "~s is not a bytevector" x))
(unless (and (fixnum? fill) ($fx<= -128 fill) ($fx<= fill 255))
(error 'bytevector-fill! "~s is not a valid fill" fill))
($bytevector-fill x 0 ($bytevector-length x) fill)))
(define bytevector-length
(lambda (x)
(if (bytevector? x)
@ -114,6 +125,20 @@
(let ([s ($make-bytevector n)])
(fill s 0 ls))))))
(define bytevector-copy
(lambda (src)
(unless (bytevector? src)
(error 'bytevector-copy "~s is not a bytevector" src))
(let ([n ($bytevector-length src)])
(let f ([src src] [dst ($make-bytevector n)] [i 0] [n n])
(cond
[($fx= i n) dst]
[else
($bytevector-set! dst i ($bytevector-u8-ref src i))
(f src dst ($fxadd1 i) n)])))))
(define bytevector-copy!
(lambda (src src-start dst dst-start k)
(cond

2
src/makefile.ss
View File

@ -280,6 +280,8 @@
[bytevector->u8-list i]
[u8-list->bytevector i]
[bytevector-copy! i]
[bytevector-copy i]
[bytevector-fill! i]
[for-each i r]
[map i r]