(*
** 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 24, 2009
//

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

// some examples translated from in Chapter 4 in the textbook

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

#include "BUCASCS320.hats"

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

#define :: list0_cons
#define cons list0_cons
#define nil list0_nil

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

// textbook, page 124

datatype person =
  | King
  | Peer of (string, string, int)
  | Knight of string
  | Peasant of string

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

// textbook, page 125

fun title (p: person): string = case+ p of
  | King () => "His Majesty the King"
  | Peer (deg, terr, _) => "The " + deg + " of " + terr
(*
  // can also be more efficiently implemented as follows:
  | Peer (deg, terr, _) => sprintf ("The %s of %s", @(deg, terr))
*)
  | Knight name => "Sir " + name
  | Peasant name => name 
// end of [title]  

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

// textbook, page 126

fun superior (p1: person, p2: person): bool =
  case+ (p1, p2) of
  | (King (), Peer _) => true
  | (King (), Knight _) => true
  | (King (), Peasant _) => true
  | (Peer _, Knight _) => true
  | (Peer _, Peasant _) => true
  | (Knight _, Peasant _) => true
  | (_, _) => false

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

// textbook, page 127

datatype degree = Duke | Marquis | Earl | Viscount | Baron

fun lady (deg: degree): string = case+ deg of
  | Duke () => "Duchess"
  | Marquis () => "Marchioness"
  | Earl () => "Countess"
  | Viscount () => "Viscountess"
  | Baron () => "Baroness"
// end of [lady]

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

// textbook, page 138

exception Empty

fun{a:t@ype} hd (xs: list0 a): a = case+ xs of
  | list0_cons (x, _) => x | list0_nil () => $raise Empty
// end of [hd]

fun{a:t@ype} tl (xs: list0 a): list0 a = case+ xs of
  | list0_cons (_, xs) => xs | list0_nil () => $raise Empty
// end of [tl]

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

// textbook, page 138

exception Subscript

fun{a:t@ype} nth (xs: list0 a, i: int): a = case+ xs of
  | list0_cons (x, xs) => if i > 0 then nth (xs, i-1) else x
  | list0_nil () => $raise Subscript
// end of [nth]

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

// textbook, page 139

exception Change

fun backChange (coinvals: list0 int, amount: int): list0 int =
  case+ (coinvals, amount) of
  | (_, 0) => nil ()
  | (nil (), _) => $raise Change ()
  | (c :: coinvals, amount) =>
      if amount < 0 then $raise Change ()
      else try
        c :: backChange (c :: coinvals, amount - c)
      with
        | ~Change () => backChange (coinvals, amount)
      // end of [if]
// end of [backChange]

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

// textbook, page 142

datatype tree (a:t@ype) = Lf(a) of () | Br(a) of (a, tree a, tree a)

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

// textbook, page 144

fun comptree (k: int, n: int): tree int =
  if n = 0 then Lf ()
           else Br (k, comptree (2 * k, n-1), comptree (2 * k + 1, n-1))
// end of [comptree]

fun{a:t@ype} reflect (t: tree a): tree a = case+ t of
  | Lf () => Lf ()
  | Br (v, t1, t2) => Br (v, reflect<a> t2, reflect<a> t1)
// end of [reflect]

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

// textbook, page 145

fun{a:t@ype} preorder (t: tree a): list0 a =
  case+ t of
  | Br (v, t1, t2) => v :: (preorder t1 + preorder t2)
  | Lf () => nil ()

fun{a:t@ype} inorder (t: tree a): list0 a =
  case+ t of
  | Br (v, t1, t2) => inorder t1 + (v :: inorder t2)
  | Lf () => nil ()

fun{a:t@ype} postorder (t: tree a): list0 a =
  case+ t of
  | Br (v, t1, t2) => postorder t1 + (postorder t2 + (v :: nil ()))
  | Lf () => nil ()

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

// textbook, page 147

fun{a:t@ype} balpre (xs: list0 a): tree a = case+ xs of
  | x :: xs => let
      val k = list0_length<a> xs / 2 in
      Br (x, balpre (list0_take_exn (xs, k)), balpre (list0_drop_exn (xs, k)))
    end // end of [::]
  | nil () => Lf ()
// end of [balpre]

fun{a:t@ype} balin (xs: list0 a): tree a = case+ xs of
  | x :: xs => let
      val k = list0_length<a> xs / 2
      val- y :: ys = list0_drop_exn (xs, k)
    in
      Br (y, balin (list0_take_exn (xs, k)), balin ys)
    end // end of [::]
  | nil () => Lf ()
// end of [balin]

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

implement main () = let
(*
  val coinlst = backChange (10 :: 2 :: nil (), 27)
  val () = loop (coinlst, 0) where {
    fun loop (cs: list0 int, i: int): void =
      case+ cs of
      | c :: cs => loop (cs, i+1) where {
          val () = if i > 0 then print ", "; val () = print c
        } // end of [::]
      | nil () => print_newline ()
  } // end of [val]
*)
in
  // empty
end // end of [main]

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

(* end of [chapter4_examples.dats] *)