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.