RunST.saved_pred

Require Import iris.proofmode.tactics.

From iris.base_logic Require Export own.
From iris.algebra Require Import agree.
From iris.prelude Require Import gmap.
Import uPred.

Section saved_pred_def.
  Context {A : cofeT}.

  Class savedPredG (Σ : gFunctors) :=
    saved_pred_inG :> inG Σ (agreeR (A -n> (laterC (iPreProp Σ)))).

  Definition savedPredΣ_ex : gFunctors :=
    #[ GFunctor (agreeRF (A -n> ( idCF))) ].

  Instance subG_savedPropΣ_ex {Σ} : subG (savedPredΣ_ex) Σ savedPredG Σ.
  Proof. apply subG_inG. Qed.

  Program Definition saved_pred_owned_base
          {Σ : gFunctors} (x : A -n> (iProp Σ))
    : (A -n> (laterC (iPreProp Σ))) :=
    (λne pn, Next (iProp_unfold (x pn))).
  Next Obligation.
  Proof. intros Σ x n pn pn' Hpn. by rewrite Hpn. Qed.

  Program Definition saved_pred_owned
          {Σ : gFunctors} (x : A -n> (iProp Σ)) :
    (agreeR (A -n> (laterC (iPreProp Σ)))) :=
    (to_agree $ (saved_pred_owned_base x)).

  Definition saved_pred_own `{savedPredG Σ}
             (γ : gname) (x : A -n> (iProp Σ)) : iProp Σ :=
    own γ (saved_pred_owned x).
  Typeclasses Opaque saved_pred_own.
  Instance: Params (@saved_pred_own) 2.

End saved_pred_def.

Section saved_pred.
  Context {A} `{@savedPredG A Σ}.
  Implicit Types x y : A -n> (iProp Σ).
  Implicit Types γ : gname.

  Global Instance saved_pred_persistent γ x : PersistentP (saved_pred_own γ x).
  Proof. rewrite /saved_pred_own; apply _. Qed.

  Global Instance saved_pred_contractive γ : Contractive (saved_pred_own γ).
  Proof.
    intros n P Q HPQ.
    rewrite /saved_pred_own /saved_pred_owned /saved_pred_owned_base.
    apply own_ne, to_agree_ne => pn; simpl.
    apply Next_contractive=> j ?; by rewrite (HPQ j).
  Qed.

  Lemma saved_pred_alloc_strong x (G : gset gname) :
    True |==> γ, (γ G) saved_pred_own γ x.
  Proof. by apply (own_alloc_strong (saved_pred_owned x)). Qed.

  Lemma saved_pred_alloc x : True |==> γ, saved_pred_own γ x.
  Proof. by apply own_alloc. Qed.

  Lemma saved_pred_agree γ x y pn :
    saved_pred_own γ x saved_pred_own γ y ▷((x pn) (y pn)).
  Proof.
  rewrite own_valid_2 agree_validI agree_equivI.
  iIntros "#Heq".
  iAssert ((Next (iProp_unfold (x pn))) (Next (iProp_unfold (y pn))))%I
    as "#Heq'".
  { setoid_replace (Next (iProp_unfold (x pn))) with
    (saved_pred_owned_base x pn) by trivial.
    setoid_replace (Next (iProp_unfold (y pn))) with
    (saved_pred_owned_base y pn) by trivial.
    by iRewrite "Heq". }
  rewrite later_equivI; iNext.
  rewrite -{2}[x pn]iProp_fold_unfold -{2}[y pn]iProp_fold_unfold.
  by iRewrite "Heq'".
  Qed.

  Lemma saved_pred_agree' γ x y :
    saved_pred_own γ x saved_pred_own γ y ▷(x y).
  Proof.
    iIntros "#H1".
    rewrite cofe_morC_equivI later_forall.
    iIntros (z).
    iApply (saved_pred_agree with "H1").
  Qed.

  Lemma saved_pred_impl γ x y pn :
    saved_pred_own γ x saved_pred_own γ y ▷(x pn) (y pn).
  Proof.
   iIntros "(Ho1 & Ho2 & Hx)".
   iPoseProof (saved_pred_agree _ _ _ pn with "[Ho1 Ho2]") as "Hleq";
   first by iFrame.
   iNext; iRewrite "Hleq"; iFrame.
  Qed.

End saved_pred.