summaryrefslogtreecommitdiffstats
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/Makefile3
-rw-r--r--stdlib/camlinternalOO.ml4
-rw-r--r--stdlib/filename.ml14
-rw-r--r--stdlib/random.ml238
-rw-r--r--stdlib/random.mli72
5 files changed, 191 insertions, 140 deletions
diff --git a/stdlib/Makefile b/stdlib/Makefile
index 93ad8d13d..9984a71fe 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -26,13 +26,14 @@ CAMLDEP=../boot/ocamlrun ../tools/ocamldep
BASIC=pervasives.cmo array.cmo list.cmo char.cmo string.cmo sys.cmo \
hashtbl.cmo sort.cmo marshal.cmo obj.cmo \
+ int32.cmo int64.cmo nativeint.cmo \
lexing.cmo parsing.cmo \
set.cmo map.cmo stack.cmo queue.cmo stream.cmo buffer.cmo \
printf.cmo format.cmo scanf.cmo \
arg.cmo printexc.cmo gc.cmo \
digest.cmo random.cmo camlinternalOO.cmo oo.cmo \
genlex.cmo callback.cmo weak.cmo \
- lazy.cmo filename.cmo int32.cmo int64.cmo nativeint.cmo complex.cmo
+ lazy.cmo filename.cmo complex.cmo
LABELLED=arrayLabels.ml listLabels.ml stringLabels.ml moreLabels.ml
OBJS=$(BASIC) labelled.cmo stdLabels.cmo
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index e26ea2832..dcf23dd6f 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -171,9 +171,11 @@ let merge_buckets b1 b2 =
bucket_list := except b2 !bucket_list;
b1
+let prng = Random.State.make [| 0 |];;
+
let rec choose bucket i =
if (i > 0) && (!small_bucket_count > 0) then begin
- let n = Random.int !small_bucket_count in
+ let n = Random.State.int prng !small_bucket_count in
if not (small_bucket !small_buckets.(n)) then begin
remove_bucket n; choose bucket i
end else
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index 05d32fa25..057b2beca 100644
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -182,19 +182,13 @@ let chop_extension name =
external open_desc: string -> open_flag list -> int -> int = "sys_open"
external close_desc: int -> unit = "sys_close"
-external random_seed: unit -> int = "sys_random_seed"
-let temp_file_counter = ref 0
+let prng = Random.State.make_self_init ();;
let temp_file_name prefix suffix =
- if !temp_file_counter = 0 then temp_file_counter := random_seed();
- let name =
- concat temporary_directory
- (Printf.sprintf "%s%06x%s"
- prefix (!temp_file_counter land 0xFFFFFF) suffix) in
- (* Linear congruential PRNG *)
- temp_file_counter := !temp_file_counter * 69069 + 25173;
- name
+ let rnd = (Random.State.bits prng) land 0xFFFFFF in
+ concat temporary_directory (Printf.sprintf "%s%06x%s" prefix rnd suffix)
+;;
let temp_file prefix suffix =
let rec try_name counter =
diff --git a/stdlib/random.ml b/stdlib/random.ml
index 2c2f2408f..3e0d99166 100644
--- a/stdlib/random.ml
+++ b/stdlib/random.ml
@@ -20,117 +20,153 @@
It is seeded by a MD5-based PRNG.
*)
-type state = { st : int array; mutable idx : int };;
+external random_seed: unit -> int = "sys_random_seed";;
+
+module State = struct
+
+ type t = { st : int array; mutable idx : int };;
+
+ let new_state () = { st = Array.make 55 0; idx = 0 };;
+ let assign st1 st2 =
+ Array.blit st2.st 0 st1.st 0 55;
+ st1.idx <- st2.idx;
+ ;;
+
+ let full_init s seed =
+ let combine accu x = Digest.string (accu ^ string_of_int x) in
+ let extract d =
+ (Char.code d.[0] + (Char.code d.[1] lsl 8) + (Char.code d.[2] lsl 16))
+ lxor (Char.code d.[3] lsl 22)
+ in
+ let l = Array.length seed in
+ for i = 0 to 54 do
+ s.st.(i) <- i;
+ done;
+ let accu = ref "x" in
+ for i = 0 to 54 + max 55 l do
+ let j = i mod 55 in
+ let k = i mod l in
+ accu := combine !accu seed.(k);
+ s.st.(j) <- s.st.(j) lxor extract !accu;
+ done;
+ s.idx <- 0;
+ ;;
+
+ let make seed =
+ let result = new_state () in
+ full_init result seed;
+ result
+ ;;
+
+ let make_self_init () = make [| random_seed () |];;
+
+ let copy s =
+ let result = new_state () in
+ assign result s;
+ result
+ ;;
+
+ (* Returns 30 random bits as an integer 0 <= x < 1073741824 *)
+ let bits s =
+ s.idx <- (s.idx + 1) mod 55;
+ let newval = (s.st.((s.idx + 24) mod 55) + s.st.(s.idx)) land 0x3FFFFFFF in
+ s.st.(s.idx) <- newval;
+ newval
+ ;;
+
+ let rec intaux s n =
+ let r = bits s in
+ if r >= n then intaux s n else r
+ ;;
+ let int s bound =
+ if bound > 0x3FFFFFFF || bound <= 0
+ then invalid_arg "Random.int"
+ else (intaux s (0x3FFFFFFF / bound * bound)) mod bound
+ ;;
+
+ let rec int32aux s n =
+ let b1 = Int32.of_int (bits s) in
+ let b2 = Int32.shift_left (Int32.of_int (bits s land 1)) 30 in
+ let r = Int32.logor b1 b2 in
+ if r >= n then int32aux s n else r
+ ;;
+ let int32 s bound =
+ if bound <= 0l then
+ invalid_arg "Random.int32"
+ else
+ let rb = Int32.mul bound (Int32.div Int32.max_int bound) in
+ Int32.rem (int32aux s rb) bound
+ ;;
+
+ let rec int64aux s n =
+ let b1 = Int64.of_int (bits s) in
+ let b2 = Int64.shift_left (Int64.of_int (bits s)) 30 in
+ let b3 = Int64.shift_left (Int64.of_int (bits s land 7)) 60 in
+ let r = Int64.logor b1 (Int64.logor b2 b3) in
+ if r >= n then int64aux s n else r
+ ;;
+ let int64 s bound =
+ if bound <= 0L then
+ invalid_arg "Random.int64"
+ else
+ let rb = Int64.mul bound (Int64.div Int64.max_int bound) in
+ Int64.rem (int64aux s rb) bound
+ ;;
+
+ let nativeint =
+ if Nativeint.size = 32
+ then fun s bound -> Nativeint.of_int32 (int32 s (Nativeint.to_int32 bound))
+ else fun s bound -> Int64.to_nativeint (int64 s (Int64.of_nativeint bound))
+ ;;
+
+ (* Returns a float 0 <= x < 1 with at most 90 bits of precision. *)
+ let rawfloat s =
+ let scale = 1073741824.0
+ and r0 = Pervasives.float (bits s)
+ and r1 = Pervasives.float (bits s)
+ and r2 = Pervasives.float (bits s)
+ in ((r0 /. scale +. r1) /. scale +. r2) /. scale
+ ;;
+
+ let float s bound = rawfloat s *. bound;;
+
+ let bool s = (bits s land 1 = 0);;
+
+end;;
(* This is the state you get with [init 27182818] on a 32-bit machine. *)
let default = {
- st = [|
- 561073064; 1051173471; 764306064; 9858203; 1023641486; 615350359;
- 552627506; 486882977; 147054819; 951240904; 869261341; 71648846;
- 848741663; 337696531; 66770770; 473370118; 998499212; 477485839;
- 814302728; 281896889; 206134737; 796925167; 762624501; 971004788;
- 878960411; 233350272; 965168955; 933858406; 572927557; 708896334;
- 32881167; 462134267; 868098973; 768795410; 567327260; 4136554;
- 268309077; 804670393; 854580894; 781847598; 310632349; 22990936;
- 187230644; 714526560; 146577263; 979459837; 514922558; 414383108;
- 21528564; 896816596; 33747835; 180326017; 414576093; 124177607;
- 440266690;
- |];
- idx = 0;
+ State.st = [|
+ 509760043; 399328820; 99941072; 112282318; 611886020; 516451399;
+ 626288598; 337482183; 748548471; 808894867; 657927153; 386437385;
+ 42355480; 977713532; 311548488; 13857891; 307938721; 93724463;
+ 1041159001; 444711218; 1040610926; 233671814; 664494626; 1071756703;
+ 188709089; 420289414; 969883075; 513442196; 275039308; 918830973;
+ 598627151; 134083417; 823987070; 619204222; 81893604; 871834315;
+ 398384680; 475117924; 520153386; 324637501; 38588599; 435158812;
+ 168033706; 585877294; 328347186; 293179100; 671391820; 846150845;
+ 283985689; 502873302; 718642511; 938465128; 962756406; 107944131;
+ 192910970;
+ |];
+ State.idx = 0;
};;
-(* Returns 30 random bits as an integer 0 <= x < 1073741824 *)
-let s_bits s =
- s.idx <- (s.idx + 1) mod 55;
- let newval = (s.st.((s.idx + 24) mod 55) + s.st.(s.idx)) land 0x3FFFFFFF in
- s.st.(s.idx) <- newval;
- newval
-;;
-
-(* Returns a float 0 <= x < 1 with at most 90 bits of precision. *)
-let s_rawfloat s =
- let scale = 1073741824.0
- and r0 = Pervasives.float (s_bits s)
- and r1 = Pervasives.float (s_bits s)
- and r2 = Pervasives.float (s_bits s)
- in ((r0 /. scale +. r1) /. scale +. r2) /. scale
-;;
-
-let rec s_intaux s n =
- let r = s_bits s in
- if r >= n then s_intaux s n else r
-;;
-let s_int s bound =
- if bound > 0x3FFFFFFF || bound <= 0
- then invalid_arg "Random.int"
- else (s_intaux s (0x3FFFFFFF / bound * bound)) mod bound
-;;
-
-let s_float s bound = s_rawfloat s *. bound
-
-let s_bool s = (s_bits s land 1 = 0);;
-
-let bits () = s_bits default;;
-let int bound = s_int default bound;;
-let float scale = s_float default scale;;
-let bool () = s_bool default;;
-
-(* Full initialisation. The seed is an array of integers. *)
-let s_full_init s seed =
- let combine accu x = Digest.string (accu ^ string_of_int x) in
- let extract d =
- (Char.code d.[0] + (Char.code d.[1] lsl 8) + (Char.code d.[2] lsl 16))
- lxor (Char.code d.[3] lsl 22)
- in
- let l = Array.length seed in
- for i = 0 to 54 do
- s.st.(i) <- i;
- done;
- let accu = ref "x" in
- for i = 0 to 54 + max 55 l do
- let j = i mod 55 in
- let k = i mod l in
- accu := combine !accu seed.(k);
- s.st.(j) <- s.st.(j) lxor extract !accu;
- done;
- s.idx <- 0;
-;;
-
-let full_init seed = s_full_init default seed;;
+let bits () = State.bits default;;
+let int bound = State.int default bound;;
+let int32 bound = State.int32 default bound;;
+let nativeint bound = State.nativeint default bound;;
+let int64 bound = State.int64 default bound;;
+let float scale = State.float default scale;;
+let bool () = State.bool default;;
-(* Simple initialisation. The seed is an integer. *)
-let init seed = s_full_init default [| seed |];;
-
-(* Low-entropy system-dependent initialisation. *)
-external random_seed: unit -> int = "sys_random_seed";;
+let full_init seed = State.full_init default seed;;
+let init seed = State.full_init default [| seed |];;
let self_init () = init (random_seed());;
-(* The default PRNG is initialised with self_init. *)
-self_init ();;
-
-let new_state () = { st = Array.make 55 0; idx = 0 };;
-let assign_state st1 st2 =
- Array.blit st2.st 0 st1.st 0 55;
- st1.idx <- st2.idx;
-;;
-
-(* Create, initialise, and return a new state value. *)
-let s_make seed =
- let result = new_state () in
- s_full_init result seed;
- result
-;;
-
-let s_copy s =
- let result = new_state () in
- assign_state result s;
- result
-;;
-
(* Manipulating the current state. *)
-let get_state () = s_copy default;;
-let set_state s = assign_state default s;;
+let get_state () = State.copy default;;
+let set_state s = State.assign default s;;
(********************
diff --git a/stdlib/random.mli b/stdlib/random.mli
index 0f1ccc459..a68eaf550 100644
--- a/stdlib/random.mli
+++ b/stdlib/random.mli
@@ -15,7 +15,7 @@
(** Pseudo-random number generators (PRNG). *)
-(** {6 functions for casual users} *)
+(** {6 basic functions} *)
val init : int -> unit
(** Initialize the generator, using the argument as a seed.
@@ -26,8 +26,7 @@ val full_init : int array -> unit
val self_init : unit -> unit
(** Initialize the generator with a more-or-less random seed chosen
- in a system-dependent way. The generator is initialised with this
- function at the start of the program. *)
+ in a system-dependent way. *)
val bits : unit -> int
(** Return 30 random bits in a nonnegative integer. *)
@@ -37,6 +36,18 @@ val int : int -> int
and [bound] (exclusive). [bound] must be more than 0 and less
than 2{^30}. *)
+val int32 : Int32.t -> Int32.t;;
+(** [Random.int32 bound] returns a random integer between 0 (inclusive)
+ and [bound] (exclusive). [bound] must be greater than 0. *)
+
+val nativeint : Nativeint.t -> Nativeint.t;;
+(** [Random.nativeint bound] returns a random integer between 0 (inclusive)
+ and [bound] (exclusive). [bound] must be greater than 0. *)
+
+val int64 : Int64.t -> Int64.t;;
+(** [Random.int64 bound] returns a random integer between 0 (inclusive)
+ and [bound] (exclusive). [bound] must be greater than 0. *)
+
val float : float -> float
(** [Random.float bound] returns a random floating-point number
between 0 (inclusive) and [bound] (exclusive). If [bound] is
@@ -46,20 +57,8 @@ val float : float -> float
val bool : unit -> bool
(** [Random.bool ()] returns [true] or [false] with probability 0.5 each. *)
-type state
-(** Values of this type are used to store the current state of the
- generator. *)
-
-val get_state : unit -> state
-(** Return the current state of the generator. This is useful for
- checkpointing computations that use the PRNG. *)
-
-val set_state : state -> unit
-(** Reset the state of the generator to some previous state returned by
- {!Random.get_state}. *)
-
-(** {6 functions for serious users} *)
+(** {6 advanced functions} *)
(** These function manipulate the current state explicitely.
This allows you to use one or several deterministic PRNGs,
@@ -68,16 +67,35 @@ val set_state : state -> unit
and some object-oriented primitives use the default PRNG).
*)
-val s_make : int array -> state;;
-(** Create a new state and initialize it with the given seed. *)
+module State : sig
+ type t
+ (** The type of PRNG states. *)
-val s_copy : state -> state;;
-(** Make a copy of the given state. *)
+ val make : int array -> t
+ (** Create a new state and initialize it with the given seed. *)
-val s_bits : state -> int;;
-val s_int : state -> int -> int;;
-val s_float : state -> float -> float;;
-val s_bool : state -> bool;;
-(** These functions are the same as the above versions, except that they
- use (and update) the given PRNG state instead of the default one.
-*)
+ val make_self_init : unit -> t
+ (** Create a new state and initialize it with a system-dependent
+ low-entropy seed. *)
+
+ val copy : t -> t
+ (** Return a copy of the given state. *)
+
+ val bits : t -> int
+ val int : t -> int -> int
+ val int32 : t -> Int32.t -> Int32.t
+ val nativeint : t -> Nativeint.t -> Nativeint.t
+ val int64 : t -> Int64.t -> Int64.t
+ val float : t -> float -> float
+ val bool : t -> bool
+ (** These functions are the same as the basic functions, except that they
+ use (and update) the given PRNG state instead of the default one.
+ *)
+end;;
+
+
+val get_state : unit -> State.t
+(** Return the current state of the generator used by the basic functions. *)
+
+val set_state : State.t -> unit
+(** Set the state of the generator used by the basic functions. *)
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-19 06:55:10 +0000