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

//
// Assignment Four (Due: Tuesday, June 16, 2009)
//
// Total points: 130 points
//
// Assgn4Ex1: 10 points
// Assgn4Ex2: 10 points
// Assgn4Ex3: 30 points
// Assgn4Ex4: 30 points
// Assgn4Ex5: 20 points
// Assgn4Ex6: 30 points
//

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

staload "assignment4.sats"
staload _(*anonymous*) = "assignment4_solu.dats"

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

staload _(*anonymous*) = "prelude/DATS/reference.dats"

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

fun{a:t@ype}
  ltree_size_check (t: ltree a): void = let
  exception SizeError of ()
  fun aux (t: ltree a): int = case+ t of
    | ltree_cons (_(*x*), r_sz, r_tl, r_tr) => let
        val szl = aux (!r_tl) and szr = aux (!r_tr)
        val sz = szl + 1 + szr
      in  
        if (!r_sz = sz) then sz else $raise SizeError ()
      end // end of [ltree_cons]  
    | ltree_nil () => 0
  // end of [aux]  
in
  try let val _ = aux (t) in () end with ~SizeError () => begin
    prerr "Exit: [ltree_size_check] failed"; prerr_newline (); exit (1)
  end // end of [try]
end (* end of [ltree_size_check] *)

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

fun{a:t@ype}
  ltree_order_check (t: ltree a, cmp: (a, a) -> int): void = let
  exception OrderError of ()
  fun auxl (x0: a, t: ltree a):<cloref1> void = case+ t of
    | ltree_cons (x, _(*r_sz*), r_tl, r_tr) => let
        val () = if (cmp (x, x0) > 0) then $raise OrderError ()
      in  
        auxl (x, !r_tl); auxr (x, !r_tr)
      end // end of [ltree_cons]  
    | ltree_nil () => ()
  // end of [auxl]
  and auxr (x0: a, t: ltree a):<cloref1> void = case+ t of
    | ltree_cons (x, _(*r_sz*), r_tl, r_tr) => let
        val () = if (cmp (x, x0) < 0) then $raise OrderError ()
      in  
        auxl (x, !r_tl); auxr (x, !r_tr)
      end // end of [ltree_cons]  
    | ltree_nil () => ()
  // end of [auxl]
in
  try case+ t of
    | ltree_cons (x, _, r_tl, r_tr) => (auxl (x, !r_tl); auxr (x, !r_tr))
    | ltree_nil () => ()
  with ~OrderError () => begin  
    prerr "Exit: [ltree_order_check] failed"; prerr_newline (); exit (1)
  end // end of [try]
end (* end of [ltree_order_check] *)

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

fun{a:t@ype} ltree_insert
  (t: ltree a, x0: a, cmp: (a, a) -> int): ltree a = case+ t of
  | ltree_cons (x, r_sz, r_tl, r_tr) => let
      val sgn = cmp (x0, x) in if sgn <= 0 then let
        val tl = ltree_insert (!r_tl, x0, cmp) in !r_tl := tl; !r_sz := !r_sz + 1; t
      end else let (* sgn > 0 *)  
        val tr = ltree_insert (!r_tr, x0, cmp) in !r_tr := tr; !r_sz := !r_sz + 1; t
      end // end of [if]
    end (* end of [ltree_cons] *)
  | ltree_nil () => ltree_cons (x0, ref 1, ref ltree_nil, ref ltree_nil) 
// end of [ltree_insert]

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

fun{a:t@ype} ltree_print
  (t: ltree a, pr: a -> void) = case+ t of
  | ltree_cons (x, _, r_tl, r_tr) => begin
      print "cons(";
      pr x; print "; "; ltree_print (!r_tl, pr); print "; "; ltree_print (!r_tr, pr);
      print ")"
    end // end of [ltree_cons]
  | ltree_nil () => print "nil"
// end of [ltree_print]

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

dynload "assignment4_solu.dats"

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

local

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

in // in of [local]

val () = $RAND.srand48_with_time ()

end // end of [val]

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

#define N 10
//
val cmp = lam (x: int, y: int) =<fun> compare (x, y)
//
val t = loop (N) where {
  fun loop (i: int): ltree int =
    if i > 0 then ltree_insert (loop (i-1), i, cmp) else ltree_nil
  // end of [loop]  
} (* end of [val] *)
val () = ltree_print<int> (t, lam x => print x)
val () = print_newline ()
val () = ltree_size_check<int> (t)
val () = ltree_order_check<int> (t, cmp)
//
val t = loop (t) where {
  fun loop (t: ltree int): ltree int = case+ t of
    | ltree_cons (_, _, r_tl, r_tr) => let
        val () = !r_tl := loop (!r_tl)
        val () = !r_tr := loop (!r_tr)
      in  
        ltree_random_root (t)
      end // end of [ltree_cons]  
    | ltree_nil () => t
  // end of [loop]
} // end of [val]
val () = ltree_print<int> (t, lam x => print x)
val () = print_newline ()
val () = ltree_size_check<int> (t)
val () = ltree_order_check<int> (t, cmp)
//

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

implement main () = ()

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

(* end of [assignment4_test.dats] *)