primitive.v 24.8 KB
Newer Older
1 2
From iris.base_logic Require Export upred.
From iris.algebra Require Export updates.
3
Set Default Proof Using "Type".
4 5 6 7 8 9 10 11
Local Hint Extern 1 (_  _) => etrans; [eassumption|].
Local Hint Extern 1 (_  _) => etrans; [|eassumption].
Local Hint Extern 10 (_  _) => omega.

(** logical connectives *)
Program Definition uPred_pure_def {M} (φ : Prop) : uPred M :=
  {| uPred_holds n x := φ |}.
Solve Obligations with done.
12 13
Definition uPred_pure_aux : seal (@uPred_pure_def). by eexists. Qed.
Definition uPred_pure {M} := unseal uPred_pure_aux M.
14
Definition uPred_pure_eq :
15
  @uPred_pure = @uPred_pure_def := seal_eq uPred_pure_aux.
16 17 18 19 20 21

Instance uPred_inhabited M : Inhabited (uPred M) := populate (uPred_pure True).

Program Definition uPred_and_def {M} (P Q : uPred M) : uPred M :=
  {| uPred_holds n x := P n x  Q n x |}.
Solve Obligations with naive_solver eauto 2 with uPred_def.
22 23 24
Definition uPred_and_aux : seal (@uPred_and_def). by eexists. Qed.
Definition uPred_and {M} := unseal uPred_and_aux M.
Definition uPred_and_eq: @uPred_and = @uPred_and_def := seal_eq uPred_and_aux.
25 26 27 28

Program Definition uPred_or_def {M} (P Q : uPred M) : uPred M :=
  {| uPred_holds n x := P n x  Q n x |}.
Solve Obligations with naive_solver eauto 2 with uPred_def.
29 30 31
Definition uPred_or_aux : seal (@uPred_or_def). by eexists. Qed.
Definition uPred_or {M} := unseal uPred_or_aux M.
Definition uPred_or_eq: @uPred_or = @uPred_or_def := seal_eq uPred_or_aux.
32 33 34 35 36 37 38 39 40 41

Program Definition uPred_impl_def {M} (P Q : uPred M) : uPred M :=
  {| uPred_holds n x :=  n' x',
       x  x'  n'  n  {n'} x'  P n' x'  Q n' x' |}.
Next Obligation.
  intros M P Q n1 x1 x1' HPQ [x2 Hx1'] n2 x3 [x4 Hx3] ?; simpl in *.
  rewrite Hx3 (dist_le _ _ _ _ Hx1'); auto. intros ??.
  eapply HPQ; auto. exists (x2  x4); by rewrite assoc.
Qed.
Next Obligation. intros M P Q [|n1] [|n2] x; auto with lia. Qed.
42 43
Definition uPred_impl_aux : seal (@uPred_impl_def). by eexists. Qed.
Definition uPred_impl {M} := unseal uPred_impl_aux M.
44
Definition uPred_impl_eq :
45
  @uPred_impl = @uPred_impl_def := seal_eq uPred_impl_aux.
46 47 48 49

Program Definition uPred_forall_def {M A} (Ψ : A  uPred M) : uPred M :=
  {| uPred_holds n x :=  a, Ψ a n x |}.
Solve Obligations with naive_solver eauto 2 with uPred_def.
50 51
Definition uPred_forall_aux : seal (@uPred_forall_def). by eexists. Qed.
Definition uPred_forall {M A} := unseal uPred_forall_aux M A.
52
Definition uPred_forall_eq :
53
  @uPred_forall = @uPred_forall_def := seal_eq uPred_forall_aux.
54 55 56 57

Program Definition uPred_exist_def {M A} (Ψ : A  uPred M) : uPred M :=
  {| uPred_holds n x :=  a, Ψ a n x |}.
Solve Obligations with naive_solver eauto 2 with uPred_def.
58 59 60
Definition uPred_exist_aux : seal (@uPred_exist_def). by eexists. Qed.
Definition uPred_exist {M A} := unseal uPred_exist_aux M A.
Definition uPred_exist_eq: @uPred_exist = @uPred_exist_def := seal_eq uPred_exist_aux.
61

62
Program Definition uPred_internal_eq_def {M} {A : ofeT} (a1 a2 : A) : uPred M :=
63 64
  {| uPred_holds n x := a1 {n} a2 |}.
Solve Obligations with naive_solver eauto 2 using (dist_le (A:=A)).
65 66
Definition uPred_internal_eq_aux : seal (@uPred_internal_eq_def). by eexists. Qed.
Definition uPred_internal_eq {M A} := unseal uPred_internal_eq_aux M A.
67
Definition uPred_internal_eq_eq:
68
  @uPred_internal_eq = @uPred_internal_eq_def := seal_eq uPred_internal_eq_aux.
69 70 71 72 73 74 75 76 77 78

Program Definition uPred_sep_def {M} (P Q : uPred M) : uPred M :=
  {| uPred_holds n x :=  x1 x2, x {n} x1  x2  P n x1  Q n x2 |}.
Next Obligation.
  intros M P Q n x y (x1&x2&Hx&?&?) [z Hy].
  exists x1, (x2  z); split_and?; eauto using uPred_mono, cmra_includedN_l.
  by rewrite Hy Hx assoc.
Qed.
Next Obligation.
  intros M P Q n1 n2 x (x1&x2&Hx&?&?) ?; rewrite {1}(dist_le _ _ _ _ Hx) // =>?.
79
  exists x1, x2; ofe_subst; split_and!;
80 81
    eauto using dist_le, uPred_closed, cmra_validN_op_l, cmra_validN_op_r.
Qed.
82 83 84
Definition uPred_sep_aux : seal (@uPred_sep_def). by eexists. Qed.
Definition uPred_sep {M} := unseal uPred_sep_aux M.
Definition uPred_sep_eq: @uPred_sep = @uPred_sep_def := seal_eq uPred_sep_aux.
85 86 87 88 89 90 91 92 93 94

Program Definition uPred_wand_def {M} (P Q : uPred M) : uPred M :=
  {| uPred_holds n x :=  n' x',
       n'  n  {n'} (x  x')  P n' x'  Q n' (x  x') |}.
Next Obligation.
  intros M P Q n x1 x1' HPQ ? n3 x3 ???; simpl in *.
  apply uPred_mono with (x1  x3);
    eauto using cmra_validN_includedN, cmra_monoN_r, cmra_includedN_le.
Qed.
Next Obligation. naive_solver. Qed.
95 96
Definition uPred_wand_aux : seal (@uPred_wand_def). by eexists. Qed.
Definition uPred_wand {M} := unseal uPred_wand_aux M.
97
Definition uPred_wand_eq :
98
  @uPred_wand = @uPred_wand_def := seal_eq uPred_wand_aux.
99 100 101 102 103 104 105

Program Definition uPred_always_def {M} (P : uPred M) : uPred M :=
  {| uPred_holds n x := P n (core x) |}.
Next Obligation.
  intros M; naive_solver eauto using uPred_mono, @cmra_core_monoN.
Qed.
Next Obligation. naive_solver eauto using uPred_closed, @cmra_core_validN. Qed.
106 107
Definition uPred_always_aux : seal (@uPred_always_def). by eexists. Qed.
Definition uPred_always {M} := unseal uPred_always_aux M.
108
Definition uPred_always_eq :
109
  @uPred_always = @uPred_always_def := seal_eq uPred_always_aux.
110 111 112 113 114 115 116 117 118

Program Definition uPred_later_def {M} (P : uPred M) : uPred M :=
  {| uPred_holds n x := match n return _ with 0 => True | S n' => P n' x end |}.
Next Obligation.
  intros M P [|n] x1 x2; eauto using uPred_mono, cmra_includedN_S.
Qed.
Next Obligation.
  intros M P [|n1] [|n2] x; eauto using uPred_closed, cmra_validN_S with lia.
Qed.
119 120
Definition uPred_later_aux : seal (@uPred_later_def). by eexists. Qed.
Definition uPred_later {M} := unseal uPred_later_aux M.
121
Definition uPred_later_eq :
122
  @uPred_later = @uPred_later_def := seal_eq uPred_later_aux.
123 124 125 126 127 128 129 130

Program Definition uPred_ownM_def {M : ucmraT} (a : M) : uPred M :=
  {| uPred_holds n x := a {n} x |}.
Next Obligation.
  intros M a n x1 x [a' Hx1] [x2 ->].
  exists (a'  x2). by rewrite (assoc op) Hx1.
Qed.
Next Obligation. naive_solver eauto using cmra_includedN_le. Qed.
131 132
Definition uPred_ownM_aux : seal (@uPred_ownM_def). by eexists. Qed.
Definition uPred_ownM {M} := unseal uPred_ownM_aux M.
133
Definition uPred_ownM_eq :
134
  @uPred_ownM = @uPred_ownM_def := seal_eq uPred_ownM_aux.
135 136 137 138

Program Definition uPred_cmra_valid_def {M} {A : cmraT} (a : A) : uPred M :=
  {| uPred_holds n x := {n} a |}.
Solve Obligations with naive_solver eauto 2 using cmra_validN_le.
139 140
Definition uPred_cmra_valid_aux : seal (@uPred_cmra_valid_def). by eexists. Qed.
Definition uPred_cmra_valid {M A} := unseal uPred_cmra_valid_aux M A.
141
Definition uPred_cmra_valid_eq :
142
  @uPred_cmra_valid = @uPred_cmra_valid_def := seal_eq uPred_cmra_valid_aux.
143 144 145 146 147 148 149 150 151 152 153 154

Program Definition uPred_bupd_def {M} (Q : uPred M) : uPred M :=
  {| uPred_holds n x :=  k yf,
      k  n  {k} (x  yf)   x', {k} (x'  yf)  Q k x' |}.
Next Obligation.
  intros M Q n x1 x2 HQ [x3 Hx] k yf Hk.
  rewrite (dist_le _ _ _ _ Hx); last lia. intros Hxy.
  destruct (HQ k (x3  yf)) as (x'&?&?); [auto|by rewrite assoc|].
  exists (x'  x3); split; first by rewrite -assoc.
  apply uPred_mono with x'; eauto using cmra_includedN_l.
Qed.
Next Obligation. naive_solver. Qed.
155 156 157
Definition uPred_bupd_aux : seal (@uPred_bupd_def). by eexists. Qed.
Definition uPred_bupd {M} := unseal uPred_bupd_aux M.
Definition uPred_bupd_eq : @uPred_bupd = @uPred_bupd_def := seal_eq uPred_bupd_aux.
158

Ralf Jung's avatar
Ralf Jung committed
159 160 161
(* Latest notation *)
Notation "'⌜' φ '⌝'" := (uPred_pure φ%C%type)
  (at level 1, φ at level 200, format "⌜ φ ⌝") : uPred_scope.
162 163 164 165 166 167 168
Notation "'False'" := (uPred_pure False) : uPred_scope.
Notation "'True'" := (uPred_pure True) : uPred_scope.
Infix "∧" := uPred_and : uPred_scope.
Notation "(∧)" := uPred_and (only parsing) : uPred_scope.
Infix "∨" := uPred_or : uPred_scope.
Notation "(∨)" := uPred_or (only parsing) : uPred_scope.
Infix "→" := uPred_impl : uPred_scope.
169 170 171
Infix "∗" := uPred_sep (at level 80, right associativity) : uPred_scope.
Notation "(∗)" := uPred_sep (only parsing) : uPred_scope.
Notation "P -∗ Q" := (uPred_wand P Q)
172 173
  (at level 99, Q at level 200, right associativity) : uPred_scope.
Notation "∀ x .. y , P" :=
174 175
  (uPred_forall (λ x, .. (uPred_forall (λ y, P)) ..)%I)
  (at level 200, x binder, y binder, right associativity) : uPred_scope.
176
Notation "∃ x .. y , P" :=
177 178
  (uPred_exist (λ x, .. (uPred_exist (λ y, P)) ..)%I)
  (at level 200, x binder, y binder, right associativity) : uPred_scope.
179 180 181 182
Notation "□ P" := (uPred_always P)
  (at level 20, right associativity) : uPred_scope.
Notation "▷ P" := (uPred_later P)
  (at level 20, right associativity) : uPred_scope.
183
Infix "≡" := uPred_internal_eq : uPred_scope.
184 185 186
Notation "✓ x" := (uPred_cmra_valid x) (at level 20) : uPred_scope.
Notation "|==> Q" := (uPred_bupd Q)
  (at level 99, Q at level 200, format "|==>  Q") : uPred_scope.
187
Notation "P ==∗ Q" := (P  |==> Q)
188
  (at level 99, Q at level 200, only parsing) : C_scope.
189 190
Notation "P ==∗ Q" := (P - |==> Q)%I
  (at level 99, Q at level 200, format "P  ==∗  Q") : uPred_scope.
191

192 193
Coercion uPred_valid {M} (P : uPred M) : Prop := True%I  P.
Notation "P -∗ Q" := (P  Q)
194
  (at level 99, Q at level 200, right associativity) : C_scope.
195

196
Module uPred.
197
Definition unseal_eqs :=
198
  (uPred_pure_eq, uPred_and_eq, uPred_or_eq, uPred_impl_eq, uPred_forall_eq,
199
  uPred_exist_eq, uPred_internal_eq_eq, uPred_sep_eq, uPred_wand_eq, uPred_always_eq,
200
  uPred_later_eq, uPred_ownM_eq, uPred_cmra_valid_eq, uPred_bupd_eq).
201
Ltac unseal := rewrite !unseal_eqs /=.
202 203 204 205 206 207 208 209 210 211 212 213

Section primitive.
Context {M : ucmraT}.
Implicit Types φ : Prop.
Implicit Types P Q : uPred M.
Implicit Types A : Type.
Notation "P ⊢ Q" := (@uPred_entails M P%I Q%I). (* Force implicit argument M *)
Notation "P ⊣⊢ Q" := (equiv (A:=uPred M) P%I Q%I). (* Force implicit argument M *)
Arguments uPred_holds {_} !_ _ _ /.
Hint Immediate uPred_in_entails.

(** Non-expansiveness and setoid morphisms *)
214
Global Instance pure_proper : Proper (iff ==> ()) (@uPred_pure M) | 0.
215
Proof. intros φ1 φ2 Hφ. by unseal; split=> -[|n] ?; try apply Hφ. Qed.
216 217 218
Global Instance pure_ne n : Proper (iff ==> dist n) (@uPred_pure M) | 1.
Proof. by intros φ1 φ2 ->. Qed.

219
Global Instance and_ne : NonExpansive2 (@uPred_and M).
220
Proof.
221
  intros n P P' HP Q Q' HQ; unseal; split=> x n' ??.
222 223 224 225
  split; (intros [??]; split; [by apply HP|by apply HQ]).
Qed.
Global Instance and_proper :
  Proper (() ==> () ==> ()) (@uPred_and M) := ne_proper_2 _.
226
Global Instance or_ne : NonExpansive2 (@uPred_or M).
227
Proof.
228
  intros n P P' HP Q Q' HQ; split=> x n' ??.
229 230 231 232
  unseal; split; (intros [?|?]; [left; by apply HP|right; by apply HQ]).
Qed.
Global Instance or_proper :
  Proper (() ==> () ==> ()) (@uPred_or M) := ne_proper_2 _.
233 234
Global Instance impl_ne :
  NonExpansive2 (@uPred_impl M).
235
Proof.
236
  intros n P P' HP Q Q' HQ; split=> x n' ??.
237 238 239 240
  unseal; split; intros HPQ x' n'' ????; apply HQ, HPQ, HP; auto.
Qed.
Global Instance impl_proper :
  Proper (() ==> () ==> ()) (@uPred_impl M) := ne_proper_2 _.
241
Global Instance sep_ne : NonExpansive2 (@uPred_sep M).
242
Proof.
243
  intros n P P' HP Q Q' HQ; split=> n' x ??.
244
  unseal; split; intros (x1&x2&?&?&?); ofe_subst x;
245 246 247 248 249
    exists x1, x2; split_and!; try (apply HP || apply HQ);
    eauto using cmra_validN_op_l, cmra_validN_op_r.
Qed.
Global Instance sep_proper :
  Proper (() ==> () ==> ()) (@uPred_sep M) := ne_proper_2 _.
250 251
Global Instance wand_ne :
  NonExpansive2 (@uPred_wand M).
252
Proof.
253
  intros n P P' HP Q Q' HQ; split=> n' x ??; unseal; split; intros HPQ x' n'' ???;
254 255 256 257
    apply HQ, HPQ, HP; eauto using cmra_validN_op_r.
Qed.
Global Instance wand_proper :
  Proper (() ==> () ==> ()) (@uPred_wand M) := ne_proper_2 _.
258 259
Global Instance internal_eq_ne (A : ofeT) :
  NonExpansive2 (@uPred_internal_eq M A).
260
Proof.
261
  intros n x x' Hx y y' Hy; split=> n' z; unseal; split; intros; simpl in *.
262 263 264
  - by rewrite -(dist_le _ _ _ _ Hx) -?(dist_le _ _ _ _ Hy); auto.
  - by rewrite (dist_le _ _ _ _ Hx) ?(dist_le _ _ _ _ Hy); auto.
Qed.
265
Global Instance internal_eq_proper (A : ofeT) :
266
  Proper (() ==> () ==> ()) (@uPred_internal_eq M A) := ne_proper_2 _.
267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290
Global Instance forall_ne A n :
  Proper (pointwise_relation _ (dist n) ==> dist n) (@uPred_forall M A).
Proof.
  by intros Ψ1 Ψ2 HΨ; unseal; split=> n' x; split; intros HP a; apply HΨ.
Qed.
Global Instance forall_proper A :
  Proper (pointwise_relation _ () ==> ()) (@uPred_forall M A).
Proof.
  by intros Ψ1 Ψ2 HΨ; unseal; split=> n' x; split; intros HP a; apply HΨ.
Qed.
Global Instance exist_ne A n :
  Proper (pointwise_relation _ (dist n) ==> dist n) (@uPred_exist M A).
Proof.
  intros Ψ1 Ψ2 HΨ.
  unseal; split=> n' x ??; split; intros [a ?]; exists a; by apply HΨ.
Qed.
Global Instance exist_proper A :
  Proper (pointwise_relation _ () ==> ()) (@uPred_exist M A).
Proof.
  intros Ψ1 Ψ2 HΨ.
  unseal; split=> n' x ?; split; intros [a ?]; exists a; by apply HΨ.
Qed.
Global Instance later_contractive : Contractive (@uPred_later M).
Proof.
291 292
  unseal; intros [|n] P Q HPQ; split=> -[|n'] x ?? //=; try omega.
  apply HPQ; eauto using cmra_validN_S.
293 294 295
Qed.
Global Instance later_proper' :
  Proper (() ==> ()) (@uPred_later M) := ne_proper _.
296
Global Instance always_ne : NonExpansive (@uPred_always M).
297
Proof.
298
  intros n P1 P2 HP.
299 300 301 302
  unseal; split=> n' x; split; apply HP; eauto using @cmra_core_validN.
Qed.
Global Instance always_proper :
  Proper (() ==> ()) (@uPred_always M) := ne_proper _.
303
Global Instance ownM_ne : NonExpansive (@uPred_ownM M).
304
Proof.
305
  intros n a b Ha.
306 307 308
  unseal; split=> n' x ? /=. by rewrite (dist_le _ _ _ _ Ha); last lia.
Qed.
Global Instance ownM_proper: Proper (() ==> ()) (@uPred_ownM M) := ne_proper _.
309 310
Global Instance cmra_valid_ne {A : cmraT} :
  NonExpansive (@uPred_cmra_valid M A).
311
Proof.
312
  intros n a b Ha; unseal; split=> n' x ? /=.
313 314 315 316
  by rewrite (dist_le _ _ _ _ Ha); last lia.
Qed.
Global Instance cmra_valid_proper {A : cmraT} :
  Proper (() ==> ()) (@uPred_cmra_valid M A) := ne_proper _.
317
Global Instance bupd_ne : NonExpansive (@uPred_bupd M).
318
Proof.
319
  intros n P Q HPQ.
320 321 322 323 324
  unseal; split=> n' x; split; intros HP k yf ??;
    destruct (HP k yf) as (x'&?&?); auto;
    exists x'; split; auto; apply HPQ; eauto using cmra_validN_op_l.
Qed.
Global Instance bupd_proper : Proper (() ==> ()) (@uPred_bupd M) := ne_proper _.
325 326 327 328
Global Instance uPred_valid_proper : Proper (() ==> iff) (@uPred_valid M).
Proof. solve_proper. Qed.
Global Instance uPred_valid_mono : Proper (() ==> impl) (@uPred_valid M).
Proof. solve_proper. Qed.
329 330 331
Global Instance uPred_valid_flip_mono :
  Proper (flip () ==> flip impl) (@uPred_valid M).
Proof. solve_proper. Qed.
332 333

(** Introduction and elimination rules *)
Ralf Jung's avatar
Ralf Jung committed
334
Lemma pure_intro φ P : φ  P  ⌜φ⌝.
335
Proof. by intros ?; unseal; split. Qed.
336
Lemma pure_elim' φ P : (φ  True  P)  ⌜φ⌝  P.
337
Proof. unseal; intros HP; split=> n x ??. by apply HP. Qed.
Ralf Jung's avatar
Ralf Jung committed
338
Lemma pure_forall_2 {A} (φ : A  Prop) : ( x : A, ⌜φ x)   x : A, φ x.
339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372
Proof. by unseal. Qed.

Lemma and_elim_l P Q : P  Q  P.
Proof. by unseal; split=> n x ? [??]. Qed.
Lemma and_elim_r P Q : P  Q  Q.
Proof. by unseal; split=> n x ? [??]. Qed.
Lemma and_intro P Q R : (P  Q)  (P  R)  P  Q  R.
Proof. intros HQ HR; unseal; split=> n x ??; by split; [apply HQ|apply HR]. Qed.

Lemma or_intro_l P Q : P  P  Q.
Proof. unseal; split=> n x ??; left; auto. Qed.
Lemma or_intro_r P Q : Q  P  Q.
Proof. unseal; split=> n x ??; right; auto. Qed.
Lemma or_elim P Q R : (P  R)  (Q  R)  P  Q  R.
Proof. intros HP HQ; unseal; split=> n x ? [?|?]. by apply HP. by apply HQ. Qed.

Lemma impl_intro_r P Q R : (P  Q  R)  P  Q  R.
Proof.
  unseal; intros HQ; split=> n x ?? n' x' ????. apply HQ;
    naive_solver eauto using uPred_mono, uPred_closed, cmra_included_includedN.
Qed.
Lemma impl_elim P Q R : (P  Q  R)  (P  Q)  P  R.
Proof. by unseal; intros HP HP'; split=> n x ??; apply HP with n x, HP'. Qed.

Lemma forall_intro {A} P (Ψ : A  uPred M): ( a, P  Ψ a)  P   a, Ψ a.
Proof. unseal; intros HPΨ; split=> n x ?? a; by apply HPΨ. Qed.
Lemma forall_elim {A} {Ψ : A  uPred M} a : ( a, Ψ a)  Ψ a.
Proof. unseal; split=> n x ? HP; apply HP. Qed.

Lemma exist_intro {A} {Ψ : A  uPred M} a : Ψ a   a, Ψ a.
Proof. unseal; split=> n x ??; by exists a. Qed.
Lemma exist_elim {A} (Φ : A  uPred M) Q : ( a, Φ a  Q)  ( a, Φ a)  Q.
Proof. unseal; intros HΦΨ; split=> n x ? [a ?]; by apply HΦΨ with a. Qed.

373
Lemma internal_eq_refl {A : ofeT} (a : A) : uPred_valid (M:=M) (a  a).
374
Proof. unseal; by split=> n x ??; simpl. Qed.
375
Lemma internal_eq_rewrite {A : ofeT} a b (Ψ : A  uPred M) P
376
  {HΨ : NonExpansive Ψ} : (P  a  b)  (P  Ψ a)  P  Ψ b.
377 378 379 380 381 382 383
Proof.
  unseal; intros Hab Ha; split=> n x ??. apply HΨ with n a; auto.
  - by symmetry; apply Hab with x.
  - by apply Ha.
Qed.

(* BI connectives *)
384
Lemma sep_mono P P' Q Q' : (P  Q)  (P'  Q')  P  P'  Q  Q'.
385 386
Proof.
  intros HQ HQ'; unseal.
387
  split; intros n' x ? (x1&x2&?&?&?); exists x1,x2; ofe_subst x;
388 389
    eauto 7 using cmra_validN_op_l, cmra_validN_op_r, uPred_in_entails.
Qed.
390
Lemma True_sep_1 P : P  True  P.
391 392 393
Proof.
  unseal; split; intros n x ??. exists (core x), x. by rewrite cmra_core_l.
Qed.
394
Lemma True_sep_2 P : True  P  P.
395
Proof.
396
  unseal; split; intros n x ? (x1&x2&?&_&?); ofe_subst;
397 398
    eauto using uPred_mono, cmra_includedN_r.
Qed.
399
Lemma sep_comm' P Q : P  Q  Q  P.
400 401 402
Proof.
  unseal; split; intros n x ? (x1&x2&?&?&?); exists x2, x1; by rewrite (comm op).
Qed.
403
Lemma sep_assoc' P Q R : (P  Q)  R  P  (Q  R).
404 405 406 407 408 409
Proof.
  unseal; split; intros n x ? (x1&x2&Hx&(y1&y2&Hy&?&?)&?).
  exists y1, (y2  x2); split_and?; auto.
  + by rewrite (assoc op) -Hy -Hx.
  + by exists y2, x2.
Qed.
410
Lemma wand_intro_r P Q R : (P  Q  R)  P  Q - R.
411 412 413 414 415
Proof.
  unseal=> HPQR; split=> n x ?? n' x' ???; apply HPQR; auto.
  exists x, x'; split_and?; auto.
  eapply uPred_closed with n; eauto using cmra_validN_op_l.
Qed.
416
Lemma wand_elim_l' P Q R : (P  Q - R)  P  Q  R.
417
Proof.
418
  unseal =>HPQR. split; intros n x ? (?&?&?&?&?). ofe_subst.
419 420 421 422 423 424 425 426 427 428 429
  eapply HPQR; eauto using cmra_validN_op_l.
Qed.

(* Always *)
Lemma always_mono P Q : (P  Q)   P   Q.
Proof. intros HP; unseal; split=> n x ? /=. by apply HP, cmra_core_validN. Qed.
Lemma always_elim P :  P  P.
Proof.
  unseal; split=> n x ? /=.
  eauto using uPred_mono, @cmra_included_core, cmra_included_includedN.
Qed.
430
Lemma always_idemp_2 P :  P    P.
431 432 433 434 435 436 437
Proof. unseal; split=> n x ?? /=. by rewrite cmra_core_idemp. Qed.

Lemma always_forall_2 {A} (Ψ : A  uPred M) : ( a,  Ψ a)  (  a, Ψ a).
Proof. by unseal. Qed.
Lemma always_exist_1 {A} (Ψ : A  uPred M) : (  a, Ψ a)  ( a,  Ψ a).
Proof. by unseal. Qed.

438
Lemma always_and_sep_l_1 P Q :  P  Q   P  Q.
439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458
Proof.
  unseal; split=> n x ? [??]; exists (core x), x; simpl in *.
  by rewrite cmra_core_l cmra_core_idemp.
Qed.

(* Later *)
Lemma later_mono P Q : (P  Q)   P   Q.
Proof.
  unseal=> HP; split=>-[|n] x ??; [done|apply HP; eauto using cmra_validN_S].
Qed.
Lemma löb P : ( P  P)  P.
Proof.
  unseal; split=> n x ? HP; induction n as [|n IH]; [by apply HP|].
  apply HP, IH, uPred_closed with (S n); eauto using cmra_validN_S.
Qed.
Lemma later_forall_2 {A} (Φ : A  uPred M) : ( a,  Φ a)    a, Φ a.
Proof. unseal; by split=> -[|n] x. Qed.
Lemma later_exist_false {A} (Φ : A  uPred M) :
  (  a, Φ a)   False  ( a,  Φ a).
Proof. unseal; split=> -[|[|n]] x /=; eauto. Qed.
459
Lemma later_sep P Q :  (P  Q)   P   Q.
460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480
Proof.
  unseal; split=> n x ?; split.
  - destruct n as [|n]; simpl.
    { by exists x, (core x); rewrite cmra_core_r. }
    intros (x1&x2&Hx&?&?); destruct (cmra_extend n x x1 x2)
      as (y1&y2&Hx'&Hy1&Hy2); eauto using cmra_validN_S; simpl in *.
    exists y1, y2; split; [by rewrite Hx'|by rewrite Hy1 Hy2].
  - destruct n as [|n]; simpl; [done|intros (x1&x2&Hx&?&?)].
    exists x1, x2; eauto using dist_S.
Qed.
Lemma later_false_excluded_middle P :  P   False  ( False  P).
Proof.
  unseal; split=> -[|n] x ? /= HP; [by left|right].
  intros [|n'] x' ????; [|done].
  eauto using uPred_closed, uPred_mono, cmra_included_includedN.
Qed.
Lemma always_later P :   P    P.
Proof. by unseal. Qed.

(* Own *)
Lemma ownM_op (a1 a2 : M) :
481
  uPred_ownM (a1  a2)  uPred_ownM a1  uPred_ownM a2.
482 483 484 485 486 487 488 489 490 491 492 493
Proof.
  unseal; split=> n x ?; split.
  - intros [z ?]; exists a1, (a2  z); split; [by rewrite (assoc op)|].
    split. by exists (core a1); rewrite cmra_core_r. by exists z.
  - intros (y1&y2&Hx&[z1 Hy1]&[z2 Hy2]); exists (z1  z2).
    by rewrite (assoc op _ z1) -(comm op z1) (assoc op z1)
      -(assoc op _ a2) (comm op z1) -Hy1 -Hy2.
Qed.
Lemma always_ownM_core (a : M) : uPred_ownM a   uPred_ownM (core a).
Proof.
  split=> n x /=; unseal; intros Hx. simpl. by apply cmra_core_monoN.
Qed.
494
Lemma ownM_empty : uPred_valid (M:=M) (uPred_ownM ).
495 496 497 498 499 500 501 502 503 504 505 506
Proof. unseal; split=> n x ??; by  exists x; rewrite left_id. Qed.
Lemma later_ownM a :  uPred_ownM a   b, uPred_ownM b   (a  b).
Proof.
  unseal; split=> -[|n] x /= ? Hax; first by eauto using ucmra_unit_leastN.
  destruct Hax as [y ?].
  destruct (cmra_extend n x a y) as (a'&y'&Hx&?&?); auto using cmra_validN_S.
  exists a'. rewrite Hx. eauto using cmra_includedN_l.
Qed.

(* Valid *)
Lemma ownM_valid (a : M) : uPred_ownM a   a.
Proof.
507
  unseal; split=> n x Hv [a' ?]; ofe_subst; eauto using cmra_validN_op_l.
508
Qed.
509
Lemma cmra_valid_intro {A : cmraT} (a : A) :  a  uPred_valid (M:=M) ( a).
510 511 512 513 514 515 516 517 518
Proof. unseal=> ?; split=> n x ? _ /=; by apply cmra_valid_validN. Qed.
Lemma cmra_valid_elim {A : cmraT} (a : A) : ¬ {0} a   a  False.
Proof. unseal=> Ha; split=> n x ??; apply Ha, cmra_validN_le with n; auto. Qed.
Lemma always_cmra_valid_1 {A : cmraT} (a : A) :  a    a.
Proof. by unseal. Qed.
Lemma cmra_valid_weaken {A : cmraT} (a b : A) :  (a  b)   a.
Proof. unseal; split=> n x _; apply cmra_validN_op_l. Qed.

(* Basic update modality *)
519
Lemma bupd_intro P : P == P.
520 521 522 523
Proof.
  unseal. split=> n x ? HP k yf ?; exists x; split; first done.
  apply uPred_closed with n; eauto using cmra_validN_op_l.
Qed.
524
Lemma bupd_mono P Q : (P  Q)  (|==> P) == Q.
525 526 527 528 529
Proof.
  unseal. intros HPQ; split=> n x ? HP k yf ??.
  destruct (HP k yf) as (x'&?&?); eauto.
  exists x'; split; eauto using uPred_in_entails, cmra_validN_op_l.
Qed.
530
Lemma bupd_trans P : (|==> |==> P) == P.
531
Proof. unseal; split; naive_solver. Qed.
532
Lemma bupd_frame_r P R : (|==> P)  R == P  R.
533 534 535 536 537 538 539 540 541
Proof.
  unseal; split; intros n x ? (x1&x2&Hx&HP&?) k yf ??.
  destruct (HP k (x2  yf)) as (x'&?&?); eauto.
  { by rewrite assoc -(dist_le _ _ _ _ Hx); last lia. }
  exists (x'  x2); split; first by rewrite -assoc.
  exists x', x2; split_and?; auto.
  apply uPred_closed with n; eauto 3 using cmra_validN_op_l, cmra_validN_op_r.
Qed.
Lemma bupd_ownM_updateP x (Φ : M  Prop) :
Ralf Jung's avatar
Ralf Jung committed
542
  x ~~>: Φ  uPred_ownM x ==  y, ⌜Φ y  uPred_ownM y.
543 544 545 546 547 548 549 550 551
Proof.
  unseal=> Hup; split=> n x2 ? [x3 Hx] k yf ??.
  destruct (Hup k (Some (x3  yf))) as (y&?&?); simpl in *.
  { rewrite /= assoc -(dist_le _ _ _ _ Hx); auto. }
  exists (y  x3); split; first by rewrite -assoc.
  exists y; eauto using cmra_includedN_l.
Qed.

(* Products *)
552
Lemma prod_equivI {A B : ofeT} (x y : A * B) : x  y  x.1  y.1  x.2  y.2.
553 554 555 556
Proof. by unseal. Qed.
Lemma prod_validI {A B : cmraT} (x : A * B) :  x   x.1   x.2.
Proof. by unseal. Qed.

557
(* Type-level Later *)
558
Lemma later_equivI {A : ofeT} (x y : A) : Next x  Next y   (x  y).
559 560 561
Proof. by unseal. Qed.

(* Discrete *)
Ralf Jung's avatar
Ralf Jung committed
562
Lemma discrete_valid {A : cmraT} `{!CMRADiscrete A} (a : A) :  a  ⌜✓ a.
563
Proof. unseal; split=> n x _. by rewrite /= -cmra_discrete_valid_iff. Qed.
Ralf Jung's avatar
Ralf Jung committed
564
Lemma timeless_eq {A : ofeT} (a b : A) : Timeless a  a  b  a  b.
565 566 567 568 569
Proof.
  unseal=> ?. apply (anti_symm ()); split=> n x ?; by apply (timeless_iff n).
Qed.

(* Option *)
570
Lemma option_equivI {A : ofeT} (mx my : option A) :
571 572 573 574 575 576 577 578 579 580
  mx  my  match mx, my with
             | Some x, Some y => x  y | None, None => True | _, _ => False
             end.
Proof.
  unseal. do 2 split. by destruct 1. by destruct mx, my; try constructor.
Qed.
Lemma option_validI {A : cmraT} (mx : option A) :
   mx  match mx with Some x =>  x | None => True end.
Proof. unseal. by destruct mx. Qed.

581 582
(* Contractive functions *)
Lemma contractiveI {A B : ofeT} (f : A  B) :
583
  Contractive f  ( a b,  (a  b)  f a  f b).
584 585
Proof.
  split; unseal; intros Hf.
586 587
  - intros a b; split=> n x _; apply Hf.
  - intros i a b; eapply Hf, ucmra_unit_validN.
588 589
Qed.

590 591 592
(* Functions *)
Lemma cofe_funC_equivI {A B} (f g : A -c> B) : f  g   x, f x  g x.
Proof. by unseal. Qed.
593
Lemma cofe_morC_equivI {A B : ofeT} (f g : A -n> B) : f  g   x, f x  g x.
594 595
Proof. by unseal. Qed.
End primitive.
596
End uPred.