mirror of https://gitlab.com/scemama/QCaml.git
234 lines
6.6 KiB
OCaml
234 lines
6.6 KiB
OCaml
open Powers
|
|
|
|
type t =
|
|
{
|
|
mutable left : int;
|
|
mutable right : int;
|
|
kind : int ;
|
|
}
|
|
|
|
|
|
(** Creates a Zkey. *)
|
|
let make ~kind right =
|
|
{ left = 0 ; right ; kind }
|
|
|
|
(** Move [right] to [left] and set [right = x] *)
|
|
let (<|) z x =
|
|
z.left <- z.right;
|
|
z.right <- x;
|
|
z
|
|
|
|
(** Shift left [right] by 10 bits, and add [x]. *)
|
|
let (<<) z x =
|
|
z.right <- (z.right lsl 10) lor x ;
|
|
z
|
|
|
|
(** Shift left [right] by 10 bits, and add [x]. *)
|
|
let (<+) z x =
|
|
z.right <- (z.right lsl 15) lor x ;
|
|
z
|
|
|
|
|
|
type kind =
|
|
| Three of Powers.t
|
|
| Four of (int * int * int * int)
|
|
| Six of (Powers.t * Powers.t)
|
|
| Nine of (Powers.t * Powers.t * Powers.t)
|
|
| Twelve of (Powers.t * Powers.t * Powers.t * Powers.t)
|
|
|
|
let of_powers_three { x=a ; y=b ; z=c ; _ } =
|
|
assert (
|
|
let alpha = a lor b lor c in
|
|
alpha >= 0 && alpha < (1 lsl 15)
|
|
);
|
|
make 3 a <+ b <+ c
|
|
|
|
let of_int_four i j k l =
|
|
assert (
|
|
let alpha = i lor j lor k lor l in
|
|
alpha >= 0 && alpha < (1 lsl 15)
|
|
);
|
|
make 4 i <+ j <+ k <+ l
|
|
|
|
let of_powers_six { x=a ; y=b ; z=c ; _ } { x=d ; y=e ; z=f ; _ } =
|
|
assert (
|
|
let alpha = a lor b lor c lor d lor e lor f in
|
|
alpha >= 0 && alpha < (1 lsl 10)
|
|
);
|
|
make 6 a << b << c << d << e << f
|
|
|
|
let of_powers_nine { x=a ; y=b ; z=c ; _ } { x=d ; y=e ; z=f ; _ }
|
|
{ x=g ; y=h ; z=i ; _ } =
|
|
assert (
|
|
let alpha = a lor b lor c lor d lor e lor f lor g lor h lor i in
|
|
alpha >= 0 && alpha < (1 lsl 10)
|
|
);
|
|
make 9 a << b << c << d << e << f
|
|
<| g << h << i
|
|
|
|
let of_powers_twelve { x=a ; y=b ; z=c ; _ } { x=d ; y=e ; z=f ; _ }
|
|
{ x=g ; y=h ; z=i ; _ } { x=j ; y=k ; z=l ; _ } =
|
|
assert (
|
|
let alpha = a lor b lor c lor d lor e lor f
|
|
lor g lor h lor i lor j lor k lor l
|
|
in
|
|
alpha >= 0 && alpha < (1 lsl 10)
|
|
);
|
|
make 12 a << b << c << d << e << f
|
|
<| g << h << i << j << k << l
|
|
|
|
|
|
let of_powers a =
|
|
match a with
|
|
| Three a -> of_powers_three a
|
|
| Six (a,b) -> of_powers_six a b
|
|
| Twelve (a,b,c,d) -> of_powers_twelve a b c d
|
|
| Nine (a,b,c) -> of_powers_nine a b c
|
|
| _ -> invalid_arg "of_powers"
|
|
|
|
|
|
let mask10 = 0x3ff
|
|
and mask15 = 0x7fff
|
|
|
|
|
|
let of_int_array = function
|
|
| [| a ; b ; c ; d |] -> of_int_four a b c d
|
|
| _ -> invalid_arg "of_int_array"
|
|
|
|
|
|
(** Transform the Zkey into an int array *)
|
|
let to_int_array { left ; right ; kind } =
|
|
match kind with
|
|
| 3 -> [|
|
|
mask15 land (right lsr 30) ;
|
|
mask15 land (right lsr 15) ;
|
|
mask15 land right
|
|
|]
|
|
|
|
| 4 -> [|
|
|
mask15 land (right lsr 45) ;
|
|
mask15 land (right lsr 30) ;
|
|
mask15 land (right lsr 15) ;
|
|
mask15 land right
|
|
|]
|
|
|
|
| 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
|
|
|]
|
|
|
|
| 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
|
|
|]
|
|
|
|
| 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
|
|
|]
|
|
| _ -> invalid_arg (__FILE__^": to_int_array")
|
|
|
|
|
|
|
|
(** Transform the Zkey into an int tuple *)
|
|
let to_powers { left ; right ; kind } =
|
|
match kind with
|
|
| 3 -> Three (Powers.of_int_tuple (
|
|
mask15 land (right lsr 30) ,
|
|
mask15 land (right lsr 15) ,
|
|
mask15 land right
|
|
))
|
|
|
|
| 6 -> Six (Powers.of_int_tuple
|
|
( mask10 land (right lsr 50) ,
|
|
mask10 land (right lsr 40) ,
|
|
mask10 land (right lsr 30)),
|
|
Powers.of_int_tuple
|
|
( mask10 land (right lsr 20) ,
|
|
mask10 land (right lsr 10) ,
|
|
mask10 land right )
|
|
)
|
|
|
|
| 12 -> Twelve (Powers.of_int_tuple
|
|
( mask10 land (left lsr 50) ,
|
|
mask10 land (left lsr 40) ,
|
|
mask10 land (left lsr 30)),
|
|
Powers.of_int_tuple
|
|
( mask10 land (left lsr 20) ,
|
|
mask10 land (left lsr 10) ,
|
|
mask10 land left ) ,
|
|
Powers.of_int_tuple
|
|
( mask10 land (right lsr 50) ,
|
|
mask10 land (right lsr 40) ,
|
|
mask10 land (right lsr 30)),
|
|
Powers.of_int_tuple
|
|
( mask10 land (right lsr 20) ,
|
|
mask10 land (right lsr 10) ,
|
|
mask10 land right )
|
|
)
|
|
|
|
| 9 -> Nine (Powers.of_int_tuple
|
|
( mask10 land (left lsr 20) ,
|
|
mask10 land (left lsr 10) ,
|
|
mask10 land left ) ,
|
|
Powers.of_int_tuple
|
|
( mask10 land (right lsr 50) ,
|
|
mask10 land (right lsr 40) ,
|
|
mask10 land (right lsr 30)),
|
|
Powers.of_int_tuple
|
|
( mask10 land (right lsr 20) ,
|
|
mask10 land (right lsr 10) ,
|
|
mask10 land right )
|
|
)
|
|
|
|
| _ -> invalid_arg (__FILE__^": to_powers")
|
|
|
|
|
|
|
|
let hash = Hashtbl.hash
|
|
|
|
let equal
|
|
{ right = r1 ; left = l1 ; kind = k1 }
|
|
{ right = r2 ; left = l2 ; kind = k2 } =
|
|
r1 = r2 && l1 = l2 && k1 = k2
|
|
|
|
let compare
|
|
{ right = r1 ; left = l1 ; kind = k1 }
|
|
{ right = r2 ; left = l2 ; kind = k2 } =
|
|
if k1 <> k2 then invalid_arg (__FILE__^": cmp");
|
|
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 { left ; right ; kind } =
|
|
"< " ^ string_of_int left ^ string_of_int right ^ " | " ^ (
|
|
to_int_array { left ; right ; kind }
|
|
|> Array.map string_of_int
|
|
|> Array.to_list
|
|
|> String.concat ", "
|
|
) ^ " >"
|
|
|