Skip to content

Commit 692eb77

Browse files
Pass Automated Testing SuitePass Automated Testing Suite
authored andcommitted
Add PCG64DXSM variant of the PCG64 bitgenerator.
1 parent f2f0a3a commit 692eb77

File tree

3 files changed

+55
-10
lines changed

3 files changed

+55
-10
lines changed

lib/bitgen.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ module SeedSequence = Seed.SeedSequence
2929

3030
module SFC64 = Sfc.SFC64
3131
module PCG64 = Pcg.PCG64
32+
module PCG64DXSM = Pcg.PCG64DXSM
3233
module Xoshiro256 = Xoshiro.Xoshiro256StarStar
3334
module Philox4x64 = Philox.Philox
3435
module ChaCha = Chacha.ChaCha128Counter

lib/pcg.ml

Lines changed: 47 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
open Stdint
77

88

9-
module PCG64 : sig
9+
module type PCG_TYPE = sig
1010
(** PCG-64 is a 128-bit implementation of O'Neill's permutation congruential
1111
generator. PCG-64 has a period of {m 2^{128}} and supports advancing an arbitrary
1212
number of steps as well as {m 2^{127}} streams.
@@ -23,16 +23,24 @@ module PCG64 : sig
2323
val advance : int128 -> t -> t
2424
(** [advance delta] Advances the underlying RNG as if [delta] draws have been made.
2525
The returned state is that of the generator [delta] steps forward. *)
26+
end
27+
28+
29+
module type FUNCTOR_SIG = sig
30+
type t = {s : setseq; ustore : uint32 option}
31+
and setseq = {state : uint128; increment : uint128}
32+
val multiplier : uint128
33+
val output : uint128 -> uint64
34+
val next : setseq -> uint64 * setseq
35+
end
2636

27-
val next_bounded_uint64 : uint64 -> t -> uint64 * t
28-
(** [next_bounded_uint64 bound t] returns an unsigned 64bit integers in the range
29-
(0, bound) as well as the state of the generator advanced one step forward. *)
30-
end = struct
37+
38+
module PCG64Impl = struct
3139
type t = {s : setseq; ustore : uint32 option}
3240
and setseq = {state : uint128; increment : uint128}
3341

3442
let multiplier = Uint128.of_string "0x2360ed051fc65da44385df649fccf645"
35-
let sixtythree = Uint32.of_int 63
43+
let sixtythree = Uint32.of_int32 63l
3644

3745
(* Uses the XSL-RR output function *)
3846
let output state =
@@ -45,14 +53,40 @@ end = struct
4553
let next {state; increment} =
4654
let state' = Uint128.(state * multiplier + increment) in
4755
output state', {state = state'; increment}
56+
end
57+
58+
59+
module PCG64DXSMImpl = struct
60+
type t = {s : setseq; ustore : uint32 option}
61+
and setseq = {state : uint128; increment : uint128}
62+
63+
let cheap_multiplier = Uint64.of_string "0xda942042e4dd58b5"
64+
let multiplier = Uint128.of_uint64 cheap_multiplier
65+
66+
let output state =
67+
let hi0 = Uint128.(shift_right state 64 |> to_uint64) in
68+
let lo = Uint128.(logor state one |> to_uint64) in
69+
let hi1 = Uint64.(shift_right hi0 32 |> logxor hi0) in
70+
let hi2 = Uint64.(hi1 * cheap_multiplier) in
71+
let hi3 = Uint64.(shift_right hi2 48 |> logxor hi2) in
72+
let hi4 = Uint64.(hi3 * lo) in
73+
hi4
74+
75+
76+
let next {state; increment} =
77+
output state, {state = Uint128.(state * multiplier + increment); increment}
78+
end
79+
80+
81+
module Make (M : FUNCTOR_SIG) = struct
82+
include M
4883

4984

5085
let next_uint64 t = match next t.s with
5186
| u, s -> u, {t with s}
52-
5387

54-
let next_uint32 t =
55-
match Common.next_uint32 ~next:next t.s t.ustore with
88+
89+
let next_uint32 t = match Common.next_uint32 ~next:next t.s t.ustore with
5690
| u, s, ustore -> u, {s; ustore}
5791

5892

@@ -83,3 +117,7 @@ end = struct
83117
let initialize seed =
84118
{s = set_seed (Seed.SeedSequence.generate_64bit_state 4 seed); ustore = None}
85119
end
120+
121+
122+
module PCG64DXSM : PCG_TYPE = Make (PCG64DXSMImpl)
123+
module PCG64 : PCG_TYPE = Make (PCG64Impl)

test/test_pcg.ml

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,13 @@ let test_pcg_datasets _ =
1818
(Sys.getcwd () ^ "/../../../test/data/pcg64-testset-1.csv");
1919
Testconf.bitgen_groundtruth
2020
(module PCG64)
21-
(Sys.getcwd () ^ "/../../../test/data/pcg64-testset-2.csv")
21+
(Sys.getcwd () ^ "/../../../test/data/pcg64-testset-2.csv");
22+
Testconf.bitgen_groundtruth
23+
(module PCG64DXSM)
24+
(Sys.getcwd () ^ "/../../../test/data/pcg64dxsm-testset-1.csv");
25+
Testconf.bitgen_groundtruth
26+
(module PCG64DXSM)
27+
(Sys.getcwd () ^ "/../../../test/data/pcg64dxsm-testset-2.csv")
2228

2329

2430
let test_bounded_u64 _ = Testconf.test_bounded_u64 (module PCG64)

0 commit comments

Comments
 (0)