Reader

src/hashtable.c

@@ -0,0 +1,129 @@
+#include "hashtable.h"
+
+#define INITIAL_SIZE     32
+#define GROWTH_THRESHOLD 0.5
+#define GROWTH_FACTOR    2
+
+static ALWAYS_INLINE bool BUCKET_EMPTY_P(struct HashTableBucket *b) {
+    return !b->key;
+}
+
+static ALWAYS_INLINE float TABLE_LOAD(LispHashTable *ht) {
+    return ((float) ht->count) / ht->size;
+}
+
+DEFUN(make_hash_table, "make-hash-table", (LispVal * hash_fn, LispVal *eq_fn),
+      "(hash-fn eq-fn)", "") {
+    LispHashTable *obj =
+        lisp_alloc_object(sizeof(LispHashTable), TYPE_HASH_TABLE);
+    obj->eq_fn = eq_fn;
+    obj->hash_fn = hash_fn;
+    obj->count = 0;
+    obj->size = INITIAL_SIZE;
+    obj->data = lisp_malloc0(sizeof(struct HashTableBucket) * obj->size);
+    return obj;
+}
+
+static uintptr_t hash_key_for_table(LispHashTable *ht, LispVal *key) {
+    if (NILP(ht->hash_fn)) {
+        return (uintptr_t) key;
+    }
+    // TODO change
+    abort();
+}
+
+static bool compare_keys(LispHashTable *ht, LispVal *key1, LispVal *key2) {
+    if (NILP(ht->eq_fn)) {
+        return key1 == key2;
+    }
+    // TODO change
+    abort();
+}
+
+static struct HashTableBucket *
+find_bucket_for_key(LispHashTable *ht, LispVal *key, uintptr_t hash) {
+    assert(TABLE_LOAD(ht) < 0.95f);
+    for (uintptr_t i = hash % ht->size; true; i = (i + 1) % ht->size) {
+        struct HashTableBucket *cb = &ht->data[i];
+        if (BUCKET_EMPTY_P(cb)
+            || (cb->hash == hash && compare_keys(ht, key, cb->key))) {
+            return cb;
+        }
+    }
+}
+
+static void rehash(LispHashTable *ht, size_t new_size) {
+    struct HashTableBucket *old_data = ht->data;
+    size_t old_size = ht->size;
+    ht->size = new_size;
+    ht->data = lisp_malloc0(sizeof(struct HashTableBucket) * new_size);
+    for (size_t i = 0; i < old_size; ++i) {
+        struct HashTableBucket *cob = &old_data[i];
+        if (!BUCKET_EMPTY_P(cob)) {
+            struct HashTableBucket *nb =
+                find_bucket_for_key(ht, cob->key, cob->hash);
+            nb->hash = cob->hash;
+            nb->key = cob->key;
+            nb->value = cob->value;
+        }
+    }
+}
+
+static void maybe_rehash(LispHashTable *ht) {
+    if (TABLE_LOAD(ht) > GROWTH_THRESHOLD) {
+        rehash(ht, ht->size * GROWTH_FACTOR);
+    }
+}
+
+// TODO type checking
+DEFUN(gethash, "gethash", (LispVal * ht, LispVal *key, LispVal *def),
+      "(ht key &optional def)", "") {
+    uintptr_t hash = hash_key_for_table(ht, key);
+    struct HashTableBucket *b = find_bucket_for_key(ht, key, hash);
+    return BUCKET_EMPTY_P(b) ? def : b->value;
+}
+
+DEFUN(puthash, "puthash", (LispVal * ht, LispVal *key, LispVal *val),
+      "(ht key val)", "") {
+    maybe_rehash(ht);
+    uintptr_t hash = hash_key_for_table(ht, key);
+    struct HashTableBucket *b = find_bucket_for_key(ht, key, hash);
+    if (BUCKET_EMPTY_P(b)) {
+        b->hash = hash;
+        b->key = key;
+    }
+    b->value = val;
+    ++((LispHashTable *) ht)->count;
+    return Qnil;
+}
+
+DEFUN(remhash, "remhash", (LispVal * ht, LispVal *key), "(ht key)", "") {
+    uintptr_t hash = hash_key_for_table(ht, key);
+    struct HashTableBucket *b = find_bucket_for_key(ht, key, hash);
+    if (BUCKET_EMPTY_P(b)) {
+        return Qnil;
+    }
+    b->key = NULL;
+    b->value = NULL; // just because
+    LispHashTable *tobj = ht;
+    --tobj->count;
+    size_t k = hash % tobj->size;
+    for (size_t i = (k + 1) % tobj->size; !BUCKET_EMPTY_P(&tobj->data[i]);
+         i = (i + 1) % tobj->size) {
+        size_t target = tobj->data[i].hash % tobj->size;
+        if ((i > k && target >= k && target < i)
+            || (i < k && (target >= k || target < i))) {
+            tobj->data[k].hash = tobj->data[i].hash;
+            tobj->data[k].key = tobj->data[i].key;
+            tobj->data[k].value = tobj->data[i].value;
+            tobj->data[i].key = NULL;
+            tobj->data[i].value = NULL;
+            k = i;
+        }
+    }
+    return Qt;
+}
+
+DEFUN(hash_table_count, "hash-table-count", (LispVal * ht), "(ht)", "") {
+    return MAKE_FIXNUM(((LispHashTable *) ht)->count);
+}