add standard functions: write/newline

This commit is contained in:
Yuichi Nishiwaki 2013-10-15 21:14:33 +09:00
parent af9dd45e65
commit 2d4a5ed1ea
4 changed files with 47 additions and 3 deletions

View File

@ -4,7 +4,7 @@ build:
cd src; \
yacc -d parse.y; \
lex scan.l
gcc -o bin/picrin -I./include src/main.c src/state.c src/gc.c src/pair.c src/write.c src/symbol.c src/value.c src/y.tab.c src/lex.yy.c src/eval.c src/bool.c src/vm.c
gcc -o bin/picrin -I./include src/main.c src/state.c src/gc.c src/pair.c src/port.c src/symbol.c src/value.c src/y.tab.c src/lex.yy.c src/eval.c src/bool.c src/vm.c src/init.c
clean:
rm -f src/y.tab.c src/y.tab.h src/lex.yy.c

14
src/init.c Normal file
View File

@ -0,0 +1,14 @@
#include "picrin.h"
void pic_init_port(pic_state *);
#define DONE pic_gc_arena_restore(pic, ai);
void
pic_init_core(pic_state *pic)
{
int ai;
ai = pic_gc_arena_preserve(pic);
pic_init_port(pic); DONE;
}

View File

@ -22,7 +22,7 @@ pic_debug(pic_state *pic, pic_value obj)
printf("%s", pic_symbol_ptr(obj)->name);
break;
case PIC_TT_FLOAT:
printf("%f", pic_float(obj));
printf("%g", pic_float(obj));
break;
case PIC_TT_UNDEF:
printf("#<undef>");
@ -35,3 +35,28 @@ pic_debug(pic_state *pic, pic_value obj)
break;
}
}
static pic_value
pic_port_write(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
pic_debug(pic, v);
return pic_undef_value();
}
static pic_value
pic_port_newline(pic_state *pic)
{
puts("");
return pic_undef_value();
}
void
pic_init_port(pic_state *pic)
{
pic_defun(pic, "write", pic_port_write);
pic_defun(pic, "newline", pic_port_newline);
}

View File

@ -15,6 +15,8 @@ pic_new_empty_env()
return env;
}
void pic_init_core(pic_state *);
pic_state *
pic_open()
{
@ -34,11 +36,14 @@ pic_open()
/* GC arena */
pic->arena_idx = 0;
pic->global_env = pic_new_empty_env();
pic->sDEFINE = pic_intern_cstr(pic, "define");
pic->sCONS = pic_intern_cstr(pic, "cons");
pic->sADD = pic_intern_cstr(pic, "add");
/* global environment */
pic->global_env = pic_new_empty_env();
pic_init_core(pic);
return pic;
}