2018-01-17 18:19:38 +01:00
|
|
|
(** Key for hastables that contain tuples of integers encoded in a Zarith integer *)
|
|
|
|
|
|
|
|
|
|
include Z
|
|
|
|
|
|
|
|
|
|
type kind =
|
|
|
|
|
| Kind_3
|
|
|
|
|
| Kind_6
|
|
|
|
|
| Kind_12
|
2018-01-19 17:42:12 +01:00
|
|
|
| Kind_4
|
|
|
|
|
| Kind_2
|
|
|
|
|
| Kind_1
|
2018-01-17 18:19:38 +01:00
|
|
|
|
|
|
|
|
|
2018-01-19 17:42:12 +01:00
|
|
|
(** Build a Zkey from an array or 1, 2, 3, 4, 6, or 12 integers *)
|
2018-01-17 18:19:38 +01:00
|
|
|
let of_int_array ~kind a =
|
|
|
|
|
let (<|) x a =
|
|
|
|
|
Z.logor (Z.shift_left x 64) a
|
|
|
|
|
in
|
|
|
|
|
let (<<) x a =
|
|
|
|
|
Int64.logor (Int64.shift_left x 10) (Int64.of_int a)
|
|
|
|
|
in
|
|
|
|
|
let (<+) x a =
|
|
|
|
|
Int64.logor (Int64.shift_left x 16) (Int64.of_int a)
|
|
|
|
|
in
|
|
|
|
|
match kind with
|
|
|
|
|
| Kind_3 -> (Int64.of_int a.(0)) << a.(1) << a.(2) |> Z.of_int64
|
|
|
|
|
| Kind_6 -> (Int64.of_int a.(0)) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5)
|
|
|
|
|
|> Z.of_int64
|
|
|
|
|
| Kind_12 ->
|
|
|
|
|
let a =
|
|
|
|
|
(Int64.of_int a.(0)) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5)
|
|
|
|
|
|> Z.of_int64
|
|
|
|
|
and b =
|
|
|
|
|
(Int64.of_int a.(6)) << a.(7) << a.(8) << a.(9) << a.(10) << a.(11)
|
|
|
|
|
|> Z.of_int64
|
|
|
|
|
in a <| b
|
2018-01-19 17:42:12 +01:00
|
|
|
| Kind_4 -> (Int64.of_int a.(0)) <+ a.(1) <+ a.(2) <+ a.(3) |> Z.of_int64
|
|
|
|
|
| Kind_2 -> (Int64.of_int a.(0)) <+ a.(1) |> Z.of_int64
|
|
|
|
|
| Kind_1 -> Z.of_int a.(0)
|
2018-01-17 18:19:38 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
|
(** Transform the Zkey into an int array *)
|
|
|
|
|
let to_int_array ~kind a =
|
|
|
|
|
match kind with
|
|
|
|
|
| Kind_3 -> [| Z.to_int @@ Z.extract a 20 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 10 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 0 10 |]
|
|
|
|
|
| Kind_6 -> [| Z.to_int @@ Z.extract a 50 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 40 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 30 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 20 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 10 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 0 10 |]
|
|
|
|
|
| Kind_12 -> [| Z.to_int @@ Z.extract a 114 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 104 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 94 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 84 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 74 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 64 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 50 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 40 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 30 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 20 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 10 10 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 0 10 |]
|
2018-01-19 17:42:12 +01:00
|
|
|
| Kind_4 -> [| Z.to_int @@ Z.extract a 48 16 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 32 16 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 16 16 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 0 16 |]
|
|
|
|
|
| Kind_2 -> [| Z.to_int @@ Z.extract a 16 16 ;
|
|
|
|
|
Z.to_int @@ Z.extract a 0 16 |]
|
|
|
|
|
| Kind_1 -> [| Z.to_int a |]
|
2018-01-17 18:19:38 +01:00
|
|
|
|
|
|
|
|
let to_string ~kind a =
|
|
|
|
|
"< " ^ ( Z.to_string a ) ^ " | " ^ (
|
|
|
|
|
to_int_array kind a
|
|
|
|
|
|> Array.map string_of_int
|
|
|
|
|
|> Array.to_list
|
|
|
|
|
|> String.concat ", "
|
|
|
|
|
) ^ " >"
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(*
|
|
|
|
|
let debug () =
|
|
|
|
|
let k2 = of_int_array Kind_2 [| 1 ; 2 |]
|
|
|
|
|
and k3 = of_int_array Kind_3 [| 1 ; 2 ; 3 |]
|
|
|
|
|
and k4 = of_int_array Kind_4 [| 1 ; 2 ; 3; 4 |]
|
|
|
|
|
and k6 = of_int_array Kind_6 [| 1 ; 2 ; 3; 4 ; 5; 6|]
|
|
|
|
|
and k12 = of_int_array Kind_12 [| 1 ; 2 ; 3; 4 ; 5; 6 ; 7 ; 8 ; 9 ; 10 ; 11; 12|]
|
|
|
|
|
in
|
|
|
|
|
print_endline @@ to_string Kind_2 k2 ;
|
|
|
|
|
print_endline @@ to_string Kind_3 k3 ;
|
|
|
|
|
print_endline @@ to_string Kind_4 k4 ;
|
|
|
|
|
print_endline @@ to_string Kind_6 k6 ;
|
|
|
|
|
print_endline @@ to_string Kind_12 k12
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let () = debug ()
|
|
|
|
|
*)
|
