Add the LXM bitgenerator.

bin/bench.ml

@@ -18,6 +18,7 @@ let pairs = [
     "Xoshiro256", (module Xoshiro256: S);
     "Philox4x64", (module Philox4x64: S);
     "ChaCha", (module ChaCha: S);
+    "LXM", (module LXM: S)
 ]
 
 

bin/crush.ml

@@ -52,6 +52,7 @@ let to_module = function
     | "philox4x64" -> (module Philox4x64 : S)
     | "sfc64" -> (module SFC64 : S)
     | "chacha" -> (module ChaCha : S)
+    | "lxm" -> (module LXM : S)
     | _ -> failwith "Unknown PRNG"
 
 

lib/bitgen.ml

@@ -32,3 +32,4 @@ module PCG64 = Pcg.PCG64
 module Xoshiro256 = Xoshiro.Xoshiro256StarStar
 module Philox4x64 = Philox.Philox
 module ChaCha = Chacha.ChaCha128Counter
+module LXM = Lxm.LXM

lib/lxm.ml

@@ -0,0 +1,77 @@
+open Stdint
+
+
+module LXM : sig
+    include Common.BITGEN
+
+    val jump : t -> t
+    (** [jump t] is equivalent to {m 2^{128}} calls to {!LXM.next_uint64}. *)
+end = struct
+  type t = {state : uint64 array; lcg_state : uint64; b : uint64; ustore : uint32 option}
+
+
+  let rotl x k = let y = 64 - k in Uint64.(logor (shift_left x k) (shift_right x y))
+
+
+  let p0 = Uint64.of_int64 0xbf58476d1ce4e5b9L
+  let p1 = Uint64.of_int64 0x94d049bb133111ebL
+  let default_add_val = Uint64.of_int 3037000493
+  let multiplier = Uint64.of_int64 2862933555777941757L
+
+
+  let murmur_hash3 key =
+    Uint64.(logxor key (shift_right key 30) * p0)
+    |> (fun k -> Uint64.(logxor k (shift_right k 27) * p1))
+    |> (fun k -> Uint64.(logxor k (shift_right k 31)))
+
+
+  let xorshift s = 
+    let open Uint64 in
+    let x2 = logxor s.(2) s.(0) and x3 = logxor s.(3) s.(1)
+    in [|logxor s.(0) x3; logxor s.(1) x2; shift_left s.(1) 17 |> logxor x2; rotl x3 45|]
+
+
+  let next_uint64 t =
+    murmur_hash3 Uint64.(t.state.(0) + t.lcg_state),
+    {t with lcg_state = Uint64.(t.lcg_state * multiplier + t.b); state = xorshift t.state}
+
+
+  let next_uint32 t = match Common.next_uint32 ~next:next_uint64 t t.ustore with
+    | u, s, ustore -> u, {s with ustore}
+
+
+  let next_double t = Common.next_double ~nextu64:next_uint64 t
+
+
+  let next_bounded_uint64 bound t = Common.next_bounded_uint64 bound ~nextu64:next_uint64 t
+
+
+  let zeros = Uint64.[|zero; zero; zero; zero|]
+  let jump = Uint64.([|of_int 0x180ec6d33cfd0aba; of_int64 0xd5a61266f0c9392cL;
+                       of_int64 0xa9582618e03fc9aaL; of_int 0x39abdc4529b1661c|])
+  let xorshift_jump t = 
+    let rec loop b j (acc0, acc1) =
+        match b >= 64, Uint64.(logand j (shift_left one b) > zero) with
+        | true, _ -> acc0, acc1 
+        | false, true -> loop (b + 1) j (Array.map2 Uint64.logxor acc0 acc1, xorshift acc1)
+        | false, false -> loop (b + 1) j (acc0, xorshift acc1)
+    in {t with state = Array.fold_right (loop 0) jump (zeros, t.state) |> fst; ustore = None}
+
+
+  let jump = xorshift_jump
+
+
+  let initialize_full b seed =
+    let rec loop state = function
+      | b when b <> Uint64.zero -> state
+      | b ->
+          let state' = Seed.SeedSequence.generate_64bit_state 5 seed in
+          let bits = Array.fold_left Uint64.logor b (Array.sub state' 0 4)
+          in loop state' bits
+    in
+    let s = loop (Seed.SeedSequence.generate_64bit_state 5 seed) Uint64.zero in
+    {state = Array.sub s 0 4; lcg_state = s.(4); b = Uint64.(logor b one); ustore = None}
+
+
+  let initialize seed = initialize_full default_add_val seed
+end