Commit dff7eb3c authored by Robbert Krebbers's avatar Robbert Krebbers

Merge branch 'master' of gitlab.mpi-sws.org:FP/iris-coq

parents c05f2a06 978eec47
...@@ -130,11 +130,11 @@ Lemma to_agree_car n (x : agree A) : ✓{n} x → to_agree (x n) ≡{n}≡ x. ...@@ -130,11 +130,11 @@ Lemma to_agree_car n (x : agree A) : ✓{n} x → to_agree (x n) ≡{n}≡ x.
Proof. intros [??]; split; naive_solver eauto using agree_valid_le. Qed. Proof. intros [??]; split; naive_solver eauto using agree_valid_le. Qed.
(** Internalized properties *) (** Internalized properties *)
Lemma agree_equivI {M} a b : (to_agree a to_agree b)%I (a b : uPred M)%I. Lemma agree_equivI {M} a b : (to_agree a to_agree b) (a b : uPred M).
Proof. Proof.
uPred.unseal. do 2 split. by intros [? Hv]; apply (Hv n). apply: to_agree_ne. uPred.unseal. do 2 split. by intros [? Hv]; apply (Hv n). apply: to_agree_ne.
Qed. Qed.
Lemma agree_validI {M} x y : (x y) (x y : uPred M). Lemma agree_validI {M} x y : (x y) (x y : uPred M).
Proof. uPred.unseal; split=> r n _ ?; by apply: agree_op_inv. Qed. Proof. uPred.unseal; split=> r n _ ?; by apply: agree_op_inv. Qed.
End agree. End agree.
......
...@@ -138,14 +138,14 @@ Admitted. ...@@ -138,14 +138,14 @@ Admitted.
(** Internalized properties *) (** Internalized properties *)
Lemma auth_equivI {M} (x y : auth A) : Lemma auth_equivI {M} (x y : auth A) :
(x y)%I (authoritative x authoritative y own x own y : uPred M)%I. (x y) (authoritative x authoritative y own x own y : uPred M).
Proof. by uPred.unseal. Qed. Proof. by uPred.unseal. Qed.
Lemma auth_validI {M} (x : auth A) : Lemma auth_validI {M} (x : auth A) :
( x)%I (match authoritative x with ( x) (match authoritative x with
| Excl a => ( b, a own x b) a | Excl a => ( b, a own x b) a
| ExclUnit => own x | ExclUnit => own x
| ExclBot => False | ExclBot => False
end : uPred M)%I. end : uPred M).
Proof. uPred.unseal. by destruct x as [[]]. Qed. Proof. uPred.unseal. by destruct x as [[]]. Qed.
(** The notations ◯ and ● only work for CMRAs with an empty element. So, in (** The notations ◯ and ● only work for CMRAs with an empty element. So, in
......
...@@ -138,16 +138,16 @@ Qed. ...@@ -138,16 +138,16 @@ Qed.
(** Internalized properties *) (** Internalized properties *)
Lemma excl_equivI {M} (x y : excl A) : Lemma excl_equivI {M} (x y : excl A) :
(x y)%I (match x, y with (x y) (match x, y with
| Excl a, Excl b => a b | Excl a, Excl b => a b
| ExclUnit, ExclUnit | ExclBot, ExclBot => True | ExclUnit, ExclUnit | ExclBot, ExclBot => True
| _, _ => False | _, _ => False
end : uPred M)%I. end : uPred M).
Proof. Proof.
uPred.unseal. do 2 split. by destruct 1. by destruct x, y; try constructor. uPred.unseal. do 2 split. by destruct 1. by destruct x, y; try constructor.
Qed. Qed.
Lemma excl_validI {M} (x : excl A) : Lemma excl_validI {M} (x : excl A) :
( x)%I (if x is ExclBot then False else True : uPred M)%I. ( x) (if x is ExclBot then False else True : uPred M).
Proof. uPred.unseal. by destruct x. Qed. Proof. uPred.unseal. by destruct x. Qed.
(** ** Local updates *) (** ** Local updates *)
......
...@@ -164,9 +164,9 @@ Global Instance map_cmra_discrete : CMRADiscrete A → CMRADiscrete mapR. ...@@ -164,9 +164,9 @@ Global Instance map_cmra_discrete : CMRADiscrete A → CMRADiscrete mapR.
Proof. split; [apply _|]. intros m ? i. by apply: cmra_discrete_valid. Qed. Proof. split; [apply _|]. intros m ? i. by apply: cmra_discrete_valid. Qed.
(** Internalized properties *) (** Internalized properties *)
Lemma map_equivI {M} m1 m2 : (m1 m2)%I ( i, m1 !! i m2 !! i : uPred M)%I. Lemma map_equivI {M} m1 m2 : (m1 m2) ( i, m1 !! i m2 !! i : uPred M).
Proof. by uPred.unseal. Qed. Proof. by uPred.unseal. Qed.
Lemma map_validI {M} m : ( m)%I ( i, (m !! i) : uPred M)%I. Lemma map_validI {M} m : ( m) ( i, (m !! i) : uPred M).
Proof. by uPred.unseal. Qed. Proof. by uPred.unseal. Qed.
End cmra. End cmra.
......
...@@ -177,17 +177,17 @@ Proof. intros. by apply frac_validN_inv_l with 0 a, cmra_valid_validN. Qed. ...@@ -177,17 +177,17 @@ Proof. intros. by apply frac_validN_inv_l with 0 a, cmra_valid_validN. Qed.
(** Internalized properties *) (** Internalized properties *)
Lemma frac_equivI {M} (x y : frac A) : Lemma frac_equivI {M} (x y : frac A) :
(x y)%I (match x, y with (x y) (match x, y with
| Frac q1 a, Frac q2 b => q1 = q2 a b | Frac q1 a, Frac q2 b => q1 = q2 a b
| FracUnit, FracUnit => True | FracUnit, FracUnit => True
| _, _ => False | _, _ => False
end : uPred M)%I. end : uPred M).
Proof. Proof.
uPred.unseal; do 2 split; first by destruct 1. uPred.unseal; do 2 split; first by destruct 1.
by destruct x, y; destruct 1; try constructor. by destruct x, y; destruct 1; try constructor.
Qed. Qed.
Lemma frac_validI {M} (x : frac A) : Lemma frac_validI {M} (x : frac A) :
( x)%I (if x is Frac q a then (q 1)%Qc a else True : uPred M)%I. ( x) (if x is Frac q a then (q 1)%Qc a else True : uPred M).
Proof. uPred.unseal. by destruct x. Qed. Proof. uPred.unseal. by destruct x. Qed.
(** ** Local updates *) (** ** Local updates *)
......
...@@ -164,9 +164,9 @@ Section iprod_cmra. ...@@ -164,9 +164,9 @@ Section iprod_cmra.
Qed. Qed.
(** Internalized properties *) (** Internalized properties *)
Lemma iprod_equivI {M} g1 g2 : (g1 g2)%I ( i, g1 i g2 i : uPred M)%I. Lemma iprod_equivI {M} g1 g2 : (g1 g2) ( i, g1 i g2 i : uPred M).
Proof. by uPred.unseal. Qed. Proof. by uPred.unseal. Qed.
Lemma iprod_validI {M} g : ( g)%I ( i, g i : uPred M)%I. Lemma iprod_validI {M} g : ( g) ( i, g i : uPred M).
Proof. by uPred.unseal. Qed. Proof. by uPred.unseal. Qed.
(** Properties of iprod_insert. *) (** Properties of iprod_insert. *)
......
...@@ -132,14 +132,14 @@ Proof. by destruct mx, my; inversion_clear 1. Qed. ...@@ -132,14 +132,14 @@ Proof. by destruct mx, my; inversion_clear 1. Qed.
(** Internalized properties *) (** Internalized properties *)
Lemma option_equivI {M} (x y : option A) : Lemma option_equivI {M} (x y : option A) :
(x y)%I (match x, y with (x y) (match x, y with
| Some a, Some b => a b | None, None => True | _, _ => False | Some a, Some b => a b | None, None => True | _, _ => False
end : uPred M)%I. end : uPred M).
Proof. Proof.
uPred.unseal. do 2 split. by destruct 1. by destruct x, y; try constructor. uPred.unseal. do 2 split. by destruct 1. by destruct x, y; try constructor.
Qed. Qed.
Lemma option_validI {M} (x : option A) : Lemma option_validI {M} (x : option A) :
( x)%I (match x with Some a => a | None => True end : uPred M)%I. ( x) (match x with Some a => a | None => True end : uPred M).
Proof. uPred.unseal. by destruct x. Qed. Proof. uPred.unseal. by destruct x. Qed.
(** Updates *) (** Updates *)
......
This diff is collapsed.
...@@ -39,9 +39,9 @@ Implicit Types Ps Qs : list (uPred M). ...@@ -39,9 +39,9 @@ Implicit Types Ps Qs : list (uPred M).
Implicit Types A : Type. Implicit Types A : Type.
(* Big ops *) (* Big ops *)
Global Instance big_and_proper : Proper (() ==> ()) (@uPred_big_and M). Global Instance big_and_proper : Proper (() ==> ()) (@uPred_big_and M).
Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed. Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed.
Global Instance big_sep_proper : Proper (() ==> ()) (@uPred_big_sep M). Global Instance big_sep_proper : Proper (() ==> ()) (@uPred_big_sep M).
Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed. Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed.
Global Instance big_and_ne n : Global Instance big_and_ne n :
...@@ -51,19 +51,19 @@ Global Instance big_sep_ne n : ...@@ -51,19 +51,19 @@ Global Instance big_sep_ne n :
Proper (Forall2 (dist n) ==> dist n) (@uPred_big_sep M). Proper (Forall2 (dist n) ==> dist n) (@uPred_big_sep M).
Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed. Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed.
Global Instance big_and_mono' : Proper (Forall2 () ==> ()) (@uPred_big_and M). Global Instance big_and_mono' : Proper (Forall2 () ==> ()) (@uPred_big_and M).
Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed. Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed.
Global Instance big_sep_mono' : Proper (Forall2 () ==> ()) (@uPred_big_sep M). Global Instance big_sep_mono' : Proper (Forall2 () ==> ()) (@uPred_big_sep M).
Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed. Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed.
Global Instance big_and_perm : Proper (() ==> ()) (@uPred_big_and M). Global Instance big_and_perm : Proper (() ==> ()) (@uPred_big_and M).
Proof. Proof.
induction 1 as [|P Ps Qs ? IH|P Q Ps|]; simpl; auto. induction 1 as [|P Ps Qs ? IH|P Q Ps|]; simpl; auto.
- by rewrite IH. - by rewrite IH.
- by rewrite !assoc (comm _ P). - by rewrite !assoc (comm _ P).
- etrans; eauto. - etrans; eauto.
Qed. Qed.
Global Instance big_sep_perm : Proper (() ==> ()) (@uPred_big_sep M). Global Instance big_sep_perm : Proper (() ==> ()) (@uPred_big_sep M).
Proof. Proof.
induction 1 as [|P Ps Qs ? IH|P Q Ps|]; simpl; auto. induction 1 as [|P Ps Qs ? IH|P Q Ps|]; simpl; auto.
- by rewrite IH. - by rewrite IH.
...@@ -71,26 +71,26 @@ Proof. ...@@ -71,26 +71,26 @@ Proof.
- etrans; eauto. - etrans; eauto.
Qed. Qed.
Lemma big_and_app Ps Qs : (Π (Ps ++ Qs))%I (Π Ps Π Qs)%I. Lemma big_and_app Ps Qs : (Π (Ps ++ Qs)) (Π Ps Π Qs).
Proof. by induction Ps as [|?? IH]; rewrite /= ?left_id -?assoc ?IH. Qed. Proof. by induction Ps as [|?? IH]; rewrite /= ?left_id -?assoc ?IH. Qed.
Lemma big_sep_app Ps Qs : (Π★ (Ps ++ Qs))%I (Π★ Ps Π★ Qs)%I. Lemma big_sep_app Ps Qs : (Π★ (Ps ++ Qs)) (Π★ Ps Π★ Qs).
Proof. by induction Ps as [|?? IH]; rewrite /= ?left_id -?assoc ?IH. Qed. Proof. by induction Ps as [|?? IH]; rewrite /= ?left_id -?assoc ?IH. Qed.
Lemma big_and_contains Ps Qs : Qs `contains` Ps (Π Ps)%I (Π Qs)%I. Lemma big_and_contains Ps Qs : Qs `contains` Ps (Π Ps) (Π Qs).
Proof. Proof.
intros [Ps' ->]%contains_Permutation. by rewrite big_and_app and_elim_l. intros [Ps' ->]%contains_Permutation. by rewrite big_and_app and_elim_l.
Qed. Qed.
Lemma big_sep_contains Ps Qs : Qs `contains` Ps (Π★ Ps)%I (Π★ Qs)%I. Lemma big_sep_contains Ps Qs : Qs `contains` Ps (Π★ Ps) (Π★ Qs).
Proof. Proof.
intros [Ps' ->]%contains_Permutation. by rewrite big_sep_app sep_elim_l. intros [Ps' ->]%contains_Permutation. by rewrite big_sep_app sep_elim_l.
Qed. Qed.
Lemma big_sep_and Ps : (Π★ Ps) (Π Ps). Lemma big_sep_and Ps : (Π★ Ps) (Π Ps).
Proof. by induction Ps as [|P Ps IH]; simpl; auto with I. Qed. Proof. by induction Ps as [|P Ps IH]; simpl; auto with I. Qed.
Lemma big_and_elem_of Ps P : P Ps (Π Ps) P. Lemma big_and_elem_of Ps P : P Ps (Π Ps) P.
Proof. induction 1; simpl; auto with I. Qed. Proof. induction 1; simpl; auto with I. Qed.
Lemma big_sep_elem_of Ps P : P Ps (Π★ Ps) P. Lemma big_sep_elem_of Ps P : P Ps (Π★ Ps) P.
Proof. induction 1; simpl; auto with I. Qed. Proof. induction 1; simpl; auto with I. Qed.
(* Big ops over finite maps *) (* Big ops over finite maps *)
...@@ -100,8 +100,8 @@ Section gmap. ...@@ -100,8 +100,8 @@ Section gmap.
Implicit Types Φ Ψ : K A uPred M. Implicit Types Φ Ψ : K A uPred M.
Lemma big_sepM_mono Φ Ψ m1 m2 : Lemma big_sepM_mono Φ Ψ m1 m2 :
m2 m1 ( x k, m2 !! k = Some x Φ k x Ψ k x) m2 m1 ( x k, m2 !! k = Some x Φ k x Ψ k x)
(Π★{map m1} Φ) (Π★{map m2} Ψ). (Π★{map m1} Φ) (Π★{map m2} Ψ).
Proof. Proof.
intros HX HΦ. trans (Π★{map m2} Φ)%I. intros HX HΦ. trans (Π★{map m2} Φ)%I.
- by apply big_sep_contains, fmap_contains, map_to_list_contains. - by apply big_sep_contains, fmap_contains, map_to_list_contains.
...@@ -117,36 +117,36 @@ Section gmap. ...@@ -117,36 +117,36 @@ Section gmap.
apply Forall2_Forall, Forall_true=> -[i x]; apply HΦ. apply Forall2_Forall, Forall_true=> -[i x]; apply HΦ.
Qed. Qed.
Global Instance big_sepM_proper m : Global Instance big_sepM_proper m :
Proper (pointwise_relation _ (pointwise_relation _ ()) ==> ()) Proper (pointwise_relation _ (pointwise_relation _ ()) ==> ())
(uPred_big_sepM (M:=M) m). (uPred_big_sepM (M:=M) m).
Proof. Proof.
intros Φ1 Φ2 HΦ; apply equiv_dist=> n. intros Φ1 Φ2 HΦ; apply equiv_dist=> n.
apply big_sepM_ne=> k x; apply equiv_dist, HΦ. apply big_sepM_ne=> k x; apply equiv_dist, HΦ.
Qed. Qed.
Global Instance big_sepM_mono' m : Global Instance big_sepM_mono' m :
Proper (pointwise_relation _ (pointwise_relation _ ()) ==> ()) Proper (pointwise_relation _ (pointwise_relation _ ()) ==> ())
(uPred_big_sepM (M:=M) m). (uPred_big_sepM (M:=M) m).
Proof. intros Φ1 Φ2 HΦ. apply big_sepM_mono; intros; [done|apply HΦ]. Qed. Proof. intros Φ1 Φ2 HΦ. apply big_sepM_mono; intros; [done|apply HΦ]. Qed.
Lemma big_sepM_empty Φ : (Π★{map } Φ)%I True%I. Lemma big_sepM_empty Φ : (Π★{map } Φ) True.
Proof. by rewrite /uPred_big_sepM map_to_list_empty. Qed. Proof. by rewrite /uPred_big_sepM map_to_list_empty. Qed.
Lemma big_sepM_insert Φ (m : gmap K A) i x : Lemma big_sepM_insert Φ (m : gmap K A) i x :
m !! i = None (Π★{map <[i:=x]> m} Φ)%I (Φ i x Π★{map m} Φ)%I. m !! i = None (Π★{map <[i:=x]> m} Φ) (Φ i x Π★{map m} Φ).
Proof. intros ?; by rewrite /uPred_big_sepM map_to_list_insert. Qed. Proof. intros ?; by rewrite /uPred_big_sepM map_to_list_insert. Qed.
Lemma big_sepM_singleton Φ i x : (Π★{map {[i := x]}} Φ)%I (Φ i x)%I. Lemma big_sepM_singleton Φ i x : (Π★{map {[i := x]}} Φ) (Φ i x).
Proof. Proof.
rewrite -insert_empty big_sepM_insert/=; last auto using lookup_empty. rewrite -insert_empty big_sepM_insert/=; last auto using lookup_empty.
by rewrite big_sepM_empty right_id. by rewrite big_sepM_empty right_id.
Qed. Qed.
Lemma big_sepM_sepM Φ Ψ m : Lemma big_sepM_sepM Φ Ψ m :
(Π★{map m} (λ i x, Φ i x Ψ i x))%I (Π★{map m} Φ Π★{map m} Ψ)%I. (Π★{map m} (λ i x, Φ i x Ψ i x)) (Π★{map m} Φ Π★{map m} Ψ).
Proof. Proof.
rewrite /uPred_big_sepM. rewrite /uPred_big_sepM.
induction (map_to_list m) as [|[i x] l IH]; csimpl; rewrite ?right_id //. induction (map_to_list m) as [|[i x] l IH]; csimpl; rewrite ?right_id //.
by rewrite IH -!assoc (assoc _ (Ψ _ _)) [(Ψ _ _ _)%I]comm -!assoc. by rewrite IH -!assoc (assoc _ (Ψ _ _)) [(Ψ _ _ _)%I]comm -!assoc.
Qed. Qed.
Lemma big_sepM_later Φ m : ( Π★{map m} Φ)%I (Π★{map m} (λ i x, Φ i x))%I. Lemma big_sepM_later Φ m : ( Π★{map m} Φ) (Π★{map m} (λ i x, Φ i x)).
Proof. Proof.
rewrite /uPred_big_sepM. rewrite /uPred_big_sepM.
induction (map_to_list m) as [|[i x] l IH]; csimpl; rewrite ?later_True //. induction (map_to_list m) as [|[i x] l IH]; csimpl; rewrite ?later_True //.
...@@ -161,7 +161,7 @@ Section gset. ...@@ -161,7 +161,7 @@ Section gset.
Implicit Types Φ : A uPred M. Implicit Types Φ : A uPred M.
Lemma big_sepS_mono Φ Ψ X Y : Lemma big_sepS_mono Φ Ψ X Y :
Y X ( x, x Y Φ x Ψ x) (Π★{set X} Φ) (Π★{set Y} Ψ). Y X ( x, x Y Φ x Ψ x) (Π★{set X} Φ) (Π★{set Y} Ψ).
Proof. Proof.
intros HX HΦ. trans (Π★{set Y} Φ)%I. intros HX HΦ. trans (Π★{set Y} Φ)%I.
- by apply big_sep_contains, fmap_contains, elements_contains. - by apply big_sep_contains, fmap_contains, elements_contains.
...@@ -176,38 +176,38 @@ Section gset. ...@@ -176,38 +176,38 @@ Section gset.
apply Forall2_Forall, Forall_true=> x; apply HΦ. apply Forall2_Forall, Forall_true=> x; apply HΦ.
Qed. Qed.
Lemma big_sepS_proper X : Lemma big_sepS_proper X :
Proper (pointwise_relation _ () ==> ()) (uPred_big_sepS (M:=M) X). Proper (pointwise_relation _ () ==> ()) (uPred_big_sepS (M:=M) X).
Proof. Proof.
intros Φ1 Φ2 HΦ; apply equiv_dist=> n. intros Φ1 Φ2 HΦ; apply equiv_dist=> n.
apply big_sepS_ne=> x; apply equiv_dist, HΦ. apply big_sepS_ne=> x; apply equiv_dist, HΦ.
Qed. Qed.
Lemma big_sepS_mono' X : Lemma big_sepS_mono' X :
Proper (pointwise_relation _ () ==> ()) (uPred_big_sepS (M:=M) X). Proper (pointwise_relation _ () ==> ()) (uPred_big_sepS (M:=M) X).
Proof. intros Φ1 Φ2 HΦ. apply big_sepS_mono; naive_solver. Qed. Proof. intros Φ1 Φ2 HΦ. apply big_sepS_mono; naive_solver. Qed.
Lemma big_sepS_empty Φ : (Π★{set } Φ)%I True%I. Lemma big_sepS_empty Φ : (Π★{set } Φ) True.
Proof. by rewrite /uPred_big_sepS elements_empty. Qed. Proof. by rewrite /uPred_big_sepS elements_empty. Qed.
Lemma big_sepS_insert Φ X x : Lemma big_sepS_insert Φ X x :
x X (Π★{set {[ x ]} X} Φ)%I (Φ x Π★{set X} Φ)%I. x X (Π★{set {[ x ]} X} Φ) (Φ x Π★{set X} Φ).
Proof. intros. by rewrite /uPred_big_sepS elements_union_singleton. Qed. Proof. intros. by rewrite /uPred_big_sepS elements_union_singleton. Qed.
Lemma big_sepS_delete Φ X x : Lemma big_sepS_delete Φ X x :
x X (Π★{set X} Φ)%I (Φ x Π★{set X {[ x ]}} Φ)%I. x X (Π★{set X} Φ) (Φ x Π★{set X {[ x ]}} Φ).
Proof. Proof.
intros. rewrite -big_sepS_insert; last set_solver. intros. rewrite -big_sepS_insert; last set_solver.
by rewrite -union_difference_L; last set_solver. by rewrite -union_difference_L; last set_solver.
Qed. Qed.
Lemma big_sepS_singleton Φ x : (Π★{set {[ x ]}} Φ)%I (Φ x)%I. Lemma big_sepS_singleton Φ x : (Π★{set {[ x ]}} Φ) (Φ x).
Proof. intros. by rewrite /uPred_big_sepS elements_singleton /= right_id. Qed. Proof. intros. by rewrite /uPred_big_sepS elements_singleton /= right_id. Qed.
Lemma big_sepS_sepS Φ Ψ X : Lemma big_sepS_sepS Φ Ψ X :
(Π★{set X} (λ x, Φ x Ψ x))%I (Π★{set X} Φ Π★{set X} Ψ)%I. (Π★{set X} (λ x, Φ x Ψ x)) (Π★{set X} Φ Π★{set X} Ψ).
Proof. Proof.
rewrite /uPred_big_sepS. rewrite /uPred_big_sepS.
induction (elements X) as [|x l IH]; csimpl; first by rewrite ?right_id. induction (elements X) as [|x l IH]; csimpl; first by rewrite ?right_id.
by rewrite IH -!assoc (assoc _ (Ψ _)) [(Ψ _ _)%I]comm -!assoc. by rewrite IH -!assoc (assoc _ (Ψ _)) [(Ψ _ _)%I]comm -!assoc.
Qed. Qed.
Lemma big_sepS_later Φ X : ( Π★{set X} Φ)%I (Π★{set X} (λ x, Φ x))%I. Lemma big_sepS_later Φ X : ( Π★{set X} Φ) (Π★{set X} (λ x, Φ x)).
Proof. Proof.
rewrite /uPred_big_sepS. rewrite /uPred_big_sepS.
induction (elements X) as [|x l IH]; csimpl; first by rewrite ?later_True. induction (elements X) as [|x l IH]; csimpl; first by rewrite ?later_True.
......
...@@ -24,18 +24,18 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -24,18 +24,18 @@ Module uPred_reflection. Section uPred_reflection.
Notation eval_list Σ l := Notation eval_list Σ l :=
(uPred_big_sep ((λ n, from_option True%I (Σ !! n)) <$> l)). (uPred_big_sep ((λ n, from_option True%I (Σ !! n)) <$> l)).
Lemma eval_flatten Σ e : eval Σ e eval_list Σ (flatten e). Lemma eval_flatten Σ e : eval Σ e eval_list Σ (flatten e).
Proof. Proof.
induction e as [| |e1 IH1 e2 IH2]; induction e as [| |e1 IH1 e2 IH2];
rewrite /= ?right_id ?fmap_app ?big_sep_app ?IH1 ?IH2 //. rewrite /= ?right_id ?fmap_app ?big_sep_app ?IH1 ?IH2 //.
Qed. Qed.
Lemma flatten_entails Σ e1 e2 : Lemma flatten_entails Σ e1 e2 :
flatten e2 `contains` flatten e1 eval Σ e1 eval Σ e2. flatten e2 `contains` flatten e1 eval Σ e1 eval Σ e2.
Proof. Proof.
intros. rewrite !eval_flatten. by apply big_sep_contains, fmap_contains. intros. rewrite !eval_flatten. by apply big_sep_contains, fmap_contains.
Qed. Qed.
Lemma flatten_equiv Σ e1 e2 : Lemma flatten_equiv Σ e1 e2 :
flatten e2 flatten e1 eval Σ e1 eval Σ e2. flatten e2 flatten e1 eval Σ e1 eval Σ e2.
Proof. intros He. by rewrite !eval_flatten He. Qed. Proof. intros He. by rewrite !eval_flatten He. Qed.
Fixpoint prune (e : expr) : expr := Fixpoint prune (e : expr) : expr :=
...@@ -54,7 +54,7 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -54,7 +54,7 @@ Module uPred_reflection. Section uPred_reflection.
induction e as [| |e1 IH1 e2 IH2]; simplify_eq/=; auto. induction e as [| |e1 IH1 e2 IH2]; simplify_eq/=; auto.
rewrite -IH1 -IH2. by repeat case_match; rewrite ?right_id_L. rewrite -IH1 -IH2. by repeat case_match; rewrite ?right_id_L.
Qed. Qed.
Lemma prune_correct Σ e : eval Σ (prune e) eval Σ e. Lemma prune_correct Σ e : eval Σ (prune e) eval Σ e.
Proof. by rewrite !eval_flatten flatten_prune. Qed. Proof. by rewrite !eval_flatten flatten_prune. Qed.
Fixpoint cancel_go (n : nat) (e : expr) : option expr := Fixpoint cancel_go (n : nat) (e : expr) : option expr :=
...@@ -86,7 +86,7 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -86,7 +86,7 @@ Module uPred_reflection. Section uPred_reflection.
Qed. Qed.
Lemma cancel_entails Σ e1 e2 e1' e2' ns : Lemma cancel_entails Σ e1 e2 e1' e2' ns :
cancel ns e1 = Some e1' cancel ns e2 = Some e2' cancel ns e1 = Some e1' cancel ns e2 = Some e2'
eval Σ e1' eval Σ e2' eval Σ e1 eval Σ e2. eval Σ e1' eval Σ e2' eval Σ e1 eval Σ e2.
Proof. Proof.
intros ??. rewrite !eval_flatten. intros ??. rewrite !eval_flatten.
rewrite (flatten_cancel e1 e1' ns) // (flatten_cancel e2 e2' ns) //; csimpl. rewrite (flatten_cancel e1 e1' ns) // (flatten_cancel e2 e2' ns) //; csimpl.
...@@ -100,20 +100,20 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -100,20 +100,20 @@ Module uPred_reflection. Section uPred_reflection.
| n :: l => ESep (EVar n) (to_expr l) | n :: l => ESep (EVar n) (to_expr l)
end. end.
Arguments to_expr !_ / : simpl nomatch. Arguments to_expr !_ / : simpl nomatch.
Lemma eval_to_expr Σ l : eval Σ (to_expr l) eval_list Σ l. Lemma eval_to_expr Σ l : eval Σ (to_expr l) eval_list Σ l.
Proof. Proof.
induction l as [|n1 [|n2 l] IH]; csimpl; rewrite ?right_id //. induction l as [|n1 [|n2 l] IH]; csimpl; rewrite ?right_id //.
by rewrite IH. by rewrite IH.
Qed. Qed.
Lemma split_l Σ e ns e' : Lemma split_l Σ e ns e' :
cancel ns e = Some e' eval Σ e (eval Σ (to_expr ns) eval Σ e')%I. cancel ns e = Some e' eval Σ e (eval Σ (to_expr ns) eval Σ e').
Proof. Proof.
intros He%flatten_cancel. intros He%flatten_cancel.
by rewrite eval_flatten He fmap_app big_sep_app eval_to_expr eval_flatten. by rewrite eval_flatten He fmap_app big_sep_app eval_to_expr eval_flatten.
Qed. Qed.
Lemma split_r Σ e ns e' : Lemma split_r Σ e ns e' :
cancel ns e = Some e' eval Σ e (eval Σ e' eval Σ (to_expr ns))%I. cancel ns e = Some e' eval Σ e (eval Σ e' eval Σ (to_expr ns)).
Proof. intros. rewrite /= comm. by apply split_l. Qed. Proof. intros. rewrite /= comm. by apply split_l. Qed.
Class Quote (Σ1 Σ2 : list (uPred M)) (P : uPred M) (e : expr) := {}. Class Quote (Σ1 Σ2 : list (uPred M)) (P : uPred M) (e : expr) := {}.
...@@ -132,16 +132,16 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -132,16 +132,16 @@ Module uPred_reflection. Section uPred_reflection.
Ltac quote := Ltac quote :=
match goal with match goal with
| |- ?P1 ?P2 => | |- ?P1 ?P2 =>
lazymatch type of (_ : Quote [] _ P1 _) with Quote _ ?Σ2 _ ?e1 => lazymatch type of (_ : Quote [] _ P1 _) with Quote _ ?Σ2 _ ?e1 =>
lazymatch type of (_ : Quote Σ2 _ P2 _) with Quote _ ?Σ3 _ ?e2 => lazymatch type of (_ : Quote Σ2 _ P2 _) with Quote _ ?Σ3 _ ?e2 =>
change (eval Σ3 e1 eval Σ3 e2) end end change (eval Σ3 e1 eval Σ3 e2) end end
end. end.
Ltac quote_l := Ltac quote_l :=
match goal with match goal with
| |- ?P1 ?P2 => | |- ?P1 ?P2 =>
lazymatch type of (_ : Quote [] _ P1 _) with Quote _ ?Σ2 _ ?e1 => lazymatch type of (_ : Quote [] _ P1 _) with Quote _ ?Σ2 _ ?e1 =>
change (eval Σ2 e1 P2) end change (eval Σ2 e1 P2) end
end. end.