cmra.v 49.7 KB
Newer Older
1
From iris.algebra Require Export cofe.
2

Robbert Krebbers's avatar
Robbert Krebbers committed
3 4
Class PCore (A : Type) := pcore : A  option A.
Instance: Params (@pcore) 2.
5 6 7 8 9 10 11 12 13

Class Op (A : Type) := op : A  A  A.
Instance: Params (@op) 2.
Infix "⋅" := op (at level 50, left associativity) : C_scope.
Notation "(⋅)" := op (only parsing) : C_scope.

Definition included `{Equiv A, Op A} (x y : A) :=  z, y  x  z.
Infix "≼" := included (at level 70) : C_scope.
Notation "(≼)" := included (only parsing) : C_scope.
14
Hint Extern 0 (_  _) => reflexivity.
15 16
Instance: Params (@included) 3.

Robbert Krebbers's avatar
Robbert Krebbers committed
17 18
Class ValidN (A : Type) := validN : nat  A  Prop.
Instance: Params (@validN) 3.
19
Notation "✓{ n } x" := (validN n x)
20
  (at level 20, n at next level, format "✓{ n }  x").
Robbert Krebbers's avatar
Robbert Krebbers committed
21

22 23
Class Valid (A : Type) := valid : A  Prop.
Instance: Params (@valid) 2.
24
Notation "✓ x" := (valid x) (at level 20) : C_scope.
25

26
Definition includedN `{Dist A, Op A} (n : nat) (x y : A) :=  z, y {n} x  z.
Robbert Krebbers's avatar
Robbert Krebbers committed
27
Notation "x ≼{ n } y" := (includedN n x y)
28
  (at level 70, n at next level, format "x  ≼{ n }  y") : C_scope.
Robbert Krebbers's avatar
Robbert Krebbers committed
29
Instance: Params (@includedN) 4.
30
Hint Extern 0 (_ {_} _) => reflexivity.
Robbert Krebbers's avatar
Robbert Krebbers committed
31

Robbert Krebbers's avatar
Robbert Krebbers committed
32
Record CMRAMixin A `{Dist A, Equiv A, PCore A, Op A, Valid A, ValidN A} := {
Robbert Krebbers's avatar
Robbert Krebbers committed
33
  (* setoids *)
34
  mixin_cmra_op_ne n (x : A) : Proper (dist n ==> dist n) (op x);
Robbert Krebbers's avatar
Robbert Krebbers committed
35 36
  mixin_cmra_pcore_ne n x y cx :
    x {n} y  pcore x = Some cx   cy, pcore y = Some cy  cx {n} cy;
37
  mixin_cmra_validN_ne n : Proper (dist n ==> impl) (validN n);
Robbert Krebbers's avatar
Robbert Krebbers committed
38
  (* valid *)
39
  mixin_cmra_valid_validN x :  x   n, {n} x;
40
  mixin_cmra_validN_S n x : {S n} x  {n} x;
Robbert Krebbers's avatar
Robbert Krebbers committed
41
  (* monoid *)
42 43
  mixin_cmra_assoc : Assoc () ();
  mixin_cmra_comm : Comm () ();
Robbert Krebbers's avatar
Robbert Krebbers committed
44 45 46 47
  mixin_cmra_pcore_l x cx : pcore x = Some cx  cx  x  x;
  mixin_cmra_pcore_idemp x cx : pcore x = Some cx  pcore cx  Some cx;
  mixin_cmra_pcore_preserving x y cx :
    x  y  pcore x = Some cx   cy, pcore y = Some cy  cx  cy;
48
  mixin_cmra_validN_op_l n x y : {n} (x  y)  {n} x;
49 50 51
  mixin_cmra_extend n x y1 y2 :
    {n} x  x {n} y1  y2 
    { z | x  z.1  z.2  z.1 {n} y1  z.2 {n} y2 }
Robbert Krebbers's avatar
Robbert Krebbers committed
52
}.
Robbert Krebbers's avatar
Robbert Krebbers committed
53

Robbert Krebbers's avatar
Robbert Krebbers committed
54 55 56 57 58 59
(** Bundeled version *)
Structure cmraT := CMRAT {
  cmra_car :> Type;
  cmra_equiv : Equiv cmra_car;
  cmra_dist : Dist cmra_car;
  cmra_compl : Compl cmra_car;
Robbert Krebbers's avatar
Robbert Krebbers committed
60
  cmra_pcore : PCore cmra_car;
Robbert Krebbers's avatar
Robbert Krebbers committed
61
  cmra_op : Op cmra_car;
62
  cmra_valid : Valid cmra_car;
Robbert Krebbers's avatar
Robbert Krebbers committed
63
  cmra_validN : ValidN cmra_car;
64
  cmra_cofe_mixin : CofeMixin cmra_car;
65
  cmra_mixin : CMRAMixin cmra_car
Robbert Krebbers's avatar
Robbert Krebbers committed
66
}.
67
Arguments CMRAT _ {_ _ _ _ _ _ _} _ _.
68 69 70 71
Arguments cmra_car : simpl never.
Arguments cmra_equiv : simpl never.
Arguments cmra_dist : simpl never.
Arguments cmra_compl : simpl never.
Robbert Krebbers's avatar
Robbert Krebbers committed
72
Arguments cmra_pcore : simpl never.
73
Arguments cmra_op : simpl never.
74
Arguments cmra_valid : simpl never.
75 76 77
Arguments cmra_validN : simpl never.
Arguments cmra_cofe_mixin : simpl never.
Arguments cmra_mixin : simpl never.
Robbert Krebbers's avatar
Robbert Krebbers committed
78
Add Printing Constructor cmraT.
Robbert Krebbers's avatar
Robbert Krebbers committed
79
Existing Instances cmra_pcore cmra_op cmra_valid cmra_validN.
80
Coercion cmra_cofeC (A : cmraT) : cofeT := CofeT A (cmra_cofe_mixin A).
Robbert Krebbers's avatar
Robbert Krebbers committed
81 82
Canonical Structure cmra_cofeC.

83 84 85 86 87 88
(** Lifting properties from the mixin *)
Section cmra_mixin.
  Context {A : cmraT}.
  Implicit Types x y : A.
  Global Instance cmra_op_ne n (x : A) : Proper (dist n ==> dist n) (op x).
  Proof. apply (mixin_cmra_op_ne _ (cmra_mixin A)). Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
89 90 91
  Lemma cmra_pcore_ne n x y cx :
    x {n} y  pcore x = Some cx   cy, pcore y = Some cy  cx {n} cy.
  Proof. apply (mixin_cmra_pcore_ne _ (cmra_mixin A)). Qed.
92 93
  Global Instance cmra_validN_ne n : Proper (dist n ==> impl) (@validN A _ n).
  Proof. apply (mixin_cmra_validN_ne _ (cmra_mixin A)). Qed.
94 95
  Lemma cmra_valid_validN x :  x   n, {n} x.
  Proof. apply (mixin_cmra_valid_validN _ (cmra_mixin A)). Qed.
96 97
  Lemma cmra_validN_S n x : {S n} x  {n} x.
  Proof. apply (mixin_cmra_validN_S _ (cmra_mixin A)). Qed.
98 99 100 101
  Global Instance cmra_assoc : Assoc () (@op A _).
  Proof. apply (mixin_cmra_assoc _ (cmra_mixin A)). Qed.
  Global Instance cmra_comm : Comm () (@op A _).
  Proof. apply (mixin_cmra_comm _ (cmra_mixin A)). Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
102 103 104 105 106 107 108
  Lemma cmra_pcore_l x cx : pcore x = Some cx  cx  x  x.
  Proof. apply (mixin_cmra_pcore_l _ (cmra_mixin A)). Qed.
  Lemma cmra_pcore_idemp x cx : pcore x = Some cx  pcore cx  Some cx.
  Proof. apply (mixin_cmra_pcore_idemp _ (cmra_mixin A)). Qed.
  Lemma cmra_pcore_preserving x y cx :
    x  y  pcore x = Some cx   cy, pcore y = Some cy  cx  cy.
  Proof. apply (mixin_cmra_pcore_preserving _ (cmra_mixin A)). Qed.
109 110
  Lemma cmra_validN_op_l n x y : {n} (x  y)  {n} x.
  Proof. apply (mixin_cmra_validN_op_l _ (cmra_mixin A)). Qed.
111
  Lemma cmra_extend n x y1 y2 :
112 113
    {n} x  x {n} y1  y2 
    { z | x  z.1  z.2  z.1 {n} y1  z.2 {n} y2 }.
114
  Proof. apply (mixin_cmra_extend _ (cmra_mixin A)). Qed.
115 116
End cmra_mixin.

Robbert Krebbers's avatar
Robbert Krebbers committed
117 118 119 120 121 122 123 124
Definition opM {A : cmraT} (x : A) (my : option A) :=
  match my with Some y => x  y | None => x end.
Infix "⋅?" := opM (at level 50, left associativity) : C_scope.

(** * Persistent elements *)
Class Persistent {A : cmraT} (x : A) := persistent : pcore x  Some x.
Arguments persistent {_} _ {_}.

125 126 127 128 129
(** * Exclusive elements (i.e., elements that cannot have a frame). *)
Class Exclusive {A : cmraT} (x : A) :=
  exclusiveN_r :  n y, {n} (x  y)  False.
Arguments exclusiveN_r {_} _ {_} _ _ _.

Robbert Krebbers's avatar
Robbert Krebbers committed
130 131 132 133 134 135 136 137 138 139 140
(** * CMRAs whose core is total *)
(** The function [core] may return a dummy when used on CMRAs without total
core. *)
Class CMRATotal (A : cmraT) := cmra_total (x : A) : is_Some (pcore x).

Class Core (A : Type) := core : A  A.
Instance: Params (@core) 2.

Instance core' `{PCore A} : Core A := λ x, from_option id x (pcore x).
Arguments core' _ _ _ /.

Ralf Jung's avatar
Ralf Jung committed
141
(** * CMRAs with a unit element *)
142
(** We use the notation ∅ because for most instances (maps, sets, etc) the
Ralf Jung's avatar
Ralf Jung committed
143
`empty' element is the unit. *)
Robbert Krebbers's avatar
Robbert Krebbers committed
144
Record UCMRAMixin A `{Dist A, Equiv A, PCore A, Op A, Valid A, Empty A} := {
145 146
  mixin_ucmra_unit_valid :  ;
  mixin_ucmra_unit_left_id : LeftId ()  ();
Robbert Krebbers's avatar
Robbert Krebbers committed
147 148
  mixin_ucmra_unit_timeless : Timeless ;
  mixin_ucmra_pcore_unit : pcore   Some 
149
}.
150 151 152 153 154 155

Structure ucmraT := UCMRAT {
  ucmra_car :> Type;
  ucmra_equiv : Equiv ucmra_car;
  ucmra_dist : Dist ucmra_car;
  ucmra_compl : Compl ucmra_car;
Robbert Krebbers's avatar
Robbert Krebbers committed
156
  ucmra_pcore : PCore ucmra_car;
157 158 159 160 161 162 163 164 165 166 167 168 169
  ucmra_op : Op ucmra_car;
  ucmra_valid : Valid ucmra_car;
  ucmra_validN : ValidN ucmra_car;
  ucmra_empty : Empty ucmra_car;
  ucmra_cofe_mixin : CofeMixin ucmra_car;
  ucmra_cmra_mixin : CMRAMixin ucmra_car;
  ucmra_mixin : UCMRAMixin ucmra_car
}.
Arguments UCMRAT _ {_ _ _ _ _ _ _ _} _ _ _.
Arguments ucmra_car : simpl never.
Arguments ucmra_equiv : simpl never.
Arguments ucmra_dist : simpl never.
Arguments ucmra_compl : simpl never.
Robbert Krebbers's avatar
Robbert Krebbers committed
170
Arguments ucmra_pcore : simpl never.
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
Arguments ucmra_op : simpl never.
Arguments ucmra_valid : simpl never.
Arguments ucmra_validN : simpl never.
Arguments ucmra_cofe_mixin : simpl never.
Arguments ucmra_cmra_mixin : simpl never.
Arguments ucmra_mixin : simpl never.
Add Printing Constructor ucmraT.
Existing Instances ucmra_empty.
Coercion ucmra_cofeC (A : ucmraT) : cofeT := CofeT A (ucmra_cofe_mixin A).
Canonical Structure ucmra_cofeC.
Coercion ucmra_cmraR (A : ucmraT) : cmraT :=
  CMRAT A (ucmra_cofe_mixin A) (ucmra_cmra_mixin A).
Canonical Structure ucmra_cmraR.

(** Lifting properties from the mixin *)
Section ucmra_mixin.
  Context {A : ucmraT}.
  Implicit Types x y : A.
  Lemma ucmra_unit_valid :  ( : A).
  Proof. apply (mixin_ucmra_unit_valid _ (ucmra_mixin A)). Qed.
  Global Instance ucmra_unit_left_id : LeftId ()  (@op A _).
  Proof. apply (mixin_ucmra_unit_left_id _ (ucmra_mixin A)). Qed.
  Global Instance ucmra_unit_timeless : Timeless ( : A).
  Proof. apply (mixin_ucmra_unit_timeless _ (ucmra_mixin A)). Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
195 196
  Lemma ucmra_pcore_unit : pcore (:A)  Some .
  Proof. apply (mixin_ucmra_pcore_unit _ (ucmra_mixin A)). Qed.
197
End ucmra_mixin.
198

199
(** * Discrete CMRAs *)
200
Class CMRADiscrete (A : cmraT) := {
201 202 203 204
  cmra_discrete :> Discrete A;
  cmra_discrete_valid (x : A) : {0} x   x
}.

Robbert Krebbers's avatar
Robbert Krebbers committed
205
(** * Morphisms *)
206
Class CMRAMonotone {A B : cmraT} (f : A  B) := {
Robbert Krebbers's avatar
Robbert Krebbers committed
207 208 209
  cmra_monotone_ne n :> Proper (dist n ==> dist n) f;
  validN_preserving n x : {n} x  {n} f x;
  included_preserving x y : x  y  f x  f y
210
}.
211 212
Arguments validN_preserving {_ _} _ {_} _ _ _.
Arguments included_preserving {_ _} _ {_} _ _ _.
213

214
(** * Local updates *)
Ralf Jung's avatar
Ralf Jung committed
215 216
(** The idea is that lemams taking this class will usually have L explicit,
    and leave Lv implicit - it will be inferred by the typeclass machinery. *)
217 218 219
Class LocalUpdate {A : cmraT} (Lv : A  Prop) (L : A  A) := {
  local_update_ne n :> Proper (dist n ==> dist n) L;
  local_updateN n x y : Lv x  {n} (x  y)  L (x  y) {n} L x  y
220 221 222
}.
Arguments local_updateN {_ _} _ {_} _ _ _ _ _.

223
(** * Frame preserving updates *)
Robbert Krebbers's avatar
Robbert Krebbers committed
224 225
Definition cmra_updateP {A : cmraT} (x : A) (P : A  Prop) :=  n mz,
  {n} (x ? mz)   y, P y  {n} (y ? mz).
226
Instance: Params (@cmra_updateP) 1.
227
Infix "~~>:" := cmra_updateP (at level 70).
Robbert Krebbers's avatar
Robbert Krebbers committed
228 229 230

Definition cmra_update {A : cmraT} (x y : A) :=  n mz,
  {n} (x ? mz)  {n} (y ? mz).
231
Infix "~~>" := cmra_update (at level 70).
232
Instance: Params (@cmra_update) 1.
Robbert Krebbers's avatar
Robbert Krebbers committed
233

Robbert Krebbers's avatar
Robbert Krebbers committed
234
(** * Properties **)
Robbert Krebbers's avatar
Robbert Krebbers committed
235
Section cmra.
236
Context {A : cmraT}.
Robbert Krebbers's avatar
Robbert Krebbers committed
237
Implicit Types x y z : A.
238
Implicit Types xs ys zs : list A.
Robbert Krebbers's avatar
Robbert Krebbers committed
239

240
(** ** Setoids *)
Robbert Krebbers's avatar
Robbert Krebbers committed
241 242 243 244 245 246 247 248 249
Global Instance cmra_pcore_ne' n : Proper (dist n ==> dist n) (@pcore A _).
Proof.
  intros x y Hxy. destruct (pcore x) as [cx|] eqn:?.
  { destruct (cmra_pcore_ne n x y cx) as (cy&->&->); auto. }
  destruct (pcore y) as [cy|] eqn:?; auto.
  destruct (cmra_pcore_ne n y x cy) as (cx&?&->); simplify_eq/=; auto.
Qed.
Lemma cmra_pcore_proper x y cx :
  x  y  pcore x = Some cx   cy, pcore y = Some cy  cx  cy.
250
Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
251 252 253
  intros. destruct (cmra_pcore_ne 0 x y cx) as (cy&?&?); auto.
  exists cy; split; [done|apply equiv_dist=> n].
  destruct (cmra_pcore_ne n x y cx) as (cy'&?&?); naive_solver.
254
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
255 256 257 258
Global Instance cmra_pcore_proper' : Proper (() ==> ()) (@pcore A _).
Proof. apply (ne_proper _). Qed.
Global Instance cmra_op_ne' n : Proper (dist n ==> dist n ==> dist n) (@op A _).
Proof. intros x1 x2 Hx y1 y2 Hy. by rewrite Hy (comm _ x1) Hx (comm _ y2). Qed.
259 260 261 262 263 264 265 266
Global Instance ra_op_proper' : Proper (() ==> () ==> ()) (@op A _).
Proof. apply (ne_proper_2 _). Qed.
Global Instance cmra_validN_ne' : Proper (dist n ==> iff) (@validN A _ n) | 1.
Proof. by split; apply cmra_validN_ne. Qed.
Global Instance cmra_validN_proper : Proper (() ==> iff) (@validN A _ n) | 1.
Proof. by intros n x1 x2 Hx; apply cmra_validN_ne', equiv_dist. Qed.

Global Instance cmra_valid_proper : Proper (() ==> iff) (@valid A _).
267 268 269 270
Proof.
  intros x y Hxy; rewrite !cmra_valid_validN.
  by split=> ? n; [rewrite -Hxy|rewrite Hxy].
Qed.
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288
Global Instance cmra_includedN_ne n :
  Proper (dist n ==> dist n ==> iff) (@includedN A _ _ n) | 1.
Proof.
  intros x x' Hx y y' Hy.
  by split; intros [z ?]; exists z; [rewrite -Hx -Hy|rewrite Hx Hy].
Qed.
Global Instance cmra_includedN_proper n :
  Proper (() ==> () ==> iff) (@includedN A _ _ n) | 1.
Proof.
  intros x x' Hx y y' Hy; revert Hx Hy; rewrite !equiv_dist=> Hx Hy.
  by rewrite (Hx n) (Hy n).
Qed.
Global Instance cmra_included_proper :
  Proper (() ==> () ==> iff) (@included A _ _) | 1.
Proof.
  intros x x' Hx y y' Hy.
  by split; intros [z ?]; exists z; [rewrite -Hx -Hy|rewrite Hx Hy].
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
289 290 291 292
Global Instance cmra_opM_ne n : Proper (dist n ==> dist n ==> dist n) (@opM A).
Proof. destruct 2; by cofe_subst. Qed.
Global Instance cmra_opM_proper : Proper (() ==> () ==> ()) (@opM A).
Proof. destruct 2; by setoid_subst. Qed.
293 294 295
Global Instance cmra_updateP_proper :
  Proper (() ==> pointwise_relation _ iff ==> iff) (@cmra_updateP A).
Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
296 297 298 299 300 301 302
  rewrite /pointwise_relation /cmra_updateP=> x x' Hx P P' HP;
    split=> ? n mz; setoid_subst; naive_solver.
Qed.
Global Instance cmra_update_proper :
  Proper (() ==> () ==> iff) (@cmra_update A).
Proof.
  rewrite /cmra_update=> x x' Hx y y' Hy; split=> ? n mz ?; setoid_subst; auto.
303
Qed.
304

Robbert Krebbers's avatar
Robbert Krebbers committed
305 306 307 308
(** ** Op *)
Lemma cmra_opM_assoc x y mz : (x  y) ? mz  x  (y ? mz).
Proof. destruct mz; by rewrite /= -?assoc. Qed.

309
(** ** Validity *)
Robbert Krebbers's avatar
Robbert Krebbers committed
310
Lemma cmra_validN_le n n' x : {n} x  n'  n  {n'} x.
311 312 313
Proof. induction 2; eauto using cmra_validN_S. Qed.
Lemma cmra_valid_op_l x y :  (x  y)   x.
Proof. rewrite !cmra_valid_validN; eauto using cmra_validN_op_l. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
314
Lemma cmra_validN_op_r n x y : {n} (x  y)  {n} y.
315
Proof. rewrite (comm _ x); apply cmra_validN_op_l. Qed.
316 317 318
Lemma cmra_valid_op_r x y :  (x  y)   y.
Proof. rewrite !cmra_valid_validN; eauto using cmra_validN_op_r. Qed.

Ralf Jung's avatar
Ralf Jung committed
319
(** ** Core *)
Robbert Krebbers's avatar
Robbert Krebbers committed
320 321 322 323 324 325 326 327
Lemma cmra_pcore_l' x cx : pcore x  Some cx  cx  x  x.
Proof. intros (cx'&?&->)%equiv_Some_inv_r'. by apply cmra_pcore_l. Qed.
Lemma cmra_pcore_r x cx : pcore x = Some cx  x  cx  x.
Proof. intros. rewrite comm. by apply cmra_pcore_l. Qed. 
Lemma cmra_pcore_r' x cx : pcore x  Some cx  x  cx  x.
Proof. intros (cx'&?&->)%equiv_Some_inv_r'. by apply cmra_pcore_r. Qed. 
Lemma cmra_pcore_idemp' x cx : pcore x  Some cx  pcore cx  Some cx.
Proof. intros (cx'&?&->)%equiv_Some_inv_r'. eauto using cmra_pcore_idemp. Qed. 
328 329 330 331
Lemma cmra_pcore_dup x cx : pcore x = Some cx  cx  cx  cx.
Proof. intros; symmetry; eauto using cmra_pcore_r', cmra_pcore_idemp. Qed.
Lemma cmra_pcore_dup' x cx : pcore x  Some cx  cx  cx  cx.
Proof. intros; symmetry; eauto using cmra_pcore_r', cmra_pcore_idemp'. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
332 333 334 335 336 337 338 339
Lemma cmra_pcore_validN n x cx : {n} x  pcore x = Some cx  {n} cx.
Proof.
  intros Hvx Hx%cmra_pcore_l. move: Hvx; rewrite -Hx. apply cmra_validN_op_l.
Qed.
Lemma cmra_pcore_valid x cx :  x  pcore x = Some cx   cx.
Proof.
  intros Hv Hx%cmra_pcore_l. move: Hv; rewrite -Hx. apply cmra_valid_op_l.
Qed.
340

341 342 343 344
(** ** Persistent elements *)
Lemma persistent_dup x `{!Persistent x} : x  x  x.
Proof. by apply cmra_pcore_dup' with x. Qed.

345 346 347 348 349 350 351 352 353
(** ** Exclusive elements *)
Lemma exclusiveN_l x `{!Exclusive x} :
   (n : nat) (y : A), {n} (y  x)  False.
Proof. intros ??. rewrite comm. by apply exclusiveN_r. Qed.
Lemma exclusive_r x `{!Exclusive x} :  (y : A),  (x  y)  False.
Proof. by intros ? ?%cmra_valid_validN%(exclusiveN_r _ 0). Qed.
Lemma exclusive_l x `{!Exclusive x} :  (y : A),  (y  x)  False.
Proof. by intros ? ?%cmra_valid_validN%(exclusiveN_l _ 0). Qed.

354
(** ** Order *)
Robbert Krebbers's avatar
Robbert Krebbers committed
355 356
Lemma cmra_included_includedN n x y : x  y  x {n} y.
Proof. intros [z ->]. by exists z. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
357
Global Instance cmra_includedN_trans n : Transitive (@includedN A _ _ n).
358
Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
359
  intros x y z [z1 Hy] [z2 Hz]; exists (z1  z2). by rewrite assoc -Hy -Hz.
360
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
361
Global Instance cmra_included_trans: Transitive (@included A _ _).
362
Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
363
  intros x y z [z1 Hy] [z2 Hz]; exists (z1  z2). by rewrite assoc -Hy -Hz.
364
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
365
Lemma cmra_validN_includedN n x y : {n} y  x {n} y  {n} x.
366
Proof. intros Hyv [z ?]; cofe_subst y; eauto using cmra_validN_op_l. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
367
Lemma cmra_validN_included n x y : {n} y  x  y  {n} x.
Robbert Krebbers's avatar
Robbert Krebbers committed
368
Proof. intros Hyv [z ?]; setoid_subst; eauto using cmra_validN_op_l. Qed.
369

Robbert Krebbers's avatar
Robbert Krebbers committed
370
Lemma cmra_includedN_S n x y : x {S n} y  x {n} y.
371
Proof. by intros [z Hz]; exists z; apply dist_S. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
372
Lemma cmra_includedN_le n n' x y : x {n} y  n'  n  x {n'} y.
373 374 375 376 377 378 379
Proof. induction 2; auto using cmra_includedN_S. Qed.

Lemma cmra_includedN_l n x y : x {n} x  y.
Proof. by exists y. Qed.
Lemma cmra_included_l x y : x  x  y.
Proof. by exists y. Qed.
Lemma cmra_includedN_r n x y : y {n} x  y.
380
Proof. rewrite (comm op); apply cmra_includedN_l. Qed.
381
Lemma cmra_included_r x y : y  x  y.
382
Proof. rewrite (comm op); apply cmra_included_l. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
383

Robbert Krebbers's avatar
Robbert Krebbers committed
384 385 386 387 388 389 390 391 392
Lemma cmra_pcore_preserving' x y cx :
  x  y  pcore x  Some cx   cy, pcore y = Some cy  cx  cy.
Proof.
  intros ? (cx'&?&Hcx)%equiv_Some_inv_r'.
  destruct (cmra_pcore_preserving x y cx') as (cy&->&?); auto.
  exists cy; by rewrite Hcx.
Qed.
Lemma cmra_pcore_preservingN' n x y cx :
  x {n} y  pcore x {n} Some cx   cy, pcore y = Some cy  cx {n} cy.
Robbert Krebbers's avatar
Robbert Krebbers committed
393
Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
394 395 396 397 398 399 400
  intros [z Hy] (cx'&?&Hcx)%dist_Some_inv_r'.
  destruct (cmra_pcore_preserving x (x  z) cx')
    as (cy&Hxy&?); auto using cmra_included_l.
  assert (pcore y {n} Some cy) as (cy'&?&Hcy')%dist_Some_inv_r'.
  { by rewrite Hy Hxy. }
  exists cy'; split; first done.
  rewrite Hcx -Hcy'; auto using cmra_included_includedN.
Robbert Krebbers's avatar
Robbert Krebbers committed
401
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
402 403
Lemma cmra_included_pcore x cx : pcore x = Some cx  cx  x.
Proof. exists x. by rewrite cmra_pcore_l. Qed.
404
Lemma cmra_preservingN_l n x y z : x {n} y  z  x {n} z  y.
405
Proof. by intros [z1 Hz1]; exists z1; rewrite Hz1 (assoc op). Qed.
406
Lemma cmra_preserving_l x y z : x  y  z  x  z  y.
407
Proof. by intros [z1 Hz1]; exists z1; rewrite Hz1 (assoc op). Qed.
408
Lemma cmra_preservingN_r n x y z : x {n} y  x  z {n} y  z.
409
Proof. by intros; rewrite -!(comm _ z); apply cmra_preservingN_l. Qed.
410
Lemma cmra_preserving_r x y z : x  y  x  z  y  z.
411
Proof. by intros; rewrite -!(comm _ z); apply cmra_preserving_l. Qed.
412

Robbert Krebbers's avatar
Robbert Krebbers committed
413
Lemma cmra_included_dist_l n x1 x2 x1' :
414
  x1  x2  x1' {n} x1   x2', x1'  x2'  x2' {n} x2.
Robbert Krebbers's avatar
Robbert Krebbers committed
415
Proof.
416 417
  intros [z Hx2] Hx1; exists (x1'  z); split; auto using cmra_included_l.
  by rewrite Hx1 Hx2.
Robbert Krebbers's avatar
Robbert Krebbers committed
418
Qed.
419

Robbert Krebbers's avatar
Robbert Krebbers committed
420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448
(** ** Total core *)
Section total_core.
  Context `{CMRATotal A}.

  Lemma cmra_core_l x : core x  x  x.
  Proof.
    destruct (cmra_total x) as [cx Hcx]. by rewrite /core /= Hcx cmra_pcore_l.
  Qed.
  Lemma cmra_core_idemp x : core (core x)  core x.
  Proof.
    destruct (cmra_total x) as [cx Hcx]. by rewrite /core /= Hcx cmra_pcore_idemp.
  Qed.
  Lemma cmra_core_preserving x y : x  y  core x  core y.
  Proof.
    intros; destruct (cmra_total x) as [cx Hcx].
    destruct (cmra_pcore_preserving x y cx) as (cy&Hcy&?); auto.
    by rewrite /core /= Hcx Hcy.
  Qed.

  Global Instance cmra_core_ne n : Proper (dist n ==> dist n) (@core A _).
  Proof.
    intros x y Hxy. destruct (cmra_total x) as [cx Hcx].
    by rewrite /core /= -Hxy Hcx.
  Qed.
  Global Instance cmra_core_proper : Proper (() ==> ()) (@core A _).
  Proof. apply (ne_proper _). Qed.

  Lemma cmra_core_r x : x  core x  x.
  Proof. by rewrite (comm _ x) cmra_core_l. Qed.
449 450
  Lemma cmra_core_dup x : core x  core x  core x.
  Proof. by rewrite -{3}(cmra_core_idemp x) cmra_core_r. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487
  Lemma cmra_core_validN n x : {n} x  {n} core x.
  Proof. rewrite -{1}(cmra_core_l x); apply cmra_validN_op_l. Qed.
  Lemma cmra_core_valid x :  x   core x.
  Proof. rewrite -{1}(cmra_core_l x); apply cmra_valid_op_l. Qed.

  Lemma persistent_total x : Persistent x  core x  x.
  Proof.
    split; [intros; by rewrite /core /= (persistent x)|].
    rewrite /Persistent /core /=.
    destruct (cmra_total x) as [? ->]. by constructor.
  Qed.
  Lemma persistent_core x `{!Persistent x} : core x  x.
  Proof. by apply persistent_total. Qed.

  Global Instance cmra_core_persistent x : Persistent (core x).
  Proof.
    destruct (cmra_total x) as [cx Hcx].
    rewrite /Persistent /core /= Hcx /=. eauto using cmra_pcore_idemp.
  Qed.

  Lemma cmra_included_core x : core x  x.
  Proof. by exists x; rewrite cmra_core_l. Qed.
  Global Instance cmra_includedN_preorder n : PreOrder (@includedN A _ _ n).
  Proof.
    split; [|apply _]. by intros x; exists (core x); rewrite cmra_core_r.
  Qed.
  Global Instance cmra_included_preorder : PreOrder (@included A _ _).
  Proof.
    split; [|apply _]. by intros x; exists (core x); rewrite cmra_core_r.
  Qed.
  Lemma cmra_core_preservingN n x y : x {n} y  core x {n} core y.
  Proof.
    intros [z ->].
    apply cmra_included_includedN, cmra_core_preserving, cmra_included_l.
  Qed.
End total_core.

Robbert Krebbers's avatar
Robbert Krebbers committed
488
(** ** Timeless *)
489
Lemma cmra_timeless_included_l x y : Timeless x  {0} y  x {0} y  x  y.
Robbert Krebbers's avatar
Robbert Krebbers committed
490 491
Proof.
  intros ?? [x' ?].
492
  destruct (cmra_extend 0 y x x') as ([z z']&Hy&Hz&Hz'); auto; simpl in *.
Robbert Krebbers's avatar
Robbert Krebbers committed
493
  by exists z'; rewrite Hy (timeless x z).
Robbert Krebbers's avatar
Robbert Krebbers committed
494
Qed.
495
Lemma cmra_timeless_included_r n x y : Timeless y  x {0} y  x {n} y.
Robbert Krebbers's avatar
Robbert Krebbers committed
496
Proof. intros ? [x' ?]. exists x'. by apply equiv_dist, (timeless y). Qed.
497
Lemma cmra_op_timeless x1 x2 :
Robbert Krebbers's avatar
Robbert Krebbers committed
498
   (x1  x2)  Timeless x1  Timeless x2  Timeless (x1  x2).
Robbert Krebbers's avatar
Robbert Krebbers committed
499 500
Proof.
  intros ??? z Hz.
501
  destruct (cmra_extend 0 z x1 x2) as ([y1 y2]&Hz'&?&?); auto; simpl in *.
502
  { rewrite -?Hz. by apply cmra_valid_validN. }
Robbert Krebbers's avatar
Robbert Krebbers committed
503
  by rewrite Hz' (timeless x1 y1) // (timeless x2 y2).
Robbert Krebbers's avatar
Robbert Krebbers committed
504
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
505

506 507 508 509 510 511 512 513
(** ** Discrete *)
Lemma cmra_discrete_valid_iff `{CMRADiscrete A} n x :  x  {n} x.
Proof.
  split; first by rewrite cmra_valid_validN.
  eauto using cmra_discrete_valid, cmra_validN_le with lia.
Qed.
Lemma cmra_discrete_included_iff `{Discrete A} n x y : x  y  x {n} y.
Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
514
  split; first by apply cmra_included_includedN.
515 516 517
  intros [z ->%(timeless_iff _ _)]; eauto using cmra_included_l.
Qed.

518
(** ** Local updates *)
519 520
Global Instance local_update_proper Lv (L : A  A) :
  LocalUpdate Lv L  Proper (() ==> ()) L.
521 522
Proof. intros; apply (ne_proper _). Qed.

523 524
Lemma local_update L `{!LocalUpdate Lv L} x y :
  Lv x   (x  y)  L (x  y)  L x  y.
525 526 527
Proof.
  by rewrite cmra_valid_validN equiv_dist=>?? n; apply (local_updateN L).
Qed.
528 529

Global Instance local_update_op x : LocalUpdate (λ _, True) (op x).
530
Proof. split. apply _. by intros n y1 y2 _ _; rewrite assoc. Qed.
531

Ralf Jung's avatar
Ralf Jung committed
532 533 534
Global Instance local_update_id : LocalUpdate (λ _, True) (@id A).
Proof. split; auto with typeclass_instances. Qed.

535 536 537 538
Global Instance exclusive_local_update y :
  LocalUpdate Exclusive (λ _, y) | 1000.
Proof. split. apply _. by intros ??? H ?%H. Qed.

539
(** ** Updates *)
540
Lemma cmra_update_updateP x y : x ~~> y  x ~~>: (y =).
Robbert Krebbers's avatar
Robbert Krebbers committed
541
Proof. split=> Hup n z ?; eauto. destruct (Hup n z) as (?&<-&?); auto. Qed.
542
Lemma cmra_updateP_id (P : A  Prop) x : P x  x ~~>: P.
Robbert Krebbers's avatar
Robbert Krebbers committed
543
Proof. intros ? n mz ?; eauto. Qed.
544
Lemma cmra_updateP_compose (P Q : A  Prop) x :
545
  x ~~>: P  ( y, P y  y ~~>: Q)  x ~~>: Q.
Robbert Krebbers's avatar
Robbert Krebbers committed
546
Proof. intros Hx Hy n mz ?. destruct (Hx n mz) as (y&?&?); naive_solver. Qed.
547 548 549
Lemma cmra_updateP_compose_l (Q : A  Prop) x y : x ~~> y  y ~~>: Q  x ~~>: Q.
Proof.
  rewrite cmra_update_updateP.
Robbert Krebbers's avatar
Robbert Krebbers committed
550
  intros; apply cmra_updateP_compose with (y =); naive_solver.
551
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
552 553
Lemma cmra_updateP_weaken (P Q : A  Prop) x :
  x ~~>: P  ( y, P y  Q y)  x ~~>: Q.
554
Proof. eauto using cmra_updateP_compose, cmra_updateP_id. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
555 556 557 558 559 560 561
Global Instance cmra_update_preorder : PreOrder (@cmra_update A).
Proof.
  split.
  - intros x. by apply cmra_update_updateP, cmra_updateP_id.
  - intros x y z. rewrite !cmra_update_updateP.
    eauto using cmra_updateP_compose with subst.
Qed.
562 563 564
Lemma cmra_update_exclusive `{!Exclusive x} y:
   y  x ~~> y.
Proof. move=>??[z|]=>[/exclusiveN_r[]|_]. by apply cmra_valid_validN. Qed.
565

566
Lemma cmra_updateP_op (P1 P2 Q : A  Prop) x1 x2 :
Robbert Krebbers's avatar
Robbert Krebbers committed
567 568
  x1 ~~>: P1  x2 ~~>: P2  ( y1 y2, P1 y1  P2 y2  Q (y1  y2)) 
  x1  x2 ~~>: Q.
569
Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
570 571 572 573 574 575
  intros Hx1 Hx2 Hy n mz ?.
  destruct (Hx1 n (Some (x2 ? mz))) as (y1&?&?).
  { by rewrite /= -cmra_opM_assoc. }
  destruct (Hx2 n (Some (y1 ? mz))) as (y2&?&?).
  { by rewrite /= -cmra_opM_assoc (comm _ x2) cmra_opM_assoc. }
  exists (y1  y2); split; last rewrite (comm _ y1) cmra_opM_assoc; auto.
576
Qed.
577
Lemma cmra_updateP_op' (P1 P2 : A  Prop) x1 x2 :
Robbert Krebbers's avatar
Robbert Krebbers committed
578 579
  x1 ~~>: P1  x2 ~~>: P2 
  x1  x2 ~~>: λ y,  y1 y2, y = y1  y2  P1 y1  P2 y2.
580
Proof. eauto 10 using cmra_updateP_op. Qed.
581
Lemma cmra_update_op x1 x2 y1 y2 : x1 ~~> y1  x2 ~~> y2  x1  x2 ~~> y1  y2.
582
Proof.
583
  rewrite !cmra_update_updateP; eauto using cmra_updateP_op with congruence.
584
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614

Section total_updates.
  Context `{CMRATotal A}.

  Lemma cmra_total_updateP x (P : A  Prop) :
    x ~~>: P   n z, {n} (x  z)   y, P y  {n} (y  z).
  Proof.
    split=> Hup; [intros n z; apply (Hup n (Some z))|].
    intros n [z|] ?; simpl; [by apply Hup|].
    destruct (Hup n (core x)) as (y&?&?); first by rewrite cmra_core_r.
    eauto using cmra_validN_op_l.
  Qed.
  Lemma cmra_total_update x y : x ~~> y   n z, {n} (x  z)  {n} (y  z).
  Proof. rewrite cmra_update_updateP cmra_total_updateP. naive_solver. Qed.

  Context `{CMRADiscrete A}.

  Lemma cmra_discrete_updateP (x : A) (P : A  Prop) :
    x ~~>: P   z,  (x  z)   y, P y   (y  z).
  Proof.
    rewrite cmra_total_updateP; setoid_rewrite <-cmra_discrete_valid_iff.
    naive_solver eauto using 0.
  Qed.
  Lemma cmra_discrete_update `{CMRADiscrete A} (x y : A) :
    x ~~> y   z,  (x  z)   (y  z).
  Proof.
    rewrite cmra_total_update; setoid_rewrite <-cmra_discrete_valid_iff.
    naive_solver eauto using 0.
  Qed.
End total_updates.
Robbert Krebbers's avatar
Robbert Krebbers committed
615 616
End cmra.

617 618
(** * Properties about CMRAs with a unit element **)
Section ucmra.
Robbert Krebbers's avatar
Robbert Krebbers committed
619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639
  Context {A : ucmraT}.
  Implicit Types x y z : A.

  Global Instance ucmra_unit_inhabited : Inhabited A := populate .

  Lemma ucmra_unit_validN n : {n} (:A).
  Proof. apply cmra_valid_validN, ucmra_unit_valid. Qed.
  Lemma ucmra_unit_leastN n x :  {n} x.
  Proof. by exists x; rewrite left_id. Qed.
  Lemma ucmra_unit_least x :   x.
  Proof. by exists x; rewrite left_id. Qed.
  Global Instance ucmra_unit_right_id : RightId ()  (@op A _).
  Proof. by intros x; rewrite (comm op) left_id. Qed.
  Global Instance ucmra_unit_persistent : Persistent (:A).
  Proof. apply ucmra_pcore_unit. Qed.

  Global Instance cmra_unit_total : CMRATotal A.
  Proof.
    intros x. destruct (cmra_pcore_preserving'  x ) as (cx&->&?);
      eauto using ucmra_unit_least, (persistent ).
  Qed.
640

Robbert Krebbers's avatar
Robbert Krebbers committed
641 642 643 644 645 646
  Lemma ucmra_update_unit x : x ~~> .
  Proof.
    apply cmra_total_update=> n z. rewrite left_id; apply cmra_validN_op_r.
  Qed.
  Lemma ucmra_update_unit_alt y :  ~~> y   x, x ~~> y.
  Proof. split; [intros; trans |]; auto using ucmra_update_unit. Qed.
647
End ucmra.
Robbert Krebbers's avatar
Robbert Krebbers committed
648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679
Hint Immediate cmra_unit_total.

(** * Constructing a CMRA with total core *)
Section cmra_total.
  Context A `{Dist A, Equiv A, PCore A, Op A, Valid A, ValidN A}.
  Context (total :  x, is_Some (pcore x)).
  Context (op_ne :  n (x : A), Proper (dist n ==> dist n) (op x)).
  Context (core_ne :  n, Proper (dist n ==> dist n) (@core A _)).
  Context (validN_ne :  n, Proper (dist n ==> impl) (@validN A _ n)).
  Context (valid_validN :  (x : A),  x   n, {n} x).
  Context (validN_S :  n (x : A), {S n} x  {n} x).
  Context (op_assoc : Assoc () (@op A _)).
  Context (op_comm : Comm () (@op A _)).
  Context (core_l :  x : A, core x  x  x).
  Context (core_idemp :  x : A, core (core x)  core x).
  Context (core_preserving :  x y : A, x  y  core x  core y).
  Context (validN_op_l :  n (x y : A), {n} (x  y)  {n} x).
  Context (extend :  n (x y1 y2 : A),
    {n} x  x {n} y1  y2 
    { z | x  z.1  z.2  z.1 {n} y1  z.2 {n} y2 }).
  Lemma cmra_total_mixin : CMRAMixin A.
  Proof.
    split; auto.
    - intros n x y ? Hcx%core_ne Hx; move: Hcx. rewrite /core /= Hx /=.
      case (total y)=> [cy ->]; eauto.
    - intros x cx Hcx. move: (core_l x). by rewrite /core /= Hcx.
    - intros x cx Hcx. move: (core_idemp x). rewrite /core /= Hcx /=.
      case (total cx)=>[ccx ->]; by constructor.
    - intros x y cx Hxy%core_preserving Hx. move: Hxy.
      rewrite /core /= Hx /=. case (total y)=> [cy ->]; eauto.
  Qed.
End cmra_total.
680

681
(** * Properties about monotone functions *)
682
Instance cmra_monotone_id {A : cmraT} : CMRAMonotone (@id A).
Robbert Krebbers's avatar
Robbert Krebbers committed
683
Proof. repeat split; by try apply _. Qed.
684 685
Instance cmra_monotone_compose {A B C : cmraT} (f : A  B) (g : B  C) :
  CMRAMonotone f  CMRAMonotone g  CMRAMonotone (g  f).
Robbert Krebbers's avatar
Robbert Krebbers committed
686 687
Proof.
  split.
Robbert Krebbers's avatar
Robbert Krebbers committed
688
  - apply _. 
689
  - move=> n x Hx /=. by apply validN_preserving, validN_preserving.
Robbert Krebbers's avatar
Robbert Krebbers committed
690
  - move=> x y Hxy /=. by apply included_preserving, included_preserving.
Robbert Krebbers's avatar
Robbert Krebbers committed
691
Qed.
692

693 694
Section cmra_monotone.
  Context {A B : cmraT} (f : A  B) `{!CMRAMonotone f}.
Robbert Krebbers's avatar
Robbert Krebbers committed
695 696
  Global Instance cmra_monotone_proper : Proper (() ==> ()) f := ne_proper _.
  Lemma includedN_preserving n x y : x {n} y  f x {n} f y.
697
  Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
698
    intros [z ->].
699
    apply cmra_included_includedN, (included_preserving f), cmra_included_l.
700
  Qed.
701
  Lemma valid_preserving x :  x   f x.
702 703 704
  Proof. rewrite !cmra_valid_validN; eauto using validN_preserving. Qed.
End cmra_monotone.

705 706
(** Functors *)
Structure rFunctor := RFunctor {
707
  rFunctor_car : cofeT  cofeT  cmraT;
708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734
  rFunctor_map {A1 A2 B1 B2} :
    ((A2 -n> A1) * (B1 -n> B2))  rFunctor_car A1 B1 -n> rFunctor_car A2 B2;
  rFunctor_ne A1 A2 B1 B2 n :
    Proper (dist n ==> dist n) (@rFunctor_map A1 A2 B1 B2);
  rFunctor_id {A B} (x : rFunctor_car A B) : rFunctor_map (cid,cid) x  x;
  rFunctor_compose {A1 A2 A3 B1 B2 B3}
      (f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x :
    rFunctor_map (fg, g'f') x  rFunctor_map (g,g') (rFunctor_map (f,f') x);
  rFunctor_mono {A1 A2 B1 B2} (fg : (A2 -n> A1) * (B1 -n> B2)) :
    CMRAMonotone (rFunctor_map fg) 
}.
Existing Instances rFunctor_ne rFunctor_mono.
Instance: Params (@rFunctor_map) 5.

Class rFunctorContractive (F : rFunctor) :=
  rFunctor_contractive A1 A2 B1 B2 :> Contractive (@rFunctor_map F A1 A2 B1 B2).

Definition rFunctor_diag (F: rFunctor) (A: cofeT) : cmraT := rFunctor_car F A A.
Coercion rFunctor_diag : rFunctor >-> Funclass.

Program Definition constRF (B : cmraT) : rFunctor :=
  {| rFunctor_car A1 A2 := B; rFunctor_map A1 A2 B1 B2 f := cid |}.
Solve Obligations with done.

Instance constRF_contractive B : rFunctorContractive (constRF B).
Proof. rewrite /rFunctorContractive; apply _. Qed.

735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763
Structure urFunctor := URFunctor {
  urFunctor_car : cofeT  cofeT  ucmraT;
  urFunctor_map {A1 A2 B1 B2} :
    ((A2 -n> A1) * (B1 -n> B2))  urFunctor_car A1 B1 -n> urFunctor_car A2 B2;
  urFunctor_ne A1 A2 B1 B2 n :
    Proper (dist n ==> dist n) (@urFunctor_map A1 A2 B1 B2);
  urFunctor_id {A B} (x : urFunctor_car A B) : urFunctor_map (cid,cid) x  x;
  urFunctor_compose {A1 A2 A3 B1 B2 B3}
      (f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x :
    urFunctor_map (fg, g'f') x  urFunctor_map (g,g') (urFunctor_map (f,f') x);
  urFunctor_mono {A1 A2 B1 B2} (fg : (A2 -n> A1) * (B1 -n> B2)) :
    CMRAMonotone (urFunctor_map fg) 
}.
Existing Instances urFunctor_ne urFunctor_mono.
Instance: Params (@urFunctor_map) 5.

Class urFunctorContractive (F : urFunctor) :=
  urFunctor_contractive A1 A2 B1 B2 :> Contractive (@urFunctor_map F A1 A2 B1 B2).

Definition urFunctor_diag (F: urFunctor) (A: cofeT) : ucmraT := urFunctor_car F A A.
Coercion urFunctor_diag : urFunctor >-> Funclass.

Program Definition constURF (B : ucmraT) : urFunctor :=
  {| urFunctor_car A1 A2 := B; urFunctor_map A1 A2 B1 B2 f := cid |}.
Solve Obligations with done.

Instance constURF_contractive B : urFunctorContractive (constURF B).
Proof. rewrite /urFunctorContractive; apply _. Qed.

764 765 766 767 768 769 770 771 772 773 774 775 776
(** * Transporting a CMRA equality *)
Definition cmra_transport {A B : cmraT} (H : A = B) (x : A) : B :=
  eq_rect A id x _ H.

Section cmra_transport.
  Context {A B : cmraT} (H : A = B).
  Notation T := (cmra_transport H).
  Global Instance cmra_transport_ne n : Proper (dist n ==> dist n) T.
  Proof. by intros ???; destruct H. Qed.
  Global Instance cmra_transport_proper : Proper (() ==> ()) T.
  Proof. by intros ???; destruct H. Qed.
  Lemma cmra_transport_op x y : T (x  y) = T x  T y.
  Proof. by destruct H. Qed.
Ralf Jung's avatar
Ralf Jung committed
777
  Lemma cmra_transport_core x : T (core x) = core (T x).
778
  Proof. by destruct H. Qed.
779
  Lemma cmra_transport_validN n x : {n} T x  {n} x.
780
  Proof. by destruct H. Qed.
781
  Lemma cmra_transport_valid x :  T x   x.
782 783 784
  Proof. by destruct H. Qed.
  Global Instance cmra_transport_timeless x : Timeless x  Timeless (T x).
  Proof. by destruct H. Qed.
785 786
  Global Instance cmra_transport_persistent x : Persistent x  Persistent (T x).
  Proof. by destruct H. Qed.
787 788 789 790 791 792 793 794
  Lemma cmra_transport_updateP (P : A  Prop) (Q : B  Prop) x :
    x ~~>: P  ( y, P y  Q (T y))  T x ~~>: Q.
  Proof. destruct H; eauto using cmra_updateP_weaken. Qed.
  Lemma cmra_transport_updateP' (P : A  Prop) x :
    x ~~>: P  T x ~~>: λ y,  y', y = cmra_transport H y'  P y'.
  Proof. eauto using cmra_transport_updateP. Qed.
End cmra_transport.

795 796
(** * Instances *)
(** ** Discrete CMRA *)
Robbert Krebbers's avatar
Robbert Krebbers committed
797
Record RAMixin A `{Equiv A, PCore A, Op A, Valid A} := {
798
  (* setoids *)
Robbert Krebbers's avatar
Robbert Krebbers committed
799 800 801 802
  ra_op_proper (x : A) : Proper (() ==> ()) (op x);
  ra_core_proper x y cx :
    x  y  pcore x = Some cx   cy, pcore y = Some cy  cx  cy;
  ra_validN_proper : Proper (() ==> impl) valid;
803
  (* monoid *)
804 805
  ra_assoc : Assoc () ();
  ra_comm : Comm () ();
Robbert Krebbers's avatar
Robbert Krebbers committed
806 807 808 809
  ra_pcore_l x cx : pcore x = Some cx  cx  x  x;
  ra_pcore_idemp x cx : pcore x = Some cx  pcore cx  Some cx;
  ra_pcore_preserving x y cx :
    x  y  pcore x = Some cx   cy, pcore y = Some cy  cx  cy;
Robbert Krebbers's avatar
Robbert Krebbers committed
810
  ra_valid_op_l x y :  (x  y)   x
811 812
}.

813
Section discrete.
Robbert Krebbers's avatar
Robbert Krebbers committed
814
  Context `{Equiv A, PCore A, Op A, Valid A, @Equivalence A ()}.
815 816
  Context (ra_mix : RAMixin A).
  Existing Instances discrete_dist discrete_compl.
817

818
  Instance discrete_validN : ValidN A := λ n x,  x.
819
  Definition discrete_cmra_mixin : CMRAMixin A.
820
  Proof.
821
    destruct ra_mix; split; try done.
822
    - intros x; split; first done. by move=> /(_ 0).
823
    - intros n x y1 y2 ??; by exists (y1,y2).
824 825 826
  Qed.
End discrete.

827 828 829 830 831
Notation discreteR A ra_mix :=
  (CMRAT A discrete_cofe_mixin (discrete_cmra_mixin ra_mix)).
Notation discreteLeibnizR A ra_mix :=
  (CMRAT A (@discrete_cofe_mixin _ equivL _) (discrete_cmra_mixin ra_mix)).

Robbert Krebbers's avatar
Robbert Krebbers committed
832
Global Instance discrete_cmra_discrete `{Equiv A, PCore A, Op A, Valid A,
833 834 835
  @Equivalence A ()} (ra_mix : RAMixin A) : CMRADiscrete (discreteR A ra_mix).
Proof. split. apply _. done. Qed.

Robbert Krebbers's avatar
Robbert Krebbers committed
836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860
Section ra_total.
  Context A `{Equiv A, PCore A, Op A, Valid A}.
  Context (total :  x, is_Some (pcore x)).
  Context (op_proper :  (x : A), Proper (() ==> ()) (op x)).
  Context (core_proper: Proper (() ==> ()) (@core A _)).
  Context (valid_proper : Proper (() ==> impl) (@valid A _)).
  Context (op_assoc : Assoc () (@op A _)).
  Context (op_comm : Comm () (@op A _)).
  Context (core_l :  x : A, core x  x  x).
  Context (core_idemp :  x : A, core (core x)  core x).
  Context (core_preserving :  x y : A, x  y  core x  core y).
  Context (valid_op_l :  x y : A,  (x  y)   x).
  Lemma ra_total_mixin : RAMixin A.
  Proof.
    split; auto.
    - intros x y ? Hcx%core_proper Hx; move: Hcx. rewrite /core /= Hx /=.
      case (total y)=> [cy ->]; eauto.
    - intros x cx Hcx. move: (core_l x). by rewrite /core /= Hcx.
    - intros x cx Hcx. move: (core_idemp x). rewrite /core /= Hcx /=.
      case (total cx)=>[ccx ->]; by constructor.
    - intros x y cx Hxy%core_preserving Hx. move: Hxy.
      rewrite /core /= Hx /=. case (total y)=> [cy ->]; eauto.
  Qed.
End ra_total.

861 862 863
(** ** CMRA for the unit type *)
Section unit.
  Instance unit_valid : Valid () := λ x, True.
864
  Instance unit_validN : ValidN () := λ n x, True.
Robbert Krebbers's avatar
Robbert Krebbers committed
865
  Instance unit_pcore : PCore () := λ x, Some x.
866
  Instance unit_op : Op () := λ x y, ().
867
  Lemma unit_cmra_mixin : CMRAMixin ().
Robbert Krebbers's avatar
Robbert Krebbers committed
868
  Proof. apply cmra_total_mixin; try done. eauto. by exists ((),()). Qed.
869
  Canonical Structure unitR : cmraT := CMRAT () unit_cofe_mixin unit_cmra_mixin.
870 871 872 873 874 875 876

  Instance unit_empty : Empty () := ().
  Lemma unit_ucmra_mixin : UCMRAMixin ().
  Proof. done. Qed.
  Canonical Structure unitUR : ucmraT :=
    UCMRAT () unit_cofe_mixin unit_cmra_mixin unit_ucmra_mixin.

877
  Global Instance unit_cmra_discrete : CMRADiscrete unitR.
878
  Proof. done. Qed.
879
  Global Instance unit_persistent (x : ()) : Persistent x.
Robbert Krebbers's avatar
Robbert Krebbers committed
880
  Proof. by constructor. Qed.
881
End unit.
882

883
(** ** Product *)
884 885
Section prod.
  Context {A B : cmraT}.
Robbert Krebbers's avatar
Robbert Krebbers committed
886 887 888
  Local Arguments pcore _ _ !_ /.
  Local Arguments cmra_pcore _ !_/.

889
  Instance prod_op : Op (A * B) := λ x y, (x.1  y.1, x.2  y.2).
Robbert Krebbers's avatar
Robbert Krebbers committed
890 891 892
  Instance prod_pcore : PCore (A * B) := λ x,
    c1  pcore (x.1); c2  pcore (x.2); Some (c1, c2).
  Arguments prod_pcore !_ /.
893
  Instance prod_valid : Valid (A * B) := λ x,  x.1   x.2.
894
  Instance prod_validN : ValidN (A * B) := λ n x, {n} x.1  {n} x.2.
895

Robbert Krebbers's avatar
Robbert Krebbers committed
896 897 898 899 900 901 902 903 904 905 906 907
  Lemma prod_pcore_Some (x cx : A * B) :
    pcore x =