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

write-simple support optional output port

This commit is contained in:
Yuichi Nishiwaki 2014-02-08 17:15:34 +09:00
parent 812e595472
commit 5efdf3cfcc
1 changed files with 60 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
src/write.c
View File

@ -8,27 +8,27 @@
#include "picrin/blob.h" #include "picrin/blob.h"
#include "picrin/macro.h" #include "picrin/macro.h"
static void write(pic_state *, pic_value); static void write(pic_state *, pic_value, XFILE *file);
static void static void
write_pair(pic_state *pic, struct pic_pair *pair) write_pair(pic_state *pic, struct pic_pair *pair, XFILE *file)
{ {
write(pic, pair->car); write(pic, pair->car, file);
if (pic_nil_p(pair->cdr)) { if (pic_nil_p(pair->cdr)) {
return; return;
} }
if (pic_pair_p(pair->cdr)) { if (pic_pair_p(pair->cdr)) {
printf(" "); xfprintf(file, " ");
write_pair(pic, pic_pair_ptr(pair->cdr)); write_pair(pic, pic_pair_ptr(pair->cdr), file);
return; return;
} }
printf(" . "); xfprintf(file, " . ");
write(pic, pair->cdr); write(pic, pair->cdr, file);
} }
static void static void
write_str(pic_state *pic, struct pic_string *str) write_str(pic_state *pic, struct pic_string *str, XFILE *file)
{ {
size_t i; size_t i;
const char *cstr = str->str; const char *cstr = str->str;
@ -37,119 +37,119 @@ write_str(pic_state *pic, struct pic_string *str)
for (i = 0; i < str->len; ++i) { for (i = 0; i < str->len; ++i) {
if (cstr[i] == '"' || cstr[i] == '\\') { if (cstr[i] == '"' || cstr[i] == '\\') {
putchar('\\'); xfputc('\\', file);
} }
putchar(cstr[i]); xfputc(cstr[i], file);
} }
} }
static void static void
write(pic_state *pic, pic_value obj) write(pic_state *pic, pic_value obj, XFILE *file)
{ {
size_t i; size_t i;
switch (pic_type(obj)) { switch (pic_type(obj)) {
case PIC_TT_NIL: case PIC_TT_NIL:
printf("()"); xfprintf(file, "()");
break; break;
case PIC_TT_BOOL: case PIC_TT_BOOL:
if (pic_true_p(obj)) if (pic_true_p(obj))
printf("#t"); xfprintf(file, "#t");
else else
printf("#f"); xfprintf(file, "#f");
break; break;
case PIC_TT_PAIR: case PIC_TT_PAIR:
printf("("); xfprintf(file, "(");
write_pair(pic, pic_pair_ptr(obj)); write_pair(pic, pic_pair_ptr(obj), file);
printf(")"); xfprintf(file, ")");
break; break;
case PIC_TT_SYMBOL: case PIC_TT_SYMBOL:
printf("%s", pic_symbol_name(pic, pic_sym(obj))); xfprintf(file, "%s", pic_symbol_name(pic, pic_sym(obj)));
break; break;
case PIC_TT_CHAR: case PIC_TT_CHAR:
switch (pic_char(obj)) { switch (pic_char(obj)) {
default: printf("#\\%c", pic_char(obj)); break; default: xfprintf(file, "#\\%c", pic_char(obj)); break;
case '\a': printf("#\\alarm"); break; case '\a': xfprintf(file, "#\\alarm"); break;
case '\b': printf("#\\backspace"); break; case '\b': xfprintf(file, "#\\backspace"); break;
case 0x7f: printf("#\\delete"); break; case 0x7f: xfprintf(file, "#\\delete"); break;
case 0x1b: printf("#\\escape"); break; case 0x1b: xfprintf(file, "#\\escape"); break;
case '\n': printf("#\\newline"); break; case '\n': xfprintf(file, "#\\newline"); break;
case '\r': printf("#\\return"); break; case '\r': xfprintf(file, "#\\return"); break;
case ' ': printf("#\\space"); break; case ' ': xfprintf(file, "#\\space"); break;
case '\t': printf("#\\tab"); break; case '\t': xfprintf(file, "#\\tab"); break;
} }
break; break;
case PIC_TT_FLOAT: case PIC_TT_FLOAT:
printf("%f", pic_float(obj)); xfprintf(file, "%f", pic_float(obj));
break; break;
case PIC_TT_INT: case PIC_TT_INT:
printf("%d", pic_int(obj)); xfprintf(file, "%d", pic_int(obj));
break; break;
case PIC_TT_EOF: case PIC_TT_EOF:
printf("#<eof-object>"); xfprintf(file, "#<eof-object>");
break; break;
case PIC_TT_UNDEF: case PIC_TT_UNDEF:
printf("#<undef>"); xfprintf(file, "#<undef>");
break; break;
case PIC_TT_PROC: case PIC_TT_PROC:
printf("#<proc %p>", pic_ptr(obj)); xfprintf(file, "#<proc %p>", pic_ptr(obj));
break; break;
case PIC_TT_PORT: case PIC_TT_PORT:
printf("#<port %p>", pic_ptr(obj)); xfprintf(file, "#<port %p>", pic_ptr(obj));
break; break;
case PIC_TT_STRING: case PIC_TT_STRING:
printf("\""); xfprintf(file, "\"");
write_str(pic, pic_str_ptr(obj)); write_str(pic, pic_str_ptr(obj), file);
printf("\""); xfprintf(file, "\"");
break; break;
case PIC_TT_VECTOR: case PIC_TT_VECTOR:
printf("#("); xfprintf(file, "#(");
for (i = 0; i < pic_vec_ptr(obj)->len; ++i) { for (i = 0; i < pic_vec_ptr(obj)->len; ++i) {
write(pic, pic_vec_ptr(obj)->data[i]); write(pic, pic_vec_ptr(obj)->data[i], file);
if (i + 1 < pic_vec_ptr(obj)->len) { if (i + 1 < pic_vec_ptr(obj)->len) {
printf(" "); xfprintf(file, " ");
} }
} }
printf(")"); xfprintf(file, ")");
break; break;
case PIC_TT_BLOB: case PIC_TT_BLOB:
printf("#u8("); xfprintf(file, "#u8(");
for (i = 0; i < pic_blob_ptr(obj)->len; ++i) { for (i = 0; i < pic_blob_ptr(obj)->len; ++i) {
printf("%d", pic_blob_ptr(obj)->data[i]); xfprintf(file, "%d", pic_blob_ptr(obj)->data[i]);
if (i + 1 < pic_blob_ptr(obj)->len) { if (i + 1 < pic_blob_ptr(obj)->len) {
printf(" "); xfprintf(file, " ");
} }
} }
printf(")"); xfprintf(file, ")");
break; break;
case PIC_TT_ERROR: case PIC_TT_ERROR:
printf("#<error %p>", pic_ptr(obj)); xfprintf(file, "#<error %p>", pic_ptr(obj));
break; break;
case PIC_TT_ENV: case PIC_TT_ENV:
printf("#<env %p>", pic_ptr(obj)); xfprintf(file, "#<env %p>", pic_ptr(obj));
break; break;
case PIC_TT_CONT: case PIC_TT_CONT:
printf("#<cont %p>", pic_ptr(obj)); xfprintf(file, "#<cont %p>", pic_ptr(obj));
break; break;
case PIC_TT_SENV: case PIC_TT_SENV:
printf("#<senv %p>", pic_ptr(obj)); xfprintf(file, "#<senv %p>", pic_ptr(obj));
break; break;
case PIC_TT_SYNTAX: case PIC_TT_SYNTAX:
printf("#<syntax %p>", pic_ptr(obj)); xfprintf(file, "#<syntax %p>", pic_ptr(obj));
break; break;
case PIC_TT_SC: case PIC_TT_SC:
printf("#<sc %p: ", pic_ptr(obj)); xfprintf(file, "#<sc %p: ", pic_ptr(obj));
write(pic, pic_sc(obj)->expr); write(pic, pic_sc(obj)->expr, file);
printf(">"); xfprintf(file, ">");
break; break;
case PIC_TT_LIB: case PIC_TT_LIB:
printf("#<lib %p>", pic_ptr(obj)); xfprintf(file, "#<lib %p>", pic_ptr(obj));
break; break;
case PIC_TT_VAR: case PIC_TT_VAR:
printf("#<var %p>", pic_ptr(obj)); xfprintf(file, "#<var %p>", pic_ptr(obj));
break; break;
case PIC_TT_IREP: case PIC_TT_IREP:
printf("#<irep %p>", pic_ptr(obj)); xfprintf(file, "#<irep %p>", pic_ptr(obj));
break; break;
} }
} }
@ -157,17 +157,18 @@ write(pic_state *pic, pic_value obj)
void void
pic_debug(pic_state *pic, pic_value obj) pic_debug(pic_state *pic, pic_value obj)
{ {
write(pic, obj); write(pic, obj, xstdout);
fflush(stdout); xfflush(xstdout);
} }
static pic_value static pic_value
pic_port_write_simple(pic_state *pic) pic_port_write_simple(pic_state *pic)
{ {
pic_value v; pic_value v;
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "o", &v); pic_get_args(pic, "o|p", &v, &port);
write(pic, v); write(pic, v, port->file);
return pic_none_value(); return pic_none_value();
} }