LogrelCC.examples.refinement.oneshotCC.oneshotCC_LR1
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 refinement.
Context `{heapG Σ, cfgSG Σ}.
Opaque difference.
Lemma call_cc_call_cc'_refinement_helper ρ E K j l v w :
nclose specN ⊆ E →
spec_ctx ρ ∗
l ↦ₛ w ∗
j ⤇ fill K
(LetIn (of_val v)
(App (TApp call_cc1)
(Lam (App (G (Loc l)) (Lam (Throw (ids 2) (ids 1))))))) ={E}=∗
∃ b, b ↦ₛ (#♭v false) ∗ l ↦ₛ ContV
(call_cc1_ectx
(Loc b)
(Cont (LetInCtx
(App (TApp call_cc1)
(Lam (App (G (Loc l))
(Lam (Throw (ids 2) (ids 1)))))) :: K)))
∗ j ⤇ fill K (of_val v).
Proof.
iIntros (HE) "[#Hspec [Hl Hj]]".
iMod (step_LetIn with "[Hj]") as "Hj";
eauto using to_of_val; auto.
asimpl.
iMod (step_call_cc_1 (LamV _) with "[Hj]")
as (b') "[Hb' Hj]"; simpl; eauto. asimpl.
iMod (step_Lam with "[Hj]") as "Hj"; simpl; eauto; try iFrame; eauto.
asimpl.
iMod (step_G _ (LamV _) with "[Hj]") as "Hj"; eauto. asimpl.
iMod (step_call_cc_1 (LamV _) ((LetInCtx _) :: _) with "[Hj]")
as (b'') "[Hb'' Hj]"; simpl; eauto; simpl.
asimpl.
iMod (step_Lam _ _ _ ((LetInCtx _) :: _) with "[Hj]")
as "Hj"; eauto; simpl; eauto.
asimpl.
iMod (step_store _ _ _ ((LetInCtx _) :: (LetInCtx _) :: _)
with "[Hl Hj]") as "[Hj Hl]"; eauto; simpl; try iFrame; eauto.
iMod (step_LetIn _ _ _ ((LetInCtx _) :: _) with "[Hj]")
as "Hj"; eauto; simpl; eauto. asimpl.
iMod (step_Lam _ _ _ ((LetInCtx _) :: _) with "[Hj]")
as "Hj"; eauto; simpl; eauto. asimpl.
iMod (step_throw _ _ _ ((LetInCtx _) :: _) with "[Hj]")
as "Hj"; eauto using to_of_val.
rewrite [ (call_cc1_ectx (Loc b') (Cont K))]call_cc1_ectx_eq /=.
iMod (step_LetIn _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val.
asimpl.
iMod (step_load _ _ _ [IfCtx _ _] with "[Hj Hb']") as "[Hj Hb']";
eauto; iFrame; eauto.
iMod (step_if_false _ _ _ [] with "[Hj]") as "Hj";
first solve_ndisj; simpl; iFrame; eauto.
iMod (step_store _ _ _ [LetInCtx _] with "[Hj Hb']") as "[Hj Hb']";
eauto; simpl; try iFrame; eauto.
iMod (step_LetIn _ _ _ [] with "[Hj]") as "Hj"; eauto; simpl; eauto. asimpl.
iMod (step_throw _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val.
iModIntro. iExists _; iFrame.
Qed.
Lemma call_cc_call_cc'_refinement :
[] ⊨ call_cc ≤log≤ call_cc' : call_cc_type.
Proof.
iIntros (Δ vvs ρ HΔ) "[#Hcfg _]".
iIntros (KK j) "[Hj HKK] /=".
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" $! (LamV _, RecV _)); iFrame; clear KK j.
iAlways. iIntros ([f f']) "#Hff /=".
iIntros ([K K'] j) "[Hj #HKK] /=".
iApply wp_Lam; eauto using to_of_val; iNext.
iMod (step_rec with "[Hj]") as "Hj"; eauto using to_of_val.
asimpl.
iMod (step_alloc _ _ _ (AppRCtx (RecV _) :: K') with "[Hj]")
as (l) "[Hj Hl]"; eauto; simpl; eauto.
iMod (step_rec _ _ _ _ _ _ (LocV _) with "[Hj]") as "Hj";
eauto using to_of_val.
asimpl.
iMod (step_G with "[Hj]") as "Hj"; eauto.
iMod (step_call_cc_1 (LamV _) ((LetInCtx _) :: K') with "[Hj]")
as (b) "[Hb Hj]"; simpl; eauto; simpl.
iMod (step_Lam _ _ _ ((LetInCtx _) :: K') with "[Hj]")
as "Hj"; eauto; simpl; eauto.
asimpl.
iMod (step_store _ _ _ ((LetInCtx _) :: (LetInCtx _) :: K')
_ _ _ (ContV _) with "[Hj $Hl]") as "[Hj Hl]"; eauto; simpl; eauto.
iApply wp_callcc; iNext. asimpl.
iMod (step_LetIn _ _ _ ((LetInCtx _) :: K') with "[Hj]")
as "Hj"; eauto; simpl; eauto.
asimpl.
iMod (inv_alloc (nroot.@"cc") _
(∃ b, b ↦ₛ (#♭v false)
∗ l ↦ₛ ContV
(call_cc1_ectx
(Loc b)
(Cont (LetInCtx
(App (TApp call_cc1)
(Lam
(App
(G (Loc l))
(Lam (Throw (ids 2) (ids 1))))))
:: K'))))%I
with "[Hl Hb]") as "#Hinv".
{ iNext. iExists _; iFrame. }
clear b.
iSpecialize ("Hff" $! (ContV _, ContV _) with "[]");
last iApply ("Hff" $! (_, (LetInCtx _) :: _)); simpl; iFrame; clear j.
- iExists _, _; iSplit; eauto. iAlways.
iIntros (vv j) "[Hj #Hvv] /=".
iApply fupd_wp.
iInv (nroot.@"cc") as (b) ">[Hb Hl]" "Hclose".
iMod (step_load _ _ _ ([ThrowRCtx _]) with "[Hj Hl]") as "[Hj Hl]"; simpl;
first (by solve_ndisj); iFrame; eauto; simpl.
iMod (step_throw _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val;
first solve_ndisj.
rewrite {2}call_cc1_ectx_eq; simpl.
asimpl.
iMod (step_LetIn _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val;
first solve_ndisj.
rewrite /= OMEGA_closed call_cc1_closed G_subst; simpl.
asimpl.
iMod (step_load _ _ _ [IfCtx _ _] with "[Hj Hb]") as "[Hj Hb]";
first solve_ndisj; simpl; iFrame; eauto.
iMod (step_if_false _ _ _ [] with "[Hj]") as "Hj";
first solve_ndisj; simpl; iFrame; eauto.
iMod (step_store _ _ _ [LetInCtx _] with "[Hj Hb]") as "[Hj Hb]";
try iFrame; eauto; first solve_ndisj.
iMod (step_LetIn _ _ _ [] with "[Hj]") as "Hj";
try iFrame; eauto; first solve_ndisj.
asimpl.
iMod (step_throw _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val;
first solve_ndisj.
simpl.
iMod (call_cc_call_cc'_refinement_helper with "[$Hj $Hl]") as
(b') "(Hb' & Hl & Hj)"; auto; first solve_ndisj.
iMod ("Hclose" with "[Hb' Hl]") as "_"; first (iNext; iExists b'; iFrame).
iApply "HKK"; eauto.
- iAlways. iIntros (vv j) "[Hj #Hvv]".
iApply fupd_wp. iInv (nroot.@"cc") as (b'') ">[Hb'' Hl]" "Hclose".
iMod (call_cc_call_cc'_refinement_helper with "[$Hj $Hl]") as
(b') "(Hb' & Hl & Hj)"; auto; first solve_ndisj.
iMod ("Hclose" with "[Hb' Hl]") as "_"; first (iNext; iExists b'; iFrame).
iModIntro.
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.
Section refinement.
Context `{heapG Σ, cfgSG Σ}.
Opaque difference.
Lemma call_cc_call_cc'_refinement_helper ρ E K j l v w :
nclose specN ⊆ E →
spec_ctx ρ ∗
l ↦ₛ w ∗
j ⤇ fill K
(LetIn (of_val v)
(App (TApp call_cc1)
(Lam (App (G (Loc l)) (Lam (Throw (ids 2) (ids 1))))))) ={E}=∗
∃ b, b ↦ₛ (#♭v false) ∗ l ↦ₛ ContV
(call_cc1_ectx
(Loc b)
(Cont (LetInCtx
(App (TApp call_cc1)
(Lam (App (G (Loc l))
(Lam (Throw (ids 2) (ids 1)))))) :: K)))
∗ j ⤇ fill K (of_val v).
Proof.
iIntros (HE) "[#Hspec [Hl Hj]]".
iMod (step_LetIn with "[Hj]") as "Hj";
eauto using to_of_val; auto.
asimpl.
iMod (step_call_cc_1 (LamV _) with "[Hj]")
as (b') "[Hb' Hj]"; simpl; eauto. asimpl.
iMod (step_Lam with "[Hj]") as "Hj"; simpl; eauto; try iFrame; eauto.
asimpl.
iMod (step_G _ (LamV _) with "[Hj]") as "Hj"; eauto. asimpl.
iMod (step_call_cc_1 (LamV _) ((LetInCtx _) :: _) with "[Hj]")
as (b'') "[Hb'' Hj]"; simpl; eauto; simpl.
asimpl.
iMod (step_Lam _ _ _ ((LetInCtx _) :: _) with "[Hj]")
as "Hj"; eauto; simpl; eauto.
asimpl.
iMod (step_store _ _ _ ((LetInCtx _) :: (LetInCtx _) :: _)
with "[Hl Hj]") as "[Hj Hl]"; eauto; simpl; try iFrame; eauto.
iMod (step_LetIn _ _ _ ((LetInCtx _) :: _) with "[Hj]")
as "Hj"; eauto; simpl; eauto. asimpl.
iMod (step_Lam _ _ _ ((LetInCtx _) :: _) with "[Hj]")
as "Hj"; eauto; simpl; eauto. asimpl.
iMod (step_throw _ _ _ ((LetInCtx _) :: _) with "[Hj]")
as "Hj"; eauto using to_of_val.
rewrite [ (call_cc1_ectx (Loc b') (Cont K))]call_cc1_ectx_eq /=.
iMod (step_LetIn _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val.
asimpl.
iMod (step_load _ _ _ [IfCtx _ _] with "[Hj Hb']") as "[Hj Hb']";
eauto; iFrame; eauto.
iMod (step_if_false _ _ _ [] with "[Hj]") as "Hj";
first solve_ndisj; simpl; iFrame; eauto.
iMod (step_store _ _ _ [LetInCtx _] with "[Hj Hb']") as "[Hj Hb']";
eauto; simpl; try iFrame; eauto.
iMod (step_LetIn _ _ _ [] with "[Hj]") as "Hj"; eauto; simpl; eauto. asimpl.
iMod (step_throw _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val.
iModIntro. iExists _; iFrame.
Qed.
Lemma call_cc_call_cc'_refinement :
[] ⊨ call_cc ≤log≤ call_cc' : call_cc_type.
Proof.
iIntros (Δ vvs ρ HΔ) "[#Hcfg _]".
iIntros (KK j) "[Hj HKK] /=".
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" $! (LamV _, RecV _)); iFrame; clear KK j.
iAlways. iIntros ([f f']) "#Hff /=".
iIntros ([K K'] j) "[Hj #HKK] /=".
iApply wp_Lam; eauto using to_of_val; iNext.
iMod (step_rec with "[Hj]") as "Hj"; eauto using to_of_val.
asimpl.
iMod (step_alloc _ _ _ (AppRCtx (RecV _) :: K') with "[Hj]")
as (l) "[Hj Hl]"; eauto; simpl; eauto.
iMod (step_rec _ _ _ _ _ _ (LocV _) with "[Hj]") as "Hj";
eauto using to_of_val.
asimpl.
iMod (step_G with "[Hj]") as "Hj"; eauto.
iMod (step_call_cc_1 (LamV _) ((LetInCtx _) :: K') with "[Hj]")
as (b) "[Hb Hj]"; simpl; eauto; simpl.
iMod (step_Lam _ _ _ ((LetInCtx _) :: K') with "[Hj]")
as "Hj"; eauto; simpl; eauto.
asimpl.
iMod (step_store _ _ _ ((LetInCtx _) :: (LetInCtx _) :: K')
_ _ _ (ContV _) with "[Hj $Hl]") as "[Hj Hl]"; eauto; simpl; eauto.
iApply wp_callcc; iNext. asimpl.
iMod (step_LetIn _ _ _ ((LetInCtx _) :: K') with "[Hj]")
as "Hj"; eauto; simpl; eauto.
asimpl.
iMod (inv_alloc (nroot.@"cc") _
(∃ b, b ↦ₛ (#♭v false)
∗ l ↦ₛ ContV
(call_cc1_ectx
(Loc b)
(Cont (LetInCtx
(App (TApp call_cc1)
(Lam
(App
(G (Loc l))
(Lam (Throw (ids 2) (ids 1))))))
:: K'))))%I
with "[Hl Hb]") as "#Hinv".
{ iNext. iExists _; iFrame. }
clear b.
iSpecialize ("Hff" $! (ContV _, ContV _) with "[]");
last iApply ("Hff" $! (_, (LetInCtx _) :: _)); simpl; iFrame; clear j.
- iExists _, _; iSplit; eauto. iAlways.
iIntros (vv j) "[Hj #Hvv] /=".
iApply fupd_wp.
iInv (nroot.@"cc") as (b) ">[Hb Hl]" "Hclose".
iMod (step_load _ _ _ ([ThrowRCtx _]) with "[Hj Hl]") as "[Hj Hl]"; simpl;
first (by solve_ndisj); iFrame; eauto; simpl.
iMod (step_throw _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val;
first solve_ndisj.
rewrite {2}call_cc1_ectx_eq; simpl.
asimpl.
iMod (step_LetIn _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val;
first solve_ndisj.
rewrite /= OMEGA_closed call_cc1_closed G_subst; simpl.
asimpl.
iMod (step_load _ _ _ [IfCtx _ _] with "[Hj Hb]") as "[Hj Hb]";
first solve_ndisj; simpl; iFrame; eauto.
iMod (step_if_false _ _ _ [] with "[Hj]") as "Hj";
first solve_ndisj; simpl; iFrame; eauto.
iMod (step_store _ _ _ [LetInCtx _] with "[Hj Hb]") as "[Hj Hb]";
try iFrame; eauto; first solve_ndisj.
iMod (step_LetIn _ _ _ [] with "[Hj]") as "Hj";
try iFrame; eauto; first solve_ndisj.
asimpl.
iMod (step_throw _ _ _ [] with "[Hj]") as "Hj"; eauto using to_of_val;
first solve_ndisj.
simpl.
iMod (call_cc_call_cc'_refinement_helper with "[$Hj $Hl]") as
(b') "(Hb' & Hl & Hj)"; auto; first solve_ndisj.
iMod ("Hclose" with "[Hb' Hl]") as "_"; first (iNext; iExists b'; iFrame).
iApply "HKK"; eauto.
- iAlways. iIntros (vv j) "[Hj #Hvv]".
iApply fupd_wp. iInv (nroot.@"cc") as (b'') ">[Hb'' Hl]" "Hclose".
iMod (call_cc_call_cc'_refinement_helper with "[$Hj $Hl]") as
(b') "(Hb' & Hl & Hj)"; auto; first solve_ndisj.
iMod ("Hclose" with "[Hb' Hl]") as "_"; first (iNext; iExists b'; iFrame).
iModIntro.
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.