add make-registry procedure

This commit is contained in:
Yuichi Nishiwaki 2015-06-09 18:50:46 +09:00
parent b983c77767
commit 44887cdd0c
2 changed files with 72 additions and 0 deletions

View File

@ -49,3 +49,73 @@ pic_reg_del(pic_state *pic, struct pic_reg *reg, void *key)
xh_del_ptr(&reg->hash, key);
}
static pic_value
reg_get(pic_state *pic, struct pic_reg *reg, void *key)
{
if (! pic_reg_has(pic, reg, key)) {
return pic_undef_value();
}
return pic_reg_ref(pic, reg, key);
}
static pic_value
reg_set(pic_state *pic, struct pic_reg *reg, void *key, pic_value val)
{
if (pic_undef_p(val)) {
if (pic_reg_has(pic, reg, key)) {
pic_reg_del(pic, reg, key);
}
} else {
pic_reg_set(pic, reg, key, val);
}
return pic_undef_value();
}
static pic_value
reg_call(pic_state *pic)
{
struct pic_proc *self = pic_get_proc(pic);
struct pic_reg *reg;
pic_value key, val;
int n;
n = pic_get_args(pic, "o|o", &key, &val);
if (! pic_obj_p(key)) {
pic_errorf(pic, "attempted to set a non-object key '~s' in a registory", key);
}
reg = pic_reg_ptr(pic_proc_env_ref(pic, self, "reg"));
if (n == 1) {
return reg_get(pic, reg, pic_obj_ptr(key));
} else {
return reg_set(pic, reg, pic_obj_ptr(key), val);
}
}
static pic_value
pic_reg_make_registry(pic_state *pic)
{
struct pic_reg *reg;
struct pic_proc *proc;
pic_get_args(pic, "");
reg = pic_make_reg(pic);
proc = pic_make_proc(pic, reg_call, "<reg-call>");
pic_proc_env_set(pic, proc, "reg", pic_obj_value(reg));
return pic_obj_value(proc);
}
void
pic_init_reg(pic_state *pic)
{
pic_defun(pic, "make-registry", pic_reg_make_registry);
}

View File

@ -32,6 +32,7 @@ void pic_init_record(pic_state *);
void pic_init_eval(pic_state *);
void pic_init_lib(pic_state *);
void pic_init_attr(pic_state *);
void pic_init_reg(pic_state *);
extern const char pic_boot[][80];
@ -130,6 +131,7 @@ pic_init_core(pic_state *pic)
pic_init_eval(pic); DONE;
pic_init_lib(pic); DONE;
pic_init_attr(pic); DONE;
pic_init_reg(pic); DONE;
pic_load_cstr(pic, &pic_boot[0][0]);
}