Require Import vellvm.
Require Import opsem_props.
Require Import memory_sim.
Require Import memory_props.

(***********************************************************************)
(* Properties of program initialization *)
Axiom genGlobalAndInitMem__wf_global: forall initGlobal initFunTable initMem
  CurLayouts CurNamedts CurProducts S,
  OpsemAux.genGlobalAndInitMem
    (OpsemAux.initTargetData CurLayouts CurNamedts Mem.empty) CurProducts
      nil nil Mem.empty = ret (initGlobal, initFunTable, initMem) ->
  wf_global (CurLayouts, CurNamedts) S initGlobal.

(* OpsemPP.initLocals__wf_lc needs wf_params that is for params.
   At initialization, we only have args...
   Actually OpsemPP.initLocals__wf_lc only needs types in params.
   So, we use the function to create a param from arg.
   We should simplify the proofs of OpsemPP.initLocals__wf_lc, and
   use only types. *)
Definition args_to_params (la: args) : params :=
List.map (fun a0 => let '(t0,attr0,id0) := a0 in (t0,attr0,value_id id0)) la.

Axiom main_wf_params: forall f t i0 a v b S CurLayouts CurNamedts CurProducts
  VarArgs,
  getParentOfFdefFromSystem (fdef_intro (fheader_intro f t i0 a v) b) S =
    ret module_intro CurLayouts CurNamedts CurProducts ->
  OpsemPP.wf_params
    (OpsemAux.initTargetData CurLayouts CurNamedts Mem.empty)
    VarArgs (args_to_params a).

Lemma s_genInitState__opsem_wf: forall S main VarArgs cfg IS
  (HwfS : wf_system S)
  (Hinit : Opsem.s_genInitState S main VarArgs Mem.empty = ret (cfg, IS)),
  OpsemPP.wf_Config cfg /\ OpsemPP.wf_State cfg IS.
Proof.
  intros.
  simpl_s_genInitState.
  assert (HeqR0':=HeqR0).
  apply getParentOfFdefFromSystem__moduleInProductsInSystemB in HeqR0'.
  destruct HeqR0' as [HMinS HinPs].
  assert (wf_namedts S (CurLayouts, CurNamedts)) as Hwfnts.
    inv HwfS.
    eapply wf_modules__wf_module in HMinS; eauto.
    inv HMinS; auto.
  split.
  split; auto.
  split.
    eapply genGlobalAndInitMem__wf_global in HeqR1; eauto.
  split; auto.
  (* split; auto. *)
  (*   intro J. congruence. *)
  split.
    eapply main_wf_params in HeqR0; eauto.
    eapply OpsemPP.wf_ExecutionContext__at_beginning_of_function; eauto.
    simpl.
    split; auto.
      intros. destruct b0 as [? [? ? t0]]. destruct t0; auto.
Qed.

Axiom genGlobalAndInitMem__wf_globals_Mem: forall
  (initGlobal initFunTable : GVMap) (initMem : mem)
  (CurLayouts : layouts) (CurNamedts : namedts)
  (CurProducts : list product) (la : args) (lc : Opsem.GVsMap)
  (VarArgs : list GenericValue),
  OpsemAux.genGlobalAndInitMem
         (OpsemAux.initTargetData CurLayouts CurNamedts Mem.empty)
         CurProducts nil nil Mem.empty =
    ret (initGlobal, initFunTable, initMem) ->
  Opsem.initLocals
    (OpsemAux.initTargetData CurLayouts CurNamedts Mem.empty) la VarArgs =
    ret lc ->
  MemProps.wf_lc initMem lc /\
  (MemProps.wf_globals (Mem.nextblock initMem - 1) initGlobal /\
   MemProps.wf_Mem (Mem.nextblock initMem - 1)
     (OpsemAux.initTargetData CurLayouts CurNamedts Mem.empty) initMem) /\
  MoreMem.mem_inj (MemProps.inject_init (Mem.nextblock initMem - 1))
    initMem initMem /\
  genericvalues_inject.wf_sb_mi (Mem.nextblock initMem - 1)
    (MemProps.inject_init (Mem.nextblock initMem - 1)) initMem initMem /\
  OpsemAux.ftable_simulation (MemProps.inject_init (Mem.nextblock initMem - 1))
    initFunTable initFunTable /\
  (forall i0 gv,
     lookupAL GenericValue lc i0 = ret gv ->
     genericvalues_inject.gv_inject
       (MemProps.inject_init (Mem.nextblock initMem - 1)) gv gv) /\
  MoreMem.mem_inj inject_id initMem initMem /\
  OpsemAux.ftable_simulation inject_id initFunTable initFunTable.

(***********************************************************************)
(* A measure function used by refinement proofs, which is the number of
   commands to execute. *)
Definition measure (st:Opsem.State) : nat :=
match st with
| {| Opsem.ECS := {| Opsem.CurCmds := cs |} :: _ |} => List.length cs
| _ => 0%nat
end.


Require Import RefProofDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import RefTactics.
Require Import AbsAccessor.Spec.
Require Import RunAux.Specs.reset_last_run_info.
Require Import RunAux.LowSpecs.reset_last_run_info.
Require Import RunAux.RefProof.RefRel.

Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Opaque Z.add Z.mul Z.div Z.shiftl Z.shiftr Z.land Z.lor.

Section Refine.

  Hint Unfold
       set_rec_last_run_info_esr_spec
  .

  Lemma reset_last_run_info_spec_exists:
    forall habd habd'  labd rec
           (Hspec: reset_last_run_info_spec rec habd = Some habd')
           (Hrel: relate_RData habd labd),
    exists labd', reset_last_run_info_spec0 rec labd = Some labd' /\ relate_RData habd' labd'.
  Proof.
    intros. inv Hrel. destruct rec.
    unfold reset_last_run_info_spec, reset_last_run_info_spec0 in *.
    repeat autounfold in *. simpl in *. grewrite.
    eexists; split. reflexivity. constructor; reflexivity.
  Qed.

End Refine.


From iris.program_logic Require Import weakestpre.
From iris.proofmode Require Import proofmode.
From iris.algebra Require Import excl.
From lrust.lang Require Import lang proofmode notation.
From iris.prelude Require Import options.

Definition mklock_unlocked : val := λ: ["l"], "l" <- #false.
Definition mklock_locked : val := λ: ["l"], "l" <- #true.
Definition try_acquire : val := λ: ["l"], CAS "l" #false #true.
Definition acquire : val :=
  rec: "acquire" ["l"] := if: try_acquire ["l"] then #☠ else "acquire" ["l"].
Definition release : val := λ: ["l"], "l" <-ˢᶜ #false.

(* It turns out that we need an accessor-based spec so that we can put the
   protocol into shared borrows.  Cancellable invariants don't work because
   their cancelling view shift has a non-empty mask, and it would have to be
   executed in the consequence view shift of a borrow. *)
Section proof.
  Context `{!lrustGS Σ}.

  Definition lock_proto (l : loc) (R : iProp Σ) : iProp Σ :=
    (∃ b : bool, l ↦ #b ∗ if b then True else R)%I.

  Global Instance lock_proto_ne l : NonExpansive (lock_proto l).
  Proof. solve_proper. Qed.
  Global Instance lock_proto_proper l : Proper ((≡) ==> (≡)) (lock_proto l).
  Proof. apply ne_proper, _. Qed.

  Lemma lock_proto_iff l R R' :
    □ (R ↔ R') -∗ lock_proto l R -∗ lock_proto l R'.
  Proof.
    iIntros "#HRR' Hlck". iDestruct "Hlck" as (b) "[Hl HR]". iExists b.
    iFrame "Hl". destruct b; first done. by iApply "HRR'".
  Qed.

  Lemma lock_proto_iff_proper l R R' :
    □ (R ↔ R') -∗ □ (lock_proto l R ↔ lock_proto l R').
  Proof.
    iIntros "#HR !>". iSplit; iIntros "Hlck"; iApply (lock_proto_iff with "[HR] Hlck").
    - done.
    - iModIntro; iSplit; iIntros; by iApply "HR".
  Qed.

  (** The main proofs. *)
  Lemma lock_proto_create (R : iProp Σ) l (b : bool) :
    l ↦ #b -∗ (if b then True else ▷ R) ==∗ ▷ lock_proto l R.
  Proof.
    iIntros "Hl HR". iExists _. iFrame "Hl". destruct b; first done. by iFrame.
  Qed.

  Lemma lock_proto_destroy l R :
    lock_proto l R -∗ ∃ (b : bool), l ↦ #b ∗ if b then True else R.
  Proof.
    iIntros "Hlck". iDestruct "Hlck" as (b) "[Hl HR]". auto with iFrame.
  Qed.

  Lemma mklock_unlocked_spec (R : iProp Σ) (l : loc) v :
    {{{ l ↦ v ∗ ▷ R }}} mklock_unlocked [ #l ] {{{ RET #☠; ▷ lock_proto l R }}}.
  Proof.
    iIntros (Φ) "[Hl HR] HΦ". wp_lam. rewrite -wp_fupd. wp_write.
    iMod (lock_proto_create with "Hl HR") as "Hproto".
    iApply "HΦ". by iFrame.
  Qed.

  Lemma mklock_locked_spec (R : iProp Σ) (l : loc) v :
    {{{ l ↦ v }}} mklock_locked [ #l ] {{{ RET #☠; ▷ lock_proto l R }}}.
  Proof.
    iIntros (Φ) "Hl HΦ". wp_lam. rewrite -wp_fupd. wp_write.
    iMod (lock_proto_create with "Hl [//]") as "Hproto".
    iApply "HΦ". by iFrame.
  Qed.

  (* At this point, it'd be really nice to have some sugar for symmetric
     accessors. *)
  Lemma try_acquire_spec E l R P :
    □ (P ={E,∅}=∗ ▷ lock_proto l R ∗ (▷ lock_proto l R ={∅,E}=∗ P)) -∗
    {{{ P }}} try_acquire [ #l ] @ E
    {{{ b, RET #b; (if b is true then R else True) ∗ P }}}.
  Proof.
    iIntros "#Hproto !> * HP HΦ".
    wp_rec. iMod ("Hproto" with "HP") as "(Hinv & Hclose)".
    iDestruct "Hinv" as ([]) "[Hl HR]".
    - wp_apply (wp_cas_int_fail with "Hl"); [done..|]. iIntros "Hl".
      iMod ("Hclose" with "[Hl]"); first (iExists true; by eauto).
      iModIntro. iApply ("HΦ" $! false). auto.
    - wp_apply (wp_cas_int_suc with "Hl"); [done..|]. iIntros "Hl".
      iMod ("Hclose" with "[Hl]") as "HP"; first (iExists true; by eauto).
      iModIntro. iApply ("HΦ" $! true); iFrame.
  Qed.

  Lemma acquire_spec E l R P :
    □ (P ={E,∅}=∗ ▷ lock_proto l R ∗ (▷ lock_proto l R ={∅,E}=∗ P)) -∗
    {{{ P }}} acquire [ #l ] @ E {{{ RET #☠; R ∗ P }}}.
  Proof.
    iIntros "#Hproto !> * HP HΦ". iLöb as "IH". wp_rec.
    wp_apply (try_acquire_spec with "Hproto HP"). iIntros ([]).
    - iIntros "[HR Hown]". wp_if. iApply "HΦ"; iFrame.
    - iIntros "[_ Hown]". wp_if. iApply ("IH" with "Hown HΦ").
  Qed.

  Lemma release_spec E l R P :
    □ (P ={E,∅}=∗ ▷ lock_proto l R ∗ (▷ lock_proto l R ={∅,E}=∗ P)) -∗
    {{{ R ∗ P }}} release [ #l ] @ E {{{ RET #☠; P }}}.
  Proof.
    iIntros "#Hproto !> * (HR & HP) HΦ". wp_let.
    iMod ("Hproto" with "HP") as "(Hinv & Hclose)".
    iDestruct "Hinv" as (b) "[? _]". wp_write. iApply "HΦ".
    iApply "Hclose". iExists false. by iFrame.
  Qed.
End proof.

Global Typeclasses Opaque lock_proto.


Require Import Metatheory.
Require Import alist.
Require Import monad.
Require Import targetdata.
Require Import genericvalues.
Require Import Values.
Require Import Memory.
Require Import Integers.
Require Import Coqlib.
Require Import syntax.
Require Import typings.
Require Import static.
Require Import opsem.
Require Import opsem_props.
Require Import opsem_wf.
Require Import vellvm_tactics.
Require Import infrastructure.
Require Import infrastructure_props.

Import LLVMsyntax.
Import LLVMgv.
Import LLVMtd.
Import LLVMtypings.
Import LLVMinfra.

(* This file defines the deterministic instance of Vellvm's operational
   semantics. *)

(* DGVs implements the signature of GenericValues. *)
Module MDGVs.

Definition t := GenericValue.
Definition instantiate_gvs (gv : GenericValue) (gvs : t) : Prop := gvs = gv.
Definition inhabited (gvs : t) : Prop := True.
Definition cundef_gvs := LLVMgv.cundef_gv.
Definition undef_gvs gv (ty:typ) : t := gv.
Definition cgv2gvs := LLVMgv.cgv2gv.
Definition gv2gvs (gv:GenericValue) (ty:typ) : t := gv.

Notation "gv @ gvs" :=
  (instantiate_gvs gv gvs) (at level 43, right associativity).
Notation "$ gv # t $" := (gv2gvs gv t) (at level 41).
Hint Unfold inhabited instantiate_gvs.

Lemma cundef_gvs__getTypeSizeInBits : forall S los nts gv ty sz al gv',
  wf_typ S (los,nts) ty ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true ty =
      Some (sz, al) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv ->
  gv' @ (cundef_gvs gv ty) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) =
    sizeGenericValue gv'.
Proof.
  unfold instantiate_gvs.
  intros. inv H2.
  eapply cundef_gv__getTypeSizeInBits; eauto.
Qed.

Lemma cundef_gvs__matches_chunks : forall S los nts gv ty gv',
  wf_typ S (los,nts) ty ->
  gv_chunks_match_typ (los, nts) gv ty ->
  gv' @ (cundef_gvs gv ty) ->
  gv_chunks_match_typ (los, nts) gv' ty.
Proof.
  unfold instantiate_gvs.
  intros. subst.
  eapply cundef_gv__matches_chunks; eauto.
Qed.

Lemma cundef_gvs__inhabited : forall gv ty, inhabited (cundef_gvs gv ty).
Proof. auto. Qed.

Lemma undef_gvs__getTypeSizeInBits : forall S los nts gv t sz al gv',
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv ->
  gv' @ (undef_gvs gv t) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) =
    sizeGenericValue gv'.
Proof.
  unfold instantiate_gvs.
  intros. inv H2. auto.
Qed.

Lemma undef_gvs__matches_chunks : forall S los nts gv ty gv',
  wf_typ S (los,nts) ty ->
  gv_chunks_match_typ (los, nts) gv ty ->
  gv' @ (undef_gvs gv ty) ->
  gv_chunks_match_typ (los, nts) gv' ty.
Proof.
  unfold instantiate_gvs.
  intros. subst. auto.
Qed.

Lemma undef_gvs__inhabited : forall gv ty, inhabited (undef_gvs gv ty).
Proof. auto. Qed.

Lemma cgv2gvs__getTypeSizeInBits : forall S los nts gv t sz al gv',
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv ->
  gv' @ (cgv2gvs gv t) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) =
    sizeGenericValue gv'.
Proof.
  unfold instantiate_gvs.
  intros. inv H2.
  eapply cgv2gv__getTypeSizeInBits; eauto.
Qed.

Lemma cgv2gvs__matches_chunks : forall S los nts gv t gv',
  wf_typ S (los,nts) t ->
  gv_chunks_match_typ (los, nts) gv t ->
  gv' @ (cgv2gvs gv t) ->
  gv_chunks_match_typ (los, nts) gv' t.
Proof.
  unfold instantiate_gvs.
  intros. subst. unfold cgv2gvs.
  destruct gv; auto.
  destruct p as [[]]; auto.
  destruct gv; auto.
  eapply cundef_gvs__matches_chunks; eauto.
Qed.

Lemma cgv2gvs__inhabited : forall gv t, inhabited (cgv2gvs gv t).
Proof. auto. Qed.

Lemma gv2gvs__getTypeSizeInBits : forall S los nts gv t sz al,
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv ->
  forall gv', gv' @ (gv2gvs gv t) ->
  sizeGenericValue gv' = Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8).
Proof.
  unfold instantiate_gvs.
  intros. inv H2. auto.
Qed.

Lemma gv2gvs__matches_chunks : forall S los nts gv t,
  wf_typ S (los,nts) t ->
  gv_chunks_match_typ (los, nts) gv t ->
  forall gv', gv' @ (gv2gvs gv t) ->
  gv_chunks_match_typ (los, nts) gv' t.
Proof.
  unfold instantiate_gvs.
  intros. subst. auto.
Qed.

Lemma gv2gvs__inhabited : forall gv t, inhabited ($ gv # t $).
Proof. auto. Qed.

Definition lift_op1 (f: GenericValue -> option GenericValue) (gvs1:t) (ty:typ) :
  option t := f gvs1.

Definition lift_op2 (f: GenericValue -> GenericValue -> option GenericValue)
  (gvs1 gvs2:t) (ty: typ) : option t := f gvs1 gvs2.

Lemma lift_op1__inhabited : forall f gvs1 ty gvs2
  (H:forall x, exists z, f x = Some z),
  inhabited gvs1 ->
  lift_op1 f gvs1 ty = Some gvs2 ->
  inhabited gvs2.
Proof. auto. Qed.

Lemma lift_op2__inhabited : forall f gvs1 gvs2 t gvs3
  (H:forall x y, exists z, f x y = Some z),
  inhabited gvs1 -> inhabited gvs2 ->
  lift_op2 f gvs1 gvs2 t = Some gvs3 ->
  inhabited gvs3.
Proof. auto. Qed.

Lemma lift_op1__isnt_stuck : forall f gvs1 ty
  (H:forall x, exists z, f x = Some z),
  exists gvs2, lift_op1 f gvs1 ty = Some gvs2.
Proof. unfold lift_op1. auto. Qed.

Lemma lift_op2__isnt_stuck : forall f gvs1 gvs2 t
  (H:forall x y, exists z, f x y = Some z),
  exists gvs3, lift_op2 f gvs1 gvs2 t = Some gvs3.
Proof. unfold lift_op2. auto. Qed.

Lemma lift_op1__getTypeSizeInBits : forall S los nts f g t sz al gvs,
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  (forall x y, x @ g -> f x = Some y ->
   sizeGenericValue y = nat_of_Z (ZRdiv (Z_of_nat sz) 8)) ->
  lift_op1 f g t = Some gvs ->
  forall gv : GenericValue,
  gv @ gvs ->
  sizeGenericValue gv = nat_of_Z (ZRdiv (Z_of_nat sz) 8).
Proof. intros. unfold lift_op1 in H2. inv H3. eauto. Qed.

Lemma lift_op1__matches_chunks : forall S los nts f g t gvs,
  wf_typ S (los,nts) t ->
  (forall x y, instantiate_gvs x g -> f x = Some y ->
    gv_chunks_match_typ (los, nts) y t) ->
  lift_op1 f g t = Some gvs ->
  forall gv : GenericValue,
  instantiate_gvs gv gvs ->
  gv_chunks_match_typ (los, nts) gv t.
Proof. intros. unfold lift_op1 in H1. inv H2. eauto. Qed.

Lemma lift_op2__getTypeSizeInBits : forall S los nts f g1 g2 t sz al gvs,
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  (forall x y z, x @ g1 -> y @ g2 -> f x y = Some z ->
   sizeGenericValue z = nat_of_Z (ZRdiv (Z_of_nat sz) 8)) ->
  lift_op2 f g1 g2 t = Some gvs ->
  forall gv : GenericValue,
  gv @ gvs ->
  sizeGenericValue gv = nat_of_Z (ZRdiv (Z_of_nat sz) 8).
Proof. intros. unfold lift_op2 in H2. inv H3. eauto. Qed.

Lemma lift_op2__matches_chunks : forall S los nts f g1 g2 t gvs,
  wf_typ S (los,nts) t ->
  (forall x y z,
   instantiate_gvs x g1 -> instantiate_gvs y g2 -> f x y = Some z ->
   gv_chunks_match_typ (los, nts) z t) ->
  lift_op2 f g1 g2 t = Some gvs ->
  forall gv : GenericValue,
  instantiate_gvs gv gvs ->
  gv_chunks_match_typ (los, nts) gv t.
Proof. intros. unfold lift_op2 in H1. inv H2. eauto. Qed.

Lemma inhabited_inv : forall gvs, inhabited gvs -> exists gv, gv @ gvs.
Proof. eauto. Qed.

Lemma instantiate_undef__undef_gvs : forall gv t, gv @ (undef_gvs gv t).
Proof. auto. Qed.

Lemma instantiate_gv__gv2gvs : forall gv t, gv @ ($ gv # t $).
Proof. auto. Qed.

Lemma none_undef2gvs_inv : forall gv gv' t,
  gv @ $ gv' # t $ -> (forall mc, (Vundef, mc)::nil <> gv') -> gv = gv'.
Proof.
  intros.
  destruct gv'; try solve [inv H; auto].
Qed.

End MDGVs.

Definition DGVs : GenericValues := mkGVs
MDGVs.t
MDGVs.instantiate_gvs
MDGVs.inhabited
MDGVs.cgv2gvs
MDGVs.gv2gvs
MDGVs.lift_op1
MDGVs.lift_op2
MDGVs.cgv2gvs__getTypeSizeInBits
MDGVs.cgv2gvs__matches_chunks
MDGVs.cgv2gvs__inhabited
MDGVs.gv2gvs__getTypeSizeInBits
MDGVs.gv2gvs__matches_chunks
MDGVs.gv2gvs__inhabited
MDGVs.lift_op1__inhabited
MDGVs.lift_op2__inhabited
MDGVs.lift_op1__isnt_stuck
MDGVs.lift_op2__isnt_stuck
MDGVs.lift_op1__getTypeSizeInBits
MDGVs.lift_op2__getTypeSizeInBits
MDGVs.lift_op1__matches_chunks
MDGVs.lift_op2__matches_chunks
MDGVs.inhabited_inv
MDGVs.instantiate_gv__gv2gvs
MDGVs.none_undef2gvs_inv.

Notation "gv @ gvs" :=
  (DGVs.(instantiate_gvs) gv gvs) (at level 43, right associativity).
Notation "$ gv # t $" := (DGVs.(gv2gvs) gv t) (at level 41).
Notation "vidxs @@ vidxss" := (@Opsem.in_list_gvs DGVs vidxs vidxss)
  (at level 43, right associativity).

(* Properties of deterministic operational semantics. *)
Lemma dos_in_list_gvs_inv : forall gvs gvss, gvs @@ gvss -> gvs = gvss.
Proof.
  induction 1; subst; auto.
    inv H; auto.
Qed.

Lemma dos_in_gvs_inv : forall gvs gvss, gvs @ gvss -> gvs = gvss.
Proof.
  intros. inv H; auto.
Qed.

Ltac dgvs_instantiate_inv :=
  match goal with
  | [ H : DGVs.(instantiate_gvs) _ _ |- _ ] => inv H
  | [ H : _ @@ _ |- _ ] => apply dos_in_list_gvs_inv in H; subst
  end.

Lemma dos_instantiate_gvs_intro : forall gv, gv @ gv.
Proof.
Local Transparent instantiate_gvs.
  unfold instantiate_gvs. simpl. auto.
Global Opaque instantiate_gvs.
Qed.

Hint Resolve dos_instantiate_gvs_intro.

Lemma dos_in_list_gvs_intro : forall gvs, gvs @@ gvs.
Proof.
  induction gvs; simpl; auto.
Qed.

Hint Resolve dos_in_list_gvs_intro.

(*************************************)
Definition DGVMap := @Opsem.GVsMap DGVs.

(*************************************)
(* Aux invariants of wf ECs *)

Definition wfEC_inv s m (EC: @Opsem.ExecutionContext DGVs) : Prop :=
uniqFdef (Opsem.CurFunction EC) /\
blockInFdefB (Opsem.CurBB EC) (Opsem.CurFunction EC) = true /\
match Opsem.CurCmds EC with
| nil => wf_insn s m (Opsem.CurFunction EC) (Opsem.CurBB EC)
           (insn_terminator (Opsem.Terminator EC))
| c::_ => wf_insn s m (Opsem.CurFunction EC) (Opsem.CurBB EC)
           (insn_cmd c)
end /\
exists l0, exists ps0, exists cs0,
  Opsem.CurBB EC = (l0, stmts_intro ps0 (cs0 ++ Opsem.CurCmds EC)
    (Opsem.Terminator EC)).

Definition wfECs_inv s m (ECs: list (@Opsem.ExecutionContext DGVs)) : Prop :=
List.Forall (wfEC_inv s m) ECs.

Lemma wf_EC__wfEC_inv: forall S los nts Ps EC
  (HwfS : wf_system S)
  (HMinS : moduleInSystemB (module_intro los nts Ps) S = true)
  (Hwfec : OpsemPP.wf_ExecutionContext (los, nts) Ps EC),
  wfEC_inv S (module_intro los nts Ps) EC.
Proof.
  destruct EC; simpl.
  intros.
  destruct Hwfec as [J1 [J2 [J3 [J4 [J5 J6]]]]].
  unfold wfEC_inv. simpl.
  split; eauto 2 using wf_system__uniqFdef.
  split; auto.
  split; auto.
    destruct J6 as [l1 [ps1 [cs1 J6]]]; subst.
    destruct CurCmds.
      eapply wf_system__wf_tmn in J2; eauto.
      eapply wf_system__wf_cmd in J2; eauto using in_middle.
Qed.

Lemma wf_ECStack__wfECs_inv: forall S los nts Ps ECs
  (HwfS : wf_system S)
  (HMinS : moduleInSystemB (module_intro los nts Ps) S = true)
  (Hwf : OpsemPP.wf_ECStack (los, nts) Ps ECs),
  wfECs_inv S (module_intro los nts Ps) ECs.
Proof.
  unfold wfECs_inv.
  induction ECs as [|]; simpl; intros; auto.
    destruct Hwf as [J1 [J2 J3]].
    constructor; eauto using wf_EC__wfEC_inv.
Qed.

Lemma wf_State__wfECs_inv: forall cfg St (Hwfc: OpsemPP.wf_Config cfg)
  (Hwfst: OpsemPP.wf_State cfg St),
  wfECs_inv (OpsemAux.CurSystem cfg)
    (module_intro (fst (OpsemAux.CurTargetData cfg))
                  (snd (OpsemAux.CurTargetData cfg))
                  (OpsemAux.CurProducts cfg) )
    (Opsem.ECS St).
Proof.
  intros.
  destruct cfg as [? [? ?] ? ?].
  destruct St.
  destruct Hwfc as [? [? [? ?]]].
  destruct Hwfst. simpl.
  eapply wf_ECStack__wfECs_inv; eauto.
Qed.

Definition uniqEC (EC: @Opsem.ExecutionContext DGVs) : Prop :=
uniqFdef (Opsem.CurFunction EC) /\
blockInFdefB (Opsem.CurBB EC) (Opsem.CurFunction EC) = true /\
exists l0, exists ps0, exists cs0,
  Opsem.CurBB EC = (l0, stmts_intro ps0 (cs0 ++ Opsem.CurCmds EC)
    (Opsem.Terminator EC)).

Definition uniqECs (ECs: list (@Opsem.ExecutionContext DGVs)) : Prop :=
List.Forall uniqEC ECs.

Lemma wfEC_inv__uniqEC: forall s m EC (Hwf: wfEC_inv s m EC), uniqEC EC.
Proof.
  intros.
  destruct Hwf as [J1 [J3 [_ J2]]]. split; auto.
Qed.

Lemma wfECs_inv__uniqECs: forall s m ECs (Hwf: wfECs_inv s m ECs), uniqECs ECs.
Proof.
  unfold wfECs_inv, uniqECs.
  intros.
  induction Hwf; auto.
    constructor; auto.
      apply wfEC_inv__uniqEC in H; auto.
Qed.

Lemma wf_State__uniqECs: forall cfg St (Hwfc: OpsemPP.wf_Config cfg)
  (Hwfst: OpsemPP.wf_State cfg St), uniqECs (Opsem.ECS St).
Proof.
  intros.
  destruct cfg as [? [? ?] ? ?].
  destruct St.
  destruct Hwfc as [? [? [? ?]]].
  destruct Hwfst. simpl.
  eapply wf_ECStack__wfECs_inv in H4; eauto.
  eapply wfECs_inv__uniqECs; eauto.
Qed.

Ltac find_uniqEC :=
repeat match goal with
| H: uniqECs (Opsem.ECS {|Opsem.ECS := _; Opsem.Mem := _ |}) |- uniqEC _ =>
  simpl in H
| H: uniqECs (?EC::_) |- uniqEC ?EC => inv H; auto
| H: uniqECs (_::?EC::_) |- uniqEC ?EC => inv H; auto
| H: Forall uniqEC (?EC::_) |- uniqEC ?EC => inv H; auto
| H: Forall uniqEC (_::?EC::_) |- uniqEC ?EC => inv H; auto
end.

(*************************************)
(* More dynamic properties *)

Lemma GEP_inv: forall TD t (mp1 : GVsT DGVs) inbounds0 vidxs mp2 t'
  (H1 : Opsem.GEP TD t mp1 vidxs inbounds0 t' = ret mp2),
  gundef TD (typ_pointer t') = ret mp2 \/
  exists blk, exists ofs1, exists ofs2 : int32, exists m1, exists m2,
    mp1 = (Vptr blk ofs1, m1) :: nil /\ mp2 = (Vptr blk ofs2, m2) :: nil.
Proof.
Local Transparent lift_op1.
  intros.
  unfold Opsem.GEP in H1. unfold lift_op1 in H1. simpl in H1.
  unfold MDGVs.lift_op1 in H1.
  unfold gep in H1. unfold GEP in H1.
  remember (GV2ptr TD (getPointerSize TD) mp1) as R1.
  destruct R1; auto.
  destruct (GVs2Nats TD vidxs); auto.
  remember (mgep TD t v l0) as R2.
  destruct R2; auto.
  inv H1.
  unfold mgep in HeqR2.
  destruct v; tinv HeqR2.
  destruct l0; tinv HeqR2.
  destruct (mgetoffset TD (typ_array 0%nat t) (z :: l0)) as [[]|];
    inv HeqR2.
  unfold GV2ptr in HeqR1.
  destruct mp1 as [|[]]; tinv HeqR1.
  destruct v; tinv HeqR1.
  destruct mp1; inv HeqR1.
  unfold ptr2GV. unfold val2GV. right. exists b0. exists i1.
  exists (Int.add 31 i1 (Int.repr 31 z0)). exists m.
  exists (AST.Mint (Size.mul Size.Eight (getPointerSize TD) - 1)).
  eauto.
Opaque lift_op1.
Qed.

Lemma wf__getTypeStoreSize_eq_sizeGenericValue: forall (gl2 : GVMap)
  (lc2 : Opsem.GVsMap) (S : system) (los : layouts) (nts : namedts)
  (Ps : list product) (v1 : value) (gv1 : GenericValue)
  (Hwfg : LLVMgv.wf_global (los, nts) S gl2) (n : nat) t
  (HeqR : ret n = getTypeStoreSize (los, nts) t) F
  (H24 : @Opsem.getOperandValue DGVs (los, nts) v1 lc2 gl2 = ret gv1)
  (Hwflc1 : OpsemPP.wf_lc (los, nts) F lc2)
  (Hwfv : wf_value S (module_intro los nts Ps) F v1 t),
  n = sizeGenericValue gv1.
Proof.
  intros.
  eapply OpsemPP.getOperandValue__wf_gvs in Hwflc1; eauto.
  inv Hwflc1.
  assert (gv1 @ gv1) as Hinst. auto.
  apply H2 in Hinst.
  unfold gv_chunks_match_typ in Hinst.
  clear - Hinst HeqR Hwfv. inv_mbind.
  apply wf_value__wf_typ in Hwfv. destruct Hwfv as [J1 J2].
  symmetry in HeqR0.
  eapply flatten_typ__getTypeSizeInBits in HeqR0; eauto.
  destruct HeqR0 as [sz [al [A B]]].
  unfold getTypeAllocSize, getTypeStoreSize, getABITypeAlignment,
         getTypeSizeInBits, getAlignment,
         getTypeSizeInBits_and_Alignment in HeqR.
  rewrite A in HeqR.
  inv HeqR. rewrite B.
  eapply vm_matches_typ__sizeMC_eq_sizeGenericValue; eauto.
Qed.


Require compcert.cfrontend.Cshmgenproof.
Require ClightX.
Require CsharpminorX.
Require SmallstepX.

Import Coqlib.
Import Errors.
Import Integers.
Import Values.
Import Globalenvs.
Import Events.
Import SmallstepX.
Import Cshmgen.
Export Cshmgenproof.

Section WITHCONFIG.
Context `{external_calls_prf: ExternalCalls}.

Variable prog: Clight.program.
Variable tprog: Csharpminor.program.
Hypothesis TRANSL: transl_program prog = OK tprog.

Let MATCH_PROG: match_prog prog tprog.
Proof. apply transf_program_match; auto.
Qed.

Let ge := Clight.globalenv prog.
Let tge := Genv.globalenv tprog.

Lemma transl_initial_states:
  forall i init_m sg args,
  forall S, ClightX.initial_state prog i init_m sg args S ->
  exists R, CsharpminorX.initial_state tprog i init_m sg args R /\ match_states prog S R.
Proof.
 inversion 1; subst.
  exploit function_ptr_translated; eauto.
  destruct 1 as (? & ? & FIND & MATCH & LINKORDER).
  esplit.
  split.
  econstructor.
  erewrite symbols_preserved; eauto.
  eassumption.
  eassumption.
  symmetry. eapply transl_fundef_sig2; eauto.
  econstructor; eauto.
  constructor.
  constructor.
Grab Existential Variables.
  eapply Ctypes.prog_comp_env.
  eassumption.
Qed.

Lemma transl_final_states:
  forall sg,
  forall S R r,
  match_states prog S R -> ClightX.final_state sg S r -> CsharpminorX.final_state sg R r.
Proof.
  inversion 2; subst. inv H. inv MK. constructor.
Qed.

Theorem transl_program_correct:
  forall i init_m sg args,
    forward_simulation
      (ClightX.semantics prog i init_m sg args)
      (CsharpminorX.semantics tprog i init_m sg args)
.
Proof.
  intros.
  eapply forward_simulation_plus.
  apply senv_preserved; auto.
  apply transl_initial_states.
  apply transl_final_states.
  apply transl_step; auto.
Qed.

End WITHCONFIG.


(*
 * Copyright (c) 2009-2016, Andrew Appel, Robert Dockins,
    Aquinas Hobor and Le Xuan Bach
 *
 *)

Require Import VST.msl.base.
Require Import VST.msl.sepalg.
Require Import VST.msl.psepalg.
Require Import VST.msl.sepalg_generators.
Require Import VST.msl.boolean_alg.
Require Import VST.msl.eq_dec.

Require VST.msl.tree_shares.

Module Share : SHARE_MODEL := tree_shares.Share.
Import Share.

Definition share : Type := Share.t.

Instance pa_share : Perm_alg share := Share.pa.
Instance sa_share : Sep_alg share := Share.sa.
Instance ca_share : Canc_alg share := Share.ca.
Definition emptyshare : share := Share.bot.
Definition fullshare : share := Share.top.

Theorem leq_join_sub : forall s1 s2:Share.t,
  s1 <= s2 <-> join_sub s1 s2.
Proof.
  split; intros.
  pose (s' := glb s2 (comp s1)).
  exists s'.
  simpl; split.
  subst s'.
  rewrite glb_commute.
  rewrite glb_assoc.
  rewrite (glb_commute (comp s1) s1).
  rewrite comp2.
  apply glb_bot.
  subst s'.
  rewrite distrib2.
  rewrite comp1.
  rewrite glb_top.
  rewrite <- ord_spec2; auto.

  destruct H as [s' H].
  destruct H.
  rewrite ord_spec2.
  rewrite <- H0.
  rewrite <- lub_assoc.
  rewrite lub_idem; auto.
Qed.

Lemma top_correct' : forall x:t, join_sub x top.
Proof.
  intros; rewrite <- leq_join_sub; auto with ba.
Qed.

Lemma bot_identity : identity bot.
Proof.
  hnf; intros.
  destruct H.
  rewrite lub_commute in H0.
  rewrite lub_bot in H0.
  auto.
Qed.

Hint Resolve bot_identity : core.

Lemma identity_share_bot : forall s,
  identity s -> s = bot.
Proof.
  intros.
  apply identities_unique; auto.
  exists s.
  apply join_comm.

  destruct (top_correct' s).
  assert (x = top).
  apply H; auto.
  subst x; auto.
  destruct (top_correct' bot).
  assert (x = top).
  apply bot_identity; auto.
  subst x; auto.
  apply join_comm in H1.
  destruct (join_assoc H0 H1); intuition.
  assert (x = top).
  apply H; auto.
  subst x.
  replace bot with s.
  rewrite identity_unit_equiv in H.
  trivial.
  eapply joins_units_eq; try apply H0. exists top; eauto.
  simpl. split. apply glb_bot. apply lub_bot.
Qed.

Lemma factoryOverlap' : forall f1 f2 n1 n2,
  isTokenFactory f1 n1 -> isTokenFactory f2 n2 -> joins f1 f2 -> False.
Proof.
  intros.
  destruct H1.
  destruct H1.
  apply (factoryOverlap f1 f2 n1 n2 H H0 H1).
Qed.

Lemma identityToken' : forall x, isToken x 0 <-> identity x.
Proof.
  intro x; destruct (identityToken x); split; intros.
  hnf; intros.
  rewrite H in H2; auto.
  apply H0.
  apply identity_share_bot; auto.
Qed.

Lemma nonidentityToken' : forall x n, (n > 0)%nat -> isToken x n -> nonidentity x.
Proof.
  intros.
  generalize (nonidentityToken x n H H0).
  repeat intro.
  apply H1.
  apply identity_share_bot; auto.
Qed.

Lemma nonidentityFactory' : forall x n, isTokenFactory x n -> nonidentity x.
Proof.
  intros.
  generalize (nonidentityFactory x n H); repeat intro.
  apply H0.
  apply identity_share_bot; auto.
Qed.

Lemma split_join : forall x1 x2 x,
  split x = (x1,x2) -> join x1 x2 x.
Proof.
  intros; split.
  apply split_disjoint with x; auto.
  apply split_together; auto.
Qed.

Lemma split_nontrivial' : forall x1 x2 x,
  split x = (x1, x2) ->
    (identity x1 \/ identity x2) ->
    identity x.
Proof.
  intros.
  rewrite (split_nontrivial x1 x2 x H).
  apply bot_identity.
  destruct H0.
  left; apply identity_share_bot; auto.
  right; apply identity_share_bot; auto.
Qed.

Lemma rel_leq : forall a x, join_sub (rel a x) a.
Proof.
  intros.
  rewrite <- leq_join_sub.

  intros.
  rewrite ord_spec1.
  pattern a at 3.
  replace a with (rel a top).
  rewrite <- rel_preserves_glb.
  rewrite glb_top.
  auto.
  apply rel_top1.
Qed.

Lemma rel_join : forall a x y z,
  join x y z ->
  join (rel a x) (rel a y) (rel a z).
Proof.
  simpl; intuition. inv H.
  constructor.
  rewrite <- rel_preserves_glb.
  replace bot with (rel a bot).
  replace (glb x y) with bot; auto.
  apply rel_bot1.
  rewrite <- rel_preserves_lub. auto.
Qed.

Lemma rel_join2 : forall a x y s,
  nonidentity a ->
  join (rel a x) (rel a y) s ->
  exists z, s = rel a z /\ join x y z.
Proof.
  simpl; intros.
  destruct H0.
  exists (lub x y).
  split.
  rewrite <- H1.
  symmetry.
  apply rel_preserves_lub.
  split; auto.
  rewrite <- rel_preserves_glb in H0.
  replace bot with (rel a bot) in H0.
  apply rel_inj_l with a; auto.
  hnf; intros; apply H.
  subst a; apply bot_identity.
  apply rel_bot1.
Qed.

Lemma rel_nontrivial : forall a x,
  identity (rel a x) ->
  (identity a \/ identity x).
Proof.
  intros a x H.
  destruct (eq_dec a bot); auto.
  subst a.
  left. apply bot_identity.

  right.
  assert (rel a x = bot).
  apply identity_share_bot; auto.
  assert (x = bot).
  replace bot with (rel a bot) in H0.
  apply rel_inj_l with a; auto.
  apply rel_bot1.
  subst x; apply bot_identity.
Qed.

Instance share_cross_split : Cross_alg t.
Proof.
  hnf; simpl; intuition. destruct H as [H1 H2]. destruct H0 as [H H3].
  exists (glb a c, glb a d, glb b c, glb b d); intuition; constructor.
  rewrite (glb_commute a d).
  rewrite glb_assoc.
  rewrite <- (glb_assoc c d a).
  rewrite H.
  rewrite (glb_commute bot a).
  rewrite glb_bot.
  rewrite glb_bot.
  auto.
  rewrite <- distrib1;  rewrite H3; rewrite <- H2; auto with ba.
  rewrite (glb_commute b d).
  rewrite glb_assoc.
  rewrite <- (glb_assoc c d b).
  rewrite H.
  rewrite (glb_commute bot b).
  rewrite glb_bot.
  rewrite glb_bot.
  auto.
  rewrite <- distrib1;  rewrite H3; rewrite <- H2; auto with ba.
  rewrite (glb_commute a c).
  rewrite glb_assoc.
  rewrite <- (glb_assoc a b c).
  rewrite H1.
  rewrite (glb_commute bot c).
  rewrite glb_bot.
  rewrite glb_bot.
  auto.
  rewrite (glb_commute a c).
  rewrite (glb_commute b c).
  rewrite <- distrib1; rewrite H2; rewrite <- H3; auto with ba.
  rewrite (glb_commute a d).
  rewrite glb_assoc.
  rewrite <- (glb_assoc a b d).
  rewrite H1.
  rewrite (glb_commute bot d).
  rewrite glb_bot.
  rewrite glb_bot.
  auto.
  rewrite (glb_commute a d).
  rewrite (glb_commute b d).
  rewrite <- distrib1; rewrite H2; rewrite <- H3; auto with ba.
Qed.

Lemma bot_correct' : forall x, join_sub bot x.
Proof.
  intros s.
  destruct (top_correct' s).
  exists s.
  destruct (top_correct' bot).
  assert (x0 = top).
  apply bot_identity; auto.
  subst x0.
  apply join_comm in H0.
  destruct (join_assoc H H0); intuition.
  apply join_comm in H2.
  destruct (join_assoc H1 H2); intuition.
  assert (s = x1).
  apply bot_identity; auto.
  subst x1; auto.
Qed.

Lemma top_share_nonidentity : nonidentity top.
Proof.
  hnf; intros.
  assert (top = bot).
  apply identity_share_bot; auto.
  apply nontrivial; auto.
Qed.

Lemma top_share_nonunit: nonunit top.
Proof.
  repeat intro. unfold unit_for in H.
  destruct H. rewrite glb_commute in H. rewrite glb_top in H. subst.
  rewrite lub_bot in H0. apply nontrivial; auto.
Qed.

Lemma bot_join_eq : forall x, join bot x x.
Proof.
  intros.
  destruct (join_ex_identities x); intuition.
  destruct H0.
  generalize (H _ _ H0).
  intros; subst; auto.
  replace bot with x0; auto.
  apply identity_share_bot; auto.
Qed.

Lemma join_bot_eq : forall x, join x bot x.
Proof.
  intros.
  apply join_comm, bot_join_eq.
Qed.

Lemma bot_joins : forall x, joins bot x.
Proof.
  intro x; exists x; apply bot_join_eq.
Qed.

Lemma dec_share_identity : forall x:t, { identity x } + { ~identity x }.
Proof.
  intro x.
  destruct (eq_dec x bot); subst.
  left; apply bot_identity.
  right; intro; elim n.
  apply identity_share_bot; auto.
Qed.

Lemma dec_share_nonunit : forall x:t, { nonunit x } + { ~ nonunit x }.
Proof.
  intro x.
  destruct (dec_share_identity x) as [H | H]; [right | left].
  + intro; revert H. apply nonunit_nonidentity; auto.
  + apply nonidentity_nonunit; auto.
Qed.

Lemma fullshare_full : full fullshare.
Proof.
  unfold full.
  intros.
  generalize (Share.top_correct);intros.
  destruct H as [sigma'' ?].
  specialize (H0 sigma'').
  rewrite leq_join_sub in H0.
  destruct H0.
  destruct (join_assoc H H0) as [s [H1 H2]].
  apply join_comm in H2. apply unit_identity in H2.
  eapply split_identity; eauto.
Qed.

Lemma join_sub_fullshare : forall sh,
  join_sub fullshare sh -> sh = fullshare.
Proof.
  intros.
  generalize fullshare_full; intro.
  apply full_maximal in H0.
  specialize ( H0 sh H).
  auto.
Qed.

Lemma dec_share_full : forall (sh : Share.t),
  {full sh} + {~full sh}.
Proof with auto.
  intro sh.
  destruct (eq_dec sh top); subst.
  left. apply fullshare_full.
  right. intro. apply n.
  generalize (Share.top_correct sh);intro.
  apply leq_join_sub in H0.
  destruct H0.
  specialize ( H x). spec H. exists top...
  specialize ( H sh top (join_comm H0))...
Qed.

Lemma rel_congruence : forall a x1 x2,
  join_sub x1 x2 ->
  join_sub (rel a x1) (rel a x2).
Proof.
  intros.
  destruct H.
  exists (rel a x).
  apply rel_join; auto.
Qed.

Lemma share_split_injective:
  forall sh1 sh2, Share.split sh1 = Share.split sh2 -> sh1=sh2.
Proof.
  intros sh1 sh2;
    case_eq (Share.split sh1); case_eq (Share.split sh2); intros.
  generalize (split_join _ _ _ H); intro.
  generalize (split_join _ _ _ H0); intro.
  inv H1.
  eapply join_eq; eauto.
Qed.

Lemma share_joins_constructive:
  forall sh1 sh2 : t , joins sh1 sh2 ->  {sh3 | join sh1 sh2 sh3}.
Proof.
  intros.
  exists (lub sh1 sh2).
  destruct H.
  destruct H; split; auto.
Qed.

Lemma share_join_sub_constructive:
  forall sh1 sh3 : t , join_sub sh1 sh3 ->  {sh2 | join sh1 sh2 sh3}.
Proof.
  intros.
  exists (glb sh3 (comp sh1)).
  destruct H.
  destruct H.
  split.
  rewrite (glb_commute sh3 (comp sh1)).
  rewrite <- glb_assoc.
  rewrite comp2.
  rewrite glb_commute.
  rewrite glb_bot.
  auto.
  rewrite distrib2.
  rewrite comp1.
  rewrite glb_top.
  rewrite <- ord_spec2.
  rewrite <- H0.
  apply lub_upper1.
Qed.

Lemma triple_join_exists_share : Trip_alg t.
Proof.
  repeat intro.
  destruct H; destruct H0; destruct H1.
  exists (lub a (lub b c)).
  split.
  rewrite <- H2.
  rewrite glb_commute.
  rewrite distrib1.
  rewrite glb_commute.
  rewrite H1.
  rewrite glb_commute.
  rewrite H0.
  rewrite lub_bot; auto.
  rewrite <- H2.
  apply lub_assoc.
Qed.

Lemma nonemp_split_neq1: forall sh sh1 sh2, nonidentity sh -> split sh = (sh1, sh2) -> sh1 <> sh.
Proof with auto.
  intros until sh2; intros H H0.
  destruct (dec_share_identity sh2).
  generalize (split_nontrivial' _ _ _ H0); intro.
  spec H1...
  destruct (eq_dec sh1 sh)...
  subst sh1.
  generalize (split_join _ _ _ H0); intro.
  apply join_comm in H1.
  apply unit_identity in H1...
Qed.

Lemma nonemp_split_neq2: forall sh sh1 sh2, nonidentity sh -> split sh = (sh1, sh2) -> sh2 <> sh.
Proof with auto.
  intros until sh2; intros H H0.
  destruct (dec_share_identity sh1).
  generalize (split_nontrivial' _ _ _ H0); intro.
  spec H1...
  destruct (eq_dec sh2 sh)...
  subst sh2.
  generalize (split_join _ _ _ H0); intro.
  apply unit_identity in H1...
Qed.

Lemma bot_unit: forall sh,
  join emptyshare sh sh.
Proof.
  intro sh.
  generalize (bot_joins sh); generalize bot_identity; intros.
  destruct H0.
  specialize ( H sh x H0). subst.
  trivial.
Qed.

Hint Resolve bot_unit : core.

Lemma join_bot: join emptyshare emptyshare emptyshare.
Proof.
  apply bot_unit.
Qed.

Lemma share_rel_nonidentity:
  forall {sh1 sh2}, nonidentity sh1 -> nonidentity sh2 -> nonidentity (Share.rel sh1 sh2).
Proof.
intros.
unfold nonidentity in *.
generalize (rel_nontrivial sh1 sh2); intro. intuition.
Qed.

Lemma share_rel_nonunit: forall {sh1 sh2: Share.t},
       nonunit sh1 -> nonunit sh2 -> nonunit (Share.rel sh1 sh2).
Proof. intros. apply nonidentity_nonunit. apply share_rel_nonidentity.
intro. apply (@identity_unit _ _ _ sh1 Share.bot) in H1. apply H in H1; auto.
apply joins_comm. apply bot_joins.
intro. apply (@identity_unit _ _ _ sh2 Share.bot) in H1. apply H0 in H1; auto.
apply joins_comm. apply bot_joins.
Qed.

Lemma decompose_bijection: forall sh1 sh2,
 sh1 = sh2 <-> decompose sh1 = decompose sh2.
Proof.
 intros.
 split;intros. subst;trivial.
 generalize (recompose_decompose sh1);intro.
 generalize (recompose_decompose sh2);intro.
 congruence.
Qed.

Module ShareMap.
Section SM.
  Variable A:Type.
  Variable EqDec_A : EqDec A.

  Variable B:Type.
  Variable JB: Join B.
  Variable paB : Perm_alg B.
  Variable saB : Sep_alg B.

  Definition map := fpm A (lifted Share.Join_ba * B).
  Instance Join_map : Join map := Join_fpm _.
  Instance pa_map : Perm_alg map := Perm_fpm _ _.
  Instance sa_map : Sep_alg map := Sep_fpm _ _.
  Instance ca_map {CA: Canc_alg B} : Canc_alg map := Canc_fpm _.
  Instance da_map {DA: Disj_alg B} : Disj_alg map := @Disj_fpm _ _ _ _ _ _.

  Definition map_share (a:A) (m:map) : share :=
    match lookup_fpm m a with
    | Some (sh,_) => lifted_obj sh
    | None => Share.bot
    end.

  Definition map_val (a:A) (m:map) : option B :=
    match lookup_fpm m a with
    | Some (_,b) => Some b
    | None => None
    end.

  Definition empty_map : map := empty_fpm _ _.

  Definition map_upd (a:A) (b:B) (m:map) : option map :=
    match lookup_fpm m a with
    | Some (sh,_) =>
        if eq_dec (lifted_obj sh) fullshare
           then Some (insert_fpm _ a (sh,b) m)
           else None
    | None => None
    end.

Lemma join_lifted {t} {J: Join t}:
    forall (a b c: lifted J), join a b c -> join (lifted_obj a) (lifted_obj b) (lifted_obj c).
Proof. destruct a; destruct b; destruct c; simpl; intros. apply H.
Qed.

  Lemma map_join_char : forall m1 m2 m3,
    join m1 m2 m3 <->
    (forall a,
       join (map_share a m1) (map_share a m2) (map_share a m3) /\
       join (map_val a m1) (map_val a m2) (map_val a m3)).
  Proof with auto.
    split; intros.
    hnf in H. specialize ( H a).
    unfold map_val, map_share, lookup_fpm.
    destruct (proj1_sig m1 a) as [[sh1 a1] | ];
    destruct (proj1_sig m2 a) as [[sh2 a2] | ];
    destruct (proj1_sig m3 a) as [[sh3 a3] | ]; inv H; try solve [inv H0]; simpl; auto.
    destruct H3; simpl in *; auto.
    split. apply join_lifted; auto. constructor; auto.
    split; apply join_unit2; auto.
    split; apply join_unit1; auto.
    split; apply join_unit1; auto.
    split; apply join_unit1; auto.

    intro a. specialize ( H a). destruct H.
        unfold map_val, map_share, lookup_fpm in *.
    destruct (proj1_sig m1 a) as [[sh1 a1] | ];
    destruct (proj1_sig m2 a) as [[sh2 a2] | ];
    destruct (proj1_sig m3 a) as [[sh3 a3] | ]; inv H0; try solve [inv H1]; auto.
    constructor. split; auto.
    apply join_unit2_e in H; auto. apply join_unit2; auto.
    repeat f_equal. destruct sh1; destruct sh3; simpl in *; subst.
    rewrite (proof_irr n n0); auto.
    apply join_unit1_e in H; auto. apply join_unit1; auto.
    repeat f_equal. destruct sh2; destruct sh3; simpl in *; subst.
    rewrite (proof_irr n n0); auto.
    constructor. constructor.
 Qed.

  Lemma empty_map_identity {CAB: Disj_alg B}: identity empty_map.
  Proof.
    rewrite identity_unit_equiv.
    intro x. simpl. auto. constructor.
  Qed.

  Lemma map_identity_unique {CAB: Disj_alg B}: forall m1 m2:map,
    identity m1 -> identity m2 -> m1 = m2.
  Proof.
    intros.
    destruct m1; destruct m2; simpl in *.
    cut (x = x0). intros. subst x0.
    replace f0 with f; auto.
    apply proof_irr; auto.
    rewrite identity_unit_equiv in H, H0.
    extensionality a.
    specialize ( H a); specialize ( H0 a).
    apply lower_inv in H.
    apply lower_inv in H0.
    destruct H; destruct H0; simpl in *.
    intuition; congruence.
    destruct s0 as [? [? [? [? [? [? ?]]]]]].
    rewrite H in H1. inv H1. rewrite H0 in H; inv H.
    destruct x3. destruct H2. simpl in *. apply no_units in H. contradiction.
    destruct s as [? [? [? [? [? [? ?]]]]]].
    rewrite H in H0; inv H0. rewrite H1 in H; inv H.
    destruct x2. destruct H2. simpl in *. apply no_units in H. contradiction.
    destruct s as [? [? [? [? [? [? ?]]]]]].
    rewrite H in H0; inv H0. rewrite H1 in H; inv H.
    destruct x2. destruct H2. simpl in *. apply no_units in H. contradiction.
  Qed.

  Lemma map_identity_is_empty  {CAB: Disj_alg B} : forall m,
    identity m -> m = empty_map.
  Proof.
    intros; apply map_identity_unique; auto.
    apply empty_map_identity.
  Qed.

  Lemma empty_map_join {CAB: Disj_alg B} : forall m,
    join empty_map m m.
  Proof.
    intro m. destruct (join_ex_units m).
    replace empty_map with x; auto.
    apply map_identity_is_empty.
    eapply unit_identity; eauto.
  Qed.

  Lemma map_val_bot  : forall a m,
    map_val a m = None <-> map_share a m = Share.bot.
  Proof.
    do 2 intro.
    unfold map_val, map_share, lookup_fpm.
    destruct (proj1_sig m a); intuition.
    disc.
    contradiction (no_units a0 a0). destruct a0. simpl in *. subst.
    contradiction (n bot). auto.
  Qed.

  Lemma map_upd_success : forall a v m,
    map_share a m = Share.top ->
    exists m', map_upd a v m = Some m'.
  Proof.
    intros.
    unfold map_upd. simpl.
    unfold map_share, lookup_fpm in*.
    destruct (proj1_sig  m a).
    destruct p.
    rewrite H.
    unfold fullshare.
    destruct (eq_dec top top).
    eauto.
    elim n; auto.
    elim Share.nontrivial; auto.
  Qed.

  Lemma map_set_share1 : forall a v m m',
    map_upd a v m = Some m' ->
    map_share a m = Share.top.
  Proof.
    unfold map_upd, map_share.
    intros.
    destruct (lookup_fpm m a); disc.
    destruct p.
    destruct (eq_dec (lifted_obj l) fullshare); disc; auto.
  Qed.

  Lemma map_set_share2 : forall a v m m',
    map_upd a v m = Some m' ->
    map_share a m' = Share.top.
  Proof.
    unfold map_upd, map_share.
    intros. destruct (lookup_fpm m a); disc.
    destruct p. destruct (eq_dec (lifted_obj l) fullshare); disc.
    inv H.
    rewrite fpm_gss. auto.
  Qed.

  Lemma map_set_share3 : forall a v m m',
    map_upd a v m = Some m' ->
    forall a',
      map_share a' m = map_share a' m'.
  Proof.
    unfold map_upd, map_share.
    intros a v m m'.
    case_eq (lookup_fpm m a); intros; disc.
    destruct p.
    destruct (eq_dec (lifted_obj l) fullshare); disc.
    inv H0.
    destruct (eq_dec a a'). subst.
    rewrite H.
    rewrite fpm_gss. auto.
    rewrite fpm_gso; auto.
  Qed.

  Lemma map_gss_val: forall a v m m',
        map_upd a v m = Some m' ->
        map_val a m' = Some v.
  Proof.
    unfold map_upd, map_val.
    intros a v m m'.
    case_eq (lookup_fpm m a); intros; disc.
    destruct p.
    destruct (eq_dec (lifted_obj l) fullshare); disc.
    inv H0.
    rewrite fpm_gss. auto.
  Qed.

  Lemma map_gso_val : forall i j v m m',
       i <> j ->
       map_upd j v m = Some m' ->
       map_val i m = map_val i m'.
  Proof.
    unfold map_upd, map_val.
    intros i j v m m'.
    case_eq (lookup_fpm m j); intros; disc.
    destruct p.
    destruct (eq_dec (lifted_obj l) fullshare); disc.
    inv H1.
    rewrite fpm_gso; auto.
  Qed.

  Lemma map_gso_share : forall i j v m m',
    i <> j ->
    map_upd j v m = Some m' ->
    map_share i m = map_share i m'.
  Proof.
    unfold map_upd, map_share.
    intros i j v m m'.
    case_eq (lookup_fpm m j); intros; disc.
    destruct p.
    destruct (eq_dec (lifted_obj l) fullshare); disc.
    inv H1.
    rewrite fpm_gso; auto.
  Qed.

  Lemma map_upd_join : forall m1 m2 m3 a v m1',
    map_upd a v m1 = Some m1' ->
    join m1 m2 m3 ->
    exists m3', map_upd a v m3 = Some m3' /\
      join m1' m2 m3'.
  Proof.
    intros.
    rewrite map_join_char in H0.
    destruct (H0 a).
    generalize H; intros.
    apply map_set_share1 in H.
    rewrite H in H1.
    destruct H1.
    rewrite glb_commute in H1.
    rewrite glb_top in H1.
    rewrite H1 in H4.
    rewrite lub_bot in H4.
    symmetry in H4.
    destruct (map_upd_success a v _ H4).
    exists x; split; auto.
    clear H2.
    rewrite map_join_char.
    intro a'.
    destruct (eq_dec a a').
    subst a'. split.
    apply map_set_share2 in H3. rewrite H3.
    apply map_set_share2 in H5. rewrite H5.
    rewrite H1. apply join_unit2; auto.
    erewrite map_gss_val; eauto.
    apply map_val_bot in H1. rewrite H1.
    erewrite map_gss_val; eauto. constructor.
    destruct (H0 a'). split.
    rewrite <- (map_gso_share a' a v m1 m1'); auto.
    rewrite <- (map_gso_share a' a v m3 x); auto.
    rewrite <- (map_gso_val a' a v m1 m1'); auto.
    rewrite <- (map_gso_val a' a v m3 x); auto.
  Qed.

  Definition build_map (l:list (A * B)) : map :=
     fold_right
      (fun (ab:A * B) m =>
        insert_fpm EqDec_A
           (fst ab)
           (mk_lifted fullshare top_share_nonunit,snd ab) m)
      empty_map l.

  Lemma build_map_results : forall (l:list (A*B)) a b,
    NoDup (List.map (@fst _ _) l) ->
    (In (a,b) l <->
    (map_val a (build_map l) = Some b /\
     map_share a (build_map l) = Share.top)).
  Proof.
    induction l; simpl.
    split; intros. elim H0.
    destruct H0.
    unfold build_map in H0. simpl in H0.
    unfold map_val in H0.
    simpl in H0. discriminate.
    intros. split; intros.
    destruct H0; subst.
    unfold build_map.
    simpl fold_right.
    split.
    unfold map_val.
    rewrite fpm_gss. simpl; auto.
    unfold map_share.
    rewrite fpm_gss. simpl; auto.
    generalize H0; intro H1.
    rewrite IHl in H0.
    inv H.
    assert (fst a <> a0).
    intro. subst a0.
    elim H4.
    clear -H1. induction l; simpl in *; intuition; subst; auto.
    destruct H0.
    unfold build_map. simpl fold_right.
    split.
    unfold map_val.
    rewrite fpm_gso; auto.
    unfold map_share.
    rewrite fpm_gso; auto.
    inv H. auto.
    inv H.
    destruct H0.
    destruct a.
    destruct (eq_dec a a0).
    subst a0.
    left. f_equal.
    unfold build_map in H.
    unfold map_val in H.
    simpl fold_right in H.
    rewrite fpm_gss in H.
    inv H. auto.
    right.
    rewrite IHl; auto.
    split.
    revert H.
    unfold build_map, map_val.
    simpl fold_right.
    rewrite fpm_gso; auto.
    revert H0.
    unfold build_map, map_share.
    simpl fold_right.
    rewrite fpm_gso; auto.
  Qed.

  Lemma build_map_join : forall (l1 l2:list (A * B)),
    NoDup (List.map (@fst _ _) (l1++l2)) ->
    join  (build_map l1)
          (build_map l2)
          (build_map (l1++l2)).
  Proof.
    induction l1; intros.
    simpl app.
    unfold build_map at 1.
    simpl fold_right.
    apply empty_fpm_join; auto with typeclass_instances.
    inv H.
    simpl app.
    unfold build_map.
    simpl fold_right.
    apply insert_fpm_join. auto with typeclass_instances.
    2: apply (IHl1 l2); auto.
    assert (~In (fst a) (List.map (@fst _ _) l2)).
    intro.
    elim H2.
    rewrite map_app.
    apply in_or_app.
    auto.
    clear -H.
    induction l2; simpl in *.
    auto.
    rewrite fpm_gso; auto.
  Qed.

End SM.
End ShareMap.


Require Import Verdi.GhostSimulations.

Require Import VerdiRaft.Raft.
Require Import VerdiRaft.RaftRefinementInterface.
Require Import VerdiRaft.CommonTheorems.

Require Import VerdiRaft.SpecLemmas.

Local Arguments update {_} {_} _ _ _ _ _ : simpl never.

Require Import VerdiRaft.LogsLeaderLogsInterface.
Require Import VerdiRaft.LeaderLogsSortedInterface.
Require Import VerdiRaft.LeaderLogsContiguousInterface.
Require Import VerdiRaft.LeaderLogsLogMatchingInterface.
Require Import VerdiRaft.RefinedLogMatchingLemmasInterface.
Require Import VerdiRaft.LeadersHaveLeaderLogsStrongInterface.
Require Import VerdiRaft.NextIndexSafetyInterface.
Require Import VerdiRaft.SortedInterface.
Require Import VerdiRaft.LeaderLogsLogPropertiesInterface.

Section LogsLeaderLogs.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Context {rri : raft_refinement_interface}.
  Context {llsi : leaderLogs_sorted_interface}.
  Context {rlmli : refined_log_matching_lemmas_interface}.
  Context {llci : leaderLogs_contiguous_interface}.
  Context {lllmi : leaderLogs_entries_match_interface}.
  Context {lhllsi : leaders_have_leaderLogs_strong_interface}.
  Context {nisi : nextIndex_safety_interface}.
  Context {si : sorted_interface}.
  Context {lpholli : log_properties_hold_on_leader_logs_interface}.

  Definition weak_sanity pli ll ll' :=
    pli = 0 ->
    (exists e, eIndex e = 0 /\ In e ll) \/
    ll = ll'.

  Definition logs_leaderLogs_nw_weak net :=
    forall p t n pli plt es ci e,
      In p (nwPackets net) ->
      pBody p = AppendEntries t n pli plt es ci ->
      In e es ->
      exists leader ll es' ll',
        In (eTerm e, ll) (leaderLogs (fst (nwState net leader))) /\
        Prefix ll' ll /\
        removeAfterIndex es (eIndex e) = es' ++ ll' /\
        (forall e', In e' es' -> eTerm e' = eTerm e) /\
        weak_sanity pli ll ll'.

  Lemma logs_leaderLogs_nw_weaken :
    forall net,
      logs_leaderLogs_nw net ->
      logs_leaderLogs_nw_weak net.
  Proof using.
    intros. unfold logs_leaderLogs_nw, logs_leaderLogs_nw_weak, weak_sanity in *.
    intros.
    eapply_prop_hyp In In; eauto.
    break_exists_exists; intuition; subst; try lia.
    break_exists; intuition; eauto.
  Qed.

  Definition logs_leaderLogs_inductive net :=
    logs_leaderLogs net /\
    logs_leaderLogs_nw net.

  Theorem lift_sorted :
    forall net,
      refined_raft_intermediate_reachable net ->
      logs_sorted (deghost net).
  Proof using si rri.
    intros.
    eapply lift_prop; eauto using logs_sorted_invariant.
  Qed.

  Theorem lift_logs_sorted :
    forall net h,
      refined_raft_intermediate_reachable net ->
      sorted (log (snd (nwState net h))).
  Proof using si rri.
    intros.
    find_apply_lem_hyp lift_sorted.
    unfold logs_sorted, logs_sorted_host in *.
    intuition.
    unfold deghost in *. simpl in *. break_match; eauto.
  Qed.

  Lemma lift_nextIndex_safety :
    forall net,
      refined_raft_intermediate_reachable net ->
      nextIndex_safety (deghost net).
  Proof using nisi rri.
    intros.
    eapply lift_prop; eauto using nextIndex_safety_invariant.
  Qed.

  Lemma nextIndex_sanity :
    forall net h h',
      refined_raft_intermediate_reachable net ->
      type (snd (nwState net h)) = Leader ->
      pred (getNextIndex (snd (nwState net h)) h') <> 0 ->
      exists e,
        findAtIndex (log (snd (nwState net h))) (pred (getNextIndex (snd (nwState net h)) h')) = Some e.
  Proof using si nisi rlmli rri.
    intros.
    find_copy_apply_lem_hyp entries_contiguous_invariant.
    find_copy_apply_lem_hyp lift_nextIndex_safety.
    assert (pred (getNextIndex (snd (nwState net h)) h') > 0) by lia.
    unfold nextIndex_safety in *.
    match goal with
      | H : forall _ _, type _ = _ -> _ |- _ => specialize (H h h')
    end.
    intuition.
    unfold entries_contiguous in *. specialize (H2 h).
    unfold contiguous_range_exact_lo in *. intuition.
    match goal with
      | H : forall _, _ < _ <= _ -> _ |- _ =>
        specialize (H (pred (getNextIndex (snd (nwState net h)) h')))
    end.
    unfold raft_refined_base_params in *.
    repeat find_rewrite_lem deghost_spec. intuition.
    break_exists_exists. intuition.
    apply findAtIndex_intro; eauto using lift_logs_sorted, sorted_uniqueIndices.
  Qed.

  Lemma update_elections_data_client_request_leaderLogs :
    forall h st client id c,
      leaderLogs (update_elections_data_client_request h st client id c) =
      leaderLogs (fst st).
  Proof using.
    unfold update_elections_data_client_request in *.
    intros. repeat break_match; repeat find_inversion; auto.
  Qed.

  Lemma update_elections_data_timeout_leaderLogs :
    forall h st,
      leaderLogs (update_elections_data_timeout h st) =
      leaderLogs (fst st).
  Proof using.
    unfold update_elections_data_timeout.
    intros.
    repeat break_match; simpl in *; auto.
  Qed.

  Lemma update_elections_data_appendEntries_leaderLogs :
    forall h st t h' pli plt es ci,
      leaderLogs (update_elections_data_appendEntries h st t h' pli plt es ci) =
      leaderLogs (fst st).
  Proof using.
    intros.
    unfold update_elections_data_appendEntries.
    repeat break_match; subst; simpl in *; auto.
  Qed.

  Lemma update_elections_data_requestVote_leaderLogs :
    forall h h' t lli llt st,
      leaderLogs (update_elections_data_requestVote h h' t h' lli llt st) =
      leaderLogs (fst st).
  Proof using.
    unfold update_elections_data_requestVote.
    intros.
    repeat break_match; auto.
  Qed.

  Lemma update_elections_data_requestVoteReply_leaderLogs :
    forall h h' t  st t' ll' r,
      In (t', ll') (leaderLogs (fst st)) ->
      In (t', ll') (leaderLogs (update_elections_data_requestVoteReply h h' t r st)).
  Proof using.
    unfold update_elections_data_requestVoteReply.
    intros.
    repeat break_match; auto.
    simpl in *. intuition.
  Qed.

  Ltac prove_in :=
    match goal with
      | [ _ : nwPackets ?net = _,
              _ : In ?p _ |- _] =>
        assert (In p (nwPackets net)) by (repeat find_rewrite; do_in_app; intuition)
      | [ _ : nwPackets ?net = _,
              _ : pBody ?p = _ |- _] =>
        assert (In p (nwPackets net)) by (repeat find_rewrite; intuition)
    end.

  Lemma contiguous_log_property :
    log_property (fun l => contiguous_range_exact_lo l 0).
  Proof using rlmli.
    red. intros.
    apply entries_contiguous_invariant; auto.
  Qed.

  Lemma leaderLogs_contiguous :
    forall net h t ll,
      refined_raft_intermediate_reachable net ->
      In (t, ll) (leaderLogs (fst (nwState net h))) ->
      contiguous_range_exact_lo ll 0.
  Proof using lpholli rlmli.
    intros. pattern ll.
    eapply log_properties_hold_on_leader_logs_invariant; eauto using contiguous_log_property.
  Qed.

  Lemma logs_leaderLogs_inductive_appendEntries :
    refined_raft_net_invariant_append_entries logs_leaderLogs_inductive.
  Proof using lpholli si lllmi llci rlmli llsi rri.
    red. unfold logs_leaderLogs_inductive. intros.
    subst. simpl in *. intuition.
    - unfold logs_leaderLogs in *. intros.
      simpl in *. repeat find_higher_order_rewrite.
      update_destruct; subst; rewrite_update; eauto.
      + simpl in *. find_apply_lem_hyp handleAppendEntries_log.
        intuition; repeat find_rewrite; eauto.
        * find_apply_hyp_hyp. break_exists_exists; intuition.
          find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
          simpl in *.
          rewrite update_elections_data_appendEntries_leaderLogs. auto.
        * { subst.
            find_apply_lem_hyp logs_leaderLogs_nw_weaken.
            unfold logs_leaderLogs_nw_weak in *.
            copy_eapply_prop_hyp pBody pBody; eauto.
            break_exists_exists.
            break_exists. intuition.
            - repeat find_higher_order_rewrite.
              update_destruct; subst; rewrite_update; eauto.
              simpl.
              rewrite update_elections_data_appendEntries_leaderLogs.
              auto.
            - repeat find_rewrite. f_equal.
              find_copy_apply_lem_hyp leaderLogs_sorted_invariant; eauto.
              eapply sorted_Prefix_in_eq; eauto.
              intros.
              eapply prefix_contiguous with (i := 0); eauto.
              + unfold weak_sanity in *. concludes.
                intuition; subst; simpl in *; intuition.
                break_exists. intuition.
                find_eapply_lem_hyp leaderLogs_contiguous_invariant; eauto.
                lia.
              + eapply leaderLogs_contiguous_invariant; eauto.
              + assert (sorted (log d)) by (eapply entries_sorted_nw_invariant; eauto).
                eapply contiguous_app with (l1 := x1).
                * repeat find_reverse_rewrite.
                  apply removeAfterIndex_sorted. auto.
                * repeat find_reverse_rewrite.
                  eapply removeAfterIndex_contiguous; eauto.
                  eapply entries_contiguous_nw_invariant; eauto.
          }
        * { break_exists. intuition. subst.
            do_in_app. intuition.
            - (* new entry *)
              unfold logs_leaderLogs_nw in *.
              prove_in.
              copy_eapply_prop_hyp In In; eauto.
              match goal with
                | H:exists _, _ |- _ => destruct H as [leader]
              end.
              break_exists; intuition.
              + (* all of the new entries, as well as x, are in the
                new term. This means we can apply the host invariant
                to x and get our leader. *)
                assert (x2 = []).
                {
                  destruct x2; intuition. exfalso.
                  simpl in *. break_match; intuition.
                  simpl in *. subst.
                  find_copy_apply_lem_hyp entries_contiguous_nw_invariant.
                  eapply_prop_hyp entries_contiguous_nw pBody; eauto.
                  unfold contiguous_range_exact_lo in *. intuition.
                  match goal with
                    | _ : removeAfterIndex _ ?index = _ ++ ?e :: _ |- _ =>
                      assert (In e es) by
                          (apply removeAfterIndex_in with (i := index);
                           repeat find_rewrite; intuition)
                  end.
                  eapply_prop_hyp In In. lia.
                } subst. rewrite app_nil_r in *.
                match goal with
                  | H : forall _ _, In _ _ -> _ |- _ =>
                    specialize (H0 (pDst p) x)
                end. intuition.
                break_exists. intuition.
                match goal with
                  | _ : In (_, ?ll) (leaderLogs (_ (_ _ ?h))),
                        _ : removeAfterIndex _ _ = ?es' ++ ?ll |- _ =>
                    exists h, ll, (removeAfterIndex es (eIndex e) ++ es')
                end. intuition.
                * repeat find_rewrite.
                  match goal with
                    | H : forall _, st' _ = _ |- _ =>
                      rewrite H
                  end.
                  update_destruct; subst; rewrite_update; eauto.
                  simpl in *.
                  rewrite update_elections_data_appendEntries_leaderLogs. auto.
                * rewrite removeAfterIndex_in_app; auto.
                  rewrite app_ass. repeat find_rewrite. auto.
                * repeat find_rewrite. do_in_app. intuition; eauto.
              + (* we share an entry with the leader, so we can use
                log matching to make sure our old entries match. we'll
                get the new entries for free from the nw invariant. *)
                break_exists; intuition;
                match goal with
                  | [ _ : In (_, ?ll) (leaderLogs (_ (_ _ ?leader))),
                      _ : removeAfterIndex _ _ = ?es' ++ _ |- _ ] =>
                    exists leader, ll, es'
                end; intuition.
                * repeat find_rewrite.
                  match goal with
                    | H : forall _, st' _ = _ |- _ =>
                      rewrite H
                  end.
                  update_destruct; subst; rewrite_update; eauto.
                  simpl in *.
                  rewrite update_elections_data_appendEntries_leaderLogs. auto.
                * rewrite removeAfterIndex_in_app; auto.
                  repeat find_rewrite. rewrite app_ass.
                  find_copy_eapply_lem_hyp leaderLogs_sorted_invariant; eauto.
                  f_equal.
                  eapply thing; eauto using lift_logs_sorted;
                  [eauto using leaderLogs_contiguous|eapply leaderLogs_entries_match_invariant; eauto|].
                  assert (sorted es) by (eapply entries_sorted_nw_invariant; eauto).
                  find_copy_apply_lem_hyp entries_contiguous_nw_invariant.
                  unfold entries_contiguous_nw in *.
                  copy_eapply_prop_hyp contiguous_range_exact_lo pBody; eauto.
                  find_eapply_lem_hyp removeAfterIndex_contiguous; eauto.
                  match goal with
                    | H : removeAfterIndex _ _ = _ |- _ =>
                      find_erewrite_lem H
                  end.
                  eapply contiguous_app; eauto.
                  repeat find_reverse_rewrite. eauto using removeAfterIndex_sorted.
                * repeat find_rewrite.
                  match goal with
                    | H : forall _, st' _ = _ |- _ =>
                      rewrite H
                  end.
                  update_destruct; subst; rewrite_update; eauto.
                  simpl in *.
                  rewrite update_elections_data_appendEntries_leaderLogs. auto.
                * rewrite removeAfterIndex_in_app; auto.
                  repeat find_rewrite. rewrite app_ass.
                  f_equal.
                  assert (x2 = []).
                  {
                    destruct x2; intuition. exfalso.
                    simpl in *. break_match; intuition.
                    simpl in *. subst.
                    find_copy_apply_lem_hyp entries_contiguous_nw_invariant.
                    eapply_prop_hyp entries_contiguous_nw pBody; eauto.
                    unfold contiguous_range_exact_lo in *. break_and.
                    match goal with
                      | _ : removeAfterIndex _ ?index = _ ++ ?e :: _ |- _ =>
                        assert (In e es) by
                            (apply removeAfterIndex_in with (i := index);
                             repeat find_rewrite; intuition)
                    end.
                    clear H0 H7.
                    eapply_prop_hyp In In. lia.
                  } subst. simpl.
                  find_copy_eapply_lem_hyp leaderLogs_sorted_invariant; eauto.
                  match goal with
                    | |- _ = ?ll =>
                      rewrite removeAfterIndex_maxIndex_sorted with (l := ll) at 2
                  end; eauto.
                  eapply removeAfterIndex_same_sufficient; eauto using lift_logs_sorted;
                  intros;
                  match goal with
                    | _ : eIndex ?e = maxIndex _,
                          _ : In ?e (log _),
                              _ : eIndex ?e' = maxIndex _ |- In ?e'' _ =>
                      assert (eIndex e = eIndex e') as Heq by (repeat find_rewrite; auto);
                        assert (eIndex e'' <= eIndex e) by lia;
                        eapply leaderLogs_entries_match_invariant in Heq; eauto;
                        repeat conclude Heq ltac:(eauto; intuition)
                  end; intuition.
            - (* old entry *)
              (* can use host invariant, since we don't change removeAfterIndex *)
              find_copy_apply_lem_hyp removeAfterIndex_in.
              find_copy_apply_lem_hyp removeAfterIndex_In_le; eauto using lift_logs_sorted.
              find_apply_hyp_hyp. break_exists_exists; intuition.
              + find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
                simpl in *.
                rewrite update_elections_data_appendEntries_leaderLogs. auto.
              + rewrite removeAfterIndex_in_app_l'; eauto;
                [rewrite <- removeAfterIndex_le; auto|].
                intros.
                apply (Nat.le_lt_trans _ (eIndex x)); [auto|].
                eapply entries_contiguous_nw_invariant; eauto.
          }
      + find_apply_hyp_hyp. break_exists_exists; intuition.
        find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
        simpl in *.
        rewrite update_elections_data_appendEntries_leaderLogs. auto.
    - unfold logs_leaderLogs_nw in *.
      intros. simpl in *. find_apply_hyp_hyp.
      intuition.
      + prove_in.
        copy_eapply_prop_hyp In In; eauto.
        break_exists_exists; intuition;
        repeat find_higher_order_rewrite;
        update_destruct; subst; rewrite_update; eauto;
        simpl in *;
        rewrite update_elections_data_appendEntries_leaderLogs; auto.
      + exfalso. subst. simpl in *.
        unfold handleAppendEntries in *; repeat break_match; find_inversion; congruence.
  Qed.

  Lemma logs_leaderLogs_inductive_appendEntriesReply :
    refined_raft_net_invariant_append_entries_reply logs_leaderLogs_inductive.
  Proof using.
    red. unfold logs_leaderLogs_inductive. intros. intuition.
    - find_apply_lem_hyp handleAppendEntriesReply_log. subst.
      unfold logs_leaderLogs in *. intros.
      simpl in *.
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; simpl in *;
      repeat find_rewrite;
      find_apply_hyp_hyp; break_exists_exists; intuition;
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
    - find_eapply_lem_hyp handleAppendEntriesReply_packets. subst.
      intuition. unfold logs_leaderLogs_nw in *. intros.
      simpl in *. find_apply_hyp_hyp. intuition.
      prove_in. copy_eapply_prop_hyp In In; eauto.
      break_exists_exists; intuition;
      repeat find_higher_order_rewrite;
      update_destruct; subst; rewrite_update; eauto.
  Qed.

  Lemma logs_leaderLogs_inductive_requestVote :
    refined_raft_net_invariant_request_vote logs_leaderLogs_inductive.
  Proof using.
    red. unfold logs_leaderLogs_inductive. intros. intuition.
    - find_apply_lem_hyp handleRequestVote_log. subst.
      unfold logs_leaderLogs in *. intros.
      simpl in *.
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; simpl in *;
      repeat find_rewrite;
      find_apply_hyp_hyp; break_exists_exists; intuition;
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto;
      simpl in *; rewrite update_elections_data_requestVote_leaderLogs; eauto.
    - find_eapply_lem_hyp handleRequestVote_no_append_entries. subst.
      intuition. unfold logs_leaderLogs_nw in *. intros.
      simpl in *. find_apply_hyp_hyp. intuition.
      + prove_in. copy_eapply_prop_hyp In In; eauto.
        break_exists_exists; intuition;
        repeat find_higher_order_rewrite;
        update_destruct; subst; rewrite_update; eauto;
        simpl in *; rewrite update_elections_data_requestVote_leaderLogs; eauto.
      + find_false. subst. simpl in *. subst.
        repeat eexists; eauto.
  Qed.

  Lemma logs_leaderLogs_inductive_requestVoteReply :
    refined_raft_net_invariant_request_vote_reply logs_leaderLogs_inductive.
  Proof using.
    red. unfold logs_leaderLogs_inductive. intros. intuition.
    - subst.
      unfold logs_leaderLogs in *. intros.
      simpl in *.
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; simpl in *;
      repeat find_rewrite;
      [match goal with
        | H : In _ (log _ ) |- _ =>
          erewrite handleRequestVoteReply_log; eauto;
          erewrite handleRequestVoteReply_log in H; eauto
      end|];
      find_apply_hyp_hyp; break_exists_exists; intuition;
      find_higher_order_rewrite ; update_destruct; subst; rewrite_update; eauto;
      simpl in *; apply update_elections_data_requestVoteReply_leaderLogs; eauto.
    - unfold logs_leaderLogs_nw in *. intros.
      simpl in *. find_apply_hyp_hyp. intuition.
      prove_in. copy_eapply_prop_hyp In In; eauto.
      break_exists_exists; intuition;
      repeat find_higher_order_rewrite;
      update_destruct; subst; rewrite_update; eauto;
      simpl in *; apply update_elections_data_requestVoteReply_leaderLogs; eauto.
  Qed.

  Lemma logs_leaderLogs_inductive_clientRequest :
    refined_raft_net_invariant_client_request logs_leaderLogs_inductive.
  Proof using si lhllsi rri.
    red. unfold logs_leaderLogs_inductive. intros. intuition.
    - subst.
      unfold logs_leaderLogs in *. intros.
      simpl in *.
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; simpl in *.
      + find_apply_lem_hyp handleClientRequest_log. intuition; subst; repeat find_rewrite.
        * find_apply_hyp_hyp; break_exists_exists; intuition;
          find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto;
          simpl in *; rewrite update_elections_data_client_request_leaderLogs; eauto.
        * {break_exists. intuition. repeat find_rewrite. simpl in *.
           intuition; subst.
           - find_apply_lem_hyp leaders_have_leaderLogs_strong_invariant; eauto.
             break_exists. intuition.
             unfold ghost_data in *. simpl in *. repeat find_rewrite.
             match goal with
               | h : name, _ : _ = ?e :: ?es ++ ?ll |- _ =>
                 exists h, ll, (e :: x0)
             end; intuition.
             + find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto;
               simpl in *; rewrite update_elections_data_client_request_leaderLogs; eauto.
             + break_if; eauto using app_ass; do_bool; lia.
             + simpl in *. intuition; subst; eauto.
           - find_copy_apply_lem_hyp maxIndex_is_max; eauto using lift_logs_sorted.
             find_apply_hyp_hyp. break_exists_exists; intuition;
             [find_higher_order_rewrite ; update_destruct; subst; rewrite_update; eauto;
              simpl in *; rewrite update_elections_data_client_request_leaderLogs; eauto|].
             break_if; do_bool; intuition; lia.
          }
      + find_apply_hyp_hyp; break_exists_exists; intuition;
        find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto;
        simpl in *; rewrite update_elections_data_client_request_leaderLogs; eauto.
    - unfold logs_leaderLogs_nw in *.
      intros. simpl in *. find_apply_hyp_hyp. intuition.
      + eapply_prop_hyp In pBody; eauto; break_exists_exists; intuition; subst;
        repeat find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto;
        simpl in *; rewrite update_elections_data_client_request_leaderLogs; eauto.
      + do_in_map. subst. simpl in *. find_eapply_lem_hyp handleClientRequest_no_append_entries;
          eauto. intuition. find_false. repeat find_rewrite. repeat eexists; eauto.
  Qed.

  Lemma logs_leaderLogs_inductive_timeout :
    refined_raft_net_invariant_timeout logs_leaderLogs_inductive.
  Proof using.
    red. unfold logs_leaderLogs_inductive. intros. intuition.
    - find_apply_lem_hyp handleTimeout_log_same. subst.
      unfold logs_leaderLogs in *. intros.
      simpl in *.
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; simpl in *;
      repeat find_rewrite;
      find_apply_hyp_hyp; break_exists_exists; intuition;
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto;
      simpl in *; rewrite update_elections_data_timeout_leaderLogs; eauto.
    - intuition. unfold logs_leaderLogs_nw in *. intros.
      simpl in *. find_apply_hyp_hyp. intuition.
      + copy_eapply_prop_hyp In In; eauto.
        break_exists_exists; intuition;
        repeat find_higher_order_rewrite;
        update_destruct; subst; rewrite_update; eauto;
        simpl in *; rewrite update_elections_data_timeout_leaderLogs; eauto.
      + do_in_map. subst. simpl in *.
        find_eapply_lem_hyp handleTimeout_packets; eauto. intuition.
        find_false. repeat find_rewrite.
        repeat eexists; eauto.
  Qed.

  Lemma logs_leaderLogs_inductive_doGenericServer :
    refined_raft_net_invariant_do_generic_server logs_leaderLogs_inductive.
  Proof using.
    red. unfold logs_leaderLogs_inductive. intros.
    match goal with
      | H : nwState ?net ?h = (?gd, ?d) |- _ =>
        replace gd with (fst (nwState net h)) in * by (rewrite H; reflexivity);
          replace d with (snd (nwState net h)) in * by (rewrite H; reflexivity);
          clear H
    end.
    intuition.
    - find_apply_lem_hyp doGenericServer_log.
      unfold logs_leaderLogs in *. intros.
      simpl in *.
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; simpl in *;
      repeat find_rewrite;
      find_apply_hyp_hyp; break_exists_exists; intuition;
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
    - find_apply_lem_hyp doGenericServer_packets. subst.
      unfold logs_leaderLogs_nw in *. intros. simpl in *.
      find_apply_hyp_hyp. intuition.
      eapply_prop_hyp In In; eauto.
      break_exists_exists; intuition;
      repeat find_higher_order_rewrite;
      update_destruct; subst; rewrite_update; eauto.
  Qed.

  Lemma doLeader_spec :
    forall st h os st' ms m t n pli plt es ci,
      doLeader st h = (os, st', ms) ->
      In m ms ->
      snd m = AppendEntries t n pli plt es ci ->
      t = currentTerm st /\
      log st' = log st /\
      type st = Leader /\
      ((pli = 0 /\ plt = 0 /\ es = findGtIndex (log st) 0) \/
       ((exists e, findAtIndex (log st) pli = Some e /\
              eTerm e = plt) /\
        es = findGtIndex (log st) pli) \/
       exists h', pred (getNextIndex st h') <> 0 /\ findAtIndex (log st) (pred (getNextIndex st h')) = None).
  Proof using.
    intros. unfold doLeader, advanceCommitIndex in *.
    break_match; try solve [find_inversion; simpl in *; intuition].
    break_if; try solve [find_inversion; simpl in *; intuition].
    find_inversion. simpl. do_in_map. subst.
    simpl in *. find_inversion. intuition.
    match goal with
      | |- context [pred ?x] =>
        remember (pred x) as index
    end. break_match; simpl in *.
    - right. left. eauto.
    -  destruct index; intuition.
       right. right. exists x.
       match goal with
         | _ : S _ = pred ?x |- context [pred ?y] =>
           assert (pred x = pred y) by auto
       end.
       repeat find_rewrite. intuition.
  Qed.

  Lemma logs_leaderLogs_inductive_doLeader :
    refined_raft_net_invariant_do_leader logs_leaderLogs_inductive.
  Proof using si nisi rlmli llsi rri.
    red. unfold logs_leaderLogs_inductive. intros.
    match goal with
      | H : nwState ?net ?h = (?gd, ?d) |- _ =>
        replace gd with (fst (nwState net h)) in * by (rewrite H; reflexivity);
          replace d with (snd (nwState net h)) in * by (rewrite H; reflexivity);
          clear H
    end.
    intuition.
    - unfold logs_leaderLogs in *.
      intros.
      simpl in *.
      find_apply_lem_hyp doLeader_log.
      find_higher_order_rewrite. simpl in *.
      update_destruct; subst; rewrite_update; simpl in *; repeat find_rewrite;
      find_apply_hyp_hyp; break_exists_exists; intuition;
      find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
    - unfold logs_leaderLogs_nw.
      intros. simpl in *. find_apply_hyp_hyp.
      break_or_hyp.
      + unfold logs_leaderLogs_nw in *.
        eapply_prop_hyp pBody pBody; eauto.
        break_exists_exists; intuition; subst;
        find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
      + { do_in_map. subst. simpl in *.
          find_eapply_lem_hyp doLeader_spec; eauto. intuition.
          - subst. (* just use host invariant *)
            unfold logs_leaderLogs in *.
            find_apply_lem_hyp findGtIndex_necessary.
            intuition.
            eapply_prop_hyp In In.
            break_exists_exists. intuition.
            match goal with
              | _ : In (_, ?ll) _ |- _ =>
                exists ll
            end.
            intuition; eauto using Prefix_refl;
            [find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto|].
            rewrite sorted_findGtIndex_0; eauto using lift_logs_sorted.
            intros. eapply entries_gt_0_invariant; eauto.
          - break_exists. break_and.
            subst.
            unfold logs_leaderLogs in *.
            find_apply_lem_hyp findGtIndex_necessary.
            break_and. find_apply_hyp_hyp.
            match goal with
              | H : exists _ _ _, _ |- _ =>
                destruct H as [leader];
                  destruct H as [ll];
                  destruct H as [es]
            end.
            break_and.
            destruct (lt_eq_lt_dec (maxIndex ll) pli); intuition.
            + exists leader, ll, (findGtIndex es pli), []. intuition.
              * find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
              * simpl; auto.
              * rewrite app_nil_r.
                rewrite findGtIndex_removeAfterIndex_commute; eauto using lift_logs_sorted.
                unfold ghost_data in *. simpl in *.
                find_rewrite.
                eapply findGtIndex_app_1; lia.
              * eauto using findGtIndex_in.
              * left. intuition.
                match goal with
                  | H : forall _, In _ _ -> _ |- _ =>
                    apply H
                end.
                find_apply_lem_hyp findAtIndex_elim. intuition.
                subst.
                match goal with
                  | _ : In ?x ?l, _ : eIndex ?e > eIndex ?x |- _ =>
                    assert (In x (removeAfterIndex l (eIndex e))) by
                        (apply removeAfterIndex_le_In; eauto; lia)
                end.
                unfold ghost_data in *. simpl in *.
                find_rewrite.
                do_in_app; intuition.
                find_copy_apply_lem_hyp leaderLogs_sorted_invariant; eauto.
                find_apply_lem_hyp maxIndex_is_max; eauto; lia.
            + exists leader, ll, (findGtIndex es pli), []. intuition.
              * find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
              * simpl; auto.
              * rewrite app_nil_r.
                rewrite findGtIndex_removeAfterIndex_commute; eauto using lift_logs_sorted.
                unfold ghost_data in *. simpl in *.
                find_rewrite.
                apply findGtIndex_app_1. lia.
              * eauto using findGtIndex_in.
              * right. find_apply_lem_hyp findAtIndex_elim.
                left. exists x0. intuition. subst.
                match goal with
                  | _ : In ?x ?l, _ : eIndex ?e > _ |- _ =>
                    assert (In x (removeAfterIndex l (eIndex e))) by
                        (apply removeAfterIndex_le_In; eauto; lia)
                end.
                unfold ghost_data in *. simpl in *.
                find_rewrite.
                assert (sorted (es ++ ll)) by (repeat find_reverse_rewrite;
                                               apply removeAfterIndex_sorted;
                                               repeat find_rewrite; eauto using lift_logs_sorted).
                eapply thing3; eauto; try lia. intros.
                match goal with
                  | |- eIndex ?e > _ =>
                    assert (In e (log (snd (nwState net h)))) by
                        (unfold ghost_data in *; simpl in *;
                         eapply removeAfterIndex_in; repeat find_reverse_rewrite; eauto)
                end.
                eapply entries_gt_0_invariant; eauto.
            + exists leader, ll, es, (findGtIndex ll pli). intuition.
              * find_higher_order_rewrite; update_destruct; subst; rewrite_update; eauto.
              * (* prefix_findGtIndex *)
                apply findGtIndex_Prefix.
              * rewrite findGtIndex_removeAfterIndex_commute; eauto using lift_logs_sorted.
                unfold ghost_data in *. simpl in *.
                find_rewrite.
                assert (sorted (es ++ ll)) by (repeat find_reverse_rewrite;
                                               apply removeAfterIndex_sorted;
                                               repeat find_rewrite; eauto using lift_logs_sorted).
                apply findGtIndex_app_2; auto.
              * { right. left.
                  find_apply_lem_hyp findAtIndex_elim.
                  exists x0.  intuition.
                  - subst.
                    match goal with
                      | H : removeAfterIndex _ _ = _ |- _ =>
                        find_eapply_lem_hyp removeAfterIndex_le_In;
                          [unfold ghost_data in *; simpl in *; find_rewrite_lem H|lia]
                    end.
                    assert (sorted (es ++ ll)) by (repeat find_reverse_rewrite;
                                                   apply removeAfterIndex_sorted;
                                                   repeat find_rewrite; eauto using lift_logs_sorted).
                    eapply thing3; eauto; try lia. intros.
                     match goal with
                       | |- eIndex ?e > _ =>
                         assert (In e (log (snd (nwState net h)))) by
                             (unfold ghost_data in *; simpl in *;
                              eapply removeAfterIndex_in; repeat find_reverse_rewrite; eauto)
                     end.
                     eapply entries_gt_0_invariant; eauto.
                  - left. intros.
                    eapply findGtIndex_non_empty; eauto.
                }
          - exfalso. (* use nextIndex_sanity *)
            break_exists. intuition.
            find_eapply_lem_hyp nextIndex_sanity; eauto. break_exists.
            unfold ghost_data in *. simpl in *. congruence.
        }
  Qed.

  Lemma logs_leaderLogs_inductive_init :
    refined_raft_net_invariant_init logs_leaderLogs_inductive.
  Proof using.
    unfold logs_leaderLogs_inductive. red. intuition.
    - unfold logs_leaderLogs. intros. simpl in *. intuition.
    - unfold logs_leaderLogs_nw. intros. simpl in *. intuition.
  Qed.

  Lemma logs_leaderLogs_inductive_state_same_packets_subset :
    refined_raft_net_invariant_state_same_packet_subset logs_leaderLogs_inductive.
  Proof using.
    red. unfold logs_leaderLogs_inductive. intuition.
    - unfold logs_leaderLogs in *. intros.
      repeat find_reverse_higher_order_rewrite.
      find_apply_hyp_hyp. break_exists_exists; intuition.
      find_reverse_higher_order_rewrite. auto.
    - unfold logs_leaderLogs_nw in *. intros.
      find_apply_hyp_hyp. eapply_prop_hyp pBody pBody; eauto.
      break_exists_exists; intuition; subst;
      repeat find_reverse_higher_order_rewrite; auto.
  Qed.

  Lemma logs_leaderLogs_inductive_reboot :
    refined_raft_net_invariant_reboot logs_leaderLogs_inductive.
  Proof using.
    red. unfold logs_leaderLogs_inductive. intros.
    match goal with
      | H : nwState ?net ?h = (?gd, ?d) |- _ =>
        replace gd with (fst (nwState net h)) in * by (rewrite H; reflexivity);
          replace d with (snd (nwState net h)) in * by (rewrite H; reflexivity);
          clear H
    end.
    intuition.
    - subst. unfold logs_leaderLogs in *. intros.
      repeat find_reverse_higher_order_rewrite.
      find_higher_order_rewrite.
      update_destruct; subst; rewrite_update; unfold reboot in *; simpl in *;
      find_apply_hyp_hyp; break_exists_exists; intuition;
      find_higher_order_rewrite; simpl in *; auto;
      update_destruct; subst; rewrite_update; simpl in *; auto.
    - unfold logs_leaderLogs_nw in *. intros.
      find_reverse_rewrite.
      eapply_prop_hyp pBody pBody; eauto.
      break_exists_exists; intuition; subst;
      repeat find_reverse_higher_order_rewrite; auto;
      repeat find_higher_order_rewrite; simpl in *; auto;
      update_destruct; subst; rewrite_update; simpl in *; auto.
  Qed.

  Theorem logs_leaderLogs_inductive_invariant :
    forall net,
      refined_raft_intermediate_reachable net ->
      logs_leaderLogs_inductive net.
  Proof using lpholli si nisi lhllsi lllmi llci rlmli llsi rri.
    intros.
    apply refined_raft_net_invariant; auto.
    - apply logs_leaderLogs_inductive_init.
    - apply logs_leaderLogs_inductive_clientRequest.
    - apply logs_leaderLogs_inductive_timeout.
    - apply logs_leaderLogs_inductive_appendEntries.
    - apply logs_leaderLogs_inductive_appendEntriesReply.
    - apply logs_leaderLogs_inductive_requestVote.
    - apply logs_leaderLogs_inductive_requestVoteReply.
    - apply logs_leaderLogs_inductive_doLeader.
    - apply logs_leaderLogs_inductive_doGenericServer.
    - apply logs_leaderLogs_inductive_state_same_packets_subset.
    - apply logs_leaderLogs_inductive_reboot.
  Qed.

  Theorem logs_leaderLogs_invariant :
    forall net,
      refined_raft_intermediate_reachable net ->
      logs_leaderLogs net.
  Proof using lpholli si nisi lhllsi lllmi llci rlmli llsi rri.
    intros. apply logs_leaderLogs_inductive_invariant. auto.
  Qed.

  Theorem logs_leaderLogs_nw_invariant :
    forall net,
      refined_raft_intermediate_reachable net ->
      logs_leaderLogs_nw net.
  Proof using lpholli si nisi lhllsi lllmi llci rlmli llsi rri.
    intros. apply logs_leaderLogs_inductive_invariant. auto.
  Qed.

  Instance llli : logs_leaderLogs_interface.
  Proof.
    split; eauto using logs_leaderLogs_invariant, logs_leaderLogs_nw_invariant.
  Qed.

End LogsLeaderLogs.


Require Import Rupicola.Lib.Api.
Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Bedrock.Specs.Field.

Section Gallina.
  Definition point {field_parameters : FieldParameters} : Type
    := (F M_pos * F M_pos).
End Gallina.

Section Compile.
  Context {semantics : Semantics.parameters}
          {semantics_ok : Semantics.parameters_ok semantics}.
  Context {field_parameters : FieldParameters}
          {field_representation : FieldRepresentation}.

  Lemma compile_point_assign :
    forall (locals: Semantics.locals) (mem: Semantics.mem)
           (locals_ok : Semantics.locals -> Prop)
      tr retvars R functions T (pred: T -> _ -> _ -> Prop)
      (x y : F M_pos) k k_impl,
      let v := (x, y) in
      (let __ := 0 in (* placeholder *)
       find k_impl
       implementing (pred (dlet x
                                (fun x => dlet y
                                               (fun y => k (x, y)))))
       and-returning retvars
       and-locals-post locals_ok
       with-locals locals and-memory mem and-trace tr and-rest R
       and-functions functions) ->
      (let head := v in
       find k_impl
       implementing (pred (dlet head k))
       and-returning retvars
       and-locals-post locals_ok
       with-locals locals and-memory mem and-trace tr and-rest R
       and-functions functions).
  Proof.
    repeat straightline'. eauto.
  Qed.
End Compile.


(* This file defines a simple escrow contract based on the "safe remote
purchase" example in Solidity's docs. This contract allows a seller to sell an
item in a trustless setting assuming economically rational actors. With the
premise that the seller wants to sell an item for 1 ETH, the contract works in
the following way:

1. The seller deploys the contract and commits 2 ETH.
2. The buyer commits 2 ETH before the deadline.
3. The seller hands over the item (outside of the smart contract).
4. The buyer confirms he has received the item. He gets 1 ETH back
while the seller gets 3 ETH back.

If the buyer does not commit the funds, the seller gets his money back after the
deadline. The economic rationality shows up in our assumption that the seller
will confirm he has received the item to get his own funds back. *)

From Coq Require Import Bool.
From Coq Require Import ZArith_base.
From Coq Require Import List. Import ListNotations.
From ConCert.Execution Require Import Blockchain.
From ConCert.Execution Require Import Monad.
From ConCert.Execution Require Import ResultMonad.
From ConCert.Execution Require Import Serializable.
From ConCert.Utils Require Import RecordUpdate.

Section Escrow.
  Context `{Base : ChainBase}.

  Set Nonrecursive Elimination Schemes.

  Record Setup :=
    build_setup {
      setup_buyer : Address;
    }.

  Inductive NextStep :=
  (* Waiting for buyer to commit itemvalue * 2 *)
  | buyer_commit
  (* Waiting for buyer to confirm item received *)
  | buyer_confirm
  (* Waiting for buyer and seller to withdraw their funds. *)
  | withdrawals
  (* No next step, sale is done. *)
  | no_next_step.

  Record State :=
    build_state {
      last_action : nat;
      next_step : NextStep;
      seller : Address;
      buyer : Address;
      seller_withdrawable : Amount;
      buyer_withdrawable : Amount;
    }.

  Definition Error : Type := nat.
  Definition default_error : Error := 1%nat.

  Inductive Msg :=
  | commit_money
  | confirm_item_received
  | withdraw.

  (* begin hide *)
  MetaCoq Run (make_setters State).
  (* end hide *)

  Section Serialization.
    Global Instance Setup_serializable : Serializable Setup :=
      Derive Serializable Setup_rect<build_setup>.

    Global Instance NextStep_serializable : Serializable NextStep :=
      Derive Serializable NextStep_rect<buyer_commit, buyer_confirm, withdrawals, no_next_step>.

    Global Instance State_serializable : Serializable State :=
      Derive Serializable State_rect<build_state>.

    Global Instance Msg_serializable : Serializable Msg :=
      Derive Serializable Msg_rect<commit_money, confirm_item_received, withdraw>.
  End Serialization.

  Open Scope Z.
  Definition init (chain : Chain)
                  (ctx : ContractCallContext)
                  (setup : Setup)
                  : result State Error :=
    let seller := ctx_from ctx in
    let buyer := setup_buyer setup in
    do if (buyer =? seller)%address then Err default_error else Ok tt;
    do if ctx_amount ctx =? 0 then Err default_error else Ok tt;
    do if Z.even (ctx_amount ctx) then Ok tt else Err default_error;
    Ok (build_state (current_slot chain) buyer_commit seller buyer 0 0).

  Definition subAmountOption (n m : Amount) : option Amount :=
    if n <? m then None else Some (n - m).

  Definition receive (chain : Chain)
                     (ctx : ContractCallContext)
                     (state : State)
                     (msg : option Msg)
                     : result (State * list ActionBody) Error :=
    match msg, next_step state with
    | Some commit_money, buyer_commit =>
      do diff_ <- result_of_option (subAmountOption (ctx_contract_balance ctx) (ctx_amount ctx)) default_error;
      let item_price := diff_ / 2 in
      let expected := item_price * 2 in
      do if (ctx_from ctx =? buyer state)%address then Ok tt else Err default_error;
      do if ctx_amount ctx =? expected then Ok tt else Err default_error;
      Ok (state<|next_step := buyer_confirm|>
              <|last_action := current_slot chain|>, [])

    | Some confirm_item_received, buyer_confirm =>
      let item_price := ctx_contract_balance ctx / 4 in
      do if (ctx_from ctx =? buyer state)%address then Ok tt else Err default_error;
      do if ctx_amount ctx =? 0 then Ok tt else Err default_error;
      let new_state :=
          state<|next_step := withdrawals|>
              <|buyer_withdrawable := item_price|>
              <|seller_withdrawable := item_price * 3|> in
      Ok (new_state, [])

    | Some withdraw, withdrawals =>
      do if ctx_amount ctx =? 0 then Ok tt else Err default_error;
      let from := ctx_from ctx in
      do '(to_pay, new_state) <-
        match from =? buyer state, from =? seller state with
        | true, _ => Ok (buyer_withdrawable state, state<|buyer_withdrawable := 0|>)
        | _, true => Ok (seller_withdrawable state, state<|seller_withdrawable := 0|>)
        | _, _ => Err default_error
        end%address;
      do if to_pay >? 0 then Ok tt else Err default_error;
      let new_state :=
          if (buyer_withdrawable new_state =? 0) && (seller_withdrawable new_state =? 0)
          then new_state<|next_step := no_next_step|>
          else new_state in
      Ok (new_state, [act_transfer (ctx_from ctx) to_pay])
    | Some withdraw, buyer_commit =>
      do if ctx_amount ctx =? 0 then Ok tt else Err default_error;
      do if (last_action state + 50 <? current_slot chain)%nat then Err default_error else Ok tt;
      do if (ctx_from ctx =? seller state)%address then Ok tt else Err default_error;
      let balance := ctx_contract_balance ctx in
      Ok (state<|next_step := no_next_step|>, [act_transfer (seller state) balance])

    | _, _ => Err default_error
    end.

  Definition contract : Contract Setup Msg State Error :=
    build_contract init receive.

End Escrow.