resolve symbols bound by define-syntax

This commit is contained in:
Yuichi Nishiwaki 2014-02-12 21:49:28 +09:00
parent 5f2424b69e
commit 910e006dc3
1 changed files with 11 additions and 2 deletions

View File

@ -278,6 +278,8 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
else if (tag == pic->sDEFINE_SYNTAX) {
pic_value var, val;
struct pic_proc *proc;
pic_sym uniq;
struct pic_macro *mac;
if (pic_length(pic, expr) != 3) {
pic_error(pic, "syntax error");
@ -285,8 +287,13 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
var = pic_cadr(pic, expr);
if (! pic_sym_p(var)) {
pic_error(pic, "syntax error");
var = macroexpand(pic, var, senv);
}
if (! pic_sym_p(var)) {
pic_error(pic, "binding to non-symbol object");
}
uniq = pic_gensym(pic, pic_sym(var));
xh_put_int(senv->name, pic_sym(var), uniq);
val = pic_cadr(pic, pic_cdr(pic, expr));
proc = pic_compile(pic, val);
@ -300,7 +307,9 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
abort();
}
assert(pic_proc_p(v));
defsyntax(pic, pic_sym(var), pic_proc_ptr(v), senv);
mac = macro_new(pic, pic_proc_ptr(v), senv);
xh_put_int(pic->macros, uniq, (long)mac);
pic_gc_arena_restore(pic, ai);
return pic_none_value();