This commit is contained in:
Yuichi Nishiwaki 2014-02-07 02:23:55 +09:00
parent 7288cd0614
commit 1c633b3cda
1 changed files with 15 additions and 16 deletions

View File

@ -455,29 +455,28 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
return v; return v;
} }
case PIC_STX_DEFINE: { case PIC_STX_DEFINE: {
pic_sym uniq; pic_sym var;
pic_value var; pic_value formals;
if (pic_length(pic, expr) < 2) { if (pic_length(pic, expr) < 2) {
pic_error(pic, "syntax error"); pic_error(pic, "syntax error");
} }
var = pic_cadr(pic, expr); formals = pic_cadr(pic, expr);
if (pic_pair_p(var)) { if (pic_pair_p(formals)) {
struct pic_senv *in = new_local_senv(pic, pic_cdr(pic, var), senv); struct pic_senv *in = new_local_senv(pic, pic_cdr(pic, formals), senv);
pic_value a; pic_value a;
pic_sym sym;
/* defined symbol */ /* defined symbol */
a = pic_car(pic, var); a = pic_car(pic, formals);
if (! pic_sym_p(a)) { if (! pic_sym_p(a)) {
a = macroexpand(pic, a, senv); a = macroexpand(pic, a, senv);
} }
if (! pic_sym_p(a)) { if (! pic_sym_p(a)) {
pic_error(pic, "binding to non-symbol object"); pic_error(pic, "binding to non-symbol object");
} }
sym = pic_sym(a); var = pic_sym(a);
xh_put_int(senv->tbl, sym, pic_gensym(pic, sym)); xh_put_int(senv->tbl, var, pic_gensym(pic, var));
/* binding value */ /* binding value */
v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym), v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym),
@ -490,16 +489,16 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
return v; return v;
} }
if (! pic_sym_p(var)) { if (! pic_sym_p(formals)) {
var = macroexpand(pic, var, senv); formals = macroexpand(pic, formals, senv);
} }
if (! pic_sym_p(var)) { if (! pic_sym_p(formals)) {
pic_error(pic, "binding to non-symbol object"); pic_error(pic, "binding to non-symbol object");
} }
var = pic_sym(formals);
/* do not make duplicate variable slot */ /* do not make duplicate variable slot */
if (xh_get_int(senv->tbl, pic_sym(var)) == NULL) { if (xh_get_int(senv->tbl, var) == NULL) {
uniq = pic_gensym(pic, pic_sym(var)); xh_put_int(senv->tbl, var, pic_gensym(pic, var));
xh_put_int(senv->tbl, pic_sym(var), (int)uniq);
} }
} }
FALLTHROUGH; FALLTHROUGH;