From 8d17bf3175f112a576765bf90edb77ad17d2699a Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 22 Feb 2016 23:49:39 +0900 Subject: [PATCH] change pic_add_identifier's behavior --- extlib/benz/eval.c | 6 +- extlib/benz/include/picrin/private/object.h | 2 +- extlib/benz/macro.c | 84 ++++++++++----------- extlib/benz/state.c | 12 --- 4 files changed, 45 insertions(+), 59 deletions(-) diff --git a/extlib/benz/eval.c b/extlib/benz/eval.c index 1717ae36..7b648909 100644 --- a/extlib/benz/eval.c +++ b/extlib/benz/eval.c @@ -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; } diff --git a/extlib/benz/include/picrin/private/object.h b/extlib/benz/include/picrin/private/object.h index 64b1d6d9..128a5fd2 100644 --- a/extlib/benz/include/picrin/private/object.h +++ b/extlib/benz/include/picrin/private/object.h @@ -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); diff --git a/extlib/benz/macro.c b/extlib/benz/macro.c index f1372bef..e0ce2185 100644 --- a/extlib/benz/macro.c +++ b/extlib/benz/macro.c @@ -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); diff --git a/extlib/benz/state.c b/extlib/benz/state.c index 5f4c5adb..373412b8 100644 --- a/extlib/benz/state.c +++ b/extlib/benz/state.c @@ -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);