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

add write-shared

This commit is contained in:
Yuichi Nishiwaki 2014-02-18 03:40:03 +09:00
parent c6c88e976f
commit cd34417c42
2 changed files with 25 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
piclib/built-in.scm
View File

@ -735,7 +735,6 @@
;; FIXME
(define write write-simple)
(define write-shared write-simple)
(define (display obj . opts)
(let ((port (if (null? opts) (current-output-port) (car opts))))

26
src/write.c
View File

@ -315,6 +315,18 @@ write_simple(pic_state *pic, pic_value obj, XFILE *file)
write_core(p, obj);
}
static void
write_shared(pic_state *pic, pic_value obj, XFILE *file)
{
struct writer_control *p;
p = writer_control_new(pic, file);
traverse_shared(p, obj);
write_core(p, obj);
}
pic_value
pic_debug(pic_state *pic, pic_value obj)
{
@ -324,7 +336,7 @@ pic_debug(pic_state *pic, pic_value obj)
pic_value
pic_fdebug(pic_state *pic, pic_value obj, XFILE *file)
{
write(pic, obj, file);
write_shared(pic, obj, file);
xfflush(file);
return obj;
}
@ -340,10 +352,22 @@ pic_port_write_simple(pic_state *pic)
return pic_none_value();
}
static pic_value
pic_port_write_shared(pic_state *pic)
{
pic_value v;
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "o|p", &v, &port);
write_shared(pic, v, port->file);
return pic_none_value();
}
void
pic_init_write(pic_state *pic)
{
pic_deflibrary ("(scheme write)") {
pic_defun(pic, "write-simple", pic_port_write_simple);
pic_defun(pic, "write-shared", pic_port_write_shared);
}
}