(*
** 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)
// Time: Tuesday, June 9, 2009
//

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

#include "BUCASCS320.hats"

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

// implementing an integer counter

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

typedef counterObj = '{
  get= () -<cloref1> int
, inc= () -<cloref1> void
, getinc = () -<cloref1> int
, reset = ()  -<cloref1> void
} // end of [typedef]

extern fun counterObj_make (): counterObj

implement counterObj_make () = let
  val state = ref_make_elt<int> (0)
in '{
  get= lam () =<cloref1> !state
, inc= lam () =<cloref1> !state := !state + 1
, getinc= lam () =<cloref1>
    let val n = !state in !state := !state + 1; n end
  // end of [getinc] 
, reset= lam () =<cloref1> !state := 0   
} end // end of [counterObj_make]

val cnt1 = counterObj_make ()
val () = (cnt1.inc ();  cnt1.inc ())
val n1 = cnt1.get ()
val () = printf ("n1 = %d\n", @(n1))

val cnt2 = counterObj_make ()
val () = (cnt2.inc ();  cnt2.inc (); cnt2.inc ())
val n2 = cnt2.get ()
val () = printf ("n2 = %d\n", @(n2))

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

// implementing a queue object

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

datatype llist (a:t@ype) = 
  | llist_nil (a) of ()
  | llist_cons (a) of (a, ref (llist a))
// end of [llist]

exception Empty of ()
typedef queueObj (a:t@ype) = '{
  enqueue= a -<cloref1> void
, dequeue= () -<cloref1> a (* raising Empty () if the queue is empty *)
, foreach= (a -<cloref1> void) -<cloref1> void
}

// exception Undefined // for temporary use

extern fun{a:t@ype} queueObj_make (): queueObj a

implement{a} queueObj_make () = let
  val front = ref_make_elt<llist a> (llist_nil)
  val back = ref_make_elt<llist a> (llist_nil)
in '{
  enqueue= lam (x) => case !back of
    | llist_nil () => begin // the queue is empty
        !front := llist_cons (x, ref llist_nil); !back := !front
      end // end of [llist_nil]
    | llist_cons (_(*last*), r_last) => begin
        !r_last := llist_cons (x, ref llist_nil); !back := !r_last
      end // end of [llist_cons]  
  // end of [enqueue]
, dequeue= lam () => let
    val x = (case+ !front of
      | llist_cons (x, r_xs) => (!front := !r_xs; x)
      | llist_nil () => $raise Empty ()
    ) : a  
    val () = case+ !front of
      | llist_nil () => !back := llist_nil ()
      | llist_cons _ => ()
    //
  in
    x // the return value
  end (* end of [enqueue] *)
, foreach = lam (f) => loop (!front) where {
    fun loop (xs: llist a):<cloref1> void = case+ xs of
      | llist_cons (x, r_xs) => (f x; loop (!r_xs)) | _ => ()
  } // end of [foreach]
} end // end of [queueObj_make]

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

val Q = queueObj_make<int> ()

val () = Q.enqueue (1)
val () = Q.enqueue (2)
val () = Q.enqueue (3)

val x1 = Q.dequeue ()
val () = printf ("x1 = %i\n", @(x1))
val x2 = Q.dequeue ()
val () = printf ("x2 = %i\n", @(x2))
val x3 = Q.dequeue ()
val () = printf ("x3 = %i\n", @(x3))

val () = Q.enqueue (1)
val () = Q.enqueue (2)
val () = Q.enqueue (3)

val () = Q.foreach (lam (x) => (print x; print_newline ()))

val x1 = Q.dequeue ()
val () = printf ("x1 = %i\n", @(x1))
val x2 = Q.dequeue ()
val () = printf ("x2 = %i\n", @(x2))
val x3 = Q.dequeue ()
val () = printf ("x3 = %i\n", @(x3))

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

implement main () = ()

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

(* end of [code-2009-06-03.dats] *)