LogrelCC.examples.refinement.oneshotCC.oneshotCC_progs
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.
(* diverging term. Perhaps move elsewhere! *)
Definition OMEGA := App (Rec (App (Var 0) (Var 1))) Unit.
Section wp_OMEGA.
Context `{heapG Σ}.
Lemma wp_OMEGA E K : (WP fill K OMEGA @ E {{_, False}})%I.
Proof. iLöb as "IH"; iApply wp_rec; eauto. Qed.
End wp_OMEGA.
Lemma OMEGA_closed : ∀ f, OMEGA.[f] = OMEGA.
Proof. by intros ?; asimpl. Qed.
Hint Rewrite OMEGA_closed : autosubst.
Typeclasses Opaque OMEGA.
Global Opaque OMEGA.
Section progs.
Context `{heapG Σ, cfgSG Σ}.
Definition call_cc := TLam (Lam (Callcc (App (Var 1) (Var 0)))).
Definition call_cc_type :=
TForall (TArrow (TArrow (TCont (TVar 0)) (TVar 0)) (TVar 0)).
Lemma call_cc_typed : [] ⊢ₜ call_cc : call_cc_type.
Proof. repeat econstructor. Qed.
Definition call_cc1_ectx b eK : ectx :=
[LetInCtx
(If (Load b.[ren (+1)]) OMEGA
(LetIn (Store b.[ren (+1)] (#♭ true))
(Throw (Var 1) eK.[ren (+2)])))].
Lemma call_cc1_ectx_eq b eK :
call_cc1_ectx b eK =
[LetInCtx
(If (Load b.[ren (+1)]) OMEGA
(LetIn (Store b.[ren (+1)] (#♭ true))
(Throw (Var 1) eK.[ren (+2)])))].
Proof. trivial. Qed.
Lemma call_cc1_ectx_subst b eK :
∀ f, (Cont (call_cc1_ectx b eK)).[f] = Cont (call_cc1_ectx b.[f] eK.[f]).
Proof. by intros f; unfold call_cc1_ectx; asimpl. Qed.
Hint Rewrite call_cc1_ectx_subst : autosubst.
Typeclasses Opaque call_cc1_ectx.
Global Opaque call_cc1_ectx.
Definition call_cc1 :=
TLam
(Lam (LetIn
(Alloc (#♭ false))
(Callcc
(App
(Var 2)
(Cont (call_cc1_ectx (Var 1) (Var 0))))
)
)
).
Lemma call_cc1_eq :
call_cc1 =
TLam
(Lam (LetIn
(Alloc (#♭ false))
(Callcc
(App
(Var 2)
(Cont (call_cc1_ectx (Var 1) (Var 0))))
)
)
).
Proof. trivial. Qed.
Lemma call_cc1_closed : ∀ f, call_cc1.[f] = call_cc1.
Proof. by asimpl. Qed.
Hint Rewrite call_cc1_closed : autosubst.
Definition call_cc1_inner_body :=
LetIn
(Alloc (#♭ false))
(Callcc
(App
(Var 2)
(Cont (call_cc1_ectx (Var 1) (Var 0))))).
Lemma call_cc1_inner_body_eq :
call_cc1_inner_body =
LetIn
(Alloc (#♭ false))
(Callcc
(App
(Var 2)
(Cont (call_cc1_ectx (Var 1) (Var 0))))).
Proof. trivial. Qed.
Typeclasses Opaque call_cc1_inner_body.
Global Opaque call_cc1_inner_body.
Lemma step_call_cc_1 f K E ρ j:
nclose specN ⊆ E →
spec_ctx ρ ∗ j ⤇ fill K (App (TApp call_cc1) (of_val f))
={E}=∗
∃ b, b ↦ₛ (#♭v false) ∗
j ⤇ fill K (App (of_val f)
(Cont (call_cc1_ectx (Loc b) (Cont K)))).
Proof.
iIntros (HE) "[#Hcfg Hj]".
iMod (step_tlam _ _ _ (AppLCtx _ :: K) with "[Hj]") as "Hj"; eauto; simpl.
rewrite call_cc1_ectx_eq.
iMod (step_Lam with "[Hj]") as "Hj"; eauto using to_of_val.
asimpl.
iMod (step_alloc _ _ _ ((LetInCtx _) :: K) with "[Hj]") as (b) "[Hj Hb]";
eauto; simpl; eauto.
iMod (step_LetIn _ _ _ _ _ _ (LocV _) with "[Hj]") as "Hj";
eauto using to_of_val.
asimpl.
iMod (step_callcc with "[Hj]") as "Hj"; eauto.
asimpl.
iModIntro. iExists b; rewrite call_cc1_ectx_eq; iFrame.
Qed.
Typeclasses Opaque call_cc1.
Global Opaque call_cc1.
Definition G r :=
Rec (LetIn
(App (TApp call_cc1)
(Lam (LetIn
(Store r.[ren (+3)] (Var 0))
(App (Var 3) (Cont [ThrowLCtx (Load r.[ren (+4)])])))))
(App
(TApp call_cc1)
(Lam (App (Var 2) (Lam (Throw (Var 2) (Var 1))))))
).
Lemma G_eq r :
G r =
Rec (LetIn
(App (TApp call_cc1)
(Lam (LetIn
(Store r.[ren (+3)] (Var 0))
(App (Var 3) (Cont [ThrowLCtx (Load r.[ren (+4)])])))))
(App
(TApp call_cc1)
(Lam (App (Var 2) (Lam (Throw (Var 2) (Var 1))))))
).
Proof. trivial. Qed.
Lemma G_subst r : ∀ f, (G r).[f] = G r.[f].
Proof. by intros f; rewrite /G; asimpl. Qed.
Hint Rewrite G_subst : autosubst.
Typeclasses Opaque G.
Global Opaque G.
Lemma step_G l f K E ρ j :
nclose specN ⊆ E →
spec_ctx ρ ∗ j ⤇ fill K (App (G (Loc l)) (of_val f))
={E}=∗
j ⤇ fill K
(LetIn
(App (TApp call_cc1)
(Lam (LetIn
(Store (Loc l) (Var 0))
(App
(of_val f).[ren (+2)]
(Cont [ThrowLCtx (Load (Loc l))])))))
(App
(TApp call_cc1)
(Lam (App (G (Loc l)) (Lam (Throw (ids 2) (ids 1))))))).
Proof.
iIntros (HE) "[#Hcfg Hj]".
rewrite {1}G_eq.
iMod (step_rec with "[Hj]"); eauto using to_of_val.
rewrite -G_eq. by asimpl.
Qed.
Definition call_cc' :=
TLam (Rec (App (Rec (App (G (Var 1)) (Var 3))) (Alloc (Cont [])))).
Lemma call_cc'_closed : ∀ f, call_cc'.[f] = call_cc'.
Proof. by intros ?; asimpl. Qed.
Hint Rewrite call_cc'_closed : autosubst.
End progs.
Hint Rewrite call_cc1_ectx_subst : autosubst.
Hint Rewrite call_cc1_closed : autosubst.
Hint Rewrite G_subst : autosubst.
Hint Rewrite call_cc'_closed : autosubst.
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.
(* diverging term. Perhaps move elsewhere! *)
Definition OMEGA := App (Rec (App (Var 0) (Var 1))) Unit.
Section wp_OMEGA.
Context `{heapG Σ}.
Lemma wp_OMEGA E K : (WP fill K OMEGA @ E {{_, False}})%I.
Proof. iLöb as "IH"; iApply wp_rec; eauto. Qed.
End wp_OMEGA.
Lemma OMEGA_closed : ∀ f, OMEGA.[f] = OMEGA.
Proof. by intros ?; asimpl. Qed.
Hint Rewrite OMEGA_closed : autosubst.
Typeclasses Opaque OMEGA.
Global Opaque OMEGA.
Section progs.
Context `{heapG Σ, cfgSG Σ}.
Definition call_cc := TLam (Lam (Callcc (App (Var 1) (Var 0)))).
Definition call_cc_type :=
TForall (TArrow (TArrow (TCont (TVar 0)) (TVar 0)) (TVar 0)).
Lemma call_cc_typed : [] ⊢ₜ call_cc : call_cc_type.
Proof. repeat econstructor. Qed.
Definition call_cc1_ectx b eK : ectx :=
[LetInCtx
(If (Load b.[ren (+1)]) OMEGA
(LetIn (Store b.[ren (+1)] (#♭ true))
(Throw (Var 1) eK.[ren (+2)])))].
Lemma call_cc1_ectx_eq b eK :
call_cc1_ectx b eK =
[LetInCtx
(If (Load b.[ren (+1)]) OMEGA
(LetIn (Store b.[ren (+1)] (#♭ true))
(Throw (Var 1) eK.[ren (+2)])))].
Proof. trivial. Qed.
Lemma call_cc1_ectx_subst b eK :
∀ f, (Cont (call_cc1_ectx b eK)).[f] = Cont (call_cc1_ectx b.[f] eK.[f]).
Proof. by intros f; unfold call_cc1_ectx; asimpl. Qed.
Hint Rewrite call_cc1_ectx_subst : autosubst.
Typeclasses Opaque call_cc1_ectx.
Global Opaque call_cc1_ectx.
Definition call_cc1 :=
TLam
(Lam (LetIn
(Alloc (#♭ false))
(Callcc
(App
(Var 2)
(Cont (call_cc1_ectx (Var 1) (Var 0))))
)
)
).
Lemma call_cc1_eq :
call_cc1 =
TLam
(Lam (LetIn
(Alloc (#♭ false))
(Callcc
(App
(Var 2)
(Cont (call_cc1_ectx (Var 1) (Var 0))))
)
)
).
Proof. trivial. Qed.
Lemma call_cc1_closed : ∀ f, call_cc1.[f] = call_cc1.
Proof. by asimpl. Qed.
Hint Rewrite call_cc1_closed : autosubst.
Definition call_cc1_inner_body :=
LetIn
(Alloc (#♭ false))
(Callcc
(App
(Var 2)
(Cont (call_cc1_ectx (Var 1) (Var 0))))).
Lemma call_cc1_inner_body_eq :
call_cc1_inner_body =
LetIn
(Alloc (#♭ false))
(Callcc
(App
(Var 2)
(Cont (call_cc1_ectx (Var 1) (Var 0))))).
Proof. trivial. Qed.
Typeclasses Opaque call_cc1_inner_body.
Global Opaque call_cc1_inner_body.
Lemma step_call_cc_1 f K E ρ j:
nclose specN ⊆ E →
spec_ctx ρ ∗ j ⤇ fill K (App (TApp call_cc1) (of_val f))
={E}=∗
∃ b, b ↦ₛ (#♭v false) ∗
j ⤇ fill K (App (of_val f)
(Cont (call_cc1_ectx (Loc b) (Cont K)))).
Proof.
iIntros (HE) "[#Hcfg Hj]".
iMod (step_tlam _ _ _ (AppLCtx _ :: K) with "[Hj]") as "Hj"; eauto; simpl.
rewrite call_cc1_ectx_eq.
iMod (step_Lam with "[Hj]") as "Hj"; eauto using to_of_val.
asimpl.
iMod (step_alloc _ _ _ ((LetInCtx _) :: K) with "[Hj]") as (b) "[Hj Hb]";
eauto; simpl; eauto.
iMod (step_LetIn _ _ _ _ _ _ (LocV _) with "[Hj]") as "Hj";
eauto using to_of_val.
asimpl.
iMod (step_callcc with "[Hj]") as "Hj"; eauto.
asimpl.
iModIntro. iExists b; rewrite call_cc1_ectx_eq; iFrame.
Qed.
Typeclasses Opaque call_cc1.
Global Opaque call_cc1.
Definition G r :=
Rec (LetIn
(App (TApp call_cc1)
(Lam (LetIn
(Store r.[ren (+3)] (Var 0))
(App (Var 3) (Cont [ThrowLCtx (Load r.[ren (+4)])])))))
(App
(TApp call_cc1)
(Lam (App (Var 2) (Lam (Throw (Var 2) (Var 1))))))
).
Lemma G_eq r :
G r =
Rec (LetIn
(App (TApp call_cc1)
(Lam (LetIn
(Store r.[ren (+3)] (Var 0))
(App (Var 3) (Cont [ThrowLCtx (Load r.[ren (+4)])])))))
(App
(TApp call_cc1)
(Lam (App (Var 2) (Lam (Throw (Var 2) (Var 1))))))
).
Proof. trivial. Qed.
Lemma G_subst r : ∀ f, (G r).[f] = G r.[f].
Proof. by intros f; rewrite /G; asimpl. Qed.
Hint Rewrite G_subst : autosubst.
Typeclasses Opaque G.
Global Opaque G.
Lemma step_G l f K E ρ j :
nclose specN ⊆ E →
spec_ctx ρ ∗ j ⤇ fill K (App (G (Loc l)) (of_val f))
={E}=∗
j ⤇ fill K
(LetIn
(App (TApp call_cc1)
(Lam (LetIn
(Store (Loc l) (Var 0))
(App
(of_val f).[ren (+2)]
(Cont [ThrowLCtx (Load (Loc l))])))))
(App
(TApp call_cc1)
(Lam (App (G (Loc l)) (Lam (Throw (ids 2) (ids 1))))))).
Proof.
iIntros (HE) "[#Hcfg Hj]".
rewrite {1}G_eq.
iMod (step_rec with "[Hj]"); eauto using to_of_val.
rewrite -G_eq. by asimpl.
Qed.
Definition call_cc' :=
TLam (Rec (App (Rec (App (G (Var 1)) (Var 3))) (Alloc (Cont [])))).
Lemma call_cc'_closed : ∀ f, call_cc'.[f] = call_cc'.
Proof. by intros ?; asimpl. Qed.
Hint Rewrite call_cc'_closed : autosubst.
End progs.
Hint Rewrite call_cc1_ectx_subst : autosubst.
Hint Rewrite call_cc1_closed : autosubst.
Hint Rewrite G_subst : autosubst.
Hint Rewrite call_cc'_closed : autosubst.