LogrelCC.examples.refinement.oneshotCC.oneshotCC_rules
From iris.algebra Require Import auth gset.
From iris.program_logic Require Import adequacy.
From LogrelCC Require Import rules_unary rules_binary soundness_binary.
From iris.proofmode Require Import tactics.
From LogrelCC Require Import typing.
From LogrelCC.examples.refinement.oneshotCC Require Import oneshotCC_progs.
Section rules.
Context `{heapG Σ, cfgSG Σ}.
Context `{inG Σ (authR (gsetUR loc))}.
Definition loc_used γ l := own γ (◯ ({[l]} : gset _)).
Instance loc_used_persistent γ l : Persistent (loc_used γ l).
Proof. apply _. Qed.
Definition used_locs γ (M : gset loc) := own γ (● M).
Lemma loc_used_alloc γ M l :
used_locs γ M ==∗ used_locs γ (M ∪ {[l]}) ∗ loc_used γ l.
Proof.
iIntros "HM".
iMod (own_update with "HM") as "HM".
{ apply auth_update_alloc, gset_local_update, union_subseteq_l. }
rewrite own_op; iDestruct "HM" as "[HM HMl]"; iFrame; iModIntro.
rewrite -gset_op_union auth_frag_op own_op.
by iDestruct "HMl" as "[_ Hl]".
Qed.
Lemma loc_is_used' γ M l :
l ∈ M → used_locs γ M ==∗ used_locs γ M ∗ loc_used γ l.
Proof.
iIntros (?) "HM".
iMod (own_update with "HM") as "HM".
{ apply auth_update_alloc, gset_local_update, union_subseteq_l. }
rewrite own_op; iDestruct "HM" as "[HM HMl]"; iFrame; iModIntro.
rewrite -gset_op_union auth_frag_op own_op.
iDestruct "HMl" as "[_ Hl]"; iFrame.
rewrite gset_op_union (comm _ M)subseteq_union_1; auto.
by apply elem_of_subseteq_singleton.
Qed.
Definition used_locs_own γ M Φ := (used_locs γ M ∗ [∗ set] l ∈ M, Φ l)%I.
Definition make_used_locs_own Φ : (True ==∗ ∃ γ, used_locs_own γ ∅ Φ)%I.
Proof.
iIntros; rewrite /used_locs_own.
iMod (own_alloc) as (γ) "Hγ";
last (iModIntro; iExists _; iFrame); first done.
by rewrite big_sepS_empty.
Qed.
Definition used_locs_own_alloc γ M Φ l :
l ∉ M → (used_locs_own γ M Φ ∗ Φ l ==∗
loc_used γ l ∗ used_locs_own γ (M ∪ {[l]}) Φ)%I.
Proof.
iIntros (?) "[[HM HMΦ] Hl]".
iCombine "Hl" "HMΦ" as "HMlΦ".
rewrite -big_opS_insert //.
iMod (loc_used_alloc with "HM") as "[? ?]".
iModIntro; rewrite /used_locs_own (comm_L _ _ M); iFrame.
Qed.
Definition used_locs_own_open γ M (M' : gset loc) Φ :=
(used_locs γ M ∗ [∗ set] l ∈ M', Φ l)%I.
Lemma used_loc_elem_of γ M l Φ :
used_locs_own γ M Φ ∗ loc_used γ l ⊢ ⌜l ∈ M⌝.
Proof.
iIntros "[[HM HΦ] Hl]".
iDestruct (own_valid_2 with "HM Hl") as %Hvl%auth_valid_discrete.
destruct Hvl as [Hvl%gset_included _].
rewrite /= gset_op_union in Hvl; apply union_subseteq in Hvl.
by destruct Hvl as [_ Hvl%elem_of_subseteq_singleton].
Qed.
Lemma loc_is_used γ M l Φ :
l ∈ M → used_locs_own γ M Φ ==∗ loc_used γ l ∗ used_locs_own γ M Φ.
Proof.
iIntros (?) "[HM HΦ]".
by iMod (loc_is_used' with "HM") as "[? ?]"; eauto; iFrame.
Qed.
Lemma get_used_loc γ M l Φ :
l ∈ M →
used_locs_own γ M Φ ⊢ used_locs_own_open γ M (M ∖ {[l]}) Φ ∗ Φ l.
Proof.
iIntros (?) "[HM HΦ]".
rewrite big_opS_delete; eauto.
iDestruct "HΦ" as "[HΦ HMΦ]".
rewrite /used_locs_own_open; iFrame.
Qed.
Lemma put_back_used_loc γ M l Φ :
l ∈ M →
used_locs_own_open γ M (M ∖ {[l]}) Φ ∗ Φ l ⊢ used_locs_own γ M Φ.
Proof.
iIntros (?) "[[HM HΦ] Hl]".
iCombine "Hl" "HΦ" as "HΦ".
rewrite -big_opS_insert;
last by apply not_elem_of_difference; right; apply elem_of_singleton_2.
rewrite -union_difference_L; last by apply elem_of_subseteq_singleton.
iFrame.
Qed.
Definition call_cc'_call_cc_refinement_inv γ l K :=
(∃ (M : gset loc) (b0 : loc),
used_locs_own γ M (λ b1 : loc, ∃ bv : bool, b1 ↦ᵢ (#♭v bv))
∗ ⌜b0 ∈ M⌝
∗ l ↦ᵢ ContV
(call_cc1_ectx
(Loc b0)
(Cont
(LetInCtx
(App
(TApp call_cc1)
(Lam (App (G (Loc l)) (Lam (Throw (Var 2) (Var 1))))))
:: K))))%I.
End rules.
From iris.program_logic Require Import adequacy.
From LogrelCC Require Import rules_unary rules_binary soundness_binary.
From iris.proofmode Require Import tactics.
From LogrelCC Require Import typing.
From LogrelCC.examples.refinement.oneshotCC Require Import oneshotCC_progs.
Section rules.
Context `{heapG Σ, cfgSG Σ}.
Context `{inG Σ (authR (gsetUR loc))}.
Definition loc_used γ l := own γ (◯ ({[l]} : gset _)).
Instance loc_used_persistent γ l : Persistent (loc_used γ l).
Proof. apply _. Qed.
Definition used_locs γ (M : gset loc) := own γ (● M).
Lemma loc_used_alloc γ M l :
used_locs γ M ==∗ used_locs γ (M ∪ {[l]}) ∗ loc_used γ l.
Proof.
iIntros "HM".
iMod (own_update with "HM") as "HM".
{ apply auth_update_alloc, gset_local_update, union_subseteq_l. }
rewrite own_op; iDestruct "HM" as "[HM HMl]"; iFrame; iModIntro.
rewrite -gset_op_union auth_frag_op own_op.
by iDestruct "HMl" as "[_ Hl]".
Qed.
Lemma loc_is_used' γ M l :
l ∈ M → used_locs γ M ==∗ used_locs γ M ∗ loc_used γ l.
Proof.
iIntros (?) "HM".
iMod (own_update with "HM") as "HM".
{ apply auth_update_alloc, gset_local_update, union_subseteq_l. }
rewrite own_op; iDestruct "HM" as "[HM HMl]"; iFrame; iModIntro.
rewrite -gset_op_union auth_frag_op own_op.
iDestruct "HMl" as "[_ Hl]"; iFrame.
rewrite gset_op_union (comm _ M)subseteq_union_1; auto.
by apply elem_of_subseteq_singleton.
Qed.
Definition used_locs_own γ M Φ := (used_locs γ M ∗ [∗ set] l ∈ M, Φ l)%I.
Definition make_used_locs_own Φ : (True ==∗ ∃ γ, used_locs_own γ ∅ Φ)%I.
Proof.
iIntros; rewrite /used_locs_own.
iMod (own_alloc) as (γ) "Hγ";
last (iModIntro; iExists _; iFrame); first done.
by rewrite big_sepS_empty.
Qed.
Definition used_locs_own_alloc γ M Φ l :
l ∉ M → (used_locs_own γ M Φ ∗ Φ l ==∗
loc_used γ l ∗ used_locs_own γ (M ∪ {[l]}) Φ)%I.
Proof.
iIntros (?) "[[HM HMΦ] Hl]".
iCombine "Hl" "HMΦ" as "HMlΦ".
rewrite -big_opS_insert //.
iMod (loc_used_alloc with "HM") as "[? ?]".
iModIntro; rewrite /used_locs_own (comm_L _ _ M); iFrame.
Qed.
Definition used_locs_own_open γ M (M' : gset loc) Φ :=
(used_locs γ M ∗ [∗ set] l ∈ M', Φ l)%I.
Lemma used_loc_elem_of γ M l Φ :
used_locs_own γ M Φ ∗ loc_used γ l ⊢ ⌜l ∈ M⌝.
Proof.
iIntros "[[HM HΦ] Hl]".
iDestruct (own_valid_2 with "HM Hl") as %Hvl%auth_valid_discrete.
destruct Hvl as [Hvl%gset_included _].
rewrite /= gset_op_union in Hvl; apply union_subseteq in Hvl.
by destruct Hvl as [_ Hvl%elem_of_subseteq_singleton].
Qed.
Lemma loc_is_used γ M l Φ :
l ∈ M → used_locs_own γ M Φ ==∗ loc_used γ l ∗ used_locs_own γ M Φ.
Proof.
iIntros (?) "[HM HΦ]".
by iMod (loc_is_used' with "HM") as "[? ?]"; eauto; iFrame.
Qed.
Lemma get_used_loc γ M l Φ :
l ∈ M →
used_locs_own γ M Φ ⊢ used_locs_own_open γ M (M ∖ {[l]}) Φ ∗ Φ l.
Proof.
iIntros (?) "[HM HΦ]".
rewrite big_opS_delete; eauto.
iDestruct "HΦ" as "[HΦ HMΦ]".
rewrite /used_locs_own_open; iFrame.
Qed.
Lemma put_back_used_loc γ M l Φ :
l ∈ M →
used_locs_own_open γ M (M ∖ {[l]}) Φ ∗ Φ l ⊢ used_locs_own γ M Φ.
Proof.
iIntros (?) "[[HM HΦ] Hl]".
iCombine "Hl" "HΦ" as "HΦ".
rewrite -big_opS_insert;
last by apply not_elem_of_difference; right; apply elem_of_singleton_2.
rewrite -union_difference_L; last by apply elem_of_subseteq_singleton.
iFrame.
Qed.
Definition call_cc'_call_cc_refinement_inv γ l K :=
(∃ (M : gset loc) (b0 : loc),
used_locs_own γ M (λ b1 : loc, ∃ bv : bool, b1 ↦ᵢ (#♭v bv))
∗ ⌜b0 ∈ M⌝
∗ l ↦ᵢ ContV
(call_cc1_ectx
(Loc b0)
(Cont
(LetInCtx
(App
(TApp call_cc1)
(Lam (App (G (Loc l)) (Lam (Throw (Var 2) (Var 1))))))
:: K))))%I.
End rules.