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

Added make-custom-binary-output-port

This commit is contained in:
Abdulaziz Ghuloum 2007-12-10 10:36:10 -05:00
parent 91b8f90715
commit 8a375a3cf7
4 changed files with 22 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
scheme/ikarus.io.ss
View File

@ -24,6 +24,7 @@
open-bytevector-input-port
open-string-input-port
make-custom-binary-input-port
make-custom-binary-output-port
transcoded-port port-transcoder
close-port close-input-port close-output-port
port-eof?
@ -67,6 +68,7 @@
open-bytevector-input-port
open-string-input-port
make-custom-binary-input-port
make-custom-binary-output-port
transcoded-port port-transcoder
close-port close-input-port close-output-port
port-eof?
@ -181,9 +183,9 @@
(define r6rs-mode-tag #x1000)
(define ($make-custom-binary-input-port id
read! get-position set-position! close buffer-size)
read! write! get-position set-position! close buffer-size)
(let ([bv (make-bytevector buffer-size)])
($make-port 0 0 bv 0 #f #f 0 id read! #f get-position
($make-port 0 0 bv 0 #f #f 0 id read! write! get-position
set-position! close)))
(define (make-custom-binary-input-port id
@ -196,7 +198,20 @@
(error who "read! is not a procedure" read!))
(unless (or (procedure? close) (not close))
(error who "close should be either a procedure or #f" close))
($make-custom-binary-input-port id read! get-position
($make-custom-binary-input-port id read! #f get-position
set-position! close 256))
(define (make-custom-binary-output-port id
write! get-position set-position! close)
;;; FIXME: get-position and set-position! are ignored for now
(define who 'make-custom-binary-output-port)
(unless (string? id)
(error who "id is not a string" id))
(unless (procedure? write!)
(error who "read! is not a procedure" write!))
(unless (or (procedure? close) (not close))
(error who "close should be either a procedure or #f" close))
($make-custom-binary-input-port id #f write! get-position
set-position! close 256))
(define (input-transcoder-attrs x)

2
scheme/last-revision
View File

@ -1 +1 @@
1209
1210

2
scheme/makefile.ss
View File

@ -1098,7 +1098,7 @@
[make-bytevector i r bv]
[make-custom-binary-input-port i r ip]
[make-custom-binary-input/output-port r ip]
[make-custom-binary-output-port r ip]
[make-custom-binary-output-port i r ip]
[make-custom-textual-input-port r ip]
[make-custom-textual-input/output-port r ip]
[make-custom-textual-output-port r ip]

4
scheme/todo-r6rs.ss
View File

@ -514,6 +514,7 @@
[buffer-mode C ip]
[buffer-mode? C ip]
[bytevector->string S ip]
[string->bytevector S ip]
[call-with-bytevector-output-port C ip]
[call-with-port C ip]
[call-with-string-output-port C ip]
@ -606,7 +607,7 @@
[make-bytevector C bv]
[make-custom-binary-input-port C ip]
[make-custom-binary-input/output-port S ip]
[make-custom-binary-output-port S ip]
[make-custom-binary-output-port C ip]
[make-custom-textual-input-port S ip]
[make-custom-textual-input/output-port S ip]
[make-custom-textual-output-port S ip]
@ -649,7 +650,6 @@
[standard-error-port C ip]
[standard-input-port C ip]
[standard-output-port C ip]
[string->bytevector S ip]
[textual-port? C ip]
[transcoded-port C ip]
[transcoder-codec C ip]