(** Realisation of the RCB_resources interface *)
From iris.algebra Require Import agree auth excl gmap.
From aneris.algebra Require Import monotone.
From iris.proofmode Require Import tactics.
From iris.base_logic Require Import invariants.
From aneris.aneris_lang Require Import lang resources.
From aneris.examples.rcb.spec Require Import base.
From aneris.examples.rcb.model Require Import events model_spec.
From aneris.examples.rcb.resources Require Import base.

Section Local_history.

  Context `{!anerisG Mdl Σ, !RCB_params, !internal_RCBG Σ}.

  Section Predicates.

    (* One ghost location per replica *)
    Context (γLs : list gname).

    Definition mk_hst (q : Qp)
                       (h : gset local_event) :
                       prodR fracR (agreeR (gsetO local_event)) :=
      (q, to_agree h).

    (* For some reason we can't write 6%Qp... *)
    Definition one_sixth_qp := (1 / pos_to_Qp 6)%Qp.

    (* Lives in the global invariant *)
    Definition lhst_glob_aux (γ : gname) (s : gset local_event) : iProp Σ :=
      own γ (mk_hst one_sixth_qp s).

    Definition lhst_glob (i : nat) (s : gset local_event) : iProp Σ :=
      ∃ γ, ⌜γLs !! i = Some γ⌝ ∗ lhst_glob_aux γ s.

    (* Lives in the lock invariant *)
    Definition lhst_lock_aux (γ : gname) (s : gset local_event) : iProp Σ :=
      own γ (mk_hst one_sixth_qp s).

    Definition lhst_lock (i : nat) (s : gset local_event) : iProp Σ :=
      ∃ γ, ⌜γLs !! i = Some γ⌝ ∗  lhst_lock_aux γ s.

    (* Given to the user *)
    Definition lhst_user_aux (γ : gname) (s : gset local_event) : iProp Σ :=
      own γ (mk_hst (2/3)%Qp s).

    Definition lhst_user (i : nat) (s : gset local_event) : iProp Σ :=
      ∃ γ, ⌜γLs !! i = Some γ⌝ ∗ lhst_user_aux γ s.

    Lemma lhst_glob_lock_user_full :
      (2 / 3 + 1 / pos_to_Qp 6 + 1 / pos_to_Qp 6)%Qp = 1%Qp.
    Proof. compute_done. Qed.

    Lemma lhst_user_excl (i : nat) (s s' : gset local_event) :
      lhst_user i s ⊢ lhst_user i s' -∗ False.
    Proof.
      iIntros "Hl1 Hl2".
      iDestruct "Hl1" as (γ1) "[%Heq1 Hown1]".
      iDestruct "Hl2" as (γ2) "[%Heq2 Hown2]".
      assert (γ1 = γ2) as ->.
      { rewrite Heq1 in Heq2.
        inversion Heq2; done. }
      iPoseProof (own_valid_2 with "Hown1 Hown2") as "%Hv".
      exfalso.
      rewrite /mk_hst in Hv.
      eapply frac_pair_valid_implies_false; [apply Hv | by compute ].
    Qed.

    Lemma lhst_mk_hst_agree (γ : gname) (p q : Qp) (s1 s2 : gset local_event) :
      own γ (mk_hst p s1) ⊢ own γ (mk_hst q s2)  -∗ ⌜s1 = s2⌝.
    Proof.
      iIntros "H1 H2".
      iPoseProof (own_valid_2 with "H1 H2") as "%Hv".
      iPureIntro.
      rewrite -pair_op in Hv.
      apply (iffLR (pair_valid _ _)) in Hv as [_ Hv].
      apply to_agree_op_valid in Hv.
      by (apply leibniz_equiv).
    Qed.

    Lemma lhst_user_lock_aux_agree γ s1 s2 :
      lhst_user_aux γ s1 ⊢ lhst_lock_aux γ s2 -∗ ⌜s1 = s2⌝.
    Proof. apply lhst_mk_hst_agree. Qed.

    Lemma lhst_user_glob_aux_agree γ s1 s2 :
      lhst_user_aux γ s1 ⊢ lhst_glob_aux γ s2 -∗ ⌜s1 = s2⌝.
    Proof. apply lhst_mk_hst_agree. Qed.

    Lemma lhst_lock_glob_aux_agree γ s1 s2 :
      lhst_lock_aux γ s1 ⊢ lhst_glob_aux γ s2 -∗ ⌜s1 = s2⌝.
    Proof. apply lhst_mk_hst_agree. Qed.

    Lemma lhst_user_lock_agree i s1 s2 :
      lhst_user i s1 ⊢ lhst_lock i s2 -∗ ⌜s1 = s2⌝.
    Proof.
      iIntros "Huser Hlock".
      iDestruct "Huser" as (γ1) "[%Hl1 Huser]".
      iDestruct "Hlock" as (γ2) "[%Hl2 Hlock]".
      assert (γ1 = γ2) as ->.
      { rewrite Hl1 in Hl2; inversion Hl2; done. }
      iApply (lhst_user_lock_aux_agree with "Huser Hlock").
    Qed.

    Lemma lhst_user_glob_agree i s1 s2 :
      lhst_user i s1 ⊢ lhst_glob i s2 -∗ ⌜s1 = s2⌝.
    Proof.
      iIntros "Huser Hglob".
      iDestruct "Huser" as (γ1) "[%Hl1 Huser]".
      iDestruct "Hglob" as (γ2) "[%Hl2 Hglob]".
      assert (γ1 = γ2) as ->.
      { rewrite Hl1 in Hl2; inversion Hl2; done. }
      iApply (lhst_user_glob_aux_agree with "Huser Hglob").
    Qed.

    Lemma lhst_lock_glob_agree i s1 s2 :
      lhst_lock i s1 ⊢ lhst_glob i s2 -∗ ⌜s1 = s2⌝.
    Proof.
      iIntros "Hlock Hglob".
      iDestruct "Hlock" as (γ1) "[%Hl1 Hlock]".
      iDestruct "Hglob" as (γ2) "[%Hl2 Hglob]".
      assert (γ1 = γ2) as ->.
      { rewrite Hl1 in Hl2; inversion Hl2; done. }
      iApply (lhst_lock_glob_aux_agree with "Hlock Hglob").
    Qed.

    Lemma lhst_user_lookup i s Ss :
      ([∗ list] γs';S ∈ γLs;Ss, lhst_glob_aux γs' S) ⊢
      lhst_user i s -∗
      ⌜Ss !! i = Some s⌝.
    Proof.
      iIntros "HL Hs".
      iDestruct "Hs" as (γ) "[% Hs]".
      iDestruct (big_sepL2_length with "HL") as %Hlen.
      destruct (lookup_lt_is_Some_2 Ss i) as [S HS].
      { rewrite -Hlen; apply lookup_lt_is_Some; eauto. }
      iDestruct (big_sepL2_lookup_acc _ _ _ i with "HL") as "[HS Hrest]";
        eauto.
      by (iDestruct (lhst_user_glob_aux_agree with "Hs HS") as %->).
    Qed.

    Lemma lhst_lock_lookup i s Ss :
      ([∗ list] γs';S ∈ γLs;Ss, lhst_glob_aux γs' S) ⊢
      lhst_lock i s -∗
      ⌜Ss !! i = Some s⌝.
    Proof.
      iIntros "HL Hs".
      iDestruct "Hs" as (γ) "[% Hs]".
      iDestruct (big_sepL2_length with "HL") as %Hlen.
      destruct (lookup_lt_is_Some_2 Ss i) as [S HS].
      { rewrite -Hlen; apply lookup_lt_is_Some; eauto. }
      iDestruct (big_sepL2_lookup_acc _ _ _ i with "HL") as "[HS Hrest]";
        eauto.
      by (iDestruct (lhst_lock_glob_aux_agree with "Hs HS") as %->).
    Qed.

    Lemma lhst_update_aux γ s e :
      lhst_user_aux γ s ⊢
      lhst_lock_aux γ s -∗
      lhst_glob_aux γ s ==∗
      lhst_user_aux γ (s ∪ {[e]}) ∗
      lhst_lock_aux γ (s ∪ {[e]}) ∗
      lhst_glob_aux γ (s ∪ {[e]}).
    Proof.
      iIntros "Hu Hl Hg".
      iMod (own_update_3 _ _ _ _
                         ((mk_hst (2/3)%Qp (s ∪ {[e]})) ⋅
                          (mk_hst one_sixth_qp (s ∪ {[e]})) ⋅
                          (mk_hst one_sixth_qp (s ∪ {[e]}))) with "Hu Hl Hg") as "Hfull".
      { assert (Exclusive (mk_hst (2 / 3) s ⋅
                           mk_hst one_sixth_qp s ⋅
                           mk_hst one_sixth_qp s)) as excl.
        { rewrite -pair_op; simpl.
          apply pair_exclusive_l.
          rewrite /one_sixth_qp.
          do 2 rewrite frac_op.
          rewrite lhst_glob_lock_user_full.
          apply frac_full_exclusive. }
        apply cmra_update_exclusive.
        rewrite /mk_hst /one_sixth_qp.
        rewrite -pair_op.
        apply pair_valid; simpl; split.
        - apply frac_valid; done.
        - do 2 rewrite agree_idemp; done. }
      iDestruct (own_op with "Hfull") as "[Hfull Hglob]".
      iDestruct (own_op with "Hfull") as "[Hfull Hlock]".
      iModIntro.
      iFrame.
    Qed.

    Lemma lhst_update i s Ss e:
      lhst_user i s ⊢
      lhst_lock i s -∗
      ([∗ list] γs;S ∈ γLs;Ss, lhst_glob_aux γs S) ==∗
      lhst_user i (s ∪ {[ e ]}) ∗
      lhst_lock i (s ∪ {[ e ]}) ∗
      ([∗ list] γs;S ∈ γLs; <[i := s ∪ {[ e ]} ]> Ss, lhst_glob_aux γs S).
    Proof.
      iIntros "Hu Hl HL".
      iDestruct "Hu" as (γu) "[%Hlu Hu]".
      iDestruct "Hl" as (γl) "[%Hll Hl]".
      iDestruct (big_sepL2_length with "HL") as %Hlen.
      destruct (lookup_lt_is_Some_2 Ss i) as [s' Hs'].
      { rewrite -Hlen; apply lookup_lt_is_Some; eauto. }
      iDestruct (big_sepL2_insert_acc _ _ _ i with "HL") as "[HS Hback]";
        eauto.
      assert (γl = γu) as ->.
      { rewrite Hlu in Hll; inversion Hll; done. }
      iDestruct (lhst_lock_glob_aux_agree with "Hl HS") as %->.
      iMod ((lhst_update_aux _ _ e) with "Hu Hl HS") as "(Hu & Hl & HS)".
      iSpecialize ("Hback" $! γu (s' ∪ {[e]}) with "HS").
      rewrite (list_insert_id γLs); last done.
      iModIntro; iFrame.
      iSplitL "Hu"; iExists _; by iFrame.
    Qed.

  End Predicates.

  Section init.

    Lemma alloc_lhst :
    True ⊢ |==>
      ∃ γLs,
        ⌜length γLs = length RCB_addresses⌝ ∗
        ([∗ list] i ↦ _ ∈ RCB_addresses, lhst_glob γLs i ∅) ∗
        ([∗ list] i ↦ _ ∈ RCB_addresses, lhst_lock γLs i ∅) ∗
        ([∗ list] i ↦ _ ∈ RCB_addresses, lhst_user γLs i ∅).
    Proof.
      iIntros (_).
      iInduction RCB_addresses as [|dba] "IHdba"; simpl.
      { by iModIntro; iExists []. }
      iMod ("IHdba") as (γLs Hlen) "(Hg & Hl & Hu)".
      iMod (own_alloc (mk_hst (2 / 3)%Qp ∅ ⋅ mk_hst one_sixth_qp ∅ ⋅ mk_hst one_sixth_qp ∅)) as (γ') "Hnew".
      { rewrite -pair_op /one_sixth_qp frac_op frac_op; simpl.
        apply pair_valid; split; [ | do 2 rewrite agree_idemp; done].
        rewrite lhst_glob_lock_user_full; done. }
      iDestruct (own_op with "Hnew") as "[Hnew Hg']".
      iDestruct (own_op with "Hnew") as "[Hu' Hl']".
      iModIntro.
      iExists (γ' :: γLs).
      rewrite -Hlen /=; iSplit; first done.
      iFrame.
      iSplitL "Hg'"; [iExists γ'; iFrame; done |].
      iSplitL "Hl'"; [iExists γ'; iFrame; done |].
      iExists γ'; iFrame; done.
    Qed.

  End init.

End Local_history.


(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

Require Import Coqlib.
Require Import Compopts.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Values.
Require Import Memory.
Require Import Globalenvs.
Require Import Op.
Require Import ValueDomain.
Require Import RTL.

(** Value analysis for IA32 operators *)

Definition eval_static_condition (cond: condition) (vl: list aval): abool :=
  match cond, vl with
  | Ccomp c, v1 :: v2 :: nil => cmp_bool c v1 v2
  | Ccompu c, v1 :: v2 :: nil => cmpu_bool c v1 v2
  | Ccompimm c n, v1 :: nil => cmp_bool c v1 (I n)
  | Ccompuimm c n, v1 :: nil => cmpu_bool c v1 (I n)
  | Ccompf c, v1 :: v2 :: nil => cmpf_bool c v1 v2
  | Cnotcompf c, v1 :: v2 :: nil => cnot (cmpf_bool c v1 v2)
  | Ccompfs c, v1 :: v2 :: nil => cmpfs_bool c v1 v2
  | Cnotcompfs c, v1 :: v2 :: nil => cnot (cmpfs_bool c v1 v2)
  | Cmaskzero n, v1 :: nil => maskzero v1 n
  | Cmasknotzero n, v1 :: nil => cnot (maskzero v1 n)
  | _, _ => Bnone
  end.

Definition eval_static_addressing (addr: addressing) (vl: list aval): aval :=
  match addr, vl with
  | Aindexed n, v1::nil => add v1 (I n)
  | Aindexed2 n, v1::v2::nil => add (add v1 v2) (I n)
  | Ascaled sc ofs, v1::nil => add (mul v1 (I sc)) (I ofs)
  | Aindexed2scaled sc ofs, v1::v2::nil => add v1 (add (mul v2 (I sc)) (I ofs))
  | Aglobal s ofs, nil => Ptr (Gl s ofs)
  | Abased s ofs, v1::nil => add (Ptr (Gl s ofs)) v1
  | Abasedscaled sc s ofs, v1::nil => add (Ptr (Gl s ofs)) (mul v1 (I sc))
  | Ainstack ofs, nil => Ptr(Stk ofs)
  | _, _ => Vbot
  end.

Definition eval_static_operation (op: operation) (vl: list aval): aval :=
  match op, vl with
  | Omove, v1::nil => v1
  | Ointconst n, nil => I n
  | Ofloatconst n, nil => if propagate_float_constants tt then F n else ftop
  | Osingleconst n, nil => if propagate_float_constants tt then FS n else ftop
  | Oindirectsymbol id, nil => Ptr (Gl id Int.zero)
  | Ocast8signed, v1 :: nil => sign_ext 8 v1
  | Ocast8unsigned, v1 :: nil => zero_ext 8 v1
  | Ocast16signed, v1 :: nil => sign_ext 16 v1
  | Ocast16unsigned, v1 :: nil => zero_ext 16 v1
  | Oneg, v1::nil => neg v1
  | Osub, v1::v2::nil => sub v1 v2
  | Omul, v1::v2::nil => mul v1 v2
  | Omulimm n, v1::nil => mul v1 (I n)
  | Omulhs, v1::v2::nil => mulhs v1 v2
  | Omulhu, v1::v2::nil => mulhu v1 v2
  | Odiv, v1::v2::nil => divs v1 v2
  | Odivu, v1::v2::nil => divu v1 v2
  | Omod, v1::v2::nil => mods v1 v2
  | Omodu, v1::v2::nil => modu v1 v2
  | Oand, v1::v2::nil => and v1 v2
  | Oandimm n, v1::nil => and v1 (I n)
  | Oor, v1::v2::nil => or v1 v2
  | Oorimm n, v1::nil => or v1 (I n)
  | Oxor, v1::v2::nil => xor v1 v2
  | Oxorimm n, v1::nil => xor v1 (I n)
  | Onot, v1::nil => notint v1
  | Oshl, v1::v2::nil => shl v1 v2
  | Oshlimm n, v1::nil => shl v1 (I n)
  | Oshr, v1::v2::nil => shr v1 v2
  | Oshrimm n, v1::nil => shr v1 (I n)
  | Oshrximm n, v1::nil => shrx v1 (I n)
  | Oshru, v1::v2::nil => shru v1 v2
  | Oshruimm n, v1::nil => shru v1 (I n)
  | Ororimm n, v1::nil => ror v1 (I n)
  | Oshldimm n, v1::v2::nil => or (shl v1 (I n)) (shru v2 (I (Int.sub Int.iwordsize n)))
  | Olea addr, _ => eval_static_addressing addr vl
  | Onegf, v1::nil => negf v1
  | Oabsf, v1::nil => absf v1
  | Oaddf, v1::v2::nil => addf v1 v2
  | Osubf, v1::v2::nil => subf v1 v2
  | Omulf, v1::v2::nil => mulf v1 v2
  | Odivf, v1::v2::nil => divf v1 v2
  | Onegfs, v1::nil => negfs v1
  | Oabsfs, v1::nil => absfs v1
  | Oaddfs, v1::v2::nil => addfs v1 v2
  | Osubfs, v1::v2::nil => subfs v1 v2
  | Omulfs, v1::v2::nil => mulfs v1 v2
  | Odivfs, v1::v2::nil => divfs v1 v2
  | Osingleoffloat, v1::nil => singleoffloat v1
  | Ofloatofsingle, v1::nil => floatofsingle v1
  | Ointoffloat, v1::nil => intoffloat v1
  | Ofloatofint, v1::nil => floatofint v1
  | Ointofsingle, v1::nil => intofsingle v1
  | Osingleofint, v1::nil => singleofint v1
  | Omakelong, v1::v2::nil => longofwords v1 v2
  | Olowlong, v1::nil => loword v1
  | Ohighlong, v1::nil => hiword v1
  | Ocmp c, _ => of_optbool (eval_static_condition c vl)
  | _, _ => Vbot
  end.

Section SOUNDNESS.

Variable bc: block_classification.
Variable ge: genv.
Hypothesis GENV: genv_match bc ge.
Variable sp: block.
Hypothesis STACK: bc sp = BCstack.

Theorem eval_static_condition_sound:
  forall cond vargs m aargs,
  Forall2 (vmatch bc) vargs aargs ->
  cmatch (eval_condition cond vargs m) (eval_static_condition cond aargs).
Proof.
  intros until aargs; intros VM.
  inv VM.
  destruct cond; auto with va.
  inv H0.
  destruct cond; simpl; eauto with va.
  inv H2.
  destruct cond; simpl; eauto with va.
  destruct cond; auto with va.
Qed.

Lemma symbol_address_sound:
  forall id ofs,
  vmatch bc (Genv.symbol_address ge id ofs) (Ptr (Gl id ofs)).
Proof.
  intros; apply symbol_address_sound; apply GENV.
Qed.

Hint Resolve symbol_address_sound: va.

Ltac InvHyps :=
  match goal with
  | [H: None = Some _ |- _ ] => discriminate
  | [H: Some _ = Some _ |- _] => inv H
  | [H1: match ?vl with nil => _ | _ :: _ => _ end = Some _ ,
     H2: Forall2 _ ?vl _ |- _ ] => inv H2; InvHyps
  | _ => idtac
  end.

Theorem eval_static_addressing_sound:
  forall addr vargs vres aargs,
  eval_addressing ge (Vptr sp Int.zero) addr vargs = Some vres ->
  Forall2 (vmatch bc) vargs aargs ->
  vmatch bc vres (eval_static_addressing addr aargs).
Proof.
  unfold eval_addressing, eval_static_addressing; intros;
  destruct addr; InvHyps; eauto with va.
  rewrite Int.add_zero_l; auto with va.
Qed.

Theorem eval_static_operation_sound:
  forall op vargs m vres aargs,
  eval_operation ge (Vptr sp Int.zero) op vargs m = Some vres ->
  Forall2 (vmatch bc) vargs aargs ->
  vmatch bc vres (eval_static_operation op aargs).
Proof.
  unfold eval_operation, eval_static_operation; intros;
  destruct op; InvHyps; eauto with va.
  destruct (propagate_float_constants tt); constructor.
  destruct (propagate_float_constants tt); constructor.
  eapply eval_static_addressing_sound; eauto.
  apply of_optbool_sound. eapply eval_static_condition_sound; eauto.
Qed.

End SOUNDNESS.


(*

  Copyright 2014 Cornell University

  This file is part of VPrl (the Verified Nuprl project).

  VPrl is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  VPrl is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with VPrl.  If not, see <http://www.gnu.org/licenses/>.

  Website: http://nuprl.org/html/verification/
  Authors: Abhishek Anand & Vincent Rahli

*)

Require Export per_props_more.

(* ========= W TYPES ========= *)

Definition wlistA T := mkc_union mkc_unit T.

Definition wlistB v :=
  mkc_ite_vars
    [v]
    (mkc_var v)
    (mk_cv [v] mkc_void)
    (mk_cv [v] mkc_unit).

Definition wlist (T : CTerm) := mkc_w (wlistA T) nvarx (wlistB nvarx).

Definition wnil := mkc_sup (mkc_inl mkc_axiom) mkc_id.

Definition wcons a b := mkc_sup (mkc_inr a) (mkc_lamc nvarx b).

Definition ex3ones :=
  wcons (mkc_nat 1) (wcons (mkc_nat 1) (wcons (mkc_nat 1) wnil)).

Definition unit_eq : term-equality :=
  fun t t' =>
    ccomputes_to_valc t mkc_axiom
    # ccomputes_to_valc t' mkc_axiom
    # capproxc mkc_axiom mkc_axiom.

Definition void_eq : term-equality := fun (t t' : CTerm) => void.

Definition wlist_eqa eqT :=
  fun t t' => per_union_eq unit_eq eqT t t'.

Definition per_isl (a a' : CTerm)
                   (eq : term-equality)
                   (e : wlist_eqa eq a a')
                   (T1 T2 : [U]) :=
  match e with
    | or_introl _ => T1
    | or_intror _ => T2
  end.

Definition wlist_eqb eqT :=
  fun a a' (e : wlist_eqa eqT a a') t t' =>
    per_isl a a' eqT e (void_eq t t') (unit_eq t t').

Definition wlist_eq eqT :=
  fun t t' => weq (wlist_eqa eqT) (wlist_eqb eqT) t t'.

Lemma lsubst_wlistB_as_decide :
  forall v x,
    ! LIn nvarx (free_vars x)
    -> lsubst (mk_decide (mk_var v) nvarx mk_void nvarx mk_unit) [(v, x)]
       = mk_decide x nvarx mk_void nvarx mk_unit.
Proof.
  introv ninx.
  unfold lsubst.
  destruct (dec_disjointv
              (bound_vars (mk_decide (mk_var v) nvarx mk_void nvarx mk_unit))
              (flat_map free_vars (range [(v, x)]))).

  simpl.
  remember (beq_var v v); destruct b; simpl.
  remember (memvar v [nvarx]); destruct b; simpl.
  symmetry in Heqb0.
  rw fold_assert in Heqb0.
  rw assert_memvar in Heqb0; simpl in Heqb0; sp.
  rw <- Heqb0; simpl.
  remember (beq_var v nvarx); destruct b; simpl; sp.
  apply beq_var_true in Heqb1; sp; subst.
  symmetry in Heqb0. rw not_of_assert in Heqb0.
  rw assert_memvar in Heqb0; simpl in Heqb0; sp.
  rw not_over_or in Heqb0; sp.
  rw <- beq_var_refl in Heqb; sp.

  assert (eqvars
            (bound_vars (mk_decide (mk_var v) nvarx mk_void nvarx mk_unit))
            [nvarx]) as eqv1.
  simpl; rw eqvars_prop; simpl; sp; split; sp.

  assert (flat_map free_vars (range [(v, x)]) = free_vars x) as eqv2.
  simpl; rw app_nil_r; sp.

  destruct n.
  rewrite eqv2.
  apply eqvars_disjoint with (s1 := [nvarx]); sp.
  rw disjoint_singleton_l; sp.
Qed.

Lemma computes_substc_wlistB_inl :
  forall a x,
    computes_to_valc a (mkc_inl x)
    -> computes_to_valc (substc a nvarx (wlistB nvarx)) mkc_void.
Proof.
  introv c.
  destruct_cterms.
  allunfold computes_to_valc; allsimpl.
  unfold subst.

  allrw isprog_eq.
  allunfold isprogram; repnd.

  assert (lsubst (mk_decide (mk_var nvarx) nvarx mk_void nvarx mk_unit) [(nvarx, x0)]
          = mk_decide x0 nvarx mk_void nvarx mk_unit) as eq.
  change_to_lsubst_aux4; try (complete (simpl; allrw; simpl; sp)).

  rw eq.

  apply implies_computes_to_value_inl_decide with (a := x); sp.
  unfold subst; simpl.
  change_to_lsubst_aux4; simpl; sp; allrw; simpl; sp.
  apply computes_to_value_isvalue_refl; sp.
Qed.

Lemma computes_substc_wlistB_inr :
  forall a x,
    computes_to_valc a (mkc_inr x)
    -> computes_to_valc (substc a nvarx (wlistB nvarx)) mkc_unit.
Proof.
  introv c.
  destruct_cterms.
  allunfold computes_to_valc; allsimpl.
  unfold subst.

  allrw isprog_eq.
  allunfold isprogram; repnd.

  assert (lsubst (mk_decide (mk_var nvarx) nvarx mk_void nvarx mk_unit) [(nvarx, x0)]
          = mk_decide x0 nvarx mk_void nvarx mk_unit) as eq.
  change_to_lsubst_aux4; try (complete (simpl; allrw; simpl; sp)).

  rw eq.

  apply implies_computes_to_value_inr_decide with (a := x); sp.
  unfold subst; simpl.
  change_to_lsubst_aux4; simpl; sp; allrw; simpl; sp.
  apply computes_to_value_isvalue_refl; sp.
Qed.

Lemma nuprl_mkc_void :
  nuprl mkc_void mkc_void void_eq.
Proof.
  apply CL_sqle; unfold per_sqle.
  exists mkc_axiom mkc_bot mkc_axiom mkc_bot; sp;
  try (complete (rw <- mkc_false_eq; rw mkc_void_eq_mkc_false;
                 apply computes_to_valc_refl; sp;
                 apply iscvalue_mkc_false)).
  unfold void_eq; split; sp.
  allapply not_axiom_approxc_bot; sp.
Qed.
Hint Immediate nuprl_mkc_void.

Lemma nuprl_mkc_unit :
  nuprl mkc_unit mkc_unit unit_eq.
Proof.
  apply CL_sqle; unfold per_sqle.
  exists mkc_axiom mkc_axiom mkc_axiom mkc_axiom; sp;
  try (complete (rw <- mkc_true_eq; rw mkc_unit_eq_mkc_true;
                 apply computes_to_valc_refl; sp;
                 apply iscvalue_mkc_true)).
Qed.
Hint Immediate nuprl_mkc_unit.

Lemma wnil_is_list :
  forall T, type T -> member wnil (wlist T).
Proof.
  introv tT.
  unfold member, equality, nuprl.
  unfold type, tequality in tT; exrepnd.
  exists (wlist_eq eq); sp.
  apply CL_w; unfold per_w, type_family.
  exists (wlist_eqa eq) (wlist_eqb eq); sp.
  exists (wlistA T) (wlistA T) nvarx nvarx (wlistB nvarx) (wlistB nvarx); sp;
  repeat (apply computes_to_valc_refl; try (apply iscvalue_mkc_w)).

  apply CL_union; unfold per_union.
  exists unit_eq eq mkc_unit mkc_unit T T; sp;
  repeat (apply computes_to_valc_refl; try (apply iscvalue_mkc_union)).

  fold nuprl.
  unfold wlist_eqa, per_union_eq in e; exrepnd; repdors; repnd.

  unfold unit_eq in e0; repnd.
  generalize (computes_substc_wlistB_inl a x)
             (computes_substc_wlistB_inl a' y);
    intros c1 c2.
  dest_imp c1 hyp.
  dest_imp c2 hyp.
  apply computes_to_valc_implies_cequivc in c1.
  apply computes_to_valc_implies_cequivc in c2.
  apply nuprl_value_respecting_left with (t1 := mkc_void);
    try (complete (apply cequivc_sym; sp)).
  apply nuprl_value_respecting_right with (t2 := mkc_void);
    try (complete (apply cequivc_sym; sp)).

  unfold wlist_eqb, per_isl; simpl.
  unfold void_eq; fold void_eq.
  apply nuprl_mkc_void.

  unfold unit_eq in e2; repnd.
  generalize (computes_substc_wlistB_inr a x)
             (computes_substc_wlistB_inr a' y);
    intros c1 c2.
  dest_imp c1 hyp.
  dest_imp c2 hyp.
  apply computes_to_valc_implies_cequivc in c1.
  apply computes_to_valc_implies_cequivc in c2.
  apply nuprl_value_respecting_left with (t1 := mkc_unit);
    try (complete (apply cequivc_sym; sp)).
  apply nuprl_value_respecting_right with (t2 := mkc_unit);
    try (complete (apply cequivc_sym; sp)).

  unfold wlist_eqb, per_isl; simpl.
  unfold unit_eq; fold unit_eq.
  apply nuprl_mkc_unit.

  unfold wlist_eq.

  assert (wlist_eqa eq (mkc_inl mkc_axiom) (mkc_inl mkc_axiom)) as e.
  unfold wlist_eqa, per_union_eq.
  exists mkc_axiom mkc_axiom; sp; left; sp;
  repeat (apply computes_to_valc_refl; try (apply iscvalue_mkc_inl)).
  unfold unit_eq; sp;
  repeat (apply computes_to_valc_refl; try (apply iscvalue_mkc_axiom)).
  assert (cequivc mkc_axiom mkc_axiom) as c; sp.
  destruct c; sp.

  apply weq_cons with
        (a := mkc_inl mkc_axiom) (a' := mkc_inl mkc_axiom)
        (f := mkc_id) (f' := mkc_id)
        (e := e); sp;
  repeat (apply computes_to_valc_refl; try (apply iscvalue_mkc_sup)).
  unfold wlist_eqb, void_eq, per_isl in X; allsimpl; sp.
  destruct e; allsimpl; sp; allsimpl; sp.
  provefalse.
  allunfold computes_to_valc; allsimpl.
  destruct_cterms.
  unfold mkc_inr in p0; allsimpl.
  apply computes_to_value_isvalue_eq in p0; sp.
  inversion p0.
  apply isvalue_inl; sp.
Qed.


Require Import Kami.Syntax Kami.Semantics Kami.RefinementFacts Kami.Renaming Kami.Wf.
Require Import Kami.Inline Kami.InlineFacts Kami.Tactics Lib.CommonTactics.
Require Import Ex.SC Ex.MemTypes Ex.ProcThreeStage.

Set Implicit Arguments.

Section Inlined.
  Variables addrSize iaddrSize instBytes dataBytes rfIdx: nat.

  Variables (fetch: AbsFetch addrSize iaddrSize instBytes dataBytes)
            (dec: AbsDec addrSize instBytes dataBytes rfIdx)
            (exec: AbsExec addrSize instBytes dataBytes rfIdx).

  Variable (d2eElt: Kind).
  Variable (d2ePack:
              forall ty,
                Expr ty (SyntaxKind (Bit 2)) -> (* opTy *)
                Expr ty (SyntaxKind (Bit rfIdx)) -> (* dst *)
                Expr ty (SyntaxKind (Bit addrSize)) -> (* addr *)
                Expr ty (SyntaxKind (Array Bool dataBytes)) -> (* byteEn *)
                Expr ty (SyntaxKind (Data dataBytes)) -> (* val1 *)
                Expr ty (SyntaxKind (Data dataBytes)) -> (* val2 *)
                Expr ty (SyntaxKind (Data instBytes)) -> (* rawInst *)
                Expr ty (SyntaxKind (Pc addrSize)) -> (* curPc *)
                Expr ty (SyntaxKind (Pc addrSize)) -> (* nextPc *)
                Expr ty (SyntaxKind Bool) -> (* epoch *)
                Expr ty (SyntaxKind d2eElt)).
  Variables
    (d2eOpType: forall ty, fullType ty (SyntaxKind d2eElt) ->
                           Expr ty (SyntaxKind (Bit 2)))
    (d2eDst: forall ty, fullType ty (SyntaxKind d2eElt) ->
                        Expr ty (SyntaxKind (Bit rfIdx)))
    (d2eAddr: forall ty, fullType ty (SyntaxKind d2eElt) ->
                         Expr ty (SyntaxKind (Bit addrSize)))
    (d2eByteEn: forall ty, fullType ty (SyntaxKind d2eElt) ->
                           Expr ty (SyntaxKind (Array Bool dataBytes)))
    (d2eVal1 d2eVal2: forall ty, fullType ty (SyntaxKind d2eElt) ->
                                 Expr ty (SyntaxKind (Data dataBytes)))
    (d2eRawInst: forall ty, fullType ty (SyntaxKind d2eElt) ->
                            Expr ty (SyntaxKind (Data instBytes)))
    (d2eCurPc: forall ty, fullType ty (SyntaxKind d2eElt) ->
                          Expr ty (SyntaxKind (Pc addrSize)))
    (d2eNextPc: forall ty, fullType ty (SyntaxKind d2eElt) ->
                           Expr ty (SyntaxKind (Pc addrSize)))
    (d2eEpoch: forall ty, fullType ty (SyntaxKind d2eElt) ->
                          Expr ty (SyntaxKind Bool)).

  Variable (e2wElt: Kind).
  Variable (e2wPack:
              forall ty,
                Expr ty (SyntaxKind d2eElt) -> (* decInst *)
                Expr ty (SyntaxKind (Data dataBytes)) -> (* execVal *)
                Expr ty (SyntaxKind e2wElt)).
  Variables
    (e2wDecInst: forall ty, fullType ty (SyntaxKind e2wElt) ->
                            Expr ty (SyntaxKind d2eElt))
    (e2wVal: forall ty, fullType ty (SyntaxKind e2wElt) ->
                        Expr ty (SyntaxKind (Data dataBytes))).

  Variable (init: ProcInit addrSize dataBytes rfIdx).

  Definition p3st := p3st fetch dec exec
                          d2ePack d2eOpType d2eDst d2eAddr d2eByteEn d2eVal1 d2eVal2
                          d2eRawInst d2eCurPc d2eNextPc d2eEpoch
                          e2wPack e2wDecInst e2wVal init.
  #[local] Hint Unfold p3st: ModuleDefs. (* for kinline_compute *)

  Definition p3stInl: sigT (fun m: Modules => p3st <<== m).
  Proof. (* SKIP_PROOF_ON
    kinline_refine p3st.
    END_SKIP_PROOF_ON *) apply cheat.
  Defined.

End Inlined.


Require Import Omega.
Require Import RelationClasses.

From sflib Require Import sflib.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import Loc.

Require Import Time.
Require Import Event.
From PromisingLib Require Import Language.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Thread.
Require Import Configuration.
Require Import Progress.

Require Import SmallStep.

Set Implicit Arguments.

Inductive fulfilled c l f t msg :=
| fulfilled_intro
    (GET: Memory.get l t c.(Configuration.memory) = Some (f, msg))
    (FULFILLED: forall tid, ~ Threads.is_promised tid l t c.(Configuration.threads))
.

Lemma writing_small_step_fulfilled_forward
      withprm tid e c1 c2 loc from to val released ord
      (WF: Configuration.wf c1)
      (STEP: small_step withprm tid e c1 c2)
      (WRITING: ThreadEvent.is_writing e = Some (loc, from, to, val, released, ord)):
  forall l f t msg
    (NP: fulfilled c1 l f t msg),
    fulfilled c2 l f t msg.
Proof.
  inv STEP. guardH PFREE.
  inv STEP0; inv STEP; ss. inv LOCAL; inv WRITING; ss.
  - inv LOCAL0. inv WRITE. inv PROMISE.
    { i. inv NP. econs; s.
      - erewrite Memory.add_o; eauto. condtac; ss.
        des. subst. exploit Memory.add_get0; eauto. congr.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          erewrite Memory.add_o; eauto. condtac; ss. i.
          eapply FULFILLED. econs; eauto.
        + i. eapply FULFILLED. econs; eauto.
    }
    { i. inv NP. econs; s.
      - erewrite Memory.split_o; eauto. condtac; ss.
        { des. subst. exploit Memory.split_get0; eauto. i. des. congr. }
        condtac; ss. guardH o. des. subst.
        exfalso. eapply FULFILLED. econs; eauto.
        hexploit Memory.split_get0; try exact PROMISES; eauto. i. des. eauto.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          erewrite Memory.split_o; eauto. repeat condtac; ss.
          * guardH o. guardH o0. i. des. inv PROMISES0.
            eapply FULFILLED. econs; eauto.
            hexploit Memory.split_get0; try exact PROMISES; eauto. i. des. eauto.
          * i. eapply FULFILLED. econs; eauto.
        + i. eapply FULFILLED. econs; eauto.
    }
    { i. inv NP. econs; s.
      - erewrite Memory.lower_o; eauto. condtac; ss.
        des. subst. exfalso. eapply FULFILLED. econs; eauto.
        hexploit Memory.lower_get0; try exact PROMISES; eauto.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          erewrite Memory.lower_o; eauto. condtac; ss.
          guardH o. guardH o0. i. des. inv PROMISES0.
          eapply FULFILLED. econs; eauto.
        + i. eapply FULFILLED. econs; eauto.
    }
  - inv LOCAL1. clear GET.
    inv LOCAL2. inv WRITE. inv PROMISE.
    { i. inv NP. econs; s.
      - erewrite Memory.add_o; eauto. condtac; ss.
        des. subst. exploit Memory.add_get0; eauto. congr.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          erewrite Memory.add_o; eauto. condtac; ss. i.
          eapply FULFILLED. econs; eauto.
        + i. eapply FULFILLED. econs; eauto.
    }
    { i. inv NP. econs; s.
      - erewrite Memory.split_o; eauto. condtac; ss.
        { des. subst. exploit Memory.split_get0; eauto. i. des. congr. }
        condtac; ss. guardH o. des. subst.
        exfalso. eapply FULFILLED. econs; eauto.
        hexploit Memory.split_get0; try exact PROMISES; eauto. i. des. eauto.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          erewrite Memory.split_o; eauto. repeat condtac; ss.
          * guardH o. guardH o0. i. des. inv PROMISES0.
            eapply FULFILLED. econs; eauto.
            hexploit Memory.split_get0; try exact PROMISES; eauto. i. des. eauto.
          * i. eapply FULFILLED. econs; eauto.
        + i. eapply FULFILLED. econs; eauto.
    }
    { i. inv NP. econs; s.
      - erewrite Memory.lower_o; eauto. condtac; ss.
        des. subst. exfalso. eapply FULFILLED. econs; eauto.
        hexploit Memory.lower_get0; try exact PROMISES; eauto.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          erewrite Memory.lower_o; eauto. condtac; ss.
          guardH o. guardH o0. i. des. inv PROMISES0.
          eapply FULFILLED. econs; eauto.
        + i. eapply FULFILLED. econs; eauto.
    }
Qed.

Lemma writing_small_step_fulfilled_new
      withprm tid e c1 c2 loc from to val released ord
      (WF: Configuration.wf c1)
      (STEP: small_step withprm tid e c1 c2)
      (WRITING: ThreadEvent.is_writing e = Some (loc, from, to, val, released, ord)):
  fulfilled c2 loc from to (Message.mk val released).
Proof.
  inv STEP. guardH PFREE.
  inv STEP0; inv STEP; ss. inv LOCAL; inv WRITING; ss.
  - inv LOCAL0. inv WRITE. inv PROMISE.
    { econs; s.
      - erewrite Memory.add_o; eauto. condtac; ss. des; congr.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          des; congr.
        + i. exploit Memory.add_get0; eauto. i.
          inv WF. inv WF0. exploit THREADS; eauto. i. inv x.
          apply PROMISES1 in PROMISES0. congr.
    }
    { econs; s.
      - erewrite Memory.split_o; eauto. condtac; ss.
        exfalso. clear -o. des; apply o; auto.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          des; congr.
        + i. exploit Memory.split_get0; eauto. i. des.
          inv WF. inv WF0. exploit THREADS; eauto. i. inv x.
          apply PROMISES1 in PROMISES0. congr.
    }
    { econs; s.
      - erewrite Memory.lower_o; eauto. condtac; ss. des; congr.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          des; congr.
        + i. exploit Memory.lower_get0; eauto. i.
          inv WF. inv WF0. exploit DISJOINT; eauto. i.
          eapply Memory.disjoint_get; try apply x; eauto.
          eapply Memory.lower_get0. eauto.
    }
  - inv LOCAL1. clear GET.
    inv LOCAL2. inv WRITE. inv PROMISE.
    { econs; s.
      - erewrite Memory.add_o; eauto. condtac; ss. des; congr.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          des; congr.
        + i. exploit Memory.add_get0; eauto. i.
          inv WF. inv WF0. exploit THREADS; eauto. i. inv x.
          apply PROMISES1 in PROMISES0. congr.
    }
    { econs; s.
      - erewrite Memory.split_o; eauto. condtac; ss.
        exfalso. clear -o. des; apply o; auto.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          des; congr.
        + i. exploit Memory.split_get0; eauto. i. des.
          inv WF. inv WF0. exploit THREADS; eauto. i. inv x.
          apply PROMISES1 in PROMISES0. congr.
    }
    { econs; s.
      - erewrite Memory.lower_o; eauto. condtac; ss. des; congr.
      - ii. inv H. revert TID0. rewrite IdentMap.gsspec. condtac.
        + i. inv TID0. apply inj_pair2 in H1. subst. ss.
          revert PROMISES0. erewrite Memory.remove_o; eauto. condtac; ss.
          des; congr.
        + i. exploit Memory.lower_get0; eauto. i.
          inv WF. inv WF0. exploit DISJOINT; eauto. i.
          eapply Memory.disjoint_get; try apply x; eauto.
          eapply Memory.lower_get0. eauto.
    }
Qed.

Lemma writing_small_step_fulfilled_backward
      withprm tid e c1 c2 loc from to val released ord
      (WF: Configuration.wf c1)
      (STEP: small_step withprm tid e c1 c2)
      (WRITING: ThreadEvent.is_writing e = Some (loc, from, to, val, released, ord)):
  forall l f t msg
    (NP: fulfilled c2 l f t msg),
    fulfilled c1 l f t msg \/ (l, f, t, msg) = (loc, from, to, Message.mk val released).
Proof.
  inv STEP. guardH PFREE.
  inv STEP0; inv STEP; ss. inv LOCAL; inv WRITING; ss.
  - inv LOCAL0. inv WRITE. inv PROMISE.
    { i. inv NP. ss. revert GET. erewrite Memory.add_o; eauto. condtac; ss.
      { i. des. inv GET. auto. }
      { left. econs; eauto. ii. inv H.
        destruct (Ident.eq_dec tid0 tid).
        - subst. rewrite TID in TID0. inv TID0. apply inj_pair2 in H1. subst.
          eapply FULFILLED. econs.
          + rewrite IdentMap.gss. eauto.
          + s. erewrite Memory.remove_o; eauto. condtac; ss.
            erewrite Memory.add_o; eauto. condtac; [|eauto]. ss.
        - eapply FULFILLED. econs; eauto.
          rewrite IdentMap.gso; eauto.
      }
    }
    { i. inv NP. ss. revert GET. erewrite Memory.split_o; eauto. condtac; ss.
      { i. des. inv GET. auto. }
      guardH o. condtac; ss.
      { i. des. inv GET. exfalso. eapply FULFILLED. econs.
        - rewrite IdentMap.gss. eauto.
        - erewrite Memory.remove_o; eauto. condtac; ss.
          erewrite Memory.split_o; eauto.
          do 2 (condtac; try congr). eauto.
      }
      { left. econs; eauto. ii. inv H.
        destruct (Ident.eq_dec tid0 tid).
        - subst. rewrite TID in TID0. inv TID0. apply inj_pair2 in H1. subst.
          eapply FULFILLED. econs.
          + rewrite IdentMap.gss. eauto.
          + s. erewrite Memory.remove_o; eauto. condtac; ss.
            erewrite Memory.split_o; eauto. do 2 (condtac; try congr). eauto.
        - eapply FULFILLED. econs; eauto.
          rewrite IdentMap.gso; eauto.
      }
    }
    { i. inv NP. ss. revert GET. erewrite Memory.lower_o; eauto. condtac; ss.
      { i. des. inv GET. auto. }
      { left. econs; eauto. ii. inv H.
        destruct (Ident.eq_dec tid0 tid).
        - subst. rewrite TID in TID0. inv TID0. apply inj_pair2 in H1. subst.
          eapply FULFILLED. econs.
          + rewrite IdentMap.gss. eauto.
          + s. erewrite Memory.remove_o; eauto. condtac; ss.
            erewrite Memory.lower_o; eauto. condtac; [|eauto]. ss.
        - eapply FULFILLED. econs; eauto.
          rewrite IdentMap.gso; eauto.
      }
    }
  - inv LOCAL1. clear GET.
    inv LOCAL2. inv WRITE. inv PROMISE.
    { i. inv NP. ss. revert GET. erewrite Memory.add_o; eauto. condtac; ss.
      { i. des. inv GET. auto. }
      { left. econs; eauto. ii. inv H.
        destruct (Ident.eq_dec tid0 tid).
        - subst. rewrite TID in TID0. inv TID0. apply inj_pair2 in H1. subst.
          eapply FULFILLED. econs.
          + rewrite IdentMap.gss. eauto.
          + s. erewrite Memory.remove_o; eauto. condtac; ss.
            erewrite Memory.add_o; eauto. condtac; [|eauto]. ss.
        - eapply FULFILLED. econs; eauto.
          rewrite IdentMap.gso; eauto.
      }
    }
    { i. inv NP. ss. revert GET. erewrite Memory.split_o; eauto. condtac; ss.
      { i. des. inv GET. auto. }
      guardH o. condtac; ss.
      { i. des. inv GET. exfalso. eapply FULFILLED. econs.
        - rewrite IdentMap.gss. eauto.
        - erewrite Memory.remove_o; eauto. condtac; ss.
          erewrite Memory.split_o; eauto.
          do 2 (condtac; try congr). eauto.
      }
      { left. econs; eauto. ii. inv H.
        destruct (Ident.eq_dec tid0 tid).
        - subst. rewrite TID in TID0. inv TID0. apply inj_pair2 in H1. subst.
          eapply FULFILLED. econs.
          + rewrite IdentMap.gss. eauto.
          + s. erewrite Memory.remove_o; eauto. condtac; ss.
            erewrite Memory.split_o; eauto. do 2 (condtac; try congr). eauto.
        - eapply FULFILLED. econs; eauto.
          rewrite IdentMap.gso; eauto.
      }
    }
    { i. inv NP. ss. revert GET. erewrite Memory.lower_o; eauto. condtac; ss.
      { i. des. inv GET. auto. }
      { left. econs; eauto. ii. inv H.
        destruct (Ident.eq_dec tid0 tid).
        - subst. rewrite TID in TID0. inv TID0. apply inj_pair2 in H1. subst.
          eapply FULFILLED. econs.
          + rewrite IdentMap.gss. eauto.
          + s. erewrite Memory.remove_o; eauto. condtac; ss.
            erewrite Memory.lower_o; eauto. condtac; [|eauto]. ss.
        - eapply FULFILLED. econs; eauto.
          rewrite IdentMap.gso; eauto.
      }
    }
Qed.

Lemma writing_small_step_fulfilled
      withprm tid e c1 c2 loc from to val released ord
      (WF: Configuration.wf c1)
      (STEP: small_step withprm tid e c1 c2)
      (WRITING: ThreadEvent.is_writing e = Some (loc, from, to, val, released, ord)):
  forall l f t msg,
    fulfilled c2 l f t msg <-> fulfilled c1 l f t msg \/ (l, f, t, msg) = (loc, from, to, Message.mk val released).
Proof.
  econs; i.
  - eapply writing_small_step_fulfilled_backward; eauto.
  - des.
    + eapply writing_small_step_fulfilled_forward; eauto.
    + inv H. eapply writing_small_step_fulfilled_new; eauto.
Qed.

Lemma nonwriting_small_step_fulfilled_forward
      tid e c1 c2
      (WF: Configuration.wf c1)
      (STEP: small_step false tid e c1 c2)
      (NONWRITING: ThreadEvent.is_writing e = None):
  forall l f t msg
    (NP: fulfilled c1 l f t msg),
    fulfilled c2 l f t msg.
Proof.
  inv STEP. guardH PFREE.
  inv STEP0; inv STEP; inv LOCAL; inv NONWRITING.
  - unguardH PFREE.
    apply promise_pf_inv in PFREE. des. subst. inv PROMISE.
    i. inv NP. econs; ss.
    + erewrite Memory.lower_o; eauto. condtac; ss. des. subst.
      exfalso. eapply FULFILLED. econs; eauto. eapply Memory.lower_get0. eauto.
    + ii. inv H.
      revert TID0. rewrite IdentMap.gsspec. condtac; ss; i.
      * inv TID0. ss. eapply FULFILLED.
        destruct msg0. hexploit Memory.op_get_inv; eauto.
        { econs 3. eauto. }
        i. des.
        { subst. econs; eauto. eapply Memory.lower_get0. eauto. }
        { econs; eauto. }
      * eapply FULFILLED. econs; eauto.
  - i. inv NP. econs; eauto. ii. inv H. ss.
    revert TID0. rewrite IdentMap.gsspec. condtac; ss; i.
    + inv TID0. eapply FULFILLED. econs; eauto.
    + eapply FULFILLED. econs; eauto.
  - inv LOCAL0.
    i. inv NP. econs; eauto. ii. inv H. ss.
    revert TID0. rewrite IdentMap.gsspec. condtac; ss; i.
    + inv TID0. eapply FULFILLED. econs; eauto.
    + eapply FULFILLED. econs; eauto.
  - inv LOCAL0.
    i. inv NP. econs; eauto. ii. inv H. ss.
    revert TID0. rewrite IdentMap.gsspec. condtac; ss; i.
    + inv TID0. eapply FULFILLED. econs; eauto.
    + eapply FULFILLED. econs; eauto.
  - inv LOCAL0.
    i. inv NP. econs; eauto. ii. inv H. ss.
    revert TID0. rewrite IdentMap.gsspec. condtac; ss; i.
    + inv TID0. eapply FULFILLED. econs; eauto.
    + eapply FULFILLED. econs; eauto.
Qed.


Require Import UNIVERSE.
Require Import Smallstep.
Require Import CoqlibC.
Require Import ModSem.
Require Import LinkingC.

Require Import Syntax Sem Mod ModSem.
Require Import Sound.
Require Import SimSymb SimMem SimModSem.

Set Implicit Arguments.

Module ModPair.

Section MODPAIR.
Context `{SM: SimMem.class} {SS: SimSymb.class SM} {SU: Sound.class}.

  Record t: Type := mk {
    src: Mod.t;
    tgt: Mod.t;
    ss: SimSymb.t;
  }.

  Definition to_msp (skenv_link_src skenv_link_tgt: SkEnv.t) (sm: SimMem.t) (mp: t): ModSemPair.t :=
    ModSemPair.mk (Mod.modsem (mp.(src)) skenv_link_src) (Mod.modsem (mp.(tgt)) skenv_link_tgt) mp.(ss) sm.

  (* TODO: Actually, ModPair can have idx/ord and transfer it to ModSemPair. *)
  (* Advantage: We can unify ord at Mod state. *)
  Inductive sim (mp: t): Prop :=
  | sim_intro
      (SIMSK: SimSymb.wf mp.(ss))
      (SKSRC: mp.(ss).(SimSymb.src) = (Mod.sk mp.(src)))
      (SKTGT: mp.(ss).(SimSymb.tgt) = (Mod.sk mp.(tgt)))
      (SIMMS: forall skenv_link_src skenv_link_tgt ss_link sm_init_link
          (INCLSRC: SkEnv.includes skenv_link_src (Mod.sk mp.(src)))
          (INCLTGT: SkEnv.includes skenv_link_tgt (Mod.sk mp.(tgt)))
          (WFSRC: SkEnv.wf skenv_link_src)
          (WFTGT: SkEnv.wf skenv_link_tgt)
          (SSLE: SimSymb.le mp.(ss) ss_link)
          (SIMSKENVLINK: SimSymb.sim_skenv sm_init_link ss_link skenv_link_src skenv_link_tgt),
          <<SIMMSP: ModSemPair.sim (to_msp skenv_link_src skenv_link_tgt sm_init_link mp)>>).

  (* Design: ModPair only has data, properties are stated in sim *)

End MODPAIR.
End ModPair.

Hint Unfold ModPair.to_msp.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.
Require Import RunAux.Spec.

Local Open Scope Z_scope.

Section Spec.

  Definition complete_hvc_exit_spec (rec: Pointer) (adt: RData) : option RData :=
    rely (peq (base rec) buffer_loc);
    when gidx == (buffer (priv adt)) @ (offset rec);
    let gn := (gs (share adt)) @ gidx in
    rely (ref_accessible gn CPU_ID);
    rely (g_tag (ginfo gn) =? GRANULE_STATE_REC);
    let esr := g_esr (grec gn) in
    rely is_int64 esr;
    if (Z.land esr ESR_EL2_EC_MASK) =? ESR_EL2_EC_HVC then
      rely is_int64 ((rec_run (priv adt)) @ 5); rely is_int64 ((rec_run (priv adt)) @ 6);
      rely is_int64 ((rec_run (priv adt)) @ 7); rely is_int64 ((rec_run (priv adt)) @ 8);
      rely is_int64 ((rec_run (priv adt)) @ 9); rely is_int64 ((rec_run (priv adt)) @ 10);
      rely is_int64 ((rec_run (priv adt)) @ 11);
      let g' := gn {grec: (grec gn) {g_regs: (g_regs (grec gn)) {r_x0: ((rec_run (priv adt)) @ 5)} {r_x1: (rec_run (priv adt)) @ 6}
                                                                {r_x2: ((rec_run (priv adt)) @ 7)} {r_x3: (rec_run (priv adt)) @ 8}
                                                                {r_x4: ((rec_run (priv adt)) @ 9)} {r_x5: (rec_run (priv adt)) @ 10}
                                                                {r_x6: ((rec_run (priv adt)) @ 11)}} {g_esr: 0}} in
      Some adt {share: (share adt) {gs: (gs (share adt)) # gidx == g'}}
    else Some adt.

End Spec.


(*

  Copyright 2016 Luxembourg University
  Copyright 2017 Luxembourg University
  Copyright 2018 Luxembourg University

  This file is part of Velisarios.

  Velisarios is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Velisarios is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with Velisarios.  If not, see <http://www.gnu.org/licenses/>.

  Authors: Vincent Rahli
           Ivana Vukotic

*)

Require Export list_util1.
Require Export PBFTprops2.
Require Export List.

Section PBFTprops3.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { pbft_context : PBFTcontext      }.
  Context { pbft_auth    : PBFTauth         }.
  Context { pbft_keys    : PBFTinitial_keys }.
  Context { pbft_hash    : PBFThash         }.

  Lemma request_data_and_rep_toks2prepare_as_pre_prepare2prepare :
    forall pp d i keys,
      request_data_and_rep_toks2prepare
        (pre_prepare2request_data pp d)
        (pre_prepare2rep_toks_of_prepare i keys pp d)
      = pre_prepare2prepare i keys pp d.
  Proof.
    introv; auto.
    destruct pp, b; simpl; auto.
  Qed.
  Hint Rewrite request_data_and_rep_toks2prepare_as_pre_prepare2prepare : pbft.

  Lemma is_primary_PBFTprimary :
    forall v, is_primary v (PBFTprimary v) = true.
  Proof.
    introv.
    unfold is_primary; simpl; pbft_dest_all x.
  Qed.
  Hint Rewrite is_primary_PBFTprimary : pbft.

  Lemma eq_request_data_same :
    forall x, eq_request_data x x = true.
  Proof.
    introv; unfold eq_request_data; pbft_dest_all x.
  Qed.
  Hint Rewrite eq_request_data_same : pbft.

  Hint Rewrite orb_false_r : bool.

  Lemma find_rep_toks_in_list_none_iff :
    forall i preps,
      find_rep_toks_in_list i preps = None
      <-> forall rt, In rt preps -> i <> rt_rep rt.
  Proof.
    induction preps; simpl; introv; split; intro h; tcsp; smash_pbft.

    - introv j; repndors; subst; tcsp.
      rewrite IHpreps in h.
      apply h; auto.

    - pose proof (h a) as q; autodimp q hyp; tcsp.

    - apply IHpreps; exrepnd.
      introv j; apply h; tcsp.
  Qed.

  Lemma own_prepare_is_already_in_entry_with_different_digest_false_and_same_request_data_implies_same_digest :
    forall i s v d d' a entry,
      own_prepare_is_already_in_entry_with_different_digest i s v d entry = None
      -> log_entry_request_data entry = request_data v s d'
      -> In (MkRepToks i a) (log_entry_prepares entry)
      -> d = d'.
  Proof.
    introv h q k.
    unfold own_prepare_is_already_in_entry_with_different_digest in h.
    smash_pbft.

    { rewrite q; simpl; auto. }

    { allrw find_rep_toks_in_list_none_iff.
      discover; simpl in *; tcsp. }

    { match goal with
      | [ H : _ <> _ |- _ ] => destruct H; rewrite q; simpl; auto
      end. }

    { match goal with
      | [ H : _ <> _ |- _ ] => destruct H; rewrite q; simpl; auto
      end. }
  Qed.

  Lemma own_prepare_is_already_logged_with_different_digest_false_and_prepare_in_log_implies_same_digest :
    forall L i s v d d' a,
      own_prepare_is_already_logged_with_different_digest i s v d L = None
      -> prepare_in_log (mk_prepare v s d' i a) L = true
      -> d = d'.
  Proof.
    induction L; introv h w; simpl in *; pbft_simplifier.
    smash_pbft.

    allrw is_prepare_for_entry_true_iff; simpl in *.
    allrw existsb_exists; exrepnd.
    allrw same_rep_tok_true_iff; subst.

    rename_hyp_with own_prepare_is_already_in_entry_with_different_digest own.
    eapply own_prepare_is_already_in_entry_with_different_digest_false_and_same_request_data_implies_same_digest in own; eauto.
  Qed.

  Lemma mk_prepare_eq_pre_prepare2prepare_implies_eq :
    forall v n d1 i1 a i2 keys pp d2,
      mk_prepare v n d1 i1 a = pre_prepare2prepare i2 keys pp d2
      -> i1 = i2 /\ d1 = d2.
  Proof.
    introv h.
    destruct pp, b; simpl in *.
    unfold pre_prepare2prepare, mk_prepare in *; ginv; tcsp.
  Qed.

  Lemma mk_prepare_eq_pre_prepare2prepare_implies_eq_seq :
    forall v n d1 i1 a i2 keys pp d2,
      mk_prepare v n d1 i1 a = pre_prepare2prepare i2 keys pp d2
      -> pre_prepare2seq pp = n.
  Proof.
    introv h.
    destruct pp, b; simpl in *.
    unfold pre_prepare2prepare, mk_prepare in *; ginv; tcsp.
  Qed.

  Lemma correct_new_view_implies_norepeatsb :
    forall nv,
      correct_new_view nv = true
      -> norepeatsb
           SeqNumDeq
           (map pre_prepare2seq (new_view2oprep nv ++ new_view2nprep nv)) = true.
  Proof.
    introv cor; unfold correct_new_view in cor; smash_pbft.
  Qed.

  Lemma norepeatsb_and_in_map_digest_same_seq_implies_eq :
    forall pp1 d1 pp2 d2 L,
      norepeatsb SeqNumDeq (map pre_prepare2seq L) = true
      -> In (pp1, d1) (map add_digest L)
      -> In (pp2, d2) (map add_digest L)
      -> pre_prepare2seq pp1 = pre_prepare2seq pp2
      -> pp1 = pp2 /\ d1 = d2.
  Proof.
    induction L; introv norep i1 i2 e; simpl in *; tcsp.
    smash_pbft.
    repndors; tcsp.

    - rewrite i1 in i2; ginv.

    - clear IHL.
      match goal with
      | [ H : ~ _ |- _ ] => destruct H
      end.
      unfold add_digest in i2; ginv.
      apply in_map_iff in i1; exrepnd.
      unfold add_digest in i1; ginv.
      allrw <-.
      apply in_map_iff; eexists; eauto.

    - clear IHL.
      match goal with
      | [ H : ~ _ |- _ ] => destruct H
      end.
      unfold add_digest in i1; ginv.
      apply in_map_iff in i2; exrepnd.
      unfold add_digest in i1; ginv.
      allrw <-.
      apply in_map_iff; eexists; eauto.
  Qed.

  Lemma eq_primary_implies_eq_primary :
    forall v i,
      i = PBFTprimary v
      -> is_primary v i = true.
  Proof.
    introv h.
    subst; autorewrite with pbft; auto.
  Qed.
  Hint Resolve eq_primary_implies_eq_primary : pbft.

  Lemma nat_seq_num:
    forall (n : nat) (s : SeqNum),
      n = s -> seq_num n = seq_num s.
  Proof.
    tcsp.
  Qed.
  Hint Resolve nat_seq_num : pbft.

  Lemma in_map_seq_num:
    forall (n A B : SeqNum),
      In n (map seq_num (seq A B))
      -> A <= n <= (A + B).
  Proof.
    introv H.
     apply in_map_iff in H.
    exrepnd.
    apply in_seq in H0.
    rewrite <- H1.
    smash_pbft. omega.
  Qed.
  Hint Resolve in_map_seq_num : pbft.

  Lemma in_map_seq_num_natAB:
    forall n A B,
      In n (map seq_num (seq A B))
      -> A <= n <= (A + B).
  Proof.
    introv H.
    apply in_map_iff in H.
    exrepnd.
    apply in_seq in H0.
    rewrite <- H1.
    smash_pbft. omega.
  Qed.
  Hint Resolve in_map_seq_num_natAB : pbft.

  Lemma max_seq_num_left :
    forall (n n1 n2 : SeqNum), n <= n1 -> n <= max_seq_num n1 n2.
  Proof.
    introv h; destruct n, n1, n2; unfold max_seq_num; simpl in *; smash_pbft.
    allrw SeqNumLe_true; auto; simpl in *; omega.
  Qed.
  Hint Resolve max_seq_num_left : pbft.

  Lemma max_seq_num_right :
    forall (n n1 n2 : SeqNum), n <= n2 -> n <= max_seq_num n1 n2.
  Proof.
    introv h; destruct n1, n2; unfold max_seq_num; simpl in *; smash_pbft.
    allrw SeqNumLe_false; simpl in *; omega.
  Qed.
  Hint Resolve max_seq_num_right : pbft.

  Lemma in_from_min_to_max_op_implies :
    forall n minop maxop,
      In n (from_min_to_max_op minop maxop)
      ->
      exists min max,
        minop = Some min
        /\ maxop = Some max
        /\ min <= max
        /\ min < n
        /\ n <= max.
  Proof.
    introv h; unfold from_min_to_max_op, from_min_to_max in h;
      smash_pbft; repndors; subst; tcsp.

    apply in_map_iff in h; exrepnd; subst.
    apply in_seq in h0.
    rewrite plus_Sn_m in h0; rewrite le_plus_minus_r in h0; smash_pbft.
    eexists; eexists; dands; eauto; try omega.
  Qed.

  Lemma vce_view_changes_replace_own_view_change_in_entry :
    forall vc e,
      vce_view_changes (replace_own_view_change_in_entry vc e)
      = vce_view_changes e.
  Proof.
    destruct e; simpl; auto.
  Qed.
  Hint Rewrite vce_view_changes_replace_own_view_change_in_entry : pbft.

  Lemma view_changed_entry_some_implies_eq_vce_view_changes :
    forall state entry vc entry',
      view_changed_entry state entry = Some (vc, entry')
      -> vce_view_changes entry' = vce_view_changes entry.
  Proof.
    introv h; unfold view_changed_entry in h; smash_pbft.
  Qed.

  Lemma view_changed_entry_some_implies_cons :
    forall state entry vc entry',
      view_changed_entry state entry = Some (vc, entry')
      -> view_change_entry2view_changes entry' = vc :: vce_view_changes entry.
  Proof.
    introv h; unfold view_changed_entry in h; smash_pbft.
    unfold view_change_entry2view_changes.
    destruct entry; simpl in *.
    destruct vce_view_change; simpl in *; ginv.
  Qed.

  Fixpoint max_seq_nums (L : list SeqNum) : SeqNum :=
    match L with
    | [] => seq_num 0
    | s :: sn => max_seq_num s (max_seq_nums sn)
    end.

  Fixpoint ordered {T} (R : T -> T -> bool) (L : list T) : Prop :=
    match L with
    | [] => True
    | x :: xs =>
      (forall a, In a xs -> R x a = true)
      /\ ordered R xs
    end.

  Lemma max_seq_num_assoc :
    forall (a b c : SeqNum),
      max_seq_num a (max_seq_num b c) = max_seq_num (max_seq_num a b) c.
  Proof.
    introv; destruct a, b, c; unfold max_seq_num; smash_pbft;
      allrw SeqNumLe_true;
      allrw SeqNumLe_false; simpl in *; omega.
  Qed.

  Lemma max_seq_num_eq_right :
    forall (a b : SeqNum),
      a < b
      -> max_seq_num a b = b.
  Proof.
    introv h; destruct a, b; unfold max_seq_num; smash_pbft.
    allrw SeqNumLe_false; simpl in *; omega.
  Qed.

  Lemma max_seq_num_eq_left :
    forall (a b : SeqNum),
      b <= a
      -> max_seq_num a b = a.
  Proof.
    introv h; destruct a, b; unfold max_seq_num; smash_pbft.
    allrw SeqNumLe_true; simpl in *.
    assert (n = n0) as xx by omega; subst; auto.
  Qed.

  Lemma max_seq_num_0_right :
    forall (a : SeqNum),
      max_seq_num a 0 = a.
  Proof.
    introv; pose proof (max_seq_num_eq_left a (seq_num 0)) as h.
    apply h; destruct a; simpl in *; omega.
  Qed.
  Hint Rewrite max_seq_num_0_right : pbft.

  Lemma max_seq_nums_right_if_lt :
    forall K a,
      (forall x : SeqNum, In x K -> SeqNumLt a x = true)
      -> K <> []
      -> max_seq_num a (max_seq_nums K) = max_seq_nums K.
  Proof.
    destruct K; introv h w; simpl in *; autorewrite with pbft in *; tcsp.
    pose proof (h s) as q; autodimp q hyp.
    allrw SeqNumLt_true.
    rewrite max_seq_num_assoc.
    rewrite (max_seq_num_eq_right a s); auto.
  Qed.

  Lemma nullb_false_iff :
    forall {T} (L : list T),
      nullb L = false <-> L <> [].
  Proof.
    introv; destruct L; simpl; split; intro q; tcsp.
  Qed.

  Lemma implies_eq_seq_nums :
    forall (s1 s2 : SeqNum), seqnum2nat s1 = seqnum2nat s2 -> s1 = s2.
  Proof.
    introv; destruct s1, s2; simpl in *; tcsp.
  Qed.

  Lemma max_seq_num_diff_left_implies_gt :
    forall (a b : SeqNum),
      max_seq_num a b <> a -> a < b.
  Proof.
    introv h; unfold max_seq_num in *; smash_pbft.
    allrw SeqNumLe_true; simpl in *.
    destruct a as [n], b as [m]; simpl in *.
    assert (n <> m); try omega.
    intro xx; subst; tcsp.
  Qed.

  Lemma diff_nat_implies_diff_seq_num :
    forall (a b : SeqNum),
      seqnum2nat a <> seqnum2nat b -> a <> b.
  Proof.
    introv h; destruct a, b; simpl in *; intro xx; subst; destruct h; tcsp.
    inversion xx; auto.
  Qed.

(*  Lemma exists_find_pre_prepare_certificate_in_prepared_infos :
    forall vc n,
      view_change2max_seq_preps vc = Some n
      ->
      exists ppi,
        find_pre_prepare_certificate_in_prepared_infos
          (view_change2max_seq_preps vc) (view_change2prep vc) = Some ppi.
  Proof.
    introv n0.
    destruct vc, v; simpl.
    unfold view_change2max_seq in *; simpl in *.
    unfold view_change2prep in *; simpl in *.
    induction P; simpl in *; tcsp.
    smash_pbft.

    match goal with
    | [ H : _ <> _ |- _ ] =>
      apply max_seq_num_diff_left_implies_gt in H
    end.
    autodimp IHP hyp.
    { apply diff_nat_implies_diff_seq_num; simpl; omega. }

    rewrite max_seq_num_eq_right; auto.
  Qed.*)

  Lemma create_new_prepare_message_implies_same_sequence_number :
    forall n v keys cert b p d,
      create_new_prepare_message n v keys cert = (b,(p,d))
      -> pre_prepare2seq p = n.
  Proof.
    introv create.
    unfold create_new_prepare_message in create; smash_pbft.
  Qed.

  Lemma create_new_prepare_message_implies_same_view :
    forall n v keys cert b p d,
      create_new_prepare_message n v keys cert = (b,(p,d))
      -> pre_prepare2view p = v.
  Proof.
    introv create.
    unfold create_new_prepare_message in create; smash_pbft.
  Qed.

  Lemma create_new_prepare_message_implies_auth :
    forall n v keys cert b p d,
      create_new_prepare_message n v keys cert = (b,(p,d))
      -> pre_prepare2auth p = authenticate (PBFTmsg_bare_pre_prepare (pre_prepare2bare p)) keys.
  Proof.
    introv create.
    unfold create_new_prepare_message in create; smash_pbft.
  Qed.

  Lemma eqset_cons_lr :
    forall {A} (a : A) l1 l2,
      eqset l1 l2
      -> eqset (a :: l1) (a :: l2).
  Proof.
    introv eqs; introv; split; intro h; simpl in *; repndors; tcsp; right;
      apply eqs; auto.
  Qed.

  Lemma eqset_cons_middle :
    forall {A} (a : A) l1 l2,
      eqset (l1 ++ a :: l2) (a :: l1 ++ l2).
  Proof.
    repeat introv; split; intro h; simpl in *; allrw in_app_iff; simpl in *; tcsp.
  Qed.

  Lemma implies_norepeatsb_middle :
    forall {A} (deq : Deq A) (a : A) l1 l2,
      norepeatsb deq (a :: l1 ++ l2) = true
      -> norepeatsb deq (l1 ++ a :: l2) = true.
  Proof.
    induction l1; introv norep; simpl in *; smash_pbft.

    - allrw in_app_iff; simpl in *.
      repeat match goal with
             | [ H : ~ (_ \/ _) |- _ ] => apply not_or in H; repnd
             end.
      repndors; tcsp.

    - allrw in_app_iff; simpl in *.
      repeat match goal with
             | [ H : ~ (_ \/ _) |- _ ] => apply not_or in H; repnd
             end.
      repndors; tcsp.
      apply IHl1; smash_pbft.
      allrw in_app_iff; tcsp.
  Qed.

  Lemma create_new_prepare_messages_implies_eqset_and_norepeatsb :
    forall sns v keys cert OP NP,
      norepeatsb SeqNumDeq sns = true
      -> create_new_prepare_messages sns v keys cert = (OP, NP)
      -> eqset sns (map pre_prepare2seq (map fst OP ++ map fst NP))
         /\ norepeatsb SeqNumDeq (map pre_prepare2seq (map fst OP ++ map fst NP)) = true.
  Proof.
    induction sns; introv norep create; simpl in *; smash_pbft; repnd; simpl in *.

    - assert False; tcsp.

      match goal with
      | [ H : create_new_prepare_messages _ _ _ _ = _ |- _ ] =>
        eapply IHsns in H; auto;[]; repnd
      end.

      match goal with
      | [ H : create_new_prepare_message _ _ _ _ = _ |- _ ] =>
        apply create_new_prepare_message_implies_same_sequence_number in H;
          rewrite H in *
      end.

      match goal with
      | [ H1 : In _ ?x, H2 : eqset _ ?x |- _ ] => apply H2 in H1; tcsp
      end.

    - match goal with
      | [ H : create_new_prepare_messages _ _ _ _ = _ |- _ ] =>
        eapply IHsns in H; auto;[]; repnd
      end.

      match goal with
      | [ H : create_new_prepare_message _ _ _ _ = _ |- _ ] =>
        dup H as create;
          apply create_new_prepare_message_implies_same_sequence_number in create;
          rewrite create in *
      end.

      dands; tcsp.
      apply eqset_cons_lr; auto.

    - match goal with
      | [ H : create_new_prepare_messages _ _ _ _ = _ |- _ ] =>
        eapply IHsns in H; auto;[]; repnd
      end.

      match goal with
      | [ H : create_new_prepare_message _ _ _ _ = _ |- _ ] =>
        dup H as create;
          apply create_new_prepare_message_implies_same_sequence_number in create
      end.

      allrw map_app; simpl in *.

      rewrite create.
      dands.

      + eapply eqset_trans;[apply eqset_cons_lr;eauto|].
        apply eqset_sym; apply eqset_cons_middle.

      + apply implies_norepeatsb_middle; auto.
        simpl; smash_pbft.

        match goal with
        | [ H1 : In _ ?x, H2 : eqset _ ?x |- _ ] => apply H2 in H1; tcsp
        end.
  Qed.

  Lemma create_new_prepare_messages_implies_norepeatsb :
    forall sns v keys cert OP NP,
      norepeatsb SeqNumDeq sns = true
      -> create_new_prepare_messages sns v keys cert = (OP, NP)
      -> norepeatsb SeqNumDeq (map pre_prepare2seq (map fst OP ++ map fst NP)) = true.
  Proof.
    introv norep create.
    eapply create_new_prepare_messages_implies_eqset_and_norepeatsb in create; eauto; tcsp.
  Qed.
  Hint Resolve create_new_prepare_messages_implies_norepeatsb : pbft.

  Lemma implies_norepeatsb_map_seq_num :
    forall l,
      norepeatsb deq_nat l = true
      -> norepeatsb SeqNumDeq (map seq_num l) = true.
  Proof.
    induction l; introv norep; simpl in *; smash_pbft.
    apply in_map_iff in i; exrepnd; subst.
    inversion i1; simpl in *; subst; GC; tcsp.
  Qed.
  Hint Resolve implies_norepeatsb_map_seq_num : pbft.

  Lemma norepeatsb_seq :
    forall len pos,
      norepeatsb deq_nat (seq pos len) = true.
  Proof.
    induction len; introv; simpl in *; smash_pbft.
    apply in_seq in i; omega.
  Qed.
  Hint Resolve norepeatsb_seq : pbft.

  Lemma norepeatsb_from_min_to_max :
    forall a b, norepeatsb SeqNumDeq (from_min_to_max a b) = true.
  Proof.
    introv; unfold from_min_to_max; smash_pbft; simpl in *.
  Qed.
  Hint Resolve norepeatsb_from_min_to_max : pbft.

  Lemma norepeatsb_from_min_to_max_op :
    forall a b, norepeatsb SeqNumDeq (from_min_to_max_op a b) = true.
  Proof.
    introv; unfold from_min_to_max_op; smash_pbft.
  Qed.
  Hint Resolve norepeatsb_from_min_to_max_op : pbft.

  Lemma norepeatsb_from_min_to_max_of_view_changes :
    forall entry,
      norepeatsb SeqNumDeq (from_min_to_max_of_view_changes entry) = true.
  Proof.
    introv; unfold from_min_to_max_of_view_changes, from_min_to_max_of_view_changes_cert; smash_pbft.
  Qed.
  Hint Resolve norepeatsb_from_min_to_max_of_view_changes : pbft.

  Lemma pre_prepare2seq_mk_auth_pre_prepare :
    forall v sn rs keys,
      pre_prepare2seq (mk_auth_pre_prepare v sn rs keys) = sn.
  Proof.
    sp.
  Qed.
  Hint Rewrite pre_prepare2seq_mk_auth_pre_prepare : pbft.

  Lemma implies_le_max_seq_nums :
    forall (n : SeqNum) (L : list SeqNum),
      In n L
      -> n <= max_seq_nums L.
  Proof.
    induction L; introv i; simpl in *; tcsp.
    repndors; subst; simpl in *; tcsp; eauto 2 with pbft.
    autodimp IHL hyp.
    eauto 2 with pbft.
  Qed.

  (*Lemma implies_create_new_prepare_message_cons_true :
    forall n v keys c C ppd,
      create_new_prepare_message n v keys C = (true, ppd)
      -> exists ppd1, create_new_prepare_message n v keys (c :: C) = (true, ppd1).
  Proof.
    introv h.
    unfold create_new_prepare_message in *; simpl in *.
    unfold find_request_info_in_view_change_cert in *; simpl in *.
    smash_pbft.
  Qed.
  Hint Resolve implies_create_new_prepare_message_cons_true : pbft.*)

(*  Lemma PreparedInfos2max_seq_implies_find_pre_prepare_certificate_in_prepared_infos_some :
    forall L n,
      PreparedInfos2max_seq L = Some n
      -> exists x, find_pre_prepare_certificate_in_prepared_infos n L = Some x.
  Proof.
    induction L; introv h; simpl in *; smash_pbft.
  Qed.*)

(*  Lemma view_change2max_seq_preps_some_implies_create_new_prepare_message_true :
    forall vc n v keys C,
      view_change2max_seq_preps vc = Some n
      -> exists ppd, create_new_prepare_message n v keys (vc :: C) = (true, ppd).
  Proof.
    introv h; unfold view_change2max_seq_preps in h.
    unfold create_new_prepare_message; simpl.
    unfold find_request_info_in_view_change_cert; simpl.
    smash_pbft.
    assert False; tcsp.
  Qed.*)

  Lemma PreparedInfos2max_seq_some_implies_ex :
    forall F L n,
      PreparedInfos2max_seq F L = Some n
      -> exists p, In p L /\ n = prepared_info2seq p /\ F p = true.
  Proof.
    induction L; introv h; simpl in *; ginv.
    remember (PreparedInfos2max_seq F L) as m; symmetry in Heqm; destruct m.

    - pose proof (IHL s) as q; autodimp q hyp; clear IHL; exrepnd; simpl in *.
      unfold max_seq_num in *; smash_pbft; allrw SeqNumLe_true; allrw SeqNumLe_false.

      + exists p; dands; tcsp.

      + exists a; dands; tcsp.

      + exists p; dands; tcsp.

    - clear IHL; simpl in *; smash_pbft.
      exists a; dands; tcsp.
  Qed.

  Lemma view_change_cert2max_seq_preps_some_implies :
    forall F C n vc,
      view_change_cert2max_seq_preps_vc F C = Some (n,vc)
      -> In vc C
         /\
         exists p,
           In p (view_change2prep vc)
           /\ n = prepared_info2seq p
           /\ F p = true.
  Proof.
    induction C; introv h; simpl in *; ginv; simpl in *; tcsp.
    smash_pbft; allrw SeqNumLt_true; allrw SeqNumLt_false.

    - pose proof (IHC n vc) as q; autodimp q hyp; clear IHC; repnd; tcsp.

    - dands; tcsp.
      apply PreparedInfos2max_seq_some_implies_ex; auto.

    - dands; tcsp.
      apply PreparedInfos2max_seq_some_implies_ex; auto.

    - pose proof (IHC x0 x) as q; clear IHC; autodimp q hyp; dands; tcsp.
  Qed.

  (*Lemma implies_pre_prepare_certificate_in_prepared_infos_some :
    forall p L,
      In p L
      ->
      exists x,
        find_pre_prepare_certificate_in_prepared_infos (prepared_info2seq p) L = Some x.
  Proof.
    induction L; introv i; simpl in *; tcsp.
    repndors; subst; smash_pbft.
  Qed.*)

(*  Lemma implies_in_view_change2prep_implies_create_new_prepare_message_true :
    forall vc p v keys C,
      In vc C
      -> In p (view_change2prep vc)
      -> exists ppd, create_new_prepare_message (prepared_info2seq p) v keys C = (true, ppd).
  Proof.
    induction C; introv i j; simpl in *; tcsp.
    repndors; subst; tcsp.

    - unfold create_new_prepare_message; simpl.
      unfold find_request_info_in_view_change_cert; simpl.
      smash_pbft.

      apply implies_pre_prepare_certificate_in_prepared_infos_some in j; exrepnd.
      allrw j0; ginv.

    - repeat (autodimp IHC hyp); exrepnd.
      unfold create_new_prepare_message in *; simpl in *.
      unfold find_request_info_in_view_change_cert in *; simpl in *.
      smash_pbft.
  Qed.*)

(*  Lemma view_change_cert2max_seq_preps_vc_implies_exists_or_zero :
    forall v keys C n vc,
      view_change_cert2max_seq_preps_vc C = Some (n,vc)
      -> exists ppd, create_new_prepare_message n v keys C = (true, ppd).
  Proof.
    introv cert.
    apply view_change_cert2max_seq_preps_some_implies in cert.
    exrepnd.
    subst.
    eapply implies_in_view_change2prep_implies_create_new_prepare_message_true; eauto.
  Qed.*)

(*  Lemma view_change_cert2max_seq_preps_implies_exists_or_zero :
    forall v keys C n,
      view_change_cert2max_seq_preps C = Some n
      -> exists ppd, create_new_prepare_message n v keys C = (true, ppd).
  Proof.
    introv cert.
    unfold view_change_cert2max_seq_preps in cert; smash_pbft.
    eapply view_change_cert2max_seq_preps_vc_implies_exists_or_zero; eauto.
  Qed.*)

(*  Lemma view_change_cert2max_seq_preps_and_create_new_prepare_messages_implies_le :
    forall K sn v keys C OP NP,
      view_change_cert2max_seq_preps C = Some sn
      -> create_new_prepare_messages K v keys C = (OP, NP)
      -> ordered SeqNumLt K
      -> sn = max_seq_nums K
      -> K <> []
      -> sn <= max_O OP.
  Proof.
    induction K; introv h q ord w knn; simpl in *; ginv.
    smash_pbft; repnd.

    - remember (nullb K) as b; symmetry in Heqb.
      destruct b.

      + rewrite nullb_true_iff in Heqb; subst; simpl in *; ginv; simpl in *; GC.
        clear ord knn.
        autorewrite with pbft in *.

        match goal with
        | [ H : create_new_prepare_message _ _ _ _ = _ |- _ ] =>
          apply create_new_prepare_message_implies in H; exrepnd; subst; simpl; auto
        end.

      + apply nullb_false_iff in Heqb.
        eapply IHK in h;[|eauto| | |]; auto; eauto 2 with pbft.
        apply max_seq_nums_right_if_lt; auto.

    - remember (nullb K) as b; symmetry in Heqb.
      destruct b.

      + rewrite nullb_true_iff in Heqb; subst; simpl in *; ginv; simpl in *; GC.
        clear ord knn.
        autorewrite with pbft in *.

        apply (view_change_cert2max_seq_preps_implies_exists_or_zero v keys) in h.
        repndors; subst; tcsp;[].
        exrepnd.
        rewrite h0 in *; ginv.

      + apply nullb_false_iff in Heqb.
        eapply IHK in h;[|eauto| | |]; auto; eauto 2 with pbft.
        apply max_seq_nums_right_if_lt; auto.
  Qed.*)

(*  Lemma pre_prepares2max_seq_OP_of_create_new_prepare_messages :
    forall L v keys C sn ovc OP NP,
      view_change_cert2max_seq C = (sn, ovc)
      -> sn = max_seq_nums L
      -> ordered SeqNumLt L
      -> L <> []
      -> create_new_prepare_messages L v keys C = (OP, NP)
      -> forall n, In n L -> n <= pre_prepares2max_seq (map fst OP).
  Proof.
    introv vmax eqsn ord diff create i.
    eapply view_change_cert2max_seq_and_create_new_prepare_messages_implies_le in create;
      [|eauto|eauto| |]; auto.
    rewrite <- max_O_as_pre_prepares2max_seq.
    eapply le_trans;[|eauto].
    subst.
    apply implies_le_max_seq_nums; auto.
  Qed.*)

  Lemma implies_ordered_map_seq_num :
    forall (L : list nat),
      ordered Nat.ltb L
      -> ordered SeqNumLt (map seq_num L).
  Proof.
    induction L; simpl in *; introv h; auto.
    repnd.
    dands; auto.
    introv i.
    apply in_map_iff in i; exrepnd; subst.
    apply SeqNumLt_true.
    apply h0 in i0; pbft_simplifier; auto.
  Qed.

  Lemma ordered_seq :
    forall (len n : nat),
      ordered Nat.ltb (seq n len).
  Proof.
    induction len; simpl; auto.
    introv; dands; auto.
    introv i.
    apply Nat.ltb_lt; auto.
    apply in_seq in i; tcsp.
  Qed.
  Hint Resolve ordered_seq : num.

(*  Lemma le_seq_num_implies_from_min_to_max_not_null :
    forall (sn1 sn2 : SeqNum),
      sn1 < sn2
      -> from_min_to_max sn1 sn2 <> [].
  Proof.
    introv d.
    unfold from_min_to_max; smash_pbft; try omega; tcsp.

  Qed.
  Hint Resolve le_seq_num_implies_from_min_to_max_not_null : pbft.*)

  Lemma in_list_implies_diff_nil :
    forall {A} (l : list A) a,
      In a l -> l <> [].
  Proof.
    introv i; destruct l; simpl in *; tcsp.
  Qed.
  Hint Resolve in_list_implies_diff_nil : pbft.

  Lemma ordered_from_min_to_max :
    forall (sn1 sn2 : SeqNum),
      ordered SeqNumLt (from_min_to_max sn1 sn2).
  Proof.
    introv; unfold from_min_to_max; smash_pbft.
    apply implies_ordered_map_seq_num; eauto 3 with num.
  Qed.
  Hint Resolve ordered_from_min_to_max : pbft.

  Lemma ordered_from_min_to_max_op :
    forall (sn1 sn2 : option SeqNum),
      ordered SeqNumLt (from_min_to_max_op sn1 sn2).
  Proof.
    introv; unfold from_min_to_max_op; smash_pbft.
  Qed.
  Hint Resolve ordered_from_min_to_max_op : pbft.

  Lemma max_seq_nums_map_seq_num_seq :
    forall (len n : nat),
      0 < len
      -> max_seq_nums (map seq_num (seq (S n) len)) = len + n.
  Proof.
    induction len; introv h; simpl; autorewrite with pbft; auto; try omega.
    simpl in *.
    destruct (lt_dec 0 len) as [d|d].
    { rewrite IHlen; auto.
      rewrite max_seq_num_eq_right; auto; simpl; try omega. }
    { assert (len = 0) by omega; subst; simpl in *; autorewrite with pbft; auto. }
  Qed.

  Lemma max_seq_nums_from_min_to_max :
    forall (sn1 sn2 : SeqNum),
      sn1 < sn2
      -> max_seq_nums (from_min_to_max sn1 sn2) = sn2.
  Proof.
    Opaque seq.
    introv h; unfold from_min_to_max; smash_pbft; try omega.
    rewrite max_seq_nums_map_seq_num_seq; simpl in *; try omega.
    rewrite Nat.sub_add; simpl; auto.
    destruct sn2; simpl; auto.
  Qed.

  Lemma in_from_min_to_max_implies_lt :
    forall n (min max : SeqNum),
      In n (from_min_to_max min max)
      -> min < max.
  Proof.
    introv i; unfold from_min_to_max in i; smash_pbft.
    apply in_map_iff in i; exrepnd; subst.
    apply in_seq in i0.
    omega.
  Qed.
  Hint Resolve in_from_min_to_max_implies_lt : pbft.

(*  Lemma view_changed_entry_some_and_check_broadcast_new_view_implies_le :
    forall n entry vc i keys nv opreps npreps,
      In n (from_min_to_max_of_view_changes entry)
      -> view_changed_entry (vce_view entry) entry = Some vc
      -> check_broadcast_new_view i keys entry = Some (nv, opreps, npreps)
      -> n <= max_O opreps.
  Proof.
    introv k vce c.
    unfold check_broadcast_new_view in c; smash_pbft.
    unfold from_min_to_max_of_view_changes in *; smash_pbft.

    applydup in_from_min_to_max_op_implies in k; exrepnd.
    eapply le_trans;[eauto|].

    match goal with
    | [ H : view_changed_entry _ _ = _ |- _ ] =>
      applydup view_changed_entry_some_implies_cons in H as eqvcs;
        rewrite eqvcs in *
    end.

    match goal with
    | [ H : context[vce_view_changes ?e] |- _ ] =>
      remember (vce_view_changes e) as VCS
    end.

    match goal with
    | [ H : context[view_change_cert2max_seq ?a] |- _ ] =>
      remember (view_change_cert2max_seq a) as sn1
    end.

    subst.
    allrw k1.
    allrw k2.
    simpl in *.

    match goal with
    | [ H : create_new_prepare_messages _ _ _ _ = _ |- _ ] =>
      eapply view_change_cert2max_seq_preps_and_create_new_prepare_messages_implies_le in H;
        [|eauto| | |]; auto; allrw; simpl; eauto 2 with pbft;[]
    end.

    rewrite max_seq_nums_from_min_to_max; eauto 2 with pbft.
  Qed.*)

  Lemma next_seq_not_le :
    forall (sn : SeqNum),
      next_seq sn <= sn -> False.
  Proof.
    introv h; destruct sn; unfold next_seq in h; simpl in *; omega.
  Qed.

  Lemma pre_prepare_in_map_correct_new_view_implies :
    forall v n rs a d nv,
      In (mk_pre_prepare v n rs a, d) (map add_digest (new_view2oprep nv ++ new_view2nprep nv))
      -> correct_new_view nv = true
      -> new_view2view nv = v.
  Proof.
    introv i cor.
    unfold correct_new_view in cor; smash_pbft.
    destruct nv, v0; simpl in *.
    allrw forallb_forall.
    allrw in_map_iff; exrepnd.
    unfold add_digest in *; ginv.
    allrw in_app_iff; repndors.

    - match goal with
      | [ H : context[forall _ : _, In _ OP -> _], H' : In _ OP |- _ ] =>
        apply H in H'; clear H
      end.
      unfold correct_new_view_opre_prepare_op in *; smash_pbft.
      unfold correct_new_view_opre_prepare in *; smash_pbft.

    - match goal with
      | [ H : context[forall _ : _, In _ NP -> _], H' : In _ NP |- _ ] =>
        apply H in H'; clear H
      end.
      unfold correct_new_view_npre_prepare_op in *; smash_pbft.
      unfold correct_new_view_npre_prepare in *; smash_pbft.
  Qed.

  Lemma new_view2sender_eq_primary :
    forall nv, new_view2sender nv = PBFTprimary (new_view2view nv).
  Proof.
    destruct nv, v; simpl; auto.
  Qed.
  Hint Resolve new_view2sender_eq_primary : pbft.

  Lemma nexists_last_prepared_true_implies :
    forall pp P,
      nexists_last_prepared pp P = true
      ->
      exists nfo,
        In nfo P
        /\ pre_prepare2seq pp = prepared_info2seq nfo
        /\ valid_prepared_info P nfo = true.
  Proof.
    introv h; unfold nexists_last_prepared in h.
    apply existsb_exists in h; exrepnd; smash_pbft.
    exists x; tcsp.
  Qed.

  Lemma last_prepared_info_app_true :
    forall nfo l1 l2,
      last_prepared_info nfo (l1 ++ l2)
      = last_prepared_info nfo l1 && last_prepared_info nfo l2.
  Proof.
    induction l1; introv; simpl; auto.
    smash_pbft; try (rewrite IHl1); auto;
      try (complete (rewrite andb_assoc; auto)).
  Qed.

  Lemma create_new_prepare_messages_view_change_cert2max_seq_none_implies :
    forall entry view keys OP NP,
      create_new_prepare_messages
        (from_min_to_max_of_view_changes entry)
        view keys
        (view_change_cert2prep (view_change_entry2view_changes entry)) = (OP, NP)
      -> view_change_cert2max_seq (view_change_entry2view_changes entry) = None
      -> OP = []
         /\ NP = []
         /\ from_min_to_max_of_view_changes entry = [].
  Proof.
    introv h q.
    unfold from_min_to_max_of_view_changes, from_min_to_max_of_view_changes_cert in *.
    rewrite q in *; simpl in *; ginv.
  Qed.

  Lemma in_from_min_to_max_of_view_changes_implies_lt_min :
    forall entry min n,
      view_change_cert2max_seq (view_change_entry2view_changes entry) = Some min
      -> In n (from_min_to_max_of_view_changes entry)
      -> min < n.
  Proof.
    introv h i.
    apply in_from_min_to_max_op_implies in i; exrepnd.
    rewrite h in *; ginv.
  Qed.
  Hint Resolve in_from_min_to_max_of_view_changes_implies_lt_min : pbft.

  Lemma implies_length_view_change_entry2view_changes :
    forall entry n,
      is_some (vce_view_change entry) = true
      -> n = length (vce_view_changes entry)
      -> n + 1 = length (view_change_entry2view_changes entry).
  Proof.
    introv h q; destruct entry; simpl in *.
    destruct vce_view_change; simpl in *; ginv; omega.
  Qed.

  Lemma oexists_last_prepared_false_implies :
    forall pp d P,
      oexists_last_prepared pp d P = false
      ->
      forall nfo,
        In nfo P
        -> pre_prepare2seq pp <> prepared_info2seq nfo
           \/  d <> prepared_info2digest nfo
           \/ valid_prepared_info P nfo = false.
  Proof.
    introv h i; unfold oexists_last_prepared in h.
    rewrite existsb_false in h.
    apply h in i; smash_pbft.
  Qed.

  Lemma max_O_in :
    forall L,
      L <> []
      ->
      exists pp d,
        max_O L = pre_prepare2seq pp
        /\ In (pp,d) L.
  Proof.
    induction L; intro h; tcsp; repnd; simpl in *.
    clear h.
    destruct L; simpl in *; tcsp.

    - clear IHL.
      autorewrite with pbft.
      eexists; dands; eauto.

    - autodimp IHL hyp; tcsp;[].
      exrepnd.
      repndors; ginv; tcsp;
        allrw;
        unfold max_seq_num; simpl; smash_pbft;
          eexists; eexists; dands; eauto.
  Qed.

  Lemma false_implies_in_create_new_prepare_messages_n_pre_prepare :
    forall n ppd L view keys C OP NP,
      create_new_prepare_messages L view keys C = (OP, NP)
      -> In n L
      -> create_new_prepare_message n view keys C = (false, ppd)
      -> In ppd NP.
  Proof.
    induction L; introv creates i create; simpl in *; smash_pbft.

    - repndors; subst; tcsp.

      + rewrite create in *; ginv.

      + eapply IHL; eauto.

    - repndors; subst; tcsp.

      + rewrite create in *; ginv.

      + right; eapply IHL; eauto.
  Qed.

  Lemma create_new_prepare_message_true_implies_oprep_not_nil :
    forall L view keys C OP NP n ppd,
      create_new_prepare_messages L view keys C = (OP, NP)
      -> In n L
      -> create_new_prepare_message n view keys C = (true,ppd)
      -> In ppd OP.
  Proof.
    induction L; introv creates i create; simpl in *; tcsp.
    smash_pbft; repndors; subst; tcsp.

    - rewrite create in *; ginv.

    - right; eapply IHL; eauto.

    - rewrite create in *; ginv.

    - eapply IHL; eauto.
  Qed.

  Lemma seq_num_seqnum2nat :
    forall (n : SeqNum), seq_num (seqnum2nat n) = n.
  Proof.
    destruct n; simpl; auto.
  Qed.
  Hint Rewrite seq_num_seqnum2nat : pbft.

  Lemma implies_max_in_from_min_to_max :
    forall n min max,
      In n (from_min_to_max min max)
      -> In max (from_min_to_max min max).
  Proof.
    unfold from_min_to_max; introv h; smash_pbft; simpl in *.
    allrw in_map_iff; exrepnd; subst.
    exists max; dands; simpl in *; autorewrite with pbft in *; auto.
    allrw in_seq; omega.
  Qed.
  Hint Resolve implies_max_in_from_min_to_max : pbft.

  Lemma norepeatsb_pre_prepare2seq_oprep_nprep_implies :
    forall (OP NP : list (Pre_prepare * PBFTdigest)) pp1 d1 pp2 d2,
      norepeatsb SeqNumDeq (map pre_prepare2seq (map fst OP ++ map fst NP)) = true
      -> pre_prepare2seq pp1 = pre_prepare2seq pp2
      -> In (pp1, d1) NP
      -> In (pp2, d2) OP
      -> False.
  Proof.
    introv norep e i1 i2.
    apply norepeatsb_as_no_repeats in norep.
    rewrite map_app in norep.
    apply no_repeats_app in norep; repnd.

    apply (norep (pre_prepare2seq pp1)); apply in_map_iff.

    - exists pp2; dands; auto.
      apply in_map_iff; eexists; dands; eauto; simpl; auto.

    - exists pp1; dands; auto.
      apply in_map_iff; eexists; dands; eauto; simpl; auto.
  Qed.

(*  Lemma find_pre_prepare_certificate_in_prepared_infos_none_implies :
    forall sn L,
      find_pre_prepare_certificate_in_prepared_infos sn L = None
      -> ~ In sn (map prepared_info2seq L).
  Proof.
    induction L; introv i j; simpl in *; tcsp.
    smash_pbft.
    repndors; subst; tcsp.
  Qed.*)

(*  Lemma find_pre_prepare_certificate_in_view_change_cert_none_implies :
    forall sn C,
      find_pre_prepare_certificate_in_view_change_cert sn C = None
      -> ~ In sn (map prepared_info2seq (view_change_cert2prep C)).
  Proof.
    induction C; introv h i; simpl in *; tcsp.
    allrw map_app.
    allrw in_app_iff.
    smash_pbft.
    autodimp IHC hyp.
    repndors; tcsp.

    match goal with
    | [ H : find_pre_prepare_certificate_in_prepared_infos _ _ = _ |- _ ] =>
      apply find_pre_prepare_certificate_in_prepared_infos_none_implies in H
    end; tcsp.
  Qed.*)

(*  Lemma implies_find_pre_prepare_certificate_in_view_change_cert_some :
    forall sn C nfo,
      In nfo (view_change_cert2prep C)
      -> sn = prepared_info2seq nfo
      -> last_prepared_info nfo (view_change_cert2prep C) = true
      -> exists nfo', find_pre_prepare_certificate_in_view_change_cert sn C = Some nfo'.
  Proof.
    induction C; introv i h q; simpl in *; tcsp.
    allrw in_app_iff.
    allrw last_prepared_info_app_true.
    allrw andb_true; repnd.
    repndors; tcsp; smash_pbft.

    - unfold pick_prepared_info_with_highest_view; smash_pbft.
  Qed.*)

(*  Lemma find_pre_prepare_certificate_in_view_change_cert_none_implies_nexists_last_prepared_none :
    forall sn vcs v rs keys,
      find_pre_prepare_certificate_in_view_change_cert sn vcs = None
      -> nexists_last_prepared
           (mk_auth_pre_prepare v sn rs keys)
           (view_change_cert2prep vcs) = false.
  Proof.
    introv h.
    match goal with
    | [ |- ?a = _ ] => remember a as b; destruct b; auto; symmetry in Heqb
    end.

    assert False; tcsp.
    apply nexists_last_prepared_true_implies in Heqb; exrepnd; simpl in *.

    Check find_pre_prepare_certificate_in_view_change_cert.

    apply find_pre_prepare_certificate_in_view_change_cert_none_implies in h.
    destruct h.
    apply in_map_iff.
    exists nfo; dands; auto.
  Qed.*)

(*  Lemma create_new_prepare_message_false_implies_correct :
    forall (sn : SeqNum) v keys vcs pp d (n max : SeqNum),
      n < sn
      -> sn < max
      -> create_new_prepare_message sn v keys vcs = (false,(pp,d))
      -> correct_new_view_npre_prepare v n max (view_change_cert2prep vcs) pp = true.
  Proof.
    introv ltsn ltmax create.
    unfold create_new_prepare_message in create; smash_pbft.
    unfold find_request_info_in_view_change_cert in *; smash_pbft.

    unfold correct_new_view_npre_prepare; simpl; smash_pbft;
      allrw SeqNumLt_true; allrw SeqNumLt_false; simpl in *; try omega; GC.

    apply negb_true_iff.
    apply find_pre_prepare_certificate_in_view_change_cert_none_implies_nexists_last_prepared_none; auto.
  Qed.*)

(*  Lemma create_new_prepare_messages_implies_correct_NPs :
    forall n max sns v keys vcs OP NP,
      (forall (x : SeqNum) ppd,
          In x sns
          -> create_new_prepare_message x v keys vcs = (false, ppd)
          -> n < x /\ x < max)
      -> create_new_prepare_messages sns v keys vcs = (OP, NP)
      -> forallb
           (correct_new_view_npre_prepare v n max (view_change_cert2prep vcs))
           (map fst NP) = true.
  Proof.
    induction sns; introv imp create; simpl in *; smash_pbft; dands; tcsp;
      try (complete (eapply IHsns; eauto)).
    repnd; simpl in *.

    pose proof (imp a (x0,x1)) as q.
    autodimp q hyp.

    eapply create_new_prepare_message_false_implies_correct;[| |eauto];tcsp.
  Qed.*)

  (*Lemma find_pre_prepare_certificate_in_view_change_cert_some_implies :
    forall sn L nfo,
      find_pre_prepare_certificate_in_view_change_cert sn L = Some nfo
      -> In nfo (view_change_cert2prep L)
         /\ sn = prepared_info2seq nfo
         /\ last_prepared_info nfo (view_change_cert2prep L) = true.
  Proof.
    induction L; introv i; simpl in *; tcsp.
    smash_pbft.

    - pose proof (IHL x0) as q; autodimp q hyp; repnd; clear IHL.

      unfold pick_prepared_info_with_highest_view; smash_pbft.

      + rewrite in_app_iff; dands; tcsp.
        rewrite last_prepared_info_app_true.
        apply andb_true_iff; dands; auto;[].

  Qed.*)

  (*Lemma find_pre_prepare_certificate_in_view_change_cert_some_implies_oexists_last_prepared_true :
    forall sn vcs v keys nfo,
      find_pre_prepare_certificate_in_view_change_cert sn vcs = Some nfo
      -> oexists_last_prepared
           (mk_auth_pre_prepare v sn (prepared_info2requests nfo) keys)
           (create_hash_messages (map PBFTrequest (prepared_info2requests nfo)))
           (view_change_cert2prep vcs) = true.
  Proof.
    introv h.
    match goal with
    | [ |- ?a = _ ] => remember a as b; destruct b; auto; symmetry in Heqb
    end.

    assert False; tcsp.

    match goal with
    | [ H : oexists_last_prepared ?a ?b ?c = _ |- _ ] =>
      pose proof (oexists_last_prepared_false_implies a b c H) as q; clear H; simpl in q
    end.

XXXXXX

    apply find_pre_prepare_certificate_in_view_change_cert_none_implies in h.
    apply nexists_last_prepared_true_implies in Heqb; exrepnd; simpl in *.
    destruct h.
    apply in_map_iff.
    exists nfo; dands; auto.
  Qed.*)

  (*Lemma create_new_prepare_message_true_implies_correct :
    forall (sn : SeqNum) v keys vcs pp d (n : SeqNum),
      n < sn
      -> create_new_prepare_message sn v keys vcs = (true,(pp,d))
      -> correct_new_view_opre_prepare v n (view_change_cert2prep vcs) pp = true.
  Proof.
    introv ltsn create.
    unfold create_new_prepare_message in create; smash_pbft.
    unfold find_request_info_in_view_change_cert in *; smash_pbft.

    unfold correct_new_view_opre_prepare; simpl; smash_pbft;
      allrw SeqNumLt_true; allrw SeqNumLt_false; simpl in *; try omega; GC.

    apply find_pre_prepare_certificate_in_view_change_cert_none_implies_nexists_last_prepared_none; auto.
  Qed.*)

  (*Lemma create_new_prepare_messages_implies_correct_OPs :
    forall n max sns v keys vcs OP NP,
      (forall (x : SeqNum) ppd,
          In x sns
          -> create_new_prepare_message x v keys vcs = (true, ppd)
          -> n < x)
      -> create_new_prepare_messages sns v keys vcs = (OP, NP)
      -> forallb
           (correct_new_view_npre_prepare v n max (view_change_cert2prep vcs))
           (map fst OP) = true.
  Proof.
    induction sns; introv imp create; simpl in *; smash_pbft; dands; tcsp;
      try (complete (eapply IHsns; eauto)).
    repnd; simpl in *.

    pose proof (imp a (x2,x1)) as q.
    autodimp q hyp.

    eapply create_new_prepare_message_implies_correct;[| |eauto];tcsp.
  Qed.*)

  Lemma find_pre_prepare_certificate_in_prepared_infos_none_implies :
    forall F n P,
      find_pre_prepare_certificate_in_prepared_infos F n P = None
      ->
      forall p, In p P -> n <> prepared_info2seq p \/ F p = false.
  Proof.
    induction P; introv find; simpl in *; tcsp.
    introv i; repndors; subst; tcsp; smash_pbft.
  Qed.

  Lemma create_new_prepare_message_false_implies_correct :
    forall (sn : SeqNum) v keys P pp d (n max : SeqNum),
      n < sn
      -> sn < max
      -> create_new_prepare_message sn v keys P = (false,(pp,d))
      -> correct_new_view_npre_prepare v n max P pp = true.
  Proof.
    introv ltsn ltmax create.
    unfold create_new_prepare_message in create; smash_pbft.

    unfold correct_new_view_npre_prepare; simpl; smash_pbft;
      allrw SeqNumLt_true; allrw SeqNumLt_false; simpl in *; try omega; GC.

    unfold nexists_last_prepared; simpl.
    apply existsb_false.
    introv i.
    smash_pbft;[].

    unfold valid_prepared_info.

    apply andb_false_iff.
    match goal with
    | [ |- _ \/ ?x = _ ] => remember x as b; symmetry in Heqb; destruct b; auto
    end.
    match goal with
    | [ |- ?x = _ \/ _ ] => remember x as c; symmetry in Heqc; destruct c; auto
    end.
    assert False; tcsp.

    eapply find_pre_prepare_certificate_in_prepared_infos_none_implies in i;[|eauto].
    repndors; tcsp.

    unfold valid_prepared_info in i.
    rewrite andb_false_iff in i; repndors; smash_pbft.
  Qed.

  Lemma create_new_prepare_messages_implies_correct_NPs :
    forall n max sns v keys P OP NP,
      (forall (x : SeqNum) ppd,
          In x sns
          -> create_new_prepare_message x v keys P = (false, ppd)
          -> n < x /\ x < max)
      -> create_new_prepare_messages sns v keys P = (OP, NP)
      -> forallb
           (correct_new_view_npre_prepare v n max P)
           (map fst NP) = true.
  Proof.
    induction sns; introv imp create; simpl in *; smash_pbft; dands; tcsp;
      try (complete (eapply IHsns; eauto)).
    repnd; simpl in *.

    pose proof (imp a (x3,x1)) as q.
    repeat (autodimp q hyp).
    eapply create_new_prepare_message_false_implies_correct;[| |eauto]; tcsp.
  Qed.

  Lemma implies_in_view_change_cert2prep :
    forall vc p C,
      In vc C
      -> In p (view_change2prep vc)
      -> In p (view_change_cert2prep C).
  Proof.
    induction C; introv i j; simpl in *; tcsp; repndors; subst; tcsp;
      allrw in_app_iff; tcsp.
  Qed.
  Hint Resolve implies_in_view_change_cert2prep : pbft.

  Lemma view_change_cert2max_seq_preps_vc_implies_exists_create_new_prepare_message :
    forall v keys C n vc,
      view_change_cert2max_seq_preps_vc (valid_prepared_info (view_change_cert2prep C)) C = Some (n,vc)
      -> exists ppd, create_new_prepare_message n v keys (view_change_cert2prep C) = (true, ppd).
  Proof.
    introv cert.
    apply view_change_cert2max_seq_preps_some_implies in cert.
    exrepnd.
    subst.
    unfold create_new_prepare_message; smash_pbft.

    assert False; tcsp.

    match goal with
    | [ H : find_pre_prepare_certificate_in_prepared_infos _ _ _ = _ |- _ ] =>
      eapply find_pre_prepare_certificate_in_prepared_infos_none_implies in H;
        [|eauto 2 with pbft]
    end.
    repndors; smash_pbft.
  Qed.

  Lemma view_change_cert2max_seq_preps_implies_exists_create_new_prepare_message :
    forall v keys C n,
      view_change_cert2max_seq_preps (valid_prepared_info (view_change_cert2prep C)) C = Some n
      -> exists ppd, create_new_prepare_message n v keys (view_change_cert2prep C) = (true, ppd).
  Proof.
    introv cert.
    unfold view_change_cert2max_seq_preps in cert; smash_pbft.
    eapply view_change_cert2max_seq_preps_vc_implies_exists_create_new_prepare_message; eauto.
  Qed.

  Lemma view_change_cert2max_seq_preps_and_create_new_prepare_messages_implies_le :
    forall K sn v keys C OP NP,
      view_change_cert2max_seq_preps (valid_prepared_info (view_change_cert2prep C)) C = Some sn
      -> create_new_prepare_messages K v keys (view_change_cert2prep C) = (OP, NP)
      -> ordered SeqNumLt K
      -> sn = max_seq_nums K
      -> K <> []
      -> sn <= max_O OP.
  Proof.
    induction K; introv h q ord w knn; simpl in *; ginv.
    smash_pbft; repnd.

    - remember (nullb K) as b; symmetry in Heqb.
      destruct b.

      + rewrite nullb_true_iff in Heqb; subst; simpl in *; ginv; simpl in *; GC.
        clear ord knn.
        autorewrite with pbft in *.

        match goal with
        | [ H : create_new_prepare_message _ _ _ _ = _ |- _ ] =>
          apply create_new_prepare_message_implies_same_sequence_number in H;subst;auto
        end.

      + apply nullb_false_iff in Heqb.
        eapply IHK in h;[|eauto| | |]; auto; eauto 2 with pbft.
        apply max_seq_nums_right_if_lt; auto.

    - remember (nullb K) as b; symmetry in Heqb.
      destruct b.

      + rewrite nullb_true_iff in Heqb; subst; simpl in *; ginv; simpl in *; GC.
        clear ord knn.
        autorewrite with pbft in *.
        apply (view_change_cert2max_seq_preps_implies_exists_create_new_prepare_message v keys) in h.
        exrepnd.
        rewrite h0 in *; ginv.

      + apply nullb_false_iff in Heqb.
        eapply IHK in h;[|eauto| | |]; auto; eauto 2 with pbft.
        apply max_seq_nums_right_if_lt; auto.
  Qed.

  Lemma view_changed_entry_some_and_check_broadcast_new_view_implies_le :
    forall n entry state vc entry' i nv  opreps npreps,
      In n (from_min_to_max_of_view_changes entry')
      -> view_changed_entry state entry = Some (vc, entry')
      -> check_broadcast_new_view i state entry = Some (nv, entry', opreps, npreps)
      -> n <= max_O opreps.
  Proof.
    introv k vce c.
    unfold check_broadcast_new_view in c; smash_pbft.
    unfold from_min_to_max_of_view_changes, from_min_to_max_of_view_changes_cert in *; smash_pbft.

    applydup in_from_min_to_max_op_implies in k; exrepnd.
    eapply le_trans;[eauto|].

    match goal with
    | [ H : view_changed_entry _ _ = _ |- _ ] =>
      applydup view_changed_entry_some_implies_cons in H as eqvcs;
        rewrite eqvcs in *
    end.

    match goal with
    | [ H : context[vce_view_changes ?e] |- _ ] =>
      remember (vce_view_changes e) as VCS
    end.

    match goal with
    | [ H : context[view_change_cert2max_seq ?a] |- _ ] =>
      remember (view_change_cert2max_seq a) as sn1
    end.

    subst.
    allrw k1.
    allrw k2.
    simpl in *.

    rename_hyp_with create_new_prepare_messages cr.
    eapply (view_change_cert2max_seq_preps_and_create_new_prepare_messages_implies_le
              _ _ _ _ (vc :: _)) in cr;
        [|simpl;eauto| | |]; auto; allrw; simpl; eauto 2 with pbft;[].
    rewrite max_seq_nums_from_min_to_max; eauto 2 with pbft; omega.
  Qed.

  Lemma create_new_prepare_messages_preserves_view :
    forall L v keys P OP NP pp d,
      create_new_prepare_messages L v keys P = (OP, NP)
      -> In (pp,d) (OP ++ NP)
      -> v = pre_prepare2view pp.
  Proof.
    induction L; introv create i; simpl in *; smash_pbft; simpl in *; tcsp.

    - repndors; smash_pbft.
      symmetry; eapply create_new_prepare_message_implies_same_view; eauto.

    - allrw in_app_iff; simpl in *; repndors; smash_pbft.

      + eapply IHL;[eauto|]; apply in_app_iff; eauto.

      + symmetry; eapply create_new_prepare_message_implies_same_view; eauto.

      + eapply IHL;[eauto|]; apply in_app_iff; eauto.
  Qed.
  Hint Resolve create_new_prepare_messages_preserves_view : pbft.

  Lemma check_broadcast_new_view_preserves_view :
    forall i state entry nv entry' OP NP pp d,
      check_broadcast_new_view i state entry = Some (nv, entry', OP, NP)
      -> In (pp, d) (OP ++ NP)
      -> new_view2view nv = pre_prepare2view pp.
  Proof.
    introv check k.
    unfold check_broadcast_new_view in check; smash_pbft.
  Qed.
  Hint Resolve check_broadcast_new_view_preserves_view : pbft.

  Lemma pre_prepare_in_map_correct_new_view_implies2 :
    forall p nv,
      In p (map add_digest (new_view2oprep nv ++ new_view2nprep nv))
      -> correct_new_view nv = true
      -> new_view2view nv = pre_prepare2view (fst p).
  Proof.
    introv i cor.
    destruct p, p, b.
    eapply pre_prepare_in_map_correct_new_view_implies in i; simpl; auto.
  Qed.

End PBFTprops3.

Hint Resolve eq_primary_implies_eq_primary : pbft.
Hint Resolve nat_seq_num : pbft.
Hint Resolve in_map_seq_num : pbft.
Hint Resolve in_map_seq_num_natAB : pbft.
Hint Resolve max_seq_num_left : pbft.
Hint Resolve max_seq_num_right : pbft.
Hint Resolve ordered_seq : num.
Hint Resolve in_list_implies_diff_nil : pbft.
(*Hint Resolve le_seq_num_implies_from_min_to_max_not_null : pbft.*)
Hint Resolve ordered_from_min_to_max : pbft.
Hint Resolve ordered_from_min_to_max_op : pbft.
Hint Resolve new_view2sender_eq_primary : pbft.
Hint Resolve create_new_prepare_messages_implies_norepeatsb : pbft.
Hint Resolve implies_norepeatsb_map_seq_num : pbft.
Hint Resolve norepeatsb_seq : pbft.
Hint Resolve norepeatsb_from_min_to_max : pbft.
Hint Resolve norepeatsb_from_min_to_max_of_view_changes : pbft.
Hint Resolve implies_in_view_change_cert2prep : pbft.
Hint Resolve in_from_min_to_max_of_view_changes_implies_lt_min : pbft.
Hint Resolve implies_max_in_from_min_to_max : pbft.
Hint Resolve create_new_prepare_messages_preserves_view : pbft.
Hint Resolve check_broadcast_new_view_preserves_view : pbft.

Hint Rewrite @request_data_and_rep_toks2prepare_as_pre_prepare2prepare : pbft.
Hint Rewrite @is_primary_PBFTprimary : pbft.
Hint Rewrite @eq_request_data_same : pbft.
Hint Rewrite @orb_false_r : bool.
Hint Rewrite @max_seq_num_0_right : pbft.
Hint Rewrite @pre_prepare2seq_mk_auth_pre_prepare : pbft.
Hint Rewrite @seq_num_seqnum2nat : pbft.
Hint Rewrite @vce_view_changes_replace_own_view_change_in_entry : pbft.