(************************************************************************)
(* This file is part of SKS.  SKS is free software; you can
   redistribute it and/or modify it under the terms of the GNU General
   Public License as published by the Free Software Foundation; either
   version 2 of the License, or (at your option) any later version.

   This program is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
   USA *)
(***********************************************************************)

(** Modified version of standard ocaml PRNG so multiple instances 
  can be created *)
open StdLabels
open MoreLabels

type seed = [ `SelfSeed | `IntSeed of int | `ArraySeed of int array ]

module Make(Seed:sig val seed : seed end) = 
struct
  (* This is the state you get with [init 27182818] on a 32-bit machine. *)
  let state = [|
    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
  |]

  let index = ref 0

  (* Returns 30 random bits as an integer 0 <= x < 1073741824 *)
  let bits () =
    index := (!index + 1) mod 55;
    let newval =
      state.((!index + 24) mod 55) + state.(!index) in
      state.(!index) <- newval;
      newval land 0x3FFFFFFF

  (* Returns a float 0 <= x < 1 with at most 90 bits of precision. *)
  let rawfloat () =
    let scale = 1073741824.0
    and r0 = float (bits ())
    and r1 = float (bits ())
    and r2 = float (bits ())
    in ((r0 /. scale +. r1) /. scale +. r2) /. scale

  let rec intaux n =
    let r = bits () in
      if r >= n then intaux n else r
  let int bound =
    if bound > 0x3FFFFFFF || bound <= 0
    then invalid_arg "Random.int"
    else (intaux (0x3FFFFFFF / bound * bound)) mod bound

  let float bound = rawfloat () *. bound

  (* Simple initialisation.  The seed is an integer.
     Two seeds that are close enough will not produce uncorrelated
     pseudo-random sequences.
  *)
  let init seed =
    let st = ref seed in
    let mdg () =
      st := !st + 1;
      let d = Digest.string (string_of_int !st) in
	(Char.code d.[0] + (Char.code d.[1] lsl 8) + (Char.code d.[2] lsl 16))
	lxor (Char.code d.[3] lsl 22)
    in
      for i = 0 to 54 do
	state.(i) <- (mdg ())
      done;
      index := 0

  (* Full initialisation.  The seed is an array of integers. *)
  let full_init seed =
    init 27182818;
    for i = 0 to Array.length (seed) - 1 do
      let j = i mod 55 in
	state.(j) <- state.(j) + seed.(i)
    done

  (* Low-entropy system-dependent initialisation. *)

  external random_seed: unit -> int = "caml_sys_random_seed"

  let self_init () = init (random_seed())


  (* Manipulating the current state. *)

  type state = { st : int array; idx : int }

  let get_state () = { st = Array.copy state; idx = !index }

  let set_state s =
    Array.blit ~src:s.st ~src_pos:0 ~dst:state ~dst_pos:0 ~len:55;
    index := s.idx


  let _ = 
    match Seed.seed with
	`SelfSeed -> self_init ()
      | `IntSeed i -> init i
      | `ArraySeed ar -> full_init ar
    
end