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) (library (ikarus io-primitives)
(export read-char unread-char peek-char write-char write-byte newline (export read-char unread-char peek-char write-char write-byte
port-name input-port-name output-port-name put-u8 put-char get-char
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)
(import (import
(ikarus system $io) (ikarus system $io)
(ikarus system $fx) (ikarus system $fx)
(ikarus system $ports) (ikarus system $ports)
(except (ikarus) read-char unread-char peek-char write-char (except (ikarus) read-char unread-char peek-char write-char write-byte
write-byte put-u8 put-char get-char
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))
@ -42,6 +43,14 @@
(error 'write-char "not an output-port" p)) (error 'write-char "not an output-port" p))
(error 'write-char "not a character" c))])) (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 (define write-byte
(case-lambda (case-lambda
[(b) [(b)
@ -54,6 +63,14 @@
($write-byte b p) ($write-byte b p)
(error 'write-byte "not an output-port" p)) (error 'write-byte "not an output-port" p))
(error 'write-byte "not a byte" b))])) (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 (define newline
(case-lambda (case-lambda
@ -85,6 +102,12 @@
(($port-handler p) 'port-name p) (($port-handler p) 'port-name p)
(error 'output-port-name "not a port" 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 (define read-char
(case-lambda (case-lambda
[() ($read-char (current-input-port))] [() ($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-n! r ip] [get-bytevector-n! r ip]
[get-bytevector-some r ip] [get-bytevector-some r ip]
[get-char r ip] [get-char i r ip]
[get-datum r ip] [get-datum r ip]
[get-line i r ip] [get-line i r ip]
[get-string-all r ip] [get-string-all r ip]
@ -1126,10 +1126,10 @@
[port-transcoder r ip] [port-transcoder r ip]
[port? i r ip] [port? i r ip]
[put-bytevector r ip] [put-bytevector r ip]
[put-char r ip] [put-char i r ip]
[put-datum r ip] [put-datum r ip]
[put-string r ip] [put-string r ip]
[put-u8 r ip] [put-u8 i r ip]
[set-port-position! r ip] [set-port-position! r ip]
[standard-error-port i r ip] [standard-error-port i r ip]
[standard-input-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-n! S ip] [get-bytevector-n! S ip]
[get-bytevector-some S ip] [get-bytevector-some S ip]
[get-char S ip] [get-char C ip]
[get-datum S ip] [get-datum S ip]
[get-line C ip] [get-line C ip]
[get-string-all S ip] [get-string-all S ip]
@ -641,10 +641,10 @@
[port-transcoder S ip] [port-transcoder S ip]
[port? C ip] [port? C ip]
[put-bytevector S ip] [put-bytevector S ip]
[put-char S ip] [put-char C ip]
[put-datum S ip] [put-datum S ip]
[put-string S ip] [put-string S ip]
[put-u8 S ip] [put-u8 C ip]
[set-port-position! S ip] [set-port-position! S ip]
[standard-error-port S ip] [standard-error-port S ip]
[standard-input-port S ip] [standard-input-port S ip]