LogrelCC.examples.refinement.oneshotCC.oneshotCC_rules

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 rules.
  Context `{heapG Σ, cfgSG Σ}.
  Context `{inG Σ (authR (gsetUR loc))}.

  Definition loc_used γ l := own γ ( ({[l]} : gset _)).

  Instance loc_used_persistent γ l : Persistent (loc_used γ l).
  Proof. apply _. Qed.

  Definition used_locs γ (M : gset loc) := own γ ( M).

  Lemma loc_used_alloc γ M l :
    used_locs γ M ==∗ used_locs γ (M {[l]}) loc_used γ l.
  Proof.
    iIntros "HM".
    iMod (own_update with "HM") as "HM".
    { apply auth_update_alloc, gset_local_update, union_subseteq_l. }
    rewrite own_op; iDestruct "HM" as "[HM HMl]"; iFrame; iModIntro.
    rewrite -gset_op_union auth_frag_op own_op.
    by iDestruct "HMl" as "[_ Hl]".
  Qed.

  Lemma loc_is_used' γ M l :
    l M used_locs γ M ==∗ used_locs γ M loc_used γ l.
  Proof.
    iIntros (?) "HM".
    iMod (own_update with "HM") as "HM".
    { apply auth_update_alloc, gset_local_update, union_subseteq_l. }
    rewrite own_op; iDestruct "HM" as "[HM HMl]"; iFrame; iModIntro.
    rewrite -gset_op_union auth_frag_op own_op.
    iDestruct "HMl" as "[_ Hl]"; iFrame.
    rewrite gset_op_union (comm _ M)subseteq_union_1; auto.
    by apply elem_of_subseteq_singleton.
  Qed.

  Definition used_locs_own γ M Φ := (used_locs γ M [∗ set] l M, Φ l)%I.

  Definition make_used_locs_own Φ : (True ==∗ γ, used_locs_own γ Φ)%I.
  Proof.
    iIntros; rewrite /used_locs_own.
    iMod (own_alloc) as (γ) "Hγ";
      last (iModIntro; iExists _; iFrame); first done.
    by rewrite big_sepS_empty.
  Qed.

  Definition used_locs_own_alloc γ M Φ l :
    l M (used_locs_own γ M Φ Φ l ==∗
             loc_used γ l used_locs_own γ (M {[l]}) Φ)%I.
  Proof.
    iIntros (?) "[[HM HMΦ] Hl]".
    iCombine "Hl" "HMΦ" as "HMlΦ".
    rewrite -big_opS_insert //.
    iMod (loc_used_alloc with "HM") as "[? ?]".
    iModIntro; rewrite /used_locs_own (comm_L _ _ M); iFrame.
  Qed.

  Definition used_locs_own_open γ M (M' : gset loc) Φ :=
    (used_locs γ M [∗ set] l M', Φ l)%I.

  Lemma used_loc_elem_of γ M l Φ :
    used_locs_own γ M Φ loc_used γ l l M.
  Proof.
    iIntros "[[HM HΦ] Hl]".
    iDestruct (own_valid_2 with "HM Hl") as %Hvl%auth_valid_discrete.
    destruct Hvl as [Hvl%gset_included _].
    rewrite /= gset_op_union in Hvl; apply union_subseteq in Hvl.
    by destruct Hvl as [_ Hvl%elem_of_subseteq_singleton].
  Qed.

  Lemma loc_is_used γ M l Φ :
    l M used_locs_own γ M Φ ==∗ loc_used γ l used_locs_own γ M Φ.
  Proof.
    iIntros (?) "[HM HΦ]".
    by iMod (loc_is_used' with "HM") as "[? ?]"; eauto; iFrame.
  Qed.

  Lemma get_used_loc γ M l Φ :
    l M
    used_locs_own γ M Φ used_locs_own_open γ M (M {[l]}) Φ Φ l.
  Proof.
    iIntros (?) "[HM HΦ]".
    rewrite big_opS_delete; eauto.
    iDestruct "HΦ" as "[HΦ HMΦ]".
    rewrite /used_locs_own_open; iFrame.
  Qed.

  Lemma put_back_used_loc γ M l Φ :
    l M
    used_locs_own_open γ M (M {[l]}) Φ Φ l used_locs_own γ M Φ.
  Proof.
    iIntros (?) "[[HM HΦ] Hl]".
    iCombine "Hl" "HΦ" as "HΦ".
    rewrite -big_opS_insert;
      last by apply not_elem_of_difference; right; apply elem_of_singleton_2.
    rewrite -union_difference_L; last by apply elem_of_subseteq_singleton.
    iFrame.
  Qed.

  Definition call_cc'_call_cc_refinement_inv γ l K :=
    ( (M : gset loc) (b0 : loc),
    used_locs_own γ M (λ b1 : loc, bv : bool, b1 ↦ᵢ (#♭v bv))
     b0 M
     l ↦ᵢ ContV
    (call_cc1_ectx
       (Loc b0)
       (Cont
          (LetInCtx
             (App
                (TApp call_cc1)
                (Lam (App (G (Loc l)) (Lam (Throw (Var 2) (Var 1))))))
             :: K))))%I.

End rules.