LogrelCC.examples.refinement.oneshotCC.oneshotCC_LR2
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 oneshotCC_LR2_helper.
Section refinement.
Context `{heapG Σ, cfgSG Σ}.
Context `{inG Σ (authR (gsetUR loc))}.
Lemma call_cc'_call_cc_refinement :
[] ⊨ call_cc' ≤log≤ call_cc : call_cc_type.
Proof.
iIntros (Δ vvs ρ HΔ) "[#Hcfg _]".
iIntros (KK j) "[Hj HKK] /=".
asimpl.
iApply ("HKK" $! (TLamV _, TLamV _)); iFrame; clear KK j; asimpl.
iAlways. iIntros (τi Hτi KK j) "[Hj HKK] /=".
iApply wp_tapp; iNext. iMod (step_tlam with "[Hj]") as "Hj"; eauto.
iApply ("HKK" $! (RecV _, LamV _)); iFrame; clear KK j.
iAlways. iIntros ([f f']) "#Hff /=".
iIntros ([K K'] j) "[Hj #HKK] /=".
iApply wp_rec; eauto using to_of_val; iNext.
iMod (step_Lam with "[$Hj]") as "Hj"; eauto.
asimpl.
iApply (wp_alloc (AppRCtx (RecV _) :: _)); eauto.
iNext. iIntros (l) "Hl /=".
iApply wp_rec; eauto; iNext.
iMod (step_callcc with "[Hj]") as "Hj"; eauto.
asimpl.
rewrite G_eq.
iApply wp_rec; eauto using to_of_val; rewrite -G_eq.
asimpl. iNext.
rewrite call_cc1_eq.
iApply (wp_tapp (AppLCtx _ :: LetInCtx _ :: _)); eauto.
iNext. simpl.
iApply (wp_Lam (LetInCtx _:: _)); eauto.
rewrite /= -call_cc1_inner_body_eq. asimpl.
iNext.
iApply (wp_alloc (LetInCtx _ :: LetInCtx _ :: _)); eauto.
iNext. iIntros (b) "Hb".
iApply (wp_LetIn (LetInCtx _ :: _)); eauto. simpl.
asimpl. iNext.
iApply (wp_callcc (LetInCtx _ :: _)); eauto. simpl.
asimpl. iNext.
iApply (wp_Lam (LetInCtx _ :: _)); eauto.
rewrite call_cc1_inner_body_eq -call_cc1_eq /=.
asimpl. iNext.
iApply (wp_store (LetInCtx _ :: LetInCtx _ :: _)); eauto; iFrame.
iNext. iIntros "Hl /=".
iApply (wp_LetIn (LetInCtx _ :: _)); eauto.
simpl; asimpl. iNext.
iMod (make_used_locs_own (λ b, ∃ bv, b ↦ᵢ (#♭v bv))%I with "[]")
as (γ) "Hul"; first done.
iMod (used_locs_own_alloc with "[Hul Hb]") as "[#Hb Hul]";
try iFrame; eauto; first done.
iMod (inv_alloc (nroot.@"cc") _ (call_cc'_call_cc_refinement_inv γ l K)
with "[Hl Hul]") as "#Hinv".
{ iNext. iExists _, _; iFrame.
by iPureIntro; rewrite left_id; apply elem_of_singleton. }
iSpecialize ("Hff" $! (ContV _, ContV _) with "[]");
last iApply ("Hff" $! (LetInCtx _ :: _, _)); simpl; iFrame; clear j.
- iExists _, _; iSplit; eauto.
iAlways. iIntros (vv j) "[Hj #Hvv] /=".
iApply (wp_atomic_under_ectx _ _ [ThrowRCtx _]); eauto.
iInv (nroot.@"cc") as (M b') ">[Hul [#HbM Hl]]" "Hclose"; iModIntro.
iApply wp_load'; iFrame. iNext. iIntros "Hl".
iApply wp_value; eauto.
iDestruct "HbM" as %HbM.
iMod (loc_is_used with "Hul") as "[#Hb' Hul]"; eauto.
iMod ("Hclose" with "[Hul Hl]") as "_".
{ iNext; by iExists _, _; iFrame. }
clear M HbM.
iModIntro. simpl.
iApply (wp_throw []); eauto using to_of_val.
iNext; simpl.
rewrite call_cc1_ectx_eq; simpl.
asimpl.
iApply (wp_LetIn []); eauto using to_of_val.
asimpl. iNext.
iApply (wp_atomic_under_ectx _ _ [IfCtx _ _]); eauto.
iInv (nroot.@"cc") as (M b'') ">[Hul [% Hl]]" "Hclose"; iModIntro.
iDestruct (used_loc_elem_of with "[Hul Hb']") as %Hb'; eauto.
iDestruct (get_used_loc _ _ b' with "Hul") as "[Hulo Hb'l]"; auto.
iDestruct "Hb'l" as (bv) "Hb'l".
iApply wp_load'; iFrame. iNext. iIntros "Hb'l".
iApply wp_value; eauto.
iDestruct (put_back_used_loc _ _ b' with "[Hulo Hb'l]") as "Hul";
eauto; first iFrame; eauto.
iMod ("Hclose" with "[Hul Hl]") as "_".
{ iNext; by iExists _, _; iFrame. }
iModIntro. simpl.
destruct bv.
{ iApply (wp_if_true []). iNext; simpl.
iApply wp_mono; last iApply (wp_OMEGA _ []).
iIntros (?) "?"; auto. }
iApply (wp_if_false []); simpl; iNext.
iApply (wp_atomic_under_ectx _ _ [LetInCtx _]); eauto.
clear dependent b'' M.
iInv (nroot.@"cc") as (M b3) ">[Hul [% Hl]]" "Hclose"; iModIntro.
iDestruct (used_loc_elem_of with "[Hul Hb']") as %Hb'; eauto.
iDestruct (get_used_loc _ _ b' with "Hul") as "[Hulo Hb'l]"; auto.
iDestruct "Hb'l" as (bv) "Hb'l".
iApply (wp_store' with "[-]"); eauto; iFrame.
iNext. iIntros "Hb'l".
iApply wp_value; eauto.
iDestruct (put_back_used_loc _ _ b' with "[Hulo Hb'l]") as "Hul";
eauto; first iFrame; eauto.
iMod ("Hclose" with "[Hul Hl]") as "_".
{ iNext; by iExists _, _; iFrame. }
iModIntro; simpl.
iApply (wp_LetIn []); eauto.
asimpl. iNext.
iApply (wp_throw []); eauto. simpl.
iNext. iApply call_cc'_call_cc_refinement_helper; iFrame "#".
iApply "HKK"; eauto.
- iAlways. iIntros (vv j) "[Hj #Hvv]".
iApply call_cc'_call_cc_refinement_helper; iFrame "#".
iApply "HKK"; eauto.
Qed.
End refinement.
Theorem call_cc'_call_cc_ctx_refinement :
[] ⊨ call_cc' ≤ctx≤ call_cc : call_cc_type.
Proof.
set (Σ := #[invΣ ; gen_heapΣ loc val ;
GFunctor (authR cfgUR) ; GFunctor (authR (gsetUR loc)) ]).
set (HG := soundness_unary.HeapPreIG Σ _ _).
eapply (binary_soundness Σ _); auto.
intros. apply call_cc'_call_cc_refinement.
Qed.
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 oneshotCC_LR2_helper.
Section refinement.
Context `{heapG Σ, cfgSG Σ}.
Context `{inG Σ (authR (gsetUR loc))}.
Lemma call_cc'_call_cc_refinement :
[] ⊨ call_cc' ≤log≤ call_cc : call_cc_type.
Proof.
iIntros (Δ vvs ρ HΔ) "[#Hcfg _]".
iIntros (KK j) "[Hj HKK] /=".
asimpl.
iApply ("HKK" $! (TLamV _, TLamV _)); iFrame; clear KK j; asimpl.
iAlways. iIntros (τi Hτi KK j) "[Hj HKK] /=".
iApply wp_tapp; iNext. iMod (step_tlam with "[Hj]") as "Hj"; eauto.
iApply ("HKK" $! (RecV _, LamV _)); iFrame; clear KK j.
iAlways. iIntros ([f f']) "#Hff /=".
iIntros ([K K'] j) "[Hj #HKK] /=".
iApply wp_rec; eauto using to_of_val; iNext.
iMod (step_Lam with "[$Hj]") as "Hj"; eauto.
asimpl.
iApply (wp_alloc (AppRCtx (RecV _) :: _)); eauto.
iNext. iIntros (l) "Hl /=".
iApply wp_rec; eauto; iNext.
iMod (step_callcc with "[Hj]") as "Hj"; eauto.
asimpl.
rewrite G_eq.
iApply wp_rec; eauto using to_of_val; rewrite -G_eq.
asimpl. iNext.
rewrite call_cc1_eq.
iApply (wp_tapp (AppLCtx _ :: LetInCtx _ :: _)); eauto.
iNext. simpl.
iApply (wp_Lam (LetInCtx _:: _)); eauto.
rewrite /= -call_cc1_inner_body_eq. asimpl.
iNext.
iApply (wp_alloc (LetInCtx _ :: LetInCtx _ :: _)); eauto.
iNext. iIntros (b) "Hb".
iApply (wp_LetIn (LetInCtx _ :: _)); eauto. simpl.
asimpl. iNext.
iApply (wp_callcc (LetInCtx _ :: _)); eauto. simpl.
asimpl. iNext.
iApply (wp_Lam (LetInCtx _ :: _)); eauto.
rewrite call_cc1_inner_body_eq -call_cc1_eq /=.
asimpl. iNext.
iApply (wp_store (LetInCtx _ :: LetInCtx _ :: _)); eauto; iFrame.
iNext. iIntros "Hl /=".
iApply (wp_LetIn (LetInCtx _ :: _)); eauto.
simpl; asimpl. iNext.
iMod (make_used_locs_own (λ b, ∃ bv, b ↦ᵢ (#♭v bv))%I with "[]")
as (γ) "Hul"; first done.
iMod (used_locs_own_alloc with "[Hul Hb]") as "[#Hb Hul]";
try iFrame; eauto; first done.
iMod (inv_alloc (nroot.@"cc") _ (call_cc'_call_cc_refinement_inv γ l K)
with "[Hl Hul]") as "#Hinv".
{ iNext. iExists _, _; iFrame.
by iPureIntro; rewrite left_id; apply elem_of_singleton. }
iSpecialize ("Hff" $! (ContV _, ContV _) with "[]");
last iApply ("Hff" $! (LetInCtx _ :: _, _)); simpl; iFrame; clear j.
- iExists _, _; iSplit; eauto.
iAlways. iIntros (vv j) "[Hj #Hvv] /=".
iApply (wp_atomic_under_ectx _ _ [ThrowRCtx _]); eauto.
iInv (nroot.@"cc") as (M b') ">[Hul [#HbM Hl]]" "Hclose"; iModIntro.
iApply wp_load'; iFrame. iNext. iIntros "Hl".
iApply wp_value; eauto.
iDestruct "HbM" as %HbM.
iMod (loc_is_used with "Hul") as "[#Hb' Hul]"; eauto.
iMod ("Hclose" with "[Hul Hl]") as "_".
{ iNext; by iExists _, _; iFrame. }
clear M HbM.
iModIntro. simpl.
iApply (wp_throw []); eauto using to_of_val.
iNext; simpl.
rewrite call_cc1_ectx_eq; simpl.
asimpl.
iApply (wp_LetIn []); eauto using to_of_val.
asimpl. iNext.
iApply (wp_atomic_under_ectx _ _ [IfCtx _ _]); eauto.
iInv (nroot.@"cc") as (M b'') ">[Hul [% Hl]]" "Hclose"; iModIntro.
iDestruct (used_loc_elem_of with "[Hul Hb']") as %Hb'; eauto.
iDestruct (get_used_loc _ _ b' with "Hul") as "[Hulo Hb'l]"; auto.
iDestruct "Hb'l" as (bv) "Hb'l".
iApply wp_load'; iFrame. iNext. iIntros "Hb'l".
iApply wp_value; eauto.
iDestruct (put_back_used_loc _ _ b' with "[Hulo Hb'l]") as "Hul";
eauto; first iFrame; eauto.
iMod ("Hclose" with "[Hul Hl]") as "_".
{ iNext; by iExists _, _; iFrame. }
iModIntro. simpl.
destruct bv.
{ iApply (wp_if_true []). iNext; simpl.
iApply wp_mono; last iApply (wp_OMEGA _ []).
iIntros (?) "?"; auto. }
iApply (wp_if_false []); simpl; iNext.
iApply (wp_atomic_under_ectx _ _ [LetInCtx _]); eauto.
clear dependent b'' M.
iInv (nroot.@"cc") as (M b3) ">[Hul [% Hl]]" "Hclose"; iModIntro.
iDestruct (used_loc_elem_of with "[Hul Hb']") as %Hb'; eauto.
iDestruct (get_used_loc _ _ b' with "Hul") as "[Hulo Hb'l]"; auto.
iDestruct "Hb'l" as (bv) "Hb'l".
iApply (wp_store' with "[-]"); eauto; iFrame.
iNext. iIntros "Hb'l".
iApply wp_value; eauto.
iDestruct (put_back_used_loc _ _ b' with "[Hulo Hb'l]") as "Hul";
eauto; first iFrame; eauto.
iMod ("Hclose" with "[Hul Hl]") as "_".
{ iNext; by iExists _, _; iFrame. }
iModIntro; simpl.
iApply (wp_LetIn []); eauto.
asimpl. iNext.
iApply (wp_throw []); eauto. simpl.
iNext. iApply call_cc'_call_cc_refinement_helper; iFrame "#".
iApply "HKK"; eauto.
- iAlways. iIntros (vv j) "[Hj #Hvv]".
iApply call_cc'_call_cc_refinement_helper; iFrame "#".
iApply "HKK"; eauto.
Qed.
End refinement.
Theorem call_cc'_call_cc_ctx_refinement :
[] ⊨ call_cc' ≤ctx≤ call_cc : call_cc_type.
Proof.
set (Σ := #[invΣ ; gen_heapΣ loc val ;
GFunctor (authR cfgUR) ; GFunctor (authR (gsetUR loc)) ]).
set (HG := soundness_unary.HeapPreIG Σ _ _).
eapply (binary_soundness Σ _); auto.
intros. apply call_cc'_call_cc_refinement.
Qed.