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

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

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)

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

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 prfun LENGTH_istot {xs:elts} ():<prf> [n:nat] LENGTH (xs, n)

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]

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

dataprop REVAPP (elts, elts, elts) =
  | {ys:elts} REVAPPnil (nil, ys, ys)
  | {x:elt} {xs,ys,zs:elts}
    REVAPPcons (cons (x, xs), ys, zs) of REVAPP (xs, cons (x, ys), zs)
// end of [REVAPP]

propdef REVERSE (xs: elts, ys: elts) = REVAPP (xs, nil, ys)

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

propdef REVAPP1 (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, n1-i-1, x))
  , {i:nat | i < n2} {x:elt} (NTH (xs2, i, x) -<prf> NTH (xs3, n1+i, x))
) // end of [REVAPP1]

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

prfun revapp_revapp1_lemma
  {xs1,xs2:elts} {xs3:elts} .<xs1>.
  (pf: REVAPP (xs1, xs2, xs3)): REVAPP1 (xs1, xs2, xs3) = let
  prval [n1:int] pf1_len = LENGTH_istot {xs1} ()
  prval [n2:int] pf2_len = LENGTH_istot {xs2} ()  
in
  case+ pf of
  | REVAPPcons (pf0) => let
      prval LENGTHcons (pf10_len) = pf1_len
      prval pf_res = revapp_revapp1_lemma (pf0)
      prval () = LENGTH_isfun (pf10_len, pf_res.0)
      prval LENGTHcons (pf2_len_alt) = pf_res.1
      prval () = LENGTH_isfun (pf2_len, pf2_len_alt)
      prval fpf1 = pf_res.3 and fpf2 = pf_res.4
      prfn fpf1_new {i:nat | i < n1} {x:elt}
        (pf_nth: NTH (xs1, i, x)):<> NTH (xs3, n1-i-1, x) =
        sif i > 0 then let
          prval NTHnxt pf_nth = pf_nth
        in
          fpf1 (pf_nth)
        end else let // i = 0
          prval NTHfst () = pf_nth
        in
          fpf2 (NTHfst ())
        end // end of [sif]
      prfn fpf2_new {i:nat | i < n2} {x:elt}
        (pf_nth: NTH (xs2, i, x)):<> NTH (xs3, n1+i, x) = fpf2 (NTHnxt pf_nth)
    in
      (pf1_len, pf2_len, pf_res.2, fpf1_new, fpf2_new)
    end // end of [REVAPPcons]
  | REVAPPnil () => let
      prval LENGTHnil () = pf1_len
      prfn fpf1 {i:nat | i < n1} {x:elt}
        (pf_nth: NTH (xs1, i, x)):<> NTH (xs3, n1-i-1, x) = case+ pf_nth of _ =/=> ()
      prfn fpf2 {i:nat | i < n2} {x:elt}
        (pf_nth: NTH (xs2, i, x)):<> NTH (xs3, n1+i, x) = pf_nth
    in
      (pf1_len, pf2_len, pf2_len, fpf1, fpf2)
    end // end of [REVAPPnil]
end // end of [revapp_revapp1_lemma]

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

//
// 30 points
//
// please implement the following lemma asserting that the reverse of
// the reverse of a list equals the list itself.
//
extern prfun lemma_reverse {xs1,xs2,xs3:elts}
  (pf1: REVERSE (xs1, xs2), pf2: REVERSE (xs2, xs3)): EQELTS (xs1, xs3)
// end of ...

prfn corollary1 {xs,ys:elts} {n:nat}
  (pf_rev: REVERSE (xs, ys), pf_len: LENGTH (xs, n))
  : {i:nat | i < n} {x:elt} (NTH (xs, i, x) -> NTH (ys, n-1-i,x)) = let
  prval pf = revapp_revapp1_lemma (pf_rev)
  prval () = LENGTH_isfun (pf_len, pf.0)
in
  pf.3
end // end of [corollary1]

prfn corollary2 {xs,ys:elts} {n:nat}
  (pf_rev: REVERSE (xs, ys), pf_len: LENGTH (xs, n)): LENGTH (ys, n) = let
  prval pf = revapp_revapp1_lemma (pf_rev)
  prval () = LENGTH_isfun (pf_len, pf.0)
  prval LENGTHnil () = pf.1
in
  pf.2
end // end of [corollary2]

implement lemma_reverse {xs1,xs2,xs3}
  (pf1, pf2) = let // pf1: REVERSE (xs1, xs2), pf2 REVERSE (xs2, xs3)
  prval [n:int] pf1_len = LENGTH_istot {xs1} ()
  prval pf2_len = corollary2 (pf1, pf1_len) // pf2_len : LENGTH (xs2, n)
  prval pf3_len = corollary2 (pf2, pf2_len) // pf3_len : LENGTH (xs3, n)
  prval fpf1 = corollary1 {xs1,xs2} {n} (pf1, pf1_len)
  prval fpf2 = corollary1 {xs2,xs3} {n} (pf2, pf2_len)
  prval fpf =
    lam {i:nat | i < n} {x1,x2:elt} (
       pf1_nth: NTH (xs1, i, x1), pf2_nth: NTH (xs3, i, x2)
      ) : EQELT (x1, x2) =<prf> let
      prval pf3_nth = fpf2 {n-1-i} (fpf1 {i} (pf1_nth)) // : NTH (xs2, i, x1)
    in
      NTH_isfun {xs3} {i} {x1,x2} (pf3_nth, pf2_nth)
    end
in
  NTH_EQ_lemma {xs1,xs3} {n} (pf1_len, pf3_len, fpf)
end // end of [lemma_reverse]

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

(* end of [list.dats] *)