Commit e906ef70 authored by Robbert's avatar Robbert

Merge branch 'gen_big_op' into 'master'

Generic big operators that are computational for lists

Closes #38

See merge request !54
parents a378b828 bf8da205
-Q theories iris
-arg -w -arg -notation-overridden,-redundant-canonical-projection,-several-object-files
theories/algebra/monoid.v
theories/algebra/cmra.v
theories/algebra/big_op.v
theories/algebra/cmra_big_op.v
theories/algebra/cmra_tactics.v
theories/algebra/sts.v
theories/algebra/auth.v
theories/algebra/gmap.v
......
coq-stdpp https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp 0ac2b4db07bdc471421c5a4c47789087b3df074c
coq-stdpp https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp a0ce0937cfabe16a184af2d92c0466ebacecbca2
......@@ -203,7 +203,8 @@ Lemma auth_frag_op a b : ◯ (a ⋅ b) = ◯ a ⋅ ◯ b.
Proof. done. 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 : UCMRAHomomorphism (Auth None).
Global Instance auth_frag_sep_homomorphism : MonoidHomomorphism op op (Auth None).
Proof. done. Qed.
Lemma auth_both_op a b : Auth (Excl' a) b a b.
......
This diff is collapsed.
From iris.algebra Require Export ofe.
From iris.algebra Require Export ofe monoid.
Set Default Proof Using "Type".
Class PCore (A : Type) := pcore : A option A.
......@@ -243,20 +243,6 @@ Class CMRAMonotone {A B : cmraT} (f : A → B) := {
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 :> NonExpansive 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}.
......@@ -633,9 +619,12 @@ Section ucmra.
Qed.
Global Instance empty_cancelable : Cancelable (:A).
Proof. intros ???. by rewrite !left_id. Qed.
(* For big ops *)
Global Instance cmra_monoid : Monoid (@op A _) := {| monoid_unit := |}.
End ucmra.
Hint Immediate cmra_unit_total.
Hint Immediate cmra_unit_total.
(** * Properties about CMRAs with Leibniz equality *)
Section cmra_leibniz.
......@@ -752,26 +741,6 @@ Section cmra_monotone.
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 : ofeT ofeT cmraT;
......@@ -1316,8 +1285,6 @@ 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.
......
This diff is collapsed.
From iris.algebra Require Export cmra.
From iris.algebra Require Import cmra_big_op.
Set Default Proof Using "Type".
(** * Simple solver for validity and inclusion by reflection *)
Module ra_reflection. Section ra_reflection.
Context {A : ucmraT}.
Inductive expr :=
| EVar : nat expr
| EEmpty : expr
| EOp : expr expr expr.
Fixpoint eval (Σ : list A) (e : expr) : A :=
match e with
| EVar n => from_option id (Σ !! n)
| EEmpty =>
| EOp e1 e2 => eval Σ e1 eval Σ e2
end.
Fixpoint flatten (e : expr) : list nat :=
match e with
| EVar n => [n]
| EEmpty => []
| EOp e1 e2 => flatten e1 ++ flatten e2
end.
Lemma eval_flatten Σ e :
eval Σ e big_op ((λ n, from_option id (Σ !! n)) <$> flatten e).
Proof.
induction e as [| |e1 IH1 e2 IH2]; rewrite /= ?right_id //.
by rewrite fmap_app IH1 IH2 big_op_app.
Qed.
Lemma flatten_correct Σ e1 e2 :
flatten e1 + flatten e2 eval Σ e1 eval Σ e2.
Proof.
by intros He; rewrite !eval_flatten; apply big_op_submseteq; rewrite ->He.
Qed.
Class Quote (Σ1 Σ2 : list A) (l : A) (e : expr) := {}.
Global Instance quote_empty: Quote E1 E1 EEmpty.
Global Instance quote_var Σ1 Σ2 e i:
rlist.QuoteLookup Σ1 Σ2 e i Quote Σ1 Σ2 e (EVar i) | 1000.
Global Instance quote_app Σ1 Σ2 Σ3 x1 x2 e1 e2 :
Quote Σ1 Σ2 x1 e1 Quote Σ2 Σ3 x2 e2 Quote Σ1 Σ3 (x1 x2) (EOp e1 e2).
End ra_reflection.
Ltac quote :=
match goal with
| |- @included _ _ _ ?x ?y =>
lazymatch type of (_ : Quote [] _ x _) with Quote _ ?Σ2 _ ?e1 =>
lazymatch type of (_ : Quote Σ2 _ y _) with Quote _ ?Σ3 _ ?e2 =>
change (eval Σ3 e1 eval Σ3 e2)
end end
end.
End ra_reflection.
Ltac solve_included :=
ra_reflection.quote;
apply ra_reflection.flatten_correct, (bool_decide_unpack _);
vm_compute; apply I.
Ltac solve_validN :=
match goal with
| H : {?n} ?y |- {?n'} ?x =>
let Hn := fresh in let Hx := fresh in
assert (n' n) as Hn by omega;
assert (x y) as Hx by solve_included;
eapply cmra_validN_le, Hn; eapply cmra_validN_included, Hx; apply H
end.
......@@ -281,11 +281,6 @@ Proof. intros ? [] ? EQ; inversion_clear EQ. by eapply id_free0_r. Qed.
Global Instance Cinr_id_free b : IdFree b IdFree (Cinr b).
Proof. intros ? [] ? EQ; inversion_clear EQ. by eapply id_free0_r. 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
......
......@@ -200,9 +200,9 @@ Implicit Types m : gmap K A.
Implicit Types i : K.
Implicit Types x y : A.
Global Instance lookup_cmra_homomorphism :
UCMRAHomomorphism (lookup i : gmap K A option A).
Proof. split. split. apply _. intros m1 m2; by rewrite lookup_op. done. Qed.
Global Instance lookup_op_homomorphism :
MonoidHomomorphism op op (lookup i : gmap K A option A).
Proof. split; [split|]. apply _. intros m1 m2; by rewrite lookup_op. done. Qed.
Lemma lookup_opM m1 mm2 i : (m1 ? mm2) !! i = m1 !! i (mm2 = (!! i)).
Proof. destruct mm2; by rewrite /= ?lookup_op ?right_id_L. Qed.
......@@ -247,9 +247,6 @@ 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.
......
......@@ -464,3 +464,63 @@ Instance listURF_contractive F :
Proof.
by intros ? A1 A2 B1 B2 n f g Hfg; apply listC_map_ne, urFunctor_contractive.
Qed.
(** * Persistence and timelessness of lists of uPreds *)
Class PersistentL {M} (Ps : list (uPred M)) :=
persistentL : Forall PersistentP Ps.
Arguments persistentL {_} _ {_}.
Hint Mode PersistentL + ! : typeclass_instances.
Class TimelessL {M} (Ps : list (uPred M)) :=
timelessL : Forall TimelessP Ps.
Arguments timelessL {_} _ {_}.
Hint Mode TimelessP + ! : typeclass_instances.
Section persistent_timeless.
Context {M : ucmraT}.
Implicit Types Ps Qs : list (uPred M).
Implicit Types A : Type.
Global Instance nil_persistentL : PersistentL (@nil (uPred M)).
Proof. constructor. Qed.
Global Instance cons_persistentL P Ps :
PersistentP P PersistentL Ps PersistentL (P :: Ps).
Proof. by constructor. Qed.
Global Instance app_persistentL Ps Ps' :
PersistentL Ps PersistentL Ps' PersistentL (Ps ++ Ps').
Proof. apply Forall_app_2. Qed.
Global Instance fmap_persistentL {A} (f : A uPred M) xs :
( x, PersistentP (f x)) PersistentL (f <$> xs).
Proof. intros. apply Forall_fmap, Forall_forall; auto. Qed.
Global Instance zip_with_persistentL {A B} (f : A B uPred M) xs ys :
( x y, PersistentP (f x y)) PersistentL (zip_with f xs ys).
Proof.
unfold PersistentL=> ?; revert ys; induction xs=> -[|??]; constructor; auto.
Qed.
Global Instance imap_persistentL {A} (f : nat A uPred M) xs :
( i x, PersistentP (f i x)) PersistentL (imap f xs).
Proof. revert f. induction xs; simpl; constructor; naive_solver. Qed.
(** ** Timelessness *)
Global Instance nil_timelessL : TimelessL (@nil (uPred M)).
Proof. constructor. Qed.
Global Instance cons_timelessL P Ps :
TimelessP P TimelessL Ps TimelessL (P :: Ps).
Proof. by constructor. Qed.
Global Instance app_timelessL Ps Ps' :
TimelessL Ps TimelessL Ps' TimelessL (Ps ++ Ps').
Proof. apply Forall_app_2. Qed.
Global Instance fmap_timelessL {A} (f : A uPred M) xs :
( x, TimelessP (f x)) TimelessL (f <$> xs).
Proof. intros. apply Forall_fmap, Forall_forall; auto. Qed.
Global Instance zip_with_timelessL {A B} (f : A B uPred M) xs ys :
( x y, TimelessP (f x y)) TimelessL (zip_with f xs ys).
Proof.
unfold TimelessL=> ?; revert ys; induction xs=> -[|??]; constructor; auto.
Qed.
Global Instance imap_timelessL {A} (f : nat A uPred M) xs :
( i x, TimelessP (f i x)) TimelessL (imap f xs).
Proof. revert f. induction xs; simpl; constructor; naive_solver. Qed.
End persistent_timeless.
From iris.algebra Require Export ofe.
Set Default Proof Using "Type".
(** The Monoid class that is used for generic big operators in the file
[algebra/big_op]. The operation is an argument because we want to have multiple
monoids over the same type (for example, on [uPred]s we have monoids for [],
[], and []). However, we do bundle the unit because:
- If we would not, it would appear explicitly in an argument of the big
operators, which confuses rewrite. Now it is hidden in the class, and hence
rewrite won't even see it.
- The unit is unique.
We could in principle have big ops over setoids instead of OFEs. However, since
we do not have a canonical structure for setoids, we do not go that way.
Note that we do not declare any of the projections as type class instances. That
is because we only need them in the [big_op] file, and nowhere else. Hence, we
declare these instances locally there to avoid them being used elsewhere. *)
Class Monoid {M : ofeT} (o : M M M) := {
monoid_unit : M;
monoid_ne : NonExpansive2 o;
monoid_assoc : Assoc () o;
monoid_comm : Comm () o;
monoid_left_id : LeftId () monoid_unit o;
}.
Lemma monoid_proper `{Monoid M o} : Proper (() ==> () ==> ()) o.
Proof. apply ne_proper_2, monoid_ne. Qed.
Lemma monoid_right_id `{Monoid M o} : RightId () monoid_unit o.
Proof. intros x. etrans; [apply monoid_comm|apply monoid_left_id]. Qed.
(** The [Homomorphism] classes give rise to generic lemmas about big operators
commuting with each other. We also consider a [WeakMonoidHomomorphism] which
does not necesarrily commute with unit; an example is the [own] connective: we
only have `True == own γ ∅`, not `True own γ ∅`. *)
Class WeakMonoidHomomorphism {M1 M2 : ofeT} (o1 : M1 M1 M1) (o2 : M2 M2 M2)
`{Monoid M1 o1, Monoid M2 o2} (f : M1 M2) := {
monoid_homomorphism_ne : NonExpansive f;
monoid_homomorphism x y : f (o1 x y) o2 (f x) (f y)
}.
Class MonoidHomomorphism {M1 M2 : ofeT} (o1 : M1 M1 M1) (o2 : M2 M2 M2)
`{Monoid M1 o1, Monoid M2 o2} (f : M1 M2) := {
monoid_homomorphism_weak :> WeakMonoidHomomorphism o1 o2 f;
monoid_homomorphism_unit : f monoid_unit monoid_unit
}.
Lemma weak_monoid_homomorphism_proper
`{WeakMonoidHomomorphism M1 M2 o1 o2 f} : Proper (() ==> ()) f.
Proof. apply ne_proper, monoid_homomorphism_ne. Qed.
This diff is collapsed.
......@@ -889,5 +889,64 @@ Proof. intros. by rewrite /PersistentP always_ownM. Qed.
Global Instance from_option_persistent {A} P (Ψ : A uPred M) (mx : option A) :
( x, PersistentP (Ψ x)) PersistentP P PersistentP (from_option Ψ P mx).
Proof. destruct mx; apply _. Qed.
(* For big ops *)
Global Instance uPred_and_monoid : Monoid (@uPred_and M) :=
{| monoid_unit := True%I |}.
Global Instance uPred_or_monoid : Monoid (@uPred_or M) :=
{| monoid_unit := False%I |}.
Global Instance uPred_sep_monoid : Monoid (@uPred_sep M) :=
{| monoid_unit := True%I |}.
Global Instance uPred_always_and_homomorphism :
MonoidHomomorphism uPred_and uPred_and (@uPred_always M).
Proof. split; [split|]. apply _. apply always_and. apply always_pure. Qed.
Global Instance uPred_always_if_and_homomorphism b :
MonoidHomomorphism uPred_and uPred_and (@uPred_always_if M b).
Proof. split; [split|]. apply _. apply always_if_and. apply always_if_pure. Qed.
Global Instance uPred_later_monoid_and_homomorphism :
MonoidHomomorphism uPred_and uPred_and (@uPred_later M).
Proof. split; [split|]. apply _. apply later_and. apply later_True. Qed.
Global Instance uPred_laterN_and_homomorphism n :
MonoidHomomorphism uPred_and uPred_and (@uPred_laterN M n).
Proof. split; [split|]. apply _. apply laterN_and. apply laterN_True. Qed.
Global Instance uPred_except_0_and_homomorphism :
MonoidHomomorphism uPred_and uPred_and (@uPred_except_0 M).
Proof. split; [split|]. apply _. apply except_0_and. apply except_0_True. Qed.
Global Instance uPred_always_or_homomorphism :
MonoidHomomorphism uPred_or uPred_or (@uPred_always M).
Proof. split; [split|]. apply _. apply always_or. apply always_pure. Qed.
Global Instance uPred_always_if_or_homomorphism b :
MonoidHomomorphism uPred_or uPred_or (@uPred_always_if M b).
Proof. split; [split|]. apply _. apply always_if_or. apply always_if_pure. Qed.
Global Instance uPred_later_monoid_or_homomorphism :
WeakMonoidHomomorphism uPred_or uPred_or (@uPred_later M).
Proof. split. apply _. apply later_or. Qed.
Global Instance uPred_laterN_or_homomorphism n :
WeakMonoidHomomorphism uPred_or uPred_or (@uPred_laterN M n).
Proof. split. apply _. apply laterN_or. Qed.
Global Instance uPred_except_0_or_homomorphism :
WeakMonoidHomomorphism uPred_or uPred_or (@uPred_except_0 M).
Proof. split. apply _. apply except_0_or. Qed.
Global Instance uPred_always_sep_homomorphism :
MonoidHomomorphism uPred_sep uPred_sep (@uPred_always M).
Proof. split; [split|]. apply _. apply always_sep. apply always_pure. Qed.
Global Instance uPred_always_if_sep_homomorphism b :
MonoidHomomorphism uPred_sep uPred_sep (@uPred_always_if M b).
Proof. split; [split|]. apply _. apply always_if_sep. apply always_if_pure. Qed.
Global Instance uPred_later_monoid_sep_homomorphism :
MonoidHomomorphism uPred_sep uPred_sep (@uPred_later M).
Proof. split; [split|]. apply _. apply later_sep. apply later_True. Qed.
Global Instance uPred_laterN_sep_homomorphism n :
MonoidHomomorphism uPred_sep uPred_sep (@uPred_laterN M n).
Proof. split; [split|]. apply _. apply laterN_sep. apply laterN_True. Qed.
Global Instance uPred_except_0_sep_homomorphism :
MonoidHomomorphism uPred_sep uPred_sep (@uPred_except_0 M).
Proof. split; [split|]. apply _. apply except_0_sep. apply except_0_True. Qed.
Global Instance uPred_ownM_sep_homomorphism :
MonoidHomomorphism op uPred_sep (@uPred_ownM M).
Proof. split; [split|]. apply _. apply ownM_op. apply ownM_empty'. Qed.
End derived.
End uPred.
......@@ -94,9 +94,10 @@ Section auth.
Proof. intros [? ->]. by rewrite auth_own_op sep_elim_l. Qed.
Lemma auth_own_valid γ a : auth_own γ a a.
Proof. by rewrite /auth_own own_valid auth_validI. Qed.
Global Instance auth_own_cmra_homomorphism : CMRAHomomorphism (auth_own γ).
Global Instance auth_own_sep_homomorphism γ :
WeakMonoidHomomorphism op uPred_sep (auth_own γ).
Proof. split. apply _. apply auth_own_op. Qed.
Global Instance own_mono' γ : Proper (flip () ==> ()) (auth_own γ).
Proof. intros a1 a2. apply auth_own_mono. Qed.
......
......@@ -97,9 +97,8 @@ Qed.
Lemma box_alloc : box N True%I.
Proof.
iIntros; iExists (λ _, True)%I; iSplit.
- iNext. by rewrite big_sepM_empty.
- by rewrite big_sepM_empty.
iIntros; iExists (λ _, True)%I; iSplit; last done.
iNext. by rewrite big_opM_empty.
Qed.
Lemma slice_insert_empty E q f Q P :
......@@ -116,8 +115,8 @@ Proof.
{ iNext. iExists false; eauto. }
iModIntro; iExists γ; repeat iSplit; auto.
iNext. iExists (<[γ:=Q]> Φ); iSplit.
- iNext. iRewrite "HeqP". by rewrite big_sepM_fn_insert'.
- rewrite (big_sepM_fn_insert (λ _ _ P', _ _ _ P' _ _ (_ _ P')))%I //.
- iNext. iRewrite "HeqP". by rewrite big_opM_fn_insert'.
- rewrite (big_opM_fn_insert (λ _ _ P', _ _ _ P' _ _ (_ _ P')))%I //.
iFrame; eauto.
Qed.
......@@ -130,13 +129,13 @@ Proof.
iIntros (??) "[#HγQ Hinv] H". iDestruct "H" as (Φ) "[#HeqP Hf]".
iExists ([ map] γ'↦_ delete γ f, Φ γ')%I.
iInv N as (b) "[>Hγ _]" "Hclose".
iDestruct (big_sepM_delete _ f _ false with "Hf")
iDestruct (big_opM_delete _ f _ false with "Hf")
as "[[>Hγ' #[HγΦ ?]] ?]"; first done.
iDestruct (box_own_auth_agree γ b false with "[-]") as %->; first by iFrame.
iMod ("Hclose" with "[Hγ]"); first iExists false; eauto.
iModIntro. iNext. iSplit.
- iDestruct (box_own_agree γ Q (Φ γ) with "[#]") as "HeqQ"; first by eauto.
iNext. iRewrite "HeqP". iRewrite "HeqQ". by rewrite -big_sepM_delete.
iNext. iRewrite "HeqP". iRewrite "HeqQ". by rewrite -big_opM_delete.
- iExists Φ; eauto.
Qed.
......@@ -147,13 +146,13 @@ Lemma slice_fill E q f γ P Q :
Proof.
iIntros (??) "#[HγQ Hinv] HQ H"; iDestruct "H" as (Φ) "[#HeqP Hf]".
iInv N as (b') "[>Hγ _]" "Hclose".
iDestruct (big_sepM_delete _ f _ false with "Hf")
iDestruct (big_opM_delete _ f _ false with "Hf")
as "[[>Hγ' #[HγΦ Hinv']] ?]"; first done.
iMod (box_own_auth_update γ b' false true with "[$Hγ $Hγ']") as "[Hγ Hγ']".
iMod ("Hclose" with "[Hγ HQ]"); first (iNext; iExists true; by iFrame).
iModIntro; iNext; iExists Φ; iSplit.
- by rewrite big_sepM_insert_override.
- rewrite -insert_delete big_sepM_insert ?lookup_delete //.
- by rewrite big_opM_insert_override.
- rewrite -insert_delete big_opM_insert ?lookup_delete //.
iFrame; eauto.
Qed.
......@@ -164,15 +163,15 @@ Lemma slice_empty E q f P Q γ :
Proof.
iIntros (??) "#[HγQ Hinv] H"; iDestruct "H" as (Φ) "[#HeqP Hf]".
iInv N as (b) "[>Hγ HQ]" "Hclose".
iDestruct (big_sepM_delete _ f with "Hf")
iDestruct (big_opM_delete _ f with "Hf")
as "[[>Hγ' #[HγΦ Hinv']] ?]"; first done.
iDestruct (box_own_auth_agree γ b true with "[-]") as %->; first by iFrame.
iFrame "HQ".
iMod (box_own_auth_update γ with "[$Hγ $Hγ']") as "[Hγ Hγ']".
iMod ("Hclose" with "[Hγ]"); first (iNext; iExists false; by repeat iSplit).
iModIntro; iNext; iExists Φ; iSplit.
- by rewrite big_sepM_insert_override.
- rewrite -insert_delete big_sepM_insert ?lookup_delete //.
- by rewrite big_opM_insert_override.
- rewrite -insert_delete big_opM_insert ?lookup_delete //.
iFrame; eauto.
Qed.
......@@ -205,11 +204,11 @@ Lemma box_fill E f P :
box N f P - P ={E}= box N (const true <$> f) P.
Proof.
iIntros (?) "H HP"; iDestruct "H" as (Φ) "[#HeqP Hf]".
iExists Φ; iSplitR; first by rewrite big_sepM_fmap.
rewrite internal_eq_iff later_iff big_sepM_later.
iExists Φ; iSplitR; first by rewrite big_opM_fmap.
rewrite internal_eq_iff later_iff big_opM_commute.
iDestruct ("HeqP" with "HP") as "HP".
iCombine "Hf" "HP" as "Hf".
rewrite -big_sepM_sepM big_sepM_fmap; iApply (fupd_big_sepM _ _ f).
rewrite -big_opM_opM big_opM_fmap; iApply (fupd_big_sepM _ _ f).
iApply (@big_sepM_impl with "[$Hf]").
iAlways; iIntros (γ b' ?) "[(Hγ' & #$ & #$) HΦ]".
iInv N as (b) "[>Hγ _]" "Hclose".
......@@ -226,7 +225,7 @@ Proof.
iAssert (([ map] γ↦b f, Φ γ)
[ map] γ↦b f, box_own_auth γ ( Excl' false) box_own_prop γ (Φ γ)
inv N (slice_inv γ (Φ γ)))%I with "[> Hf]" as "[HΦ ?]".
{ rewrite -big_sepM_sepM -fupd_big_sepM. iApply (@big_sepM_impl with "[$Hf]").
{ rewrite -big_opM_opM -fupd_big_sepM. iApply (@big_sepM_impl with "[$Hf]").
iAlways; iIntros (γ b ?) "(Hγ' & #HγΦ & #Hinv)".
assert (true = b) as <- by eauto.
iInv N as (b) "[>Hγ HΦ]" "Hclose".
......@@ -235,8 +234,8 @@ Proof.
iMod ("Hclose" with "[Hγ]"); first (iNext; iExists false; iFrame; eauto).
iFrame "HγΦ Hinv". by iApply "HΦ". }
iModIntro; iSplitL "HΦ".
- rewrite internal_eq_iff later_iff big_sepM_later. by iApply "HeqP".
- iExists Φ; iSplit; by rewrite big_sepM_fmap.
- rewrite internal_eq_iff later_iff big_opM_commute. by iApply "HeqP".
- iExists Φ; iSplit; by rewrite big_opM_fmap.
Qed.
Lemma slice_iff E q f P Q Q' γ b :
......
......@@ -63,30 +63,22 @@ Section fractional.
Global Instance fractional_big_sepL {A} l Ψ :
( k (x : A), Fractional (Ψ k x))
Fractional (M:=M) (λ q, [ list] kx l, Ψ k x q)%I.
Proof.
intros ? q q'. rewrite -big_sepL_sepL. by setoid_rewrite fractional.
Qed.
Proof. intros ? q q'. rewrite -big_opL_opL. by setoid_rewrite fractional. Qed.
Global Instance fractional_big_sepM `{Countable K} {A} (m : gmap K A) Ψ :
( k (x : A), Fractional (Ψ k x))
Fractional (M:=M) (λ q, [ map] kx m, Ψ k x q)%I.
Proof.
intros ? q q'. rewrite -big_sepM_sepM. by setoid_rewrite fractional.
Qed.
Proof. intros ? q q'. rewrite -big_opM_opM. by setoid_rewrite fractional. Qed.
Global Instance fractional_big_sepS `{Countable A} (X : gset A) Ψ :
( x, Fractional (Ψ x))
Fractional (M:=M) (λ q, [ set] x X, Ψ x q)%I.
Proof.
intros ? q q'. rewrite -big_sepS_sepS. by setoid_rewrite fractional.
Qed.
Proof. intros ? q q'. rewrite -big_opS_opS. by setoid_rewrite fractional. Qed.
Global Instance fractional_big_sepMS `{Countable A} (X : gmultiset A) Ψ :
( x, Fractional (Ψ x))
Fractional (M:=M) (λ q, [ mset] x X, Ψ x q)%I.
Proof.
intros ? q q'. rewrite -big_sepMS_sepMS. by setoid_rewrite fractional.
Qed.
Proof. intros ? q q'. rewrite -big_opMS_opMS. by setoid_rewrite fractional. Qed.
(** Mult instances *)
......
......@@ -86,8 +86,6 @@ 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.
......@@ -178,6 +176,11 @@ Proof.
- intros x; destruct inG_prf. by rewrite left_id.
Qed.
(** Big op class instances *)
Instance own_cmra_sep_homomorphism `{inG Σ (A:ucmraT)} :
WeakMonoidHomomorphism op uPred_sep (own γ).
Proof. split. apply _. apply own_op. Qed.
(** Proofmode class instances *)
Section proofmode_classes.
Context `{inG Σ A}.
......
......@@ -105,9 +105,9 @@ Lemma ownI_open i P : wsat ∗ ownI i P ∗ ownE {[i]} ⊢ wsat ∗ ▷ P ∗ ow
Proof.
rewrite /ownI. iIntros "(Hw & Hi & HiE)". iDestruct "Hw" as (I) "[? HI]".
iDestruct (invariant_lookup I i P with "[$]") as (Q) "[% #HPQ]".
iDestruct (big_sepM_delete _ _ i with "HI") as "[[[HQ $]|HiE'] HI]"; eauto.
iDestruct (big_opM_delete _ _ i with "HI") as "[[[HQ $]|HiE'] HI]"; eauto.
- iSplitR "HQ"; last by iNext; iRewrite -"HPQ".
iExists I. iFrame "Hw". iApply (big_sepM_delete _ _ i); eauto.
iExists I. iFrame "Hw". iApply (big_opM_delete _ _ i); eauto.
iFrame "HI"; eauto.
- iDestruct (ownE_singleton_twice with "[$HiE $HiE']") as %[].
Qed.
......@@ -115,9 +115,9 @@ Lemma ownI_close i P : wsat ∗ ownI i P ∗ ▷ P ∗ ownD {[i]} ⊢ wsat ∗ o
Proof.
rewrite /ownI. iIntros "(Hw & Hi & HP & HiD)". iDestruct "Hw" as (I) "[? HI]".
iDestruct (invariant_lookup with "[$]") as (Q) "[% #HPQ]".
iDestruct (big_sepM_delete _ _ i with "HI") as "[[[HQ ?]|$] HI]"; eauto.
iDestruct (big_opM_delete _ _ i with "HI") as "[[[HQ ?]|$] HI]"; eauto.
- iDestruct (ownD_singleton_twice with "[$]") as %[].
- iExists I. iFrame "Hw". iApply (big_sepM_delete _ _ i); eauto.
- iExists I. iFrame "Hw". iApply (big_opM_delete _ _ i); eauto.
iFrame "HI". iLeft. iFrame "HiD". by iNext; iRewrite "HPQ".
Qed.
......@@ -139,7 +139,7 @@ Proof.
iModIntro; iExists i; iSplit; [done|]. rewrite /ownI; iFrame "HiP".
iExists (<[i:=P]>I); iSplitL "Hw".
{ by rewrite fmap_insert insert_singleton_op ?lookup_fmap ?HIi. }
iApply (big_sepM_insert _ I); first done.
iApply (big_opM_insert _ I); first done.
iFrame "HI". iLeft. by rewrite /ownD; iFrame.
Qed.
......@@ -162,7 +162,7 @@ Proof.
rewrite -/(ownD _). iFrame "HD".
iIntros "HE". iExists (<[i:=P]>I); iSplitL "Hw".
{ by rewrite fmap_insert insert_singleton_op ?lookup_fmap ?HIi. }
iApply (big_sepM_insert _ I); first done.
iApply (big_opM_insert _ I); first done.
iFrame "HI". by iRight.
Qed.
End wsat.
......@@ -23,17 +23,16 @@ Module uPred_reflection. Section uPred_reflection.
| ESep e1 e2 => flatten e1 ++ flatten e2
end.
Notation eval_list Σ l := ([] ((λ n, from_option id True%I (Σ !! n)) <$> l))%I.
Notation eval_list Σ l := ([ list] n l, from_option id True (Σ !! n))%I.
Lemma eval_flatten Σ e : eval Σ e ⊣⊢ eval_list Σ (flatten e).
Proof.
induction e as [| |e1 IH1 e2 IH2];
rewrite /= ?right_id ?fmap_app ?big_sep_app ?IH1 ?IH2 //.
rewrite /= ?right_id ?big_opL_app ?IH1 ?IH2 //.
Qed.
Lemma flatten_entails Σ e1 e2 :
flatten e2 + flatten e1 eval Σ e1 eval Σ e2.
Proof.
intros. rewrite !eval_flatten. by apply