72 lines
1.2 KiB
C
72 lines
1.2 KiB
C
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
|
|
#include "picrin.h"
|
|
#include "picrin/proc.h"
|
|
|
|
static void
|
|
write(pic_state *pic, pic_value obj)
|
|
{
|
|
switch (pic_type(obj)) {
|
|
case PIC_TT_NIL:
|
|
printf("()");
|
|
break;
|
|
case PIC_TT_BOOL:
|
|
if (pic_true_p(obj))
|
|
printf("#t");
|
|
else
|
|
printf("#f");
|
|
break;
|
|
case PIC_TT_PAIR:
|
|
printf("(");
|
|
write(pic, pic_car(pic, obj));
|
|
printf(" . ");
|
|
write(pic, pic_cdr(pic, obj));
|
|
printf(")");
|
|
break;
|
|
case PIC_TT_SYMBOL:
|
|
printf("%s", pic_symbol_ptr(obj)->name);
|
|
break;
|
|
case PIC_TT_FLOAT:
|
|
printf("%g", pic_float(obj));
|
|
break;
|
|
case PIC_TT_UNDEF:
|
|
printf("#<undef>");
|
|
break;
|
|
case PIC_TT_PROC:
|
|
printf("#<proc %p>", pic_proc_ptr(obj));
|
|
break;
|
|
}
|
|
}
|
|
|
|
void
|
|
pic_debug(pic_state *pic, pic_value obj)
|
|
{
|
|
write(pic, obj);
|
|
}
|
|
|
|
static pic_value
|
|
pic_port_write(pic_state *pic)
|
|
{
|
|
pic_value v;
|
|
|
|
pic_get_args(pic, "o", &v);
|
|
write(pic, v);
|
|
return pic_false_value();
|
|
}
|
|
|
|
static pic_value
|
|
pic_port_newline(pic_state *pic)
|
|
{
|
|
puts("");
|
|
return pic_false_value();
|
|
}
|
|
|
|
void
|
|
pic_init_port(pic_state *pic)
|
|
{
|
|
pic_defun(pic, "write", pic_port_write);
|
|
pic_defun(pic, "newline", pic_port_newline);
|
|
}
|
|
|