pic_id * -> pic_value

This commit is contained in:
Yuichi Nishiwaki 2016-02-20 15:59:06 +09:00
parent c57655c7ac
commit fc37af43b5
8 changed files with 64 additions and 65 deletions

View File

@ -97,11 +97,11 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
pic_id *id1, *id2; pic_id *id1, *id2;
pic_value s1, s2; pic_value s1, s2;
id1 = pic_id_ptr(x); id1 = pic_id_ptr(pic, x);
id2 = pic_id_ptr(y); id2 = pic_id_ptr(pic, y);
s1 = pic_find_identifier(pic, id1->u.id, id1->env); s1 = pic_find_identifier(pic, pic_obj_value(id1->u.id), id1->env);
s2 = pic_find_identifier(pic, id2->u.id, id2->env); s2 = pic_find_identifier(pic, pic_obj_value(id2->u.id), id2->env);
return pic_eq_p(pic, s1, s2); return pic_eq_p(pic, s1, s2);
} }

View File

@ -115,6 +115,7 @@ struct pic_port {
xFILE *file; xFILE *file;
}; };
#define pic_id_ptr(pic, o) ((pic_id *)pic_obj_ptr(o))
#define pic_sym_ptr(pic, o) ((pic_sym *)pic_obj_ptr(o)) #define pic_sym_ptr(pic, o) ((pic_sym *)pic_obj_ptr(o))
#define pic_str_ptr(pic, o) ((struct pic_string *)pic_obj_ptr(o)) #define pic_str_ptr(pic, o) ((struct pic_string *)pic_obj_ptr(o))
#define pic_blob_ptr(pic, o) ((struct pic_blob *)pic_obj_ptr(o)) #define pic_blob_ptr(pic, o) ((struct pic_blob *)pic_obj_ptr(o))
@ -124,7 +125,6 @@ struct pic_port {
#define pic_weak_ptr(pic, o) ((struct pic_weak *)pic_obj_ptr(o)) #define pic_weak_ptr(pic, o) ((struct pic_weak *)pic_obj_ptr(o))
#define pic_data_ptr(pic, o) ((struct pic_data *)pic_obj_ptr(o)) #define pic_data_ptr(pic, o) ((struct pic_data *)pic_obj_ptr(o))
#define pic_proc_ptr(pic, o) ((struct pic_proc *)pic_obj_ptr(o)) #define pic_proc_ptr(pic, o) ((struct pic_proc *)pic_obj_ptr(o))
#define pic_id_ptr(v) ((pic_id *)pic_obj_ptr(v))
#define pic_context_ptr(o) ((struct pic_context *)pic_obj_ptr(o)) #define pic_context_ptr(o) ((struct pic_context *)pic_obj_ptr(o))
#define pic_rec_ptr(v) ((struct pic_record *)pic_obj_ptr(v)) #define pic_rec_ptr(v) ((struct pic_record *)pic_obj_ptr(v))
#define pic_error_ptr(v) ((struct pic_error *)pic_obj_ptr(v)) #define pic_error_ptr(v) ((struct pic_error *)pic_obj_ptr(v))
@ -151,17 +151,17 @@ struct pic_object *pic_obj_alloc(pic_state *, size_t, int type);
if (tolen - at < e - s) pic_errorf(pic, "invalid range"); \ if (tolen - at < e - s) pic_errorf(pic, "invalid range"); \
} while (0) } while (0)
pic_id *pic_make_identifier(pic_state *, pic_id *, struct pic_env *); pic_value pic_make_identifier(pic_state *, pic_value id, struct pic_env *);
pic_value pic_make_proc(pic_state *, pic_func_t, int, pic_value *); pic_value pic_make_proc(pic_state *, pic_func_t, int, pic_value *);
pic_value pic_make_proc_irep(pic_state *, struct pic_irep *, struct pic_context *); pic_value pic_make_proc_irep(pic_state *, struct pic_irep *, struct pic_context *);
struct pic_record *pic_make_rec(pic_state *, pic_value, pic_value); struct pic_record *pic_make_rec(pic_state *, pic_value, pic_value);
struct pic_error *pic_make_error(pic_state *, const char *, const char *, pic_value); struct pic_error *pic_make_error(pic_state *, const char *, const char *, pic_value);
struct pic_env *pic_make_env(pic_state *, struct pic_env *); struct pic_env *pic_make_env(pic_state *, struct pic_env *);
pic_value pic_add_identifier(pic_state *, pic_id *, struct pic_env *); pic_value pic_add_identifier(pic_state *, pic_value id, struct pic_env *);
pic_value pic_put_identifier(pic_state *, pic_id *, pic_value uid, struct pic_env *); pic_value pic_put_identifier(pic_state *, pic_value id, pic_value uid, struct pic_env *);
pic_value pic_find_identifier(pic_state *, pic_id *, struct pic_env *); pic_value pic_find_identifier(pic_state *, pic_value id, struct pic_env *);
pic_value pic_id_name(pic_state *, pic_id *); pic_value pic_id_name(pic_state *, pic_value id);
void pic_rope_incref(pic_state *, struct pic_rope *); void pic_rope_incref(pic_state *, struct pic_rope *);
void pic_rope_decref(pic_state *, struct pic_rope *); void pic_rope_decref(pic_state *, struct pic_rope *);

View File

@ -42,10 +42,10 @@ make_library_env(pic_state *pic, pic_value name)
kh_init(env, &env->map); kh_init(env, &env->map);
/* set up default environment */ /* set up default environment */
pic_put_identifier(pic, pic_id_ptr(pic->sDEFINE_LIBRARY), pic->sDEFINE_LIBRARY, env); pic_put_identifier(pic, pic->sDEFINE_LIBRARY, pic->sDEFINE_LIBRARY, env);
pic_put_identifier(pic, pic_id_ptr(pic->sIMPORT), pic->sIMPORT, env); pic_put_identifier(pic, pic->sIMPORT, pic->sIMPORT, env);
pic_put_identifier(pic, pic_id_ptr(pic->sEXPORT), pic->sEXPORT, env); pic_put_identifier(pic, pic->sEXPORT, pic->sEXPORT, env);
pic_put_identifier(pic, pic_id_ptr(pic->sCOND_EXPAND), pic->sCOND_EXPAND, env); pic_put_identifier(pic, pic->sCOND_EXPAND, pic->sCOND_EXPAND, env);
return env; return env;
} }
@ -116,11 +116,11 @@ pic_import(pic_state *pic, const char *lib)
libp = get_library(pic, lib); libp = get_library(pic, lib);
while (pic_dict_next(pic, pic_obj_value(libp->exports), &it, &name, &realname)) { while (pic_dict_next(pic, pic_obj_value(libp->exports), &it, &name, &realname)) {
uid = pic_find_identifier(pic, pic_id_ptr(realname), libp->env); uid = pic_find_identifier(pic, realname, libp->env);
if (! pic_weak_has(pic, pic->globals, uid) && ! pic_weak_has(pic, pic->macros, uid)) { if (! pic_weak_has(pic, pic->globals, uid) && ! pic_weak_has(pic, pic->macros, uid)) {
pic_errorf(pic, "attempted to export undefined variable '~s'", realname); pic_errorf(pic, "attempted to export undefined variable '~s'", realname);
} }
pic_put_identifier(pic, pic_id_ptr(name), uid, pic->lib->env); pic_put_identifier(pic, name, uid, pic->lib->env);
} }
} }
@ -192,12 +192,12 @@ pic_lib_library_import(pic_state *pic)
realname = pic_dict_ref(pic, pic_obj_value(libp->exports), name); realname = pic_dict_ref(pic, pic_obj_value(libp->exports), name);
} }
uid = pic_find_identifier(pic, pic_id_ptr(realname), libp->env); uid = pic_find_identifier(pic, realname, libp->env);
if (! pic_weak_has(pic, pic->globals, uid) && ! pic_weak_has(pic, pic->macros, uid)) { if (! pic_weak_has(pic, pic->globals, uid) && ! pic_weak_has(pic, pic->macros, uid)) {
pic_errorf(pic, "attempted to export undefined variable '~s'", realname); pic_errorf(pic, "attempted to export undefined variable '~s'", realname);
} }
pic_put_identifier(pic, pic_id_ptr(alias), uid, pic->lib->env); pic_put_identifier(pic, alias, uid, pic->lib->env);
return pic_undef_value(pic); return pic_undef_value(pic);
} }

View File

@ -22,14 +22,14 @@ pic_make_env(pic_state *pic, struct pic_env *up)
} }
pic_value pic_value
pic_add_identifier(pic_state *pic, pic_id *id, struct pic_env *env) pic_add_identifier(pic_state *pic, pic_value id, struct pic_env *env)
{ {
const char *name; const char *name;
pic_value uid, str; pic_value uid, str;
name = pic_str(pic, pic_id_name(pic, id)); name = pic_str(pic, pic_id_name(pic, id));
if (env->up == NULL && pic_sym_p(pic, pic_obj_value(id))) { /* toplevel & public */ if (env->up == NULL && pic_sym_p(pic, id)) { /* toplevel & public */
str = pic_strf_value(pic, "%s/%s", pic_str(pic, pic_obj_value(env->lib)), name); str = pic_strf_value(pic, "%s/%s", pic_str(pic, pic_obj_value(env->lib)), name);
} else { } else {
str = pic_strf_value(pic, ".%s.%d", name, pic->ucnt++); str = pic_strf_value(pic, ".%s.%d", name, pic->ucnt++);
@ -40,23 +40,23 @@ pic_add_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
} }
pic_value pic_value
pic_put_identifier(pic_state *pic, pic_id *id, pic_value uid, struct pic_env *env) pic_put_identifier(pic_state *pic, pic_value id, pic_value uid, struct pic_env *env)
{ {
khiter_t it; khiter_t it;
int ret; int ret;
it = kh_put(env, &env->map, id, &ret); it = kh_put(env, &env->map, pic_id_ptr(pic, id), &ret);
kh_val(&env->map, it) = pic_sym_ptr(pic, uid); kh_val(&env->map, it) = pic_sym_ptr(pic, uid);
return uid; return uid;
} }
static bool static bool
search_scope(pic_state *pic, pic_id *id, struct pic_env *env, pic_value *uid) search_scope(pic_state *pic, pic_value id, struct pic_env *env, pic_value *uid)
{ {
khiter_t it; khiter_t it;
it = kh_get(env, &env->map, id); it = kh_get(env, &env->map, pic_id_ptr(pic, id));
if (it == kh_end(&env->map)) { if (it == kh_end(&env->map)) {
return false; return false;
} }
@ -65,7 +65,7 @@ search_scope(pic_state *pic, pic_id *id, struct pic_env *env, pic_value *uid)
} }
static bool static bool
search(pic_state *pic, pic_id *id, struct pic_env *env, pic_value *uid) search(pic_state *pic, pic_value id, struct pic_env *env, pic_value *uid)
{ {
while (env != NULL) { while (env != NULL) {
if (search_scope(pic, id, env, uid)) { if (search_scope(pic, id, env, uid)) {
@ -77,19 +77,19 @@ search(pic_state *pic, pic_id *id, struct pic_env *env, pic_value *uid)
} }
pic_value pic_value
pic_find_identifier(pic_state *pic, pic_id *id, struct pic_env *env) pic_find_identifier(pic_state *pic, pic_value id, struct pic_env *env)
{ {
pic_value uid; pic_value uid;
while (! search(pic, id, env, &uid)) { while (! search(pic, id, env, &uid)) {
if (pic_sym_p(pic, pic_obj_value(id))) { if (pic_sym_p(pic, id)) {
while (env->up != NULL) { while (env->up != NULL) {
env = env->up; env = env->up;
} }
return pic_add_identifier(pic, id, env); return pic_add_identifier(pic, id, env);
} }
env = id->env; /* do not overwrite id first */ env = pic_id_ptr(pic, id)->env; /* do not overwrite id first */
id = id->u.id; id = pic_obj_value(pic_id_ptr(pic, id)->u.id);
} }
return uid; return uid;
} }
@ -131,14 +131,14 @@ static pic_value expand(pic_state *, pic_value, struct pic_env *, pic_value);
static pic_value expand_lambda(pic_state *, pic_value, struct pic_env *); static pic_value expand_lambda(pic_state *, pic_value, struct pic_env *);
static pic_value static pic_value
expand_var(pic_state *pic, pic_id *id, struct pic_env *env, pic_value deferred) expand_var(pic_state *pic, pic_value id, struct pic_env *env, pic_value deferred)
{ {
pic_value mac, functor; pic_value mac, functor;
functor = pic_find_identifier(pic, id, env); functor = pic_find_identifier(pic, id, env);
if (find_macro(pic, functor, &mac)) { if (find_macro(pic, functor, &mac)) {
return expand(pic, pic_call(pic, mac, 2, pic_obj_value(id), pic_obj_value(env)), env, deferred); return expand(pic, pic_call(pic, mac, 2, id, pic_obj_value(env)), env, deferred);
} }
return functor; return functor;
} }
@ -207,10 +207,10 @@ expand_lambda(pic_state *pic, pic_value expr, struct pic_env *env)
in = pic_make_env(pic, env); in = pic_make_env(pic, env);
for (a = pic_cadr(pic, expr); pic_pair_p(pic, a); a = pic_cdr(pic, a)) { for (a = pic_cadr(pic, expr); pic_pair_p(pic, a); a = pic_cdr(pic, a)) {
pic_add_identifier(pic, pic_id_ptr(pic_car(pic, a)), in); pic_add_identifier(pic, pic_car(pic, a), in);
} }
if (pic_id_p(pic, a)) { if (pic_id_p(pic, a)) {
pic_add_identifier(pic, pic_id_ptr(a), in); pic_add_identifier(pic, a, in);
} }
deferred = pic_list(pic, 1, pic_nil_value(pic)); deferred = pic_list(pic, 1, pic_nil_value(pic));
@ -226,10 +226,9 @@ expand_lambda(pic_state *pic, pic_value expr, struct pic_env *env)
static pic_value static pic_value
expand_define(pic_state *pic, pic_value expr, struct pic_env *env, pic_value deferred) expand_define(pic_state *pic, pic_value expr, struct pic_env *env, pic_value deferred)
{ {
pic_value uid, val; pic_value id, uid, val;
pic_id *id;
id = pic_id_ptr(pic_cadr(pic, expr)); id = pic_cadr(pic, expr);
if (! search_scope(pic, id, env, &uid)) { if (! search_scope(pic, id, env, &uid)) {
uid = pic_add_identifier(pic, id, env); uid = pic_add_identifier(pic, id, env);
} else { } else {
@ -244,10 +243,9 @@ static pic_value
expand_defmacro(pic_state *pic, pic_value expr, struct pic_env *env) expand_defmacro(pic_state *pic, pic_value expr, struct pic_env *env)
{ {
pic_value pic_compile(pic_state *, pic_value); pic_value pic_compile(pic_state *, pic_value);
pic_id *id; pic_value id, uid, val;
pic_value uid, val;
id = pic_id_ptr(pic_cadr(pic, expr)); id = pic_cadr(pic, expr);
if (! search_scope(pic, id, env, &uid)) { if (! search_scope(pic, id, env, &uid)) {
uid = pic_add_identifier(pic, id, env); uid = pic_add_identifier(pic, id, env);
} }
@ -268,7 +266,7 @@ expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value defer
switch (pic_type(pic, expr)) { switch (pic_type(pic, expr)) {
case PIC_TYPE_ID: case PIC_TYPE_ID:
case PIC_TYPE_SYMBOL: { case PIC_TYPE_SYMBOL: {
return expand_var(pic, pic_id_ptr(expr), env, deferred); return expand_var(pic, expr, env, deferred);
} }
case PIC_TYPE_PAIR: { case PIC_TYPE_PAIR: {
pic_value mac; pic_value mac;
@ -280,7 +278,7 @@ expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value defer
if (pic_id_p(pic, pic_car(pic, expr))) { if (pic_id_p(pic, pic_car(pic, expr))) {
pic_value functor; pic_value functor;
functor = pic_find_identifier(pic, pic_id_ptr(pic_car(pic, expr)), env); functor = pic_find_identifier(pic, pic_car(pic, expr), env);
if (pic_eq_p(pic, functor, pic->sDEFINE_MACRO)) { if (pic_eq_p(pic, functor, pic->sDEFINE_MACRO)) {
return expand_defmacro(pic, expr, env); return expand_defmacro(pic, expr, env);

View File

@ -897,7 +897,7 @@ pic_define(pic_state *pic, const char *lib, const char *name, pic_value val)
env = pic_library_environment(pic, lib); env = pic_library_environment(pic, lib);
uid = pic_find_identifier(pic, pic_id_ptr(sym), env); uid = pic_find_identifier(pic, sym, env);
if (pic_weak_has(pic, pic->globals, uid)) { if (pic_weak_has(pic, pic->globals, uid)) {
pic_warnf(pic, "redefining variable: ~s", uid); pic_warnf(pic, "redefining variable: ~s", uid);
} }
@ -914,7 +914,7 @@ pic_ref(pic_state *pic, const char *lib, const char *name)
env = pic_library_environment(pic, lib); env = pic_library_environment(pic, lib);
uid = pic_find_identifier(pic, pic_id_ptr(sym), env); uid = pic_find_identifier(pic, sym, env);
if (! pic_weak_has(pic, pic->globals, uid)) { if (! pic_weak_has(pic, pic->globals, uid)) {
pic_errorf(pic, "symbol \"%s\" not defined in library %s", name, lib); pic_errorf(pic, "symbol \"%s\" not defined in library %s", name, lib);
} }
@ -932,7 +932,7 @@ pic_set(pic_state *pic, const char *lib, const char *name, pic_value val)
env = pic_library_environment(pic, lib); env = pic_library_environment(pic, lib);
uid = pic_find_identifier(pic, pic_id_ptr(sym), env); uid = pic_find_identifier(pic, sym, env);
if (! pic_weak_has(pic, pic->globals, uid)) { if (! pic_weak_has(pic, pic->globals, uid)) {
pic_errorf(pic, "symbol \"%s\" not defined in library %s", name, lib); pic_errorf(pic, "symbol \"%s\" not defined in library %s", name, lib);
} }

View File

@ -77,17 +77,17 @@ pic_features(pic_state *pic)
return pic->features; return pic->features;
} }
#define import_builtin_syntax(name) do { \ #define import_builtin_syntax(name) do { \
pic_value nick, real; \ pic_value nick, real; \
nick = pic_intern_lit(pic, "builtin:" name); \ nick = pic_intern_lit(pic, "builtin:" name); \
real = pic_intern_lit(pic, name); \ real = pic_intern_lit(pic, name); \
pic_put_identifier(pic, pic_id_ptr(nick), real, pic->lib->env); \ pic_put_identifier(pic, nick, real, pic->lib->env); \
} while (0) } while (0)
#define declare_vm_procedure(name) do { \ #define declare_vm_procedure(name) do { \
pic_value sym; \ pic_value sym; \
sym = pic_intern_lit(pic, name); \ sym = pic_intern_lit(pic, name); \
pic_put_identifier(pic, pic_id_ptr(sym), sym, pic->lib->env); \ pic_put_identifier(pic, sym, sym, pic->lib->env); \
} while (0) } while (0)
void pic_init_bool(pic_state *); void pic_init_bool(pic_state *);

View File

@ -34,15 +34,16 @@ pic_intern(pic_state *pic, pic_value str)
return pic_obj_value(sym); return pic_obj_value(sym);
} }
pic_id * pic_value
pic_make_identifier(pic_state *pic, pic_id *id, struct pic_env *env) pic_make_identifier(pic_state *pic, pic_value id, struct pic_env *env)
{ {
pic_id *nid; pic_id *nid;
nid = (pic_id *)pic_obj_alloc(pic, sizeof(pic_id), PIC_TYPE_ID); nid = (pic_id *)pic_obj_alloc(pic, sizeof(pic_id), PIC_TYPE_ID);
nid->u.id = id; nid->u.id = pic_id_ptr(pic, id);
nid->env = env; nid->env = env;
return nid;
return pic_obj_value(nid);
} }
pic_value pic_value
@ -52,13 +53,13 @@ pic_sym_name(pic_state PIC_UNUSED(*pic), pic_value sym)
} }
pic_value pic_value
pic_id_name(pic_state *pic, pic_id *id) pic_id_name(pic_state *pic, pic_value id)
{ {
while (! pic_sym_p(pic, pic_obj_value(id))) { while (! pic_sym_p(pic, id)) {
id = id->u.id; id = pic_obj_value(pic_id_ptr(pic, id)->u.id);
} }
return pic_sym_name(pic, pic_obj_value(id)); return pic_sym_name(pic, id);
} }
static pic_value static pic_value
@ -130,7 +131,7 @@ pic_symbol_make_identifier(pic_state *pic)
pic_assert_type(pic, id, id); pic_assert_type(pic, id, id);
pic_assert_type(pic, env, env); pic_assert_type(pic, env, env);
return pic_obj_value(pic_make_identifier(pic, pic_id_ptr(id), pic_env_ptr(env))); return pic_make_identifier(pic, id, pic_env_ptr(env));
} }
static pic_value static pic_value
@ -146,7 +147,7 @@ pic_symbol_identifier_variable(pic_state *pic)
pic_errorf(pic, "expected non-symbol identifier, but got symbol ~s", id); pic_errorf(pic, "expected non-symbol identifier, but got symbol ~s", id);
} }
return pic_obj_value(pic_id_ptr(id)->u.id); return pic_obj_value(pic_id_ptr(pic, id)->u.id);
} }
static pic_value static pic_value
@ -162,7 +163,7 @@ pic_symbol_identifier_environment(pic_state *pic)
pic_errorf(pic, "expected non-symbol identifier, but got symbol ~s", id); pic_errorf(pic, "expected non-symbol identifier, but got symbol ~s", id);
} }
return pic_obj_value(pic_id_ptr(id)->env); return pic_obj_value(pic_id_ptr(pic, id)->env);
} }
static pic_value static pic_value

View File

@ -290,7 +290,7 @@ write_core(struct writer_control *p, pic_value obj)
xfprintf(pic, file, "#f"); xfprintf(pic, file, "#f");
break; break;
case PIC_TYPE_ID: case PIC_TYPE_ID:
xfprintf(pic, file, "#<identifier %s>", pic_str(pic, pic_id_name(pic, pic_id_ptr(obj)))); xfprintf(pic, file, "#<identifier %s>", pic_str(pic, pic_id_name(pic, obj)));
break; break;
case PIC_TYPE_EOF: case PIC_TYPE_EOF:
xfprintf(pic, file, "#.(eof-object)"); xfprintf(pic, file, "#.(eof-object)");