(*
** Course: Concepts of Programming Languages (BU CAS CS 320)
** Semester: Summer I, 2009
** Instructor: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
*)

//
// author: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
//

(* ****** ****** *)

extern fun{a:t@ype} array_ptr_shuffle 
  {n:nat} {l:addr} (pf: !array_v (a, n, l) | p: ptr l, n: size_t n):<> void
// end of [extern]

staload RAND = "libc/SATS/random.sats"

implement{a} array_ptr_shuffle
  (pf | p, n) = loop (pf | p, n) where {
  #define i2sz size1_of_int1; #define sz2i int1_of_size1
  fun loop {n:nat} {l:addr} .<n>.
    (pf: !array_v (a, n, l) | p: ptr l, n: size_t n):<> void =
    if n >= 2 then let
      val i = $effmask_ref ($RAND.randint (sz2i n))
      val () = if i <> 0 then array_ptr_exch<a> (!p, 0, i2sz i)
      prval (pf1, pf2) = array_v_uncons {a} (pf)
      val () = loop (pf2 | p + sizeof<a>, n-1)
      prval () = pf := array_v_cons {a} (pf1, pf2)
    in
      // nothing
    end // end of [if]
  // end of [loop]  
} (* end of [array_ptr_shuffle] *)

(* ****** ****** *)

(*

// this is for shuffling a persistent array
extern fun{a:t@ype} array0_shuffle (A: array0 a):<!ref> void

implement{a} array0_shuffle (A) = let
  val r = array0_get_arraysize_ref {a} (A)
  val (vbox pf_asz | p_asz) = ref_get_view_ptr {Arraysize a} (r)
in
  array_ptr_shuffle<a> (p_asz->1 | p_asz->2, p_asz->3)
end // end of [array0_shuffle]

*)

(* ****** ****** *)

extern fun{a:t@ype} list0_shuffle (xs: list0 a):<> list0 a

implement{a}
  list0_shuffle (xs) = list0_of_list1 (xs) where {
  val [n:int] xs = list1_of_list0 (xs)
  val n = list_length (xs); val n = size1_of_int1 (n)
  var !p_arr with pf_arr = @[a][n]() // stack allocation
  val () = array_ptr_initialize_lst<a> (!p_arr, xs)
  val () = array_ptr_shuffle (pf_arr | p_arr, n)
  val xs = loop (!p_arr, n, list_nil) where {
    fun loop {i:nat | i <= n} .<i>.
      (A: & @[a][n], i: size_t i, res: list (a, n-i)):<> list (a, n) =
      if i > 0 then let
        val i = i - 1 in loop (A, i, list_cons (A.[i], res))
      end else res
    // end of [loop]   
  } (* end of [val] *)
} (* end of [list0_shuffle] *)

(* ****** ****** *)

(* end of [list0_shuffle.dats] *)