intern symbols using hash table

include/picconf.h

@@ -13,6 +13,7 @@
 #define PIC_STACK_SIZE 1024
 #define PIC_IREP_SIZE 256
 #define PIC_GLOBALS_SIZE 1024
+#define PIC_SYM_TBL_SIZE 128
 
 /* enable all debug flags */
 #define DEBUG 1

include/picrin.h

@@ -27,6 +27,8 @@ typedef struct {
   pic_value sADD, sSUB, sMUL, sDIV;
   struct pic_env *global_env;
 
+  struct sym_tbl *sym_tbl;
+
   pic_value *globals;
   size_t glen, gcapa;
   struct pic_irep **irep;

include/picrin/symbol.h

@@ -0,0 +1,12 @@
+#ifndef SYMBOL_H__
+#define SYMBOL_H__
+
+struct sym_tbl {
+  pic_value tbl[PIC_SYM_TBL_SIZE];
+  size_t size;
+};
+
+struct sym_tbl * sym_tbl_new();
+pic_value sym_tbl_get(struct sym_tbl *, const char *);
+
+#endif

src/state.c

@@ -3,9 +3,10 @@
 #include "picrin.h"
 #include "picrin/gc.h"
 #include "picrin/proc.h"
+#include "picrin/symbol.h"
 
 static struct pic_env *
-pic_new_empty_env()
+new_empty_env()
 {
   struct pic_env *env;
 
@@ -37,6 +38,9 @@ pic_open()
   pic->heap = (struct heap_page *)malloc(sizeof(struct heap_page));
   init_heap_page(pic->heap);
 
+  /* symbol table */
+  pic->sym_tbl = sym_tbl_new();
+
   /* irep */
   pic->irep = (struct pic_irep **)malloc(sizeof(struct pic_irep *) * PIC_IREP_SIZE);
   pic->ilen = 0;
@@ -64,7 +68,7 @@ pic_open()
   pic->sDIV = pic_intern_cstr(pic, "/");
 
   /* global environment */
-  pic->global_env = pic_new_empty_env();
+  pic->global_env = new_empty_env();
   pic_init_core(pic);
 
   return pic;

src/symbol.c

@@ -2,19 +2,80 @@
 #include <stdlib.h>
 
 #include "picrin.h"
+#include "picrin/pair.h"
+#include "picrin/symbol.h"
+
+static int
+str_hash(const char *str)
+{
+  int hash = 0, len, i;
+
+  len = strlen(str);
+  for (i = 0; i < len; ++i) {
+    hash = hash * 31 + str[i];
+  }
+  return hash;
+}
+
+struct sym_tbl *
+sym_tbl_new()
+{
+  struct sym_tbl *s_tbl;
+  int i;
+
+  s_tbl = (struct sym_tbl *)malloc(sizeof(struct sym_tbl));
+  s_tbl->size = PIC_SYM_TBL_SIZE;
+
+  for (i = 0; i < PIC_SYM_TBL_SIZE; ++i) {
+    s_tbl->tbl[i] = pic_nil_value();
+  }
+  return s_tbl;
+}
 
 pic_value
-pic_intern_cstr(pic_state *pic, const char *name)
+sym_tbl_get(struct sym_tbl *s_tbl, const char *key)
 {
-  struct pic_symbol *sym;
+  int hash, idx;
-  size_t len;
+  pic_value v, k;
+  char *name;
 
-  sym = (struct pic_symbol*)pic_obj_alloc(pic, sizeof(struct pic_symbol), PIC_TT_SYMBOL);
+  hash = str_hash(key);
+  idx = hash % s_tbl->size;
+  for (v = s_tbl->tbl[idx]; ! pic_nil_p(v); v = pic_pair_ptr(v)->cdr) {
+    k = pic_pair_ptr(v)->car;
+
+    name = pic_symbol_ptr(k)->name;
+    if (strcmp(name, key) == 0) {
+      return k;
+    }
+  }
+  return pic_undef_value();
+}
+
+pic_value
+pic_intern_cstr(pic_state *pic, const char *str)
+{
+  pic_value v;
+  int len, hash, idx;
+  char *new_str;
+  struct pic_symbol *sym;
+
+  v = sym_tbl_get(pic->sym_tbl, str);
+  if (! pic_undef_p(v)) {
+    return v;
+  }
 
   /* clone name string */
-  len = strlen(name);
+  len = strlen(str);
-  sym->name = (char *)pic_alloc(pic, len + 1);
+  new_str = (char *)pic_alloc(pic, len + 1);
-  strncpy(sym->name, name, len + 1);
+  strncpy(new_str, str, len + 1);
 
-  return pic_obj_value(sym);
+  sym = (struct pic_symbol*)pic_obj_alloc(pic, sizeof(struct pic_symbol), PIC_TT_SYMBOL);
+  sym->name = new_str;
+  v = pic_obj_value(sym);
+
+  hash = str_hash(str);
+  idx = hash % pic->sym_tbl->size;
+  pic->sym_tbl->tbl[idx] = pic_cons(pic, v, pic->sym_tbl->tbl[idx]);
+  return v;
 }