primary symbol to object hashtable support (dictionary)

src/codegen.c

@@ -825,6 +825,7 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
   case PIC_TT_IREP:
   case PIC_TT_DATA:
   case PIC_TT_BOX:
+  case PIC_TT_DICT:
     pic_errorf(pic, "invalid expression given: ~s", obj);
   }
   UNREACHABLE();

src/dict.c

@@ -0,0 +1,85 @@
+/**
+ * See Copyright Notice in picrin.h
+ */
+
+#include "picrin.h"
+#include "picrin/dict.h"
+
+static pic_value
+pic_dict_dict(pic_state *pic)
+{
+  struct pic_dict *dict;
+
+  pic_get_args(pic, "");
+
+  dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
+
+  xh_init_int(&dict->hash, sizeof(pic_value));
+
+  return pic_obj_value(dict);
+}
+
+static pic_value
+pic_dict_dict_p(pic_state *pic)
+{
+  pic_value obj;
+
+  pic_get_args(pic, "o", &obj);
+
+  return pic_bool_value(pic_dict_p(obj));
+}
+
+static pic_value
+pic_dict_dict_ref(pic_state *pic)
+{
+  struct pic_dict *dict;
+  pic_sym key;
+  xh_entry *e;
+
+  pic_get_args(pic, "dm", &dict, &key);
+
+  e = xh_get_int(&dict->hash, key);
+  if (! e) {
+    return pic_none_value();
+  }
+  return xh_val(e, pic_value);
+}
+
+static pic_value
+pic_dict_dict_set(pic_state *pic)
+{
+  struct pic_dict *dict;
+  pic_sym key;
+  pic_value val;
+
+  pic_get_args(pic, "dmo", &dict, &key, &val);
+
+  xh_put_int(&dict->hash, key, &val);
+
+  return pic_none_value();
+}
+
+static pic_value
+pic_dict_dict_del(pic_state *pic)
+{
+  struct pic_dict *dict;
+  pic_sym key;
+
+  pic_get_args(pic, "dm", &dict, &key);
+
+  xh_del_int(&dict->hash, key);
+
+  return pic_none_value();
+}
+
+void
+pic_init_dict(pic_state *pic)
+{
+  pic_deflibrary ("(picrin dictionary)") {
+    pic_defun(pic, "dictionary", pic_dict_dict);
+    pic_defun(pic, "dictionary?", pic_dict_dict_p);
+    pic_defun(pic, "dictionary-ref", pic_dict_dict_ref);
+    pic_defun(pic, "dictionary-set!", pic_dict_dict_set);
+    pic_defun(pic, "dictionary-delete", pic_dict_dict_del);
+  }
+}

src/gc.c

@@ -20,6 +20,7 @@
 #include "picrin/var.h"
 #include "picrin/data.h"
 #include "picrin/box.h"
+#include "picrin/dict.h"
 
 #if GC_DEBUG
 # include <string.h>
@@ -504,6 +505,16 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     gc_mark(pic, box->value);
     break;
   }
+  case PIC_TT_DICT: {
+    struct pic_dict *dict = (struct pic_dict *)obj;
+    xh_iter it;
+
+    xh_begin(&it, &dict->hash);
+    while (xh_next(&it)) {
+      gc_mark(pic, xh_val(it.e, pic_value));
+    }
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
@@ -657,6 +668,11 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_BOX: {
     break;
   }
+  case PIC_TT_DICT: {
+    struct pic_dict *dict = (struct pic_dict *)obj;
+    xh_destroy(&dict->hash);
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:

src/init.c

@@ -29,6 +29,7 @@ void pic_init_macro(pic_state *);
 void pic_init_var(pic_state *);
 void pic_init_load(pic_state *);
 void pic_init_write(pic_state *);
+void pic_init_dict(pic_state *);
 
 void pic_load_piclib(pic_state *);
 
@@ -93,6 +94,7 @@ pic_init_core(pic_state *pic)
     pic_init_var(pic); DONE;
     pic_init_load(pic); DONE;
     pic_init_write(pic); DONE;
+    pic_init_dict(pic); DONE;
 
     pic_load_piclib(pic); DONE;
 

src/macro.c

@@ -569,6 +569,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_valu
   case PIC_TT_IREP:
   case PIC_TT_DATA:
   case PIC_TT_BOX:
+  case PIC_TT_DICT:
     pic_errorf(pic, "unexpected value type: ~s", expr);
   }
   UNREACHABLE();

src/vm.c

@@ -19,6 +19,7 @@
 #include "picrin/lib.h"
 #include "picrin/macro.h"
 #include "picrin/error.h"
+#include "picrin/dict.h"
 
 #define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
 
@@ -49,6 +50,7 @@ pic_get_proc(pic_state *pic)
  *  c   char
  *  l   lambda object
  *  p   port object
+ *  d   dictionary object
  *
  *  |  optional operator
  *  *  variable length operator
@@ -327,6 +329,23 @@ pic_get_args(pic_state *pic, const char *format, ...)
       }
       break;
     }
+    case 'd': {
+      struct pic_dict **d;
+      pic_value v;
+
+      d = va_arg(ap, struct pic_dict **);
+      if (i < argc) {
+        v = GET_OPERAND(pic,i);
+        if (pic_dict_p(v)) {
+          *d = pic_dict_ptr(v);
+        }
+        else {
+          pic_error(pic, "pic_get_args, expected dictionary");
+        }
+        i++;
+      }
+      break;
+    }
     default:
       pic_error(pic, "pic_get_args: invalid argument specifier given");
     }

src/write.c

@@ -338,6 +338,9 @@ write_core(struct writer_control *p, pic_value obj)
   case PIC_TT_BOX:
     xfprintf(file, "#<box %p>", pic_ptr(obj));
     break;
+  case PIC_TT_DICT:
+    xfprintf(file, "#<dict %p>", pic_ptr(obj));
+    break;
   }
 }