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

add core syntaces in pic_open

This commit is contained in:
Yuichi Nishiwaki 2013-11-26 08:32:05 -08:00
parent a2e1f21b29
commit a32473ae92
3 changed files with 18 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
include/picrin/macro.h
View File

@ -24,4 +24,6 @@ struct pic_syntax {
#define pic_syntax(v) ((struct pic_syntax *)pic_ptr(v))
#define pic_syntax_p(v) (pic_type(v) == PIC_TT_SYNTAX)
struct pic_syntax *pic_syntax_new(pic_state *, int kind, pic_sym sym);
#endif

22
src/macro.c
View File

@ -375,7 +375,7 @@ macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv)
return pic_cons(pic, v, macroexpand_list(pic, pic_cdr(pic, list), senv));
}
static struct pic_syntax *
struct pic_syntax *
pic_syntax_new(pic_state *pic, int kind, pic_sym sym)
{
struct pic_syntax *stx;
@ -390,27 +390,11 @@ pic_value
pic_macroexpand_2(pic_state *pic, pic_value expr)
{
struct pic_senv *senv;
struct pic_syntax **stx;
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
senv->up = NULL;
senv->tbl = xh_new();
senv->stx = NULL;
stx = (struct pic_syntax **)pic_alloc(pic, sizeof(struct pic_syntax *) * 6);
stx[0] = pic_syntax_new(pic, PIC_STX_DEFINE, pic->sDEFINE);
stx[1] = pic_syntax_new(pic, PIC_STX_SET, pic->sSETBANG);
stx[2] = pic_syntax_new(pic, PIC_STX_QUOTE, pic->sQUOTE);
stx[3] = pic_syntax_new(pic, PIC_STX_LAMBDA, pic->sLAMBDA);
stx[4] = pic_syntax_new(pic, PIC_STX_IF, pic->sIF);
stx[5] = pic_syntax_new(pic, PIC_STX_BEGIN, pic->sBEGIN);
senv->stx = stx;
xh_put(senv->tbl, "define", ~0);
xh_put(senv->tbl, "set!", ~1);
xh_put(senv->tbl, "quote", ~2);
xh_put(senv->tbl, "lambda", ~3);
xh_put(senv->tbl, "if", ~4);
xh_put(senv->tbl, "begin", ~5);
senv->tbl = pic->var_tbl;
senv->stx = pic->stx;
return macroexpand(pic, expr, senv);
}

13
src/state.c
View File

@ -118,6 +118,19 @@ pic_open(int argc, char *argv[], char **envp)
register_core_symbol(pic, sGT, ">");
register_core_symbol(pic, sGE, ">=");
pic_gc_arena_restore(pic, ai);
#define register_core_syntax(pic,kind,name) do { \
pic->stx[pic->xlen] = pic_syntax_new(pic, kind, pic_intern_cstr(pic, name)); \
xh_put(pic->global_tbl, name, ~pic->xlen); \
pic->xlen++; \
} while (0)
register_core_syntax(pic, PIC_STX_DEFINE, "define");
register_core_syntax(pic, PIC_STX_SET, "set!");
register_core_syntax(pic, PIC_STX_QUOTE, "quote");
register_core_syntax(pic, PIC_STX_LAMBDA, "lambda");
register_core_syntax(pic, PIC_STX_IF, "if");
register_core_syntax(pic, PIC_STX_BEGIN, "begin");
pic_gc_arena_restore(pic, ai);
pic_init_core(pic);