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

Added get-bytevector-n

This commit is contained in:
Abdulaziz Ghuloum 2007-11-22 16:03:44 -05:00
parent bfccea7718
commit e4910e9b61
4 changed files with 40 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
scheme/ikarus.io-primitives.ss
View File

@ -17,7 +17,7 @@
(library (ikarus io-primitives) (library (ikarus io-primitives)
(export read-char unread-char peek-char write-char write-byte (export read-char unread-char peek-char write-char write-byte
put-u8 put-char put-string put-bytevector put-u8 put-char put-string put-bytevector
get-char get-u8 get-string-n get-char get-u8 get-string-n get-bytevector-n
newline port-name input-port-name output-port-name newline port-name input-port-name output-port-name
close-input-port reset-input-port! close-input-port reset-input-port!
flush-output-port close-output-port get-line) flush-output-port close-output-port get-line)
@ -27,7 +27,7 @@
(ikarus system $ports) (ikarus system $ports)
(except (ikarus) read-char unread-char peek-char write-char write-byte (except (ikarus) read-char unread-char peek-char write-char write-byte
put-u8 put-char put-string put-bytevector put-u8 put-char put-string put-bytevector
get-char get-u8 get-string-n get-char get-u8 get-string-n get-bytevector-n
newline port-name input-port-name output-port-name newline port-name input-port-name output-port-name
close-input-port reset-input-port! flush-output-port close-input-port reset-input-port! flush-output-port
close-output-port get-line)) close-output-port get-line))
@ -295,6 +295,7 @@
c)) c))
($put-bytevector p s i j)))]))) ($put-bytevector p s i j)))])))
(define (get-string-n p n) (define (get-string-n p n)
(import (ikarus system $fx) (ikarus system $strings)) (import (ikarus system $fx) (ikarus system $strings))
(unless (input-port? p) (unless (input-port? p)
@ -319,5 +320,39 @@
(f p n s i)))]))))] (f p n s i)))]))))]
[($fx= n 0) ""] [($fx= n 0) ""]
[else (error 'get-string-n "count is negative" n)])) [else (error 'get-string-n "count is negative" n)]))
(define (get-bytevector-n p n)
(import (ikarus system $fx) (ikarus system $bytevectors))
(define (subbytevector s n)
(let ([p ($make-bytevector n)])
(let f ([s s] [n n] [p p])
(let ([n ($fx- n 1)])
($bytevector-set! p n ($bytevector-u8-ref s n))
(if ($fx= n 0)
p
(f s n p))))))
(unless (input-port? p)
(error 'get-bytevector-n "not an input port" p))
(unless (fixnum? n)
(error 'get-bytevector-n "count is not a fixnum" n))
(cond
[($fx> n 0)
(let ([s ($make-bytevector n)])
(let f ([p p] [n n] [s s] [i 0])
(let ([x ($get-u8 p)])
(cond
[(eof-object? x)
(if ($fx= i 0)
(eof-object)
(subbytevector s i))]
[else
($bytevector-set! s i x)
(let ([i ($fxadd1 i)])
(if ($fx= i n)
s
(f p n s i)))]))))]
[($fx= n 0) '#vu8()]
[else (error 'get-bytevector-n "count is negative" n)]))
) )

2
scheme/last-revision
View File

@ -1 +1 @@
1111 1112

2
scheme/makefile.ss
View File

@ -1058,7 +1058,7 @@
[file-options i r ip] [file-options i r ip]
[flush-output-port i r ip] [flush-output-port i r ip]
[get-bytevector-all r ip] [get-bytevector-all r ip]
[get-bytevector-n r ip] [get-bytevector-n i r ip]
[get-bytevector-n! r ip] [get-bytevector-n! r ip]
[get-bytevector-some r ip] [get-bytevector-some r ip]
[get-char i r ip] [get-char i r ip]

2
scheme/todo-r6rs.ss
View File

@ -564,7 +564,7 @@
[file-options C ip] [file-options C ip]
[flush-output-port C ip] [flush-output-port C ip]
[get-bytevector-all S ip] [get-bytevector-all S ip]
[get-bytevector-n S ip] [get-bytevector-n C ip]
[get-bytevector-n! S ip] [get-bytevector-n! S ip]
[get-bytevector-some S ip] [get-bytevector-some S ip]
[get-char C ip] [get-char C ip]