fix a hashtbl hash bug, add more tests for hashtbl

jscomp/lib/js.ml

@@ -33,6 +33,10 @@ external anything_to_string : 'a -> string = "js_anything_to_string"
 external anything_to_number : 'a -> float = "js_anything_to_number"
 
 
+type any = Obj.t 
+
+external erase : 'a -> any = "%identity" 
+external cast : any -> 'a = "%identity" 
 
 type + 'a opt
 
@@ -141,10 +145,13 @@ module Caml_obj = struct
   external set_tag : Obj.t -> int -> unit = "caml_obj_set_tag"
   external uninitialized_object : int -> int -> Obj.t = "js_uninitialized_object"
   external is_instance_array : Obj.t -> bool = "js_is_instance_array" (* use Array.isArray instead*)
+  external size_of_any : Obj.t -> 'a def = "length" [@@bs.get]
+  external tag_of_any : Obj.t -> 'a def = "tag" [@@bs.get]
 end
 
 module Caml_int64 = struct
   external discard_sign : int64 -> int64 = "js_int64_discard_sign"
   external div_mod : int64 -> int64 -> int64 * int64 = "js_int64_div_mod"
   external to_hex : int64 -> string = "js_int64_to_hex"    
 end  
+

jscomp/runtime/.depend

@@ -15,7 +15,6 @@ caml_queue.cmi :
 caml_string.cmi :
 caml_sys.cmi :
 caml_utils.cmi :
-caml_weak.cmi :
 caml_array.cmo : js.cmo caml_array.cmi
 caml_array.cmx : js.cmx caml_array.cmi
 caml_bigarray.cmo : caml_bigarray.cmi
@@ -54,8 +53,6 @@ caml_sys.cmo : js.cmo caml_sys.cmi
 caml_sys.cmx : js.cmx caml_sys.cmi
 caml_utils.cmo : caml_utils.cmi
 caml_utils.cmx : caml_utils.cmi
-caml_weak.cmo : caml_array.cmi caml_weak.cmi
-caml_weak.cmx : caml_array.cmx caml_weak.cmi
 fn.cmo :
 fn.cmx :
 js.cmo :
@@ -102,8 +99,6 @@ caml_sys.cmo : js.cmo caml_sys.cmi
 caml_sys.cmj : js.cmj caml_sys.cmi
 caml_utils.cmo : caml_utils.cmi
 caml_utils.cmj : caml_utils.cmi
-caml_weak.cmo : caml_array.cmi caml_weak.cmi
-caml_weak.cmj : caml_array.cmj caml_weak.cmi
 fn.cmo :
 fn.cmj :
 js.cmo :

jscomp/runtime/caml_hash.js

@@ -69,7 +69,8 @@ function caml_hash(count, _, seed, obj) {
     while(queue[/* length */0] !== 0 && num > 0) {
       var obj$1 = Caml_queue.unsafe_pop(queue);
       if (typeof obj$1 === "number") {
-        hash = mix(hash, obj$1 | 0);
+        var u$1 = obj$1 | 0;
+        hash = mix(hash, (u$1 + u$1 | 0) + 1 | 0);
         num = num - 1 | 0;
       }
       else if (typeof obj$1 === "string") {
@@ -83,19 +84,29 @@ function caml_hash(count, _, seed, obj) {
                   Caml_builtin_exceptions.assert_failure,
                   [
                     "caml_hash.ml",
-                    124,
+                    125,
                     8
                   ]
                 ];
           }
           else if (typeof obj$1 !== "function") {
-            var tag = obj$1.tag | 0;
-            hash = mix(hash, tag);
-            var v = obj$1.length - 1 | 0;
-            var block = v < num ? v : num;
-            for(var i = 0; i<= block; ++i){
-              Caml_queue.push(obj$1[i], queue);
+            var size = obj$1.length;
+            if (size) {
+              var obj_tag = obj$1.tag | 0;
+              var tag = (size << 10) | obj_tag;
+              if (tag === 248) {
+                hash = mix(hash, obj$1[1]);
+              }
+              else {
+                hash = mix(hash, tag);
+                var v = size - 1 | 0;
+                var block = v < num ? v : num;
+                for(var i = 0; i<= block; ++i){
+                  Caml_queue.push(obj$1[i], queue);
+                }
+              }
             }
+
           }
 
         }

jscomp/runtime/caml_hash.ml

@@ -108,7 +108,8 @@ let caml_hash count _limit seed obj =
       let obj = Caml_queue.unsafe_pop queue in 
       if Js.typeof obj = "number" then
         begin 
-          hash := mix !hash (Nativeint.of_float (Obj.magic obj));
+          let u = Nativeint.of_float (Obj.magic obj) in
+          hash := mix !hash (u +~ u +~ 1n) ;
           decr num ;
         end
       else if Js.typeof obj = "string" then 
@@ -125,13 +126,23 @@ let caml_hash count _limit seed obj =
       else if Js.typeof obj = "function" then
         () 
       else 
-        let tag = Obj.tag obj in 
-        hash := mix !hash (Nativeint.of_int tag) ;
-        let block = 
-          let v = Obj.size obj - 1 in if v <  !num then v else !num in 
-        for i = 0 to block do
-          Caml_queue.push (Obj.field obj i ) queue
-        done 
+        let size = Js.Caml_obj.size_of_any obj in 
+        match Js.from_def size with (* FIXME: generated code is buggy *)
+        | None -> ()
+        | Some size -> 
+          let obj_tag = Obj.tag obj in
+          let tag = (size lsl 10) lor obj_tag in 
+          if tag = 248 (* Obj.object_tag*) then 
+            hash := mix !hash (Nativeint.of_int (Oo.id (Obj.magic obj)))
+          else 
+            begin 
+              hash := mix !hash (Nativeint.of_int tag) ;
+              let block = 
+                let v = size - 1 in if v <  !num then v else !num in 
+              for i = 0 to block do
+                Caml_queue.push (Obj.field obj i ) queue
+              done 
+            end
     done;
     final_mix !hash 
 

jscomp/test/.depend

@@ -218,6 +218,10 @@ int64_test.cmo : ../stdlib/pervasives.cmi ../stdlib/nativeint.cmi mt.cmi \
 int64_test.cmx : ../stdlib/pervasives.cmx ../stdlib/nativeint.cmx mt.cmx \
     ../lib/js.cmx ../stdlib/int64.cmx ../stdlib/int32.cmx \
     ../stdlib/format.cmx ext_array.cmx ../stdlib/array.cmx
+int_hashtbl_test.cmo : mt.cmi ../stdlib/list.cmi ../stdlib/hashtbl.cmi \
+    ../stdlib/array.cmi
+int_hashtbl_test.cmx : mt.cmx ../stdlib/list.cmx ../stdlib/hashtbl.cmx \
+    ../stdlib/array.cmx
 int_map.cmo : ../stdlib/map.cmi
 int_map.cmx : ../stdlib/map.cmx
 int_overflow_test.cmo : ../stdlib/string.cmi mt.cmi ../stdlib/int32.cmi \
@@ -764,6 +768,10 @@ int64_test.cmo : ../stdlib/pervasives.cmi ../stdlib/nativeint.cmi mt.cmi \
 int64_test.cmj : ../stdlib/pervasives.cmj ../stdlib/nativeint.cmj mt.cmj \
     ../lib/js.cmj ../stdlib/int64.cmj ../stdlib/int32.cmj \
     ../stdlib/format.cmj ext_array.cmj ../stdlib/array.cmj
+int_hashtbl_test.cmo : mt.cmi ../stdlib/list.cmi ../stdlib/hashtbl.cmi \
+    ../stdlib/array.cmi
+int_hashtbl_test.cmj : mt.cmj ../stdlib/list.cmj ../stdlib/hashtbl.cmj \
+    ../stdlib/array.cmj
 int_map.cmo : ../stdlib/map.cmi
 int_map.cmj : ../stdlib/map.cmj
 int_overflow_test.cmo : ../stdlib/string.cmi mt.cmi ../stdlib/int32.cmi \

jscomp/test/hash_test.js

@@ -63,23 +63,86 @@ function normalize(x) {
   return x & 1073741823;
 }
 
-var param = $$Array.map(function (x) {
-      return Hashtbl.hash(x) & 1073741823;
-    }, test_strings);
+function caml_hash(x) {
+  return Hashtbl.hash(x) & 1073741823;
+}
+
+var param = $$Array.map(caml_hash, test_strings);
 
-Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 17, characters 5-12', param, test_strings_hash_results);
+Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 18, characters 5-12', param, test_strings_hash_results);
 
 var param$1 = Hashtbl.hash(0) & 1073741823;
 
-Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 23, characters 5-12', param$1, 129913994);
+Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 24, characters 5-12', param$1, 129913994);
 
 var param$2 = Hashtbl.hash("x") & 1073741823;
 
-Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 26, characters 5-12', param$2, 780510073);
+Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 27, characters 5-12', param$2, 780510073);
 
 var param$3 = Hashtbl.hash("xy") & 1073741823;
 
-Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 29, characters 5-12', param$3, 194127723);
+Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 30, characters 5-12', param$3, 194127723);
+
+var param$4 = Hashtbl.hash(/* A */65) & 1073741823;
+
+Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 33, characters 5-12', param$4, 381663642);
+
+var param$5 = Hashtbl.hash(/* `A */[
+      65,
+      3
+    ]) & 1073741823;
+
+Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 34, characters 5-12', param$5, 294279345);
+
+var param$6 = Hashtbl.hash(/* :: */[
+      /* `A */[
+        65,
+        3
+      ],
+      /* :: */[
+        /* `B */[
+          66,
+          2
+        ],
+        /* :: */[
+          /* `C */[
+            67,
+            3
+          ],
+          /* [] */0
+        ]
+      ]
+    ]) & 1073741823;
+
+Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 35, characters 5-12', param$6, 1017654909);
+
+var param$7 = Hashtbl.hash(/* :: */[
+      /* tuple */[
+        /* `A */[
+          65,
+          "3"
+        ],
+        /* `B */[
+          66,
+          "2"
+        ]
+      ],
+      /* :: */[
+        /* tuple */[
+          /* `C */[
+            67,
+            "3"
+          ],
+          /* `D */[
+            68,
+            "4"
+          ]
+        ],
+        /* [] */0
+      ]
+    ]) & 1073741823;
+
+Mt_global.collect_eq(test_id, suites, 'File "hash_test.ml", line 36, characters 5-12', param$7, 81986873);
 
 Mt.from_pair_suites("hash_test.ml", suites[0]);
 
@@ -89,4 +152,5 @@ exports.eq                        = eq;
 exports.test_strings              = test_strings;
 exports.test_strings_hash_results = test_strings_hash_results;
 exports.normalize                 = normalize;
+exports.caml_hash                 = caml_hash;
 /* test_strings Not a pure module */

jscomp/test/hash_test.ml

@@ -13,9 +13,10 @@ let test_strings_hash_results =
     178511779; 585018975; 544388424; 1043872806; 831138595|]
 
 let normalize x = x land 0x3FFFFFFF
+let caml_hash x = Hashtbl.hash x |> normalize
 let () = 
   eq __LOC__ 
-    (test_strings |> Array.map (fun x -> normalize (Hashtbl.hash x)   ))
+    (test_strings |> Array.map caml_hash)
     test_strings_hash_results
 
 
@@ -28,5 +29,12 @@ let () =
 let () =
   eq __LOC__ (Hashtbl.hash "xy" |> normalize) 194127723
 
-let () = 
+let () =
+  eq __LOC__ (caml_hash `A) 381663642;
+  eq __LOC__ (caml_hash (`A 3)) 294279345;
+  eq __LOC__ (caml_hash [`A 3; `B 2 ; `C 3 ]) 1017654909;
+  eq __LOC__ (caml_hash [`A "3", `B "2" ; `C "3", `D "4"]) (81986873)  
+
+
+let () =
   Mt.from_pair_suites __FILE__ !suites