hashes for dictionaries

.gitignore

@@ -32,3 +32,4 @@ temp/
 
 /TAGS
 /bin/project.carp
+instrumentations/

examples/project.carp

@@ -27,11 +27,32 @@
              :b {:x 66666}
              :c {:x 300}}})
 
-(defn compare []
-  (assert (not (= d1 d2))))
+(def d3 {:a {}
+         :b {:a 1
+             :b 2
+             :c 3}
+         :c {:a {:x 100}
+             :b {:x 200}
+             :c {:x 300}}})
 
-;;(time (for (i 0 9999) (compare)))
+(defn compare []
+  (do
+    (assert (not (= d1 d2)))
+    (assert (= d1 d3))))
+
+(time (for (i 0 50000) (compare))) ;; takes 4700 ms
+
+;; (println (str "meta d1: " (meta d1)))
+;; (println (str "meta d2: " (meta d2)))
+;; (println (str "meta d3: " (meta d3)))
 
 (println "bleh...")
 
-(while true (println "."))
+;;(meta {:a 10 :b {:x 10 :y 20}})
+
+;; 410767028
+;; 410767028
+
+;; {:a {:x 100}
+;;  :b {:x 666}
+;;  :c {:x 300}}

src/bytecode.h

@@ -2,7 +2,7 @@
 
 #include "obj.h"
 
-#define BYTECODE_EVAL 1
+#define BYTECODE_EVAL 0
 
 Obj *form_to_bytecode(Process *process, Obj *env, Obj *form, bool insert_return_instruction);
 //Obj *bytecode_eval_bytecode(Process *process, Obj *bytecodeObj);

src/obj.c

@@ -201,7 +201,7 @@ Obj *obj_copy(Obj *o) {
       prev->car = obj_copy(p->car);
       if(p->cdr) {
 	prev->cdr = obj_copy(p->cdr);
-	return list; // early break when copying dotted pairs!
+	return list; // early break when copying dotted pairs! TODO: is this case always selected?!
       } else {
 	prev->cdr = obj_new_cons(NULL, NULL);
 	prev = new;
@@ -277,6 +277,107 @@ Obj *obj_copy(Obj *o) {
   }
 }
 
+int string_to_hash(char *str) {
+  unsigned long hash = 5381;
+  int c;
+  while((c = *str++)) {
+    hash = ((hash << 5) + hash) + c; /* hash * 33 + c */
+  }
+  return hash;
+}
+
+Obj *obj_hash(Process *process, Obj *o) {
+  assert(o);
+
+  shadow_stack_push(process, o);
+  Obj *hash = obj_new_int(123456789);
+  shadow_stack_push(process, hash);
+  
+  if(o->tag == 'C') {
+    Obj *p = o;
+    int h = 1234;
+    while(p && p->car) {
+      h += obj_hash(process, p->car)->i;
+      if(p->cdr && p->cdr->tag != 'C') {
+        // dotted pair
+        h += obj_hash(process, p->cdr)->i;
+        break;
+      } else {
+        // normal list
+        p = p->cdr;
+      }
+    }
+    hash->i = h;   
+  }
+  else if(o->tag == 'A') {
+    int h = 5381;
+    for(int i = 0; i < o->count; i++) {
+      h = ((h << 5) + h) + obj_hash(process, o->array[i])->i;
+    }
+    hash->i = h;   
+  }
+  else if(o->tag == 'E') {
+    hash->i = obj_hash(process, o->bindings)->i + 666;   
+  }
+  else if(o->tag == 'Q') {
+    hash->i = (int)o->void_ptr;   
+  }
+  else if(o->tag == 'I') {
+    hash->i = o->i;   
+  }
+  else if(o->tag == 'V') {
+    hash->i = (int)o->f32;   
+  }
+  else if(o->tag == 'W') {
+    hash->i = (int)o->f64;   
+  }
+  else if(o->tag == 'S') {
+    hash->i = string_to_hash(o->s);   
+  }
+  else if(o->tag == 'Y') {
+    hash->i = string_to_hash(o->s);   
+  }
+  else if(o->tag == 'K') {
+    hash->i = string_to_hash(o->s);   
+  }
+  else if(o->tag == 'P') {
+    hash->i = (int)o->primop;
+  }
+  else if(o->tag == 'D') {
+    hash->i = (int)o->dylib;
+  }
+  else if(o->tag == 'F') {
+    hash->i = (int)o->funptr;
+  }
+  else if(o->tag == 'L') {
+    // ???
+  }
+  else if(o->tag == 'M') {
+    // ???
+  }
+  else if(o->tag == 'T') {
+    hash->i = (int)o->character;
+  }
+  else if(o->tag == 'B') {
+    hash->i = o->boolean ? 29843 : 42391;
+  }
+  else if(o->tag == 'X') {
+    // ???
+  }
+  else {
+    printf("obj_hash() can't handle type tag %c (%d).\n", o->tag, o->tag);
+    return NULL;
+    assert(false);
+  }
+
+  shadow_stack_pop(process); // hash
+  shadow_stack_pop(process); // o
+
+  //printf("hash for %s is %d\n", obj_to_string(process, o)->s, hash->i);
+  
+  return hash;
+}
+
 Obj *obj_list_internal(Obj *objs[]) {
   Obj *list = obj_new_cons(NULL, NULL);
   Obj **o = objs;
@@ -433,7 +534,19 @@ bool obj_eq(Process *process, Obj *a, Obj *b) {
   else if(a->tag == 'D') {
     return a->dylib == b->dylib;
   }
-  else if(a->tag == 'C') {
+
+  if(a->meta && b->meta) {
+    Obj *hash_a = env_lookup(process, a->meta, hash);
+    Obj *hash_b = env_lookup(process, b->meta, hash);
+    if(hash_a && hash_b) {
+      if(hash_a->i != hash_b->i) {
+        //printf("Hash of %s and %s are not equal!\n", obj_to_string(process, a)->s, obj_to_string(process, b)->s);
+        return false;
+      }
+    }
+  }
+  
+  if(a->tag == 'C') {
     Obj *pa = a;
     Obj *pb = b;
     while(1) {
@@ -471,8 +584,17 @@ bool obj_eq(Process *process, Obj *a, Obj *b) {
     }
   }
   else if(a->tag == 'E') {
-    if(!obj_eq(process, a->parent, b->parent)) { return false; }
-    //printf("WARNING! Can't reliably compare dicts.\n");
+
+    /* if(!a->meta) { */
+    /*   printf("dict is missing meta: %s\n", obj_to_string(process, a)->s); */
+    /* } */
+    /* if(!b->meta) { */
+    /*   printf("dict is missing meta: %s\n", obj_to_string(process, b)->s); */
+    /* } */
+    
+    if(!obj_eq(process, a->parent, b->parent)) {
+      return false;
+    }
 
     {
       Obj *pa = a->bindings;    

src/obj.h

@@ -171,6 +171,7 @@ Obj *obj_new_bool(bool b);
 Obj *obj_new_bytecode(char *bytecode);
 
 Obj *obj_copy(Obj *o);
+Obj *obj_hash(Process *process, Obj *o);
 bool obj_eq(Process *process, Obj *a, Obj *b);
 
 Obj *obj_list_internal(Obj *objs[]);
@@ -198,6 +199,7 @@ Obj *lisp_NULL;
 Obj *ampersand; // "&"
 Obj *hash; // "#"
 Obj *dotdotdot; // "..."
+Obj *hash; // ":hash"
 
 Obj *type_int;
 Obj *type_bool;

src/primops.c

@@ -294,6 +294,9 @@ Obj *p_dictionary(Process *process, Obj** args, int arg_count) {
   }
   
   //sprintf("Created dictionary:\n%s\n", obj_to_string(process, e)->s);
+
+  Obj *hash = obj_hash(process, e); // do this first since it might trigger GC
+  obj_set_meta(e, obj_new_keyword("hash"), hash);
   
   return e;
 }
@@ -2242,7 +2245,13 @@ Obj *p_sort_by(Process *process, Obj** args, int arg_count) {
   return result;
 }
 
-
+Obj *p_hash(Process *process, Obj** args, int arg_count) {
+  if(arg_count != 1) {
+    eval_error = obj_new_string("Wrong argument count to 'hash'.");
+    return nil;
+  }
+  return obj_hash(process, args[0]);
+}
 
       /* shadow_stack_push(process, list); */
       

src/primops.h

@@ -88,6 +88,7 @@ Obj *p_replace_subst_from_right_fast(Process *process, Obj** args, int arg_count
 Obj *p_types_exactly_eq(Process *process, Obj** args, int arg_count);
 Obj *p_extend_substitutions_fast(Process *process, Obj** args, int arg_count);
 Obj *p_sort_by(Process *process, Obj** args, int arg_count);
+Obj *p_hash(Process *process, Obj** args, int arg_count);
 
 Obj *register_ffi_internal(Process *process, char *name, VoidFn funptr, Obj *args, Obj *return_type_obj, bool builtin);
 

src/process.c

@@ -47,6 +47,9 @@ Process *process_new() {
   dotdotdot = obj_new_symbol("dotdotdot");
   define("dotdotdot", dotdotdot);
 
+  hash = obj_new_keyword("hash");
+  define("hash", hash);
+
   lisp_NULL = obj_new_ptr(NULL);
   define("NULL", lisp_NULL);
 
@@ -177,6 +180,7 @@ Process *process_new() {
   register_primop(process, "array-set!", p_array_set_BANG);
   register_primop(process, "array-set", p_array_set);
   register_primop(process, "gc", p_gc);
+  register_primop(process, "hash", p_hash);
   register_primop(process, "delete", p_delete);
   register_primop(process, "stop", p_stop);
   register_primop(process, "parallell", p_parallell);