implement the rest procedures of `input` but `u8-ready?` is incomlete like `char-ready?`

This commit is contained in:
Sunrim KIM (keen) 2014-05-26 03:21:26 +09:00
parent af921a9df8
commit cffaccf8ef
3 changed files with 169 additions and 6 deletions

View File

@ -155,7 +155,7 @@ At the REPL start-up time, some usuful built-in libraries listed below will be a
| 6.11 Exceptions | yes | `raise-continuable` is not supported |
| 6.12 Environments and evaluation | N/A | |
| 6.13.1 Ports | yes | |
| 6.13.2 Input | incomplete | TODO: binary input |
| 6.13.2 Input | yes | |
| 6.13.3 Output | yes | |
| 6.14 System interface | yes | |

View File

@ -434,6 +434,140 @@ pic_port_char_ready_p(pic_state *pic)
return pic_true_value(); /* FIXME: always returns #t */
}
static pic_value
pic_port_read_string(pic_state *pic){
struct pic_port *port = pic_stdin(pic), *buf;
pic_str *str;
int k, i;
char c;
pic_get_args(pic, "i|p", &k, &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, PIC_PORT_OPEN, "read-stritg");
buf = pic_open_output_string(pic);
for(i = 0; i < k; ++i) {
c = xfgetc(port->file);
if( c == EOF){
break;
}
xfputc(c, buf->file);
}
str = pic_get_output_string(pic, buf);
if (pic_strlen(str) == 0 && c == EOF) {
return pic_eof_object();
}
else {
return pic_obj_value(str);
}
}
static pic_value
pic_port_read_byte(pic_state *pic){
struct pic_port *port = pic_stdin(pic);
pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-u8");
return pic_int_value((char) xfgetc(port->file));
}
static pic_value
pic_port_peek_byte(pic_state *pic)
{
char c;
struct pic_port *port = pic_stdin(pic);
pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "peek-u8");
if ((c = xfgetc(port->file)) == EOF) {
return pic_eof_object();
}
else {
xungetc(c, port->file);
return pic_int_value(c);
}
}
static pic_value
pic_port_byte_ready_p(pic_state *pic)
{
struct pic_port *port = pic_stdin(pic);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "char-ready?");
pic_get_args(pic, "|p", &port);
return pic_true_value(); /* FIXME: always returns #t */
}
static pic_value
pic_port_read_blob(pic_state *pic){
struct pic_port *port = pic_stdin(pic);
int k, i;
char c, *buf;
pic_get_args(pic, "i|p", &k, &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector");
buf = pic_calloc(pic, k, sizeof(char));
for(i = 0; i < k; i++){
c = xfgetc(port->file);
if( c == EOF ){
break;
}
buf[i] = c;
}
if ( i == 0 && c == EOF) {
return pic_eof_object();
}
else {
pic_realloc(pic, buf, i);
return pic_obj_value(pic_blob_new(pic, buf, i));
}
}
static pic_value
pic_port_read_blob_ip(pic_state *pic){
struct pic_port *port;
struct pic_blob *bv;
int i, n, start, end;
char c;
n = pic_get_args(pic, "b|pii", &bv, &port, &start, &end);
switch (n) {
case 1:
port = pic_stdin(pic);
case 2:
start = 0;
case 3:
end = bv->len;
}
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector!");
for(i = start; i < end; i++){
c = xfgetc(port->file);
if( c == EOF ){
break;
}
bv->data[i] = c;
}
if ( i == start && c == EOF) {
return pic_eof_object();
}
else {
return pic_int_value(i - start);
}
}
static pic_value
pic_port_newline(pic_state *pic)
{
@ -571,12 +705,12 @@ pic_init_port(pic_state *pic)
pic_defun(pic, "eof-object?", pic_port_eof_object_p);
pic_defun(pic, "eof-object", pic_port_eof_object);
pic_defun(pic, "char-ready?", pic_port_char_ready_p);
/* pic_defun(pic, "read-string", pic_port_read_string); */
/* pic_defun(pic, "read-u8", pic_port_read_byte); */
/* pic_defun(pic, "peek-u8", pic_port_peek_byte); */
pic_defun(pic, "read-string", pic_port_read_string);
pic_defun(pic, "read-u8", pic_port_read_byte);
pic_defun(pic, "peek-u8", pic_port_peek_byte);
/* pic_defun(pic, "u8-ready?", pic_port_byte_ready_p); */
/* pic_defun(pic, "read-bytevector", pic_port_read_blob); */
/* pic_defun(pic, "peek-bytevector!", pic_port_read_blob_ip); */
pic_defun(pic, "read-bytevector", pic_port_read_blob);
pic_defun(pic, "read-bytevector!", pic_port_read_blob_ip);
/* output */
pic_defun(pic, "newline", pic_port_newline);

29
t/byteio.scm Normal file
View File

@ -0,0 +1,29 @@
(import (scheme base)
(scheme write)
(scheme file))
(let ((string-port (open-input-string "hello")))
(display "read-string: ")
(write (read-string 4 string-port))
(newline)
(display "read-string more: ")
(write (read-string 4 string-port))
(newline))
(let ((byte-port (open-input-bytevector (bytevector 1 2 3 4 5 6 7 8)))
(buf (make-bytevector 4 98)))
(display "read-u8: ")
(write (read-u8 byte-port))
(newline)
(display "peek-u8: ")
(write (peek-u8 byte-port))
(newline)
(display "read-bytevector: ")
(write (read-bytevector 4 byte-port))
(newline)
(display "read-bytevector!: read size: ")
(write (read-bytevector! buf byte-port 1 3))
(display " read content: ")
(write buf)
(newline))