diff --git a/scheme/ikarus.io-primitives.ss b/scheme/ikarus.io-primitives.ss index cb31aaa..4878028 100644 --- a/scheme/ikarus.io-primitives.ss +++ b/scheme/ikarus.io-primitives.ss @@ -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))] diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 6fb8473..146ad9d 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -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] diff --git a/scheme/todo-r6rs.ss b/scheme/todo-r6rs.ss index fc9878d..18d99d6 100755 --- a/scheme/todo-r6rs.ss +++ b/scheme/todo-r6rs.ss @@ -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]