Merge pull request #30 from picrin-scheme/object-dictionary

Object-to-object dictionary

dict.c

@@ -7,35 +7,96 @@
 #include "picrin/cont.h"
 #include "picrin/pair.h"
 
+static int
+xh_value_hash(const void *key, void *data)
+{
+  union { double f; int i; } u;
+  pic_value val = *(pic_value *)key;
+  int hash;
+
+  UNUSED(data);
+
+  switch (pic_vtype(val)) {
+  default:
+    hash = 0;
+    break;
+  case PIC_VTYPE_SYMBOL:
+    hash = pic_sym(val);
+    break;
+  case PIC_VTYPE_FLOAT:
+    u.f = pic_float(val);
+    hash = u.i;
+    break;
+  case PIC_VTYPE_INT:
+    hash = pic_int(val);
+    break;
+  case PIC_VTYPE_HEAP:
+    hash = (int)pic_ptr(val);
+    break;
+  }
+
+  return hash + pic_vtype(val);
+}
+
+static int
+xh_value_equal(const void *key1, const void *key2, void *pic)
+{
+  return pic_equal_p(pic, *(pic_value *)key1, *(pic_value *)key2);
+}
+
+static void
+xh_init_value(pic_state *pic, xhash *x)
+{
+  xh_init_(x, sizeof(pic_value), sizeof(pic_value), xh_value_hash, xh_value_equal, pic);
+}
+
+static inline xh_entry *
+xh_get_value(xhash *x, pic_value key)
+{
+  return xh_get_(x, &key);
+}
+
+static inline xh_entry *
+xh_put_value(xhash *x, pic_value key, void *val)
+{
+  return xh_put_(x, &key, val);
+}
+
+static inline void
+xh_del_value(xhash *x, pic_value key)
+{
+  xh_del_(x, &key);
+}
+
 struct pic_dict *
 pic_make_dict(pic_state *pic)
 {
   struct pic_dict *dict;
 
   dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
-  xh_init_int(&dict->hash, sizeof(pic_value));
+  xh_init_value(pic, &dict->hash);
 
   return dict;
 }
 
 pic_value
-pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_sym key)
+pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_value key)
 {
   xh_entry *e;
 
-  e = xh_get_int(&dict->hash, key);
+  e = xh_get_value(&dict->hash, key);
   if (! e) {
-    pic_errorf(pic, "element not found for a key: ~s", pic_sym_value(key));
+    pic_errorf(pic, "element not found for a key: ~s", key);
   }
   return xh_val(e, pic_value);
 }
 
 void
-pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_sym key, pic_value val)
+pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_value key, pic_value val)
 {
   UNUSED(pic);
 
-  xh_put_int(&dict->hash, key, &val);
+  xh_put_value(&dict->hash, key, &val);
 }
 
 size_t
@@ -47,21 +108,21 @@ pic_dict_size(pic_state *pic, struct pic_dict *dict)
 }
 
 bool
-pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_sym key)
+pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_value key)
 {
   UNUSED(pic);
 
-  return xh_get_int(&dict->hash, key) != NULL;
+  return xh_get_value(&dict->hash, key) != NULL;
 }
 
 void
-pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_sym key)
+pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_value key)
 {
-  if (xh_get_int(&dict->hash, key) == NULL) {
-    pic_errorf(pic, "no slot named ~s found in dictionary", pic_sym_value(key));
+  if (xh_get_value(&dict->hash, key) == NULL) {
+    pic_errorf(pic, "no slot named ~s found in dictionary", key);
   }
 
-  xh_del_int(&dict->hash, key);
+  xh_del_value(&dict->hash, key);
 }
 
 static pic_value
@@ -88,8 +149,7 @@ pic_dict_dictionary(pic_state *pic)
   dict = pic_make_dict(pic);
 
   for (i = 0; i < argc; i += 2) {
-    pic_assert_type(pic, argv[i], sym);
-    pic_dict_set(pic, dict, pic_sym(argv[i]), argv[i+1]);
+    pic_dict_set(pic, dict, argv[i], argv[i+1]);
   }
 
   return pic_obj_value(dict);
@@ -109,9 +169,9 @@ static pic_value
 pic_dict_dictionary_ref(pic_state *pic)
 {
   struct pic_dict *dict;
-  pic_sym key;
+  pic_value key;
 
-  pic_get_args(pic, "dm", &dict, &key);
+  pic_get_args(pic, "do", &dict, &key);
 
   if (pic_dict_has(pic, dict, key)) {
     return pic_values2(pic, pic_dict_ref(pic, dict, key), pic_true_value());
@@ -124,10 +184,9 @@ static pic_value
 pic_dict_dictionary_set(pic_state *pic)
 {
   struct pic_dict *dict;
-  pic_sym key;
-  pic_value val;
+  pic_value key, val;
 
-  pic_get_args(pic, "dmo", &dict, &key, &val);
+  pic_get_args(pic, "doo", &dict, &key, &val);
 
   pic_dict_set(pic, dict, key, val);
 
@@ -138,9 +197,9 @@ static pic_value
 pic_dict_dictionary_del(pic_state *pic)
 {
   struct pic_dict *dict;
-  pic_sym key;
+  pic_value key;
 
-  pic_get_args(pic, "dm", &dict, &key);
+  pic_get_args(pic, "do", &dict, &key);
 
   pic_dict_del(pic, dict, key);
 
@@ -169,7 +228,7 @@ pic_dict_dictionary_map(pic_state *pic)
 
   xh_begin(&it, &dict->hash);
   while (xh_next(&it)) {
-    item = pic_cons(pic, pic_sym_value(xh_key(it.e, pic_sym)), xh_val(it.e, pic_value));
+    item = pic_cons(pic, xh_key(it.e, pic_value), xh_val(it.e, pic_value));
     pic_push(pic, pic_apply1(pic, proc, item), list);
   }
 
@@ -190,7 +249,7 @@ pic_dict_dictionary_for_each(pic_state *pic)
   while (xh_next(&it)) {
     int ai = pic_gc_arena_preserve(pic);
 
-    item = pic_cons(pic, pic_sym_value(xh_key(it.e, pic_sym)), xh_val(it.e, pic_value));
+    item = pic_cons(pic, xh_key(it.e, pic_value), xh_val(it.e, pic_value));
     pic_apply1(pic, proc, item);
 
     pic_gc_arena_restore(pic, ai);
@@ -210,7 +269,7 @@ pic_dict_dictionary_to_alist(pic_state *pic)
 
   xh_begin(&it, &dict->hash);
   while (xh_next(&it)) {
-    item = pic_cons(pic, pic_sym_value(xh_key(it.e, pic_sym)), xh_val(it.e, pic_value));
+    item = pic_cons(pic, xh_key(it.e, pic_value), xh_val(it.e, pic_value));
     pic_push(pic, item, alist);
   }
 
@@ -228,8 +287,7 @@ pic_dict_alist_to_dictionary(pic_state *pic)
   dict = pic_make_dict(pic);
 
   pic_for_each (e, pic_reverse(pic, alist)) {
-    pic_assert_type(pic, pic_car(pic, e), sym);
-    pic_dict_set(pic, dict, pic_sym(pic_car(pic, e)), pic_cdr(pic, e));
+    pic_dict_set(pic, dict, pic_car(pic, e), pic_cdr(pic, e));
   }
 
   return pic_obj_value(dict);
@@ -246,8 +304,8 @@ pic_dict_dictionary_to_plist(pic_state *pic)
 
   xh_begin(&it, &dict->hash);
   while (xh_next(&it)) {
+    pic_push(pic, xh_key(it.e, pic_value), plist);
     pic_push(pic, xh_val(it.e, pic_value), plist);
-    pic_push(pic, pic_sym_value(xh_key(it.e, pic_sym)), plist);
   }
 
   return pic_reverse(pic, plist);
@@ -264,8 +322,7 @@ pic_dict_plist_to_dictionary(pic_state *pic)
   dict = pic_make_dict(pic);
 
   for (e = pic_reverse(pic, plist); ! pic_nil_p(e); e = pic_cddr(pic, e)) {
-    pic_assert_type(pic, pic_car(pic, e), sym);
-    pic_dict_set(pic, dict, pic_sym(pic_car(pic, e)), pic_cadr(pic, e));
+    pic_dict_set(pic, dict, pic_cadr(pic, e), pic_car(pic, e));
   }
 
   return pic_obj_value(dict);

gc.c

@@ -498,6 +498,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
 
     xh_begin(&it, &dict->hash);
     while (xh_next(&it)) {
+      gc_mark(pic, xh_key(it.e, pic_value));
       gc_mark(pic, xh_val(it.e, pic_value));
     }
     break;

include/picrin/dict.h

@@ -19,11 +19,11 @@ struct pic_dict {
 
 struct pic_dict *pic_make_dict(pic_state *);
 
-pic_value pic_dict_ref(pic_state *, struct pic_dict *, pic_sym);
-void pic_dict_set(pic_state *, struct pic_dict *, pic_sym, pic_value);
-void pic_dict_del(pic_state *, struct pic_dict *, pic_sym);
+pic_value pic_dict_ref(pic_state *, struct pic_dict *, pic_value);
+void pic_dict_set(pic_state *, struct pic_dict *, pic_value, pic_value);
+void pic_dict_del(pic_state *, struct pic_dict *, pic_value);
 size_t pic_dict_size(pic_state *, struct pic_dict *);
-bool pic_dict_has(pic_state *, struct pic_dict *, pic_sym);
+bool pic_dict_has(pic_state *, struct pic_dict *, pic_value);
 
 #if defined(__cplusplus)
 }

lib.c

@@ -7,7 +7,6 @@
 #include "picrin/pair.h"
 #include "picrin/macro.h"
 #include "picrin/error.h"
-#include "picrin/dict.h"
 #include "picrin/string.h"
 #include "picrin/proc.h"
 
@@ -65,55 +64,54 @@ pic_find_library(pic_state *pic, pic_value spec)
   return pic_lib_ptr(pic_cdr(pic, v));
 }
 
-static struct pic_dict *
-import_table(pic_state *pic, pic_value spec)
+static void
+import_table(pic_state *pic, pic_value spec, xhash *imports)
 {
   const pic_sym sONLY = pic_intern_cstr(pic, "only");
   const pic_sym sRENAME = pic_intern_cstr(pic, "rename");
   const pic_sym sPREFIX = pic_intern_cstr(pic, "prefix");
   const pic_sym sEXCEPT = pic_intern_cstr(pic, "except");
   struct pic_lib *lib;
-  struct pic_dict *imports, *dict;
-  pic_value val, id;
-  pic_sym sym;
+  xhash table;
+  pic_value val;
+  pic_sym sym, id;
   xh_iter it;
 
-  imports = pic_make_dict(pic);
+  xh_init_int(&table, sizeof(pic_sym));
 
   if (pic_list_p(spec)) {
     if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sONLY))) {
-      dict = import_table(pic, pic_cadr(pic, spec));
+      import_table(pic, pic_cadr(pic, spec), &table);
       pic_for_each (val, pic_cddr(pic, spec)) {
-        pic_dict_set(pic, imports, pic_sym(val), pic_dict_ref(pic, dict, pic_sym(val)));
+        xh_put_int(imports, pic_sym(val), &xh_val(xh_get_int(&table, pic_sym(val)), pic_sym));
       }
-      return imports;
+      goto exit;
     }
     if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME))) {
-      imports = import_table(pic, pic_cadr(pic, spec));
+      import_table(pic, pic_cadr(pic, spec), imports);
       pic_for_each (val, pic_cddr(pic, spec)) {
-        id = pic_dict_ref(pic, imports, pic_sym(pic_car(pic, val)));
-        pic_dict_del(pic, imports, pic_sym(pic_car(pic, val)));
-        pic_dict_set(pic, imports, pic_sym(pic_cadr(pic, val)), id);
+        id = xh_val(xh_get_int(imports, pic_sym(pic_car(pic, val))), pic_sym);
+        xh_del_int(imports, pic_sym(pic_car(pic, val)));
+        xh_put_int(imports, pic_sym(pic_cadr(pic, val)), &id);
       }
-      return imports;
+      goto exit;
     }
     if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sPREFIX))) {
-      dict = import_table(pic, pic_cadr(pic, spec));
-      xh_begin(&it, &dict->hash);
+      import_table(pic, pic_cadr(pic, spec), &table);
+      xh_begin(&it, &table);
       while (xh_next(&it)) {
-        id = pic_sym_value(xh_key(it.e, pic_sym));
         val = pic_list_ref(pic, spec, 2);
-        sym = pic_intern_str(pic, pic_format(pic, "~s~s", val, id));
-        pic_dict_set(pic, imports, sym, xh_val(it.e, pic_value));
+        sym = pic_intern_str(pic, pic_format(pic, "~s~s", val, pic_sym_value(xh_key(it.e, pic_sym))));
+        xh_put_int(imports, sym, &xh_val(it.e, pic_sym));
       }
-      return imports;
+      goto exit;
     }
     if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sEXCEPT))) {
-      imports = import_table(pic, pic_cadr(pic, spec));
+      import_table(pic, pic_cadr(pic, spec), imports);
       pic_for_each (val, pic_cddr(pic, spec)) {
-        pic_dict_del(pic, imports, pic_sym(val));
+        xh_del_int(imports, pic_sym(val));
       }
-      return imports;
+      goto exit;
     }
   }
   lib = pic_find_library(pic, spec);
@@ -122,28 +120,34 @@ import_table(pic_state *pic, pic_value spec)
   }
   xh_begin(&it, &lib->exports);
   while (xh_next(&it)) {
-    pic_dict_set(pic, imports, xh_key(it.e, pic_sym), pic_sym_value(xh_val(it.e, pic_sym)));
+    xh_put_int(imports, xh_key(it.e, pic_sym), &xh_val(it.e, pic_sym));
   }
-  return imports;
+
+ exit:
+  xh_destroy(&table);
 }
 
 static void
 import(pic_state *pic, pic_value spec)
 {
-  struct pic_dict *imports;
+  xhash imports;
   xh_iter it;
 
-  imports = import_table(pic, spec);
+  xh_init_int(&imports, sizeof(pic_sym)); /* pic_sym to pic_sym */
 
-  xh_begin(&it, &imports->hash);
+  import_table(pic, spec, &imports);
+
+  xh_begin(&it, &imports);
   while (xh_next(&it)) {
 
 #if DEBUG
-    printf("* importing %s as %s\n", pic_symbol_name(pic, xh_key(it.e, pic_sym)), pic_symbol_name(pic, pic_sym(xh_val(it.e, pic_value))));
+    printf("* importing %s as %s\n", pic_symbol_name(pic, xh_key(it.e, pic_sym)), pic_symbol_name(pic, xh_val(it.e, pic_sym)));
 #endif
 
-    pic_put_rename(pic, pic->lib->env, xh_key(it.e, pic_sym), pic_sym(xh_val(it.e, pic_value)));
+    pic_put_rename(pic, pic->lib->env, xh_key(it.e, pic_sym), xh_val(it.e, pic_sym));
   }
+
+  xh_destroy(&imports);
 }
 
 static void

proc.c

@@ -61,13 +61,13 @@ pic_attr(pic_state *pic, struct pic_proc *proc)
 pic_value
 pic_attr_ref(pic_state *pic, struct pic_proc *proc, const char *key)
 {
-  return pic_dict_ref(pic, pic_attr(pic, proc), pic_intern_cstr(pic, key));
+  return pic_dict_ref(pic, pic_attr(pic, proc), pic_sym_value(pic_intern_cstr(pic, key)));
 }
 
 void
 pic_attr_set(pic_state *pic, struct pic_proc *proc, const char *key, pic_value v)
 {
-  pic_dict_set(pic, pic_attr(pic, proc), pic_intern_cstr(pic, key), v);
+  pic_dict_set(pic, pic_attr(pic, proc), pic_sym_value(pic_intern_cstr(pic, key)), v);
 }
 
 static pic_value

write.c

@@ -336,7 +336,9 @@ write_core(struct writer_control *p, pic_value obj)
     xfprintf(file, "#.(dictionary");
     xh_begin(&it, &pic_dict_ptr(obj)->hash);
     while (xh_next(&it)) {
-      xfprintf(file, " '%s ", pic_symbol_name(pic, xh_key(it.e, pic_sym)));
+      xfprintf(file, " '");
+      write_core(p, xh_key(it.e, pic_value));
+      xfprintf(file, " '");
       write_core(p, xh_val(it.e, pic_value));
     }
     xfprintf(file, ")");