Add Random.full_int (ocaml#9489)

* Allow 62-bit bound on Random.int on 64-bit systems

* Add Random.int63

Behaves equivalently on 64-bit and JavaScript and allows 62-bit
upperbound on 64-bit systems.

* Use upper bits of each 30-bit random int

* Simple chi-square test for functions from module Random

* Fix 32-bit path (unnecessary use of wrong mask)

* Add a test for the JavaScript case

* Remove the unnecessary extra bit

* Random.full_int instead of Random.int63

Co-authored-by: Xavier Leroy <xavier.leroy@college-de-france.fr>

Changes

@@ -156,6 +156,11 @@ Working version
   functions in String to match those in Bytes.
   (David Allsopp, review by Damien Doligez, Gabriel Scherer and others)
 
+- #9487, #9489: Add Random.full_int which allows 62-bit bounds on 64-bit
+  systems.
+  (David Allsopp, request by Francois Berenger, review by Xavier Leroy and
+   Damien Doligez)
+
 - #9533: Added String.starts_with and String.ends_with.
   (Bernhard Schommer, review by Daniel Bünzli, Gabriel Scherer and
   Alain Frisch)

stdlib/random.ml

@@ -93,6 +93,39 @@ module State = struct
     then invalid_arg "Random.int"
     else intaux s bound
 
+  let rec int63aux s n =
+    let max_int_32 = (1 lsl 30) + 0x3FFFFFFF in (* 0x7FFFFFFF *)
+    let b1 = bits s in
+    let b2 = bits s in
+    let (r, max_int) =
+      if n <= max_int_32 then
+        (* 31 random bits on both 64-bit OCaml and JavaScript.
+           Use upper 15 bits of b1 and 16 bits of b2. *)
+        let bpos =
+          (((b2 land 0x3FFFC000) lsl 1) lor (b1 lsr 15))
+        in
+          (bpos, max_int_32)
+      else
+        let b3 = bits s in
+        (* 62 random bits on 64-bit OCaml; unreachable on JavaScript.
+           Use upper 20 bits of b1 and 21 bits of b2 and b3. *)
+        let bpos =
+          ((((b3 land 0x3FFFFE00) lsl 12) lor (b2 lsr 9)) lsl 20)
+            lor (b1 lsr 10)
+        in
+          (bpos, max_int)
+    in
+    let v = r mod n in
+    if r - v > max_int - n + 1 then int63aux s n else v
+
+  let full_int s bound =
+    if bound <= 0 then
+      invalid_arg "Random.full_int"
+    else if bound > 0x3FFFFFFF then
+      int63aux s bound
+    else
+      intaux s bound
+
 
   let rec int32aux s n =
     let b1 = Int32.of_int (bits s) in
@@ -165,6 +198,7 @@ let default = {
 
 let bits () = State.bits default
 let int bound = State.int default bound
+let full_int bound = State.full_int default bound
 let int32 bound = State.int32 default bound
 let nativeint bound = State.nativeint default bound
 let int64 bound = State.int64 default bound

stdlib/random.mli

@@ -42,6 +42,17 @@ val int : int -> int
      and [bound] (exclusive).  [bound] must be greater than 0 and less
      than 2{^30}. *)
 
+val full_int : int -> int
+(** [Random.full_int bound] returns a random integer between 0 (inclusive)
+     and [bound] (exclusive). [bound] may be any positive integer.
+
+     If [bound] is less than 2{^30}, [Random.full_int bound] is equal to
+     {!Random.int}[ bound]. If [bound] is greater than 2{^30} (on 64-bit systems
+     or non-standard environments, such as JavaScript), [Random.full_int]
+     returns a value, where {!Random.int} raises {!Invalid_argument}.
+
+    @since 4.13.0 *)
+
 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. *)
@@ -89,6 +100,7 @@ module State : sig
 
   val bits : t -> int
   val int : t -> int -> int
+  val full_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

testsuite/tests/lib-random/chi2.ml

@@ -65,4 +65,24 @@ let _ =
                                              52)));
   test "Random.int64 (256 * p) / p"
        (let p = 16430454264262693L in
-        fun () -> Int64.(to_int (div (Random.int64 (mul 256L p)) p)))
+        fun () -> Int64.(to_int (div (Random.int64 (mul 256L p)) p)));
+  if Sys.int_size >= 32 then begin
+    test "Random.full_int 2^30 (bits 0-7)"
+         (fun () -> Random.full_int (1 lsl 30));
+    test "Random.full_int 2^30 (bits 22-29)"
+         (fun () -> Random.full_int (1 lsl 30) lsr 22);
+    test "Random.full_int (256 * p) / p"
+         (let p = 7992689 in
+          fun () -> Random.full_int (256 * p) / p)
+  end;
+  if Sys.int_size >= 63 then begin
+    test "Random.full_int 2^60 (bits 0-7)"
+         (fun () -> Random.full_int (1 lsl 60));
+    test "Random.full_int 2^60 (bits 30-37)"
+         (fun () -> Random.full_int (1 lsl 60) lsr 30);
+    test "Random.full_int 2^60 (bits 52-59)"
+         (fun () -> Random.full_int (1 lsl 60) lsr 52);
+    test "Random.full_int (256 * P) / P"
+         (let p = Int64.to_int 17766642568158577L in
+          fun () -> Random.full_int (256 * p) / p)
+  end

testsuite/tests/lib-random/full_int.ml

@@ -0,0 +1,10 @@
+(* TEST *)
+
+(* Ensure that a bound which is negative on 31-bit OCaml but positive on 32-bit
+   OCaml produces the same result on 64-bit OCaml. *)
+let bound = 0x6FFFFFFF in
+if bound < 0 then (* 31-bit integers *)
+  print_endline "6beb775a"
+else (* 32 or 64-bit integers *)
+  let s = Random.State.make [| 42 |] in
+  Printf.printf "%x\n" (Random.State.full_int s bound)

testsuite/tests/lib-random/full_int.reference

@@ -0,0 +1 @@
+6beb775a