implement the rest procedures of `input` but `u8-ready?` is incomlete like `char-ready?`
This commit is contained in:
parent
af921a9df8
commit
cffaccf8ef
|
@ -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 | |
|
||||
|
||||
|
|
144
src/port.c
144
src/port.c
|
@ -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);
|
||||
|
|
|
@ -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))
|
Loading…
Reference in New Issue