Commit 6fbff46e authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Generic big operators that are no longer tied to CMRAs.

Instead, I have introduced a type class `Monoid` that is used by the big operators:

    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;
      monoid_right_id : RightId (≡) monoid_unit o;
    }.

Note that 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, the unit would appear explicitly in an implicit argument of the
  big operators, which confuses rewrite. By bundling the unit in the `Monoid` class
  it is hidden, 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 bundled setoids, I did not go that way.
parent c52ff261
-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
......
......@@ -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 [ list] n flatten e, from_option id (Σ !! n).
Proof.
induction e as [| |e1 IH1 e2 IH2]; rewrite /= ?right_id //.
by rewrite IH1 IH2 big_opL_app.
Qed.
Lemma flatten_correct Σ e1 e2 :
flatten e1 + flatten e2 eval Σ e1 eval Σ e2.
Proof.
by intros He; rewrite !eval_flatten; apply big_opL_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;
monoid_right_id : RightId () monoid_unit o;
}.
Lemma monoid_proper `{Monoid M o} : Proper (() ==> () ==> ()) o.
Proof. apply ne_proper_2, monoid_ne. Qed.
(** The [Homomorphism] classes give rise to generic lemmas about big operators
commuting with each other. *)
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.
From iris.algebra Require Export list cmra_big_op.
From iris.algebra Require Export list big_op.
From iris.base_logic Require Export base_logic.
From stdpp Require Import gmap fin_collections gmultiset functions.
Set Default Proof Using "Type".
Import uPred.
(* We make use of the bigops on CMRAs, so we first define a (somewhat ad-hoc)
CMRA structure on uPred. *)
Section cmra.
Context {M : ucmraT}.
Instance uPred_valid_inst : Valid (uPred M) := λ P, n x, {n} x P n x.
Instance uPred_validN_inst : ValidN (uPred M) := λ n P,
n' x, n' n {n'} x P n' x.
Instance uPred_op : Op (uPred M) := uPred_sep.
Instance uPred_pcore : PCore (uPred M) := λ _, Some True%I.
Instance uPred_validN_ne n : Proper (dist n ==> iff) (uPred_validN_inst n).
Proof. intros P Q HPQ; split=> H n' x ??; by apply HPQ, H. Qed.
Lemma uPred_validN_alt n (P : uPred M) : {n} P P {n} True%I.
Proof.
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.
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 sep_elim_l. Qed.
Definition uPred_cmra_mixin : CMRAMixin (uPred M).
Proof.
apply cmra_total_mixin; try apply _ || by eauto.
- intros n P Q ??. by ofe_subst.
- intros P; split.
+ intros HP n n' x ?. apply HP.
+ intros HP n x. by apply (HP n).
- intros n P HP n' x ?. apply HP; auto.
- intros P. by rewrite left_id.
- intros P Q _. exists True%I. by rewrite left_id.
- intros n P Q. apply uPred_cmra_validN_op_l.
- intros n P Q1 Q2 HP HPQ. exists True%I, P; split_and!.
+ by rewrite left_id.
+ move: HP; by rewrite HPQ=> /uPred_cmra_validN_op_l /uPred_validN_alt.
+ move: HP; rewrite HPQ=> /uPred_cmra_validN_op_l /uPred_validN_alt=> ->.
by rewrite left_id.
Qed.
Canonical Structure uPredR := CMRAT (uPred M) uPred_cmra_mixin.
Instance uPred_empty : Empty (uPred M) := True%I.
Definition uPred_ucmra_mixin : UCMRAMixin (uPred M).
Proof.
split; last done.
- by rewrite /empty /uPred_empty uPred_pure_eq.
- intros P. by rewrite left_id.
Qed.
Canonical Structure uPredUR := UCMRAT (uPred M) 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_laterN_homomorphism n : UCMRAHomomorphism (uPred_laterN n).
Proof. split; [split|]. apply _. apply laterN_sep. apply laterN_True. Qed.
Global Instance uPred_except_0_homomorphism :
CMRAHomomorphism uPred_except_0.
Proof. split. apply _. apply except_0_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.
Arguments uPredUR : clear implicits.
(* Notations *)
Notation "'[∗' 'list' ] k ↦ x ∈ l , P" := (big_opL (M:=uPredUR _) (λ k x, P) l)
Notation "'[∗' 'list]' k ↦ x ∈ l , P" := (big_opL uPred_sep (λ k x, P) l)
(at level 200, l at level 10, k, x at level 1, right associativity,
format "[∗ list ] k ↦ x ∈ l , P") : uPred_scope.
Notation "'[∗' 'list' ] x ∈ l , P" := (big_opL (M:=uPredUR _) (λ _ x, P) l)
format "[∗ list] k ↦ x ∈ l , P") : uPred_scope.
Notation "'[∗' 'list]' x ∈ l , P" := (big_opL uPred_sep (λ _ x, P) l)
(at level 200, l at level 10, x at level 1, right associativity,
format "[∗ list ] x ∈ l , P") : uPred_scope.
format "[∗ list] x ∈ l , P") : uPred_scope.
Notation "'[∗]' Ps" :=
(big_opL (M:=uPredUR _) (λ _ x, x) Ps) (at level 20) : uPred_scope.
(big_opL uPred_sep (λ _ x, x) Ps) (at level 20) : uPred_scope.
Notation "'[∗' 'map' ] k ↦ x ∈ m , P" := (big_opM (M:=uPredUR _) (λ k x, P) m)
Notation "'[∗' 'map]' k ↦ x ∈ m , P" := (big_opM uPred_sep (λ k x, P) m)
(at level 200, m at level 10, k, x at level 1, right associativity,
format "[∗ map ] k ↦ x ∈ m , P") : uPred_scope.
Notation "'[∗' 'map' ] x ∈ m , P" := (big_opM (M:=uPredUR _) (λ _ x, P) m)
format "[∗ map] k ↦ x ∈ m , P") : uPred_scope.
Notation "'[∗' 'map]' x ∈ m , P" := (big_opM uPred_sep (λ _ x, P) m)
(at level 200, m at level 10, x at level 1, right associativity,
format "[∗ map ] x ∈ m , P") : uPred_scope.
format "[∗ map] x ∈ m , P") : uPred_scope.
Notation "'[∗' 'set' ] x ∈ X , P" := (big_opS (M:=uPredUR _) (λ x, P) X)
Notation "'[∗' 'set]' x ∈ X , P" := (big_opS uPred_sep (λ x, P) X)
(at level 200, X at level 10, x at level 1, right associativity,
format "[∗ set ] x ∈ X , P") : uPred_scope.
format "[∗ set] x ∈ X , P") : uPred_scope.
Notation "'[∗' 'mset' ] x ∈ X , P" := (big_opMS (M:=uPredUR _) (λ x, P) X)
Notation "'[∗' 'mset]' x ∈ X , P" := (big_opMS uPred_sep (λ x, P) X)
(at level 200, X at level 10, x at level 1, right associativity,
format "[∗ mset ] x ∈ X , P") : uPred_scope.
(** * 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.
format "[∗ mset] x ∈ X , P") : uPred_scope.
(** * Properties *)
Section big_op.
......@@ -127,52 +36,6 @@ Context {M : ucmraT}.
Implicit Types Ps Qs : list (uPred M).
Implicit Types A : Type.
Global Instance nil_persistent : PersistentL (@nil (uPred M)).
Proof. constructor. Qed.
Global Instance cons_persistent P Ps :
PersistentP P PersistentL Ps PersistentL (P :: Ps).
Proof. by constructor. Qed.
Global Instance app_persistent Ps Ps' :
PersistentL Ps PersistentL Ps' PersistentL (Ps ++ Ps').
Proof. apply Forall_app_2. Qed.
Global Instance fmap_persistent {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_persistent {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_persistent {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 big_sep_timeless Ps : TimelessL Ps TimelessP ([] Ps).
Proof. induction 1; apply _. Qed.
Global Instance nil_timeless : TimelessL (@nil (uPred M)).
Proof. constructor. Qed.
Global Instance cons_timeless P Ps :
TimelessP P TimelessL Ps TimelessL (P :: Ps).
Proof. by constructor. Qed.
Global Instance app_timeless Ps Ps' :
TimelessL Ps TimelessL Ps' TimelessL (Ps ++ Ps').
Proof. apply Forall_app_2. Qed.
Global Instance fmap_timeless {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_timeless {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_timeless {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.
(** ** Big ops over lists *)
Section list.
Context {A : Type}.
......@@ -203,14 +66,14 @@ Section list.
Proof. apply big_opL_proper. Qed.
Lemma big_sepL_submseteq (Φ : A uPred M) l1 l2 :
l1 + l2 ([ list] y l2, Φ y) [ list] y l1, Φ y.
Proof. intros ?. apply uPred_included. by apply: big_opL_submseteq. Qed.
Proof. intros [l ->]%submseteq_Permutation. by rewrite big_sepL_app sep_elim_l. Qed.
Global Instance big_sepL_mono' :
Proper (pointwise_relation _ (pointwise_relation _ ()) ==> (=) ==> ())
(big_opL (M:=uPredUR M) (A:=A)).
(big_opL (@uPred_sep M) (A:=A)).
Proof. intros f g Hf m ? <-. apply big_opL_forall; apply _ || intros; apply Hf. Qed.
Global Instance big_sep_mono' :
Proper (Forall2 () ==> ()) (big_opL (M:=uPredUR M) (λ _ P, P)).
Proper (Forall2 () ==> ()) (big_opL (@uPred_sep M) (λ _ P, P)).
Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed.
Lemma big_sepL_lookup_acc Φ l i x :
......@@ -224,11 +87,13 @@ Section list.
Lemma big_sepL_lookup Φ l i x :
l !! i = Some x ([ list] ky l, Φ k y) Φ i x.
Proof. intros. apply uPred_included. by apply: big_opL_lookup. Qed.
Proof. intros. by rewrite big_sepL_lookup_acc // sep_elim_l. Qed.
Lemma big_sepL_elem_of (Φ : A uPred M) l x :
x l ([ list] y l, Φ y) Φ x.
Proof. intros. apply uPred_included. by apply: big_opL_elem_of. Qed.
Proof.
intros [i ?]%elem_of_list_lookup; eauto using (big_sepL_lookup (λ _, Φ)).
Qed.
Lemma big_sepL_fmap {B} (f : A B) (Φ : nat B uPred M) l :
([ list] ky f <$> l, Φ k y) ⊣⊢ ([ list] ky l, Φ k (f y)).
......@@ -313,7 +178,7 @@ Section list2.
([ list] kx zip_with f l1 l2, Φ k x)
⊣⊢ ([ list] kx l1, y, l2 !! k = Some y Φ k (f x y)).
Proof.
revert Φ l2; induction l1 as [|x l1 IH]=> Φ [|y l2]//.
revert Φ l2; induction l1 as [|x l1 IH]=> Φ [|y l2] //.
- apply (anti_symm _), True_intro.
trans ([ list] __ x :: l1, True : uPred M)%I.
+ rewrite big_sepL_forall. auto using forall_intro, impl_intro_l, True_intro.
......@@ -346,7 +211,7 @@ Section gmap.
Global Instance big_sepM_mono' :
Proper (pointwise_relation _ (pointwise_relation _ ()) ==> (=) ==> ())
(big_opM (M:=uPredUR M) (A:=A)).
(big_opM (@uPred_sep M) (A:=A)).
Proof. intros f g Hf m ? <-. apply big_opM_forall; apply _ || intros; apply Hf. Qed.
Lemma big_sepM_empty Φ : ([ map] kx , Φ k x) ⊣⊢ True.
......@@ -357,12 +222,12 @@ Section gmap.