mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-06-02 03:15:19 +02:00
217 lines
8.3 KiB
OCaml
217 lines
8.3 KiB
OCaml
(** 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 ()
|
|
*)
|