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

assume all symbols are bound at the toplevel

This commit is contained in:
Yuichi Nishiwaki 2015-06-15 01:02:53 +09:00
parent 3a59a95960
commit 6d80b58060
1 changed files with 17 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
extlib/benz/macro.c
View File

@ -80,14 +80,21 @@ resolve(pic_state *pic, pic_value var, struct pic_env *env)
pic_sym *uid; pic_sym *uid;
assert(pic_var_p(var)); assert(pic_var_p(var));
assert(env != NULL);
while ((uid = lookup(pic, var, env)) == NULL) { while ((uid = lookup(pic, var, env)) == NULL) {
if (pic_sym_p(var)) { if (pic_sym_p(var)) {
return NULL; break;
} }
env = pic_id_ptr(var)->env; env = pic_id_ptr(var)->env;
var = pic_id_ptr(var)->var; var = pic_id_ptr(var)->var;
} }
if (uid == NULL) {
while (env->up != NULL) {
env = env->up;
}
uid = pic_add_variable(pic, env, var);
}
return uid; return uid;
} }
@ -147,12 +154,7 @@ static pic_value macroexpand_lambda(pic_state *, pic_value, struct pic_env *);
static pic_value static pic_value
macroexpand_var(pic_state *pic, pic_value var, struct pic_env *env) macroexpand_var(pic_state *pic, pic_value var, struct pic_env *env)
{ {
pic_sym *uid; return pic_obj_value(resolve(pic, var, env));
if ((uid = resolve(pic, var, env)) == NULL) {
pic_errorf(pic, "unbound variable found: ~s", var);
}
return pic_obj_value(uid);
} }
static pic_value static pic_value
@ -355,9 +357,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_env *env)
if (pic_var_p(pic_car(pic, expr))) { if (pic_var_p(pic_car(pic, expr))) {
pic_sym *functor; pic_sym *functor;
if ((functor = resolve(pic, pic_car(pic, expr), env)) == NULL) { functor = resolve(pic, pic_car(pic, expr), env);
goto call;
}
if (functor == pic->uDEFINE_MACRO) { if (functor == pic->uDEFINE_MACRO) {
return macroexpand_defmacro(pic, expr, env); return macroexpand_defmacro(pic, expr, env);
@ -376,8 +376,6 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_env *env)
return macroexpand_node(pic, macroexpand_macro(pic, mac, expr, env), env); return macroexpand_node(pic, macroexpand_macro(pic, mac, expr, env), env);
} }
} }
call:
return macroexpand_list(pic, expr, env); return macroexpand_list(pic, expr, env);
} }
default: default:
@ -506,22 +504,21 @@ static pic_value
pic_macro_variable_eq_p(pic_state *pic) pic_macro_variable_eq_p(pic_state *pic)
{ {
pic_value var1, var2; pic_value var1, var2;
pic_sym *uid1, *uid2;
pic_get_args(pic, "oo", &var1, &var2); pic_get_args(pic, "oo", &var1, &var2);
pic_assert_type(pic, var1, var); pic_assert_type(pic, var1, var);
pic_assert_type(pic, var2, var); pic_assert_type(pic, var2, var);
if (pic_eq_p(var1, var2)) { if (pic_sym_p(var1) && pic_sym_p(var2)) {
return pic_true_value(); return pic_bool_value(pic_eq_p(var1, var2));
} }
if (pic_id_p(var1) && pic_id_p(var2)) {
struct pic_id *id1, *id2;
uid1 = resolve(pic, var1, NULL); id1 = pic_id_ptr(var1);
uid2 = resolve(pic, var2, NULL); id2 = pic_id_ptr(var2);
return pic_bool_value(resolve(pic, id1->var, id1->env) == resolve(pic, id2->var, id2->env));
if (uid1 || uid2) {
return pic_bool_value(uid1 == uid2);
} }
return pic_false_value(); return pic_false_value();
} }