(*
** 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 3 in the textbook

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

#include "BUCASCS320.hats"

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

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

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

// textbook, page 71

fun upto (m: int, n: int): list0 int =
  if m > n then nil () else m :: upto (m+1, n)
// end of [upto]

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

// textbook, page 72

fun prod (ns: list0 int): int = case+ ns of
  | n :: ns => n * prod (ns) | nil () => 1
// end of [prod]

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

// textbook, page 72

// a very *inefficient* style
fun maxl (ns: list0 int): int = case- ns of
  | n :: nil () => n
  | n1 :: n2 :: ns =>
      if n1 >= n2 then maxl (n1 :: ns) else maxl (n2 :: ns)
// end of [maxl]

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

// textbook, page 73

fun factl (n: int): int = prod (upto (1, n))

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

// textbook, page 74

fun null {a:t@ype} (xs: list0 a): bool =
  case+ xs of nil () => true | _ :: _ => false
// end of [null]

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

// textbook, pages 74-75

fun{a:t@ype} hd (xs: list0 a): a =
  let val- cons (x, _) = xs in x end
// end of [hd]

fun{a:t@ype} tl (xs: list0 a): list0 a =
  let val- cons (_, xs) = xs in xs end
// end of [tl]

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

// textbook, page 76

local

fun{a:t@ype} addlen (n: int, xs: list0 a): int =
  case+ xs of | _ :: xs => addlen (n+1, xs) | nil () => n
// end of [addlen]

in

fun{a:t@ype} length (xs: list0 a): int = addlen (0, xs)

end (* end of [local] *)

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

// textbook, page 77

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

fun{a:t@ype} rtake
  (xs: list0 a, i: int, taken: list0 a): list0 a =
  case+ xs of
  | x :: xs => if i > 0 then rtake (xs, i-1, x :: taken) else taken
  | nil () => taken
// end of [rtake]

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

// textbook, page 78

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

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

// textbook, page 80

fun{a:t@ype}
  revAppend (xs: list0 a, ys: list0 a): list0 a =
  case+ (xs, ys) of
  | (nil (), _) => ys
  | (x :: xs, _) => revAppend (xs, x :: ys)
// end of [revAppend]

fun{a:t@ype} rev (xs: list0 a): list0 a = revAppend (xs, nil ())

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

// textbook, page 81

fun{a:t@ype} concat (xss: list0 (list0 a)): list0 a =
  case+ xss of xs :: xss => xs + concat xss | nil () => nil ()
// end of [concat]

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

// textbook, page 81

fun{a,b:t@ype} zip (xs: list0 a, ys: list0 b): list0 @(a, b) =
  case+ (xs, ys) of
  | (x :: xs, y :: ys) => (x, y) :: zip (xs, ys) | (_, _) => nil ()
// end of [zip]

fun{a,b:t@ype} unzip (xys: list0 @(a, b)): (list0 a, list0 b) =
  case+ xys of
  | xy :: xys => let
      val xsys = unzip<a,b> (xys) in (xy.0 :: xsys.0, xy.1 :: xsys.1)
    end // end of [::]  
  | nil () => (nil (), nil ())
// end of [unzip]  

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

// textbook, page 84

typedef coinlst = list0 int

// this is a horribly inefficient implementation:
fun allChange (
    coins: coinlst
  , coinvals: coinlst
  , amount: int
  ) : list0 coinlst =
  case+ (coins, coinvals, amount) of
  | (_, _, 0) => cons (coins, nil ())
  | (_, nil (), amount(* <> 0 *)) => nil ()
  | (_, c :: coinsval, amount) =>
      if amount < 0 then nil ()
      else list0_append<coinlst> (
        allChange (c :: coins, c :: coinvals, amount - c)
      , allChange (coins, coinvals, amount)
      ) // end [if]
// end of [allChange]

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

// textbook, page 94

staload Math = "libc/SATS/math.sats" // for [sqrt]

fun squares (r: int): list0 @(int, int) = let
  typedef res_t = list0 @(int, int)
  fun between (x: int, y: int):<cloref1> res_t = let
    val diff = r - x * x
    fun above (y: int):<cloref1> res_t =
      if y > x then nil ()
      else if y * y < diff then above (y+1)
      else if y * y = diff then (x, y) :: between (x-1, y+1)
      else (* y * y > diff *) between (x-1, y)
  in
    above y
  end (* end of [between] *)
  val firstx = int_of_double ($Math.sqrt (double_of_int r))
in
  between (firstx, 0)
end (* end of [squares] *)

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

// textbook, page 110

fun quick (xs: list0 double): list0 double = case+ xs of
  | nil () => xs
  | _ :: nil () => xs
  | a :: bs => let
      fun partition (
          left: list0 double, right: list0 double, bs: list0 double
        ) :<cloref1> list0 double =
        case+ bs of
        | nil () => quick left + cons (a, quick right)
        | x :: xs =>
            if x <= a then partition (x :: left, right, xs)
                      else partition (left, x :: right, xs)
    in
      partition (nil (), nil (), bs)
    end (* end of [::] *)
// end of [quick]

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

// textbook, pages 111, 112

fun merge (xs: list0 double, ys: list0 double): list0 double =
  case+ (xs, ys) of
  | (nil (), _) => ys
  | (_, nil ()) => xs
  | (x :: xs, y :: ys) => begin
      if x <= y then x :: merge (xs, y :: ys) else y :: merge (x :: xs, ys)
    end // end of [::, ::]
// end of [merge]

fun tmergesort (xs: list0 double): list0 double = case+ xs of
  | nil () => xs
  | _ :: nil () => xs
  | _ => let
      val k = list0_length<double> (xs) / 2 in
      merge (tmergesort (take (xs, k)), tmergesort (drop (xs, k)))
    end // end of [_]
(* end of [tmergesort] *)

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

implement main () = let
(*
  val res = squares (48612265)
  val () = print "squares (48612265) = "
  val () = loop (res, 0) where {
    fun loop (res: list0 @(int, int), i: int): void =
      case+ res of
      | xy :: res => begin
          if (i>0) then print ", ";
          printf ("(%i, %i)", @(xy.0, xy.1));
          loop (res, i + 1)
        end // end of [::]
      | nil () => print_newline ()
  } // end of [val]
  val () = printf ("There are %i solutions in all.", @(list0_length res))
  val () = print_newline ()
*)
in
  // empty
end // end of [main]

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

(* end of [chapater3_examples.dats] *)