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

refactor macroexpand

This commit is contained in:
Yuichi Nishiwaki 2014-03-24 15:27:03 +09:00
parent 9dcdc45ab6
commit b29832d2c5
1 changed files with 25 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
src/macro.c
View File

@ -224,17 +224,10 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
pic_in_library(pic, pic_cadr(pic, expr)); pic_in_library(pic, pic_cadr(pic, expr));
pic_for_each (v, pic_cddr(pic, expr)) { pic_for_each (v, pic_cddr(pic, expr)) {
struct pic_proc *proc;
int ai = pic_gc_arena_preserve(pic); int ai = pic_gc_arena_preserve(pic);
proc = pic_compile(pic, v); pic_eval(pic, v);
if (proc == NULL) {
abort();
}
pic_apply_argv(pic, proc, 0);
if (pic_undef_p(v)) {
abort();
}
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
} }
@ -271,7 +264,6 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
else if (tag == pic->sDEFINE_SYNTAX) { else if (tag == pic->sDEFINE_SYNTAX) {
pic_value var, val; pic_value var, val;
struct pic_proc *proc;
pic_sym uniq; pic_sym uniq;
struct pic_macro *mac; struct pic_macro *mac;
@ -290,16 +282,12 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
xh_put_int(senv->name, pic_sym(var), uniq); xh_put_int(senv->name, pic_sym(var), uniq);
val = pic_cadr(pic, pic_cdr(pic, expr)); val = pic_cadr(pic, pic_cdr(pic, expr));
proc = pic_compile(pic, val);
if (pic->err) { pic_try {
printf("macroexpand error: %s\n", pic_errmsg(pic)); v = pic_eval(pic, val);
abort(); } pic_catch {
} pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
v = pic_apply(pic, proc, pic_nil_value()); }
if (pic->err) {
printf("macroexpand error: %s\n", pic_errmsg(pic));
abort();
}
assert(pic_proc_p(v)); assert(pic_proc_p(v));
mac = macro_new(pic, pic_proc_ptr(v), senv); mac = macro_new(pic, pic_proc_ptr(v), senv);
@ -311,7 +299,6 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
else if (tag == pic->sDEFINE_MACRO) { else if (tag == pic->sDEFINE_MACRO) {
pic_value var, val; pic_value var, val;
struct pic_proc *proc;
pic_sym uniq; pic_sym uniq;
struct pic_macro *mac; struct pic_macro *mac;
@ -339,16 +326,11 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
uniq = pic_gensym(pic, pic_sym(var)); uniq = pic_gensym(pic, pic_sym(var));
xh_put_int(senv->name, pic_sym(var), uniq); xh_put_int(senv->name, pic_sym(var), uniq);
proc = pic_compile(pic, val); pic_try {
if (pic->err) { v = pic_eval(pic, val);
printf("macroexpand error: %s\n", pic_errmsg(pic)); } pic_catch {
abort(); pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
} }
v = pic_apply(pic, proc, pic_nil_value());
if (pic->err) {
printf("macroexpand error: %s\n", pic_errmsg(pic));
abort();
}
assert(pic_proc_p(v)); assert(pic_proc_p(v));
mac = macro_new(pic, pic_proc_ptr(v), NULL); mac = macro_new(pic, pic_proc_ptr(v), NULL);
@ -441,7 +423,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
/* macro */ /* macro */
if ((e = xh_get_int(pic->macros, tag)) != NULL) { if ((e = xh_get_int(pic->macros, tag)) != NULL) {
pic_value v; pic_value v, args;
struct pic_macro *mac; struct pic_macro *mac;
#if DEBUG #if DEBUG
@ -452,19 +434,17 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
mac = (struct pic_macro *)e->val; mac = (struct pic_macro *)e->val;
if (mac->senv == NULL) { /* legacy macro */ if (mac->senv == NULL) { /* legacy macro */
v = pic_apply(pic, mac->proc, pic_cdr(pic, expr)); args = pic_cdr(pic, expr);
if (pic->err) { }
printf("macroexpand error: %s\n", pic_errmsg(pic)); else {
abort(); args = pic_list3(pic, expr, pic_obj_value(senv), pic_obj_value(mac->senv));
} }
}
else { pic_try {
v = pic_apply_argv(pic, mac->proc, 3, expr, pic_obj_value(senv), pic_obj_value(mac->senv)); v = pic_apply(pic, mac->proc, args);
if (pic->err) { } pic_catch {
printf("macroexpand error: %s\n", pic_errmsg(pic)); pic_errorf(pic, "macroexpand error: %s", pic_errmsg(pic));
abort(); }
}
}
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
pic_gc_protect(pic, v); pic_gc_protect(pic, v);