Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-15 16:57:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added read-bytevector

Browse source
This commit is contained in:
Justin Ethier 2019-12-28 18:55:19 -05:00
parent 02fcad76f6
commit e5dca1835f
2 changed files with 22 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
CHANGELOG.md
View file

@ -4,7 +4,7 @@
Features Features
- Added `write-bytevector` from R7RS. - Added `read-bytevector` and `write-bytevector` IO functions from R7RS.
Bug Fixes Bug Fixes

22
scheme/base.sld
View file

@ -190,7 +190,7 @@
; Possibly missing functions: ; Possibly missing functions:
; ;
; ; following byte vector functions are not implemented yet: ; ; following byte vector functions are not implemented yet:
; read-bytevector read-bytevector
; read-bytevector! ; read-bytevector!
write-bytevector write-bytevector
; ;
@ -713,6 +713,26 @@
(if (null? port) (if (null? port)
(Cyc-display str (current-output-port)) (Cyc-display str (current-output-port))
(Cyc-display str (car port)))) (Cyc-display str (car port))))
(define (read-bytevector k . _port)
(let ((port (if (null? _port)
(current-input-port)
(car _port))))
'test))
(define (read-bytevector k . _port)
(letrec ((port (if (null? port)
(current-input-port)
(car _port)))
(bv (make-bytevector k))
(loop (lambda (n)
(let ((b (read-u8 port)))
(cond
((eof-object? b)
(bytevector-copy bv 0 n))
((< n k)
(bytevector-u8-set! bv n b)
(loop (+ n 1)))
(else bv))))))
(loop 0)))
(define (write-bytevector vec . opts) (define (write-bytevector vec . opts)
(letrec ((len (bytevector-length vec)) (letrec ((len (bytevector-length vec))
(port (if (> (length opts) 0) (car opts) (current-output-port))) (port (if (> (length opts) 0) (car opts) (current-output-port)))