(** Key for hastables that contain tuples of integers encoded in a Zarith integer *) type kind_array = | Kind_3 | Kind_6 | Kind_12 | Kind_9 | Kind_4 | Kind_2 | Kind_1 let (<|) x a = Z.logor (Z.shift_left x 64) a let (<<) x a = Int64.logor (Int64.shift_left x 10) (Int64.of_int a) let (<+) x a = Int64.logor (Int64.shift_left x 16) (Int64.of_int a) (** Build a Zkey from an array or 1, 2, 3, 4, 6, 9, or 12 integers *) let of_int_array ~kind a = 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 | Kind_9 -> 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) |> Z.of_int64 in a <| b | 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) type kind = | One of (int) | Two of (int*int) | Three of (int*int*int) | Four of ((int*int)*(int*int)) | Six of ((int*int*int)*(int*int*int)) | Nine of ((int*int*int)*(int*int*int)*(int*int*int)) | Twelve of ((int*int*int)*(int*int*int)*(int*int*int)*(int*int*int)) let of_int_tuple a = match a with | One (a) -> Z.of_int a | Two (a,b) -> (Int64.of_int a) <+ b |> Z.of_int64 | Three (a,b,c) -> (Int64.of_int a) << b << c |> Z.of_int64 | Four ((a,b),(c,d)) -> (Int64.of_int a) <+ b <+ c <+ d |> Z.of_int64 | Six ((a,b,c),(d,e,f)) -> (Int64.of_int a) << b << c << d << e << f |> Z.of_int64 | Twelve ((a,b,c),(d,e,f),(g,h,i),(j,k,l)) -> let a = (Int64.of_int a) << b << c << d << e << f |> Z.of_int64 and b = (Int64.of_int g) << h << i << j << k << l |> Z.of_int64 in a <| b | Nine ((a,b,c),(d,e,f),(g,h,i)) -> let a = (Int64.of_int a) << b << c << d << e << f |> Z.of_int64 and b = (Int64.of_int g) << h << i |> Z.of_int64 in a <| b let mask10 = Int64.of_int 0x3ff and mask16 = Int64.of_int 0xffff (** Transform the Zkey into an int array *) let to_int_array ~kind a = let open Int64 in match kind with | Kind_3 -> let x = Z.to_int64 a in [| to_int ( logand mask10 (shift_right x 20)) ; to_int ( logand mask10 (shift_right x 10)) ; to_int ( logand mask10 x) |] | Kind_6 -> let x = Z.to_int64 a in [| to_int ( logand mask10 (shift_right x 50)) ; to_int ( logand mask10 (shift_right x 40)) ; to_int ( logand mask10 (shift_right x 30)) ; to_int ( logand mask10 (shift_right x 20)) ; to_int ( logand mask10 (shift_right x 10)) ; to_int ( logand mask10 x) |] | Kind_12 -> let x = Z.to_int64 @@ Z.extract a 0 60 and y = Z.to_int64 @@ Z.extract a 64 60 in [| to_int ( logand mask10 (shift_right y 114)) ; to_int ( logand mask10 (shift_right y 104)) ; to_int ( logand mask10 (shift_right y 94)) ; to_int ( logand mask10 (shift_right y 84)) ; to_int ( logand mask10 (shift_right y 74)) ; to_int ( logand mask10 (shift_right y 64)) ; to_int ( logand mask10 (shift_right x 50)) ; to_int ( logand mask10 (shift_right x 40)) ; to_int ( logand mask10 (shift_right x 30)) ; to_int ( logand mask10 (shift_right x 20)) ; to_int ( logand mask10 (shift_right x 10)) ; to_int ( logand mask10 x) |] | Kind_9 -> let x = Z.to_int64 @@ Z.extract a 0 60 and y = Z.to_int64 @@ Z.extract a 64 60 in [| to_int ( logand mask10 (shift_right y 84)) ; to_int ( logand mask10 (shift_right y 74)) ; to_int ( logand mask10 (shift_right y 64)) ; to_int ( logand mask10 (shift_right x 50)) ; to_int ( logand mask10 (shift_right x 40)) ; to_int ( logand mask10 (shift_right x 30)) ; to_int ( logand mask10 (shift_right x 20)) ; to_int ( logand mask10 (shift_right x 10)) ; to_int ( logand mask10 x) |] | Kind_4 -> let x = Z.to_int64 a in [| to_int ( logand mask16 (shift_right x 48)) ; to_int ( logand mask16 (shift_right x 32)) ; to_int ( logand mask16 (shift_right x 16)) ; to_int ( logand mask16 x) |] | Kind_2 -> let x = Z.to_int64 a in [| to_int ( logand mask16 (shift_right x 16)) ; to_int ( logand mask16 x) |] | Kind_1 -> [| Z.to_int a |] (** Transform the Zkey into an int tuple *) let to_int_tuple ~kind a = let open Int64 in match kind with | Kind_3 -> let x = Z.to_int64 a in Three ( to_int ( logand mask10 (shift_right x 20)), to_int ( logand mask10 (shift_right x 10)), to_int ( logand mask10 x) ) | Kind_6 -> let x = Z.to_int64 a in Six ( ( to_int ( logand mask10 (shift_right x 50)), to_int ( logand mask10 (shift_right x 40)), to_int ( logand mask10 (shift_right x 30))), ( to_int ( logand mask10 (shift_right x 20)), to_int ( logand mask10 (shift_right x 10)), to_int ( logand mask10 x) ) ) | Kind_12 -> let x = Z.to_int64 @@ Z.extract a 0 60 and y = Z.to_int64 @@ Z.extract a 64 60 in Twelve ( ( to_int ( logand mask10 (shift_right y 114)), to_int ( logand mask10 (shift_right y 104)), to_int ( logand mask10 (shift_right y 94))), ( to_int ( logand mask10 (shift_right y 84)), to_int ( logand mask10 (shift_right y 74)), to_int ( logand mask10 (shift_right y 64))), ( to_int ( logand mask10 (shift_right x 50)), to_int ( logand mask10 (shift_right x 40)), to_int ( logand mask10 (shift_right x 30))), ( to_int ( logand mask10 (shift_right x 20)), to_int ( logand mask10 (shift_right x 10)), to_int ( logand mask10 x) )) | Kind_9 -> let x = Z.to_int64 @@ Z.extract a 0 60 and y = Z.to_int64 @@ Z.extract a 64 60 in Nine ( ( to_int ( logand mask10 (shift_right y 84)), to_int ( logand mask10 (shift_right y 74)), to_int ( logand mask10 (shift_right y 64))), ( to_int ( logand mask10 (shift_right x 50)), to_int ( logand mask10 (shift_right x 40)), to_int ( logand mask10 (shift_right x 30))), ( to_int ( logand mask10 (shift_right x 20)), to_int ( logand mask10 (shift_right x 10)), to_int ( logand mask10 x) )) | Kind_4 -> let x = Z.to_int64 a in Four ( ( to_int ( logand mask16 (shift_right x 48)), to_int ( logand mask16 (shift_right x 32))), ( to_int ( logand mask16 (shift_right x 16)), to_int ( logand mask16 x) )) | Kind_2 -> let x = Z.to_int64 a in Two ( to_int ( logand mask16 (shift_right x 16)), to_int ( logand mask16 x) ) | Kind_1 -> One ( Z.to_int a ) include Z 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 () *)