add make-registry procedure

extlib/benz/reg.c

@@ -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);
+}

extlib/benz/state.c

@@ -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]);
   }