PURE
14 |
--------------------------------------------------------------------------------
/docs/type_PRNG.Chacha.State.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 | STATE
14 |
--------------------------------------------------------------------------------
/docs/type_PRNG.Splitmix.Pure.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 | PURE
14 |
--------------------------------------------------------------------------------
/docs/type_PRNG.Splitmix.State.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 | STATE
14 |
--------------------------------------------------------------------------------
/pringo.opam:
--------------------------------------------------------------------------------
1 | opam-version: "2.0"
2 | name: "pringo"
3 | synopsis: "Pseudo-random, splittable number generators"
4 | description:
5 | "Pseudo-random number generators that support splitting and two interfaces: one stateful, one purely functional"
6 | maintainer: "Xavier Leroy sig module State : STATE module Pure : PURE end
14 |
--------------------------------------------------------------------------------
/docs/type_PRNG.Splitmix.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 | sig module State : STATE module Pure : PURE end
14 |
--------------------------------------------------------------------------------
/docs/index_module_types.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 | P | |
| PURE [PRNG] | 20 ||
S | |
| STATE [PRNG] | 23 |
T | |
| t [PRNG.PURE] | 20 ||
| t [PRNG.STATE] | 22 |
23 |
26 | The type of generators 24 | 25 | |
module Splitmix:sig..end
module State:25 |PRNG.STATE
module Pure:26 | -------------------------------------------------------------------------------- /docs/PRNG.Chacha.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |PRNG.PURE
module Chacha:sig..end
module State:27 |PRNG.STATE
module Pure:28 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 |PRNG.PURE
| PRNG |
26 |
42 | This library provides pseudo-random number generators (PRNGs) comparable
27 | to that of the Random module from OCaml's standard library, but with
28 | two extensions: Generators are "splittable": they support a |
C | |
| Chacha [PRNG] | 20 ||
L | |
| LXM [PRNG] | 23 ||
P | |
| PRNG | 26 |
27 |
43 | This library provides pseudo-random number generators (PRNGs) comparable
28 | to that of the Random module from OCaml's standard library, but with
29 | two extensions: Generators are "splittable": they support a |
| Pure [PRNG.LXM] | 45 ||
| Pure [PRNG.Chacha] | 47 ||
| Pure [PRNG.Splitmix] | 49 ||
S | |
| Splitmix [PRNG] | 52 ||
| State [PRNG.LXM] | 54 ||
| State [PRNG.Chacha] | 56 ||
| State [PRNG.Splitmix] | 58 |
module type PURE =sig..end
type
28 |
29 | val seed : string -> t
31 | val make : int array -> t
32 | val make_self_init : unit -> tval bool : t -> bool * t
34 | val bit : t -> bool * t
35 | val uniform : t -> float * t
36 | val float : float -> t -> float * t
37 | val byte : t -> int * t
38 | val bits8 : t -> int * t
39 | val int : int -> t -> int * t
40 | val bits : t -> int * t
41 | val bits30 : t -> int * t
42 | val bits32 : t -> int32 * t
43 | val int32 : int32 -> t -> int32 * t
44 | val bits64 : t -> int64 * t
45 | val int64 : int64 -> t -> int64 * t
46 | val nativebits : t -> nativeint * t
47 | val nativeint : nativeint -> t -> nativeint * t
48 | val char : t -> char * tval split : t -> t * t
50 |
--------------------------------------------------------------------------------
/docs/PRNG.Chacha.Pure.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 | module Pure:PRNG.PURE
type
28 |
29 | val seed : string -> t
31 | val make : int array -> t
32 | val make_self_init : unit -> tval bool : t -> bool * t
34 | val bit : t -> bool * t
35 | val uniform : t -> float * t
36 | val float : float -> t -> float * t
37 | val byte : t -> int * t
38 | val bits8 : t -> int * t
39 | val int : int -> t -> int * t
40 | val bits : t -> int * t
41 | val bits30 : t -> int * t
42 | val bits32 : t -> int32 * t
43 | val int32 : int32 -> t -> int32 * t
44 | val bits64 : t -> int64 * t
45 | val int64 : int64 -> t -> int64 * t
46 | val nativebits : t -> nativeint * t
47 | val nativeint : nativeint -> t -> nativeint * t
48 | val char : t -> char * tval split : t -> t * t
50 |
--------------------------------------------------------------------------------
/docs/PRNG.Splitmix.Pure.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 | module Pure:PRNG.PURE
type
28 |
29 | val seed : string -> t
31 | val make : int array -> t
32 | val make_self_init : unit -> tval bool : t -> bool * t
34 | val bit : t -> bool * t
35 | val uniform : t -> float * t
36 | val float : float -> t -> float * t
37 | val byte : t -> int * t
38 | val bits8 : t -> int * t
39 | val int : int -> t -> int * t
40 | val bits : t -> int * t
41 | val bits30 : t -> int * t
42 | val bits32 : t -> int32 * t
43 | val int32 : int32 -> t -> int32 * t
44 | val bits64 : t -> int64 * t
45 | val int64 : int64 -> t -> int64 * t
46 | val nativebits : t -> nativeint * t
47 | val nativeint : nativeint -> t -> nativeint * t
48 | val char : t -> char * tval split : t -> t * t
50 |
--------------------------------------------------------------------------------
/docs/type_PRNG.STATE.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 | sig
14 | type t
15 | val seed : string -> PRNG.STATE.t
16 | val make : int array -> PRNG.STATE.t
17 | val make_self_init : unit -> PRNG.STATE.t
18 | val bool : PRNG.STATE.t -> bool
19 | val bit : PRNG.STATE.t -> bool
20 | val uniform : PRNG.STATE.t -> float
21 | val float : PRNG.STATE.t -> float -> float
22 | val byte : PRNG.STATE.t -> int
23 | val bits8 : PRNG.STATE.t -> int
24 | val bits : PRNG.STATE.t -> int
25 | val bits30 : PRNG.STATE.t -> int
26 | val int : PRNG.STATE.t -> int -> int
27 | val bits32 : PRNG.STATE.t -> int32
28 | val int32 : PRNG.STATE.t -> int32 -> int32
29 | val bits64 : PRNG.STATE.t -> int64
30 | val int64 : PRNG.STATE.t -> int64 -> int64
31 | val nativebits : PRNG.STATE.t -> nativeint
32 | val nativeint : PRNG.STATE.t -> nativeint -> nativeint
33 | val char : PRNG.STATE.t -> char
34 | val bytes : PRNG.STATE.t -> bytes -> int -> int -> unit
35 | val split : PRNG.STATE.t -> PRNG.STATE.t
36 | val copy : PRNG.STATE.t -> PRNG.STATE.t
37 | val reseed : PRNG.STATE.t -> string -> unit
38 | val remake : PRNG.STATE.t -> int array -> unit
39 | end
40 |
--------------------------------------------------------------------------------
/docs/PRNG.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 | module PRNG:sig..end
This library provides pseudo-random number generators (PRNGs) comparable 28 | to that of the Random module from OCaml's standard library, but with 29 | two extensions:
30 |split operation that
32 | returns a new generator that is statistically independent from the
33 | current generator. Both generators can be used in parallel, and can
34 | be further splitted, without introducing statistical bias. This
35 | splitting operation is particularly useful to implement the lazy
36 | generation of pseudo-random infinite data structures such as
37 | functions or streams.Random.State standard library module, another, purely
40 | functional interface is provided. In the functional interface, the
41 | current state of the PRNG appears as parameter but also as result of
42 | the number generation functions. This interface can be used
43 | directly within a state monad.module type STATE =sig..end
In this alternate interface, number-generating functions do not 50 | update the current state of the generator in-place. Instead, they 51 | return the updated generator as a second result. It is the 52 | programmer's responsibility to correctly thread the generators 53 | through the program, typically by using a state monad.
54 | 55 |All operations of the STATE interface are provided except
56 | bytes (too imperative) and copy, reseed and remake (pointless).
module type PURE =sig..end
module Splitmix:sig..end
This is an implementation of the STATE and PURE interfaces
60 | based on the Splitmix design by Guy L. Steele Jr., Doug Lea, and
61 | Christine H. Flood.
For seeding, 64 bits of entropy is recommended. Seeds of 8
64 | characters or less are used as a 64-bit integer. Longer seeds
65 | are hashed using Digest.string before being used.
Reseeding is recommended after 232 numbers have been generated.
68 |module Chacha:sig..end
This is an implementation of the STATE and PURE interfaces
70 | based on the Chacha 20 stream cipher by D. J. Bernstein.
For seeding, 128 bits of entropy is recommended. Seeds of up 73 | to 32 characters are used as keys to the Chacha 20 cipher. 74 | Characters beyond the first 32 are ignored.
75 | 76 |Reseeding is recommended after 264 numbers have been generated.
77 |module LXM:sig..end
This is an implementation of the STATE and PURE interfaces
79 | based on the LXM design by Guy L. Steele Jr, and Sebastiano Vigna.
80 | We use the L64X128 variant from Fig. 1 of their OOPSLA 2021 paper.
For seeding, 128 bits of entropy is recommended. The last 32 bytes 83 | of the seed are used to initialize the PRNG state.
84 | 85 |This PRNG has a large internal state (192 bits) and a period of 86 | 2192 - 264. Therefore, reseeding should not be necessary 87 | in practice.
88 | 89 | -------------------------------------------------------------------------------- /docs/type_PRNG.PURE.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 |sig
14 | type t
15 | val seed : string -> PRNG.PURE.t
16 | val make : int array -> PRNG.PURE.t
17 | val make_self_init : unit -> PRNG.PURE.t
18 | val bool : PRNG.PURE.t -> bool * PRNG.PURE.t
19 | val bit : PRNG.PURE.t -> bool * PRNG.PURE.t
20 | val uniform : PRNG.PURE.t -> float * PRNG.PURE.t
21 | val float : float -> PRNG.PURE.t -> float * PRNG.PURE.t
22 | val byte : PRNG.PURE.t -> int * PRNG.PURE.t
23 | val bits8 : PRNG.PURE.t -> int * PRNG.PURE.t
24 | val int : int -> PRNG.PURE.t -> int * PRNG.PURE.t
25 | val bits : PRNG.PURE.t -> int * PRNG.PURE.t
26 | val bits30 : PRNG.PURE.t -> int * PRNG.PURE.t
27 | val bits32 : PRNG.PURE.t -> int32 * PRNG.PURE.t
28 | val int32 : int32 -> PRNG.PURE.t -> int32 * PRNG.PURE.t
29 | val bits64 : PRNG.PURE.t -> int64 * PRNG.PURE.t
30 | val int64 : int64 -> PRNG.PURE.t -> int64 * PRNG.PURE.t
31 | val nativebits : PRNG.PURE.t -> nativeint * PRNG.PURE.t
32 | val nativeint : nativeint -> PRNG.PURE.t -> nativeint * PRNG.PURE.t
33 | val char : PRNG.PURE.t -> char * PRNG.PURE.t
34 | val split : PRNG.PURE.t -> PRNG.PURE.t * PRNG.PURE.t
35 | end
36 |
--------------------------------------------------------------------------------
/test/u01.ml:
--------------------------------------------------------------------------------
1 | open TestU01
2 |
3 | (* Creating generators *)
4 |
5 | let gfloat name (f: unit -> float) =
6 | Unif01.create_extern_gen_01 name f
7 |
8 | let gint32 name (f: unit -> int32) =
9 | Unif01.create_extern_gen_int32 name f
10 |
11 | let gint8 name (f: unit -> int) =
12 | let g () =
13 | let b1 = f () in
14 | let b2 = f () in
15 | let b3 = f () in
16 | let b4 = f () in
17 | let b12 = b1 lsl 8 + b2 in
18 | let b34 = b3 lsl 8 + b4 in
19 | Int32.(add (shift_left (of_int b12) 16) (of_int b34))
20 | in gint32 name g
21 |
22 | let gint32list name (f: unit -> int32 list) =
23 | let acc = ref [] in
24 | let rec g () =
25 | match !acc with
26 | | [] -> acc := f(); g()
27 | | h :: t -> acc := t; h
28 | in gint32 name g
29 |
30 | let gint32seq name (s: int32 Seq.t) =
31 | let rs = ref s in
32 | let rec f () =
33 | match !rs () with
34 | | Seq.Nil -> assert false
35 | | Seq.Cons(n, s') -> rs := s'; n
36 | in gint32 name f
37 |
38 | let gint64 name (f: unit -> int64) =
39 | let g () =
40 | let n = f() in
41 | [Int64.to_int32 n; Int64.(to_int32 (shift_right_logical n 32))]
42 | in gint32list name g
43 |
44 | (* Test harness *)
45 |
46 | let seed = ref "Jamais un coup de dés n'abolira le hasard. -Mallarmé"
47 |
48 | module type TEST = sig
49 | val gen_floats: unit -> Unif01.gen
50 | val gen_bytes: unit -> Unif01.gen
51 | val gen_int32: unit -> Unif01.gen
52 | val gen_int64: unit -> Unif01.gen
53 | val gen_blocks: int -> Unif01.gen
54 | val treesplits: int -> Unif01.gen
55 | val laggedsplit: int -> Unif01.gen
56 | val split_l: unit -> Unif01.gen
57 | val split_r: unit -> Unif01.gen
58 | val split_a: unit -> Unif01.gen
59 | val split_s: unit -> Unif01.gen
60 | end
61 |
62 | module Maketest (R: PRNG.STATE) : TEST = struct
63 |
64 | let init () = R.seed !seed
65 |
66 | let gen_floats () =
67 | let g = init() in gfloat "float" (fun () -> R.uniform g)
68 |
69 | let gen_bytes () =
70 | let g = init() in gint8 "byte" (fun () -> R.byte g)
71 |
72 | let gen_int32 () =
73 | let g = init() in gint32 "int32" (fun () -> R.bits32 g)
74 |
75 | let gen_int64 () =
76 | let g = init() in gint64 "int64" (fun () -> R.bits64 g)
77 |
78 | let gen_blocks n =
79 | let g = init() in
80 | let b = Bytes.create n in
81 | let pos = ref n in
82 | let f () =
83 | let p = !pos in
84 | if p < n
85 | then (pos := p + 1; Bytes.get_uint8 b p)
86 | else (R.bytes g b 0 n; pos := 1; Bytes.get_uint8 b 0)
87 | in gint8 "blocks" f
88 |
89 | let treesplits n =
90 | let rec mkgens n g =
91 | if n <= 0 then [g] else begin
92 | let g' = R.split g in
93 | mkgens (n-1) g @ mkgens (n-1) g'
94 | end in
95 | let gl = mkgens n (init()) in
96 | let f () = List.map R.bits32 gl
97 | in gint32list "treesplits" f
98 |
99 | let laggedsplit n =
100 | let g = ref (init())
101 | and i = ref 0 in
102 | let rec f () =
103 | if !i < n
104 | then (incr i; R.bits32 !g)
105 | else (i := 0; g := R.split !g; f ())
106 | in gint32 "laggedsplit" f
107 |
108 | (* Split sequence "S_L". Split, generate number with "left" generator, then
109 | recurse using "right" generator.
110 |
111 | This and the following "split sequences" are defined in sections 5.5 and 5.6
112 | of:
113 |
114 | Hans Georg Schaathun. 2015. Evaluation of splittable pseudo-random
115 | generators. Journal of Functional Programming, Vol. 25.
116 | https://doi.org/10.1017/S095679681500012X
117 |
118 | split
119 | / \
120 | (1) …
121 |
122 | *)
123 |
124 | let split_l () =
125 | let rec spl g () =
126 | let gR = R.split g in (* now gL = g *)
127 | Seq.Cons(R.bits32 g (* 1 *), spl gR)
128 | in gint32seq "split_l" (spl (init()))
129 |
130 | (* Split sequence "S_R". Split, generate number with "right" generator, then
131 | recurse using "left" generator.
132 |
133 | split
134 | / \
135 | … (1)
136 |
137 | *)
138 |
139 | let split_r () =
140 | let rec spl g () =
141 | let gR = R.split g in (* now gL = g *)
142 | Seq.Cons(R.bits32 gR (* 1 *), spl g)
143 | in gint32seq "split_r" (spl (init()))
144 |
145 | (* Split sequence "S_A". Split, generate number with "right" generator, then
146 | split again, generate number with "left" generator, and recurse with "right"
147 | generator.
148 |
149 | split
150 | / \
151 | split (1)
152 | / \
153 | (2) …
154 |
155 | *)
156 |
157 | let split_a () =
158 | let rec spl g () =
159 | let gR = R.split g in
160 | let n1 = R.bits32 gR in (* 1 *)
161 | let gLR = R.split g in
162 | let n2 = R.bits32 g in (* 2 *)
163 | Seq.Cons(n1, fun () -> Seq.Cons(n2, spl gLR))
164 | in gint32seq "split_a" (spl (init()))
165 |
166 | (* Split sequence "S".
167 |
168 | split
169 | / \
170 | … split
171 | / \
172 | split split
173 | / \ / \
174 | (1) (2) (3) (4)
175 |
176 | *)
177 |
178 | let split_s () =
179 | let rec spl g () =
180 | let gR = R.split g in (* now gL = g *)
181 | let gRR = R.split gR in (* now gRL = gR *)
182 | let gRRR = R.split gRR in (* now gRRL = gRR *)
183 | let gRLR = R.split gR in (* now gRLL = gR *)
184 | let n1 = R.bits32 gR (* 1 *) in
185 | let n2 = R.bits32 gRLR (* 2 *) in
186 | let n3 = R.bits32 gRR (* 3 *) in
187 | let n4 = R.bits32 gRRR (* 4 *) in
188 | Seq.Cons(n1, fun () -> Seq.Cons(n2, fun () -> Seq.Cons(n3, fun () -> Seq.Cons(n4, spl g))))
189 | in gint32seq "split_s" (spl (init()))
190 |
191 | end
192 |
193 | module T1 = Maketest(PRNG.Splitmix.State)
194 | module T2 = Maketest(PRNG.Chacha.State)
195 | module T3 = Maketest(PRNG.LXM.State)
196 |
197 | let dut = ref (module T1 : TEST)
198 |
199 | let gen_floats () =
200 | let module T = (val !dut) in T.gen_floats()
201 | let gen_bytes () =
202 | let module T = (val !dut) in T.gen_bytes()
203 | let gen_int32 () =
204 | let module T = (val !dut) in T.gen_int32()
205 | let gen_int64 () =
206 | let module T = (val !dut) in T.gen_int64()
207 | let gen_blocks n =
208 | let module T = (val !dut) in T.gen_blocks n
209 | let treesplits n =
210 | let module T = (val !dut) in T.treesplits n
211 | let laggedsplit n =
212 | let module T = (val !dut) in T.laggedsplit n
213 | let split_l () =
214 | let module T = (val !dut) in T.split_l()
215 | let split_r () =
216 | let module T = (val !dut) in T.split_r()
217 | let split_a () =
218 | let module T = (val !dut) in T.split_a()
219 | let split_s () =
220 | let module T = (val !dut) in T.split_s()
221 |
222 | let gen_config s =
223 | let l =
224 | match String.split_on_char '-' s with
225 | | "splitmix" :: l -> dut := (module T1 : TEST); l
226 | | "chacha" :: l -> dut := (module T2 : TEST); l
227 | | "lxm" :: l -> dut := (module T3 : TEST); l
228 | | _ -> raise (Arg.Bad ("unknown configuration " ^ s)) in
229 | match l with
230 | | ["float"] -> gen_floats()
231 | | ["seq8"] -> gen_bytes()
232 | | ["seq32"] -> gen_int32()
233 | | ["seq64"] -> gen_int64()
234 | | ["block"; n] -> gen_blocks (int_of_string n)
235 | | ["treesplit"; n] -> treesplits (int_of_string n)
236 | | ["laggedsplit"; n] -> laggedsplit (int_of_string n)
237 | | ["splitl"] -> split_l()
238 | | ["splitr"] -> split_r()
239 | | ["splita"] -> split_a()
240 | | ["splits"] -> split_s()
241 | | _ -> raise (Arg.Bad ("unknown configuration " ^ s))
242 |
243 | let size = ref 1
244 |
245 | let run_config config =
246 | match !size with
247 | | 1 -> Bbattery.small_crush (gen_config config)
248 | | 2 -> Bbattery.crush (gen_config config)
249 | | 3 -> Bbattery.big_crush (gen_config config)
250 | | 4 -> Bbattery.rabbit (gen_config config) (2.0 ** 26.)
251 | | 5 -> Bbattery.alphabit (gen_config config) (2.0 ** 30.) 0 32
252 | | _ -> assert false
253 |
254 | let _ =
255 | Arg.(parse [
256 | "-small", Unit (fun () -> size := 1),
257 | "Run the small crush tests";
258 | "-medium", Unit (fun () -> size := 2),
259 | "Run the normal crush tests";
260 | "-big", Unit (fun () -> size := 3),
261 | "Run the big crush tests";
262 | "-rabbit", Unit (fun () -> size := 4),
263 | "Run the Rabbit tests";
264 | "-alphabit", Unit (fun () -> size := 5),
265 | "Run the Alphabit tests";
266 | ]
267 | run_config
268 | "Usage: ./testU01 B | |
| bit [PRNG.PURE] | 20 ||
| bit [PRNG.STATE] | 22 |
23 |
26 | Return a Boolean value in |
| bits [PRNG.PURE] | 28 ||
| bits [PRNG.STATE] | 30 ||
| bits30 [PRNG.PURE] | 32 ||
| bits30 [PRNG.STATE] | 34 |
35 |
39 | Return a 30-bit integer evenly distributed between 0 and 230-1 36 | (that is, 1073741823, or 0x3FFFFFFF). 37 | 38 | |
| bits32 [PRNG.PURE] | 41 ||
| bits32 [PRNG.STATE] | 43 |
44 |
48 | Return a 32-bit integer evenly distributed between 45 | and . 46 | 47 | |
| bits64 [PRNG.PURE] | 50 ||
| bits64 [PRNG.STATE] | 52 |
53 |
57 | Return a 64-bit integer evenly distributed between 54 | and . 55 | 56 | |
| bits8 [PRNG.PURE] | 59 ||
| bits8 [PRNG.STATE] | 61 |
62 |
65 | Return an 8-bit integer evenly distributed between 0 and 255. 63 | 64 | |
| bool [PRNG.PURE] | 67 ||
| bool [PRNG.STATE] | 69 ||
| byte [PRNG.PURE] | 71 ||
| byte [PRNG.STATE] | 73 ||
| bytes [PRNG.STATE] | 75 |
76 |
80 |
|
C | |
| char [PRNG.PURE] | 83 ||
| char [PRNG.STATE] | 85 |
86 |
89 | Return a character evenly distributed among |
| copy [PRNG.STATE] | 91 |
92 |
95 |
|
F | |
| float [PRNG.PURE] | 98 ||
| float [PRNG.STATE] | 100 |
101 |
105 |
|
I | |
| int [PRNG.PURE] | 108 ||
| int [PRNG.STATE] | 110 |
111 |
115 |
|
| int32 [PRNG.PURE] | 117 ||
| int32 [PRNG.STATE] | 119 |
120 |
124 |
|
| int64 [PRNG.PURE] | 126 ||
| int64 [PRNG.STATE] | 128 |
129 |
133 |
|
M | |
| make [PRNG.PURE] | 136 ||
| make [PRNG.STATE] | 138 |
139 |
142 | Initialize a generator from the given seed. 140 | 141 | |
| make_self_init [PRNG.PURE] | 144 ||
| make_self_init [PRNG.STATE] | 146 |
147 |
151 | Initialize a generator from a random seed obtained from the 148 | operating system. 149 | 150 | |
N | |
| nativebits [PRNG.PURE] | 154 ||
| nativebits [PRNG.STATE] | 156 |
157 |
162 |
|
| nativeint [PRNG.PURE] | 164 ||
| nativeint [PRNG.STATE] | 166 |
167 |
171 |
|
R | |
| remake [PRNG.STATE] | 174 |
175 |
179 |
|
| reseed [PRNG.STATE] | 181 |
182 |
186 |
|
S | |
| seed [PRNG.PURE] | 189 ||
| seed [PRNG.STATE] | 191 |
192 |
195 | Initialize a generator from the given seed. 193 | 194 | |
| split [PRNG.PURE] | 197 ||
| split [PRNG.STATE] | 199 |
200 |
204 |
|
U | |
| uniform [PRNG.PURE] | 207 ||
| uniform [PRNG.STATE] | 209 |
210 |
213 | Return a floating-point number evenly distributed between 0.0 and 1.0. 211 | 212 | |
module type STATE =sig..end
type
29 | The type of generators
32 |val seed : string -> tInitialize a generator from the given seed. The seed is given
39 | as a character string. The length and randomness of the seed
40 | limit the total entropy of the generator. For example, 64
41 | bits of entropy can be obtained by giving a seed consisting of
42 | 8 cryptographically-strong random characters (as obtained
43 | e.g. by reading /dev/random.
val make : int array -> tInitialize a generator from the given seed. The seed is given 50 | as an array of integers.
51 |val make_self_init : unit -> tInitialize a generator from a random seed obtained from the
57 | operating system. Tries hard to provide at least
58 | 64 bits of entropy. With high probability, successive calls
59 | to make_self_init return different PRNGs with different seeds.
val bool : t -> bool
64 | val bit : t -> boolReturn a Boolean value in false,true with 0.5 probability each.
val uniform : t -> floatReturn a floating-point number evenly distributed between 0.0 and 1.0.
73 | 0.0 and 1.0 are never returned.
74 | The result is of the form n * 2{^-53}, where n is a random integer
75 | in (0, 2{^53}).
val float : t -> float -> floatfloat g x returns a floating-point number evenly distributed
82 | between 0.0 and x. If x is negative, negative numbers
83 | between x and 0.0 are returned. Implemented as uniform g *. x.
84 | Consequently, the values 0.0 and x can be returned
85 | (as a result of floating-point rounding), but not if x is
86 | 1.0, since float g 1.0 behaves exactly like uniform g.
val byte : t -> int
91 | val bits8 : t -> intReturn an 8-bit integer evenly distributed between 0 and 255.
94 |val bits : t -> int
98 | val bits30 : t -> intReturn a 30-bit integer evenly distributed between 0 and 230-1 101 | (that is, 1073741823, or 0x3FFFFFFF).
102 |val int : t -> int -> intint g n returns an integer evenly distributed between 0 included
108 | and n excluded. Hence there are n possible return values
109 | with probability 1/n each. n must be greater than 0 and
110 | no greater than 230-1.
val bits32 : t -> int32Return a 32-bit integer evenly distributed between 117 | and .
118 |val int32 : t -> int32 -> int32int32 g n returns a 32-bit integer evenly distributed between
124 | 0 included and n excluded. n must be strictly positive.
Note that int32 Int32.max_int produces numbers between 0 and
127 | Int32.max_int excluded. To produce numbers between 0 and
128 | Int32.max_int included, use
129 | Int32.logand (bits32 g) Int32.max_int.
val bits64 : t -> int64Return a 64-bit integer evenly distributed between 136 | and .
137 |val int64 : t -> int64 -> int64int64 g n returns a 64-bit integer evenly distributed between
143 | 0 included and n excluded. n must be strictly positive.
Note that int64 Int64.max_int produces numbers between 0 and
146 | Int64.max_int excluded. To produce numbers between 0 and
147 | Int64.max_int included, use
148 | Int64.logand (bits64 g) Int64.max_int.
val nativebits : t -> nativeintnativebits g returns a platform-native integer (32 or 64
155 | bits) evenly distributed between and
156 | .
val nativeint : t -> nativeint -> nativeintnativeint g n returns a platform-native integer between
163 | 0 included and n included. n must be strictly positive.
val char : t -> charReturn a character evenly distributed among '\000' ... '\255'.
val bytes : t -> bytes -> int -> int -> unitbytes g b ofs len produces len bytes of pseudo-random data
176 | and stores them in byte sequence b at offsets ofs to ofs+len-1.
Raise Invalid_argument if len < 0 or ofs and len do not
179 | designate a valid range of b.
val split : t -> tsplit g returns a fresh generator g' that is statistically
186 | independent from the current generator g. The two generators
187 | g and g' can be used in parallel and will produce independent
188 | pseudo-random data. Each generator g and g' can be splitted
189 | again in the future.
val copy : t -> tcopy g returns a generator g' that has the same state as g.
196 | The two generators g and g' produce the same data.
val reseed : t -> string -> unitreseed g s reinitializes the generator g with fresh seed data
203 | from string s. This is like seed s except that the existing
204 | generator g is seeded, instead of a new generator being returned.
205 | It is good practice to reseed a PRNG after a certain quantity
206 | of pseudo-random data has been produced from it: typically
207 | 232 numbers for the PRNG.Splitmix generator and
208 | 264 bytes for then PRNG.Chacha generator.
val remake : t -> int array -> unitremake g a reinitializes the generator g with fresh seed data
215 | from array a. This is like reseed except that the seed is
216 | given as an array of integers.
module State:PRNG.STATE
type
29 | The type of generators
32 |val seed : string -> tInitialize a generator from the given seed. The seed is given
39 | as a character string. The length and randomness of the seed
40 | limit the total entropy of the generator. For example, 64
41 | bits of entropy can be obtained by giving a seed consisting of
42 | 8 cryptographically-strong random characters (as obtained
43 | e.g. by reading /dev/random.
val make : int array -> tInitialize a generator from the given seed. The seed is given 50 | as an array of integers.
51 |val make_self_init : unit -> tInitialize a generator from a random seed obtained from the
57 | operating system. Tries hard to provide at least
58 | 64 bits of entropy. With high probability, successive calls
59 | to make_self_init return different PRNGs with different seeds.
val bool : t -> bool
64 | val bit : t -> boolReturn a Boolean value in false,true with 0.5 probability each.
val uniform : t -> floatReturn a floating-point number evenly distributed between 0.0 and 1.0.
73 | 0.0 and 1.0 are never returned.
74 | The result is of the form n * 2{^-53}, where n is a random integer
75 | in (0, 2{^53}).
val float : t -> float -> floatfloat g x returns a floating-point number evenly distributed
82 | between 0.0 and x. If x is negative, negative numbers
83 | between x and 0.0 are returned. Implemented as uniform g *. x.
84 | Consequently, the values 0.0 and x can be returned
85 | (as a result of floating-point rounding), but not if x is
86 | 1.0, since float g 1.0 behaves exactly like uniform g.
val byte : t -> int
91 | val bits8 : t -> intReturn an 8-bit integer evenly distributed between 0 and 255.
94 |val bits : t -> int
98 | val bits30 : t -> intReturn a 30-bit integer evenly distributed between 0 and 230-1 101 | (that is, 1073741823, or 0x3FFFFFFF).
102 |val int : t -> int -> intint g n returns an integer evenly distributed between 0 included
108 | and n excluded. Hence there are n possible return values
109 | with probability 1/n each. n must be greater than 0 and
110 | no greater than 230-1.
val bits32 : t -> int32Return a 32-bit integer evenly distributed between 117 | and .
118 |val int32 : t -> int32 -> int32int32 g n returns a 32-bit integer evenly distributed between
124 | 0 included and n excluded. n must be strictly positive.
Note that int32 Int32.max_int produces numbers between 0 and
127 | Int32.max_int excluded. To produce numbers between 0 and
128 | Int32.max_int included, use
129 | Int32.logand (bits32 g) Int32.max_int.
val bits64 : t -> int64Return a 64-bit integer evenly distributed between 136 | and .
137 |val int64 : t -> int64 -> int64int64 g n returns a 64-bit integer evenly distributed between
143 | 0 included and n excluded. n must be strictly positive.
Note that int64 Int64.max_int produces numbers between 0 and
146 | Int64.max_int excluded. To produce numbers between 0 and
147 | Int64.max_int included, use
148 | Int64.logand (bits64 g) Int64.max_int.
val nativebits : t -> nativeintnativebits g returns a platform-native integer (32 or 64
155 | bits) evenly distributed between and
156 | .
val nativeint : t -> nativeint -> nativeintnativeint g n returns a platform-native integer between
163 | 0 included and n included. n must be strictly positive.
val char : t -> charReturn a character evenly distributed among '\000' ... '\255'.
val bytes : t -> bytes -> int -> int -> unitbytes g b ofs len produces len bytes of pseudo-random data
176 | and stores them in byte sequence b at offsets ofs to ofs+len-1.
Raise Invalid_argument if len < 0 or ofs and len do not
179 | designate a valid range of b.
val split : t -> tsplit g returns a fresh generator g' that is statistically
186 | independent from the current generator g. The two generators
187 | g and g' can be used in parallel and will produce independent
188 | pseudo-random data. Each generator g and g' can be splitted
189 | again in the future.
val copy : t -> tcopy g returns a generator g' that has the same state as g.
196 | The two generators g and g' produce the same data.
val reseed : t -> string -> unitreseed g s reinitializes the generator g with fresh seed data
203 | from string s. This is like seed s except that the existing
204 | generator g is seeded, instead of a new generator being returned.
205 | It is good practice to reseed a PRNG after a certain quantity
206 | of pseudo-random data has been produced from it: typically
207 | 232 numbers for the PRNG.Splitmix generator and
208 | 264 bytes for then PRNG.Chacha generator.
val remake : t -> int array -> unitremake g a reinitializes the generator g with fresh seed data
215 | from array a. This is like reseed except that the seed is
216 | given as an array of integers.
module State:PRNG.STATE
type
29 | The type of generators
32 |val seed : string -> tInitialize a generator from the given seed. The seed is given
39 | as a character string. The length and randomness of the seed
40 | limit the total entropy of the generator. For example, 64
41 | bits of entropy can be obtained by giving a seed consisting of
42 | 8 cryptographically-strong random characters (as obtained
43 | e.g. by reading /dev/random.
val make : int array -> tInitialize a generator from the given seed. The seed is given 50 | as an array of integers.
51 |val make_self_init : unit -> tInitialize a generator from a random seed obtained from the
57 | operating system. Tries hard to provide at least
58 | 64 bits of entropy. With high probability, successive calls
59 | to make_self_init return different PRNGs with different seeds.
val bool : t -> bool
64 | val bit : t -> boolReturn a Boolean value in false,true with 0.5 probability each.
val uniform : t -> floatReturn a floating-point number evenly distributed between 0.0 and 1.0.
73 | 0.0 and 1.0 are never returned.
74 | The result is of the form n * 2{^-53}, where n is a random integer
75 | in (0, 2{^53}).
val float : t -> float -> floatfloat g x returns a floating-point number evenly distributed
82 | between 0.0 and x. If x is negative, negative numbers
83 | between x and 0.0 are returned. Implemented as uniform g *. x.
84 | Consequently, the values 0.0 and x can be returned
85 | (as a result of floating-point rounding), but not if x is
86 | 1.0, since float g 1.0 behaves exactly like uniform g.
val byte : t -> int
91 | val bits8 : t -> intReturn an 8-bit integer evenly distributed between 0 and 255.
94 |val bits : t -> int
98 | val bits30 : t -> intReturn a 30-bit integer evenly distributed between 0 and 230-1 101 | (that is, 1073741823, or 0x3FFFFFFF).
102 |val int : t -> int -> intint g n returns an integer evenly distributed between 0 included
108 | and n excluded. Hence there are n possible return values
109 | with probability 1/n each. n must be greater than 0 and
110 | no greater than 230-1.
val bits32 : t -> int32Return a 32-bit integer evenly distributed between 117 | and .
118 |val int32 : t -> int32 -> int32int32 g n returns a 32-bit integer evenly distributed between
124 | 0 included and n excluded. n must be strictly positive.
Note that int32 Int32.max_int produces numbers between 0 and
127 | Int32.max_int excluded. To produce numbers between 0 and
128 | Int32.max_int included, use
129 | Int32.logand (bits32 g) Int32.max_int.
val bits64 : t -> int64Return a 64-bit integer evenly distributed between 136 | and .
137 |val int64 : t -> int64 -> int64int64 g n returns a 64-bit integer evenly distributed between
143 | 0 included and n excluded. n must be strictly positive.
Note that int64 Int64.max_int produces numbers between 0 and
146 | Int64.max_int excluded. To produce numbers between 0 and
147 | Int64.max_int included, use
148 | Int64.logand (bits64 g) Int64.max_int.
val nativebits : t -> nativeintnativebits g returns a platform-native integer (32 or 64
155 | bits) evenly distributed between and
156 | .
val nativeint : t -> nativeint -> nativeintnativeint g n returns a platform-native integer between
163 | 0 included and n included. n must be strictly positive.
val char : t -> charReturn a character evenly distributed among '\000' ... '\255'.
val bytes : t -> bytes -> int -> int -> unitbytes g b ofs len produces len bytes of pseudo-random data
176 | and stores them in byte sequence b at offsets ofs to ofs+len-1.
Raise Invalid_argument if len < 0 or ofs and len do not
179 | designate a valid range of b.
val split : t -> tsplit g returns a fresh generator g' that is statistically
186 | independent from the current generator g. The two generators
187 | g and g' can be used in parallel and will produce independent
188 | pseudo-random data. Each generator g and g' can be splitted
189 | again in the future.
val copy : t -> tcopy g returns a generator g' that has the same state as g.
196 | The two generators g and g' produce the same data.
val reseed : t -> string -> unitreseed g s reinitializes the generator g with fresh seed data
203 | from string s. This is like seed s except that the existing
204 | generator g is seeded, instead of a new generator being returned.
205 | It is good practice to reseed a PRNG after a certain quantity
206 | of pseudo-random data has been produced from it: typically
207 | 232 numbers for the PRNG.Splitmix generator and
208 | 264 bytes for then PRNG.Chacha generator.
val remake : t -> int array -> unitremake g a reinitializes the generator g with fresh seed data
215 | from array a. This is like reseed except that the seed is
216 | given as an array of integers.
sig
14 | module type STATE =
15 | sig
16 | type t
17 | val seed : string -> PRNG.STATE.t
18 | val make : int array -> PRNG.STATE.t
19 | val make_self_init : unit -> PRNG.STATE.t
20 | val bool : PRNG.STATE.t -> bool
21 | val bit : PRNG.STATE.t -> bool
22 | val uniform : PRNG.STATE.t -> float
23 | val float : PRNG.STATE.t -> float -> float
24 | val byte : PRNG.STATE.t -> int
25 | val bits8 : PRNG.STATE.t -> int
26 | val bits : PRNG.STATE.t -> int
27 | val bits30 : PRNG.STATE.t -> int
28 | val int : PRNG.STATE.t -> int -> int
29 | val bits32 : PRNG.STATE.t -> int32
30 | val int32 : PRNG.STATE.t -> int32 -> int32
31 | val bits64 : PRNG.STATE.t -> int64
32 | val int64 : PRNG.STATE.t -> int64 -> int64
33 | val nativebits : PRNG.STATE.t -> nativeint
34 | val nativeint : PRNG.STATE.t -> nativeint -> nativeint
35 | val char : PRNG.STATE.t -> char
36 | val bytes : PRNG.STATE.t -> bytes -> int -> int -> unit
37 | val split : PRNG.STATE.t -> PRNG.STATE.t
38 | val copy : PRNG.STATE.t -> PRNG.STATE.t
39 | val reseed : PRNG.STATE.t -> string -> unit
40 | val remake : PRNG.STATE.t -> int array -> unit
41 | end
42 | module type PURE =
43 | sig
44 | type t
45 | val seed : string -> PRNG.PURE.t
46 | val make : int array -> PRNG.PURE.t
47 | val make_self_init : unit -> PRNG.PURE.t
48 | val bool : PRNG.PURE.t -> bool * PRNG.PURE.t
49 | val bit : PRNG.PURE.t -> bool * PRNG.PURE.t
50 | val uniform : PRNG.PURE.t -> float * PRNG.PURE.t
51 | val float : float -> PRNG.PURE.t -> float * PRNG.PURE.t
52 | val byte : PRNG.PURE.t -> int * PRNG.PURE.t
53 | val bits8 : PRNG.PURE.t -> int * PRNG.PURE.t
54 | val int : int -> PRNG.PURE.t -> int * PRNG.PURE.t
55 | val bits : PRNG.PURE.t -> int * PRNG.PURE.t
56 | val bits30 : PRNG.PURE.t -> int * PRNG.PURE.t
57 | val bits32 : PRNG.PURE.t -> int32 * PRNG.PURE.t
58 | val int32 : int32 -> PRNG.PURE.t -> int32 * PRNG.PURE.t
59 | val bits64 : PRNG.PURE.t -> int64 * PRNG.PURE.t
60 | val int64 : int64 -> PRNG.PURE.t -> int64 * PRNG.PURE.t
61 | val nativebits : PRNG.PURE.t -> nativeint * PRNG.PURE.t
62 | val nativeint : nativeint -> PRNG.PURE.t -> nativeint * PRNG.PURE.t
63 | val char : PRNG.PURE.t -> char * PRNG.PURE.t
64 | val split : PRNG.PURE.t -> PRNG.PURE.t * PRNG.PURE.t
65 | end
66 | module Splitmix : sig module State : STATE module Pure : PURE end
67 | module Chacha : sig module State : STATE module Pure : PURE end
68 | module LXM : sig module State : STATE module Pure : PURE end
69 | end
70 |
--------------------------------------------------------------------------------
/PRNG.ml:
--------------------------------------------------------------------------------
1 | (***********************************************************************)
2 | (* *)
3 | (* The PRINGO library *)
4 | (* *)
5 | (* Xavier Leroy, projet Gallium, INRIA Paris *)
6 | (* *)
7 | (* Copyright 2017 Institut National de Recherche en Informatique et *)
8 | (* en Automatique. All rights reserved. This file is distributed *)
9 | (* under the terms of the GNU Library General Public License v2, *)
10 | (* with the special exception on linking described in file LICENSE. *)
11 | (* *)
12 | (***********************************************************************)
13 |
14 | (** The two interfaces *)
15 |
16 | module type STATE = sig
17 | type t
18 | val seed: string -> t
19 | val make: int array -> t
20 | val make_self_init: unit -> t
21 | val bool: t -> bool
22 | val bit: t -> bool
23 | val uniform: t -> float
24 | val float: t -> float -> float
25 | val byte: t -> int
26 | val bits8: t -> int
27 | val bits: t -> int
28 | val bits30: t -> int
29 | val int: t -> int -> int
30 | val bits32: t -> int32
31 | val int32: t -> int32 -> int32
32 | val bits64: t -> int64
33 | val int64: t -> int64 -> int64
34 | val nativebits: t -> nativeint
35 | val nativeint: t -> nativeint -> nativeint
36 | val char: t -> char
37 | val bytes: t -> bytes -> int -> int -> unit
38 | val split: t -> t
39 | val copy: t -> t
40 | val reseed: t -> string -> unit
41 | val remake: t -> int array -> unit
42 | end
43 |
44 | (** The purely-functional, monadic interface *)
45 |
46 | module type PURE = sig
47 | type t
48 | val seed: string -> t
49 | val make: int array -> t
50 | val make_self_init: unit -> t
51 | val bool: t -> bool * t
52 | val bit: t -> bool * t
53 | val uniform: t -> float * t
54 | val float: float -> t -> float * t
55 | val byte: t -> int * t
56 | val bits8: t -> int * t
57 | val int: int -> t -> int * t
58 | val bits: t -> int * t
59 | val bits30: t -> int * t
60 | val bits32: t -> int32 * t
61 | val int32: int32 -> t -> int32 * t
62 | val bits64: t -> int64 * t
63 | val int64: int64 -> t -> int64 * t
64 | val nativebits: t -> nativeint * t
65 | val nativeint: nativeint -> t -> nativeint * t
66 | val char: t -> char * t
67 | val split: t -> t * t
68 | end
69 |
70 | (** The seeders *)
71 |
72 | (* The seeder from OCaml's runtime system *)
73 | external sys_random_seed: unit -> int array = "caml_sys_random_seed"
74 |
75 | (* A better seeder for machines that support /dev/urandom *)
76 | let dev_urandom_seed len =
77 | match open_in_bin "/dev/urandom" with
78 | | exception Sys_error _ -> None
79 | | ic ->
80 | match really_input_string ic len with
81 | | exception (End_of_file | Sys_error _) -> close_in ic; None
82 | | s -> close_in ic; Some s
83 |
84 | (** Byte array manipulation *)
85 |
86 | external getbyte : bytes -> int -> int = "%bytes_safe_get"
87 | external setbyte : bytes -> int -> int -> unit = "%bytes_safe_set"
88 | (* If we feel adventurous:
89 | external getbyte : bytes -> int -> int = "%bytes_unsafe_get"
90 | external setbyte : bytes -> int -> int -> unit = "%bytes_unsafe_set"
91 | *)
92 |
93 | (** Derived operations for the STATE interface *)
94 |
95 | module StateDerived(X: sig
96 | type t
97 | val bits30: t -> int
98 | val bits32: t -> int32
99 | val bits64: t -> int64
100 | val errorprefix: string
101 | end) =
102 | struct
103 |
104 | let rec intaux g n =
105 | let r = X.bits30 g in
106 | let v = r mod n in
107 | if r - v > 0x3FFFFFFF - n + 1 then intaux g n else v
108 |
109 | let int g bound =
110 | if bound > 0x3FFFFFFF || bound <= 0
111 | then invalid_arg (X.errorprefix ^ "int")
112 | else intaux g bound
113 |
114 | let rec int32aux g n =
115 | let r = Int32.logand (X.bits32 g) 0x7FFF_FFFFl in
116 | let v = Int32.rem r n in
117 | if Int32.sub r v > Int32.(add (sub max_int n) 1l)
118 | then int32aux g n
119 | else v
120 |
121 | let int32 g bound =
122 | if bound <= 0l
123 | then invalid_arg (X.errorprefix ^ "int32")
124 | else int32aux g bound
125 |
126 | let rec int64aux g n =
127 | let r = Int64.logand (X.bits64 g) 0x7FFF_FFFF_FFFF_FFFFL in
128 | let v = Int64.rem r n in
129 | if Int64.sub r v > Int64.(add (sub max_int n) 1L)
130 | then int64aux g n
131 | else v
132 |
133 | let int64 g bound =
134 | if bound <= 0L
135 | then invalid_arg (X.errorprefix ^ "int64")
136 | else int64aux g bound
137 |
138 | let nativebits =
139 | if Nativeint.size = 32
140 | then fun g -> Nativeint.of_int32 (X.bits32 g)
141 | else fun g -> Int64.to_nativeint (X.bits64 g)
142 |
143 | let nativeint =
144 | if Nativeint.size = 32
145 | then fun g bound -> Nativeint.of_int32 (int32 g (Nativeint.to_int32 bound))
146 | else fun g bound -> Int64.to_nativeint (int64 g (Int64.of_nativeint bound))
147 |
148 | let rec uniform g =
149 | let b = X.bits64 g in
150 | let n = Int64.shift_right_logical b 11 in
151 | if n <> 0L then Int64.to_float n *. 0x1.p-53 else uniform g
152 |
153 | let float g bound = uniform g *. bound
154 |
155 | let bytes g dst ofs len =
156 | if ofs < 0 || len < 0 || ofs > Bytes.length dst - len then
157 | invalid_arg (X.errorprefix ^ "bytes")
158 | else begin
159 | let rec fill ofs len =
160 | let n = X.bits64 g in
161 | setbyte dst ofs (Int64.to_int n);
162 | if len > 1 then
163 | setbyte dst (ofs+1) (Int64.to_int (Int64.shift_right n 8));
164 | if len > 2 then
165 | setbyte dst (ofs+2) (Int64.to_int (Int64.shift_right n 16));
166 | if len > 3 then
167 | setbyte dst (ofs+3) (Int64.to_int (Int64.shift_right n 24));
168 | if len > 4 then
169 | setbyte dst (ofs+4) (Int64.to_int (Int64.shift_right n 32));
170 | if len > 5 then
171 | setbyte dst (ofs+5) (Int64.to_int (Int64.shift_right n 40));
172 | if len > 6 then
173 | setbyte dst (ofs+6) (Int64.to_int (Int64.shift_right n 48));
174 | if len > 7 then
175 | setbyte dst (ofs+7) (Int64.to_int (Int64.shift_right n 56));
176 | if len > 8 then
177 | fill (ofs + 8) (len - 8)
178 | in if len > 0 then fill ofs len
179 | end
180 |
181 | end
182 |
183 | (** Derived operations for the PURE interface *)
184 |
185 | module PureDerived(X: sig
186 | type t
187 | val bits30: t -> int * t
188 | val bits32: t -> int32 * t
189 | val bits64: t -> int64 * t
190 | val errorprefix: string
191 | end) =
192 | struct
193 |
194 | let rec intaux n g =
195 | let (r, g') = X.bits30 g in
196 | let v = r mod n in
197 | if r - v > 0x3FFFFFFF - n + 1 then intaux n g' else (v, g')
198 |
199 | let int bound g =
200 | if bound > 0x3FFFFFFF || bound <= 0
201 | then invalid_arg (X.errorprefix ^ "int")
202 | else intaux bound g
203 |
204 | let rec int32aux n g =
205 | let (r, g') = X.bits32 g in
206 | let r = Int32.logand r 0x7FFF_FFFFl in
207 | let v = Int32.rem r n in
208 | if Int32.sub r v > Int32.(add (sub max_int n) 1l)
209 | then int32aux n g'
210 | else (v, g')
211 |
212 | let int32 bound g =
213 | if bound <= 0l
214 | then invalid_arg (X.errorprefix ^ "int32")
215 | else int32aux bound g
216 |
217 | let rec int64aux n g =
218 | let (r, g') = X.bits64 g in
219 | let r = Int64.logand r 0x7FFF_FFFF_FFFF_FFFFL in
220 | let v = Int64.rem r n in
221 | if Int64.sub r v > Int64.(add (sub max_int n) 1L)
222 | then int64aux n g'
223 | else (v, g')
224 |
225 | let int64 bound g =
226 | if bound <= 0L
227 | then invalid_arg (X.errorprefix ^ "int64")
228 | else int64aux bound g
229 |
230 | let nativebits =
231 | if Nativeint.size = 32
232 | then fun g -> let (r, g') = X.bits32 g in (Nativeint.of_int32 r, g')
233 | else fun g -> let (r, g') = X.bits64 g in (Int64.to_nativeint r, g')
234 |
235 | let nativeint =
236 | if Nativeint.size = 32
237 | then begin
238 | fun bound g ->
239 | let (r, g') = int32 (Nativeint.to_int32 bound) g in
240 | (Nativeint.of_int32 r, g')
241 | end else begin
242 | fun bound g ->
243 | let (r, g') = int64 (Int64.of_nativeint bound) g in
244 | (Int64.to_nativeint r, g')
245 | end
246 |
247 | let rec uniform g =
248 | let (b, g) = X.bits64 g in
249 | let n = Int64.shift_right_logical b 11 in
250 | if n <> 0L then (Int64.to_float n *. 0x1.p-53, g) else uniform g
251 |
252 | let float bound g =
253 | let (f, g) = uniform g in (f *. bound, g)
254 |
255 | end
256 |
257 | (** This is an implementation of the Splitmix PRNG, from:
258 | Guy L. Steele Jr., Doug Lea, Christine H. Flood
259 | "Fast Splittable Pseudorandom Number Generators"
260 | OOPSLA 2014.
261 | Two interfaces are provided: stateful and monadic. *)
262 |
263 | module Splitmix = struct
264 |
265 | (* Notations for int64 operations *)
266 |
267 | let (<<) = Int64.shift_left
268 | let (>>) = Int64.shift_right_logical
269 | let (^^) = Int64.logxor
270 | let (&&&) = Int64.logand
271 | let (|||) = Int64.logor
272 | let ( ** ) = Int64.mul
273 | let (++) = Int64.add
274 | let (--) = Int64.sub
275 |
276 | (* The core mixing functions. Could be defined in OCaml, and would run
277 | quite fast on 64-bit platforms, but are too slow on 32-bit platforms. *)
278 |
279 | external mix64: int64 -> int64 = "pringo_mix64" "pringo_mix64_unboxed"
280 | [@@unboxed] [@@noalloc]
281 | external mix32: int64 -> int32 = "pringo_mix32" "pringo_mix32_unboxed"
282 | [@@unboxed] [@@noalloc]
283 | external mix30: (int64[@unboxed]) -> int = "pringo_mix30" "pringo_mix30_unboxed"
284 | [@@noalloc]
285 | external mixGamma: int64 -> int64 = "pringo_mixGamma" "pringo_mixGamma_unboxed"
286 | [@@unboxed] [@@noalloc]
287 |
288 | (** Helpers for initialization *)
289 |
290 | let golden_gamma = 0x9e3779b97f4a7c15L
291 |
292 | let int64_of_seed s =
293 | let s = if String.length s <= 8 then s else Digest.string s in
294 | let rec extract i accu =
295 | if i < 0 then accu else
296 | extract (i-1)
297 | ((accu << 8) ++ Int64.of_int (Char.code (String.get s i))) in
298 | extract (min 7 (String.length s - 1)) 0L
299 |
300 | let mix_init accu n =
301 | mix64 (accu ++ Int64.of_int (n land 0x3FFFFFFF))
302 |
303 | (** The stateful interface *)
304 |
305 | module State = struct
306 |
307 | type t = { mutable seed: int64; gamma: int64; }
308 |
309 | let seed s =
310 | { seed = int64_of_seed s; gamma = golden_gamma }
311 |
312 | let make s =
313 | { seed = Array.fold_left mix_init 0L s; gamma = golden_gamma }
314 |
315 | let make_self_init () =
316 | match dev_urandom_seed 8 with
317 | | Some s -> seed s
318 | | None -> make (sys_random_seed())
319 |
320 | let [@inline] nextseed t =
321 | let z = t.seed ++ t.gamma in t.seed <- z; z
322 |
323 | let bit g = mix30 (nextseed g) land 0x1 = 1
324 | let bool = bit
325 |
326 | let bits8 g = mix30 (nextseed g) land 0xFF
327 | let byte = bits8
328 | let char g = Char.chr (bits8 g)
329 |
330 | let bits30 g = mix30 (nextseed g)
331 | let bits = bits30
332 |
333 | let bits32 g = mix32 (nextseed g)
334 |
335 | let bits64 g = mix64 (nextseed g)
336 |
337 | include StateDerived(struct
338 | type nonrec t = t
339 | let bits30 = bits30
340 | let bits32 = bits32
341 | let bits64 = bits64
342 | let errorprefix = "PRNG.Splitmix.State."
343 | end)
344 |
345 | let split g =
346 | let n1 = nextseed g in
347 | let n2 = nextseed g in
348 | { seed = mix64 n1; gamma = mixGamma n2 }
349 |
350 | let copy g = { seed = g.seed; gamma = g.gamma }
351 |
352 | let reseed g s =
353 | g.seed <- int64_of_seed s
354 | (* let's keep the original gamma, why not? *)
355 |
356 | let remake g s =
357 | g.seed <- Array.fold_left mix_init 0L s
358 | (* let's keep the original gamma, why not? *)
359 |
360 | end
361 |
362 | (** The pure interface *)
363 |
364 | module Pure = struct
365 |
366 | type t = { seed: int64; gamma: int64; }
367 |
368 | let seed s =
369 | { seed = int64_of_seed s; gamma = golden_gamma }
370 |
371 | let make s =
372 | { seed = Array.fold_left mix_init 0L s; gamma = golden_gamma }
373 |
374 | let make_self_init () =
375 | match dev_urandom_seed 8 with
376 | | Some s -> seed s
377 | | None -> make (sys_random_seed())
378 |
379 | let [@inline] next g = { seed = g.seed ++ g.gamma; gamma = g.gamma }
380 |
381 | let bit g =
382 | let g = next g in ((mix30 g.seed land 0x1 = 1), g)
383 | let bool = bit
384 |
385 | let bits8 g =
386 | let g = next g in (mix30 g.seed land 0xFF, g)
387 | let byte = bits8
388 | let char g =
389 | let g = next g in (Char.chr (mix30 g.seed land 0xFF), g)
390 |
391 | let bits30 g =
392 | let g = next g in (mix30 g.seed, g)
393 | let bits = bits30
394 |
395 | let bits32 g =
396 | let g = next g in (mix32 g.seed, g)
397 |
398 | let bits64 g =
399 | let g = next g in (mix64 g.seed, g)
400 |
401 | include PureDerived(struct
402 | type nonrec t = t
403 | let bits30 = bits30
404 | let bits32 = bits32
405 | let bits64 = bits64
406 | let errorprefix = "PRNG.Splitmix.Pure."
407 | end)
408 |
409 | let split g =
410 | let g1 = next g in
411 | let g2 = next g1 in
412 | ({ seed = mix64 g1.seed; gamma = mixGamma g2.seed }, g2)
413 |
414 | end
415 |
416 | end
417 |
418 | (** The Chacha implementation *)
419 |
420 | module Chacha = struct
421 |
422 | type key
423 | type state = bytes
424 |
425 | external chacha_make_key: string -> key = "pringo_chacha_make_key"
426 | external chacha_make_state: bytes -> state = "pringo_chacha_make_state"
427 | external chacha_transform: key -> state -> unit = "pringo_chacha_transform"
428 |
429 | (** Helpers for initialization *)
430 |
431 | let empty_bytes = Bytes.make 16 '\000'
432 |
433 | let mix_init a =
434 | let buf = Bytes.create (4 * Array.length a) in
435 | let storeint n i =
436 | setbyte buf i n;
437 | setbyte buf (i+1) (n lsl 8);
438 | setbyte buf (i+2) (n lsl 16);
439 | setbyte buf (i+3) (n lsl 24) in
440 | Array.iteri (fun i n -> storeint n (i * 4)) a;
441 | Digest.bytes buf
442 |
443 | (** Helpers to build integers *)
444 |
445 | let [@inline] make30 b0 b1 b2 b3 =
446 | b0 + (b1 lsl 8) + (b2 lsl 16) + ((b3 land 0x3F) lsl 24)
447 |
448 | let [@inline] make32 b0 b1 b2 b3 =
449 | Int32.(add (add (of_int b0)
450 | (shift_left (of_int b1) 8))
451 | (add (shift_left (of_int b2) 16)
452 | (shift_left (of_int b3) 24)))
453 |
454 | let make64 =
455 | if Sys.word_size = 64
456 | then (fun b0 b1 b2 b3 b4 b5 b6 b7 ->
457 | Int64.(add (add (add (of_int b0)
458 | (shift_left (of_int b1) 8))
459 | (add (shift_left (of_int b2) 16)
460 | (shift_left (of_int b3) 24)))
461 | (add (add (shift_left (of_int b4) 32)
462 | (shift_left (of_int b5) 40))
463 | (add (shift_left (of_int b6) 48)
464 | (shift_left (of_int b7) 56)))))
465 | [@inline]
466 | else (fun b0 b1 b2 b3 b4 b5 b6 b7 ->
467 | Int64.(add (of_int32 (make32 b0 b1 b2 b3))
468 | (shift_left (of_int32 (make32 b4 b5 b6 b7)) 32)))
469 | [@inline]
470 |
471 | (** The stateful interface *)
472 |
473 | module State = struct
474 |
475 | type t = { mutable key: key; mutable st: state; mutable next: int }
476 |
477 | let seed s =
478 | { key = chacha_make_key s; st = chacha_make_state empty_bytes; next = 64 }
479 |
480 | let make s =
481 | { key = chacha_make_key (mix_init s);
482 | st = chacha_make_state empty_bytes; next = 64 }
483 |
484 | let make_self_init () =
485 | match dev_urandom_seed 16 with
486 | | Some s -> seed s
487 | | None -> make (sys_random_seed())
488 |
489 | (* Layout of the state:
490 | 0...63 up to 64 bytes of already-generated pseudo-random data
491 | 64...79 16 bytes for the counter and the nonce *)
492 |
493 | let byte g =
494 | let i = g.next in
495 | if i <= 63 then begin
496 | g.next <- i + 1;
497 | getbyte g.st i
498 | end else begin
499 | chacha_transform g.key g.st;
500 | g.next <- 1;
501 | getbyte g.st 0
502 | end
503 |
504 | let bits8 = byte
505 | let char g = Char.chr (bits8 g)
506 |
507 | let bit g = byte g land 0x1 = 1
508 | let bool = bit
509 |
510 | let bits30 g =
511 | let i = g.next in
512 | if i <= 60 then begin
513 | g.next <- i + 4;
514 | make30 (getbyte g.st i) (getbyte g.st (i+1))
515 | (getbyte g.st (i+2)) (getbyte g.st (i+3))
516 | end else begin
517 | let b0 = byte g in let b1 = byte g in
518 | let b2 = byte g in let b3 = byte g in
519 | make30 b0 b1 b2 b3
520 | end
521 |
522 | let bits = bits30
523 |
524 | let bits32 g =
525 | let i = g.next in
526 | if i <= 60 then begin
527 | g.next <- i + 4;
528 | make32 (getbyte g.st i) (getbyte g.st (i+1))
529 | (getbyte g.st (i+2)) (getbyte g.st (i+3))
530 | end else begin
531 | let b0 = byte g in let b1 = byte g in
532 | let b2 = byte g in let b3 = byte g in
533 | make32 b0 b1 b2 b3
534 | end
535 |
536 | let bits64 g =
537 | let i = g.next in
538 | if i <= 56 then begin
539 | g.next <- i + 8;
540 | make64 (getbyte g.st i) (getbyte g.st (i+1))
541 | (getbyte g.st (i+2)) (getbyte g.st (i+3))
542 | (getbyte g.st (i+4)) (getbyte g.st (i+5))
543 | (getbyte g.st (i+6)) (getbyte g.st (i+7))
544 | end else begin
545 | let b0 = byte g in let b1 = byte g in
546 | let b2 = byte g in let b3 = byte g in
547 | let b4 = byte g in let b5 = byte g in
548 | let b6 = byte g in let b7 = byte g in
549 | make64 b0 b1 b2 b3 b4 b5 b6 b7
550 | end
551 |
552 | include StateDerived(struct
553 | type nonrec t = t
554 | let bits30 = bits30
555 | let bits32 = bits32
556 | let bits64 = bits64
557 | let errorprefix = "PRNG.Chacha.State."
558 | end)
559 |
560 | let bytes g dst ofs len =
561 | if ofs < 0 || len < 0 || Bytes.length dst - len > ofs then
562 | invalid_arg "PRNG.Chacha.State.bytes";
563 | let rec fill ofs len =
564 | let next = g.next in
565 | let avail = 64 - next in
566 | if len <= avail then begin
567 | Bytes.blit g.st next dst ofs len;
568 | g.next <- next + len;
569 | end else begin
570 | Bytes.blit g.st next dst ofs avail;
571 | chacha_transform g.key g.st;
572 | g.next <- 0;
573 | fill (ofs + avail) (len - avail)
574 | end
575 | in fill ofs len
576 |
577 | let split g =
578 | let k = Bytes.create 16 in
579 | bytes g k 0 16;
580 | { key = g.key; st = chacha_make_state k; next = 64 }
581 |
582 | let copy g = { key = g.key; st = Bytes.copy g.st; next = g.next }
583 |
584 | let reseed g s =
585 | g.key <- chacha_make_key s;
586 | g.st <- chacha_make_state empty_bytes;
587 | g.next <- 64
588 |
589 | let remake g s =
590 | g.key <- chacha_make_key (mix_init s);
591 | g.st <- chacha_make_state empty_bytes;
592 | g.next <- 64
593 |
594 | end
595 |
596 | (** The pure interface *)
597 |
598 | module Pure = struct
599 |
600 | type t = { key: key; st: state; next: int }
601 |
602 | let seed s =
603 | { key = chacha_make_key s; st = chacha_make_state empty_bytes; next = 64 }
604 |
605 | let make s =
606 | { key = chacha_make_key (mix_init s);
607 | st = chacha_make_state empty_bytes; next = 64 }
608 |
609 | let make_self_init () =
610 | match dev_urandom_seed 16 with
611 | | Some s -> seed s
612 | | None -> make (sys_random_seed())
613 |
614 | let byte g =
615 | let i = g.next in
616 | if i <= 63 then begin
617 | (getbyte g.st i, {g with next = i + 1})
618 | end else begin
619 | let st' = Bytes.copy g.st in
620 | chacha_transform g.key st';
621 | (getbyte st' 0, {g with st = st'; next = 1})
622 | end
623 |
624 | let bits8 = byte
625 | let char g = let (n, g') = byte g in (Char.chr n, g')
626 |
627 | let bit g = let (n, g') = byte g in (n land 0x1 = 1, g')
628 | let bool = bit
629 |
630 | let bits30 g =
631 | let i = g.next in
632 | if i <= 60 then begin
633 | (make30 (getbyte g.st i) (getbyte g.st (i+1))
634 | (getbyte g.st (i+2)) (getbyte g.st (i+3)),
635 | {g with next = i + 4})
636 | end else begin
637 | let (b0, g) = byte g in let (b1, g) = byte g in
638 | let (b2, g) = byte g in let (b3, g) = byte g in
639 | (make30 b0 b1 b2 b3, g)
640 | end
641 |
642 | let bits = bits30
643 |
644 | let bits32 g =
645 | let i = g.next in
646 | if i <= 60 then begin
647 | (make32 (getbyte g.st i) (getbyte g.st (i+1))
648 | (getbyte g.st (i+2)) (getbyte g.st (i+3)),
649 | {g with next = i + 4})
650 | end else begin
651 | let (b0, g) = byte g in let (b1, g) = byte g in
652 | let (b2, g) = byte g in let (b3, g) = byte g in
653 | (make32 b0 b1 b2 b3, g)
654 | end
655 |
656 | let bits64 g =
657 | let i = g.next in
658 | if i <= 56 then begin
659 | (make64 (getbyte g.st i) (getbyte g.st (i+1))
660 | (getbyte g.st (i+2)) (getbyte g.st (i+3))
661 | (getbyte g.st (i+4)) (getbyte g.st (i+5))
662 | (getbyte g.st (i+6)) (getbyte g.st (i+7)),
663 | {g with next = i + 8})
664 | end else begin
665 | let (b0, g) = byte g in let (b1, g) = byte g in
666 | let (b2, g) = byte g in let (b3, g) = byte g in
667 | let (b4, g) = byte g in let (b5, g) = byte g in
668 | let (b6, g) = byte g in let (b7, g) = byte g in
669 | (make64 b0 b1 b2 b3 b4 b5 b6 b7, g)
670 | end
671 |
672 | include PureDerived(struct
673 | type nonrec t = t
674 | let bits30 = bits30
675 | let bits32 = bits32
676 | let bits64 = bits64
677 | let errorprefix = "PRNG.Chacha.Pure."
678 | end)
679 |
680 | let bytes g dst ofs len =
681 | if ofs < 0 || len < 0 || Bytes.length dst - len > ofs then
682 | invalid_arg "PRNG.Chacha.Pure.bytes";
683 | let rec fill g ofs len =
684 | let next = g.next in
685 | let avail = 64 - next in
686 | if len <= avail then begin
687 | Bytes.blit g.st next dst ofs len;
688 | {g with next = next + len}
689 | end else begin
690 | Bytes.blit g.st next dst ofs avail;
691 | let st' = Bytes.copy g.st in
692 | chacha_transform g.key st';
693 | fill {g with st = st'; next = 0} (ofs + avail) (len - avail)
694 | end
695 | in fill g ofs len
696 |
697 | let split g =
698 | let k = Bytes.create 16 in
699 | let g = bytes g k 0 16 in
700 | ( { key = g.key; st = chacha_make_state k; next = 64 }, g )
701 |
702 | end
703 |
704 | end
705 |
706 | (* The LXM implementation *)
707 |
708 | module LXM = struct
709 |
710 | type state
711 |
712 | external next: state -> (int64[@unboxed])
713 | = "pringo_LXM_next" "pringo_LXM_next_unboxed"
714 | external copy: state -> state = "pringo_LXM_copy"
715 | external assign: state -> state -> unit = "pringo_LXM_assign"
716 | external init: (int64[@unboxed]) -> (int64[@unboxed]) ->
717 | (int64[@unboxed]) -> (int64[@unboxed]) -> state
718 | = "pringo_LXM_init" "pringo_LXM_init_unboxed"
719 | external seed: string -> state = "pringo_LXM_seed"
720 | external make: int array -> state = "pringo_LXM_make"
721 |
722 | (** The stateful interface *)
723 |
724 | module State = struct
725 |
726 | type t = state
727 |
728 | let seed = seed
729 | let make = make
730 | let make_self_init () =
731 | match dev_urandom_seed 16 with
732 | | Some s -> seed s
733 | | None -> make (sys_random_seed())
734 |
735 | let byte g = Int64.to_int (next g) land 0xFF
736 | let bits8 = byte
737 | let char g = Char.chr (bits8 g)
738 | let bit g = Int64.to_int (next g) land 0x1 = 1
739 | let bool = bit
740 | let bits30 g = Int64.to_int (next g) land 0x3FFFFFFF
741 | let bits = bits30
742 | let bits32 g = Int64.to_int32 (next g)
743 | let bits64 = next
744 |
745 | include StateDerived(struct
746 | type nonrec t = t
747 | let bits30 = bits30
748 | let bits32 = bits32
749 | let bits64 = bits64
750 | let errorprefix = "PRNG.LXM.State."
751 | end)
752 |
753 | let split g =
754 | let i1 = next g in let i2 = next g in let i3 = next g in let i4 = next g in
755 | init i1 i2 i3 i4
756 |
757 | let copy = copy
758 |
759 | let reseed g s = assign g (seed s)
760 | let remake g s = assign g (make s)
761 |
762 | end
763 |
764 | (** The pure interface *)
765 |
766 | module Pure = struct
767 |
768 | type t = state
769 |
770 | let seed = seed
771 | let make = make
772 | let make_self_init () =
773 | match dev_urandom_seed 16 with
774 | | Some s -> seed s
775 | | None -> make (sys_random_seed())
776 |
777 | let byte g =
778 | let g = copy g in (Int64.to_int (next g) land 0xFF, g)
779 | let bits8 = byte
780 | let char g =
781 | let (n, g') = bits8 g in (Char.chr n, g')
782 | let bit g =
783 | let g = copy g in (Int64.to_int (next g) land 0x1 = 1, g)
784 | let bool = bit
785 |
786 | let bits30 g =
787 | let g = copy g in (Int64.to_int (next g) land 0x3FFFFFFF, g)
788 | let bits = bits30
789 |
790 | let bits32 g =
791 | let g = copy g in (Int64.to_int32 (next g), g)
792 |
793 | let bits64 g =
794 | let g = copy g in (next g, g)
795 |
796 | include PureDerived(struct
797 | type nonrec t = t
798 | let bits30 = bits30
799 | let bits32 = bits32
800 | let bits64 = bits64
801 | let errorprefix = "PRNG.Chacha.Pure."
802 | end)
803 |
804 | let split g =
805 | let g = copy g in
806 | let i1 = next g in let i2 = next g in let i3 = next g in let i4 = next g in
807 | (init i1 i2 i3 i4, g)
808 |
809 | end
810 |
811 | end
812 |
--------------------------------------------------------------------------------