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

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

// total: 110 points

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

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)
// end of [EQELTS]

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

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) =
  | {x:elt} {xs:elts} {n:nat} LENGTHcons (cons (x, xs), n+1) of LENGTH (xs, n)
  | LENGTHnil (nil (), 0)
// end of [LENGTH]
  
(* ****** ****** *)

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]

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]

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

propdef REVERSE1 (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 [REVERSE1]

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

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

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

dataview slseg_v (elts, addr, addr) =
  | {l:addr} SLSEGnil (nil (), l, l)
  | {x:elt} {xs:elts} {l_beg,l_end:addr | l_beg <> null} {l_nxt:addr}
    SLSEGcons (cons (x, xs), l_beg, l_end) of ((T x, ptr l_nxt) @ l_beg, slseg_v (xs, l_nxt, l_end))
// end of [slseg_v]

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

// (10 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]

// (20 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)

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

// (10 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)

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

// (20 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] (REVERSE1 (xs, ys), sllst_v (ys, l) | ptr l)

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

// permutation

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

dataprop INSERT (elts, int, elt, elts) =
  | {x0:elt} {x:elt} {xs:elts} {xs':elts} {i:nat}
    INSERTnxt (cons (x0, xs), i+1, x, cons (x0, xs')) of INSERT (xs, i, x, xs')
  | {x:elt} {xs:elts} INSERTfst (xs, 0, x, cons (x, xs))
// end of [INSERT]
                                           
dataprop PERMUTE (elts, elts) =
  | {xs1,xs2:elts} {i1,i2:nat} {x:elt} {xs1',xs2':elts}
    PERMUTEcons (xs1', xs2') of (INSERT (xs1, i1, x, xs1'), INSERT (xs2, i2, x, xs2'), PERMUTE (xs1, xs2))
  | PERMUTEnil (nil (), nil ()) of ()
// end of [PERMUTE]

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

// 10 points
extern prfun insert_length_lemma
  {xs:elts} {i:nat} {x:elt} {xs':elts} {n:nat}
  (pf_ins: INSERT (xs, i, x, xs'), pf_len: LENGTH (xs, n)): LENGTH (xs', n+1)

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

// 10 points
extern prfun permute_length {xs1,xs2:elts} {n:nat}
  (pf_mut: PERMUTE (xs1, xs2), pf_len: LENGTH (xs1, n)): LENGTH (xs2, n)
 
(* ****** ****** *)

// 10 points
extern prfun permute_refl {xs:elts} (): PERMUTE (xs, xs)

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

// 10 points
extern prfun permute_symm {xs1,xs2:elts}
  (pf: PERMUTE (xs1, xs2)): PERMUTE (xs2, xs1)

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

(* end of [assignment5.dats] *)