(****************************************************************************)
(*                                                                          *)
(*                                                                          *)
(*              Solange Coupet-Grimal & Catherine Nouvet                    *)
(*                                                                          *)
(*                                                                          *)
(*       Laboratoire d'Informatique Fondamentale de Marseille               *)
(*               CMI-Technopole de Chateau-Gombert                          *)
(*                   39, Rue F. Joliot Curie                                *)
(*                   13453 MARSEILLE Cedex 13                               *)
(*           Contact :Solange.Coupet@cmi.univ-mrs.fr                        *)
(*                                                                          *)
(*                                                                          *)
(*                                Coq V7.0                                  *)
(*                             Septembre 2002                               *)
(*                                                                          *)
(****************************************************************************)
(*                              accnotfree.v                                *)
(****************************************************************************)

Section invariant4.

Require Export lemma_step.
Require Export sweepnogrey.
Require Export rtgreyorblack.

Lemma acc_imp_notfree_init :
 forall s : state, init_state s -> acc_imp_notfree s.

unfold acc_imp_notfree in |- *.
intros s init n acces_s_n.
elim acces_s_n; clear acces_s_n.
cut (rt_grey_or_black s); unfold rt_grey_or_black in |- *.
intro mksrt; elim mksrt; clear mksrt.
intro mksrt; rewrite mksrt; discriminate.
intro mksrt; rewrite mksrt; discriminate.
apply (rt_grey_or_black_init s); assumption.
intros n0 m acces_s_m mksm hsmn0; elim init; clear init.
intros ctls H_mark_col; elim H_mark_col; clear H_mark_col.
intros init heap; absurd (hp s m n0 = false); auto.
rewrite hsmn0; discriminate.
Qed.

Lemma acc_imp_notfree_addedge :
 forall s t : state, acc_imp_notfree s -> add_edge s t -> acc_imp_notfree t.

unfold acc_imp_notfree in |- *.
intros s t H_s addedge n acces_t_n.
apply (add_notfrees_notfreet s t); auto.
apply H_s; apply (add_accest_access s t); assumption.
Qed.

Lemma acc_imp_notfree_removeedge :
 forall s t : state,
 acc_imp_notfree s -> remove_edge s t -> acc_imp_notfree t.

unfold acc_imp_notfree in |- *.
intros s t H_s removeedge n acces_t_n.
apply (remove_notfrees_notfreet s t); auto.
apply H_s; apply (remove_accest_access s t); assumption.
Qed.

Lemma acc_imp_notfree_alloc :
 forall s t : state, acc_imp_notfree s -> alloc s t -> acc_imp_notfree t.

unfold acc_imp_notfree in |- *.
intros s t H_s alloc n acces_t_n.
elim alloc; clear alloc.
intros ctls ctlt n0 mksn0 H_fils mark add; elim mark; clear mark.
intros mark mktn0; elim (eq_dec_node n n0).
intro neqn0; rewrite neqn0; rewrite mktn0; discriminate.
intro ndifn0.
rewrite <- (mark n ndifn0).
apply H_s; apply (alloc_accest_access s t n0); auto.
unfold update_color in |- *; auto.
Qed.

Lemma acc_imp_notfree_gccall :
 forall s t : state,
 nogrey_accn_imp_blackn s ->
 acc_imp_notfree s -> gc_call s t -> acc_imp_notfree t.

unfold acc_imp_notfree in |- *.
intros s t inv5_s H_s gccall.
elim gccall; clear gccall.
intros ctls ctlt heap H_col init n acces_t_n.
apply (initcolor_notfrees_notfreet s t); auto.
apply H_s; rewrite <- heap; assumption.
intros ctls ctlt heap H_sons n acces_t_n.
apply (greynode_notfrees_notfreet s t n); auto.
apply H_s; elim H_sons; clear H_sons.
intros g mksg mktg H_col1 H_col2; rewrite <- heap; assumption.
intros ctls ctlt heap H_col m mksm mark n acces_t_n.
elim mark; clear mark.
intros mark mktm.
unfold nogrey_accn_imp_blackn in inv5_s.
rewrite <- (mark n).
rewrite inv5_s; auto.
discriminate.
rewrite heap; assumption.
apply (noteqmar_noteqnod (mk s) n m); rewrite mksm; rewrite inv5_s; auto.
discriminate.
rewrite heap; assumption.
Qed.

Lemma acc_imp_notfree_marknode :
 forall s t : state, acc_imp_notfree s -> mark_node s t -> acc_imp_notfree t.

unfold acc_imp_notfree in |- *.
intros s t H_s marknode n acces_t_n.
apply (marknode_notfrees_notfreet s t); auto.
apply H_s; apply (marknode_accest_access s t); assumption.
Qed.

Lemma acc_imp_notfree_gcstop :
 forall s t : state, acc_imp_notfree s -> gc_stop s t -> acc_imp_notfree t.

unfold acc_imp_notfree in |- *.
intros s t H_s gcstop n acces_t_n.
apply (gcstop_notfrees_notfreet s t); auto.
apply H_s; apply (gcstop_accest_access s t); assumption.
Qed.

Lemma acc_imp_notfree_gcfree :
 forall s t : state,
 nogrey_accn_imp_blackn s ->
 acc_imp_notfree s -> gc_free s t -> acc_imp_notfree t.

unfold acc_imp_notfree in |- *.
unfold nogrey_accn_imp_blackn in |- *.
intros s t inv5_s H_s gcfree n acces_t_n.
elim gcfree; clear gcfree.
intros ctls ctlt H_col heap m mksm mark; elim mark; clear mark.
intros mark mktm; rewrite <- (mark n).
rewrite inv5_s; auto.
discriminate.
rewrite <- heap; assumption.
apply (noteqmar_noteqnod (mk s) n m); rewrite mksm; rewrite inv5_s; auto.
discriminate.
rewrite <- heap; assumption.
Qed.

Lemma acc_imp_notfree_gcfree1 :
 forall s t : state,
 sweep_no_greys s ->
 nogrey_accn_imp_blackn s ->
 acc_imp_notfree s -> gc_free1 s t -> acc_imp_notfree t.

unfold nogrey_accn_imp_blackn in |- *.
unfold sweep_no_greys in |- *.
unfold acc_imp_notfree in |- *.
intros s t inv4_s inv5_s H_s gcfree1 n acces_t_n.
elim gcfree1; clear gcfree1.
intros ctls ctlt heap n0 mksn0 mark; elim mark; clear mark.
intros mark mktn0; rewrite <- (mark n).
rewrite inv5_s; auto.
discriminate.
rewrite heap; assumption.
apply (noteqmar_noteqnod (mk s) n n0); rewrite mksn0; rewrite inv5_s; auto.
discriminate.
rewrite heap; assumption.
Qed.

Lemma acc_imp_notfree_gcend :
 forall s t : state, acc_imp_notfree s -> gc_end s t -> acc_imp_notfree t.

unfold acc_imp_notfree in |- *.
intros s t H_s gcend n acces_t_n.
apply (gcend_notfrees_notfreet s t); auto.
apply H_s; apply (gcend_accest_access s t); assumption.
Qed.

End invariant4.

Hint Immediate acc_imp_notfree_addedge.
Hint Immediate acc_imp_notfree_removeedge.
Hint Immediate acc_imp_notfree_alloc.
Hint Immediate acc_imp_notfree_gccall.
Hint Immediate acc_imp_notfree_marknode.
Hint Immediate acc_imp_notfree_gcstop.
Hint Immediate acc_imp_notfree_gcfree.
Hint Immediate acc_imp_notfree_gcfree1.
Hint Immediate acc_imp_notfree_gcend.


Require Import VerdiRaft.Raft.
Require Import VerdiRaft.CommonDefinitions.

Require Import VerdiRaft.LastAppliedCommitIndexMatchingInterface.
Require Import VerdiRaft.LogMatchingInterface.
Require Import VerdiRaft.StateMachineSafetyInterface.
Require Import VerdiRaft.MaxIndexSanityInterface.

Section LastAppliedCommitIndexMatching.

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

  Context {lmi : log_matching_interface}.
  Context {smsi : state_machine_safety_interface}.
  Context {misi : max_index_sanity_interface}.

  Theorem lastApplied_commitIndex_match_invariant :
    forall net,
      raft_intermediate_reachable net ->
      lastApplied_commitIndex_match net.
  Proof using misi smsi lmi.
    intros.
    find_copy_apply_lem_hyp log_matching_invariant. unfold log_matching in *.
    find_copy_apply_lem_hyp state_machine_safety_invariant. unfold state_machine_safety in *.
    find_copy_apply_lem_hyp max_index_sanity_invariant. unfold maxIndex_sanity in *.
    unfold lastApplied_commitIndex_match.
    intuition; simpl in *.
    - unfold log_matching_hosts in *. intuition. simpl in *.
      match goal with
        | H : forall (_ : name) (_ : nat), _ |- In ?e (_ (_ ?h)) =>
          specialize (H h (eIndex e)); forward H;
          intuition
      end.
      + find_apply_hyp_hyp; omega.
      + eapply le_trans; [|eapply_prop maxIndex_commitIndex].
        simpl. omega.
      + break_exists. intuition.
        match goal with
          | _ : eIndex ?e = eIndex ?e' |- _ =>
            cut (e = e'); [intros; subst; auto|]
        end.
        eapply_prop state_machine_safety_host; unfold commit_recorded; intuition eauto;
        simpl in *; intuition.
    - unfold log_matching_hosts in *. intuition. simpl in *.
      match goal with
        | H : forall (_ : name) (_ : nat), _ |- In ?e (_ (_ ?h)) =>
          specialize (H h (eIndex e)); forward H;
          intuition
      end.
      + find_apply_hyp_hyp; omega.
      + eapply le_trans; [|eapply_prop maxIndex_lastApplied].
        simpl. omega.
      + break_exists. intuition.
        match goal with
          | _ : eIndex ?e = eIndex ?e' |- _ =>
            cut (e = e'); [intros; subst; auto|]
        end.
        eapply_prop state_machine_safety_host; unfold commit_recorded; intuition eauto;
        simpl in *; intuition.
  Qed.

  Theorem commitIndex_lastApplied_match_invariant :
    forall net,
      raft_intermediate_reachable net ->
      commitIndex_lastApplied_match net.
  Proof using misi smsi lmi.
    intros.
    find_copy_apply_lem_hyp log_matching_invariant. unfold log_matching in *.
    find_copy_apply_lem_hyp state_machine_safety_invariant. unfold state_machine_safety in *.
    find_copy_apply_lem_hyp max_index_sanity_invariant. unfold maxIndex_sanity in *.
    unfold commitIndex_lastApplied_match.
    intuition; simpl in *.
    - unfold log_matching_hosts in *. intuition. simpl in *.
      match goal with
        | H : forall (_ : name) (_ : nat), _ |- In ?e (_ (_ ?h)) =>
          specialize (H h (eIndex e)); forward H;
          intuition
      end.
      + find_apply_hyp_hyp; omega.
      + eapply le_trans; [|eapply_prop maxIndex_lastApplied].
        simpl. omega.
      + break_exists. intuition.
        match goal with
          | _ : eIndex ?e = eIndex ?e' |- _ =>
            cut (e = e'); [intros; subst; auto|]
        end.
        eapply_prop state_machine_safety_host; unfold commit_recorded; intuition eauto;
        simpl in *; intuition.
    - unfold log_matching_hosts in *. intuition. simpl in *.
      match goal with
        | H : forall (_ : name) (_ : nat), _ |- In ?e (_ (_ ?h)) =>
          specialize (H h (eIndex e)); forward H;
          intuition
      end.
      + find_apply_hyp_hyp; omega.
      + eapply le_trans; [|eapply_prop maxIndex_commitIndex].
        simpl. omega.
      + break_exists. intuition.
        match goal with
          | _ : eIndex ?e = eIndex ?e' |- _ =>
            cut (e = e'); [intros; subst; auto|]
        end.
        eapply_prop state_machine_safety_host; unfold commit_recorded; intuition eauto;
        simpl in *; intuition.
  Qed.

  Theorem lastApplied_lastApplied_match_invariant :
    forall net,
      raft_intermediate_reachable net ->
      lastApplied_lastApplied_match net.
  Proof using misi smsi lmi.
    intros.
    find_copy_apply_lem_hyp log_matching_invariant. unfold log_matching in *.
    find_copy_apply_lem_hyp state_machine_safety_invariant. unfold state_machine_safety in *.
    find_copy_apply_lem_hyp max_index_sanity_invariant. unfold maxIndex_sanity in *.
    unfold lastApplied_lastApplied_match.
    intuition; simpl in *.
    - unfold log_matching_hosts in *. intuition. simpl in *.
      match goal with
        | H : forall (_ : name) (_ : nat), _ |- In ?e (_ (_ ?h)) =>
          specialize (H h (eIndex e)); forward H;
          intuition
      end.
      + find_apply_hyp_hyp; omega.
      + eapply le_trans; [|eapply_prop maxIndex_lastApplied].
        simpl. omega.
      + break_exists. intuition.
        match goal with
          | _ : eIndex ?e = eIndex ?e' |- _ =>
            cut (e = e'); [intros; subst; auto|]
        end.
        eapply_prop state_machine_safety_host; unfold commit_recorded; intuition eauto;
        simpl in *; intuition.
    - unfold log_matching_hosts in *. intuition. simpl in *.
      match goal with
        | H : forall (_ : name) (_ : nat), _ |- In ?e (_ (_ ?h)) =>
          specialize (H h (eIndex e)); forward H;
          intuition
      end.
      + find_apply_hyp_hyp; omega.
      + eapply le_trans; [|eapply_prop maxIndex_lastApplied].
        simpl. omega.
      + break_exists. intuition.
        match goal with
          | _ : eIndex ?e = eIndex ?e' |- _ =>
            cut (e = e'); [intros; subst; auto|]
        end.
        eapply_prop state_machine_safety_host; unfold commit_recorded; intuition eauto;
        simpl in *; intuition.
  Qed.

  Instance lacimi : lastApplied_commitIndex_match_interface.
  split.
  - exact lastApplied_commitIndex_match_invariant.
  - exact commitIndex_lastApplied_match_invariant.
  - exact lastApplied_lastApplied_match_invariant.
  Defined.
End LastAppliedCommitIndexMatching.


From cap_machine Require Import rules_base.
From iris.base_logic Require Export invariants gen_heap.
From iris.program_logic Require Export weakestpre ectx_lifting.
From iris.proofmode Require Import tactics.
From iris.algebra Require Import frac.
From cap_machine.rules Require Import rules_StoreU.

Section cap_lang_rules.
  Context `{memG Σ, regG Σ, MonRef: MonRefG (leibnizO _) CapR_rtc Σ}.
  Context `{MachineParameters}.
  Implicit Types P Q : iProp Σ.
  Implicit Types σ : ExecConf.
  Implicit Types c : cap_lang.expr.
  Implicit Types a b : Addr.
  Implicit Types r : RegName.
  Implicit Types v : cap_lang.val.
  Implicit Types w : Word.
  Implicit Types reg : gmap RegName Word.
  Implicit Types ms : gmap Addr Word.

  Lemma isU_nonO p p' :
    PermFlows p p' → isU p = true → p' ≠ O.
  Proof.
    intros Hfl' Hra. destruct p'; auto. destruct p; inversion Hfl'. inversion Hra.
  Qed.

  Lemma wb_implies_verify_access p g:
    ∀ b e a,
      withinBounds ((p, g), b, e, a) = true ->
      match (a + 0)%a with
        | Some a' =>
            if Addr_le_dec b a'
            then if Addr_le_dec a' a then if Addr_lt_dec a e then Some a' else None else None
            else None
        | None => None
        end = Some a.
  Proof.
    intros b e a Hwb.
    rewrite /= addr_add_0 /=.
    apply withinBounds_le_addr in Hwb as [Hle Hlt].
    destruct (Addr_le_dec b a);[|contradiction].
    destruct (Addr_le_dec a a);[|solve_addr].
    destruct (Addr_lt_dec a e);[|contradiction].
    auto.
  Qed.

  (* store and increment *)
  Lemma wp_storeU_success_0_reg E pc_p pc_g pc_b pc_e pc_a pc_a' w dst src w'
         p g b e a a' w'' pc_p' p' :
    decodeInstrW w = StoreU dst (inl 0%Z) (inr src) →
    PermFlows pc_p pc_p' →
    PermFlows p p' →
    isCorrectPC (inr ((pc_p,pc_g),pc_b,pc_e,pc_a)) →
    (pc_a + 1)%a = Some pc_a' →
    isU p  = true -> canStoreU p w'' = true ->
    withinBounds ((p, g), b, e, a) = true ->
    (a + 1)%a = Some a' ->

     {{{ ▷ PC ↦ᵣ inr ((pc_p,pc_g),pc_b,pc_e,pc_a)
           ∗ ▷ pc_a ↦ₐ[pc_p'] w
           ∗ ▷ src ↦ᵣ w''
           ∗ ▷ dst ↦ᵣ inr ((p,g),b,e,a)
           ∗ ▷ a ↦ₐ[p'] w' }}}
       Instr Executable @ E
       {{{ RET NextIV;
           PC ↦ᵣ inr ((pc_p,pc_g),pc_b,pc_e,pc_a')
              ∗ pc_a ↦ₐ[pc_p'] w
              ∗ src ↦ᵣ w''
              ∗ dst ↦ᵣ inr ((p,g),b,e,a')
              ∗ a ↦ₐ[p'] w'' }}}.
    Proof.
      iIntros (Hinstr Hfl Hfl' Hvpc Hpca' HU HstoreU Hwb Ha' φ)
             "(>HPC & >Hi & >Hsrc & >Hdst & >Hsrca) Hφ".
    iDestruct (map_of_regs_3 with "HPC Hsrc Hdst") as "[Hmap (%&%&%)]".
    pose proof (isU_nonO _ _ Hfl' HU) as Hp''.
    pose proof (correctPC_nonO _ _ _ _ _ _ Hfl Hvpc) as Hpc_p'.
    iDestruct (memMap_resource_2ne_apply with "Hi Hsrca") as "[Hmem %]"; auto.

    iApply (wp_storeU _ pc_p with "[$Hmap $Hmem]"); eauto; simplify_map_eq; eauto.
    { by rewrite !dom_insert; set_solver+. }
    { rewrite HU HstoreU. erewrite wb_implies_verify_access; eauto.
      by simplify_map_eq. }
    iNext. iIntros (regs' mem' retv) "(#Hspec & Hmem & Hmap)".
    iDestruct "Hspec" as %Hspec.

    destruct Hspec as [ | * Hfail ].
     { (* Success *)
       iApply "Hφ".
       simplify_map_eq.
       erewrite wb_implies_verify_access in H11; eauto. simplify_eq.
       rewrite insert_commute // insert_insert.
       iDestruct (memMap_resource_2ne with "Hmem") as "[Hpc_a Ha]";auto.
       destruct (addr_eq_dec a'0 a'0);[|contradiction].
       incrementPC_inv.
       simplify_map_eq.
       rewrite (insert_commute _ _ PC) // insert_insert.
       rewrite (insert_commute _ _ src) // insert_insert.
       iDestruct (regs_of_map_3 with "[$Hmap]") as "[HPC [Hsrc Hdst] ]"; eauto. iFrame. }
     { (* Failure (contradiction) *)
       destruct Hfail; try incrementPC_inv; simplify_map_eq; eauto.
       all: try congruence.
       erewrite wb_implies_verify_access in e6; eauto. simplify_eq.
       Unshelve. all:auto.
     }
    Qed.

  (* store and increment from and to the same register *)
  Lemma wp_storeU_success_0_reg_same E pc_p pc_g pc_b pc_e pc_a pc_a' w dst w'
         p g b e a a' pc_p' p' :
    decodeInstrW w = StoreU dst (inl 0%Z) (inr dst) →
    PermFlows pc_p pc_p' →
    PermFlows p p' →
    isCorrectPC (inr ((pc_p,pc_g),pc_b,pc_e,pc_a)) →
    (pc_a + 1)%a = Some pc_a' →
    isU p  = true -> canStoreU p (inr (p, g, b, e, a)) = true ->
    withinBounds ((p, g), b, e, a) = true ->
    (a + 1)%a = Some a' ->

     {{{ ▷ PC ↦ᵣ inr ((pc_p,pc_g),pc_b,pc_e,pc_a)
           ∗ ▷ pc_a ↦ₐ[pc_p'] w
           ∗ ▷ dst ↦ᵣ inr ((p,g),b,e,a)
           ∗ ▷ a ↦ₐ[p'] w' }}}
       Instr Executable @ E
       {{{ RET NextIV;
           PC ↦ᵣ inr ((pc_p,pc_g),pc_b,pc_e,pc_a')
              ∗ pc_a ↦ₐ[pc_p'] w
              ∗ dst ↦ᵣ inr ((p,g),b,e,a')
              ∗ a ↦ₐ[p'] inr ((p,g),b,e,a)}}}.
    Proof.
      iIntros (Hinstr Hfl Hfl' Hvpc Hpca' HU HstoreU Hwb Ha' φ)
             "(>HPC & >Hi & >Hdst & >Hsrca) Hφ".
    iDestruct (map_of_regs_2 with "HPC Hdst") as "[Hmap %]".
    pose proof (isU_nonO _ _ Hfl' HU) as Hp''.
    pose proof (correctPC_nonO _ _ _ _ _ _ Hfl Hvpc) as Hpc_p'.
    iDestruct (memMap_resource_2ne_apply with "Hi Hsrca") as "[Hmem %]"; auto.

    iApply (wp_storeU _ pc_p with "[$Hmap $Hmem]"); eauto; simplify_map_eq; eauto.
    { by rewrite !dom_insert; set_solver+. }
    { unfold canStoreU. rewrite HU HstoreU. erewrite wb_implies_verify_access; eauto.
      by simplify_map_eq. }
    iNext. iIntros (regs' mem' retv) "(#Hspec & Hmem & Hmap)".
    iDestruct "Hspec" as %Hspec.

    destruct Hspec as [ | * Hfail ].
     { (* Success *)
       iApply "Hφ".
       simplify_map_eq.
       erewrite wb_implies_verify_access in H9; eauto. simplify_eq.
       rewrite insert_commute // insert_insert.
       iDestruct (memMap_resource_2ne with "Hmem") as "[Hpc_a Ha]";auto.
       destruct (addr_eq_dec a'0 a'0);[|contradiction].
       incrementPC_inv.
       simplify_map_eq.
       rewrite (insert_commute _ _ PC) // insert_insert.
       rewrite insert_insert.
       iDestruct (regs_of_map_2 with "[$Hmap]") as "[HPC [Hsrc Hdst] ]"; eauto. iFrame. }
     { (* Failure (contradiction) *)
       destruct Hfail; try incrementPC_inv; simplify_map_eq; eauto.
       all: try congruence.
       erewrite wb_implies_verify_access in e6; eauto. simplify_eq.
       Unshelve. all:auto.
     }
    Qed.

    Lemma wp_storeU_success_0_z E pc_p pc_g pc_b pc_e pc_a pc_a' w dst z w'
         p g b e a a' pc_p' p' :
    decodeInstrW w = StoreU dst (inl 0%Z) (inl z) →
    PermFlows pc_p pc_p' →
    PermFlows p p' →
    isCorrectPC (inr ((pc_p,pc_g),pc_b,pc_e,pc_a)) →
    (pc_a + 1)%a = Some pc_a' →
    isU p  = true ->
    withinBounds ((p, g), b, e, a) = true ->
    (a + 1)%a = Some a' ->

     {{{ ▷ PC ↦ᵣ inr ((pc_p,pc_g),pc_b,pc_e,pc_a)
           ∗ ▷ pc_a ↦ₐ[pc_p'] w
           ∗ ▷ dst ↦ᵣ inr ((p,g),b,e,a)
           ∗ ▷ a ↦ₐ[p'] w' }}}
       Instr Executable @ E
       {{{ RET NextIV;
           PC ↦ᵣ inr ((pc_p,pc_g),pc_b,pc_e,pc_a')
              ∗ pc_a ↦ₐ[pc_p'] w
              ∗ dst ↦ᵣ inr ((p,g),b,e,a')
              ∗ a ↦ₐ[p'] (inl z) }}}.
    Proof.
      iIntros (Hinstr Hfl Hfl' Hvpc Hpca' HU Hwb Ha' φ)
             "(>HPC & >Hi & >Hdst & >Hsrca) Hφ".
    iDestruct (map_of_regs_2 with "HPC Hdst") as "[Hmap %]".
    pose proof (isU_nonO _ _ Hfl' HU) as Hp''.
    pose proof (correctPC_nonO _ _ _ _ _ _ Hfl Hvpc) as Hpc_p'.
    iDestruct (memMap_resource_2ne_apply with "Hi Hsrca") as "[Hmem %]"; auto.

    iApply (wp_storeU _ pc_p with "[$Hmap $Hmem]"); eauto; simplify_map_eq; eauto.
    { by rewrite !dom_insert; set_solver+. }
    { rewrite HU. erewrite wb_implies_verify_access; eauto.
      by simplify_map_eq. }
    iNext. iIntros (regs' mem' retv) "(#Hspec & Hmem & Hmap)".
    iDestruct "Hspec" as %Hspec.

    destruct Hspec as [ | * Hfail ].
     { (* Success *)
       iApply "Hφ".
       simplify_map_eq.
       erewrite wb_implies_verify_access in H9; eauto. simplify_eq.
       rewrite insert_commute // insert_insert.
       iDestruct (memMap_resource_2ne with "Hmem") as "[Hpc_a Ha]";auto.
       destruct (addr_eq_dec a'0 a'0);[|contradiction].
       incrementPC_inv.
       simplify_map_eq.
       rewrite (insert_commute _ _ PC) // insert_insert. rewrite insert_insert.
       iDestruct (regs_of_map_2 with "[$Hmap]") as "[HPC Hdst]"; eauto. iFrame. }
     { (* Failure (contradiction) *)
       destruct Hfail; try incrementPC_inv; simplify_map_eq; eauto.
       all: try congruence.
       erewrite wb_implies_verify_access in e6; eauto. simplify_eq.
       Unshelve. all:auto.
     }
    Qed.

End cap_lang_rules.


Require Import VST.msl.msl_direct.
Require Import CertiGraph.msl_ext.abs_addr.
Require Import Peano_dec.

Instance Join_discrete (A : Type): Join A := fun a1 a2 a3 : A => False.

Instance Perm_discrete (A: Type)  : @Perm_alg A (Join_discrete A).
Proof. constructor; intros; inv H. Qed.

Instance psa_discrete (A: Type) :  @Pos_alg A  (Join_discrete A).
Proof. repeat intro. inv H. Qed.

(* Definition var := nat. *)
Definition adr := nat.

Definition world := (fpm adr adr).

Instance Join_world: Join world := Join_fpm (Join_discrete adr).

Instance Perm_world : Perm_alg world. apply Perm_fpm; apply Perm_discrete. Qed.

Instance Sep_world : Sep_alg world. apply Sep_fpm. Qed.

Instance Canc_world : Canc_alg world. apply Canc_fpm; [intuition | repeat intro; inversion H]. Qed.

Instance Disj_world : Disj_alg world. apply Disj_fpm; repeat intro; [apply Perm_discrete | |]; inversion H. Qed.

Instance Cross_world : Cross_alg world. apply Cross_fpm; [apply Perm_discrete | apply psa_discrete | repeat intro; inv H]. Qed.

Instance Trip_world : @Trip_alg world Join_world.
Proof.
  repeat intro.
  destruct ab as [fab Hab]. destruct c as [fc Hc].
  remember (fun x => match (fab x) with
                       | Some v => Some v
                       | None => match (fc x) with
                                   | Some v' => Some v'
                                   | None => None
                                 end
                     end) as fabc.
  assert (finMap fabc). {
    hnf in Hab, Hc. destruct Hab as [lab ?]. destruct Hc as [lc ?].
    exists (lab ++ lc). intro z; intros.
    assert (~ In z lab). intro. apply H2. apply in_or_app. left; auto.
    assert (~ In z lc). intro. apply H2. apply in_or_app. right; auto.
    hnf in *. simpl in *. specialize (e0 z H4). specialize (e z H3).
    rewrite Heqfabc. destruct (fab z) eqn:? . inv e. destruct (fc z) eqn:? . inv e0. auto.
  } exists (exist (finMap (B:=adr)) fabc H2).
  hnf. simpl. intros. rewrite Heqfabc. destruct (fab x) eqn:? .
  + destruct (fc x) eqn:? .
    - destruct a as [fa ?]. destruct b as [fb ?]. hnf in *. simpl in *.
      specialize (H x). rewrite Heqo in *. inversion H.
      * specialize (H0 x). rewrite H6, Heqo0 in *. inversion H0. inversion H9.
      * specialize (H1 x). rewrite H6, Heqo0 in *. inversion H1. inversion H9.
      * inversion H6.
    - constructor.
  + destruct (fc x) eqn:? .
    - constructor.
    - constructor.
Defined.

Definition adr_conflict (a1 a2 : adr) : bool := if (NPeano.Nat.eq_dec a1 a2) then true else false.

Instance AbsAddr_world : AbsAddr adr adr.
  apply (mkAbsAddr adr adr adr_conflict); intros; unfold adr_conflict in *.
  + destruct (NPeano.Nat.eq_dec p1 p2). subst. destruct (NPeano.Nat.eq_dec p2 p2); auto. exfalso; tauto.
    destruct (NPeano.Nat.eq_dec p2 p1). subst. exfalso; tauto. trivial.
  + destruct (NPeano.Nat.eq_dec p1 p1). inversion H. exfalso; tauto.
Defined.

Fixpoint extractSome (f : adr -> option adr) (li : list adr) : list adr :=
  match li with
    | nil => nil
    | x :: lx => match f x with
                   | Some _ => x :: extractSome f lx
                   | None => extractSome f lx
                 end
  end.

Lemma world_finite: forall w: world, exists l: list adr, forall a:adr, In a l <-> lookup_fpm w a <> None.
Proof.
  intro; destruct w as [f [li ?]]; simpl; exists (extractSome f li); split; intros.
  clear e; induction li; simpl in H; auto.
  destruct (f a0) eqn: ?. destruct (in_inv H). subst. rewrite Heqo. intro. inversion H0.
  apply IHli; auto. apply IHli; auto. destruct (in_dec nat_eq_dec a li). clear e.
  induction li; simpl in *; auto. destruct (f a0) eqn : ?. destruct i. subst. apply in_eq.
  apply in_cons. apply IHli; auto. destruct i. subst. exfalso; auto. apply IHli; auto.
  specialize (e a n). exfalso; auto.
Qed.

Lemma lookup_fpm_join_sub: forall (w1 w2 : world) x, join_sub w1 w2 -> lookup_fpm w1 x <> None -> lookup_fpm w2 x <> None.
Proof.
  intros. destruct H as [w3 ?].
  destruct w1 as [f1 [l1 ?]]. destruct w2 as [f2 [l2 ?]]. destruct w3 as [f3 [l3 ?]]. hnf in H; simpl in *.
  specialize (H x). inversion H. exfalso; auto. auto. auto.
Qed.


Require Import Coq.Program.Basics.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Combinators.
Require Import Setoid.
Require Import ZArith.
Require Import Psatz.

Require Import FinProof.Common.
Require Import FinProof.CommonInstances.
Require Import FinProof.StateMonad2.
Require Import FinProof.StateMonadInstances.
Require Import FinProof.ProgrammingWith.

Local Open Scope struct_scope.

Require Import FinProof.CommonProofs.
Require Import depoolContract.ProofEnvironment.
Require Import depoolContract.DePoolClass.
Require Import depoolContract.SolidityNotations.

Require Import depoolContract.NewProofs.ProofHelpers.
Require Import depoolContract.DePoolFunc.

(* Set Typeclasses Iterative Deepening.
Set Typeclasses Depth 100. *)

Require Import depoolContract.Lib.CommonModelProofs.
Module CommonModelProofs := CommonModelProofs StateMonadSig.
Import CommonModelProofs.
Require Import depoolContract.Lib.Tactics.
Require Import depoolContract.Lib.ErrorValueProofs.
Require Import depoolContract.Lib.CommonCommon.

(* Require Import MultiSigWallet.Proofs.tvmFunctionsProofs. *)

Import DePoolSpec.LedgerClass.SolidityNotations.

Local Open Scope struct_scope.
Local Open Scope Z_scope.
Local Open Scope solidity_scope.
Require Import Lists.List.
Import ListNotations.
Local Open Scope list_scope.

Require Import depoolContract.DePoolConsts.
Module DePoolContract_Ф_addLockStake (dc : DePoolConstsTypesSig XTypesSig StateMonadSig).
Module DePoolFuncs := DePoolFuncs XTypesSig StateMonadSig dc.
Module ProofHelpers := ProofHelpers dc.

Import dc.
Import ProofHelpers.
Import DePoolFuncs.
Import DePoolSpec.
Import LedgerClass.

Opaque DePoolContract_Ф_addVestingOrLock.

Lemma DePoolContract_Ф_addLockStake_exec : forall ( Л_stake : XInteger64 )
                                                   (Л_beneficiary: XAddress)
										                               (Л_withdrawalPeriod: XInteger32)
										                               (Л_totalPeriod: XInteger32)
                                                   (l: Ledger) ,
exec_state ( ↓ DePoolContract_Ф_addLockStake Л_stake Л_beneficiary Л_withdrawalPeriod Л_totalPeriod ) l =
exec_state ( ↓ DePoolContract_Ф_addVestingOrLock Л_stake Л_beneficiary Л_withdrawalPeriod Л_totalPeriod xBoolFalse ) l .
 Proof.
  intros.
  destructLedger l.
  compute.

  destructFunction5 DePoolContract_Ф_addVestingOrLock; auto.
 Qed.

 Lemma DePoolContract_Ф_addLockStake_eval : forall ( Л_stake : XInteger64 )
                                                   (Л_beneficiary: XAddress)
										                               (Л_withdrawalPeriod: XInteger32)
										                               (Л_totalPeriod: XInteger32)
                                                   (l: Ledger) ,
eval_state ( ↓ DePoolContract_Ф_addLockStake Л_stake Л_beneficiary Л_withdrawalPeriod Л_totalPeriod )  l =
eval_state ( ↓ DePoolContract_Ф_addVestingOrLock Л_stake Л_beneficiary Л_withdrawalPeriod Л_totalPeriod xBoolFalse )  l .
 Proof.
  intros.
  destructLedger l.
  compute.

  destructFunction5 DePoolContract_Ф_addVestingOrLock; auto.
Qed.

Lemma DePoolContract_Ф_addVestingStake_exec : forall ( Л_stake : XInteger64 )
                                                   (Л_beneficiary: XAddress)
										                               (Л_withdrawalPeriod: XInteger32)
										                               (Л_totalPeriod: XInteger32)
                                                   (l: Ledger) ,
exec_state ( ↓ DePoolContract_Ф_addVestingStake Л_stake Л_beneficiary Л_withdrawalPeriod Л_totalPeriod ) l =
exec_state ( ↓ DePoolContract_Ф_addVestingOrLock Л_stake Л_beneficiary Л_withdrawalPeriod Л_totalPeriod xBoolTrue ) l .
 Proof.
  intros.
  destructLedger l.
  compute.

  destructFunction5 DePoolContract_Ф_addVestingOrLock; auto.
 Qed.

 Lemma DePoolContract_Ф_addVesingStake_eval : forall ( Л_stake : XInteger64 )
                                                   (Л_beneficiary: XAddress)
										                               (Л_withdrawalPeriod: XInteger32)
										                               (Л_totalPeriod: XInteger32)
                                                   (l: Ledger) ,
eval_state ( ↓ DePoolContract_Ф_addVestingStake Л_stake Л_beneficiary Л_withdrawalPeriod Л_totalPeriod )  l =
eval_state ( ↓ DePoolContract_Ф_addVestingOrLock Л_stake Л_beneficiary Л_withdrawalPeriod Л_totalPeriod xBoolTrue )  l .
 Proof.
  intros.
  destructLedger l.
  compute.

  destructFunction5 DePoolContract_Ф_addVestingOrLock; auto.
Qed.

End DePoolContract_Ф_addLockStake.