mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-11-06 22:23:42 +01:00
347 lines
10 KiB
Org Mode
347 lines
10 KiB
Org Mode
#+begin_src elisp tangle: no :results none :exports none
|
|
(setq pwd (file-name-directory buffer-file-name))
|
|
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
|
(setq lib (concat pwd "lib/"))
|
|
(setq testdir (concat pwd "test/"))
|
|
(setq mli (concat lib name ".mli"))
|
|
(setq ml (concat lib name ".ml"))
|
|
(setq test-ml (concat testdir name ".ml"))
|
|
(org-babel-tangle)
|
|
#+end_src
|
|
|
|
* Zkey
|
|
:PROPERTIES:
|
|
:header-args: :noweb yes :comments both
|
|
:END:
|
|
|
|
Encodes the powers of x, y, z in a compact form, suitable for being
|
|
used as keys in a hash table.
|
|
|
|
Internally, the ~Zkey.t~ is made of two integers, ~left~ and ~right~.
|
|
The small integers x, y and z are stored compactly in this 126-bits
|
|
space:
|
|
|
|
#+begin_example
|
|
Left Right
|
|
3 [--------------------------------------------------------------] [------------------|---------------|---------------|---------------]
|
|
x y z
|
|
|
|
6 [--------------------------------------------------------------] [---|----------|----------|----------|----------|----------|---------]
|
|
x1 y1 z1 x2 y2 z2
|
|
|
|
9 [---------------------------------|----------|----------|---------] [---|----------|----------|----------|----------|----------|---------]
|
|
x1 y1 z1 x2 y2 z2 x3 y3 z3
|
|
|
|
12 [---|----------|----------|----------|----------|----------|---------] [---|----------|----------|----------|----------|----------|---------]
|
|
x1 y1 z1 x2 y2 z2 x3 y3 z3 x4 y4 z4
|
|
#+end_example
|
|
|
|
The values of x,y,z should be positive and should not exceed 32767 for ~kind=3~. For all other kinds kinds the values should not exceed 1023.
|
|
|
|
** Types
|
|
|
|
#+begin_src ocaml :tangle (eval mli)
|
|
type t
|
|
|
|
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)
|
|
#+end_src
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
type t =
|
|
{
|
|
mutable left : int;
|
|
mutable right : int;
|
|
kind : int ;
|
|
}
|
|
|
|
open Powers
|
|
|
|
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)
|
|
#+end_src
|
|
|
|
** Conversions
|
|
|
|
#+begin_src ocaml :tangle (eval mli)
|
|
val of_powers_three : Powers.t -> t
|
|
val of_powers_six : Powers.t -> Powers.t -> t
|
|
val of_powers_nine : Powers.t -> Powers.t -> Powers.t -> t
|
|
val of_powers_twelve : Powers.t -> Powers.t -> Powers.t -> Powers.t -> t
|
|
val of_powers : kind -> t
|
|
val of_int_array : int array -> t
|
|
val of_int_four : int -> int -> int -> int -> t
|
|
val to_int_array : t -> int array
|
|
val to_powers : t -> kind
|
|
val to_string : t -> string
|
|
#+end_src
|
|
|
|
| ~of_powers_three~ | Create from a ~Powers.t~ |
|
|
| ~of_powers_six~ | Create from two ~Powers.t~ |
|
|
| ~of_powers_nine~ | Create from three ~Powers.t~ |
|
|
| ~of_powers_twelve~ | Create from four ~Powers.t~ |
|
|
| ~of_powers~ | Create using the ~kind~ type |
|
|
| ~of_int_array~ | Convert from an ~int~ array |
|
|
| ~of_int_four~ | Create from four ~ints~ |
|
|
| ~to_int_array~ | Convert to an ~int~ array |
|
|
| ~to_powers~ | Convert to an ~Powers.t~ array |
|
|
| ~to_string~ | Pretty printing |
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
(** 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
|
|
|
|
|
|
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 ~kind: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 ~kind: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 ~kind: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 ~kind: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 ~kind: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")
|
|
|
|
|
|
#+end_src
|
|
|
|
** Functions for hash tables
|
|
|
|
#+begin_src ocaml :tangle (eval mli)
|
|
val hash : t -> int
|
|
val equal : t -> t -> bool
|
|
val compare : t -> t -> int
|
|
#+end_src
|
|
|
|
| ~hash~ | Associates a nonnegative integer to any Zkey |
|
|
| ~equal~ | The equal function. True if two Zkeys are equal |
|
|
| ~compare~ | Comparison function, used for sorting |
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
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 ", "
|
|
) ^ " >"
|
|
#+end_src
|
|
|
|
** Printers
|
|
|
|
#+begin_src ocaml :tangle (eval mli)
|
|
val pp : Format.formatter -> t -> unit
|
|
#+end_src
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
let pp ppf t =
|
|
Format.fprintf ppf "@[%s@]" (to_string t)
|
|
#+end_src
|