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

change pic_add_identifier's behavior

This commit is contained in:
Yuichi Nishiwaki 2016-02-22 23:49:39 +09:00
parent 1a8bc0bc66
commit 8d17bf3175
4 changed files with 45 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extlib/benz/eval.c
View File

@ -116,7 +116,7 @@ analyzer_scope_destroy(pic_state *PIC_UNUSED(pic), analyze_scope *PIC_UNUSED(sco
}
static bool
search_scope(pic_state *pic, analyze_scope *scope, pic_value sym)
find_local_var(pic_state *pic, analyze_scope *scope, pic_value sym)
{
return pic_dict_has(pic, scope->args, sym) || pic_dict_has(pic, scope->locals, sym) || scope->depth == 0;
}
@ -127,7 +127,7 @@ find_var(pic_state *pic, analyze_scope *scope, pic_value sym)
int depth = 0;
while (scope) {
if (search_scope(pic, scope, sym)) {
if (find_local_var(pic, scope, sym)) {
if (depth > 0) {
pic_dict_set(pic, scope->captures, sym, pic_true_value(pic)); /* capture! */
}
@ -144,7 +144,7 @@ define_var(pic_state *pic, analyze_scope *scope, pic_value sym)
{
if (scope->depth > 0) {
/* local */
if (search_scope(pic, scope, sym)) {
if (find_local_var(pic, scope, sym)) {
pic_warnf(pic, "redefining variable: ~s", sym);
return;
}

2
extlib/benz/include/picrin/private/object.h
View File

@ -179,7 +179,7 @@ pic_value pic_make_error(pic_state *, const char *type, const char *msg, pic_val
pic_value pic_make_rec(pic_state *, pic_value type, pic_value datum);
pic_value pic_add_identifier(pic_state *, pic_value id, pic_value env);
pic_value pic_put_identifier(pic_state *, pic_value id, pic_value uid, pic_value env);
void pic_put_identifier(pic_state *, pic_value id, pic_value uid, pic_value env);
pic_value pic_find_identifier(pic_state *, pic_value id, pic_value env);
pic_value pic_id_name(pic_state *, pic_value id);

84
extlib/benz/macro.c
View File

@ -22,36 +22,6 @@ pic_make_env(pic_state *pic, pic_value up)
return pic_obj_value(env);
}
pic_value
pic_add_identifier(pic_state *pic, pic_value id, pic_value env)
{
const char *name;
pic_value uid, str;
name = pic_str(pic, pic_id_name(pic, id));
if (pic_env_ptr(pic, env)->up == NULL && pic_sym_p(pic, id)) { /* toplevel & public */
str = pic_strf_value(pic, "~a/%s", pic_obj_value(pic_env_ptr(pic, env)->lib), name);
} else {
str = pic_strf_value(pic, ".%s.%d", name, pic->ucnt++);
}
uid = pic_intern(pic, str);
return pic_put_identifier(pic, id, uid, env);
}
pic_value
pic_put_identifier(pic_state *pic, pic_value id, pic_value uid, pic_value env)
{
int it;
int ret;
it = kh_put(env, &pic_env_ptr(pic, env)->map, pic_id_ptr(pic, id), &ret);
kh_val(&pic_env_ptr(pic, env)->map, it) = pic_sym_ptr(pic, uid);
return uid;
}
static bool
search_scope(pic_state *pic, pic_value id, pic_value env, pic_value *uid)
{
@ -103,6 +73,39 @@ pic_find_identifier(pic_state *pic, pic_value id, pic_value env)
return uid;
}
pic_value
pic_add_identifier(pic_state *pic, pic_value id, pic_value env)
{
const char *name;
pic_value uid, str;
if (search_scope(pic, id, env, &uid)) {
return uid;
}
name = pic_str(pic, pic_id_name(pic, id));
if (pic_env_ptr(pic, env)->up == NULL && pic_sym_p(pic, id)) { /* toplevel & public */
str = pic_strf_value(pic, "~a/%s", pic_obj_value(pic_env_ptr(pic, env)->lib), name);
} else {
str = pic_strf_value(pic, ".%s.%d", name, pic->ucnt++);
}
uid = pic_intern(pic, str);
pic_put_identifier(pic, id, uid, env);
return uid;
}
void
pic_put_identifier(pic_state *pic, pic_value id, pic_value uid, pic_value env)
{
int it, ret;
it = kh_put(env, &pic_env_ptr(pic, env)->map, pic_id_ptr(pic, id), &ret);
kh_val(&pic_env_ptr(pic, env)->map, it) = pic_sym_ptr(pic, uid);
}
/**
* macro expander
@ -238,14 +241,12 @@ expand_lambda(pic_state *pic, pic_value expr, pic_value env)
static pic_value
expand_define(pic_state *pic, pic_value expr, pic_value env, pic_value deferred)
{
pic_value id, uid, val;
pic_value uid, val;
uid = pic_add_identifier(pic, pic_list_ref(pic, expr, 1), env);
shadow_macro(pic, uid);
id = pic_cadr(pic, expr);
if (! search_scope(pic, id, env, &uid)) {
uid = pic_add_identifier(pic, id, env);
} else {
shadow_macro(pic, uid);
}
val = expand(pic, pic_list_ref(pic, expr, 2), env, deferred);
return pic_list(pic, 3, S("define"), uid, val);
@ -255,16 +256,13 @@ static pic_value
expand_defmacro(pic_state *pic, pic_value expr, pic_value env)
{
pic_value pic_compile(pic_state *, pic_value);
pic_value id, uid, val;
pic_value uid, val;
id = pic_cadr(pic, expr);
if (! search_scope(pic, id, env, &uid)) {
uid = pic_add_identifier(pic, id, env);
}
uid = pic_add_identifier(pic, pic_list_ref(pic, expr, 1), env);
val = pic_call(pic, pic_compile(pic, pic_expand(pic, pic_list_ref(pic, expr, 2), env)), 0);
if (! pic_proc_p(pic, val)) {
pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", id);
pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", pic_list_ref(pic, expr, 1));
}
define_macro(pic, uid, val);

12
extlib/benz/state.c
View File

@ -352,18 +352,6 @@ pic_close(pic_state *pic)
/* free all heap objects */
pic_gc(pic);
#if 0
{
/* FIXME */
int i = 0;
struct list_head *list;
for (list = pic->ireps.next; list != &pic->ireps; list = list->next) {
i++;
}
printf("%d\n", i);
}
#endif
/* flush all xfiles */
xfflush(pic, NULL);