(*
** 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: May 28, 2009
//

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

#include "BUCASCS320.hats"

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

// this example shows how integer lists are represented internally

datatype intlist =
  | intlist_nil
  | intlist_cons of (int, intlist)

fun sumlist (xs: intlist): int =
  case+ xs of
  | intlist_nil () => 0
  | intlist_cons (x, xs) => x + sumlist (xs)
// end of [sumlist]

extern fun sumlist2 (xs: intlist): int = "csumlist"

#define :: intlist_cons
#define nil intlist_nil
implement main () = let
  val xs = 1 :: 2 :: 3 :: 4 :: 5 :: nil ()
  val sum = sumlist (xs)
  val sum2 = sumlist2 (xs)
in
  printf ("sum = %i\n", @(sum));
  printf ("sum2 = %i\n", @(sum2))
end // end of [main]

%{$


typedef
struct cintlst {
  int head; void *tail;
} cintlst_struct ;

ats_int_type csumlist (ats_ptr_type xs) {
  int res = 0 ;
  while (xs) { // xs is not null
    res = res + ((cintlst_struct*)xs)->head;
    xs = ((cintlst_struct*)xs)-> tail;
  }
  return res ;
}

%}

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

//
// this example demonstrates a *proper* way to make use of exception
//

datatype bt = E | B of (bt, bt)

fun eq_bt_bt (t1: bt, t2: bt): bool =
  case+ (t1, t2) of
  | (B (t11, t12), B (t21, t22)) =>
      eq_bt_bt (t11, t21) andalso eq_bt_bt (t12, t22)
  | (E _ , E _) => true
  | (_, _) => false
// end of [eq_bt_bt]

overload = with eq_bt_bt  

extern fun isPerfect (t: bt): bool

(*

// very inefficient
implement isPerfect (t) = case+ t of
  | B (t1, t2) =>
      if (isPerfect t1 andalso isPerfect t2) then t1 = t2 else false
  | E () => true
// end of [isPerfect]

*)

(*

// a monadic style
implement isPerfect (t) = let
  // aux (t) = ~1 implies that t is not perfect;
  // aux (t) >= 0 implies that t is perfect and its size equals aux (t)
  fun aux (t: bt): int =
    case+ t of
    | B (t1, t2) => let
        val r1 = aux (t1)
      in
        case+ 0 of
        | _ when r1 >= 0 => let
            val r2 = aux (t2) in
            if r2 >= 0 then
              (if r1 = r2 then 1 + r1 + r2 else ~1)
            else ~1
          end // end of [_ when ...]
        | _ (*r1 = ~1*) => ~1 
      end // end of [B]
    | E () => 0
   // end of [aux]
   val r = aux (t)
 in
   if r >= 0 then true else false
 end (* end of [isPerfect] *)

*)  

implement isPerfect (t) = let
  exception NotPerfectException of ()
  // if aux (t) returns then t is perfect and its size equals aux (t)
  fun aux (t: bt): int = case+ t of
    | B (t1, t2) => let
        val r1 = aux (t1)
        val r2 = aux (t2)
      in
        if r1 = r2 then 1 + r1 + r2 else $raise NotPerfectException ()
      end
    | E () => 0
  // end of [aux]
 in
   try let
     val _(*r*) = aux (t) in true
   end with
     | ~NotPerfectException () => false
   // end of [try]
 end // end of [isPerfect]
 
(*

implement main () = let
  val t0 = E ()
  val t1 = B (t0, t0)
  val t2 = B (t1, t1) // perfect
  val t3 = B (t1, t2) // not perfect 
  val ans2 = isPerfect (t2) // true
  val () = (print "ans2 (true) = "; print ans2; print_newline ())
  val ans3 = isPerfect (t3) // false
  val () = (print "ans3 (false) = "; print ans3; print_newline ())
in
  // nothing
end // end of [main]

*)

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

// this example illustrates a *nonsensical* use of exception:

fun{a:t@ype} list_length (xs: list0 a): int = let
  exception SubscriptException of ()
  val res = ref_make_elt<int> (0)
  fun aux (xs: list0 a): void = case+ xs of
    | list0_cons (_, xs) => (!res := !res + 1; aux xs)
    | list0_nil () => $raise SubscriptException ()
  // end of [aux]
in
  try (aux xs; 0) with ~SubscriptException () => !res
end // end of [list_length]

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

(* end of [code-2009-05-28.dats] *)