(*
** 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

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] *)