LogrelCC.examples.refinement.oneshotCC.oneshotCC_LR2_helper
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 oneshotCC_rules.
Section refinement.
Context `{heapG Σ, cfgSG Σ}.
Context `{inG Σ (authR (gsetUR loc))}.
Lemma call_cc'_call_cc_refinement_helper γ l K w Φ:
inv (nroot.@"cc") (call_cc'_call_cc_refinement_inv γ l K) ∗
WP fill K (of_val w) {{Φ}} ⊢
WP fill K
(LetIn (of_val w)
(App (TApp call_cc1)
(Lam (App (G (Loc l))
(Lam (Throw (Var 2) (Var 1))))))) {{Φ}}.
Proof.
iIntros "[#Hinv Hen]".
iApply (wp_LetIn); eauto. iNext. asimpl.
rewrite call_cc1_eq.
iApply (wp_tapp (AppLCtx _ :: _)); eauto.
iNext.
iApply (wp_Lam); eauto. simpl; asimpl. iNext.
iApply (wp_alloc (LetInCtx _ :: _)); eauto.
iNext. iIntros (b) "Hb".
iApply wp_LetIn; eauto. asimpl. iNext.
iApply wp_callcc; eauto.
asimpl. iNext.
iApply wp_Lam; eauto. asimpl. iNext.
rewrite G_eq.
iApply wp_rec; eauto.
rewrite -G_eq.
asimpl. iNext.
rewrite call_cc1_eq -call_cc1_inner_body_eq.
iApply (wp_tapp (AppLCtx _ :: LetInCtx _ :: _)); eauto.
iNext. simpl. asimpl.
rewrite -call_cc1_eq.
iApply (wp_Lam (LetInCtx _ :: _)); eauto.
asimpl.
rewrite call_cc1_inner_body_eq. asimpl. iNext.
iApply (wp_alloc (LetInCtx _ :: LetInCtx _ :: _)); eauto.
iNext. iIntros (b'') "Hb''". simpl. asimpl.
iApply (wp_LetIn (LetInCtx _ :: _)); eauto.
simpl. asimpl. iNext.
iApply (wp_callcc (LetInCtx _ :: _)); eauto.
asimpl. iNext.
iApply (wp_Lam (LetInCtx _ :: _)); eauto.
simpl. asimpl. iNext.
iApply (wp_atomic_under_ectx _ _
(LetInCtx _:: LetInCtx _ :: _)); eauto.
simpl.
iInv (nroot.@"cc") as (M b4) ">[Hul [% Hl]]" "Hclose"; iModIntro.
iApply (wp_store' with "[-]"); eauto; iFrame.
iNext. iIntros "Hl".
iAssert (⌜ b'' ∉ M⌝)%I as %Hb''M.
{ iIntros (Hb''M).
iDestruct (get_used_loc _ _ b'' with "[Hul]") as "[Hulo Hb4]"; eauto;
iFrame.
iDestruct "Hb4" as (?) "Hb4".
by iDestruct (@mapsto_valid_2 with "Hb'' Hb4") as %?. }
iMod (used_locs_own_alloc with "[Hul Hb'']") as "[Hb'' HM']"; eauto;
iFrame; eauto.
iApply wp_value; eauto.
iMod ("Hclose" with "[HM' Hl]") as "_".
{ iNext. iExists _, _; iFrame.
by iPureIntro; apply elem_of_union; right; apply elem_of_singleton. }
iModIntro.
iApply (wp_LetIn (LetInCtx _ :: _)); eauto.
simpl; asimpl. iNext.
iApply (wp_Lam (LetInCtx _ :: _)); eauto.
simpl; asimpl. iNext.
iApply (wp_throw (LetInCtx _ :: _)); eauto.
iNext.
rewrite call_cc1_ectx_eq /=.
iApply (wp_LetIn []); eauto.
simpl; asimpl. iNext.
iApply (wp_load [IfCtx _ _]); eauto; iFrame.
iNext. iIntros "Hb /=".
iApply (wp_if_false []).
iNext; simpl.
iApply (wp_store [LetInCtx _] with "[-]"); eauto; iFrame.
iNext. iIntros "Hb /=".
iApply (wp_LetIn []); eauto.
asimpl. iNext.
iApply (wp_throw []); eauto.
Qed.
End refinement.
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 oneshotCC_rules.
Section refinement.
Context `{heapG Σ, cfgSG Σ}.
Context `{inG Σ (authR (gsetUR loc))}.
Lemma call_cc'_call_cc_refinement_helper γ l K w Φ:
inv (nroot.@"cc") (call_cc'_call_cc_refinement_inv γ l K) ∗
WP fill K (of_val w) {{Φ}} ⊢
WP fill K
(LetIn (of_val w)
(App (TApp call_cc1)
(Lam (App (G (Loc l))
(Lam (Throw (Var 2) (Var 1))))))) {{Φ}}.
Proof.
iIntros "[#Hinv Hen]".
iApply (wp_LetIn); eauto. iNext. asimpl.
rewrite call_cc1_eq.
iApply (wp_tapp (AppLCtx _ :: _)); eauto.
iNext.
iApply (wp_Lam); eauto. simpl; asimpl. iNext.
iApply (wp_alloc (LetInCtx _ :: _)); eauto.
iNext. iIntros (b) "Hb".
iApply wp_LetIn; eauto. asimpl. iNext.
iApply wp_callcc; eauto.
asimpl. iNext.
iApply wp_Lam; eauto. asimpl. iNext.
rewrite G_eq.
iApply wp_rec; eauto.
rewrite -G_eq.
asimpl. iNext.
rewrite call_cc1_eq -call_cc1_inner_body_eq.
iApply (wp_tapp (AppLCtx _ :: LetInCtx _ :: _)); eauto.
iNext. simpl. asimpl.
rewrite -call_cc1_eq.
iApply (wp_Lam (LetInCtx _ :: _)); eauto.
asimpl.
rewrite call_cc1_inner_body_eq. asimpl. iNext.
iApply (wp_alloc (LetInCtx _ :: LetInCtx _ :: _)); eauto.
iNext. iIntros (b'') "Hb''". simpl. asimpl.
iApply (wp_LetIn (LetInCtx _ :: _)); eauto.
simpl. asimpl. iNext.
iApply (wp_callcc (LetInCtx _ :: _)); eauto.
asimpl. iNext.
iApply (wp_Lam (LetInCtx _ :: _)); eauto.
simpl. asimpl. iNext.
iApply (wp_atomic_under_ectx _ _
(LetInCtx _:: LetInCtx _ :: _)); eauto.
simpl.
iInv (nroot.@"cc") as (M b4) ">[Hul [% Hl]]" "Hclose"; iModIntro.
iApply (wp_store' with "[-]"); eauto; iFrame.
iNext. iIntros "Hl".
iAssert (⌜ b'' ∉ M⌝)%I as %Hb''M.
{ iIntros (Hb''M).
iDestruct (get_used_loc _ _ b'' with "[Hul]") as "[Hulo Hb4]"; eauto;
iFrame.
iDestruct "Hb4" as (?) "Hb4".
by iDestruct (@mapsto_valid_2 with "Hb'' Hb4") as %?. }
iMod (used_locs_own_alloc with "[Hul Hb'']") as "[Hb'' HM']"; eauto;
iFrame; eauto.
iApply wp_value; eauto.
iMod ("Hclose" with "[HM' Hl]") as "_".
{ iNext. iExists _, _; iFrame.
by iPureIntro; apply elem_of_union; right; apply elem_of_singleton. }
iModIntro.
iApply (wp_LetIn (LetInCtx _ :: _)); eauto.
simpl; asimpl. iNext.
iApply (wp_Lam (LetInCtx _ :: _)); eauto.
simpl; asimpl. iNext.
iApply (wp_throw (LetInCtx _ :: _)); eauto.
iNext.
rewrite call_cc1_ectx_eq /=.
iApply (wp_LetIn []); eauto.
simpl; asimpl. iNext.
iApply (wp_load [IfCtx _ _]); eauto; iFrame.
iNext. iIntros "Hb /=".
iApply (wp_if_false []).
iNext; simpl.
iApply (wp_store [LetInCtx _] with "[-]"); eauto; iFrame.
iNext. iIntros "Hb /=".
iApply (wp_LetIn []); eauto.
asimpl. iNext.
iApply (wp_throw []); eauto.
Qed.
End refinement.