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

Added make-custom-textual-input-port and make-custom-textual-output-port

This commit is contained in:
Abdulaziz Ghuloum 2007-12-10 11:11:59 -05:00
parent 85a54dbbbf
commit b6299fbec2
5 changed files with 51 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
scheme/ikarus.io.ss
View File

@ -25,6 +25,8 @@
open-string-input-port
make-custom-binary-input-port
make-custom-binary-output-port
make-custom-textual-input-port
make-custom-textual-output-port
transcoded-port port-transcoder
close-port close-input-port close-output-port
port-eof?
@ -69,6 +71,8 @@
open-string-input-port
make-custom-binary-input-port
make-custom-binary-output-port
make-custom-textual-input-port
make-custom-textual-output-port
transcoded-port port-transcoder
close-port close-input-port close-output-port
port-eof?
@ -188,6 +192,12 @@
($make-port 0 0 bv 0 #f #f attrs id read! write! get-position
set-position! close)))
(define ($make-custom-textual-port attrs id
read! write! get-position set-position! close buffer-size)
(let ([bv (make-string buffer-size)])
($make-port 0 0 bv 0 #f #f attrs id read! write! get-position
set-position! close)))
(define (make-custom-binary-input-port id
read! get-position set-position! close)
;;; FIXME: get-position and set-position! are ignored for now
@ -218,6 +228,38 @@
id #f write! get-position
set-position! close 256))
(define (make-custom-textual-input-port id
read! get-position set-position! close)
;;; FIXME: get-position and set-position! are ignored for now
(define who 'make-custom-textual-input-port)
(unless (string? id)
(error who "id is not a string" id))
(unless (procedure? read!)
(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-textual-port
(fxior fast-get-tag fast-get-char-tag)
id read! #f get-position
set-position! close 256))
(define (make-custom-textual-output-port id
write! get-position set-position! close)
;;; FIXME: get-position and set-position! are ignored for now
(define who 'make-custom-textual-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-textual-port
(fxior fast-put-tag fast-put-char-tag)
id #f write! get-position
set-position! close 256))
(define (input-transcoder-attrs x)
(cond
[(not x) ;;; binary input port

2
scheme/last-revision
View File

@ -1 +1 @@
1213
1214

6
scheme/makefile.ss
View File

@ -1097,11 +1097,11 @@
[lookahead-u8 i r ip]
[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 i r ip]
[make-custom-textual-input-port r ip]
[make-custom-textual-input-port i r ip]
[make-custom-textual-output-port i r ip]
[make-custom-binary-input/output-port r ip]
[make-custom-textual-input/output-port r ip]
[make-custom-textual-output-port r ip]
[make-i/o-decoding-error i r ip]
[make-i/o-encoding-error i r ip]
[make-i/o-error i r ip is fi]

4
scheme/tests/io.ss
View File

@ -477,12 +477,12 @@
#f)])
(let f ([i 0])
(unless (fx= i 10000)
(put-u8 p (mod i 256))
(put-u8 p (mod i 37))
(f (+ i 1))))
(flush-output-port p)
(let f ([i 0] [ls (reverse ls)])
(unless (null? ls)
(assert (fx= (mod i 256) (car ls)))
(assert (fx= (mod i 37) (car ls)))
(f (fx+ i 1) (cdr ls))))))

6
scheme/todo-r6rs.ss
View File

@ -606,11 +606,11 @@
[lookahead-u8 C ip]
[make-bytevector C bv]
[make-custom-binary-input-port C ip]
[make-custom-binary-input/output-port S ip]
[make-custom-binary-output-port C ip]
[make-custom-textual-input-port S ip]
[make-custom-textual-input-port C ip]
[make-custom-textual-output-port C ip]
[make-custom-binary-input/output-port S ip]
[make-custom-textual-input/output-port S ip]
[make-custom-textual-output-port S ip]
[make-i/o-decoding-error C ip]
[make-i/o-encoding-error C ip]
[make-i/o-error C ip is fi]