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

refactor macroexpand_lambda

This commit is contained in:
Yuichi Nishiwaki 2014-07-13 21:05:57 +09:00
parent 1989a972cb
commit 730cfc8601
1 changed files with 31 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
src/macro.c
View File

@ -11,8 +11,6 @@
#include "picrin/error.h" #include "picrin/error.h"
#include "picrin/dict.h" #include "picrin/dict.h"
static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *, struct pic_dict *);
pic_sym pic_sym
pic_add_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym) pic_add_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym)
{ {
@ -70,39 +68,6 @@ find_macro(pic_state *pic, pic_sym rename)
return xh_val(e, struct pic_macro *); return xh_val(e, struct pic_macro *);
} }
static struct pic_senv *
push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, struct pic_dict *cxt)
{
struct pic_senv *senv;
pic_value a;
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
senv->up = up;
xh_init_int(&senv->renames, sizeof(pic_sym));
for (a = formals; pic_pair_p(a); a = pic_cdr(pic, a)) {
pic_value v = pic_car(pic, a);
if (! pic_sym_p(v)) {
v = macroexpand(pic, v, up, cxt);
}
if (! pic_sym_p(v)) {
pic_error(pic, "syntax error");
}
pic_add_rename(pic, senv, pic_sym(v));
}
if (! pic_sym_p(a)) {
a = macroexpand(pic, a, up, cxt);
}
if (pic_sym_p(a)) {
pic_add_rename(pic, senv, pic_sym(a));
}
else if (! pic_nil_p(a)) {
pic_error(pic, "syntax error");
}
return senv;
}
static pic_sym static pic_sym
translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt) translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt)
{ {
@ -128,6 +93,8 @@ translate(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *c
} }
} }
static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *, struct pic_dict *);
static pic_value static pic_value
macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt) macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv, struct pic_dict *cxt)
{ {
@ -360,8 +327,36 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv, struct
{ {
pic_value formal, body; pic_value formal, body;
struct pic_senv *in; struct pic_senv *in;
pic_value a;
in = push_scope(pic, pic_cadr(pic, expr), senv, cxt); if (pic_length(pic, expr) < 2) {
pic_error(pic, "syntax error");
}
in = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
in->up = senv;
xh_init_int(&in->renames, sizeof(pic_sym));
for (a = pic_cadr(pic, expr); pic_pair_p(a); a = pic_cdr(pic, a)) {
pic_value v = pic_car(pic, a);
if (! pic_sym_p(v)) {
v = macroexpand(pic, v, senv, cxt);
}
if (! pic_sym_p(v)) {
pic_error(pic, "syntax error");
}
pic_add_rename(pic, in, pic_sym(v));
}
if (! pic_sym_p(a)) {
a = macroexpand(pic, a, senv, cxt);
}
if (pic_sym_p(a)) {
pic_add_rename(pic, in, pic_sym(a));
}
else if (! pic_nil_p(a)) {
pic_error(pic, "syntax error");
}
formal = macroexpand_list(pic, pic_cadr(pic, expr), in, cxt); formal = macroexpand_list(pic, pic_cadr(pic, expr), in, cxt);
body = macroexpand_list(pic, pic_cddr(pic, expr), in, cxt); body = macroexpand_list(pic, pic_cddr(pic, expr), in, cxt);