//
//
// This file is for Assignment 5, BU CAS CS 520, Fall, 2008
//
//

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

datasort elt = // abstract
datasort elts = nil of () | cons of (elt, elts)

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

dataprop EQELT (elt, elt) = {x:elt} EQELT (x, x)

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

dataprop EQELTS (elts, elts) =
  | EQELTSnil (nil (), nil ())
  | {x:elt} {xs1,xs2:elts}
    EQELTScons (cons (x, xs1), cons (x, xs2)) of EQELTS (xs1, xs2)

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

abst@ype T (elt)

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

dataprop NTH (elts, int, elt) =
  | {x:elt} {xs:elts} NTHfst (cons (x, xs), 0, x)
  | {x0:elt} {x:elt} {xs:elts} {i:nat} NTHnxt (cons (x0, xs), i+1, x) of NTH (xs, i, x)
  
dataprop LENGTH (elts, int) =
  | LENGTHnil (nil (), 0)
  | {x:elt} {xs:elts} {n:nat} LENGTHcons (cons (x, xs), n+1) of LENGTH (xs, n)
  
(* ****** ****** *)

prfun NTH_EQ_lemma {xs1,xs2:elts} {n:nat} .<n>. (
    pf1_len: LENGTH (xs1, n), pf2_len: LENGTH (xs2, n)
  , fpf: {i: nat | i < n} {x1,x2:elt} (NTH (xs1, i, x1), NTH (xs2, i, x2))-<prf> EQELT (x1, x2)
  ) : EQELTS (xs1, xs2) =
  sif n > 0 then let
    prval LENGTHcons {x1} {xs11} (pf11_len) = pf1_len
    prval LENGTHcons {x2} {xs21} (pf21_len) = pf2_len
    prval EQELT () = fpf {0} (NTHfst {x1} {xs11} (), NTHfst {x2} {xs21} ())
    prfn fpf1 {i:nat | i < n - 1} {x1,x2:elt}
      (pf1_nth: NTH (xs11, i, x1), pf2_nth: NTH (xs21, i, x2)): EQELT (x1, x2) = let
   in
     fpf (NTHnxt pf1_nth, NTHnxt pf2_nth)
   end // end of [fpf1]
  in
    EQELTScons (NTH_EQ_lemma {xs11,xs21} (pf11_len, pf21_len, fpf1))
  end else let
    prval LENGTHnil () = pf1_len and LENGTHnil () = pf2_len
  in
    EQELTSnil ()
  end // end of [sif]
// end of [NTH_EQ_lemma]

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

prfun NTH_isfun {xs:elts} {i:nat} {x1,x2:elt} .<xs>.
  (pf1: NTH (xs, i, x1), pf2: NTH (xs, i, x2)): EQELT (x1, x2) =
  case+ (pf1, pf2) of
  | (NTHfst (), NTHfst ()) => EQELT ()
  | (NTHnxt pf1, NTHnxt pf2) => NTH_isfun (pf1, pf2)
// end of [NTH_isfun]

prfun NTH_istot {xs:elts}
  {n,i:nat | i < n} .<xs>. (pf: LENGTH (xs, n)): [x:elt] NTH (xs, i, x) = let
  prval LENGTHcons (pf) = pf
in
  sif i == 0 then NTHfst () else NTHnxt (NTH_istot {..} {n-1,i-1} (pf))
end // end of [NTH_istot]

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

prfun LENGTH_isfun {xs:elts} {n1,n2:int} .<xs>.
  (pf1: LENGTH (xs, n1), pf2: LENGTH (xs, n2)):<prf> [n1 == n2] void =
  sif n1 > 0 then let
    prval LENGTHcons (pf1) = pf1; prval LENGTHcons (pf2) = pf2
  in
    LENGTH_isfun (pf1, pf2)
  end else let // n1 = 0
    prval LENGTHnil () = pf1; prval LENGTHnil () = pf2
  in
    // empty
  end // end of [sif]
// end of [LENGTH_isfun]

extern praxi LENGTH_istot {xs:elts} ():<prf> [n:nat] LENGTH (xs, n)

(*

// [scase] is yet to be supported in ATS
prfun LENGTH_istot {xs:elts} .<xs>. ():<prf> [n:nat] LENGTH (xs, n) = begin
  scase xs of cons (x, xs) => LENGTHcons (LENGTH_istot {xs} ()) | nil () => LENGTHnil ()
end // end of [LENGTH_istot]

*)

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

datatype list (elts) =
  | LISTnil (nil) | {x:elt} {xs:elts} LISTcons (cons (x, xs)) of (T x, list (xs))

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

// a simple example
fun list_get {xs:elts} {i:nat} {x:elt}
  (pf: NTH (xs, i, x) | xs: list xs, i: int i): T x =
  if i > 0 then let
    prval NTHnxt (pf1) = pf; val+ LISTcons (_, xs1) = xs
  in
    list_get (pf1 | xs1, i - 1)
  end else let
    prval NTHfst () = pf; val+ LISTcons (x, _) = xs
  in
    x // the return value
  end // end of [list_get]
// end of [list_get]

typedef T0 = [x:elt] T x
typedef List = [xs:elts] list (xs)

fun list_get1 {xs:elts} {n,i:nat | i < n}
  (pf_len: LENGTH (xs, n) | xs: list xs, i: int i): T0 = let
  prval pf_nth = NTH_istot {xs} {n,i} (pf_len)
in
  list_get (pf_nth | xs, i)
end // end of [list_get1]

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

propdef APPEND (xs1:elts, xs2:elts, xs3:elts) = [n1,n2:nat] (
    LENGTH (xs1, n1), LENGTH (xs2, n2), LENGTH (xs3, n1+n2)
  , {i:nat | i < n1} {x:elt} (NTH (xs1, i, x) -<prf> NTH (xs3, i, x))
  , {i:nat | i < n2} {x:elt} (NTH (xs2, i, x) -<prf> NTH (xs3, n1+i, x))
) // end of [APPEND]

extern fun list_append {xs1,xs2:elts}
  (xs1: list xs1, xs2: list xs2):<> [xs3:elts] (APPEND (xs1, xs2, xs3) | list xs3)

// this example may be of use for implementing [list_reverse]
implement list_append (xs1, xs2) = append (xs1, xs2) where {
  fun append {xs1,xs2:elts} .<xs1>.
    (xs1: list xs1, xs2: list xs2)
    :<> [xs3:elts] (APPEND (xs1, xs2, xs3) | list xs3) = let
    prval [n1:int] pf1_len = LENGTH_istot {xs1} ()
    prval [n2:int] pf2_len = LENGTH_istot {xs2} ()
  in
    case+ xs1 of
    | LISTcons {x} (x, xs10) => let
        val [xs30:elts] (pf | xs30) = append (xs10, xs2)
        stadef xs3 = cons (x, xs30)
        prval () = LENGTH_isfun (pf1_len, LENGTHcons (pf.0))
        prval () = LENGTH_isfun (pf2_len, pf.1)
        prval fpf2 = pf.3 and fpf3 = pf.4
        prfn fpf2_new {i:nat | i < n1} {x:elt}
          (pf_nth: NTH (xs1, i, x)): NTH (xs3, i, x) = case+ pf_nth of
          | NTHfst () => NTHfst () | NTHnxt (pf1_nth) => NTHnxt (fpf2 pf1_nth)
        prfn fpf3_new {i:nat | i < n2} {x:elt}
          (pf_nth: NTH (xs2, i, x)): NTH (xs3, n1+i, x) =
          NTHnxt (fpf3 pf_nth)
        prval pf_new = (pf1_len, pf2_len, LENGTHcons pf.2, fpf2_new, fpf3_new)
      in
        (pf_new | LISTcons (x, xs30))
      end // end of [LISTcons]
    | LISTnil () => let
        prval () = LENGTH_isfun (pf1_len, LENGTHnil ())
        prfn fpf2 {i:nat | i < 0} {x:elt}
          (pf_nth: NTH (xs1, i, x)): NTH (xs2, i, x) = case+ pf_nth of _ =/=> ()
        prfn fpf3 {i:nat | i < n2} {x:elt}
          (pf_nth: NTH (xs2, i, x)): NTH (xs2, i, x) = pf_nth
        prval pf = (pf1_len, pf2_len, pf2_len, fpf2, fpf3)
      in
        (pf | xs2)
      end // end of [LISTnil]
  end // end of [append]
} // end of [list_append]

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

propdef REVERSE (xs1:elts, xs2:elts) = [n:nat] (
    LENGTH (xs1, n)
  , LENGTH (xs2, n)
  , {i:nat | i < n} {x:elt} NTH (xs1, i, x) -<prf> NTH (xs2, n-i-1, x)
) // end of [REVERSE]

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

// Here is another example that may be useful:
prfn example2 {x:elt} {xs1,xs2:elts} {xs2_x:elts}
  (pf1: REVERSE (xs1, xs2), pf2: APPEND (xs2, cons (x, nil ()), xs2_x))
  : REVERSE (cons (x, xs1), xs2_x) = let
  stadef x_xs1 = cons (x, xs1)
  prval pf_len_xs1 = pf1.0 and pf_len_xs2 = pf1.1 and fpf_rev = pf1.2

  prval [n1:int] pf_len_x_xs1 = LENGTH_istot {x_xs1} ()
  prval LENGTHcons (pf_len_xs1_alt) = pf_len_x_xs1
  prval () = LENGTH_isfun (pf_len_xs1, pf_len_xs1_alt)

  prval pf_len_xs2_alt = pf2.0 and pf_len_x = pf2.1 and pf_len_xs2_x = pf2.2
  prval fpf_app1 = pf2.3 and fpf_app2 = pf2.4
  
  prval () = LENGTH_isfun (pf_len_xs2, pf_len_xs2_alt)
  prval LENGTHcons (LENGTHnil ()) = pf2.1
  
  prfn fpf_rev_new {i:nat | i < n1} {x:elt}
    (pf_nth: NTH (x_xs1, i, x)): NTH (xs2_x, n1-1-i, x) =
    sif i == 0 then let
      prval NTHfst () = pf_nth in fpf_app2 (NTHfst ())
    end else let
      val NTHnxt pf_nth = pf_nth in fpf_app1 (fpf_rev pf_nth)
    end // end of [sif]
in
  (pf_len_x_xs1, pf_len_xs2_x, fpf_rev_new)
end // end of [example2]

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

// (20 points)
extern prfun reverse_lemma {xs1,xs2:elts} (pf: REVERSE (xs1, xs2)):<prf> REVERSE (xs2, xs1)

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

// (40 points)
extern fun list_reverse {xs:elts} (xs: list (xs)):<> [ys:elts] (REVERSE (xs, ys) | list ys)

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

dataview slseg_v (elts, addr, addr) =
  | {l:addr} slseg_v_nil (nil (), l, l)
  | {x:elt} {xs:elts} {l_beg,l_end:addr | l_beg <> null} {l_nxt:addr}
    slseg_v_cons (cons (x, xs), l_beg, l_end) of ((T x, ptr l_nxt) @ l_beg, slseg_v (xs, l_nxt, l_end))

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

// (20 points)
extern fun slseg_get {xs:elts} {i:nat} {x:elt} {l_beg,l_end:addr}
  (pf_lst: !slseg_v (xs, l_beg, l_end), pf_nth: NTH (xs, i, x) | p: ptr l_beg, i: int i):<> T x

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

propdef UPDATE (xs0:elts, i0:int, x1: elt, xs1: elts) = [n:nat] (
    LENGTH (xs0, n), LENGTH (xs1, n)
  , NTH (xs1, i0, x1)
  , {i:nat | i <> i0} {x:elt} NTH (xs0, i, x) -<prf> NTH (xs1, i, x)
) // end of [UPDATE]

// (40 points)
extern fun slseg_set
  {xs0:elts} {i:nat} {x0,x1:elt} {l_beg,l_end:addr} (
    pf_lst: slseg_v (xs0, l_beg, l_end)
  , pf_nth: NTH (xs0, i, x0)
  | p: ptr l_beg, i: int i, e: T x1
  ) :<> [xs1:elts] (
    slseg_v (xs1, l_beg, l_end), UPDATE (xs0, i, x1, xs1) | void
  ) // end of [slseg_set]

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

viewdef sllst_v (xs: elts, l:addr) = slseg_v (xs, l, null)

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

// (20 points)
// Note: full credit can only be given to a tail-recursive implementation
extern fun sllst_length {xs:elts} {l:addr}
  (pf: !sllst_v (xs, l) | p: ptr l):<> [n:nat] (LENGTH (xs, n) | int n)

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

// (60 ***extra*** points)
// Note: full credit can only be given to a tail-recursive implementation
extern fun sllst_reverse {xs:elts} {l:addr}
  (pf: sllst_v (xs, l) | p: ptr l):<> [ys:elts] [l:addr] (REVERSE (xs, ys), sllst_v (ys, l) | ptr l)

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

(* end of [sllst.dats] *)