mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-06-21 12:42:05 +02:00
245 lines
7.1 KiB
OCaml
245 lines
7.1 KiB
OCaml
(** Key for hastables that contain tuples of integers encoded in small integers *)
|
|
type kind_array =
|
|
| Kind_3
|
|
| Kind_6
|
|
| Kind_12
|
|
| Kind_9
|
|
| Kind_4
|
|
| Kind_2
|
|
| Kind_1
|
|
|
|
type t =
|
|
{
|
|
left : int ;
|
|
right : int ;
|
|
}
|
|
|
|
|
|
let of_int right =
|
|
{ left = 0 ; right }
|
|
|
|
let (<|) { left ; right } x =
|
|
{ left=right ; right=x }
|
|
|
|
let (<<) { left ; right } x =
|
|
{ left ; right = (right lsl 10) lor x }
|
|
|
|
let (<+) { left ; right } x =
|
|
{ left ; right = (right lsl 15) lor x }
|
|
|
|
|
|
(** 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 -> of_int a.(0) <+ a.(1) <+ a.(2)
|
|
| Kind_6 -> of_int a.(0) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5)
|
|
| Kind_12 ->
|
|
of_int a.(0) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5)
|
|
<| a.(6) << a.(7) << a.(8) << a.(9) << a.(10) << a.(11)
|
|
| Kind_9 ->
|
|
of_int a.(0) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5)
|
|
<| a.(6) << a.(7) << a.(8)
|
|
| Kind_4 -> of_int a.(0) <+ a.(1) <+ a.(2) <+ a.(3)
|
|
| Kind_2 -> of_int a.(0) <+ a.(1)
|
|
| Kind_1 -> 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) -> of_int a
|
|
| Two (a,b) -> of_int a <+ b
|
|
| Three (a,b,c) -> of_int a <+ b <+ c
|
|
| Four ((a,b),(c,d)) -> of_int a <+ b <+ c <+ d
|
|
| Six ((a,b,c),(d,e,f)) ->
|
|
of_int a << b << c << d << e << f
|
|
| Twelve ((a,b,c),(d,e,f),(g,h,i),(j,k,l)) ->
|
|
of_int a << b << c << d << e << f
|
|
<| g << h << i << j << k << l
|
|
| Nine ((a,b,c),(d,e,f),(g,h,i)) ->
|
|
of_int a << b << c << d << e << f
|
|
<| g << h << i
|
|
|
|
|
|
let mask10 = 0x3ff
|
|
and mask15 = 0x7fff
|
|
|
|
(** Transform the Zkey into an int array *)
|
|
let to_int_array ~kind { left ; right } =
|
|
match kind with
|
|
| Kind_3 -> [|
|
|
mask15 land (right lsr 30) ;
|
|
mask15 land (right lsr 15) ;
|
|
mask15 land right
|
|
|]
|
|
|
|
| Kind_6 -> [|
|
|
mask10 land (right lsr 50) ;
|
|
mask10 land (right lsr 40) ;
|
|
mask10 land (right lsr 30) ;
|
|
mask10 land (right lsr 20) ;
|
|
mask10 land (right lsr 10) ;
|
|
mask10 land right
|
|
|]
|
|
|
|
| Kind_12 -> [|
|
|
mask10 land (left lsr 50) ;
|
|
mask10 land (left lsr 40) ;
|
|
mask10 land (left lsr 30) ;
|
|
mask10 land (left lsr 20) ;
|
|
mask10 land (left lsr 10) ;
|
|
mask10 land left ;
|
|
mask10 land (right lsr 50) ;
|
|
mask10 land (right lsr 40) ;
|
|
mask10 land (right lsr 30) ;
|
|
mask10 land (right lsr 20) ;
|
|
mask10 land (right lsr 10) ;
|
|
mask10 land right
|
|
|]
|
|
|
|
| Kind_9 -> [|
|
|
mask10 land (left lsr 20) ;
|
|
mask10 land (left lsr 10) ;
|
|
mask10 land left ;
|
|
mask10 land (right lsr 50) ;
|
|
mask10 land (right lsr 40) ;
|
|
mask10 land (right lsr 30) ;
|
|
mask10 land (right lsr 20) ;
|
|
mask10 land (right lsr 10) ;
|
|
mask10 land right
|
|
|]
|
|
|
|
| Kind_4 -> [|
|
|
mask15 land (right lsr 45) ;
|
|
mask15 land (right lsr 30) ;
|
|
mask15 land (right lsr 15) ;
|
|
mask15 land right
|
|
|]
|
|
|
|
| Kind_2 -> [|
|
|
mask15 land (right lsr 15) ;
|
|
mask15 land right
|
|
|]
|
|
|
|
| Kind_1 -> [| right |]
|
|
|
|
|
|
|
|
(** Transform the Zkey into an int tuple *)
|
|
let to_int_tuple ~kind { left ; right } =
|
|
match kind with
|
|
| Kind_3 -> Three (
|
|
mask15 land (right lsr 30) ,
|
|
mask15 land (right lsr 15) ,
|
|
mask15 land right
|
|
)
|
|
|
|
| Kind_6 -> Six (
|
|
( mask10 land (right lsr 50) ,
|
|
mask10 land (right lsr 40) ,
|
|
mask10 land (right lsr 30)),
|
|
( mask10 land (right lsr 20) ,
|
|
mask10 land (right lsr 10) ,
|
|
mask10 land right )
|
|
)
|
|
|
|
| Kind_12 -> Twelve (
|
|
( mask10 land (left lsr 50) ,
|
|
mask10 land (left lsr 40) ,
|
|
mask10 land (left lsr 30)),
|
|
( mask10 land (left lsr 20) ,
|
|
mask10 land (left lsr 10) ,
|
|
mask10 land left ) ,
|
|
( mask10 land (right lsr 50) ,
|
|
mask10 land (right lsr 40) ,
|
|
mask10 land (right lsr 30)),
|
|
( mask10 land (right lsr 20) ,
|
|
mask10 land (right lsr 10) ,
|
|
mask10 land right )
|
|
)
|
|
|
|
| Kind_9 -> Nine (
|
|
( mask10 land (left lsr 20) ,
|
|
mask10 land (left lsr 10) ,
|
|
mask10 land left ) ,
|
|
( mask10 land (right lsr 50) ,
|
|
mask10 land (right lsr 40) ,
|
|
mask10 land (right lsr 30)),
|
|
( mask10 land (right lsr 20) ,
|
|
mask10 land (right lsr 10) ,
|
|
mask10 land right )
|
|
)
|
|
|
|
| Kind_4 -> Four (
|
|
( mask15 land (right lsr 45) ,
|
|
mask15 land (right lsr 30)),
|
|
( mask15 land (right lsr 15) ,
|
|
mask15 land right )
|
|
)
|
|
|
|
| Kind_2 -> Two (
|
|
mask15 land (right lsr 15) ,
|
|
mask15 land right
|
|
)
|
|
|
|
| Kind_1 -> One right
|
|
|
|
|
|
let hash = Hashtbl.hash
|
|
|
|
let equal
|
|
{ right = r1 ; left = l1 }
|
|
{ right = r2 ; left = l2 } =
|
|
r1 = r2 && l1 = l2
|
|
|
|
let cmp
|
|
{ right = r1 ; left = l1 }
|
|
{ right = r2 ; left = l2 } =
|
|
if r1 < r2 then -1
|
|
else if r1 > r2 then 1
|
|
else if l1 < l2 then -1
|
|
else if l1 > l2 then 1
|
|
else 0
|
|
|
|
let to_string ~kind { left ; right } =
|
|
"< " ^ string_of_int left ^ string_of_int right ^ " | " ^ (
|
|
to_int_array kind { left ; right }
|
|
|> 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
|
|
|
|
(*
|
|
< 65538 | 1, 2 >
|
|
< 1050627 | 1, 2, 3 >
|
|
< 281483566841860 | 1, 2, 3, 4 >
|
|
< 1128102155523078 | 1, 2, 3, 4, 5, 6 >
|
|
< 20809811751934310026571282435288076 | 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 >
|
|
*)
|
|
|
|
let () = debug ()
|
|
*)
|