conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

define current-*-ports in port.c

This commit is contained in:
Yuichi Nishiwaki 2014-07-23 09:24:28 +09:00
parent 8846776f2f
commit aeb9c2bcee
2 changed files with 16 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
piclib/prelude.scm
View File

@ -707,16 +707,6 @@
;;; 6.13. Input and output ;;; 6.13. Input and output
(import (picrin port))
(define current-input-port (make-parameter standard-input-port))
(define current-output-port (make-parameter standard-output-port))
(define current-error-port (make-parameter standard-error-port))
(export current-input-port
current-output-port
current-error-port)
(define (call-with-port port proc) (define (call-with-port port proc)
(dynamic-wind (dynamic-wind
(lambda () #f) (lambda () #f)

21
src/port.c
View File

@ -11,6 +11,7 @@
#include "picrin/port.h" #include "picrin/port.h"
#include "picrin/string.h" #include "picrin/string.h"
#include "picrin/blob.h" #include "picrin/blob.h"
#include "picrin/var.h"
pic_value pic_value
pic_eof_object() pic_eof_object()
@ -42,7 +43,7 @@ pic_stdout(pic_state *pic)
return pic_port_ptr(pic_apply(pic, proc, pic_nil_value())); return pic_port_ptr(pic_apply(pic, proc, pic_nil_value()));
} }
static pic_value static struct pic_port *
port_new_stdport(pic_state *pic, xFILE *file, short dir) port_new_stdport(pic_state *pic, xFILE *file, short dir)
{ {
struct pic_port *port; struct pic_port *port;
@ -51,7 +52,7 @@ port_new_stdport(pic_state *pic, xFILE *file, short dir)
port->file = file; port->file = file;
port->flags = dir | PIC_PORT_TEXT; port->flags = dir | PIC_PORT_TEXT;
port->status = PIC_PORT_OPEN; port->status = PIC_PORT_OPEN;
return pic_obj_value(port); return port;
} }
struct pic_port * struct pic_port *
@ -688,12 +689,22 @@ pic_port_flush(pic_state *pic)
void void
pic_init_port(pic_state *pic) pic_init_port(pic_state *pic)
{ {
struct pic_port *STDIN, *STDOUT, *STDERR;
STDIN = port_new_stdport(pic, xstdin, PIC_PORT_IN);
STDOUT = port_new_stdport(pic, xstdout, PIC_PORT_OUT);
STDERR = port_new_stdport(pic, xstderr, PIC_PORT_OUT);
pic_deflibrary ("(picrin port)") { pic_deflibrary ("(picrin port)") {
pic_define(pic, "standard-input-port", port_new_stdport(pic, xstdin, PIC_PORT_IN)); pic_define(pic, "standard-input-port", pic_obj_value(STDIN));
pic_define(pic, "standard-output-port", port_new_stdport(pic, xstdout, PIC_PORT_OUT)); pic_define(pic, "standard-output-port", pic_obj_value(STDOUT));
pic_define(pic, "standard-error-port", port_new_stdport(pic, xstderr, PIC_PORT_OUT)); pic_define(pic, "standard-error-port", pic_obj_value(STDERR));
} }
pic_define(pic, "current-input-port", pic_obj_value(pic_var_new(pic, pic_obj_value(STDIN), NULL)));
pic_define(pic, "current-output-port", pic_obj_value(pic_var_new(pic, pic_obj_value(STDOUT), NULL)));
pic_define(pic, "current-error-port", pic_obj_value(pic_var_new(pic, pic_obj_value(STDERR), NULL)));
pic_defun(pic, "input-port?", pic_port_input_port_p); pic_defun(pic, "input-port?", pic_port_input_port_p);
pic_defun(pic, "output-port?", pic_port_output_port_p); pic_defun(pic, "output-port?", pic_port_output_port_p);
pic_defun(pic, "textual-port?", pic_port_textual_port_p); pic_defun(pic, "textual-port?", pic_port_textual_port_p);