//
//
// This file is for Assignment 7, BU CAS CS 520, Fall, 2009
//
// Instructor: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
//
//

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

sortdef elt = int
sortdef eltmset = int
stadef eltmset_nil = 0

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

absprop ELTMSETSZ (eltmset, int)

extern praxi ELTMSETSZnil (): ELTMSETSZ (eltmset_nil, 0)
extern praxi ELTMSETSZcons {x:elt} {xs:eltmset}
  {n:nat} (pf: ELTMSETSZ (xs, n)): ELTMSETSZ (x+xs, n+1)

extern praxi ELTMSETSZuncons {x:elt} {xs:eltmset}
  {n:nat} (pf: ELTMSETSZ (x+xs, n)): [n>0] ELTMSETSZ (xs, n-1)
// end of [ELTMSETSZuncons]

extern praxi ELTMSETSZunion {xs1,xs2:eltmset} {n1,n2:nat}
  (pf1: ELTMSETSZ (xs1, n1), pf2: ELTMSETSZ (xs2, n2)): ELTMSETSZ (xs1+xs2, n1+n2)
// end of [ELTMSETSZunion]

extern praxi ELTMSETSZistot {xs:eltmset} (): [n:nat] ELTMSETSZ (xs, n)
extern praxi ELTMSETSZisfun {xs:eltmset}
  {n1,n2:int} (pf1: ELTMSETSZ (xs, n1), pf2: ELTMSETSZ (xs, n2)): [n1==n2] void
// end of [ELTMSETSZisfun]

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

absprop ELTMSETLB (elt, eltmset)
absprop ELTMSETUB (eltmset, elt)

extern
praxi ELTMSETLBnil {x:elt} (): ELTMSETLB (x, eltmset_nil)

extern
praxi ELTMSETLBcons {lb:elt} {x:elt | lb <= x}
  {xs:eltmset} (pf: ELTMSETLB (lb, xs)): ELTMSETLB (lb, x+xs)

extern
praxi ELTMSETUBnil {x:elt} (): ELTMSETUB (eltmset_nil, x)

extern
praxi ELTMSETUBcons {ub:elt} {x:elt | x <= ub}
  {xs:eltmset} (pf: ELTMSETUB (xs, ub)): ELTMSETUB (x+xs, ub)

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

abst@ype T (elt)

datatype bintree (eltmset) =
  | BINTREEnil (eltmset_nil) of ()
  | {x:elt} {xs1,xs2:eltmset} BINTREEcons (x+xs1+xs2) of (
      ELTMSETUB (xs1, x), ELTMSETLB (x, xs2) | T x, bintree xs1, bintree xs2
    ) // end of [BINTREEcons]
// end of [bintree]

extern // implemented externally
fun lte_elt_elt
  {x1,x2:elt} (x1: T x1, x2: T x2):<> bool (x1 <= x2)
// end of [lte_elt_elt]

extern // 20 extra points
fun bintree_insert // please prove termination!
  {x:elt} {xs:eltmset} (x: T x, t: bintree xs):<> bintree (x+xs)
// end of [bintree_insert]

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

datatype list (eltmset) =
  | {x:elt} {xs:eltmset} LISTcons (x+xs) of (T x, list xs)
  | LISTnil (eltmset_nil) of ()
// end of [list]

extern // 10 points // please prove termination
fun bintree_of_list {xs:eltmset} (xs: list xs):<> bintree (xs)

extern // 10 points // please prove termination
fun list_of_bintree {xs:eltmset} (t: bintree xs):<> list xs

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

fun ack
  (m:int, n:int): int =
  case+ m of
  | 0 => n+1
  | _ => begin case+ n of
    | 0 => ack (m-1, 1) | _ => ack (m-1, ack (m, n-1))
    end // end of [_]
// end of [ack1]

fun ackf (m: int): int -<cloref1> int = let
  fun helper
    (f: int -<cloref1> int): int -<cloref1> int =
    lam n => if n = 0 then f (1) else f (helper f (n-1))
in
  case+ m of
  | 0 => lam n => n+1 | _ => helper (ackf (m-1))
end // end of [ackf]

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

//
// 10 points
//
// Please prove by induction that for every pair of natural numbers
// m and n, ack (m, n) = ackf m n
//

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

//
// 10 points
//
// Please implement ackf in System F. The implementation needs to be
// coded in ATS.
//

//
// Here is an implementation of [ackf] in System F:
//

typedef tid
  (X:type) = X -<cloref> X
// end of [tid]
typedef Nat = {X:type} tid (tid X)

val _0 = (lam f x =<cloref> x): Nat
val _1 = (lam f x =<cloref> f x): Nat
val succ = lam (n: Nat): Nat =<cloref> lam f x =<cloref> f (n f x)

extern fun acksysf : Nat -<cloref> Nat -<cloref> Nat

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

// please do not change the following code; it is for testing

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

extern
fun list_sort {xs:eltmset} (xs: list xs):<> list xs
implement list_sort (xs) = list_of_bintree (bintree_of_list xs)

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

typedef T0 = [x:int] T x
assume T (x:int) = double

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

implement lte_elt_elt {x1,x2} (x1, x2) = let
  extern castfn __cast (_: bool):<> bool (x1 <= x2)
in
  __cast (x1 <= x2)
end // end of [lte_elt_elt]

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

fn print_elt (x: T0): void = printf ("%6f", @(x))

fun print_list {xs:eltmset}
  (xs: list xs): void = aux (xs, 0) where {
  fun aux {xs:eltmset} (xs: list xs, i: int): void =
  case+ xs of
  | LISTcons (x, xs) => begin
     if i > 0 then print ", "; print_elt x; aux (xs, i+1)
    end // end of [LISTcons]
  | LISTnil () => ()
} // end of [print_list]

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

staload Rand = "libc/SATS/random.sats"

fn randgen_elt (): T0 = $Rand.drand48 ()

fun randgen_list {n:nat}
  (n: int n): [xs:eltmset] list xs = loop (LISTnil, n) where {
  fun loop {xs:eltmset} {n:nat} .<n>.
    (xs: list xs, n: int n): [xs:eltmset] list xs =
    if n > 0 then let
      val x = randgen_elt () in loop (LISTcons (x, xs), n-1)
    end else xs
  // end of [loop]
} // end of [randgen_list]

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

val _2 = succ (_1)
val _3 = succ (_2)
val _4 = succ (_3)
val _5 = succ (_4)
val _6 = succ (_5)
val _7 = succ (_6)
val _8 = succ (_7)
val _9 = succ (_8)

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

#define N 10

implement main () = let
  val () = $Rand.srand48_with_time ()
  val xs1 = randgen_list (N)
  val () = begin
    print "xs1 (unsorted) =\n"; print_list xs1; print_newline ()
  end // end of [val]
  val xs2 = list_sort (xs1)
  // is there any doubt :)
  val () = begin
    print "xs2 (sorted) =\n"; print_list xs2; print_newline ()
  end // end of [val]
//
  typedef int = intptr
  val _int0 = intptr_of_int (0)
  val _int1 = intptr_of_int (1)
  // val () = printf ("ack(3,8) = %i\n", @(ack(3,8)))
  val ack_3_8 : int = (acksysf _3 _8) {int} (lam x => x + _int1) (_int0)
  val () = begin
    print "ack_3_8(2045) = "; print ack_3_8; print_newline ()
  end // end of [val]
//
in
  // empty
end // end of [main]

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

(* end of [assignment7.dats] *)