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

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

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

dataprop EQELT (elt, elt) = {x:elt} EQELT (x, x)
dataprop EQELTS (elts, elts) = {xs:elts} EQELTS (xs, xs)

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

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_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)

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

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

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

// please implement the following proof functions

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

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

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

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

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

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

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

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

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

// 60 ***extra*** points
extern prfun permute_tran {xs1,xs2,xs3:elts}
  (pf1: PERMUTE (xs1, xs2), pf2: PERMUTE (xs2, xs3)): PERMUTE (xs1, xs3)

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

abst@ype T (elt)

typedef T0 = [x:elt] T (x)

dataview array_v (elts, addr) =
  | {l:addr} array_v_nil (nil (), l)
  | {x:elt} {xs:elts} {l:addr}
    array_v_cons (cons (x, xs), l) of (T x @ l, array_v (xs, l+sizeof (T0)))

// no implementation is needed
extern fun array_get_elt_at {xs:elts} {i:nat} {x:elt} {l:addr}
  (pf_nth: NTH (xs, i, x), pf_arr: !array_v (xs, l) | p: ptr l, i: int i): T x
  = "array_get_elt_at"

dataprop UPDATE (elts, int, elt, elts) =
  | {x0:elt} {x_new:elt} {xs:elts} {xs_new:elts} {i:nat}
      UPDATEnxt (cons (x0, xs), i+1, x_new, cons (x0, xs_new)) of UPDATE (xs, i, x_new, xs_new)
  | {x:elt} {x_new: elt} {xs:elts} UPDATEfst (cons (x, xs), 0, x_new, cons (x_new, xs))

// no implementation is needed
extern fun array_set_elt_at
  {xs:elts} {i:nat} {x:elt} {x_new:elt} {l:addr}
  (pf_nth: NTH (xs, i, x), pf_arr: array_v (xs, l) | p: ptr l, i: int i, x_new: T x_new)
  : [xs_new: elts] (UPDATE (xs, i, x_new, xs_new), array_v (xs_new, l) | void)
  = "array_set_elt_at"
  
(* ****** ****** *)

// please implement the following functions

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

// 30 points
extern fun array_swap_fst
  {xs:elts} {n:nat} {i:pos | i < n} {x0,x1:elt} {l:addr} (
    pf_len: LENGTH (xs, n)
  , pf_nth_0: NTH (xs, 0, x0)
  , pf_nth_i: NTH (xs, i, x1)
  , pf_arr: array_v (xs, l)
  | p: ptr l, i: int i
  ) : [xs1,xs2:elts] (
      UPDATE (xs, 0, x1, xs1), UPDATE (xs1, i, x0, xs2), array_v (xs2, l) | void
    )

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

// 40 ***extra*** points
extern prfun permute_swap_fst_lemma {xs:elts} {x0,x1:elt} {xs1,xs2:elts} {i:pos}
  (_: NTH (xs, 0, x0), _: NTH (xs, i, x1), _: UPDATE (xs, 0, x1, xs1), _: UPDATE (xs1, i, x0, xs2))
  : PERMUTE (xs, xs2)

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

// no implementation is needed
// the possibility is 1/n for any natural number less than n to return
extern fun random_nat_gen {n:pos} (n: int n): [i:nat | i < n] int (i)

// 50 points
// it should be equally possible for any permutation of [xs] to return
// full credit will only be given to a tail-recursive implementation
extern fun array_shuffle {xs:elts} {n:nat} {l:addr}
  (pf_len: LENGTH (xs, n), pf_arr: array_v (xs, l) | p: ptr l, n: int n)
  : [ys: elts] (PERMUTE (xs, ys), array_v (ys, l) | void)

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

(* end of [permute.dats] *)