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

refactor macroexpand_define. make use of macroexpand_lambda function

This commit is contained in:
Yuichi Nishiwaki 2014-07-13 21:01:30 +09:00
parent e08ec23a9f
commit 1989a972cb
1 changed files with 38 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
src/macro.c
View File

@ -355,55 +355,6 @@ macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv, struct pi
return x;
}
static pic_value
macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
{
pic_sym sym;
pic_value formal;
if (pic_length(pic, expr) < 2) {
pic_error(pic, "syntax error");
}
formal = pic_cadr(pic, expr);
if (pic_pair_p(formal)) {
struct pic_senv *in = push_scope(pic, pic_cdr(pic, formal), senv, cxt);
pic_value a;
/* defined symbol */
a = pic_car(pic, formal);
if (! pic_sym_p(a)) {
a = macroexpand(pic, a, senv, cxt);
}
if (! pic_sym_p(a)) {
pic_error(pic, "binding to non-symbol object");
}
sym = pic_sym(a);
if (! pic_find_rename(pic, senv, sym, NULL)) {
pic_add_rename(pic, senv, sym);
}
/* binding value */
return pic_cons(pic, pic_sym_value(pic->sDEFINE),
pic_cons(pic,
macroexpand_list(pic, pic_cadr(pic, expr), in, cxt),
macroexpand_list(pic, pic_cddr(pic, expr), in, cxt)));
}
if (! pic_sym_p(formal)) {
formal = macroexpand(pic, formal, senv, cxt);
}
if (! pic_sym_p(formal)) {
pic_error(pic, "binding to non-symbol object");
}
sym = pic_sym(formal);
if (! pic_find_rename(pic, senv, sym, NULL)) {
pic_add_rename(pic, senv, sym);
}
return pic_cons(pic, pic_sym_value(pic->sDEFINE), macroexpand_list(pic, pic_cdr(pic, expr), senv, cxt));
}
static pic_value
macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
{
@ -418,6 +369,44 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
return pic_cons(pic, pic_sym_value(pic->sLAMBDA), pic_cons(pic, formal, body));
}
static pic_value
macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
{
pic_sym sym;
pic_value formal, body, var, val;
if (pic_length(pic, expr) < 2) {
pic_error(pic, "syntax error");
}
formal = pic_cadr(pic, expr);
if (pic_pair_p(formal)) {
var = pic_car(pic, formal);
} else {
if (pic_length(pic, expr) != 3) {
pic_error(pic, "syntax error");
}
var = formal;
}
if (! pic_sym_p(var)) {
var = macroexpand(pic, var, senv, cxt);
}
if (! pic_sym_p(var)) {
pic_error(pic, "binding to non-symbol object");
}
sym = pic_sym(var);
if (! pic_find_rename(pic, senv, sym, NULL)) {
pic_add_rename(pic, senv, sym);
}
body = pic_cddr(pic, expr);
if (pic_pair_p(formal)) {
val = macroexpand_lambda(pic, pic_cons(pic, pic_false_value(), pic_cons(pic, pic_cdr(pic, formal), body)), senv, cxt);
} else {
val = macroexpand(pic, pic_car(pic, body), senv, cxt);
}
return pic_list3(pic, pic_sym_value(pic->sDEFINE), macroexpand_symbol(pic, sym, senv, cxt), val);
}
static pic_value
macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, struct pic_dict *cxt)
{