Commit 61761380 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Introduce CMRA homomorphisms.

This allows us to factor out properties about connectives that
commute with the big operators.
parent 7293e063
......@@ -189,10 +189,13 @@ Proof. uPred.unseal. by destruct x as [[[]|]]. Qed.
Lemma auth_frag_op a b : (a b) a b.
Proof. done. Qed.
Lemma auth_both_op a b : Auth (Excl' a) b a b.
Proof. by rewrite /op /auth_op /= left_id. Qed.
Lemma auth_frag_mono a b : a b a b.
Proof. intros [c ->]. rewrite auth_frag_op. apply cmra_included_l. Qed.
Global Instance auth_frag_cmra_homomorphism : CMRAHomomorphism (Auth None).
Proof. done. Qed.
Lemma auth_both_op a b : Auth (Excl' a) b a b.
Proof. by rewrite /op /auth_op /= left_id. Qed.
Lemma auth_auth_valid a : a ( a).
Proof. intros; split; simpl; auto using ucmra_unit_leastN. Qed.
......@@ -246,7 +249,7 @@ Instance auth_map_cmra_monotone {A B : ucmraT} (f : A → B) :
Proof.
split; try apply _.
- intros n [[[a|]|] b]; rewrite /= /cmra_validN /=; try
naive_solver eauto using cmra_monotoneN, validN_preserving.
naive_solver eauto using cmra_monotoneN, cmra_monotone_validN.
- by intros [x a] [y b]; rewrite !auth_included /=;
intros [??]; split; simpl; apply: cmra_monotone.
Qed.
......
......@@ -213,12 +213,26 @@ Class CMRADiscrete (A : cmraT) := {
(** * Morphisms *)
Class CMRAMonotone {A B : cmraT} (f : A B) := {
cmra_monotone_ne n :> Proper (dist n ==> dist n) f;
validN_preserving n x : {n} x {n} f x;
cmra_monotone_validN n x : {n} x {n} f x;
cmra_monotone x y : x y f x f y
}.
Arguments validN_preserving {_ _} _ {_} _ _ _.
Arguments cmra_monotone_validN {_ _} _ {_} _ _ _.
Arguments cmra_monotone {_ _} _ {_} _ _ _.
(* Not all intended homomorphisms preserve validity, in particular it does not
hold for the [ownM] and [own] connectives. *)
Class CMRAHomomorphism {A B : cmraT} (f : A B) := {
cmra_homomorphism_ne n :> Proper (dist n ==> dist n) f;
cmra_homomorphism x y : f (x y) f x f y
}.
Arguments cmra_homomorphism {_ _} _ _ _ _.
Class UCMRAHomomorphism {A B : ucmraT} (f : A B) := {
ucmra_homomorphism :> CMRAHomomorphism f;
ucmra_homomorphism_unit : f
}.
Arguments ucmra_homomorphism_unit {_ _} _ _.
(** * Properties **)
Section cmra.
Context {A : cmraT}.
......@@ -631,7 +645,7 @@ Instance cmra_monotone_compose {A B C : cmraT} (f : A → B) (g : B → C) :
Proof.
split.
- apply _.
- move=> n x Hx /=. by apply validN_preserving, validN_preserving.
- move=> n x Hx /=. by apply cmra_monotone_validN, cmra_monotone_validN.
- move=> x y Hxy /=. by apply cmra_monotone, cmra_monotone.
Qed.
......@@ -643,10 +657,30 @@ Section cmra_monotone.
intros [z ->].
apply cmra_included_includedN, (cmra_monotone f), cmra_included_l.
Qed.
Lemma valid_preserving x : x f x.
Proof. rewrite !cmra_valid_validN; eauto using validN_preserving. Qed.
Lemma cmra_monotone_valid x : x f x.
Proof. rewrite !cmra_valid_validN; eauto using cmra_monotone_validN. Qed.
End cmra_monotone.
Instance cmra_homomorphism_id {A : cmraT} : CMRAHomomorphism (@id A).
Proof. repeat split; by try apply _. Qed.
Instance cmra_homomorphism_compose {A B C : cmraT} (f : A B) (g : B C) :
CMRAHomomorphism f CMRAHomomorphism g CMRAHomomorphism (g f).
Proof.
split.
- apply _.
- move=> x y /=. rewrite -(cmra_homomorphism g).
by apply (ne_proper _), cmra_homomorphism.
Qed.
Instance cmra_homomorphism_proper {A B : cmraT} (f : A B) :
CMRAHomomorphism f Proper (() ==> ()) f := λ _, ne_proper _.
Instance ucmra_homomorphism_id {A : ucmraT} : UCMRAHomomorphism (@id A).
Proof. repeat split; by try apply _. Qed.
Instance ucmra_homomorphism_compose {A B C : ucmraT} (f : A B) (g : B C) :
UCMRAHomomorphism f UCMRAHomomorphism g UCMRAHomomorphism (g f).
Proof. split. apply _. by rewrite /= !ucmra_homomorphism_unit. Qed.
(** Functors *)
Structure rFunctor := RFunctor {
rFunctor_car : cofeT cofeT cmraT;
......@@ -1010,7 +1044,7 @@ Instance prod_map_cmra_monotone {A A' B B' : cmraT} (f : A → A') (g : B → B'
CMRAMonotone f CMRAMonotone g CMRAMonotone (prod_map f g).
Proof.
split; first apply _.
- by intros n x [??]; split; simpl; apply validN_preserving.
- by intros n x [??]; split; simpl; apply cmra_monotone_validN.
- intros x y; rewrite !prod_included=> -[??] /=.
by split; apply cmra_monotone.
Qed.
......@@ -1142,6 +1176,8 @@ Section option.
(** Misc *)
Global Instance Some_cmra_monotone : CMRAMonotone Some.
Proof. split; [apply _|done|intros x y [z ->]; by exists (Some z)]. Qed.
Global Instance Some_cmra_homomorphism : CMRAHomomorphism Some.
Proof. split. apply _. done. Qed.
Lemma op_None mx my : mx my = None mx = None my = None.
Proof. destruct mx, my; naive_solver. Qed.
......@@ -1176,7 +1212,7 @@ Instance option_fmap_cmra_monotone {A B : cmraT} (f: A → B) `{!CMRAMonotone f}
CMRAMonotone (fmap f : option A option B).
Proof.
split; first apply _.
- intros n [x|] ?; rewrite /cmra_validN //=. by apply (validN_preserving f).
- intros n [x|] ?; rewrite /cmra_validN //=. by apply (cmra_monotone_validN f).
- intros mx my; rewrite !option_included.
intros [->|(x&y&->&->&[Hxy|?])]; simpl; eauto 10 using @cmra_monotone.
right; exists (f x), (f y). by rewrite {3}Hxy; eauto.
......
......@@ -376,62 +376,54 @@ End gset.
End big_op.
Lemma big_opL_commute {M1 M2 : ucmraT} {A} (h : M1 M2)
`{!Proper (() ==> ()) h} (f : nat A M1) l :
h
( x y, h (x y) h x h y)
`{!UCMRAHomomorphism h} (f : nat A M1) l :
h ([ list] kx l, f k x) ([ list] kx l, h (f k x)).
Proof.
intros ??. revert f. induction l as [|x l IH]=> f.
- by rewrite !big_opL_nil.
- by rewrite !big_opL_cons -IH.
revert f. induction l as [|x l IH]=> f.
- by rewrite !big_opL_nil ucmra_homomorphism_unit.
- by rewrite !big_opL_cons cmra_homomorphism -IH.
Qed.
Lemma big_opL_commute1 {M1 M2 : ucmraT} {A} (h : M1 M2)
`{!Proper (() ==> ()) h} (f : nat A M1) l :
( x y, h (x y) h x h y)
l []
h ([ list] kx l, f k x) ([ list] kx l, h (f k x)).
`{!CMRAHomomorphism h} (f : nat A M1) l :
l [] h ([ list] kx l, f k x) ([ list] kx l, h (f k x)).
Proof.
intros ??. revert f. induction l as [|x [|x' l'] IH]=> f //.
intros ?. revert f. induction l as [|x [|x' l'] IH]=> f //.
- by rewrite !big_opL_singleton.
- by rewrite !(big_opL_cons _ x) -IH.
- by rewrite !(big_opL_cons _ x) cmra_homomorphism -IH.
Qed.
Lemma big_opM_commute {M1 M2 : ucmraT} `{Countable K} {A} (h : M1 M2)
`{!Proper (() ==> ()) h} (f : K A M1) m :
h
( x y, h (x y) h x h y)
`{!UCMRAHomomorphism h} (f : K A M1) m :
h ([ map] kx m, f k x) ([ map] kx m, h (f k x)).
Proof.
intros. rewrite /big_opM.
induction (map_to_list m) as [|[i x] l IH]; csimpl; rewrite -?IH; auto.
intros. induction m as [|i x m ? IH] using map_ind.
- by rewrite !big_opM_empty ucmra_homomorphism_unit.
- by rewrite !big_opM_insert // cmra_homomorphism -IH.
Qed.
Lemma big_opM_commute1 {M1 M2 : ucmraT} `{Countable K} {A} (h : M1 M2)
`{!Proper (() ==> ()) h} (f : K A M1) m :
( x y, h (x y) h x h y)
m
h ([ map] kx m, f k x) ([ map] kx m, h (f k x)).
`{!CMRAHomomorphism h} (f : K A M1) m :
m h ([ map] kx m, f k x) ([ map] kx m, h (f k x)).
Proof.
rewrite -map_to_list_empty' /big_opM=> ??.
induction (map_to_list m) as [|[i x] [|i' x'] IH];
csimpl in *; rewrite ?right_id -?IH //.
intros. induction m as [|i x m ? IH] using map_ind; [done|].
destruct (decide (m = )) as [->|].
- by rewrite !big_opM_insert // !big_opM_empty !right_id.
- by rewrite !big_opM_insert // cmra_homomorphism -IH //.
Qed.
Lemma big_opS_commute {M1 M2 : ucmraT} `{Countable A} (h : M1 M2)
`{!Proper (() ==> ()) h} (f : A M1) X :
h
( x y, h (x y) h x h y)
Lemma big_opS_commute {M1 M2 : ucmraT} `{Countable A}
(h : M1 M2) `{!UCMRAHomomorphism h} (f : A M1) X :
h ([ set] x X, f x) ([ set] x X, h (f x)).
Proof.
intros. rewrite /big_opS.
induction (elements X) as [|x l IH]; csimpl; rewrite -?IH; auto.
intros. induction X as [|x X ? IH] using collection_ind_L.
- by rewrite !big_opS_empty ucmra_homomorphism_unit.
- by rewrite !big_opS_insert // cmra_homomorphism -IH.
Qed.
Lemma big_opS_commute1 {M1 M2 : ucmraT} `{Countable A} (h : M1 M2)
`{!Proper (() ==> ()) h} (f : A M1) X :
( x y, h (x y) h x h y)
X
h ([ set] x X, f x) ([ set] x X, h (f x)).
Lemma big_opS_commute1 {M1 M2 : ucmraT} `{Countable A}
(h : M1 M2) `{!CMRAHomomorphism h} (f : A M1) X :
X h ([ set] x X, f x) ([ set] x X, h (f x)).
Proof.
rewrite -elements_empty' /big_opS=> ??.
induction (elements X) as [|x [|x' l] IH];
csimpl in *; rewrite ?right_id -?IH //.
intros. induction X as [|x X ? IH] using collection_ind_L; [done|].
destruct (decide (X = )) as [->|].
- by rewrite !big_opS_insert // !big_opS_empty !right_id.
- by rewrite !big_opS_insert // cmra_homomorphism -IH //.
Qed.
......@@ -242,6 +242,11 @@ Proof. by move=> H[]? =>[/H||]. Qed.
Global Instance Cinr_exclusive b : Exclusive b Exclusive (Cinr b).
Proof. by move=> H[]? =>[|/H|]. Qed.
Global Instance Cinl_cmra_homomorphism : CMRAHomomorphism Cinl.
Proof. split. apply _. done. Qed.
Global Instance Cinr_cmra_homomorphism : CMRAHomomorphism Cinr.
Proof. split. apply _. done. Qed.
(** Internalized properties *)
Lemma csum_equivI {M} (x y : csum A B) :
x y (match x, y with
......@@ -330,7 +335,7 @@ Instance csum_map_cmra_monotone {A A' B B' : cmraT} (f : A → A') (g : B → B'
CMRAMonotone f CMRAMonotone g CMRAMonotone (csum_map f g).
Proof.
split; try apply _.
- intros n [a|b|]; simpl; auto using validN_preserving.
- intros n [a|b|]; simpl; auto using cmra_monotone_validN.
- intros x y; rewrite !csum_included.
intros [->|[(a&a'&->&->&?)|(b&b'&->&->&?)]]; simpl;
eauto 10 using cmra_monotone.
......
......@@ -238,6 +238,9 @@ Qed.
Lemma op_singleton (i : K) (x y : A) :
{[ i := x ]} {[ i := y ]} = ({[ i := x y ]} : gmap K A).
Proof. by apply (merge_singleton _ _ _ x y). Qed.
Global Instance singleton_cmra_homomorphism :
CMRAHomomorphism (singletonM i : A gmap K A).
Proof. split. apply _. intros. by rewrite op_singleton. Qed.
Global Instance gmap_persistent m : ( x : A, Persistent x) Persistent m.
Proof.
......@@ -434,7 +437,7 @@ Instance gmap_fmap_cmra_monotone `{Countable K} {A B : cmraT} (f : A → B)
`{!CMRAMonotone f} : CMRAMonotone (fmap f : gmap K A gmap K B).
Proof.
split; try apply _.
- by intros n m ? i; rewrite lookup_fmap; apply (validN_preserving _).
- by intros n m ? i; rewrite lookup_fmap; apply (cmra_monotone_validN _).
- intros m1 m2; rewrite !lookup_included=> Hm i.
by rewrite !lookup_fmap; apply: cmra_monotone.
Qed.
......
......@@ -287,7 +287,7 @@ Instance iprod_map_cmra_monotone
( x, CMRAMonotone (f x)) CMRAMonotone (iprod_map f).
Proof.
split; first apply _.
- intros n g Hg x; rewrite /iprod_map; apply (validN_preserving (f _)), Hg.
- intros n g Hg x; rewrite /iprod_map; apply (cmra_monotone_validN (f _)), Hg.
- intros g1 g2; rewrite !iprod_included_spec=> Hf x.
rewrite /iprod_map; apply (cmra_monotone _), Hf.
Qed.
......
......@@ -429,7 +429,7 @@ Instance list_fmap_cmra_monotone {A B : ucmraT} (f : A → B)
Proof.
split; try apply _.
- intros n l. rewrite !list_lookup_validN=> Hl i. rewrite list_lookup_fmap.
by apply (validN_preserving (fmap f : option A option B)).
by apply (cmra_monotone_validN (fmap f : option A option B)).
- intros l1 l2. rewrite !list_lookup_included=> Hl i. rewrite !list_lookup_fmap.
by apply (cmra_monotone (fmap f : option A option B)).
Qed.
......
......@@ -69,13 +69,13 @@ Program Definition uPred_map {M1 M2 : ucmraT} (f : M2 -n> M1)
`{!CMRAMonotone f} (P : uPred M1) :
uPred M2 := {| uPred_holds n x := P n (f x) |}.
Next Obligation. naive_solver eauto using uPred_mono, cmra_monotoneN. Qed.
Next Obligation. naive_solver eauto using uPred_closed, validN_preserving. Qed.
Next Obligation. naive_solver eauto using uPred_closed, cmra_monotone_validN. Qed.
Instance uPred_map_ne {M1 M2 : ucmraT} (f : M2 -n> M1)
`{!CMRAMonotone f} n : Proper (dist n ==> dist n) (uPred_map f).
Proof.
intros x1 x2 Hx; split=> n' y ??.
split; apply Hx; auto using validN_preserving.
split; apply Hx; auto using cmra_monotone_validN.
Qed.
Lemma uPred_map_id {M : ucmraT} (P : uPred M): uPred_map cid P P.
Proof. by split=> n x ?. Qed.
......@@ -1477,7 +1477,6 @@ Qed.
Theorem soundness : ¬ (True False).
Proof. exact (adequacy False 0). Qed.
End uPred_logic.
(* Hint DB for the logic *)
......@@ -1490,6 +1489,8 @@ Hint Immediate True_intro False_elim : I.
Hint Immediate iff_refl eq_refl' : I.
End uPred.
Import uPred.
(* CMRA structure on uPred *)
Section cmra.
Context {M : ucmraT}.
......@@ -1505,19 +1506,19 @@ Section cmra.
Lemma uPred_validN_alt n (P : uPred M) : {n} P P {n} True%I.
Proof.
uPred.unseal=> HP; split=> n' x ??; split; [done|].
unseal=> HP; split=> n' x ??; split; [done|].
intros _. by apply HP.
Qed.
Lemma uPred_cmra_validN_op_l n P Q : {n} (P Q)%I {n} P.
Proof.
uPred.unseal. intros HPQ n' x ??.
unseal. intros HPQ n' x ??.
destruct (HPQ n' x) as (x1&x2&->&?&?); auto.
eapply uPred_mono with x1; eauto using cmra_includedN_l.
Qed.
Lemma uPred_included P Q : P Q Q P.
Proof. intros [P' ->]. apply uPred.sep_elim_l. Qed.
Proof. intros [P' ->]. apply sep_elim_l. Qed.
Definition uPred_cmra_mixin : CMRAMixin (uPred M).
Proof.
......@@ -1551,6 +1552,19 @@ Section cmra.
Canonical Structure uPredUR :=
UCMRAT (uPred M) uPred_cofe_mixin uPred_cmra_mixin uPred_ucmra_mixin.
Global Instance uPred_always_homomorphism : UCMRAHomomorphism uPred_always.
Proof. split; [split|]. apply _. apply always_sep. apply always_pure. Qed.
Global Instance uPred_always_if_homomorphism b :
UCMRAHomomorphism (uPred_always_if b).
Proof. split; [split|]. apply _. apply always_if_sep. apply always_if_pure. Qed.
Global Instance uPred_later_homomorphism : UCMRAHomomorphism uPred_later.
Proof. split; [split|]. apply _. apply later_sep. apply later_True. Qed.
Global Instance uPred_except_last_homomorphism :
CMRAHomomorphism uPred_except_last.
Proof. split. apply _. apply except_last_sep. Qed.
Global Instance uPred_ownM_homomorphism : UCMRAHomomorphism uPred_ownM.
Proof. split; [split|]. apply _. apply ownM_op. apply ownM_empty'. Qed.
End cmra.
Arguments uPredR : clear implicits.
......
......@@ -155,15 +155,15 @@ Section list.
Lemma big_sepL_later Φ l :
([ list] kx l, Φ k x) ([ list] kx l, Φ k x).
Proof. apply (big_opL_commute _). apply later_True. apply later_sep. Qed.
Proof. apply (big_opL_commute _). Qed.
Lemma big_sepL_always Φ l :
( [ list] kx l, Φ k x) ([ list] kx l, Φ k x).
Proof. apply (big_opL_commute _). apply always_pure. apply always_sep. Qed.
Proof. apply (big_opL_commute _). Qed.
Lemma big_sepL_always_if p Φ l :
?p ([ list] kx l, Φ k x) ([ list] kx l, ?p Φ k x).
Proof. destruct p; simpl; auto using big_sepL_always. Qed.
Proof. apply (big_opL_commute _). Qed.
Lemma big_sepL_forall Φ l :
( k x, PersistentP (Φ k x))
......@@ -277,15 +277,15 @@ Section gmap.
Lemma big_sepM_later Φ m :
([ map] kx m, Φ k x) ([ map] kx m, Φ k x).
Proof. apply (big_opM_commute _). apply later_True. apply later_sep. Qed.
Proof. apply (big_opM_commute _). Qed.
Lemma big_sepM_always Φ m :
( [ map] kx m, Φ k x) ([ map] kx m, Φ k x).
Proof. apply (big_opM_commute _). apply always_pure. apply always_sep. Qed.
Proof. apply (big_opM_commute _). Qed.
Lemma big_sepM_always_if p Φ m :
?p ([ map] kx m, Φ k x) ([ map] kx m, ?p Φ k x).
Proof. destruct p; simpl; auto using big_sepM_always. Qed.
Proof. apply (big_opM_commute _). Qed.
Lemma big_sepM_forall Φ m :
( k x, PersistentP (Φ k x))
......@@ -386,14 +386,14 @@ Section gset.
Proof. apply: big_opS_opS. Qed.
Lemma big_sepS_later Φ X : ([ set] y X, Φ y) ([ set] y X, Φ y).
Proof. apply (big_opS_commute _). apply later_True. apply later_sep. Qed.
Proof. apply (big_opS_commute _). Qed.
Lemma big_sepS_always Φ X : ([ set] y X, Φ y) ([ set] y X, Φ y).
Proof. apply (big_opS_commute _). apply always_pure. apply always_sep. Qed.
Proof. apply (big_opS_commute _). Qed.
Lemma big_sepS_always_if q Φ X :
?q ([ set] y X, Φ y) ([ set] y X, ?q Φ y).
Proof. destruct q; simpl; auto using big_sepS_always. Qed.
Proof. apply (big_opS_commute _). Qed.
Lemma big_sepS_forall Φ X :
( x, PersistentP (Φ x)) ([ set] x X, Φ x) ( x, (x X) Φ x).
......@@ -410,7 +410,7 @@ Section gset.
Qed.
Lemma big_sepS_impl Φ Ψ X :
( x, (x X) Φ x Ψ x) ([ set] x X, Φ x) [ set] x X, Ψ x.
( x, (x X) Φ x Ψ x) ([ set] x X, Φ x) [ set] x X, Ψ x.
Proof.
rewrite always_and_sep_l always_forall.
setoid_rewrite always_impl; setoid_rewrite always_pure.
......
......@@ -53,6 +53,8 @@ Proof. by rewrite !own_eq /own_def -ownM_op iRes_singleton_op. Qed.
Lemma own_mono γ a1 a2 : a2 a1 own γ a1 own γ a2.
Proof. move=> [c ->]. rewrite own_op. eauto with I. Qed.
Global Instance own_cmra_homomorphism : CMRAHomomorphism (own γ).
Proof. split. apply _. apply own_op. Qed.
Global Instance own_mono' γ : Proper (flip () ==> ()) (@own Σ A _ γ).
Proof. intros a1 a2. apply own_mono. Qed.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment