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

* Added put-char, get-char, and put-u8.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-18 18:48:24 -05:00
parent 3b4d3097a1
commit e99ce9c03b
3 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -15,16 +15,17 @@
(library (ikarus io-primitives)
(export read-char unread-char peek-char write-char write-byte newline
port-name input-port-name output-port-name
(export read-char unread-char peek-char write-char write-byte
put-u8 put-char get-char
newline port-name input-port-name output-port-name
close-input-port reset-input-port!
flush-output-port close-output-port get-line)
(import
(ikarus system $io)
(ikarus system $fx)
(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 get-char
newline port-name input-port-name output-port-name
close-input-port reset-input-port! flush-output-port
close-output-port get-line))
@ -42,6 +43,14 @@
(error 'write-char "not an output-port" p))
(error 'write-char "not a character" c))]))
(define put-char
(lambda (c p)
(if (char? c)
(if (output-port? p)
($write-char c p)
(error 'put-char "not an output-port" p))
(error 'put-char "not a character" c))))
(define write-byte
(case-lambda
[(b)
@ -54,6 +63,14 @@
($write-byte b p)
(error 'write-byte "not an output-port" p))
(error 'write-byte "not a byte" b))]))
(define put-u8
(lambda (b p)
(if (and (fixnum? b) ($fx<= 0 b) ($fx<= b 255))
(if (output-port? p)
($write-byte b p)
(error 'put-u8 "not an output-port" p))
(error 'put-u8 "not a u8" b))))
;;;
(define newline
(case-lambda
@ -85,6 +102,12 @@
(($port-handler p) 'port-name p)
(error 'output-port-name "not a port" p))))
(define get-char
(lambda (p)
(if (input-port? p)
($read-char p)
(error 'get-char "not an input-port" p))))
(define read-char
(case-lambda
[() ($read-char (current-input-port))]

6
scheme/makefile.ss
View File

@ -1052,7 +1052,7 @@
[get-bytevector-n r ip]
[get-bytevector-n! r ip]
[get-bytevector-some r ip]
[get-char r ip]
[get-char i r ip]
[get-datum r ip]
[get-line i r ip]
[get-string-all r ip]
@ -1126,10 +1126,10 @@
[port-transcoder r ip]
[port? i r ip]
[put-bytevector r ip]
[put-char r ip]
[put-char i r ip]
[put-datum r ip]
[put-string r ip]
[put-u8 r ip]
[put-u8 i r ip]
[set-port-position! r ip]
[standard-error-port i r ip]
[standard-input-port i r ip]

6
scheme/todo-r6rs.ss
View File

@ -567,7 +567,7 @@
[get-bytevector-n S ip]
[get-bytevector-n! S ip]
[get-bytevector-some S ip]
[get-char S ip]
[get-char C ip]
[get-datum S ip]
[get-line C ip]
[get-string-all S ip]
@ -641,10 +641,10 @@
[port-transcoder S ip]
[port? C ip]
[put-bytevector S ip]
[put-char S ip]
[put-char C ip]
[put-datum S ip]
[put-string S ip]
[put-u8 S ip]
[put-u8 C ip]
[set-port-position! S ip]
[standard-error-port S ip]
[standard-input-port S ip]