add make-registry procedure
This commit is contained in:
parent
b983c77767
commit
44887cdd0c
|
@ -49,3 +49,73 @@ pic_reg_del(pic_state *pic, struct pic_reg *reg, void *key)
|
|||
|
||||
xh_del_ptr(®->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);
|
||||
}
|
||||
|
|
|
@ -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]);
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue