saved_prop.v 4.63 KB
Newer Older
Ralf Jung's avatar
Ralf Jung committed
1
From iris.base_logic Require Export own.
2
From iris.algebra Require Import agree.
Ralf Jung's avatar
Ralf Jung committed
3
From stdpp Require Import gmap.
4
From iris.proofmode Require Import tactics.
5
Set Default Proof Using "Type".
Robbert Krebbers's avatar
Robbert Krebbers committed
6 7
Import uPred.

8 9 10 11 12 13
(* "Saved anything" -- this can give you saved propositions, saved predicates,
   saved whatever-you-like. *)

Class savedAnythingG (Σ : gFunctors) (F : cFunctor) :=
  saved_anything_inG :> inG Σ (agreeR (F (iPreProp Σ))).
Definition savedAnythingΣ (F : cFunctor) `{!cFunctorContractive F} : gFunctors :=
14
  #[ GFunctor (agreeRF F) ].
15

16 17
Instance subG_savedAnythingΣ {Σ F} `{!cFunctorContractive F} :
  subG (savedAnythingΣ F) Σ  savedAnythingG Σ F.
18
Proof. solve_inG. Qed.
19

20
Definition saved_anything_own `{savedAnythingG Σ F}
21
    (γ : gname) (x : F (iProp Σ)) : iProp Σ :=
22
  own γ (to_agree $ (cFunctor_map F (iProp_fold, iProp_unfold) x)).
23 24
Typeclasses Opaque saved_anything_own.
Instance: Params (@saved_anything_own) 3.
Robbert Krebbers's avatar
Robbert Krebbers committed
25

26 27
Section saved_anything.
  Context `{savedAnythingG Σ F}.
28
  Implicit Types x y : F (iProp Σ).
Robbert Krebbers's avatar
Robbert Krebbers committed
29 30
  Implicit Types γ : gname.

Robbert Krebbers's avatar
Robbert Krebbers committed
31 32
  Global Instance saved_anything_persistent γ x :
    Persistent (saved_anything_own γ x).
33
  Proof. rewrite /saved_anything_own; apply _. Qed.
34

35 36 37 38 39
  Global Instance saved_anything_ne γ : NonExpansive (saved_anything_own γ).
  Proof. solve_proper. Qed.
  Global Instance saved_anything_proper γ : Proper (() ==> ()) (saved_anything_own γ).
  Proof. solve_proper. Qed.

40 41
  Lemma saved_anything_alloc_strong x (G : gset gname) :
    (|==>  γ, ⌜γ  G  saved_anything_own γ x)%I.
42
  Proof. by apply own_alloc_strong. Qed.
43

44
  Lemma saved_anything_alloc x : (|==>  γ, saved_anything_own γ x)%I.
45
  Proof. by apply own_alloc. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
46

47 48
  Lemma saved_anything_agree γ x y :
    saved_anything_own γ x - saved_anything_own γ y - x  y.
Robbert Krebbers's avatar
Robbert Krebbers committed
49
  Proof.
50 51 52
    iIntros "Hx Hy". rewrite /saved_anything_own.
    iDestruct (own_valid_2 with "Hx Hy") as "Hv".
    rewrite agree_validI agree_equivI.
53
    set (G1 := cFunctor_map F (iProp_fold, iProp_unfold)).
54
    set (G2 := cFunctor_map F (@iProp_unfold Σ, @iProp_fold Σ)).
55 56
    assert ( z, G2 (G1 z)  z) as help.
    { intros z. rewrite /G1 /G2 -cFunctor_compose -{2}[z]cFunctor_id.
57
      apply (ne_proper (cFunctor_map F)); split=>?; apply iProp_fold_unfold. }
58
    rewrite -{2}[x]help -{2}[y]help. by iApply f_equiv.
Robbert Krebbers's avatar
Robbert Krebbers committed
59
  Qed.
60 61 62 63 64 65 66 67 68 69 70
End saved_anything.

(** Provide specialized versions of this for convenience. **)

(* Saved propositions. *)
Notation savedPropG Σ := (savedAnythingG Σ ( )).
Notation savedPropΣ := (savedAnythingΣ ( )).

Definition saved_prop_own `{savedPropG Σ} (γ : gname) (P: iProp Σ) :=
  saved_anything_own (F :=  ) γ (Next P).

71 72 73 74
Instance saved_prop_own_contractive `{savedPropG Σ} γ :
  Contractive (saved_prop_own γ).
Proof. rewrite /saved_prop_own. solve_contractive. Qed.

75 76 77 78
Lemma saved_prop_alloc_strong `{savedPropG Σ} (G : gset gname) (P: iProp Σ) :
  (|==>  γ, ⌜γ  G  saved_prop_own γ P)%I.
Proof. iApply saved_anything_alloc_strong. Qed.

79 80 81 82 83 84 85 86 87 88 89 90 91 92
Lemma saved_prop_alloc `{savedPropG Σ} (P: iProp Σ) :
  (|==>  γ, saved_prop_own γ P)%I.
Proof. iApply saved_anything_alloc. Qed.

Lemma saved_prop_agree `{savedPropG Σ} γ P Q :
  saved_prop_own γ P - saved_prop_own γ Q -  (P  Q).
Proof.
  iIntros "HP HQ". iApply later_equivI. iApply (saved_anything_agree with "HP HQ").
Qed.

(* Saved predicates. *)
Notation savedPredG Σ A := (savedAnythingG Σ (constCF A -n>  )).
Notation savedPredΣ A := (savedAnythingΣ (constCF A -n>  )).

93 94
Definition saved_pred_own `{savedPredG Σ A} (γ : gname) (Φ : A -n> iProp Σ) :=
  saved_anything_own (F := A -n>  ) γ (CofeMor Next  Φ).
95

96 97 98 99 100 101
Instance saved_pred_own_contractive `{savedPredG Σ A} γ : Contractive (saved_pred_own γ).
Proof.
  intros n Φ Φ' HΦ. rewrite /saved_pred_own /saved_anything_own /=.
  do 3 f_equiv. intros x. rewrite /=. by f_contractive.
Qed.

102 103
Lemma saved_pred_alloc_strong `{savedPredG Σ A} (G : gset gname) (Φ : A -n> iProp Σ) :
  (|==>  γ, ⌜γ  G  saved_pred_own γ Φ)%I.
104 105
Proof. iApply saved_anything_alloc_strong. Qed.

106 107
Lemma saved_pred_alloc `{savedPredG Σ A} (Φ : A -n> iProp Σ) :
  (|==>  γ, saved_pred_own γ Φ)%I.
108 109
Proof. iApply saved_anything_alloc. Qed.

110
(* We put the `x` on the outside to make this lemma easier to apply. *)
111 112
Lemma saved_pred_agree `{savedPredG Σ A} γ Φ Ψ x :
  saved_pred_own γ Φ - saved_pred_own γ Ψ -  (Φ x  Ψ x).
113
Proof.
114 115
  iIntros "HΦ HΨ". unfold saved_pred_own. iApply later_equivI.
  iDestruct (ofe_morC_equivI (CofeMor Next  Φ) (CofeMor Next  Ψ)) as "[FE _]".
116
  simpl. iApply ("FE" with "[-]").
117
  iApply (saved_anything_agree with "HΦ HΨ").
118
Qed.