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

separate macroexpansion and arena management

This commit is contained in:
Yuichi Nishiwaki 2014-03-25 15:42:20 +09:00
parent 3d1aaf8ec3
commit 4b13848cbc
1 changed files with 19 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
src/macro.c
View File

@ -209,11 +209,24 @@ symbol_rename(pic_state *pic, pic_sym sym, struct pic_senv *senv)
return sym; return sym;
} }
static pic_value macroexpand_node(pic_state *, pic_value, struct pic_senv *);
static pic_value static pic_value
macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
{ {
int ai = pic_gc_arena_preserve(pic); int ai = pic_gc_arena_preserve(pic);
pic_value v;
v = macroexpand_node(pic, expr, senv);
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v);
return v;
}
static pic_value
macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
{
#if DEBUG #if DEBUG
printf("[macroexpand] expanding... "); printf("[macroexpand] expanding... ");
pic_debug(pic, expr); pic_debug(pic, expr);
@ -324,7 +337,6 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
mac = macro_new(pic, pic_proc_ptr(v), senv); mac = macro_new(pic, pic_proc_ptr(v), senv);
xh_put(&pic->macros, rename, &mac); xh_put(&pic->macros, rename, &mac);
pic_gc_arena_restore(pic, ai);
return pic_none_value(); return pic_none_value();
} }
@ -372,21 +384,16 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
mac = macro_new(pic, pic_proc_ptr(v), NULL); mac = macro_new(pic, pic_proc_ptr(v), NULL);
xh_put(&pic->macros, rename, &mac); xh_put(&pic->macros, rename, &mac);
pic_gc_arena_restore(pic, ai);
return pic_none_value(); return pic_none_value();
} }
else if (tag == pic->sLAMBDA) { else if (tag == pic->sLAMBDA) {
struct pic_senv *in = senv_new_local(pic, pic_cadr(pic, expr), senv); struct pic_senv *in = senv_new_local(pic, pic_cadr(pic, expr), senv);
v = pic_cons(pic, car, return pic_cons(pic, car,
pic_cons(pic, pic_cons(pic,
macroexpand_list(pic, pic_cadr(pic, expr), in), macroexpand_list(pic, pic_cadr(pic, expr), in),
macroexpand_list(pic, pic_cddr(pic, expr), in))); macroexpand_list(pic, pic_cddr(pic, expr), in)));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v);
return v;
} }
else if (tag == pic->sDEFINE) { else if (tag == pic->sDEFINE) {
@ -416,14 +423,10 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
} }
/* binding value */ /* binding value */
v = pic_cons(pic, car, return pic_cons(pic, car,
pic_cons(pic, pic_cons(pic,
macroexpand_list(pic, pic_cadr(pic, expr), in), macroexpand_list(pic, pic_cadr(pic, expr), in),
macroexpand_list(pic, pic_cddr(pic, expr), in))); macroexpand_list(pic, pic_cddr(pic, expr), in)));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v);
return v;
} }
if (! pic_sym_p(formals)) { if (! pic_sym_p(formals)) {
@ -437,25 +440,15 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
pic_add_rename(pic, senv, sym); pic_add_rename(pic, senv, sym);
} }
v = pic_cons(pic, pic_symbol_value(tag), return pic_cons(pic, pic_symbol_value(tag), macroexpand_list(pic, pic_cdr(pic, expr), senv));
macroexpand_list(pic, pic_cdr(pic, expr), senv));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v);
return v;
} }
else if (tag == pic->sSETBANG || tag == pic->sIF || tag == pic->sBEGIN) { else if (tag == pic->sSETBANG || tag == pic->sIF || tag == pic->sBEGIN) {
v = pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), senv)); return pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), senv));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v);
return v;
} }
else if (tag == pic->sQUOTE) { else if (tag == pic->sQUOTE) {
v = pic_cons(pic, car, pic_cdr(pic, expr)); return pic_cons(pic, car, pic_cdr(pic, expr));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v);
return v;
} }
/* macro */ /* macro */
@ -482,8 +475,6 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
} pic_catch { } pic_catch {
pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic)); pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
} }
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v);
#if DEBUG #if DEBUG
puts("after expand-1:"); puts("after expand-1:");
@ -495,10 +486,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
} }
} }
v = pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), senv)); return pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), senv));
pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v);
return v;
} }
case PIC_TT_EOF: case PIC_TT_EOF:
case PIC_TT_NIL: case PIC_TT_NIL: