Require Import Blech.Defaults.

Require Import Coq.Setoids.Setoid.
Require Import Coq.Classes.SetoidClass.

Require Import Blech.Type.Predicate.
Require Import Blech.Bishop.
Require Import Blech.Category.
Require Import Blech.Category.Prod.
Require Import Blech.Groupoid.
Require Import Blech.Groupoid.Core.
Require Import Blech.Bicategory.
Require Import Blech.Functor.
Require Import Blech.Category.Funct.
Require Blech.Reflect.
Require Blech.Functor.Id.
Require Blech.Functor.Curry.
Require Blech.Functor.Compose.

Import BishopNotations.
Import CategoryNotations.
Import ProdNotations.

Open Scope category_scope.
Open Scope bishop_scope.

#[local]
Obligation Tactic := Reflect.category_simpl.

#[program]
 #[local]
Definition godement {X Y Z}: Functor (Funct Y Z * Funct X Y * X) Z :=
 {|
  op '(F, G, x) := F (G x) ;
  map '(A, B, C) '(X, Y, Z) '(F, G, x) := F _ ∘ map A (G _ ∘ map B x) ;
 |}.

Next Obligation.
Proof.
  exists.
  all: cbn.
  - intros  [[? []]] [[? []]] [[? []]] [[[] []]] [[[] []]].
    cbn in *.
    repeat rewrite <- Category.compose_assoc.
    apply compose_compat.
    1: reflexivity.
    repeat rewrite <- map_composes.
    repeat rewrite Category.compose_assoc.
    apply compose_compat.
    2: reflexivity.
    repeat rewrite map_composes.
    rewrite natural.
    repeat rewrite <- Category.compose_assoc.
    repeat rewrite map_composes.
    apply compose_compat.
    1: reflexivity.
    apply map_compat.
    repeat rewrite <- Category.compose_assoc.
    apply compose_compat.
    1: reflexivity.
    rewrite n2.
    reflexivity.
  - intros [[]].
    cbn in *.
    repeat rewrite <- map_composes.
    repeat rewrite map_id.
    repeat rewrite Category.compose_id_right.
    reflexivity.
  - intros [[]] [[]] [[[] []]] [[[] []]] [[p q] r].
    cbn in *.
    rewrite p, q, r.
    reflexivity.
Qed.

#[program]
Definition Cat: Bicategory := {|
  Obj := Category ;
  Mor := Funct ;

  id := Id.id ;
  compose A B C := Curry.curry (@godement A B C) ;

  compose_id_left A B F :=
    {|
      to _ := Category.id _ ;
      from _ := Category.id _ ;
    |} ;
  compose_id_right A B F :=
    {|
      to _ := Category.id _ ;
      from _ := Category.id _ ;
    |} ;

  compose_assoc _ _ _ _ F G H :=
    {|
      to _ := Category.id _ ;
      from _ := Category.id _  ;
    |} ;
|}.

Next Obligation.
Proof.
  intros ? ? m.
  cbn in *.
  Reflect.category.
  reflexivity.
Qed.

Next Obligation.
Proof.
  intros ? ? m.
  cbn in *.
  Reflect.category.
  reflexivity.
Qed.

Next Obligation.
Proof.
  intros ? ? m.
  cbn in *.
  repeat rewrite Category.compose_id_right.
  repeat rewrite Category.compose_id_left.
  reflexivity.
Qed.

Next Obligation.
Proof.
  intros ? ? m.
  cbn in *.
  repeat rewrite Category.compose_id_right.
  repeat rewrite Category.compose_id_left.
  reflexivity.
Qed.

Next Obligation.
Proof.
  intros ? ? m.
  cbn in *.
  repeat rewrite Category.compose_id_right.
  repeat rewrite Category.compose_id_left.
  reflexivity.
Qed.

Next Obligation.
Proof.
  intros ? ? m.
  cbn in *.
  repeat rewrite Category.compose_id_right.
  repeat rewrite Category.compose_id_left.
  reflexivity.
Qed.


Require Import Arith.
Require Import Word.
Require Import Omega.
Require Import List ListUtils.
Require Import FunctionalExtensionality.
Require Import NArith.
Require Import AsyncDisk.
Require Import Bytes.
Require Import DiskSet.
Require Import Pred.
Import EqNotations.

Set Implicit Arguments.

Notation "'byteset'" := (byte * list byte)%type.

Definition list2byteset {A} def (l: list A) : (A * list A) :=
  match l with
  | nil => (def, nil)
  | h::t => (h,t)
  end.

Definition byteset2list {A} (nel: A * list A) : list A := (fst nel)::(snd nel).

Definition byteset0 := (byte0, nil: list byte).
Definition valu0 := bytes2valu  (natToWord (valubytes*8) 0).
Definition valuset0 := (valu0, nil: list valu).

Definition bytes_eq: forall sz, sz <= valubytes -> sz + (valubytes - sz) = valubytes.
Proof. intros; omega. Qed.

Definition bytes2valubytes sz (b: bytes sz): bytes valubytes:=
    let c:= le_dec sz valubytes in
    match c with
    | left l => eq_rect (sz + (valubytes - sz)) bytes
                  (bcombine b (word2bytes (valubytes-sz) eq_refl $0)) valubytes (bytes_eq l)
    | right _ => $0
    end.

Definition byte2valu b : valu :=  bytes2valu (bytes2valubytes (byte2bytes b)).

Definition list2valu l: valu :=  bytes2valu (bytes2valubytes (bcombine_list l)).

Definition valu2list v : list byte :=  bsplit_list (valu2bytes v).

Definition selN' {A: Type} i def (l: list A): A := selN l i def.

Definition cons' {A} (a: list A) b:= cons b a.

Definition get_sublist {A:Type}(l: list A) (off len: nat) : list A := firstn len (skipn off l).

Fixpoint valuset2bytesets_rec (vs: list (list byte)) i : list (list byte):=
match i with
| O => nil
| S i' => match vs with
    | nil => nil
    | _ =>  (map (selN' 0 byte0) vs)::(valuset2bytesets_rec (map (skipn 1) vs) i')
    end
end.

Definition valuset2bytesets (vs: valuset): list byteset:=
  map (list2byteset byte0) (valuset2bytesets_rec (map valu2list (byteset2list vs)) valubytes).

Fixpoint bytesets2valuset_rec (bs: list (list byte)) i : list (list  byte):=
match i with
| O => nil
| S i' => match bs with
          | nil => nil
          | _ =>  (map (selN' 0 byte0) bs)::(bytesets2valuset_rec (map (skipn 1) bs) i')
          end
end.

Definition bytesets2valuset (bs: list byteset) : valuset :=
	list2byteset valu0 (map (list2valu) (bytesets2valuset_rec (map (@byteset2list byte) bs)
                             (length(byteset2list(selN bs 0 byteset0))))).

Fixpoint merge_bs (lb: list byte) (lbs: list byteset): list byteset :=
match lb with
| nil => nil
| hb :: tb => match lbs with
              | nil => (hb, nil)::(merge_bs tb nil)
              | hbs::tbs => (hb, (fst hbs)::(snd hbs)):: (merge_bs tb tbs)
              end
end.

Definition updN_list (l: list byteset) off (l1: list byte): list byteset :=
(firstn off l)++ (merge_bs l1 (get_sublist l off (length l1))) ++(skipn (off + length l1) l).

Definition ds2llb (ds: diskset) : nelist (list (list byteset)):=
d_map (map valuset2bytesets) ds.

Definition llb2ds (llb : nelist (list (list byteset))) : diskset :=
d_map (map bytesets2valuset) llb.

Definition dsbupd (ds : diskset) (a : addr) (b : byteset): diskset :=
  llb2ds (d_map (map (fun x : list byteset => x ⟦ a := b ⟧)) (ds2llb ds)).

Fixpoint dsblistupd (ds : diskset) (a : addr) (lb : list byteset): diskset :=
  match lb with
  | nil => ds
  | h::t => dsblistupd (dsbupd ds a h) (a+1) t
  end.

Definition mem_except_range AEQ V (m: @Mem.mem _ AEQ V) a n :=
(fun a' =>
    if (le_dec a a')
      then if (lt_dec a' (a + n))
            then None
           else m a'
    else m a').

Fixpoint list_split_chunk A k cs (l: list A): list (list A) :=
match k with
  | O => nil
  | S k' => (firstn cs l)::(list_split_chunk k' cs (skipn cs l))
end.

Fixpoint list_zero_pad l a :=
match a with
| O => l
| S a' => list_zero_pad (l ++ (byte0 :: nil)) a'
end.

Definition mod_minus_curb a b: nat:=
match a mod b with
| O => 0
| _ => (b - a mod b)
end.

Fixpoint valu0_pad n: list valu :=
match n with
| O => nil
| S n' => valu0::(valu0_pad n')
end.

(* Lemmas *)

Lemma byteset2list2byteset: forall A (l: A * list A) def,
  list2byteset def (byteset2list l) = l.
Proof.
  intros.
  unfold list2byteset, byteset2list.
  symmetry; apply surjective_pairing.
Qed.

Lemma list2byteset2list: forall A (l: list A) def,
  l<>nil -> byteset2list (list2byteset def l) = l.
Proof.
  intros.
  unfold list2byteset, byteset2list.
  destruct l.
  destruct H; reflexivity.
  reflexivity.
Qed.

Lemma valu2list_len : forall v,
 length(valu2list v) = valubytes.
Proof.
  intros.
  unfold valu2list.
  rewrite bsplit_list_len.
  rewrite valubytes_is.
  reflexivity.
Qed.

Lemma valuset2bytesets_rec_expand: forall i a l,
   i > 0 ->
  valuset2bytesets_rec (a::l) i =
	(map (selN' 0 byte0) (a::l)):: (valuset2bytesets_rec (map (skipn 1) (a::l)) (i-1)).
Proof.
  destruct i; intros. simpl.
  inversion H.
  simpl.
  rewrite <- minus_n_O.
  reflexivity.
Qed.

Lemma valuset2bytesets_rec_len: forall i l,
  l <> nil -> length(valuset2bytesets_rec l i) = i.
Proof.
  induction i.
  reflexivity.
  destruct l.
  intros.
  destruct H; reflexivity.
  intros.
  rewrite valuset2bytesets_rec_expand.
  replace (S i - 1) with i by omega.
  simpl.
  rewrite IHi.
  reflexivity.
  unfold not; intros; inversion H0.
  omega.
Qed.

Lemma valuset2bytesets_len: forall vs,
  length(valuset2bytesets vs) = valubytes.
Proof.
  intros.
  unfold valuset2bytesets.
  rewrite map_length.
  apply valuset2bytesets_rec_len.
  unfold not; intros; inversion H.
Qed.

(* XXX: START Arithmetic Lemmas. *)
Lemma le_trans: forall n m k, n <= m -> m <= k -> n <= k.
Proof. intros. omega. Qed.

Fact lt_le_trans: forall n m p, n < m -> m <= p -> n < p.
Proof. intros. omega. Qed.

Lemma le_weaken_l: forall n m k, n + m <= k -> n <= k.
Proof. intros. omega. Qed.

Lemma le_weaken_r: forall n m k, n + m <= k -> m <= k.
Proof. intros. omega. Qed.

Lemma lt_weaken_l: forall n m k, n + m < k -> n < k.
Proof. intros. omega. Qed.

Lemma lt_weaken_r: forall n m k, n + m < k -> m < k.
Proof. intros. omega. Qed.

Lemma le2lt_l: forall n m k, n + m <= k -> m > 0 -> n < k.
Proof. intros. omega. Qed.

Lemma le2lt_r: forall n m k, n + m <= k -> n > 0 -> m < k.
Proof. intros. omega. Qed.

Lemma mult_ne_O_l: forall n m p, p * n < p * m -> p > 0.
Proof.
  induction p; intros.
  repeat rewrite <- mult_n_O in H; inversion H.
  omega.
Qed.

Lemma mult_ne_O_r: forall n m p, n * p < m * p -> p > 0.
Proof.
  induction p; intros.
  repeat rewrite <- mult_n_O in H; inversion H.
  omega.
Qed.

Lemma plus_lt_compat_rev: forall n m p, p + n < p + m -> n < m.
Proof. intros. omega. Qed.

Lemma lt_mult_weaken: forall p n m, n * p < m * p  -> n < m.
Proof.
  assert(A: forall x, 0 * x = 0). intros. omega.
  induction n. intros.
  destruct m.
  rewrite A in H; inversion H.
  omega. intros.
  destruct m.
  rewrite A in H; inversion H.
  apply lt_n_S.
  apply IHn.
  simpl in H.
  apply plus_lt_compat_rev in H.
  apply H.
Qed.

Lemma le_le_weaken: forall n m p k,
n + m <= p -> k <= m -> n + k <= p.
Proof. intros.
omega.
Qed.

Lemma le_lt_weaken: forall n m p k,
n + m <= p -> k < m -> n + k < p.
Proof. intros.
omega.
Qed.

Lemma div_eq: forall m n k, k < m -> (n * m + k)/m = n.
Proof.
  intros.
  rewrite Nat.div_add_l.
  apply Nat.div_small in H.
  rewrite H; symmetry; apply plus_n_O.
  unfold not; intros; rewrite H0 in H; inversion H.
Qed.

(* XXX: END Arithmetic Lemmas. *)

Lemma some_eq: forall A (x y: A), Some x = Some y <-> x = y.
Proof.
  split; intros.
  inversion H; reflexivity.
  rewrite H; reflexivity.
Qed.

Lemma concat_hom_selN: forall A (lists: list(list A)) i n k def,
  Forall (fun sublist => length sublist = k) lists ->
  i < k ->
  selN (concat lists) (n * k + i) def = selN (selN lists n nil) i def.
Proof.
  induction lists.
  reflexivity.
  intros.
  rewrite Forall_forall in H.
  destruct n.
  simpl.
  apply selN_app1.
  destruct H with (x:= a).
  apply in_eq.
  apply H0.
  destruct H with (x:=a).
  apply in_eq.
  simpl.
  rewrite selN_app2.
  replace (length a + n * length a + i - length a) with (n * length a + i).
  apply IHlists.
  rewrite Forall_forall.
  intros.
  eapply in_cons in H1.
  apply H in H1.
  apply H1.
  apply H0.
  remember (n * length a + i) as x.
  replace (length a + n * length a + i - length a) with (length a + x - length a).
  omega.
  rewrite Heqx.
  omega.
  unfold ge.
  remember (n * length a + i) as x.
  replace (length a + n * length a + i) with (length a + x).
  apply le_plus_l.
  omega.
Qed.

Lemma fst_list2byteset: forall A (l:list A) def, fst(list2byteset def l) =  selN l 0 def.
Proof. induction l; intros; reflexivity. Qed.

Lemma flat_map_len: forall vs, length(flat_map valuset2bytesets vs) = length(vs) * valubytes.
Proof.
  induction vs.
  reflexivity.
  simpl.
  rewrite app_length.
  rewrite IHvs.
  rewrite valuset2bytesets_len.
  reflexivity.
Qed.

Lemma valuset2bytesets_rec_nil: forall i, valuset2bytesets_rec nil i = nil.
Proof. intros; destruct i; reflexivity. Qed.

Lemma firstn1 : forall A (l:list(list A)), concat(firstn 1 l) = selN l 0 nil.
Proof.
  intros.
  induction l.
  rewrite firstn_nil.
  reflexivity.
  simpl.
  apply app_nil_r.
Qed.

  Lemma cons_eq_destruct: forall A (l1 l2: list A) b1 b2,
  b1 = b2 -> l1 = l2 -> b1::l1 = b2::l2.
  Proof. intros; subst; reflexivity. Qed.

Lemma concat_hom_O: forall A (l: list(list A)) i k,
  Forall (fun sublist : list A => length sublist = k) l ->
  i<= k ->
  firstn i (concat l) = firstn i (selN l 0 nil).
Proof.
  intros.
  induction l.
  reflexivity.
  simpl.
  rewrite firstn_app_l.
  reflexivity.
  rewrite Forall_forall in H.
  destruct H with (x:= a).
  apply in_eq.
  apply H0.
Qed.

Lemma mapfst_maplist2byteset: forall A (l: list (list A)) def,
  map fst (map (list2byteset def) l) = map (selN' 0 def) l.
Proof.
  intros.
  rewrite map_map.
  unfold selN'.
  replace (fun x : list A => fst (list2byteset def x)) with
    (fun x : list A => selN x 0 def).
  reflexivity.
  apply functional_extensionality.
  intros; symmetry; apply fst_list2byteset.
Qed.

Lemma bcombine_list_contr: forall a l,
  bcombine (byte2bytes a) (bcombine_list l) = bcombine_list (a::l).
Proof. intros; reflexivity. Qed.

Lemma word2bytes_preserve: forall sz (b: bytes sz),
  word2bytes sz eq_refl $ (# b) = b.
Proof.
  intros.
  simpl.
  apply natToWord_wordToNat.
Qed.

Lemma bytes_eq_to_word_eq : forall n m,
    n = m ->
    n * 8 = m * 8.
Proof.
  intros; subst; auto.
Qed.

Lemma eq_rect_bytes_to_word : forall sz sz' (H: sz = sz') b,
    rew [fun n => word (n * 8)] H in b = rew [fun n => word n] (bytes_eq_to_word_eq H) in b.
Proof.
  intros.
  generalize (bytes_eq_to_word_eq H).
  generalize_proof.
  destruct H; intros.
  eq_rect_simpl; auto.
Qed.

Theorem bcombine_0 : forall sz (b: bytes sz) (b': bytes 0) H,
    eq_rect _ bytes (bcombine b b') _ H = b.
Proof.
  intros.
  rewrite eq_rect_bytes_to_word.
  unfold bcombine.
  rewrite combine_n_0.
  eq_rect_simpl; auto.
Qed.

Lemma list2valu2list: forall l, length l = valubytes -> valu2list (list2valu l) = l.
Proof.
  intros.
  unfold valu2list, list2valu.
  rewrite bytes2valu2bytes.

  unfold bytes2valubytes.
  destruct (le_dec (length l) valubytes); try omega.
  simpl.

  generalize_proof.
  rewrite <- H.
  rewrite Nat.sub_diag.
  intros.

  rewrite bcombine_0.
  rewrite list2bytes2list; auto.
Qed.

Lemma valu2list2valu: forall v, list2valu (valu2list v) = v.
Proof.
  unfold list2valu, valu2list; intros.

  assert (length (bsplit_list (valu2bytes v)) = valubytes).
  rewrite bsplit_list_len; auto.

  unfold bytes2valu.
  eq_rect_simpl.
  rewrite eq_rect_bytes_to_word; eq_rect_simpl.
  unshelve erewrite bytes2list2bytes; auto.

  unfold bytes2valubytes.
  match goal with
  | [ |- context[match ?d with _ => _ end] ] =>
    destruct d
  end; try omega.

  unfold bytes.
  unfold bcombine.
  repeat rewrite eq_rect_bytes_to_word; eq_rect_simpl.
  repeat generalize_proof; intros.
  destruct e.
  simpl.
  generalize_proof.
  rewrite H, Nat.sub_diag; simpl.
  rewrite combine_n_0.
  intros.
  eq_rect_simpl.
  rewrite <- valu2bytes2valu.
  unfold bytes2valu.
  eq_rect_simpl.
  rewrite eq_rect_bytes_to_word; eq_rect_simpl.
  repeat generalize_proof; intros.
  assert (e = e2) by (apply ProofIrrelevance.proof_irrelevance).
  congruence.
Qed.

Lemma cons_simpl: forall A a (l l': list A), l = l' -> (a::l) = (a::l').
Proof. intros; rewrite H; reflexivity. Qed.

Lemma v2b_rec_nil: forall l i,
  i = length l  ->
  valuset2bytesets_rec (l::nil) i = map (cons' nil) l.
Proof.
  induction l; intros.
  rewrite H; reflexivity.
  simpl.
  destruct i.
  inversion H.
  simpl.
  rewrite IHl.
  reflexivity.
  simpl in H.
  inversion H; reflexivity.
Qed.

Lemma length_skip1: forall l i,
  length l = S i ->
  length ((fun l : list byte => match l with
                               | nil => nil
                               | _ :: l0 => l0
                               end) l) = i.
Proof.
  intros.
  destruct l.
  inversion H.
  simpl in H; omega.
Qed.

Lemma mapfst_valuset2bytesets_single: forall w,
map fst (valuset2bytesets (w,nil)) = valu2list w.
Proof.
	intros.
	unfold valuset2bytesets.
	simpl.
	rewrite v2b_rec_nil.
	rewrite map_map.
	rewrite map_map.
	unfold cons', list2byteset; simpl.
	rewrite map_id.
	reflexivity.
	symmetry; apply valu2list_len.
Qed.

Lemma mapfst_valuset2bytesets_rec: forall i a l,
length a = i ->
  Forall (fun sublist => length sublist = i) l ->
  map fst (map (list2byteset byte0)
     (valuset2bytesets_rec (a::l) i)) = a.
Proof.
	induction i; intros.
	simpl.
	apply length_zero_iff_nil in H; subst; reflexivity.
	simpl.
	rewrite IHi.
	unfold selN'; simpl.
	destruct a.
	simpl in H; inversion H.
	reflexivity.
	destruct a.
	simpl in H; inversion H.
	simpl in H; omega.
	rewrite Forall_forall; intros.
	apply in_map_iff in H1.
	repeat destruct H1.
	rewrite Forall_forall in H0.
	apply H0 in H2.
	destruct x0.
	simpl in H2; inversion H2.
	simpl in H2; omega.
Qed.

Lemma mapfst_valuset2bytesets: forall vs,
map fst (valuset2bytesets vs) = valu2list (fst vs).
	Proof.
		intros.
		unfold valuset2bytesets.
		unfold byteset2list; simpl.
		apply mapfst_valuset2bytesets_rec.
		apply valu2list_len.
		rewrite Forall_forall; intros.
		apply in_map_iff in H.
		repeat destruct H.
		apply valu2list_len.
	Qed.

Lemma bsplit1_bsplit_list: forall sz (b: bytes (1 + (sz - 1))),
  (bsplit1 1 (sz - 1) b :: bsplit_list (bsplit2 1 (sz - 1) b)) = bsplit_list b.
Proof.
  intros.
  simpl.
  unfold bsplit1_dep, bsplit2_dep.
  reflexivity.
Qed.

Lemma merge_bs_nil: forall l,
merge_bs l nil = map (fun x => (x, nil)) l.
Proof.
	induction l; simpl.
	reflexivity.
	rewrite IHl.
	reflexivity.
Qed.

Lemma l2b_cons_x_nil: forall l,
map (list2byteset byte0) (map (cons' nil) l)
		= map (fun x => (x, nil)) l.
Proof.
	intros.
	rewrite map_map.
	unfold list2byteset, cons'; simpl.
	reflexivity.
Qed.

Lemma valuset2bytesets_rec_cons_merge_bs: forall k a l,
  Forall (fun sublist => length sublist = k) (a::l) ->
 map (list2byteset byte0) (valuset2bytesets_rec (a::l) k)
 		= merge_bs a (map (list2byteset byte0) (valuset2bytesets_rec l k)).
	Proof.
		induction k; intros.
		simpl.
		rewrite Forall_forall in H.
		assert (In a (a::l)).
		apply in_eq.
		apply H in H0.
		apply length_zero_iff_nil in H0.
		rewrite H0; reflexivity.
		destruct a.
		assert (In nil (nil::l)).
		apply in_eq.
		rewrite Forall_forall in H.
		apply H in H0.
		simpl in H0; inversion H0.
		simpl.
		destruct l.
		simpl.
		rewrite v2b_rec_nil.
		rewrite merge_bs_nil.
		rewrite l2b_cons_x_nil.
		reflexivity.
		assert (In (b::a) ((b::a)::nil)).
		apply in_eq.
		rewrite Forall_forall in H.
		apply H in H0.
		simpl in H0; inversion H0.
		reflexivity.
		simpl.
		rewrite IHk.
		reflexivity.
		rewrite Forall_forall; intros.
		repeat destruct H0.
		assert (In (b::a) ((b::a)::l::l0)).
		apply in_eq.
		rewrite Forall_forall in H.
		apply H in H0.
		simpl in H0; inversion H0.
		reflexivity.
		assert (In l ((b::a)::l::l0)).
		apply in_cons.
		apply in_eq.
		rewrite Forall_forall in H.
		apply H in H0.
		destruct l.
		simpl in H0; inversion H0.
		simpl in H0; inversion H0.
		reflexivity.
		apply in_map_iff in H0.
		repeat destruct H0.
		rewrite Forall_forall in H.
		eapply in_cons in H1.
		eapply in_cons in H1.
		apply H in H1.
		destruct x0.
		simpl in H1; inversion H1.
		simpl in H1; inversion H1.
		reflexivity.
	Qed.

(* alterantive definitions that are easier to induct over *)
Definition valuset2byteset (vs : list (list byte)) :=
  map (fun i => selN_each vs i byte0) (seq 0 valubytes).

Definition valuset2bytesets' (vs: valuset): list byteset :=
  combine (valu2list (fst vs)) (valuset2byteset (map valu2list (snd vs))).

Definition bytesets2valuset' (l : list byteset) i :=
  let sets := split l in
  (list2valu (fst sets), map (fun i => list2valu (selN_each (snd sets) i byte0)) (seq 0 i)).

Lemma valuset2bytesets_rec_eq_valuset2bytesets: forall vs,
  length vs > 0 ->
  valuset2bytesets_rec vs valubytes = valuset2byteset vs.
Proof.
  unfold valuset2byteset.
  generalize valubytes.
  induction n; intros; subst; auto.
  destruct vs; cbn [length] in *.
  omega.
  cbn -[skipn selN_each].
  f_equal.
  rewrite <- seq_shift.
  rewrite map_map.
  rewrite IHn by (cbn; omega).
  apply map_ext. intros.
  rewrite selN_each_S. reflexivity.
Qed.

Lemma valuset2bytesets_eq_valuset2bytesets': forall vs,
  valuset2bytesets vs = valuset2bytesets' vs.
Proof.
  unfold valuset2bytesets, valuset2bytesets'.
  intros.
  setoid_rewrite valuset2bytesets_rec_eq_valuset2bytesets.
  destruct vs; cbn.
  unfold valuset2byteset at 1.
  rewrite map_map.
  cbn.

  rewrite combine_map.
  f_equal.
  rewrite map_selN_seq; auto.
  rewrite valu2list_len; auto.
  autorewrite with list.
  destruct vs; cbn. omega.
Qed.

Lemma bytesets2valuset_rec_eq_map: forall n bs,
  length bs > 0 ->
  bytesets2valuset_rec bs n = map (fun i => selN_each bs i byte0) (seq 0 n).
Proof.
  unfold bytesets2valuset.
  induction n; intros; subst; auto.
  cbn -[skipn].
  destruct bs; cbn [length] in *.
  omega.
  f_equal.
  rewrite <- seq_shift.
  rewrite map_map.
  rewrite IHn by (cbn; omega).
  apply map_ext. intros.
  rewrite selN_each_S. reflexivity.
Qed.

Lemma selN_each_fst_list2byteset: forall T (l : list (T * _)) def,
  selN_each (map byteset2list l) 0 def = fst (split l).
Proof.
  unfold selN_each.
  induction l; cbn; intros; auto.
  rewrite surjective_pairing with (p := split l).
  destruct a; cbn.
  f_equal.
  eauto.
Qed.

Lemma selN_each_snd_list2byteset: forall T (l : list (T * _)) a def,
  selN_each (map byteset2list l) (S a) def = selN_each (snd (split l)) a def.
Proof.
  unfold selN_each.
  induction l; cbn; intros; auto.
  rewrite surjective_pairing with (p := split l).
  destruct a; cbn.
  f_equal.
  eauto.
Qed.

Lemma bytesets2valuset_eq_bytesets2valuset': forall bs n,
  Forall (fun b => length (snd b) = n) bs ->
  length bs = valubytes ->
  bytesets2valuset bs = bytesets2valuset' bs n.
Proof.
  unfold bytesets2valuset, bytesets2valuset'.
  intros.
  setoid_rewrite bytesets2valuset_rec_eq_map.
  cbn.
  repeat f_equal.
  apply selN_each_fst_list2byteset.
  rewrite <- seq_shift.
  repeat rewrite map_map.
  eapply Forall_selN in H as H'.
  rewrite H'.
  apply map_ext. intros.
  rewrite selN_each_snd_list2byteset. auto.
  rewrite Valulen.valubytes_is in H0. omega.
  autorewrite with list.
  rewrite Valulen.valubytes_is in H0. omega.
Qed.

Lemma valuset2bytesets2valuset: forall vs,
  bytesets2valuset (valuset2bytesets vs) = vs.
Proof.
  intros.
  rewrite valuset2bytesets_eq_valuset2bytesets'.
  destruct vs; cbn.
  erewrite bytesets2valuset_eq_bytesets2valuset' with (n := length l).
  cbv [bytesets2valuset' valuset2bytesets'].
  rewrite combine_split. cbn.
  rewrite valu2list2valu.
  f_equal.
  induction l; cbn; auto.
  f_equal.
  unfold valuset2byteset.
  rewrite map_map. cbn.
  rewrite map_selN_seq.
  apply valu2list2valu.
  rewrite valu2list_len. auto.
  rewrite <- seq_shift.
  rewrite map_map.
  cbn.
  rewrite <- IHl at 2.
  apply map_ext. intros.
  f_equal.
  unfold valuset2byteset, selN_each.
  repeat rewrite map_map.
  reflexivity.
  rewrite valu2list_len.
  unfold valuset2byteset.
  autorewrite with list. auto.
  unfold valuset2bytesets', valuset2byteset. cbn.
  apply Forall_forall. intros x H.
  destruct x; cbn in *.
  apply in_combine_r in H.
  rewrite in_map_iff in *. deex.
  autorewrite with lists. auto.
  unfold valuset2bytesets', valuset2byteset. cbn.
  autorewrite with lists.
  rewrite seq_length.
  rewrite valu2list_len.
  apply Nat.min_id.
Qed.

Fact updN_list_nil: forall l2 l1 a,
  l1 <> nil -> updN_list l1 a l2 = nil -> l2 = nil.
Proof.
  induction l2; intros.
  split.
  auto.

  destruct l1.
  unfold not in H; destruct H; reflexivity.
  destruct a0.
  unfold updN_list in *.
  simpl in *.
  inversion H0.
  unfold updN_list in *.
  simpl in *.
  inversion H0.
Qed.

Fact skipn_not_nil: forall A (l: list A) n,
  n < length l -> skipn n l <> nil.
Proof.
  induction l; intros.
  inversion H.
  destruct n.
  simpl.
  unfold not; intros; inversion H0.
  simpl.
  apply IHl.
  simpl in H.
  omega.
Qed.

Fact b2v_rec_nil: forall i bn,
  bytesets2valuset_rec bn i = nil -> i = 0 \/ bn = nil.
Proof.
  induction i; intros.
  left. reflexivity.
  right.
  destruct bn.
  reflexivity.
  simpl in H.
  inversion H.
Qed.

Fact d_map_d_map: forall A B C (a: A) (l: list A) (f: A -> B) (g: B -> C),
d_map g (d_map f (a,l)) = d_map (fun x => g(f x)) (a, l).
Proof.
intros; unfold d_map; simpl.
rewrite map_map; reflexivity.
Qed.

Lemma mod_Sn_n_1: forall a, a >1 -> (a + 1) mod a = 1.
Proof.
intros.
rewrite <- Nat.add_mod_idemp_l; try omega.
rewrite Nat.mod_same; simpl; try omega.
apply Nat.mod_1_l; auto.
Qed.

Lemma le_mult_weaken: forall p n m, p > 0 -> n * p <= m * p  -> n <= m.
Proof.
  assert(A: forall x, 0 * x = 0). intros. omega.
  induction n. intros.
  destruct m.
  omega.
  omega. intros.
  destruct m.
  inversion H0.
  apply plus_is_O in H2.
  destruct H2.
  omega.
  apply le_n_S.
  apply IHn.
  auto.
  simpl in H0.
  omega.
Qed.

Fact vs2bs_selN_O: forall l,
selN (valuset2bytesets l) 0 byteset0 = (list2byteset byte0 (map (selN' 0 byte0) (map valu2list (byteset2list l)))).
Proof.
intros.
unfold valuset2bytesets.
destruct l.
simpl.
rewrite map_map; simpl.
rewrite valuset2bytesets_rec_expand.
simpl.
unfold selN'.
rewrite map_map; reflexivity.
rewrite valubytes_is; omega.
Qed.

Lemma updN_eq: forall A v v' a (l: list A), v = v' -> updN l a v  = updN l a v'.
Proof. intros; subst; reflexivity. Qed.

Lemma skipn_concat_skipn: forall A j i k (l: list (list A)) def,
i <= k -> j < length l -> Forall (fun sublist : list A => length sublist = k) l ->
skipn i (concat (skipn j l)) = skipn i (selN l j def) ++ concat (skipn (S j) l).
Proof. induction j; destruct l; intros; simpl.
inversion H0.
apply skipn_app_l.
rewrite Forall_forall in H1.
destruct H1 with (x:= l).
apply in_eq.
omega.
inversion H0.
erewrite IHj.
reflexivity.
eauto.
simpl in H0; omega.
eapply Forall_cons2.
eauto.
Qed.

Fact map_1to1_eq: forall A B (f: A -> B) (l l': list A),
  (forall x y, f x = f y -> x = y) ->
  map f l = map f l' ->
  l = l'.

Proof.
  induction l; intros.
  simpl in H0; symmetry in H0.
  eapply map_eq_nil in H0.
  eauto.
  destruct l'.
  rewrite map_cons in H0; simpl in H0.
  inversion H0.
  repeat rewrite map_cons in H0.
  inversion H0.
  apply H in H2.
  rewrite H2.
  eapply IHl in H.
  apply cons_simpl.
  eauto.
  eauto.
Qed.

Fact map_eq: forall A B (f: A -> B) (l l': list A),
  l = l' ->
  map f l = map f l'.
Proof. intros; rewrite H; reflexivity. Qed.

Fact minus_eq_O: forall n m, n >= m -> n - m = 0 -> n = m.
Proof.
induction n; intros.
inversion H; reflexivity.
destruct m.
inversion H0.
apply eq_S.
apply IHn.
omega. omega.
Qed.

Fact valubytes_ne_O: valubytes <> 0.
Proof. rewrite valubytes_is; unfold not; intros H'; inversion H'. Qed.

Fact divmult_plusminus_eq:forall n m, m <> 0 ->
   m + n / m * m = n + (m - n mod m).
Proof.
intros.
rewrite Nat.add_sub_assoc.
replace (n + m - n mod m)
    with (m + n - n mod m) by omega.
rewrite <- Nat.add_sub_assoc.
rewrite Nat.add_cancel_l with (p:= m); eauto.
rewrite Nat.mod_eq; eauto.
rewrite Rounding.sub_sub_assoc.
apply Nat.mul_comm.
apply Nat.mul_div_le; eauto.
apply Nat.mod_le; eauto.
apply Nat.lt_le_incl.
apply Nat.mod_upper_bound; eauto.
Qed.

Fact le_minus_divmult: forall n m k, m <> 0 ->
    n - (m - k mod m) - (n - (m - k mod m)) / m * m <= m.
Proof. intros.
remember (n - (m - k mod m)) as b.
replace (b - b / m * m) with (b mod m).
apply Nat.lt_le_incl.
apply Nat.mod_upper_bound; eauto.
rewrite Nat.mul_comm.
apply Nat.mod_eq; eauto.
Qed.

Fact grouping_minus: forall n m k a, n - (m - k + a) = n - (m - k) - a.
Proof. intros. omega. Qed.

Lemma mod_dem_neq_dem: forall a b, a <> 0 -> b <> 0 -> b <> a mod b.
Proof.
induction b; intros.
unfold not in H0; destruct H0; reflexivity.
destruct a.
unfold not in H; destruct H; reflexivity.
unfold not in *; intros.
apply IHb; auto.
intros.
rewrite H2 in H1.
rewrite Nat.mod_1_r in H1; inversion H1.
simpl in H1.
destruct b.
reflexivity.
simpl in *.
destruct (snd (Nat.divmod a (S b) 0 b)); omega.
Qed.

Lemma get_sublist_length: forall A (l: list A) a b,
a + b <= length l ->
length (get_sublist l a b) = b.
Proof.
intros.
unfold get_sublist.
rewrite firstn_length_l.
reflexivity.
rewrite skipn_length.
omega.
Qed.

Lemma bsplit_list_b2vb: forall b,
  exists l, (bsplit_list (bytes2valubytes (byte2bytes b))) = b::l.
Proof.
  intros.
  unfold bytes2valubytes.
  destruct (le_dec 1 valubytes).
  simpl.
  unfold eq_rect.
  destruct (bytes_eq l).
  simpl.
  unfold bsplit1_dep, bsplit2_dep; simpl.
  rewrite bsplit1_bcombine.
  rewrite bsplit2_bcombine.
  unfold natToWord.
  exists (bsplit_list
       ((fix natToWord (sz n : addr) {struct sz} : word sz :=
           match sz as sz0 return (word sz0) with
           | 0 => WO
           | S sz' => WS (mod2 n) (natToWord sz' (Nat.div2 n))
           end) ((valubytes - 1) * 8) 0)).
  unfold byte2bytes.
  unfold word2bytes.
  eq_rect_simpl.
  reflexivity.
  rewrite valubytes_is in n; omega.
Qed.

Lemma app_length_eq: forall A (l l': list A) len a,
length l = len -> a + length l' <= len ->
length (firstn a l ++ l' ++ skipn (a + length l') l) = len.
	Proof.
		intros; repeat rewrite app_length.
		repeat rewrite map_length.
		rewrite firstn_length_l.
		rewrite skipn_length.
		omega.
		omega.
	Qed.

Lemma off_mod_v_l_data_le_v: forall length_data off,
	length_data <= valubytes - off mod valubytes ->
	off mod valubytes + length_data <= valubytes.
	Proof.
		intros;
		apply DiskLogHash.PaddedLog.Desc.le_add_le_sub.
		apply Nat.lt_le_incl; apply Nat.mod_upper_bound.
		apply valubytes_ne_O.
		auto.
	Qed.

Lemma v_off_mod_v_le_length_data: forall length_data off,
~ length_data <= valubytes - off mod valubytes ->
valubytes - off mod valubytes <= length_data.
	Proof. intros; omega. Qed.

Lemma three_reorder: forall a b c,
a + b + c = c + b + a.
Proof. intros; omega. Qed.

Lemma last_two_reorder: forall a b c,
a + b + c = a + c + b.
	Proof. intros; omega. Qed.

Lemma pm_1_3_cancel: forall a b,
a + b - a = b.
	Proof. intros; omega. Qed.

Lemma n_le_n_p_1: forall n,
n <= n + 1.
	Proof. intros; omega. Qed.

Lemma ppmp_2_4_cancel: forall a b c d,
a + b + c - b + d = a + c + d.
	Proof. intros; omega. Qed.

Lemma mm_dist: forall a b c,
b <= a ->
c <= b ->
a - (b - c) = a - b + c.
	Proof. intros; omega. Qed.

	Lemma ppmm_4_5_minus_distr_le: forall a b c d e,
d <= a + b + c ->
e <= d ->
a + b + c - (d - e) = a + b + c - d + e.
	Proof. intros; omega. Qed.

Lemma le_2: forall a b c,
b <= a + b + c.
	Proof. intros; omega. Qed.

Lemma app_assoc_middle_2: forall A (l1 l2 l3 l4 l5: list A),
l1++l2++l3++l4++l5 = l1++l2++(l3++l4)++l5.
	Proof. intros; repeat rewrite app_assoc; reflexivity. Qed.

Lemma ppmp_3_4_cancel: forall a b c d,
a + b + c - c + d = a + b + d.
	Proof. intros; omega. Qed.

Lemma mm_1_3_cancel: forall a b,
a - b - a = 0.
	Proof. intros; omega. Qed.

Lemma list_split_chunk_length: forall A n m (l: list A),
m > 0 ->
length l = n * m ->
length (list_split_chunk n m l) = min n (length l / m).
Proof.
  induction n; intros; simpl.
  reflexivity.
  destruct (length l / m) eqn:D.
  destruct m eqn:D1; simpl; try omega.
  apply Nat.div_small_iff in D; try omega.
  rewrite H0 in D.
  destruct n.
  simpl in D. rewrite <- plus_n_O in D; omega.
  simpl in D. apply lt_S_n in D.
  assert (forall a b, a + (S b) < a -> False).
  intros; omega.
  apply H1 in D; inversion D.
  rewrite IHn; try omega.
  rewrite skipn_length.
  rewrite H0.
  replace (S n * m - m) with (n * m).
  rewrite H0 in D.
  rewrite Nat.div_mul in *.
  inversion D.
  reflexivity.
  all: try omega.
  simpl.
  rewrite pm_1_3_cancel.
  reflexivity.
  rewrite skipn_length.
  rewrite H0.
  simpl.
  apply pm_1_3_cancel.
Qed.

Lemma firstn_valuset2bytesets_byte2valu: forall b,
firstn 1 (valuset2bytesets (byte2valu b, nil)) = (b, nil)::nil.
Proof.
  intros;
  unfold valuset2bytesets.
  simpl.
  unfold byte2valu.
  unfold bytes2valubytes.
  destruct (le_dec 1 valubytes).
  rewrite v2b_rec_nil.
  rewrite l2b_cons_x_nil.
  unfold word2bytes.
  eq_rect_simpl.
  unfold valu2list.
  rewrite bytes2valu2bytes.
  unfold bcombine.
  eq_rect_simpl.
  unfold eq_rect.
  destruct (bytes_eq l).
  simpl.
  unfold bsplit1_dep; simpl.
  unfold bsplit1.
  eq_rect_simpl.
  rewrite Word.split1_combine.
  unfold byte2bytes.
  unfold word2bytes.
  eq_rect_simpl.
  reflexivity.
  rewrite valu2list_len; reflexivity.
  rewrite valubytes_is in n; omega.
Qed.

Lemma list_split_chunk_app_1: forall A a b (l l': list A) ,
length l = a * b ->
length l' = b ->
list_split_chunk (a+1) b (l ++ l') =  list_split_chunk a b l ++ l'::nil.
Proof.
  induction a; intros.
  simpl in H.
  apply length_zero_iff_nil in H; rewrite H.
  simpl.
  rewrite <- H0; rewrite firstn_exact; reflexivity.
  simpl.
  rewrite skipn_app_l.
  rewrite IHa.
  rewrite firstn_app_l.
  reflexivity.
  all: try omega.
  all: try rewrite H; simpl; try apply le_plus_trans; try omega.
  rewrite skipn_length. rewrite H; simpl. apply pm_1_3_cancel.
Qed.

Lemma list_split_chunk_map_comm: forall A B a b (l: list A) (f:A -> B),
map (fun x => map f x) (list_split_chunk a b l) = list_split_chunk a b (map f l).
Proof.
    induction a; intros.
    reflexivity.
    simpl.
    rewrite IHa.
    rewrite firstn_map_comm.
    rewrite skipn_map_comm.
    reflexivity.
Qed.

Lemma get_sublist_map_comm: forall A B a b (f: A -> B) (l: list A),
map f (get_sublist l a b) = get_sublist (map f l) a b.
Proof.
  intros; unfold get_sublist.
  rewrite <- firstn_map_comm;
  rewrite <- skipn_map_comm;
  reflexivity.
Qed.

Lemma firstn_1_selN: forall A (l: list A) def,
l <> nil -> firstn 1 l = (selN l 0 def)::nil.
Proof.
  intros.
  destruct l.
  destruct H; reflexivity.
  reflexivity.
Qed.

Lemma concat_list_split_chunk_id: forall A a b (l: list A),
a * b = length l -> concat (list_split_chunk a b l) = l.
Proof.
  induction a; intros.
  simpl in *.
  symmetry in H; apply length_zero_iff_nil in H. symmetry; auto.
  simpl.
  rewrite IHa.
  apply firstn_skipn.
  rewrite skipn_length.
  rewrite <- H; simpl; rewrite pm_1_3_cancel; reflexivity.
Qed.

Lemma list_split_chunk_cons: forall A m1 (l: list A),
length l = m1 * valubytes + valubytes ->
list_split_chunk (m1 + 1) valubytes l  = firstn valubytes l :: list_split_chunk m1 valubytes (skipn valubytes l).
Proof.
  intros.
  replace (m1 + 1) with (S m1) by omega.
  reflexivity.
Qed.

Lemma list_split_chunk_nonnil: forall A a b (l: list A),
b > 0 ->
length l = a * b ->
forall x, In x (list_split_chunk a b l) -> x <> nil.
Proof.
  induction a; intros.
  simpl in *.
  inversion H1.
  simpl in *.
  destruct H1.
  unfold not; intros.
  rewrite <- H1 in H2.
  apply length_zero_iff_nil in H2.
  rewrite firstn_length_l in H2; try omega.
  rewrite H0; apply le_plus_trans. apply le_n.
  eapply IHa; eauto.
  rewrite skipn_length.
  rewrite H0; apply pm_1_3_cancel.
Qed.

Lemma le_minus_weaken: forall a b c,
a <= b -> a-c <= b - c.
Proof.  intros. omega. Qed.

Lemma le_minus_dist: forall a b c,
a >= b ->
b >= c ->
a - (b - c) = a - b + c.
Proof. intros. omega. Qed.

Lemma plus_minus_arrange: forall a b c d,
a >= b ->
a - b + c >= d ->
a - b + c - d + b = a + c - d + b - b.
Proof. intros; omega. Qed.

Lemma le_minus_weaken_r: forall a b c,
a <= b - c -> a <= b.
Proof. intros; omega. Qed.

Fact merge_bs_length: forall l l',
length (merge_bs l l') = length l.
Proof.
induction l; intros.
reflexivity.
simpl.
destruct l'; simpl; rewrite IHl; reflexivity.
Qed.

Fact updN_list_length: forall l a ln,
a + length ln <= length l ->
length (updN_list l a ln) = length l.
Proof.
intros.
unfold updN_list.
repeat rewrite app_length.
rewrite merge_bs_length.
rewrite firstn_length_l; try omega.
rewrite skipn_length.
rewrite Nat.add_assoc.
symmetry; apply le_plus_minus.
auto.
Qed.

Fact updN_list2firstn_skipn: forall ln a l,
a + length ln <= length l ->
updN_list l a ln = firstn a l ++ (updN_list (get_sublist l a (length ln)) 0 ln)
                      ++ skipn (a + (length ln)) l.
Proof.
intros.
unfold updN_list; simpl.
unfold get_sublist; simpl.
rewrite firstn_firstn.
rewrite Nat.min_id.
replace (firstn (length ln) (skipn a l)) with (firstn (length ln + 0) (skipn a l)).
rewrite skipn_firstn_comm.
simpl. rewrite app_nil_r. reflexivity.
rewrite <- plus_n_O; reflexivity.
Qed.

Lemma app_tail_eq: forall A (l l' l'':list A),
  l = l' -> l ++ l'' = l' ++ l''.
Proof. intros; rewrite H; reflexivity. Qed.

Lemma app_head_eq: forall A (l l' l'':list A),
  l = l' -> l'' ++ l = l'' ++ l'.
Proof. intros; rewrite H; reflexivity. Qed.

Lemma valubytes_ge_O: valubytes > 0.
Proof. rewrite valubytes_is; omega. Qed.

Lemma old_data_m1_ge_0: forall l_old_data m1 l_old_blocks,
m1 < l_old_blocks ->
l_old_data = l_old_blocks * valubytes ->
l_old_data - m1 * valubytes > 0.
Proof. intros; rewrite valubytes_is in *; omega. Qed.

Lemma length_data_ge_m1: forall l_data l_old_data m1 l_old_blocks,
l_data = l_old_data ->
m1 < l_old_blocks ->
l_old_data = l_old_blocks * valubytes ->
m1 * valubytes <= l_data.
Proof. intros; rewrite valubytes_is in *; omega. Qed.

Lemma get_sublist_div_length: forall A (data: list A) l_old_data m1 l_old_blocks,
length data = l_old_data ->
m1 < l_old_blocks ->
l_old_data = l_old_blocks * valubytes ->
m1 <= length (get_sublist data 0 (m1 * valubytes)) / valubytes.
Proof.
intros.
rewrite get_sublist_length.
rewrite Nat.div_mul.
omega.
apply valubytes_ne_O.
simpl.
eapply length_data_ge_m1; eauto.
Qed.

Lemma length_old_data_ge_O: forall l_data l_old_data m1 l_old_blocks,
l_data = l_old_data ->
m1 < l_old_blocks ->
l_old_data = l_old_blocks * valubytes ->
l_old_data > 0.
Proof. intros; rewrite valubytes_is in *; omega. Qed.

Lemma old_data_ne_nil: forall A (old_data: list A) m1 l_old_blocks,
old_data = nil ->
m1 < l_old_blocks ->
length old_data = l_old_blocks * valubytes ->
False.
Proof. intros; apply length_zero_iff_nil in H; rewrite valubytes_is in *; omega. Qed.

Lemma length_bytefile_ge_minus: forall l_fy block_off l_old_data m1 l_old_blocks,
block_off * valubytes + l_old_data <= l_fy ->
m1 < l_old_blocks ->
l_old_data = l_old_blocks * valubytes ->
valubytes <= l_fy - (block_off + m1) * valubytes.
Proof. intros; rewrite valubytes_is in *; omega. Qed.

Lemma length_data_ge_m1_v: forall l_data l_old_data m1 l_old_blocks,
l_data = l_old_data ->
m1 < l_old_blocks ->
l_old_data = l_old_blocks * valubytes ->
m1 * valubytes + valubytes <= l_data.
Proof. intros; rewrite valubytes_is in *; omega. Qed.

Lemma nonnil_exists: forall A (l: list A),
l <> nil -> exists a l', l = a::l'.
Proof.
intros.
destruct l.
unfold not in H; destruct H; reflexivity. repeat eexists.
Qed.

Lemma map_same: forall A B (l1 l2: list A) (f: A -> B),
l1 = l2 -> map f l1 = map f l2.
Proof. intros; subst; reflexivity. Qed.

Lemma pmm_1_3_cancel: forall a b c,
a + b - a -c = b - c.
Proof. intros; omega. Qed.

Lemma le_div_mult_add: forall a b,
b <> 0 -> a <= a/b * b + b.
Proof.
  intros.
  remember (a / b * b + b) as x.
  rewrite Nat.div_mod with (x:= a)(y:= b).
  rewrite Heqx.
  apply plus_le_compat.
  rewrite Nat.mul_comm; apply le_n.
  apply Nat.lt_le_incl; apply Nat.mod_upper_bound.
  all: auto.
Qed.

Lemma le_minus_middle_cancel: forall a b c d e,
a - c <= d - e -> a - b - c <= d - b - e.
Proof. intros; omega. Qed.

Lemma mppp_two_five_cancel: forall a b c d,
a >= b ->
a - b + c + d + b = a + c + d.
Proof. intros; omega. Qed.

Lemma le_minus_lt: forall a b c,
b > 0 -> c > 0 -> a <= b - c -> a < b.
Proof. intros; omega. Qed.

Lemma modulo_eq: forall b a,
  b <> 0 -> a >= b -> (a - b) mod b = a mod b.
Proof.
  intros.
  eapply Nat.mod_unique.
  apply Nat.mod_upper_bound.
  auto.
  instantiate (1:= (a - b) / b + 1).
  remember (b * ((a - b) / b + 1) + (a - b) mod b) as x.
  rewrite <- Nat.sub_add with (n:= b)(m:= a).
  rewrite Nat.div_mod with (x:= a-b)(y:=b).
  rewrite Nat.add_comm.
  rewrite Nat.add_assoc.
  rewrite Heqx.
  rewrite Nat.mul_add_distr_l.
  omega.
  all: auto.
Qed.

Lemma minus_middle: forall a b c,
b <> 0 -> a>= b -> b >= c -> (a - (b - c))/ b = (a + c) / b - 1.
Proof.
  intros.
  rewrite le_minus_dist.
  rewrite <- Nat.add_sub_swap.
  all: auto.
  remember (a+c) as x.
  apply Nat.mul_cancel_l with (p:= b).
  auto.
  replace (b * ((x - b) / b)) with ((x - b) - (x-b) mod b).
  rewrite Nat.mul_sub_distr_l.
  replace (b * (x / b)) with (x - x mod b).
  rewrite modulo_eq.
  omega.
  all: auto.
  rewrite Heqx.
  omega.
  replace (x - x mod b)
    with (b*(x / b) + x mod b - x mod b).
  apply Nat.add_sub.
  rewrite <- Nat.div_mod.
  reflexivity.
  auto.
  replace (x - b - (x - b) mod b)
    with (b * ((x-b)/b) + (x-b) mod b - (x - b) mod b).
  apply Nat.add_sub.
  rewrite <- Nat.div_mod.
  reflexivity.
  auto.
Qed.

	Lemma mod_minus_eq: forall c a b,
	b <> 0 ->
	a >= c * b ->
	(a - c * b) mod b = a mod b.
	Proof.
		induction c; intros.
		simpl.
		rewrite <- minus_n_O.
		reflexivity.
		replace (a - S c * b) with ((a - b) - c * b).
		rewrite IHc.
		apply modulo_eq.
		all: auto.
		simpl in H0.
		eapply le_trans.
		2: apply H0.
		apply le_plus_l.
		apply Nat.le_add_le_sub_l.
		simpl in H0; auto.
		simpl.
		rewrite Nat.sub_add_distr.
		reflexivity.
	Qed.

		Lemma lt_minus_r: forall a b c,
	b > c -> a > c -> a - c > a -b.
	Proof. intros; omega. Qed.

  Lemma div_lt_le: forall a b c,
      b <> 0 ->
      a >= c ->
      a / b >= c / b.
  Proof.
    intros.
    apply Nat.div_le_mono; eauto.
  Qed.

Lemma n2w_id: forall a b sz,
a = b -> natToWord sz a = natToWord sz b.
	Proof. intros; subst; reflexivity. Qed.

Lemma mod_minus: forall a b,
b <> 0 ->
a - a mod b = (a / b) * b.
	Proof.
	 intros.
	 remember (a mod b) as x.
	 remember (a / b * b) as y.
	 rewrite Nat.div_mod with (x:= a)(y:= b); eauto.
	 rewrite Heqx; rewrite Heqy.
	 rewrite Nat.add_sub.
	 apply Nat.mul_comm.
 Qed.

Lemma mod_minus_mod: forall a b,
b <> 0 ->
(a - a mod b) mod b = 0.
	Proof.
		intros.
		rewrite mod_minus.
		apply Nat.mod_mul.
		all: auto.
	Qed.

Lemma lt_mp: forall a b c,
a > b ->
c < b ->
a - b + c < a.
Proof. intros; omega. Qed.

Lemma between_lt_upper: forall a b c,
b <> 0 ->
a > (c - 1) * b ->
a <= c * b ->
a mod b > 0 ->
a < c * b.
Proof.
  intros.
  destruct c; simpl in *; try omega.
  rewrite Nat.sub_0_r in *.
  destruct (Nat.eq_dec a (b + c * b)); try omega.
  subst.
  exfalso.
  rewrite Nat.mod_add in H2 by auto.
  rewrite Nat.mod_same in * by auto.
  omega.
Qed.

Lemma list_zero_pad_length: forall a l,
length (list_zero_pad l a) = length l + a.
Proof.
  induction a; intros.
  simpl; apply plus_n_O.
  simpl.
  rewrite IHa.
  rewrite app_length; simpl; omega.
Qed.

Lemma list_zero_pad_selN_l: forall a l i def,
i < length l ->
selN (list_zero_pad l a) i def = selN l i def.
Proof.
  induction a; intros.
  reflexivity.
  simpl.
  rewrite IHa.
  rewrite selN_app1.
  reflexivity.
  auto.
  rewrite app_length.
  simpl; omega.
Qed.

Lemma list_zero_pad_selN_pad: forall a l i,
i >= length l ->
selN (list_zero_pad l a) i byte0 = byte0.
Proof.
  intros.
  destruct (lt_dec i (length l + a)).
  generalize dependent l.
  induction a; intros.
  simpl.
  rewrite selN_oob; auto.
  simpl.
  destruct (le_dec (S (length l)) i).
  apply IHa.
  rewrite app_length; simpl; omega.
  rewrite app_length; simpl; omega.
  apply Nat.nle_gt in n.
  rewrite list_zero_pad_selN_l.
  rewrite selN_app2.
  simpl.
  destruct (i - length l); try omega; reflexivity.
  auto.
  rewrite app_length; simpl; omega.
  apply selN_oob.
  rewrite list_zero_pad_length; omega.
Qed.

Lemma between_mod_ne_0: forall c a b,
b <> 0 ->
a > (c - 1) * b ->
a < c * b ->
a mod b <> 0.
Proof.
  induction c; intros.
  inversion H1.
  destruct (lt_dec a b).
  apply Nat.mod_small_iff in l.
  rewrite l.
  unfold not; intros.
  rewrite H2 in H0; inversion H0.
  auto.
  apply Nat.nlt_ge in n.
  replace (S c - 1) with c in H0 by omega.
  simpl in *.
  rewrite <- modulo_eq.
  apply IHc.
  all: try omega.
  rewrite Nat.mul_sub_distr_r.
  apply Nat.lt_add_lt_sub_r.
  simpl; rewrite <- plus_n_O.
  rewrite Nat.sub_add; try omega.
  destruct c. omega.
  simpl;  apply le_plus_l.
Qed.

Lemma merge_bs_firstn_comm: forall l l' a,
firstn a (merge_bs l l') = merge_bs (firstn a l) (firstn a l').
Proof. induction l; intros.
  simpl.
  repeat rewrite firstn_nil.
  reflexivity.
  destruct l'.
  rewrite firstn_nil.
  repeat rewrite merge_bs_nil.
  apply firstn_map_comm.
  destruct a0.
  reflexivity.
  simpl.
  rewrite IHl.
  reflexivity.
Qed.

Lemma list_zero_pad_expand: forall a l,
list_zero_pad l a = l ++ list_zero_pad nil a.
Proof.
  induction a; intros; simpl.
  rewrite app_nil_r; reflexivity.
  rewrite IHa.
  simpl.
  remember ((l ++ byte0 :: nil) ++ list_zero_pad nil a) as x.
  rewrite IHa.
  rewrite Heqx.
  rewrite <- app_comm_cons.
  apply app_assoc_reverse.
Qed.

Lemma list_zero_pad_nil_iff: forall a l,
list_zero_pad l a = nil <-> l = nil /\ a = 0.
Proof.
  induction a; intros.
  split; intros.
  split; simpl in *; auto.
  destruct H.
  rewrite H; reflexivity.
  split; intros.
  simpl in H.
  apply IHa in H.
  destruct H.
  apply app_eq_nil in H.
  destruct H.
  inversion H1.
  destruct H.
  inversion H0.
Qed.

Lemma pmp_1_4_cancel: forall a b c,
a + b - a + c = b + c.
Proof. intros; omega. Qed.

Lemma lt_minus_S: forall a b,
a > b ->
exists n, a - b = S n.
Proof.
  induction a; intros.
  inversion H.
  destruct b.
  exists a.
  omega.
  simpl.
  apply IHa.
  omega.
Qed.

Lemma mod_upper_bound_le: forall a b,
a mod b < b ->
a mod b + 1 <= b.
Proof. intros. omega. Qed.

Lemma list_zero_pad_nil_firstn: forall a b,
firstn a (list_zero_pad nil b) = list_zero_pad nil (min a b).
Proof.
	induction a; intros.
	reflexivity.
	destruct b.
	reflexivity.
	simpl.
	rewrite list_zero_pad_expand.
	simpl.
	rewrite IHa.
	symmetry; apply list_zero_pad_expand.
Qed.

		Lemma lt_0_S: forall a,
	a > 0 -> exists n, a = S n.
	Proof.
	intros; inversion H. exists 0. reflexivity.
	exists m. reflexivity.
	Qed.

	Lemma mod_minus_lt_0: forall a b,
	b <> 0 ->
	b - a mod b > 0.
	Proof.
	intros. apply Nat.lt_add_lt_sub_r; simpl.
	apply Nat.mod_upper_bound; auto.
	Qed.

	Lemma mp_2_3_cancel: forall a b,
	a >= b -> a - b + b = a.
	Proof. intros; omega. Qed.

	Lemma mod_upper_bound_le': forall a b,
	b <> 0 ->
	b >= a mod b.
	Proof.
	intros; apply Nat.lt_le_incl;
	apply Nat.mod_upper_bound; auto.
	Qed.

	Lemma mod_ne_0: forall a b,
b <> 0 -> a mod b > 0 ->
a > 0.
Proof.
	intros.
	rewrite Nat.div_mod with (x:= a)(y:= b).
	apply Nat.add_nonneg_pos.
	all: try omega.
	apply le_0_n.
Qed.

Lemma minus_le_0_eq: forall a b,
a >= b -> a - b = 0 -> a = b.
Proof. intros; omega. Qed.

 Lemma lt_plus_minus_l: forall a b c,
  c > 0 -> a < b + c -> a - b < c.
Proof.  intros; omega. Qed.

Lemma plus_minus_eq_le: forall a b c,
  a >=  b -> a - b = c -> a = b + c.
Proof. intros; omega. Qed.

Lemma between_exists: forall b a c,
    a >= (b-1) * c -> a < b*c -> c<>0 -> a = (b-1) * c + a mod c.
Proof.
  intros.
  destruct b; simpl in *.
  inversion H0.
  rewrite <- minus_n_O in *.

  pose proof (Nat.le_exists_sub (b*c) a); intuition; deex.
  rewrite Nat.mod_add by auto.
  rewrite Nat.mod_small by omega.
  omega.
Qed.

Lemma mod_between_upper: forall a b c,
	b <> 0 ->
	a > (c - 1) * b ->
	c * b >= a ->
	a mod b = 0 ->
	a = c * b.
	Proof.
		intros.
		destruct (lt_dec a (c * b)).
		apply Nat.lt_le_incl in H0 as H'.
		apply between_exists in H'; auto.
		omega.
		omega.
	Qed.


(* Librariile necesare pt a lucra cu stringuri*)
Require Import Strings.String.
Local Open Scope string_scope.
Local Open Scope list_scope.
Scheme Equality for string.

(* Acum voi inlocui tipul nat pe care l am mai folosit cu un nou tip: ErrorNar, care trateaza si cazurile mai speciale *)
Inductive ErrorNat :=
 | error_nat: ErrorNat
 | num : nat -> ErrorNat.
Check ErrorNat.
Check error_nat.
Check num.
Coercion num : nat >-> ErrorNat.

(* Same pentru bool *)

Inductive ErrorBool :=
 | error_bool : ErrorBool
 | bul : bool -> ErrorBool.
Check ErrorBool.
Check error_bool.
Check bul.
Coercion bul : bool >-> ErrorBool.

(* Fac un tip cu erori si pentru string, pentru moment*)

Inductive ErrorString :=
 | error_string : ErrorString
 | char : string -> ErrorString.
Check ErrorString.
Check error_string.
Check char.
Coercion char : string >-> ErrorString.

(* Pentru expr aritmetice *)
Inductive AExp :=
 | anum : ErrorNat -> AExp
 | avar : string -> AExp
 | aplus : AExp -> AExp -> AExp
 | aminus : AExp -> AExp -> AExp
 | amul : AExp -> AExp -> AExp
 | adiv : AExp -> AExp -> AExp
 | amod : AExp -> AExp -> AExp.

Coercion avar : string >-> AExp.
Coercion anum : ErrorNat >-> AExp.

Notation "A +' B" := (aplus A B)(at level 60, right associativity).
Notation "A -' B" := (aminus A B)(at level 60, right associativity).
Notation "A *' B" := (amul A B)(at level 59, right associativity).
Notation "A /' B" := (adiv A B)(at level 59, right associativity).
Notation "A %' B" := (amod A B)(at level 58, right associativity).
Check ("a" +' "b").
Check ("a" -' "b").
Check ("a" +' 3).
Check ("a" /' 0).
Check (7 %' 2).

(* Acum pentru expresii booleene *)
Inductive BExp :=
 | berror
 | btrue
 | bfalse
 | bvar : string -> BExp
 | blessthan : AExp -> AExp -> BExp
 | beqlessthan : AExp -> AExp -> BExp
 | bgreaterthan : AExp -> AExp -> BExp
 | beqgreaterthan : AExp -> AExp -> BExp
 | bnot : BExp -> BExp
 | band : BExp -> BExp -> BExp
 | bor : BExp -> BExp -> BExp
 | bequal : AExp -> AExp -> BExp.

Coercion bvar : string >-> BExp.

Notation "A <' B" := (blessthan A B) (at level 53).
Notation "A <=' B" := (beqlessthan A B) (at level 53).
Notation "A >' B" := (bgreaterthan A B) (at level 53).
Notation "A >=' B" := (beqgreaterthan A B) (at level 53).
Notation "!' A" := (bnot A) (at level 50, left associativity).
Notation "A &&' B" := (band A B) (at level 51, left associativity).
Notation "A ||' B" := (bor A B) (at level 52, left associativity).
Notation "A ==' B" := (bequal A B) (at level 54, left associativity).
Check berror.
Check btrue.
Check bfalse.
Check (!' "a").
Check (!' btrue).
Check ("a" <' "b").
Check ("a" <=' "b").
Check ("a" >' "b").
Check ("a" >=' "b").
Check ("a" &&' bfalse).
Check ("a" ||' "b").

(* Pentru expresii cu siruri de caractere *)

Inductive CExp :=
 | null : CExp
 | cuvant : ErrorString -> CExp.

Coercion cuvant : ErrorString >-> CExp.
Scheme Equality for CExp.

(* Functii stringuri *)

Definition append_s (c1 c2 : ErrorString) : ErrorString :=
  match c1, c2 with
    | error_string, _ => error_string
    | _, error_string => error_string
    | char c1, "" => error_string
    | "", char c2 => error_string
    | char c1, char c2 => char (append c1 c2)
  end.

Compute append "asd" "asd".
Compute append_s "asd" "asd".
Compute eqb "asd" "asd".

Definition equal_s (c1 c2 : ErrorString) : ErrorBool :=
  match c1, c2 with
    | error_string, _ => error_bool
    | _, error_string => error_bool
    | char c1, char c2 => bul (eqb c1 c2)
  end.

Compute length "asd".

Definition strlen_s (c1 : ErrorString) : ErrorNat :=
  match c1 with
    | error_string => error_nat
    | char c1 => num (length c1)
  end.

Compute strlen_s "asd".

Notation " A =s= B " := (equal_s A B) (at level 30).
Notation " 'strlen' ( A ) " := (strlen_s A) (at level 31).
Notation " A +s+ B " := (append_s A B) (at level 32).

Check strlen ( "abc" ).
Compute strlen ( "abc" ).
Compute "abc" =s= "abc".
Compute "abc" =s= "abcd".
Compute "te" +s+ " pup".

(* Functii castare *)

Definition b_to_str (b : bool) : ErrorString :=
  match b with
  | true => "true"
  | false => "false"
  end.

Notation "'(b_char)' { A }" := (b_to_str A)( at level 35).

Compute ((b_char) { true }).
Compute ((b_char) { false }).

Definition n_to_str (n : nat) : ErrorString :=
  match n with
  | 0 => "zero"
  | 1 => "unu"
  | 2 => "doi"
  | 3 => "trei"
  | 4 => "patru"
  | 5 => "cinci"
  | 6 => "sase"
  | 7 => "sapte"
  | 8 => "opt"
  | 9 => "noua"
  | _ => "numar din doua cifre"
  end.

Notation "'(n_char)' { A }" := (n_to_str A)( at level 35).

Compute ((n_char) { 5 }).
Compute ((n_char) { 11 }).

(* Definirea tipului pentru vectori cu ajutorul listelor*)

Inductive Vector :=
 | Error_vector : Vector
 | Nat_vector : nat -> list ErrorNat -> Vector
 | Bool_vector : nat -> list ErrorBool -> Vector
 | String_vector : nat -> list ErrorString -> Vector.

Check Nat_vector.

(* Statementuri *)

Inductive Stmt :=
 | nada : Stmt
 | nat_decl : string -> Stmt
 | nat_assign : string -> AExp -> Stmt
 | bool_decl : string -> Stmt
 | bool_assign : string -> BExp -> Stmt
 | string_decl : string -> Stmt
 | string_assign : string -> CExp -> Stmt
 | sequence : Stmt -> Stmt -> Stmt
 | nat_decl_vector : string -> Vector -> Stmt
 | nat_assign_vector : string -> Vector -> Stmt
 | bool_decl_vector : string -> Vector -> Stmt
 | bool_assign_vector : string -> Vector -> Stmt
 | string_decl_vector : string -> Vector -> Stmt
 | string_assign_vector : string -> Vector -> Stmt
 | while : BExp -> Stmt -> Stmt
 | ifthenelse : BExp -> Stmt -> Stmt -> Stmt
 | ifthen : BExp -> Stmt -> Stmt
 | break : Stmt
 | continue : Stmt
 | fct_declare : string -> Stmt -> Stmt -> Stmt
 | fct_call : string -> Stmt
 | switch : AExp -> AExp -> Stmt -> AExp -> Stmt -> Stmt -> Stmt.

Notation "'unsigned' X" := (nat_decl X)(at level 80).
Notation "'bool' X" := (bool_decl X)(at level 80).
Notation "'char' X" := (string_decl X)(at level 80).

Notation "V [ N ]n" := ( nat_decl_vector V num N)(at level 40).
Notation "V [ N ]b" := ( bool_decl_vector V num N)(at level 40).
Notation "V [ N ]s" := ( string_decl_vector V num N)(at level 40).

Notation "V [ N ]n={ E1 ; E2 ; .. ; En }" := ( nat_assign_vector V ( Nat_vector N (cons num(E1) (cons num(E2) .. (cons num(En) nil) ..) ) ) )(at level 40).
Notation "V [ N ]b={ E1 ; E2 ; .. ; En }" := ( bool_assign_vector V ( Bool_vector N (cons bul(E1) (cons bul(E2) .. (cons bul(En) nil) ..) ) ) )(at level 40).
Notation "V [ N ]s={ E1 ; E2 ; .. ; En }" := ( string_assign_vector V ( String_vector N (cons string(E1) (cons string(E2) .. (cons string(En) nil) ..) ) ) )(at level 40).

Notation "X :n= A" := (nat_assign X A)(at level 80).
Notation "X :b= A" := (bool_assign X A)(at level 80).
Notation "X :s= A" := (string_assign X A)(at level 80).

Notation "S1 ;; S2" := (sequence S1 S2)(at level 93).

Notation "'if'' B 'then'' S1 'end''" := (ifthen B S1)(at level 83).
Notation "'if'' B 'then'' S1 'else'' S2 'end''" := (ifthenelse B S1 S2)(at level 83).
Notation "'for' ( A ~ B ~ C ) { S }" := (A ;; while B  (S ;; C )) (at level 97).
Notation "'while'' ( B ) { S }" := (while B S) (at level 83).

Notation " 'switch' A 'inceput' 'case' a1 'sf' s1 'sfarsit' 'case' a2 'sf' s2 'sfarsit' 'default' s3 'sfarsit' " := (switch A a1 s1 a2 s2 s3) (at level 97).

Notation " 'declare' X S1 'begin' { S2 } 'endf' " := (fct_declare X S1 S2)(at level 78).
Notation " 'call' X 'endcall'" := (fct_call X)(at level 68).

Check (unsigned "a").
Check ("a" :n= 3).

Check (bool "a").
Check ("a" :b= bfalse).

Check (char "c").
Check ("c" :s= "abc").

Check (

unsigned "a";;
unsigned "b";;
unsigned "sum";;
"sum" :n= 0;;
"a" :n= 1;;
"b" :n= 5;;
char "rasp";;

if' ("a" <=' "b") then'
  "rasp" :s= "a este mai mic sau egal cu b"
else'
  "rasp" :s= "a este mai mare decat b"
end'
).

Check ( switch "x" +' "y" inceput
          case 7 sf "z" :n= 7 sfarsit
          case 10 sf "z" :n= 10 sfarsit
          default "z" :n= 0 sfarsit  ).

Check (

unsigned "x";;
unsigned "y";;
"x" :n= 1;;
"y" :n= 4;;
while' ( "x" <' "y" ) {
  "x" :n= "x" +' 1;;
  if' ("x" ==' 2 ) then'
      break
  end'
}
).

Check (
declare "fun" unsigned "a"
  begin
    {
      unsigned "b" ;;
      "b" :n= ("a" *' 10)
}endf
).

Check (call "fnct" endcall ).

Inductive Tipuri :=
 | error_undecl : Tipuri (* Sa nu folosesc variabile nedeclarate *)
 | error_assign : Tipuri (* Sa nu atribui valori de alt tip decat tipul variabilei *)
 | default : Tipuri (* O valoare default care se pune in variabile la declarere *)
 | tip_nat : ErrorNat -> Tipuri
 | tip_bul : ErrorBool -> Tipuri
 | tip_string : ErrorString -> Tipuri
 | code : Stmt -> Tipuri.

Check tip_nat.
Check tip_string.
Check tip_bul.
Check Tipuri.

Coercion tip_nat : ErrorNat >-> Tipuri.
Coercion tip_bul : ErrorBool >-> Tipuri.
Coercion tip_string : ErrorString >-> Tipuri.

Definition Egalitate_tipuri (t1 : Tipuri)(t2 : Tipuri) : bool :=
 match t1 with
 | error_assign => match t2 with
                   | error_assign => true
                   | _ => false
                   end
 | error_undecl => match t2 with
                   | error_undecl => true
                   | _ => false
                   end
 | default => match t2 with
                   | default => true
                   | _ => false
                   end
 | tip_nat x => match t2 with
                   | tip_nat x => true
                   | _ => false
                   end
 | tip_bul x => match t2 with
                   | tip_bul x => true
                   | _ => false
                   end
 | tip_string x => match t2 with
                   | tip_string x => true
                   | _ => false
                  end
 | code x => match t2 with
                   | code x => true
                   | _ => false
                  end
end.

Check Egalitate_tipuri.
Check tip_nat.


Require Import String Ensembles.
Require Import Common.
Require Import Computation.Core Computation.Monad Computation.SetoidMorphisms Computation.Refinements.Tactics.

(** General Lemmas about the behavior of [computes_to], [refine], and
    [refineEquiv]. *)

Local Arguments impl _ _ / .

Section general_refine_lemmas.

  Lemma refine_under_bind {A B}
  : forall c (x y : A -> Comp B),
      (forall a, computes_to c a -> refine (x a) (y a))
      -> refine (a <- c; x a) (a <- c; y a).
  Proof. t_refine. Qed.

  Lemma refineEquiv_is_computational {A} {c} (CompC : @is_computational A c)
  : @refineEquiv _ c (ret (is_computational_val CompC)).
  Proof.
    unfold refineEquiv, refine.
    pose proof (is_computational_val_computes_to CompC).
    t_refine.
  Qed.

  Lemma refine_pick A (P : A -> Prop) c (H : forall x, c ↝ x -> P x)
  : @refine A ({x : A | P x })%comp
            c.
  Proof. t_refine. Qed.

  Lemma refine_pick_val A a (P : A -> Prop)
  : P a -> @refine A ({x | P x })%comp
                   (ret a).
  Proof.
    t_refine.
  Qed.

  Lemma refine_bind_pick :
    forall (A B : Type) (P : Ensemble A),
    forall x y : A -> Comp B,
      (forall a, P a -> refine (x a) (y a)) ->
      refine (a <- {a | P a};
              x a)
             (a <- {a | P a};
              y a).
  Proof. t_refine. Qed.

  Lemma refine_pick_pick A (P1 P2 : A -> Prop)
        (H : forall x, P2 x -> P1 x)
  : @refine _
            { x : A | P1 x }%comp
            { x : A | P2 x }%comp.
  Proof. t_refine. Qed.

  Lemma refineEquiv_pick_pick A (P1 P2 : A -> Prop)
        (H : forall x, P1 x <-> P2 x)
  : @refineEquiv _
                 { x : A | P1 x }%comp
                 { x : A | P2 x }%comp.
  Proof. t_refine. Qed.

  Lemma refineEquiv_pick_pair A B (PA : A -> Prop) (PB : B -> Prop)
  : @refineEquiv _
                 { x : A * B | PA (fst x) /\ PB (snd x) }%comp
                 (a <- { a : A | PA a };
                  b <- { b : B | PB b };
                  ret (a, b))%comp.
  Proof. t_refine. Qed.

  Lemma refineEquiv_pick_pair_fst_dep A B (PA : A * B -> Prop) (PB : B -> Prop)
  : @refineEquiv _
                 {x | PA x /\ PB (snd x)}%comp
                 (b <- { b | PB b };
                  a <- { a | PA (a, b) };
                  ret (a, b))%comp.
  Proof. t_refine. Qed.

  Lemma refineEquiv_pick_pair_snd_dep A B (PA : A -> Prop) (PB : A * B -> Prop)
  : @refineEquiv _
                 { x | PA (fst x) /\ PB x }%comp
                 (a <- { a | PA a };
                  b <- { b | PB (a, b) };
                  ret (a, b))%comp.
  Proof. t_refine. Qed.

  Lemma refineEquiv_pick_pair_pair A B C
        (PA : A -> Prop) (PB : B -> Prop) (PC : C -> Prop)
  : @refineEquiv _
                 { x | (PA (fst (fst x))
                                   /\ PB (snd (fst x)))
                                   /\ PC (snd x)}%comp
                 (a <- { a | PA a };
                  b <- { b | PB b };
                  c <- { c | PC c };
                  ret (a, b, c))%comp.
  Proof. t_refine. Qed.

  Definition refineEquiv_split_ex A B
             (P : A -> Prop) (P' : A -> B -> Prop)
  : @refineEquiv _
                 { b | exists a, P a /\ P' a b }%comp
                 (a <- { a | P a /\ exists b, P' a b };
                  { b | P' a b })%comp.
  Proof. t_refine. Qed.

  Definition refineEquiv_pick_contr_ret A (P : A -> Prop)
             (x : A) (H : unique P x)
  : @refineEquiv _
                 { y | P y }
                 (ret x).
  Proof. t_refine. Qed.

  Definition refineEquiv_pick_eq
             A (x : A)
  : @refineEquiv _
                 { y | y = x }%comp
                 (ret x).
  Proof. t_refine. Qed.

  Definition refineEquiv_pick_eq' A (x : A)
  : @refineEquiv _ { y | x = y }%comp
                 (ret x).
  Proof. t_refine. Qed.

  Definition refineEquiv_split_func_ex
  : forall A B (P : A -> Prop) (f : A -> B),
      @refineEquiv _ { b | exists a, P a /\ b = f a}%comp
                   (a <- { a | P a};
                    ret (f a))%comp.
  Proof. t_refine. Qed.

  Definition refineEquiv_split_func_ex2
             A A' B (P : A -> Prop) (P' : A' -> Prop)
             (f : A -> A' -> B)
  : refineEquiv { b | exists a, P a /\ exists a', P' a' /\ b = f a a'}
                (a <- { a | P a};
                 a' <- { a' | P' a'};
                 ret (f a a')).
  Proof. t_refine. Qed.

  Definition refineEquiv_split_func_ex2'
             A A' B (P : A -> Prop) (P' : A' -> Prop)
             (f : A -> A' -> B)
  : refineEquiv { b | exists a, P a /\ exists a', P' a' /\ f a a' = b}
                (a <- { a | P a};
                 a' <- { a' | P' a'};
                 ret (f a a')).
  Proof. t_refine. Qed.

  Definition refineEquiv_pick_computes_to A (c : Comp A)
  : refineEquiv { v | c ↝ v } c.
  Proof. t_refine. Qed.

  Definition refine_pick_computes_to A (c : Comp A)
  : refine { v | c ↝ v } c.
  Proof. t_refine. Qed.

  Lemma split_refineEquiv_fst_proj1_sig A B P Q
  : refineEquiv { x : { x : A * B | P x } | Q (fst (proj1_sig x)) }
                (x <- { x : A | Q x };
                 y <- { y : B | P (x, y) };
                 pf <- { pf : P (x, y) | True };
                 ret (exist P _ pf)).
  Proof. t_refine. Qed.

  Definition split_refine_fst_proj1_sig A B P Q
    := proj1 (@split_refineEquiv_fst_proj1_sig A B P Q).

  Lemma split_refineEquiv_snd_proj1_sig A B P Q
  : refineEquiv { x : { x : A * B | P x } | Q (snd (proj1_sig x)) }
                (x <- { x : B | Q x };
                 y <- { y : A | P (y, x) };
                 pf <- { pf : P (y, x) | True };
                 ret (exist P _ pf)).
  Proof. t_refine. Qed.

  Definition refineEquiv_pick_computes_to_and A (c : Comp A)
             (P : Ensemble A)
  : refineEquiv { v | c ↝ v /\ P v}
                (v <- c;
                 { a | a = v /\ P a}).
  Proof. t_refine. Qed.

  Definition split_refine_snd_proj1_sig A B P Q
    := proj1 (@split_refineEquiv_snd_proj1_sig A B P Q).

  Lemma split_refineEquiv_proj1_sig A P Q
  : refineEquiv { x : { x : A | P x } | Q (proj1_sig x) }
                (x <- { x | P x /\ Q x };
                 p <- { _ : P x | True };
                 ret (exist P x p)).
  Proof. t_refine. Qed.

  Lemma refineEquiv_pick_forall_eq
        A B (a : A) (P : A -> B -> Prop)
  : @refineEquiv _
                 (Pick (fun b => forall a', a = a' -> P a' b))
                 (Pick (P a)).
  Proof. t_refine. Qed.

  Lemma refine_if_bool_eta :
    forall (u : bool),
    refine (if u then (ret true) else (ret false))
           (ret u).
  Proof. destruct u; reflexivity. Qed.

  Open Scope comp.

  Lemma refinement_step {A} (c c' : Comp A) :
    refine c c'
    -> Refinement of c'
    -> Refinement of c.
  Proof.
    intros refine_c_c' Refinement_c'.
    destruct Refinement_c' as [c'' refine_c'_c''].
    intros; econstructor.
    etransitivity; eassumption.
  Defined.

  Lemma refine_pick_forall_Prop
        A B C (a : A) (Q : C -> A -> Prop) (P : A -> C -> B -> Prop)
        b
  :
    (forall c, Q c a -> refine (Pick (P a c)) b) ->
    @refine B (Pick (fun b' => forall c, Q c a -> P a c b')) b.
  Proof.
    unfold refine; intros; econstructor; intros.
    generalize (H _ H1 _ H0); intros.
    inversion_by computes_to_inv; assumption.
  Qed.

  Lemma refine_pick_eq_ex_bind {A B : Type}
        (P : A -> B -> Prop)
        (a : A)
  : refine (a' <- {a' | a' = a /\ exists b, P a' b};
            {b | P a' b})
           {b | P a b}.
  Proof.
    unfold refine; intros; inversion_by computes_to_inv;
    econstructor; eauto.
  Qed.

  Lemma refineEquiv_if A :
    forall (f : bool -> Comp A) (b : bool) ta ea,
      refineEquiv (f true) ta
      -> refineEquiv (f false) ea
      -> refineEquiv (f b) (if b then ta else ea).
  Proof.
    destruct b; simpl; auto.
  Qed.

  Lemma refine_if A :
    forall (c : Comp A) (b : bool) ta ea,
      (b = true -> refine c ta)
      -> (b = false -> refine c ea)
      -> refine c (if b then ta else ea).
  Proof.
    destruct b; simpl; auto.
  Qed.

  Lemma refineEquiv_Pick_if {A B}
        (P : A -> B -> Prop) :
    forall (cond : bool) (ta ea : A) ta' ea',
      refineEquiv {b | P ta b} ta'
      -> refineEquiv {b | P ea b} ea'
      -> refineEquiv {b | P (if cond then ta else ea) b}
                (if cond then ta' else ea').
  Proof.
    intros; setoid_rewrite refineEquiv_if with
            (f := fun cond : bool => {b : B | P (if cond then ta else ea) b}); eauto.
    reflexivity.
  Qed.

  Lemma refineEquiv_if_ret {A}
  : forall (cond : bool) (ta ea : A),
      refineEquiv (ret (if cond then ta else ea))
                  (if cond then ret ta else ret ea).
  Proof.
    split; destruct cond; reflexivity.
  Qed.

  Definition refine_split_ex A B
             (P : A -> Prop) (P' : A -> B -> Prop)
  : @refine _
            { b | exists a, P a /\ P' a b }%comp
            (a <- { a | P a};
             { b | P' a b })%comp.
    Proof.
      t_refine.
    Qed.

  Definition refineEquiv_pick_ex_computes_to_and A B
             (c : Comp A)
             (P : A -> B -> Prop)
  : refineEquiv { b | exists a, c ↝ a /\ P a b}
                (a <- c;
                 { b | P a b}).
  Proof. t_refine. Qed.

  Definition refineEquiv_pick_ex_computes_to_bind_and A B D
             (c : B -> Comp A)
             (cB : Comp B)
             (P : A -> D -> Prop)
  : refineEquiv { d | exists a, (b <- cB; c b) ↝ a /\ P a d}
                (b <- cB;
                 { d | exists a, c b ↝ a /\ P a d}).
  Proof. t_refine. Qed.

  Lemma refine_Pick_If_Then_Opt {A B}
  : forall (P : Ensemble B) (c e : Comp A) (t : B -> Comp A),
      (forall b, P b -> refine c (t b))
      -> (refine c e)
      -> refine c
                (b <- {b | forall b',
                             (b = Some b' -> P b')};
                 Ifopt b as b' Then t b' Else e).
  Proof.
    unfold refine; intros; apply computes_to_inv in H1; destruct_ex; intuition.
    destruct x; inversion_by computes_to_inv; eauto.
  Qed.

  Lemma refine_Pick_Some_dec {A B}
  : forall (P : Ensemble B) (c e : Comp A) (t : B -> Comp A),
      (forall b, P b -> refine c (t b))
      -> ((forall b, ~ P b) -> refine c e)
      -> refine c
                (b <- {b | forall b',
                             (b = Some b' -> P b')
                             /\ (b = None -> forall b', ~ P b')};
                 Ifopt b as b' Then t b' Else e) .
  Proof.
    unfold refine; intros; apply computes_to_inv in H1; destruct_ex; intuition.
    destruct x; inversion_by computes_to_inv; eauto.
  Qed.

  Definition decides (b : bool) (P : Prop)
    := if b then P else ~ P.

  Lemma refine_pick_decides {A}
  : forall (P : Prop) (c e : Comp A) (t : Comp A),
    (P -> refine c t)
    -> (~ P -> refine c e)
    -> refine c
         (b <- {b | decides b P};
          if b then t else e).
  Proof.
    unfold refine; intros; apply_in_hyp computes_to_inv;
    destruct_ex; split_and; inversion_by computes_to_inv.
    destruct x; simpl in *; eauto.
  Qed.

  Lemma refine_pick_decides' {A}
        (P : Prop)
        (Q Q' : Ensemble A)
  : refine {a | (P -> Q a) /\
                (~ P -> Q' a)}
           (b <- {b | decides b P};
            if b then
            {a | Q a}
            else
              {a | Q' a}).
  Proof.
    eapply refine_pick_decides;
    unfold refine; intros; apply_in_hyp computes_to_inv;
    econstructor; intuition.
  Qed.

  Lemma refine_If_Then_Else_Bind {A B}
  : forall i (t e : Comp A) (b : A -> Comp B),
      refine (a <- If i Then t Else e; b a)
             (If i Then (a <- t;
                         b a)
                   Else (a <- e;
                         b a)).
  Proof.
      intros; destruct i; simpl; reflexivity.
  Qed.

  Lemma refine_If_Opt_Then_Else_Bind {A B C}
  : forall (i : option A)
           (t : A -> Comp B)
           (e : Comp B)
           (c : B -> Comp C),
      refine (b <- If_Opt_Then_Else i t e; c b)
             (If_Opt_Then_Else i (fun a' =>
                                      b <- t a';
                                  c b)
                               (b <- e;
                                c b)).
  Proof.
    intros; destruct i; simpl; reflexivity.
  Qed.

End general_refine_lemmas.

Tactic Notation "finalize" "refinement" :=
  eexists; solve [ reflexivity | eapply reflexivityT ].

Tactic Notation "refine" "using" constr(refinement_rule) :=
  eapply refinement_step;
  [progress setoid_rewrite refinement_rule; try reflexivity | ].

(* 'Wrapper' tactics for various refinements *)

Tactic Notation "refine" "pick" "pair" :=
  rewrite refine_pick_pick;
  [ |
    let x := fresh in
    let H := fresh in
    intros x H;
      let A := match goal with
                   |- ?A /\ ?B => constr:(A)
               end in
      let B := match goal with
                   |- ?A /\ ?B => constr:(B)
               end in
      match eval pattern (fst x) in A with
          ?A' _ =>
          match eval pattern (snd x) in B with
              ?B' _ =>
              match type of H with
                | ?C _ => unify C (fun x => A' (fst x) /\ B' (snd x));
                         exact H
              end
          end
      end ]; rewrite refineEquiv_pick_pair.

  Tactic Notation "refine" "pick" "val" open_constr(v) :=
    let T := type of v in
    rewrite refine_pick_val with
    (A := T)
      (a := v).

  Tactic Notation "refine" "pick" "eq" :=
    match goal with
      | |- context[Pick (fun x => x = _)] =>
        setoid_rewrite refineEquiv_pick_eq
      | |- context[Pick (fun x => _ = x)] =>
        setoid_rewrite refineEquiv_pick_eq'
    end.


Require Export Basics.

Require Export EnvListAux7.
Require Export EnvListAuxT1.

Require Export Coq.Program.Equality.
Require Import Coq.Init.Specif.
Require Import Coq.Arith.PeanoNat.
Require Import Omega.
Require Import Coq.Lists.List.
Require Import Coq.Logic.ProofIrrelevance.

Require Import TPipStaticM2.
Require Import TPipDynamicM2.
Require Import TRInductM2.
Require Import WeakM2.
Require Import TSoundnessRM2.

Require Import Coq.Logic.EqdepFacts.

Module Determinism (IdT: IdModType) <: IdModType.
(* Export IdT. *)

Definition Id := IdT.Id.
Definition IdEqDec := IdT.IdEqDec.
Definition IdEq := IdT.IdEq.
Definition W := IdT.W.
Definition Loc_PI := IdT.Loc_PI.
Definition BInit := IdT.BInit.
Definition WP := IdT.WP.

Module TSoundnessRC := TSoundnessR IdT.
Export TSoundnessRC.

Definition UniqueEStep
                     (fenv: funEnv) (env: valEnv)
                     (n n1 n2: W) (e e1 e2: Exp) :=
    EStep fenv env (Conf Exp n e) ((Conf Exp n1 e1)) ->
    EStep fenv env (Conf Exp n e) ((Conf Exp n2 e2)) ->
        (n1 = n2) /\ (e1 = e2).

Definition UniquePStep
                     (fenv: funEnv) (env: valEnv)
                     (n n1 n2: W) (ps ps1 ps2: Prms) :=
    PrmsStep fenv env (Conf Prms n ps) ((Conf Prms n1 ps1)) ->
    PrmsStep fenv env (Conf Prms n ps) ((Conf Prms n2 ps2)) ->
        (n1 = n2) /\ (ps1 = ps2).

Definition UniqueQFStep
                         (fenv: funEnv)
                         (n n1 n2: W) (q q1 q2: QFun) :=
    QFStep fenv (Conf QFun n q) ((Conf QFun n1 q1)) ->
    QFStep fenv (Conf QFun n q) ((Conf QFun n2 q2)) ->
        (n1 = n2) /\ (q1 = q2).

Definition UniqueQVStep
                         (env: valEnv)
                         (n n1 n2: W) (q q1 q2: QValue) :=
    QVStep env (Conf QValue n q) ((Conf QValue n1 q1)) ->
    QVStep env (Conf QValue n q) ((Conf QValue n2 q2)) ->
        (n1 = n2) /\ (q1 = q2).

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

Definition DPar_E :=
  fun (ftenv: funTC) (tenv: valTC) (fenv: funEnv)
      (e: Exp) (t: VTyp)
      (p: ExpTyping ftenv tenv fenv e t) =>
  FEnvTyping fenv ftenv ->
  forall (env: valEnv),
    EnvTyping env tenv ->
  forall (n n1 n2: W) (e1 e2: Exp),
         UniqueEStep fenv env n n1 n2 e e1 e2.

Definition DPar_P :=
  fun (ftenv: funTC) (tenv: valTC) (fenv: funEnv)
                (ps: Prms) (pt: PTyp)
                (p: PrmsTyping ftenv tenv fenv ps pt) =>
  FEnvTyping fenv ftenv ->
  forall (env: valEnv),
    EnvTyping env tenv ->
    forall (n n1 n2: W) (ps1 ps2: Prms),
          UniquePStep fenv env n n1 n2 ps ps1 ps2.

Definition DPar_F := fun (f: Fun) (ft: FTyp)
   (p: FunTyping f ft) =>
   (forall (fps: valTC) (t: VTyp),
    ft = FT fps t ->
    forall (i: nat) (fenv': funEnv)
           (x: Id) (e0 e1: Exp),
       f = FC fenv' fps e0 e1 x i ->
       forall (n: W) (env: valEnv),
       EnvTyping env fps ->
       match i with
         | 0 => forall (n1 n2: W) (e01 e02: Exp),
                  UniqueEStep fenv' env n n1 n2 e0 e01 e02
         | S j => forall (n1 n2: W) (e11 e12: Exp),
                  UniqueEStep (updateE fenv' x (FC fenv' fps e0 e1 x j))
                                 env n n1 n2 e1 e11 e12
        end).

Definition DPar_Q :=
   fun (ftenv: funTC) (fenv: funEnv)
          (qf: QFun) (ft: FTyp)
   (p: QFunTyping ftenv fenv qf ft) =>
   FEnvTyping fenv ftenv ->
   forall (n n1 n2: W) (qf qf1 qf2: QFun),
   UniqueQFStep fenv n n1 n2 qf qf1 qf2.

Definition ExpTypingDet_rect :=
  ExpTyping_str_rect
         DPar_F DPar_Q DPar_E DPar_P.

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

Definition UniqueVal
                     (fenv: funEnv) (env: valEnv)
                     (n n1: W) (e: Exp) (v1: Value) :=
  forall (n2: W) (v2: Value),
     EClosure fenv env (Conf Exp n e) ((Conf Exp n2 (Val v2))) ->
        (n2 = n1) /\ (v2 = v1).

Definition UniquePVal
                      (fenv: funEnv) (env: valEnv)
                      (n n1: W) (ps: Prms) (vs1: list Exp) :=
  forall (n2: W) (vs2: list Exp),
    isValueList vs1 ->
    isValueList vs2 ->
    PrmsClosure fenv env (Conf Prms n ps)
                              ((Conf Prms n2 (PS vs2))) ->
        (n2 = n1) /\ (vs2 = vs1).

Lemma QVDeterminism :
  forall (env: valEnv) (n n1 n2: W) (q q1 q2: QValue),
    QVStep env (Conf QValue n q) ((Conf QValue n1 q1)) ->
    QVStep env (Conf QValue n q) ((Conf QValue n2 q2)) ->
        (n1 = n2) /\ (q1 = q2).
Proof.
  intros.
  inversion X0; subst.
  inversion X; subst.
  inversion X1; subst.
  inversion X2; subst.
  rewrite H in H0.
  inversion H0; subst.
  auto.
Defined.

Lemma QFDeterminism :
  forall (fenv: funEnv) (n n1 n2: W) (qf qf1 qf2: QFun),
         UniqueQFStep fenv n n1 n2 qf qf1 qf2.
Proof.
  intros.
  unfold UniqueQFStep.
  intros.
  inversion X; subst.
  inversion X0; subst.
  inversion X1; subst.
  inversion X2; subst.
  rewrite H in H0.
  inversion H0; subst.
  auto.
Defined.

Lemma deterAux1 (n1 n2: W) (v1 v2: Value) (e3 e4 e5 e6: Exp) :
  Conf Exp n1 (IfThenElse (Val v1) e3 e4) =
  Conf Exp n2 (IfThenElse (Val v2) e5 e6) ->
  v1 = v2.
  intros.
  inversion H; subst.
  auto.
 Defined.

Lemma deterAux2 (n1 n2: W) (e1 e2 e3 e4 e5 e6: Exp) :
  Conf Exp n1 (IfThenElse e1 e3 e4) =
  Conf Exp n2 (IfThenElse e2 e5 e6) ->
  e1 = e2.
  intros.
  inversion H; subst.
  auto.
 Defined.

Lemma ExpDeterminism :
  forall (ftenv: funTC) (tenv: valTC) (fenv: funEnv)
         (e: Exp) (t: VTyp),
      ExpTyping ftenv tenv fenv e t ->
      FEnvTyping fenv ftenv ->
  forall (env: valEnv),
    EnvTyping env tenv ->
  forall (n n1 n2: W) (e1 e2: Exp),
         UniqueEStep fenv env n n1 n2 e e1 e2.

Proof.
eapply ExpTypingDet_rect.
- (* SLL *)
  unfold Par_SSL, DPar_E.
  unfold UniqueEStep.
  constructor.
- (* SLL *)
  unfold Par_SSL, DPar_E.
  intros.
  constructor.
  assumption.
  assumption.
  assumption.
- (* SSA *)
  unfold Par_SSA, DPar_F.
  constructor.
- unfold Par_SSA, DPar_F.
  intros.
  constructor.
  assumption.
  assumption.
  assumption.
- (* SSB *)
  unfold Par_SSB, Par_SSA, DPar_F.
  intros.
  econstructor.
  exact m0.
  exact m1.
  assumption.
  assumption.
  assumption.
  assumption.
  assumption.
  assumption.
- (* Par_F *)
  unfold DPar_E, DPar_F.
  intros.
  inversion H0; subst.
  inversion H1; subst.
  intros.
  eauto.
- (* Par_F *)
  unfold DPar_E, DPar_F.
  intros ftenv ftenv' tenv fenv fenv'.
  intros e0 e1 x n t.
  intros E1 E2 K1 K2 K3 HP1 HP2.
  intros fps t0 E3.
  intros i fenv1 x0 e2 e3 E4 n0 env H.
  inversion E3; subst.
  inversion E4; subst.
  eapply HP1.
  eapply updateFEnvLemma.
  assumption.
  assumption.
  assumption.
- (* Par_Q - QF *)
  unfold DPar_F, DPar_Q.
  intros.
  eapply QFDeterminism.
- (* Par_Q - FVar *)
  unfold DPar_F,  DPar_Q.
  intros.
  eapply QFDeterminism.
- (* modify *)
  unfold DPar_E.
  unfold UniqueEStep.
  intros ftenv tenv fenv T1 T2 VT1 VT2 XF q K H0 env H0'.
  intros n n1 n2 e1 e2.
  intros.
  inversion X; subst.
  assert (VT4 = VT1).
  eapply loc_pi.
  subst.
  assert (VT5 = VT2).
  eapply loc_pi.
  subst.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  clear XF2.
  inversion X0; subst.
  eapply inj_pair2 in H8; subst.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  auto.
  inversion X1; subst.
  assert (VT4 = VT1).
  eapply loc_pi.
  subst.
  assert (VT5 = VT2).
  eapply loc_pi.
  subst.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  clear XF2.
  inversion X0; subst.
  clear XF2.
  clear VT4.
  clear VT5.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  inversion X1; subst.
  assert (VT4 = VT1).
  eapply loc_pi.
  subst.
  assert (VT5 = VT2).
  eapply loc_pi.
  subst.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  inversion X1; subst.
  inversion X2; subst.
  inversion X3; subst.
  inversion X4; subst.
  rewrite H in H1.
  inversion H1; subst.
  auto.
  (* return *)
- unfold DPar_E.
  unfold UniqueEStep.
  intros G ftenv tenv fenv q t k1.
  intros H0 env H0'.
  intros n n1 n2 e1 e2.
  intros X X0.
  inversion X; subst.
  inversion X0; subst.
  auto.
  inversion X1; subst.
  inversion X1; subst.
  inversion X0; subst.
  inversion X3; subst.
  inversion X2; subst.
  inversion X4; subst.
  rewrite H in H1.
  inversion H1; subst.
  auto.
(* bindN *)
- unfold DPar_E.
  unfold UniqueEStep.
  intros ftenv tenv fenv e1 e2 t1 t2 K1 K2 HP1 HP2 H0 env H0'.
  intros n n1 n2 e0 e3.
  intros.
  inversion X; subst.
  + inversion X0; subst.
    * auto.
    * inversion X1.
  + inversion X0; subst.
    * inversion X1.
    * rename e1'0 into e2'.
      assert (n1 = n2 /\ e1' = e2').
      eapply HP1.
      assumption.
      eassumption.
      eassumption.
      assumption.
      destruct H.
      rewrite H1.
      auto.
(* bindS *)
- unfold DPar_E.
  unfold UniqueEStep.
  intros ftenv tenv tenv' fenv x e1 e2 t1 t2.
  intros E K1 K2 HP1 HP2 H0 env H0'.
    intros n n1 n2 e0 e3.
    intros.
    inversion X; subst.
    + inversion X0; subst.
      * auto.
      * inversion X1.
    + inversion X0; subst.
      * inversion X1.
      * rename e1'0 into e2'.
        assert (n1 = n2 /\ e1' = e2').
        eapply HP1.
        assumption.
        eassumption.
        eassumption.
        assumption.
        destruct H.
        rewrite H1.
        auto.
(* bindMS *)
  - unfold DPar_E.
    unfold UniqueEStep.
    intros ftenv ftenvP ftenv' tenv tenvP tenv' fenv fenvP fenv' envP.
    intros e t.
    intros K1 K2 K3 K4 K5 K6 K7 HP.
    intros H0 env H0'.
    intros n n1 n2 e1 e2.
    intros.
    inversion X; subst.
    + inversion X0; subst.
      * auto.
      * inversion X1.
    + inversion X0; subst.
      inversion X1.
      rename e'0 into e''.
      assert (n1 = n2 /\ e' = e'').
      eapply HP.
      eapply overrideEnvLemmaT.
      assumption.
      assumption.
      eapply overrideEnvLemmaT.
      eassumption.
      eassumption.
      eassumption.
      assumption.
      destruct H.
      rewrite H1.
      auto.
(* apply *)
  - unfold DPar_P, DPar_Q, DPar_E.
    unfold UniqueEStep.
    unfold UniqueQFStep.
    unfold UniquePStep.
    intros ftenv tenv fps fenv.
    intros q ps pt t.
    intros K1 K2 K3 K4 HP1 HP2.
    intros H0 env H0'.
    intros n n1 n2 e1 e2.
    intros.
    inversion X; subst.
    + inversion X0; subst.
      * inversion H6; subst.
        inversion H5; subst.
        eapply vlaMapEq in H.
        rewrite H.
        auto.
      * destruct ps'.
        eapply NoPrmsStep in X1.
        intuition X1.
        apply isValueList2IsValueT in H6.
        assumption.
      * inversion X1.
    + inversion X0; subst.
      * inversion H6; subst.
        inversion H5; subst.
        eapply vlaMapEq in H.
        rewrite H.
        auto.
      * destruct ps'.
        eapply NoPrmsStep in X1.
        intuition X1.
        apply isValueList2IsValueT in H6.
        assumption.
      * inversion X1.
    + inversion X0; subst.
      * destruct ps'.
        eapply NoPrmsStep in X1.
        intuition X1.
        apply isValueList2IsValueT in H6.
        assumption.
      * destruct ps'.
        eapply NoPrmsStep in X1.
        intuition X1.
        apply isValueList2IsValueT in H6.
        assumption.
      * rename ps'0 into ps''.
        assert (n1 = n2 /\ ps' = ps'').
        eapply HP2.
        assumption.
        eassumption.
        eassumption.
        assumption.
        destruct H.
        rewrite H1.
        auto.
      * inversion X2.
    + inversion X0; subst.
      * inversion X1.
      * inversion X1.
      * inversion X1.
      * rename qf'0 into qf''.
        assert (n1 = n2 /\ qf' = qf'').
        eapply HP1.
        assumption.
        eassumption.
        assumption.
        destruct H.
        rewrite H1.
        auto.
(* val *)
  - unfold DPar_E.
    unfold UniqueEStep.
    intros ftenv tenv fenv.
    intros v t.
    intros K H0 env H0'.
    intros n n1 n2 e1 e2.
    intros.
    inversion X.
  - (* ifthenelse *)
    unfold DPar_E.
    intros.
    unfold UniqueEStep.
    intros.
    inversion X1; subst.
    inversion X2; subst.
    auto.
    eapply deterAux1 in H4.
    unfold cst in H4.
    eapply inj_pair2 in H4.
    inversion H4.
    inversion X2; subst.
    rewrite <- H9.
    rewrite <- H9.
    auto.
    inversion X3.
    inversion X4.
    inversion X2; subst.
    eapply deterAux1 in H4.
    unfold cst in H4.
    eapply inj_pair2 in H4.
    inversion H4.
    auto.
    inversion X3.
    inversion X2; subst.
    inversion X3.
    inversion X1; subst.
    inversion X3.
    rewrite H9 at 2.
    auto.
    inversion X4.
    unfold UniqueEStep in H.
    rename e'0 into e''.
    assert (n1 = n2 /\ e' = e'').
    eapply H.
    assumption.
    eassumption.
    eassumption.
    assumption.
    destruct H2.
    rewrite H2.
    rewrite H3.
    auto.
  - (* SLL *)
    unfold Par_SSL, DPar_P, DPar_E.
    unfold UniquePStep, UniqueEStep.
    intros ftenv tenv fenv.
    intros es ts K HP H0 env H0'.
    intros n n1 n2 ps1 ps2.
    intros.
    revert K.
    dependent induction HP.
    inversion X0.
    intro K.
    inversion X0; subst.
    inversion X; subst.
    rename es'0 into es''.
    assert (n1 = n2 /\ PS es'' = PS es').
    eapply IHHP.
    assumption.
    eassumption.
    eassumption.
    assumption.
    inversion K; subst.
    assumption.
    destruct H.
    inversion H1; subst.
    auto.
    (**)
    inversion X2.
    (**)
    inversion X; subst.
    inversion X1.
    rename e'0 into e''.
    assert (n1 = n2 /\ e'' = e').
    eapply p0.
    assumption.
    eassumption.
    eassumption.
    assumption.
    destruct H.
    rewrite H1.
    auto.
Defined.

Definition PrmsTypingDet_rect :=
  ExpTypingP_str_rect
         DPar_F DPar_Q DPar_E DPar_P.

Lemma PrmsDeterminism :
  forall (ftenv: funTC) (tenv: valTC) (fenv: funEnv)
         (ps: Prms) (pt: PTyp),
      PrmsTyping ftenv tenv fenv ps pt ->
      FEnvTyping fenv ftenv ->
  forall (env: valEnv),
    EnvTyping env tenv ->
  forall (n n1 n2: W) (ps1 ps2: Prms),
         UniquePStep fenv env n n1 n2 ps ps1 ps2.

Proof.
eapply PrmsTypingDet_rect.
- (* SLL *)
  unfold Par_SSL, DPar_E.
  unfold UniqueEStep.
  constructor.
- (* SLL *)
  unfold Par_SSL, DPar_E.
  intros.
  constructor.
  assumption.
  assumption.
  assumption.
- (* SSA *)
  unfold Par_SSA, DPar_F.
  constructor.
- unfold Par_SSA, DPar_F.
  intros.
  constructor.
  assumption.
  assumption.
  assumption.
- (* SSB *)
  unfold Par_SSB, Par_SSA, DPar_F.
  intros.
  econstructor.
  exact m0.
  exact m1.
  assumption.
  assumption.
  assumption.
  assumption.
  assumption.
  assumption.
- (* Par_F *)
  unfold DPar_E, DPar_F.
  intros.
  inversion H0; subst.
  inversion H1; subst.
  intros.
  eauto.
- (* Par_F *)
  unfold DPar_E, DPar_F.
  intros ftenv ftenv' tenv fenv fenv'.
  intros e0 e1 x n t.
  intros E1 E2 K1 K2 K3 HP1 HP2.
  intros fps t0 E3.
  intros i fenv1 x0 e2 e3 E4 n0 env H.
  inversion E3; subst.
  inversion E4; subst.
  eapply HP1.
  eapply updateFEnvLemma.
  assumption.
  assumption.
  assumption.
- (* Par_Q - QF *)
  unfold DPar_F, DPar_Q.
  intros.
  eapply QFDeterminism.
- (* Par_Q - FVar *)
  unfold DPar_F,  DPar_Q.
  intros.
  eapply QFDeterminism.
- (* modify *)
  unfold DPar_E.
  unfold UniqueEStep.
  intros ftenv tenv fenv T1 T2 VT1 VT2 XF q K H0 env H0'.
  intros n n1 n2 e1 e2.
  intros.
  inversion X; subst.
  assert (VT4 = VT1).
  eapply loc_pi.
  subst.
  assert (VT5 = VT2).
  eapply loc_pi.
  subst.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  clear XF2.
  inversion X0; subst.
  eapply inj_pair2 in H8; subst.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  auto.
  inversion X1; subst.
  assert (VT4 = VT1).
  eapply loc_pi.
  subst.
  assert (VT5 = VT2).
  eapply loc_pi.
  subst.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  clear XF2.
  inversion X0; subst.
  clear XF2.
  clear VT4.
  clear VT5.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  inversion X1; subst.
  assert (VT4 = VT1).
  eapply loc_pi.
  subst.
  assert (VT5 = VT2).
  eapply loc_pi.
  subst.
  eapply inj_pair2 in H6.
  eapply inj_pair2 in H6; subst.
  inversion X1; subst.
  inversion X2; subst.
  inversion X3; subst.
  inversion X4; subst.
  rewrite H in H1.
  inversion H1; subst.
  auto.
  (* return *)
- unfold DPar_E.
  unfold UniqueEStep.
  intros G ftenv tenv fenv q t k1.
  intros H0 env H0'.
  intros n n1 n2 e1 e2.
  intros X X0.
  inversion X; subst.
  inversion X0; subst.
  auto.
  inversion X1; subst.
  inversion X1; subst.
  inversion X0; subst.
  inversion X3; subst.
  inversion X2; subst.
  inversion X4; subst.
  rewrite H in H1.
  inversion H1; subst.
  auto.
(* bindN *)
- unfold DPar_E.
  unfold UniqueEStep.
  intros ftenv tenv fenv e1 e2 t1 t2 K1 K2 HP1 HP2 H0 env H0'.
  intros n n1 n2 e0 e3.
  intros.
  inversion X; subst.
  + inversion X0; subst.
    * auto.
    * inversion X1.
  + inversion X0; subst.
    * inversion X1.
    * rename e1'0 into e2'.
      assert (n1 = n2 /\ e1' = e2').
      eapply HP1.
      assumption.
      eassumption.
      eassumption.
      assumption.
      destruct H.
      rewrite H1.
      auto.
(* bindS *)
- unfold DPar_E.
  unfold UniqueEStep.
  intros ftenv tenv tenv' fenv x e1 e2 t1 t2.
  intros E K1 K2 HP1 HP2 H0 env H0'.
    intros n n1 n2 e0 e3.
    intros.
    inversion X; subst.
    + inversion X0; subst.
      * auto.
      * inversion X1.
    + inversion X0; subst.
      * inversion X1.
      * rename e1'0 into e2'.
        assert (n1 = n2 /\ e1' = e2').
        eapply HP1.
        assumption.
        eassumption.
        eassumption.
        assumption.
        destruct H.
        rewrite H1.
        auto.
(* bindMS *)
  - unfold DPar_E.
    unfold UniqueEStep.
    intros ftenv ftenvP ftenv' tenv tenvP tenv' fenv fenvP fenv' envP.
    intros e t.
    intros K1 K2 K3 K4 K5 K6 K7 HP.
    intros H0 env H0'.
    intros n n1 n2 e1 e2.
    intros.
    inversion X; subst.
    + inversion X0; subst.
      * auto.
      * inversion X1.
    + inversion X0; subst.
      inversion X1.
      rename e'0 into e''.
      assert (n1 = n2 /\ e' = e'').
      eapply HP.
      eapply overrideEnvLemmaT.
      assumption.
      assumption.
      eapply overrideEnvLemmaT.
      eassumption.
      eassumption.
      eassumption.
      assumption.
      destruct H.
      rewrite H1.
      auto.
(* apply *)
  - unfold DPar_P, DPar_Q, DPar_E.
    unfold UniqueEStep.
    unfold UniqueQFStep.
    unfold UniquePStep.
    intros ftenv tenv fps fenv.
    intros q ps pt t.
    intros K1 K2 K3 K4 HP1 HP2.
    intros H0 env H0'.
    intros n n1 n2 e1 e2.
    intros.
    inversion X; subst.
    + inversion X0; subst.
      * inversion H6; subst.
        inversion H5; subst.
        eapply vlaMapEq in H.
        rewrite H.
        auto.
      * destruct ps'.
        eapply NoPrmsStep in X1.
        intuition X1.
        apply isValueList2IsValueT in H6.
        assumption.
      * inversion X1.
    + inversion X0; subst.
      * inversion H6; subst.
        inversion H5; subst.
        eapply vlaMapEq in H.
        rewrite H.
        auto.
      * destruct ps'.
        eapply NoPrmsStep in X1.
        intuition X1.
        apply isValueList2IsValueT in H6.
        assumption.
      * inversion X1.
    + inversion X0; subst.
      * destruct ps'.
        eapply NoPrmsStep in X1.
        intuition X1.
        apply isValueList2IsValueT in H6.
        assumption.
      * destruct ps'.
        eapply NoPrmsStep in X1.
        intuition X1.
        apply isValueList2IsValueT in H6.
        assumption.
      * rename ps'0 into ps''.
        assert (n1 = n2 /\ ps' = ps'').
        eapply HP2.
        assumption.
        eassumption.
        eassumption.
        assumption.
        destruct H.
        rewrite H1.
        auto.
      * inversion X2.
    + inversion X0; subst.
      * inversion X1.
      * inversion X1.
      * inversion X1.
      * rename qf'0 into qf''.
        assert (n1 = n2 /\ qf' = qf'').
        eapply HP1.
        assumption.
        eassumption.
        assumption.
        destruct H.
        rewrite H1.
        auto.
(* val *)
  - unfold DPar_E.
    unfold UniqueEStep.
    intros ftenv tenv fenv.
    intros v t.
    intros K H0 env H0'.
    intros n n1 n2 e1 e2.
    intros.
    inversion X.
  - (* ifthenelse *)
    unfold DPar_E.
    intros.
    unfold UniqueEStep.
    intros.
    inversion X1; subst.
    inversion X2; subst.
    auto.
    eapply deterAux1 in H4.
    unfold cst in H4.
    eapply inj_pair2 in H4.
    inversion H4.
    inversion X2; subst.
    rewrite <- H9.
    rewrite <- H9.
    auto.
    inversion X3.
    inversion X4.
    inversion X2; subst.
    eapply deterAux1 in H4.
    unfold cst in H4.
    eapply inj_pair2 in H4.
    inversion H4.
    auto.
    inversion X3.
    inversion X2; subst.
    inversion X3.
    inversion X1; subst.
    inversion X3.
    rewrite H9 at 2.
    auto.
    inversion X4.
    unfold UniqueEStep in H.
    rename e'0 into e''.
    assert (n1 = n2 /\ e' = e'').
    eapply H.
    assumption.
    eassumption.
    eassumption.
    assumption.
    destruct H2.
    rewrite H2.
    rewrite H3.
    auto.
  - (* SLL *)
    unfold Par_SSL, DPar_P, DPar_E.
    unfold UniquePStep, UniqueEStep.
    intros ftenv tenv fenv.
    intros es ts K HP H0 env H0'.
    intros n n1 n2 ps1 ps2.
    intros.
    revert K.
    dependent induction HP.
    inversion X0.
    intro K.
    inversion X0; subst.
    inversion X; subst.
    rename es'0 into es''.
    assert (n1 = n2 /\ PS es'' = PS es').
    eapply IHHP.
    assumption.
    eassumption.
    eassumption.
    assumption.
    inversion K; subst.
    assumption.
    destruct H.
    inversion H1; subst.
    auto.
    (**)
    inversion X2.
    (**)
    inversion X; subst.
    inversion X1.
    rename e'0 into e''.
    assert (n1 = n2 /\ e'' = e').
    eapply p0.
    assumption.
    eassumption.
    eassumption.
    assumption.
    destruct H.
    rewrite H1.
    auto.
Defined.

End Determinism.