1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
(* using the hash_variant of pa_type_conv at compile time *)
let repr_of_poly_variant : [> ] -> int =
fun variant ->
let obj = Obj.repr variant in
if Obj.is_int obj
then Obj.obj obj
else (
let size = Obj.size obj in
assert (size = 2);
let repr = Obj.field obj 0 in
assert (Obj.is_int repr);
Obj.obj repr)
;;
let hash_variant s =
let accu = ref 0 in
for i = 0 to String.length s - 1 do
accu := (223 * !accu) + Char.code s.[i]
done;
(* reduce to 31 bits *)
accu := !accu land ((1 lsl 31) - 1);
(* make it signed for 64 bits architectures *)
if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu
;;
(* a few unit tests of cases that have triggered diffs in the past of this
lib *)
let () = assert (repr_of_poly_variant `Latency_stats = hash_variant "Latency_stats")
let () = assert (repr_of_poly_variant `zero = hash_variant "zero")
let double_array_value = Obj.magic 0.
let has_double_array_tag a = Obj.double_array_tag = Obj.tag (Obj.repr a)
let () =
let module M = struct
type double =
{ a : float
; b : float
}
type simple =
{ c : float
; d : int
}
let double = { a = double_array_value; b = double_array_value }
let simple = { c = double_array_value; d = double_array_value }
end
in
assert (has_double_array_tag M.double);
assert (not (has_double_array_tag M.simple))
;;
|
