add call-with-port

This commit is contained in:
Yuichi Nishiwaki 2014-09-10 17:42:55 +09:00
parent ac638daa2b
commit e376f2614d
1 changed files with 18 additions and 0 deletions

18
port.c
View File

@ -113,6 +113,22 @@ pic_close_port(pic_state *pic, struct pic_port *port)
port->status = PIC_PORT_CLOSE;
}
static pic_value
pic_port_call_with_port(pic_state *pic)
{
struct pic_port *port;
struct pic_proc *proc;
pic_value value;
pic_get_args(pic, "pl", &port, &proc);
value = pic_apply1(pic, proc, pic_obj_value(port));
pic_close_port(pic, port);
return value;
}
static pic_value
pic_port_input_port_p(pic_state *pic)
{
@ -670,6 +686,8 @@ pic_init_port(pic_state *pic)
pic_define(pic, "current-output-port", pic_obj_value(pic_var_new(pic, pic_obj_value(pic->xSTDOUT), NULL)));
pic_define(pic, "current-error-port", pic_obj_value(pic_var_new(pic, pic_obj_value(pic->xSTDERR), NULL)));
pic_defun(pic, "call-with-port", pic_port_call_with_port);
pic_defun(pic, "input-port?", pic_port_input_port_p);
pic_defun(pic, "output-port?", pic_port_output_port_p);
pic_defun(pic, "textual-port?", pic_port_textual_port_p);