(* Construct random terms *)
(* Modified: Dave *)

structure Random
    : sig
	  type params
	      
	  val default : params

	  (* Each seed determines a different pseudo-random number
	   * sequence.  Assumes seed >= 0.
	   *)
	  val set_seed : int -> params -> params

	  (* Roughly the percentage of generated Text which will be
	   * whitespace.  Assumes 0 <= percentage <= 100.
	   *)
	  val set_space_percentage : int -> params -> params

	  (* Maximum number of tags in a Tag expression.  NONE means
	   * no limit.  Assumes limit >= 1.
	   *)
	  val set_tag_limit : int option -> params -> params

	  (* (random_exp params n) creates an expression
	   * whose size is approximately n.
	   *)
	  val random_exp : params -> int -> Il.exp
      end =
struct
    datatype 'a params = PARAMS of {rand : 'a,
				    space_percentage : int,
				    tag_limit : int option}
    type params = int params

    val default = PARAMS {rand = 0,
			  space_percentage = 25,
			  tag_limit = SOME 20}
	
    fun set_seed i (PARAMS {rand,space_percentage,tag_limit}) =
	PARAMS {rand = i,
		space_percentage = space_percentage,
		tag_limit = tag_limit}

    fun set_space_percentage i (PARAMS {rand,space_percentage,tag_limit}) =
	if i < 0 orelse i > 100
	    then raise Fail "bad percentage"
	else
	    PARAMS {rand = rand,
		    space_percentage = i,
		    tag_limit = tag_limit}

    fun check_limit limit =
	(case limit
	   of NONE => limit
	    | SOME i =>
	       if i <= 0 then raise Fail "bad limit"
	       else limit)

    fun set_tag_limit limit (PARAMS {rand,space_percentage,tag_limit}) =
	PARAMS {rand = rand,
		space_percentage = space_percentage,
		tag_limit = check_limit limit}

    (* params_map : ('a -> 'b) -> 'a params -> 'b params *)
    fun params_map f (PARAMS {rand,space_percentage,tag_limit}) =
	PARAMS {rand = f rand,
		space_percentage = space_percentage,
		tag_limit = tag_limit}
	
    (* simple_rand : Word32.word -> Word32.word.
     * Simple linear congruential pseudo random number generator.
     * Constants from Numerical Recipes.
     *)
    fun simple_rand seed =
	let val c = 0w1013904223
	    val a = 0w1664525
            (* modulus is 2^32 *)
	in  Word32.+(Word32.*(a,seed),c)
	end

    (* Lossy conversion of 32-bit word to real without overflow.  We
       avoid LargeInt of problems with today's (7/27/01) version of
       MLton. *)
    fun word2real w =
	let val keepbits = (case Int.precision
			      of NONE => 32
			       | SOME k => k - 1)
	    val shift = Word.fromInt (32 - keepbits)
	    val w = Word32.<< (w,shift)
	    val w = Word32.>> (w,shift)
	    val i = Word32.toInt w
	in  Real.fromInt i
	end

    (* If f = (mkrand seed) and i > 0, then each application f i
     * returns a pseudo-random j s.t. 0 <= j < i.
     *)
    fun mkrand seed =
	let val current = ref seed
	    fun next i =
		let val _ = current := simple_rand (!current)
		    (* low order bits not very random *)
		    (* val wr = Word32.mod (!current,Word32.fromInt i) *)
		    (* val r = Word32.toInt r *)
		    val rand = word2real (!current)
		    val max  = word2real 0wxFFFFFFFF + 1.0
		    val r = floor (real i * rand / max)
		in  r
		end
	in  next
	end

    fun random_attr (PARAMS {rand,...}) : Token.attr =
	(case rand 2
	   of 0 => Token.B
	    | 1 => Token.I)
	     
    fun random_tag (p as PARAMS {rand,...}) : Token.tag =
	(case rand 8
	   of 0 => Token.EM
	    | 1 => Token.PL
	    | 2 => Token.S
	    | 3 => Token.TT
	    | 4 => Token.U
	    | 5 => Token.Num (rand 10)
	    | 6 => Token.Clr (rand 8)
	    | 7 => Token.Att (random_attr p))

    fun random_char (p as PARAMS {rand,space_percentage,...}) : char =
	if rand 100 < space_percentage then
	    (case rand 4
	       of 0 => #" "
		| 1 => #"\^M"
		| 2 => #"\n"
		| 3 => #"\t")
	else #"*"
	    
    (* iterate : int * (unit -> 'a) -> 'a list *)
    fun iterate (n,f) = List.tabulate (n, fn _ => f())

    fun random_string (params, size) : string =
	let val chars = iterate (size, fn () => random_char params)
	in  String.implode chars
	end

    (* Given n >= 0, construct a list of non-zero natural numbers
       which sums to n. *)
    fun partition (PARAMS {rand,...}, n) =
	let
	    fun loop (0, acc) = acc
	      | loop (remain, acc) =
		let val cur = (rand remain) + 1
		in  loop (remain-cur, cur :: acc)
		end
	in  loop (n,nil)
	end

    fun limit (NONE,i) = i
      | limit (SOME j,i) = Int.min (j,i)

    fun random_exp_any params size =	(* assumes size >= 0 *)
	if size = 0 then Il.Seq []
	else
	    let val PARAMS {rand,...} = params
		val f = (case rand 3
			   of 0 => random_exp_tag
			    | 1 => random_exp_seq
			    | 2 => random_exp_text)
	    in  f params size
	    end

    and random_exp_tag params size =	(* assumes size >= 1 *)
	let val PARAMS {tag_limit,rand,...} = params
	    val numtags = limit (tag_limit, (rand size) + 1)
	    val size = Int.max (0, size - numtags)
	    val tags = iterate (numtags,
				fn () => random_tag params)
	in  Il.Tag (tags, random_exp_any params size)
	end

    and random_exp_seq params size =	(* assumes size >= 0 *)
	let val sizes = partition (params, size)
	    val exps = map (random_exp_any params) sizes
	in  Il.Seq exps
	end

    and random_exp_text params size =	(* assumes size >= 0 *)
	Il.Text (random_string (params, size))

    fun random_exp params size =
	if size < 0 then raise Fail "bad size"
	else random_exp_seq params size

    val random_exp = random_exp o (params_map (mkrand o Word32.fromInt))
end
