Commit 30a36cf2 authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan

Move internal_eq in the sbi interface.

parent 1addf2ac
......@@ -349,7 +349,7 @@ Definition unseal_eqs :=
Ltac unseal := (* Coq unfold is used to circumvent bug #5699 in rewrite /foo *)
unfold bi_emp; simpl;
unfold uPred_emp, bi_pure, bi_and, bi_or, bi_impl, bi_forall, bi_exist,
bi_internal_eq, bi_sep, bi_wand, bi_plainly, bi_persistently, sbi_later; simpl;
bi_sep, bi_wand, bi_plainly, bi_persistently, sbi_internal_eq, sbi_later; simpl;
unfold sbi_emp, sbi_pure, sbi_and, sbi_or, sbi_impl, sbi_forall, sbi_exist,
sbi_internal_eq, sbi_sep, sbi_wand, sbi_plainly, sbi_persistently; simpl;
rewrite !unseal_eqs /=.
......@@ -358,10 +358,11 @@ Import uPred_unseal.
Local Arguments uPred_holds {_} !_ _ _ /.
Lemma uPred_bi_mixin (M : ucmraT) : BiMixin (ofe_mixin_of (uPred M))
uPred_entails uPred_emp uPred_pure uPred_and uPred_or uPred_impl
(@uPred_forall M) (@uPred_exist M) (@uPred_internal_eq M)
uPred_sep uPred_wand uPred_plainly uPred_persistently.
Lemma uPred_bi_mixin (M : ucmraT) :
BiMixin
uPred_entails uPred_emp uPred_pure uPred_and uPred_or uPred_impl
(@uPred_forall M) (@uPred_exist M) uPred_sep uPred_wand uPred_plainly
uPred_persistently.
Proof.
split.
- (* PreOrder uPred_entails *)
......@@ -403,10 +404,6 @@ Proof.
- (* NonExpansive uPred_persistently *)
intros n P1 P2 HP.
unseal; split=> n' x; split; apply HP; eauto using @cmra_core_validN.
- (* NonExpansive2 (@uPred_internal_eq M A) *)
intros A n x x' Hx y y' Hy; split=> n' z; unseal; split; intros; simpl in *.
+ by rewrite -(dist_le _ _ _ _ Hx) -?(dist_le _ _ _ _ Hy); auto.
+ by rewrite (dist_le _ _ _ _ Hx) ?(dist_le _ _ _ _ Hy); auto.
- (* φ → P ⊢ ⌜φ⌝ *)
intros P φ ?. unseal; by split.
- (* (φ → True ⊢ P) → ⌜φ⌝ ⊢ P *)
......@@ -438,17 +435,6 @@ Proof.
intros A Ψ a. unseal; split=> n x ??; by exists a.
- (* (∀ a, Ψ a ⊢ Q) → (∃ a, Ψ a) ⊢ Q *)
intros A Ψ Q. unseal; intros HΨ; split=> n x ? [a ?]; by apply HΨ with a.
- (* P ⊢ a ≡ a *)
intros A P a. unseal; by split=> n x ?? /=.
- (* a ≡ b ⊢ Ψ a → Ψ b *)
intros A a b Ψ Hnonexp.
unseal; split=> n x ? Hab n' x' ??? HΨ. eapply Hnonexp with n a; auto.
- (* (∀ x, f x ≡ g x) ⊢ f ≡ g *)
by unseal.
- (* `x ≡ `y ⊢ x ≡ y *)
by unseal.
- (* Discrete a → a ≡ b ⊣⊢ ⌜a ≡ b⌝ *)
intros A a b ?. unseal; split=> n x ?; by apply (discrete_iff n).
- (* (P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q' *)
intros P P' Q Q' HQ HQ'; unseal.
split; intros n' x ? (x1&x2&?&?&?); exists x1,x2; ofe_subst x;
......@@ -482,9 +468,6 @@ Proof.
unseal; split=> n x ?? //.
- (* (∀ a, bi_plainly (Ψ a)) ⊢ bi_plainly (∀ a, Ψ a) *)
by unseal.
- (* bi_plainly ((P → Q) ∧ (Q → P)) ⊢ P ≡ Q *)
unseal; split=> n x ? /= HPQ; split=> n' x' ? HP;
split; eapply HPQ; eauto using @ucmra_unit_least.
- (* (bi_plainly P → bi_persistently Q) ⊢ bi_persistently (bi_plainly P → Q) *)
unseal; split=> /= n x ? HPQ n' x' ????.
eapply uPred_mono with n' (core x)=>//; [|by apply cmra_included_includedN].
......@@ -518,15 +501,33 @@ Proof.
exists (core x), x; rewrite ?cmra_core_l; auto.
Qed.
Lemma uPred_sbi_mixin (M : ucmraT) : SbiMixin
uPred_entails uPred_pure uPred_or uPred_impl
(@uPred_forall M) (@uPred_exist M) (@uPred_internal_eq M)
uPred_sep uPred_plainly uPred_persistently uPred_later.
Lemma uPred_sbi_mixin (M : ucmraT) : SbiMixin uPred_ofe_mixin
uPred_entails uPred_pure uPred_and uPred_or uPred_impl
(@uPred_forall M) (@uPred_exist M) uPred_sep uPred_plainly uPred_persistently
(@uPred_internal_eq M) uPred_later.
Proof.
split.
- (* Contractive sbi_later *)
unseal; intros [|n] P Q HPQ; split=> -[|n'] x ?? //=; try omega.
apply HPQ; eauto using cmra_validN_S.
- (* NonExpansive2 (@uPred_internal_eq M A) *)
intros A n x x' Hx y y' Hy; split=> n' z; unseal; split; intros; simpl in *.
+ by rewrite -(dist_le _ _ _ _ Hx) -?(dist_le _ _ _ _ Hy); auto.
+ by rewrite (dist_le _ _ _ _ Hx) ?(dist_le _ _ _ _ Hy); auto.
- (* P ⊢ a ≡ a *)
intros A P a. unseal; by split=> n x ?? /=.
- (* a ≡ b ⊢ Ψ a → Ψ b *)
intros A a b Ψ Hnonexp.
unseal; split=> n x ? Hab n' x' ??? HΨ. eapply Hnonexp with n a; auto.
- (* (∀ x, f x ≡ g x) ⊢ f ≡ g *)
by unseal.
- (* `x ≡ `y ⊢ x ≡ y *)
by unseal.
- (* Discrete a → a ≡ b ⊣⊢ ⌜a ≡ b⌝ *)
intros A a b ?. unseal; split=> n x ?; by apply (discrete_iff n).
- (* bi_plainly ((P → Q) ∧ (Q → P)) ⊢ P ≡ Q *)
unseal; split=> n x ? /= HPQ; split=> n' x' ? HP;
split; eapply HPQ; eauto using @ucmra_unit_least.
- (* Next x ≡ Next y ⊢ ▷ (x ≡ y) *)
by unseal.
- (* ▷ (x ≡ y) ⊢ Next x ≡ Next y *)
......@@ -638,7 +639,7 @@ Lemma ownM_unit : bi_valid (uPred_ownM (ε:M)).
Proof. unseal; split=> n x ??; by exists x; rewrite left_id. Qed.
Lemma later_ownM (a : M) : uPred_ownM a b, uPred_ownM b (a b).
Proof.
rewrite /bi_and /sbi_later /bi_exist /bi_internal_eq /=; unseal.
rewrite /bi_and /sbi_later /bi_exist /sbi_internal_eq /=; unseal.
split=> -[|n] x /= ? Hax; first by eauto using ucmra_unit_leastN.
destruct Hax as [y ?].
destruct (cmra_extend n x a y) as (a'&y'&Hx&?&?); auto using cmra_validN_S.
......
This diff is collapsed.
......@@ -22,7 +22,6 @@ Class BiEmbedding (PROP1 PROP2 : bi) `{BiEmbed PROP1 PROP2} := {
bi_embed_impl_2 P Q : (P Q) P Q;
bi_embed_forall_2 A (Φ : A PROP1) : ( x, ⎡Φ x) x, Φ x;
bi_embed_exist_1 A (Φ : A PROP1) : x, Φ x x, ⎡Φ x;
bi_embed_internal_eq_1 (A : ofeT) (x y : A) : x y x y;
bi_embed_sep P Q : P Q P Q;
bi_embed_wand_2 P Q : (P - Q) P - Q;
bi_embed_plainly P : bi_plainly P bi_plainly P;
......@@ -31,6 +30,7 @@ Class BiEmbedding (PROP1 PROP2 : bi) `{BiEmbed PROP1 PROP2} := {
Class SbiEmbedding (PROP1 PROP2 : sbi) `{BiEmbed PROP1 PROP2} := {
sbi_embed_bi_embed :> BiEmbedding PROP1 PROP2;
sbi_embed_internal_eq_1 (A : ofeT) (x y : A) : x y x y;
sbi_embed_later P : ⎡▷ P P
}.
......@@ -87,13 +87,6 @@ Section bi_embedding.
last apply bi.True_intro.
apply bi.impl_intro_l. by rewrite right_id.
Qed.
Lemma bi_embed_internal_eq (A : ofeT) (x y : A) : x y x y.
Proof.
apply bi.equiv_spec; split; [apply bi_embed_internal_eq_1|].
etrans; [apply (bi.internal_eq_rewrite x y (λ y, x y%I)); solve_proper|].
rewrite -(bi.internal_eq_refl True%I) bi_embed_pure.
eapply bi.impl_elim; [done|]. apply bi.True_intro.
Qed.
Lemma bi_embed_iff P Q : P Q (P Q).
Proof. by rewrite bi_embed_and !bi_embed_impl. Qed.
Lemma bi_embed_wand_iff P Q : P - Q (P - Q).
......@@ -162,6 +155,13 @@ Section sbi_embedding.
Context `{SbiEmbedding PROP1 PROP2}.
Implicit Types P Q R : PROP1.
Lemma sbi_embed_internal_eq (A : ofeT) (x y : A) : x y x y.
Proof.
apply bi.equiv_spec; split; [apply sbi_embed_internal_eq_1|].
etrans; [apply (bi.internal_eq_rewrite x y (λ y, x y%I)); solve_proper|].
rewrite -(bi.internal_eq_refl True%I) bi_embed_pure.
eapply bi.impl_elim; [done|]. apply bi.True_intro.
Qed.
Lemma sbi_embed_laterN n P : ⎡▷^n P ^n P.
Proof. induction n=>//=. rewrite sbi_embed_later. by f_equiv. Qed.
Lemma sbi_embed_except_0 P : ⎡◇ P P.
......
This diff is collapsed.
......@@ -131,7 +131,6 @@ Definition monPred_embed_eq : bi_embed (A:=PROP) = _ := seal_eq _.
Definition monPred_pure (φ : Prop) : monPred := tc_opaque ⎡⌜φ⌝⎤%I.
Definition monPred_emp : monPred := tc_opaque emp%I.
Definition monPred_internal_eq (A : ofeT) (a b : A) : monPred := tc_opaque a b%I.
Definition monPred_plainly P : monPred := tc_opaque i, bi_plainly (P i)%I.
Definition monPred_all (P : monPred) : monPred := tc_opaque i, P i%I.
Definition monPred_ex (P : monPred) : monPred := tc_opaque i, P i%I.
......@@ -216,6 +215,8 @@ Implicit Types i : I.
Notation monPred := (monPred I PROP).
Implicit Types P Q : monPred.
Definition monPred_internal_eq (A : ofeT) (a b : A) : monPred := tc_opaque a b%I.
Program Definition monPred_later_def P : monPred := MonPred (λ i, (P i))%I _.
Next Obligation. solve_proper. Qed.
Definition monPred_later_aux : seal monPred_later_def. by eexists. Qed.
......@@ -243,7 +244,7 @@ Definition unseal_eqs :=
Ltac unseal :=
unfold bi_affinely, bi_absorbingly, sbi_except_0, bi_pure, bi_emp,
monPred_all, monPred_ex, monPred_upclosed, bi_and, bi_or,
bi_impl, bi_forall, bi_exist, bi_internal_eq, bi_sep, bi_wand,
bi_impl, bi_forall, bi_exist, sbi_internal_eq, bi_sep, bi_wand,
bi_persistently, bi_affinely, sbi_later;
simpl;
unfold sbi_emp, sbi_pure, sbi_and, sbi_or, sbi_impl, sbi_forall, sbi_exist,
......@@ -257,13 +258,12 @@ Import MonPred.
Section canonical_bi.
Context (I : biIndex) (PROP : bi).
Lemma monPred_bi_mixin : BiMixin (@monPred_ofe_mixin I PROP)
Lemma monPred_bi_mixin : BiMixin (PROP:=monPred I PROP)
monPred_entails monPred_emp monPred_pure monPred_and monPred_or
monPred_impl monPred_forall monPred_exist monPred_internal_eq
monPred_sep monPred_wand monPred_plainly monPred_persistently.
monPred_impl monPred_forall monPred_exist monPred_sep monPred_wand
monPred_plainly monPred_persistently.
Proof.
split; try unseal;
try by (repeat intro; split=> ? /=; repeat f_equiv).
split; try unseal; try by (split=> ? /=; repeat f_equiv).
- split.
+ intros P. by split.
+ intros P Q R [H1] [H2]. split => ?. by rewrite H1 H2.
......@@ -289,13 +289,6 @@ Proof.
- intros A Ψ. split=> i. by apply: bi.forall_elim.
- intros A Ψ a. split=> i. by rewrite /= -bi.exist_intro.
- intros A Ψ Q HΨ. split=> i. apply bi.exist_elim => a. by apply HΨ.
- intros A P a. split=> i. by apply bi.internal_eq_refl.
- intros A a b Ψ ?. split=> i /=.
setoid_rewrite bi.pure_impl_forall. do 2 apply bi.forall_intro => ?.
erewrite (bi.internal_eq_rewrite _ _ (flip Ψ _)) => //=. solve_proper.
- intros A1 A2 f g. split=> i. by apply bi.fun_ext.
- intros A P x y. split=> i. by apply bi.sig_eq.
- intros A a b ?. split=> i. by apply bi.discrete_eq_1.
- intros P P' Q Q' [?] [?]. split=> i. by apply bi.sep_mono.
- intros P. split=> i. by apply bi.emp_sep_1.
- intros P. split=> i. by apply bi.emp_sep_2.
......@@ -313,11 +306,6 @@ Proof.
- intros A Ψ. split=> i /=. apply bi.forall_intro=> j.
rewrite bi.plainly_forall. apply bi.forall_intro=> a.
by rewrite !bi.forall_elim.
- intros P Q. split=> i /=.
rewrite <-(sig_monPred_sig P), <-(sig_monPred_sig Q), <-(bi.f_equiv _).
rewrite -bi.sig_equivI /= -bi.fun_ext. f_equiv=> j.
rewrite -bi.prop_ext !(bi.forall_elim j) !bi.pure_impl_forall
!bi.forall_elim //.
- intros P Q. split=> i /=. repeat setoid_rewrite bi.pure_impl_forall.
repeat setoid_rewrite <-bi.plainly_forall.
repeat setoid_rewrite bi.persistently_forall. do 4 f_equiv.
......@@ -341,21 +329,35 @@ Qed.
Canonical Structure monPredI : bi :=
Bi (monPred I PROP) monPred_dist monPred_equiv monPred_entails monPred_emp
monPred_pure monPred_and monPred_or monPred_impl monPred_forall
monPred_exist monPred_internal_eq monPred_sep monPred_wand monPred_plainly
monPred_persistently monPred_ofe_mixin monPred_bi_mixin.
monPred_exist monPred_sep monPred_wand monPred_plainly monPred_persistently
monPred_ofe_mixin monPred_bi_mixin.
End canonical_bi.
Section canonical_sbi.
Context (I : biIndex) (PROP : sbi).
Lemma monPred_sbi_mixin :
SbiMixin (PROP:=monPred I PROP) monPred_entails monPred_pure monPred_or
monPred_impl monPred_forall monPred_exist monPred_internal_eq
monPred_sep monPred_plainly monPred_persistently monPred_later.
SbiMixin (PROP:=monPred I PROP) monPred_ofe_mixin monPred_entails monPred_pure
monPred_and monPred_or monPred_impl monPred_forall monPred_exist
monPred_sep monPred_plainly monPred_persistently monPred_internal_eq
monPred_later.
Proof.
split; unseal.
- intros n P Q HPQ. split=> i /=.
apply bi.later_contractive. destruct n as [|n]=> //. by apply HPQ.
- by split=> ? /=; repeat f_equiv.
- intros A P a. split=> i. by apply bi.internal_eq_refl.
- intros A a b Ψ ?. split=> i /=.
setoid_rewrite bi.pure_impl_forall. do 2 apply bi.forall_intro => ?.
erewrite (bi.internal_eq_rewrite _ _ (flip Ψ _)) => //=. solve_proper.
- intros A1 A2 f g. split=> i. by apply bi.fun_ext.
- intros A P x y. split=> i. by apply bi.sig_eq.
- intros A a b ?. split=> i. by apply bi.discrete_eq_1.
- intros P Q. split=> i /=.
rewrite <-(sig_monPred_sig P), <-(sig_monPred_sig Q), <-(bi.f_equiv _).
rewrite -bi.sig_equivI /= -bi.fun_ext. f_equiv=> j.
rewrite -bi.prop_ext !(bi.forall_elim j) !bi.pure_impl_forall
!bi.forall_elim //.
- intros A x y. split=> i. by apply bi.later_eq_1.
- intros A x y. split=> i. by apply bi.later_eq_2.
- intros P Q [?]. split=> i. by apply bi.later_mono.
......@@ -378,8 +380,8 @@ Qed.
Canonical Structure monPredSI : sbi :=
Sbi (monPred I PROP) monPred_dist monPred_equiv monPred_entails monPred_emp
monPred_pure monPred_and monPred_or monPred_impl monPred_forall
monPred_exist monPred_internal_eq monPred_sep monPred_wand monPred_plainly
monPred_persistently monPred_later monPred_ofe_mixin
monPred_exist monPred_sep monPred_wand monPred_plainly
monPred_persistently monPred_internal_eq monPred_later monPred_ofe_mixin
(bi_bi_mixin _) monPred_sbi_mixin.
End canonical_sbi.
......@@ -523,8 +525,6 @@ Lemma monPred_at_pure i (φ : Prop) : monPred_at ⌜φ⌝ i ⊣⊢ ⌜φ⌝.
Proof. by apply monPred_at_embed. Qed.
Lemma monPred_at_emp i : monPred_at emp i emp.
Proof. by apply monPred_at_embed. Qed.
Lemma monPred_at_internal_eq {A : ofeT} i (a b : A) : monPred_at (a b) i a b.
Proof. by apply monPred_at_embed. Qed.
Lemma monPred_at_plainly i P : bi_plainly P i j, bi_plainly (P j).
Proof. by apply monPred_at_embed. Qed.
Lemma monPred_at_and i P Q : (P Q) i P i Q i.
......@@ -620,15 +620,6 @@ Proof.
eapply bi.pure_elim; [apply bi.and_elim_l|]=>?. rewrite bi.and_elim_r. by f_equiv.
Qed.
Lemma monPred_equivI {PROP' : bi} P Q :
bi_internal_eq (PROP:=PROP') P Q i, P i Q i.
Proof.
apply bi.equiv_spec. split.
- apply bi.forall_intro=>?. apply (bi.f_equiv (flip monPred_at _)).
- by rewrite -{2}(sig_monPred_sig P) -{2}(sig_monPred_sig Q)
-bi.f_equiv -bi.sig_equivI !bi.ofe_fun_equivI.
Qed.
Lemma monPred_bupd_embed `{BUpdFacts PROP} (P : PROP) :
|==> P bupd (PROP:=monPredI) P.
Proof.
......@@ -734,7 +725,7 @@ Proof.
Qed.
Global Instance monPred_sbi_embedding : SbiEmbedding PROP monPredSI.
Proof. split; try apply _. by unseal. Qed.
Proof. split; try apply _; by unseal. Qed.
Global Instance monPred_fupd_facts `{FUpdFacts PROP} : FUpdFacts monPredSI.
Proof.
......@@ -766,6 +757,9 @@ Qed.
(** Unfolding lemmas *)
Lemma monPred_at_internal_eq {A : ofeT} i (a b : A) :
@monPred_at I PROP (a b) i a b.
Proof. by apply monPred_at_embed. Qed.
Lemma monPred_at_later i P : ( P) i P i.
Proof. by unseal. Qed.
Lemma monPred_at_fupd `{FUpdFacts PROP} i E1 E2 P :
......@@ -785,4 +779,13 @@ Proof.
- by do 2 apply bi.forall_intro=>?.
- rewrite !bi.forall_elim //.
Qed.
Lemma monPred_equivI {PROP' : sbi} P Q :
sbi_internal_eq (PROP:=PROP') P Q i, P i Q i.
Proof.
apply bi.equiv_spec. split.
- apply bi.forall_intro=>?. apply (bi.f_equiv (flip monPred_at _)).
- by rewrite -{2}(sig_monPred_sig P) -{2}(sig_monPred_sig Q)
-bi.f_equiv -bi.sig_equivI !bi.ofe_fun_equivI.
Qed.
End sbi_facts.
......@@ -81,10 +81,6 @@ Proof. rewrite /FromAssumption=>->. apply bupd_intro. Qed.
Global Instance into_pure_pure φ : @IntoPure PROP ⌜φ⌝ φ.
Proof. by rewrite /IntoPure. Qed.
Global Instance into_pure_eq {A : ofeT} (a b : A) :
Discrete a @IntoPure M (a b) (a b).
Proof. intros. by rewrite /IntoPure discrete_eq. Qed.
Global Instance into_pure_pure_and (φ1 φ2 : Prop) P1 P2 :
IntoPure P1 φ1 IntoPure P2 φ2 IntoPure (P1 P2) (φ1 φ2).
Proof. rewrite /IntoPure pure_and. by intros -> ->. Qed.
......@@ -126,10 +122,6 @@ Proof. rewrite /IntoPure=> ->. by rewrite bi_embed_pure. Qed.
(* FromPure *)
Global Instance from_pure_pure φ : @FromPure PROP ⌜φ⌝ φ.
Proof. by rewrite /FromPure. Qed.
Global Instance from_pure_internal_eq {A : ofeT} (a b : A) :
@FromPure PROP (a b) (a b).
Proof. by rewrite /FromPure pure_internal_eq. Qed.
Global Instance from_pure_pure_and (φ1 φ2 : Prop) P1 P2 :
FromPure P1 φ1 FromPure P2 φ2 FromPure (P1 P2) (φ1 φ2).
Proof. rewrite /FromPure pure_and. by intros -> ->. Qed.
......@@ -176,27 +168,6 @@ Global Instance from_pure_bupd `{BUpdFacts PROP} P φ :
FromPure P φ FromPure (|==> P) φ.
Proof. rewrite /FromPure=> ->. apply bupd_intro. Qed.
(* IntoInternalEq *)
Global Instance into_internal_eq_internal_eq {A : ofeT} (x y : A) :
@IntoInternalEq PROP A (x y) x y.
Proof. by rewrite /IntoInternalEq. Qed.
Global Instance into_internal_eq_affinely {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq (bi_affinely P) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite affinely_elim. Qed.
Global Instance into_internal_eq_absorbingly {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq (bi_absorbingly P) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite absorbingly_internal_eq. Qed.
Global Instance into_internal_eq_plainly {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq (bi_plainly P) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite plainly_elim. Qed.
Global Instance into_internal_eq_persistently {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq (bi_persistently P) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite persistently_elim. Qed.
Global Instance into_internal_eq_embed
`{BiEmbedding PROP PROP'} {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq P x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite bi_embed_internal_eq. Qed.
(* IntoPersistent *)
Global Instance into_persistent_persistently p P Q :
IntoPersistent true P Q IntoPersistent p (bi_persistently P) Q | 0.
......@@ -841,10 +812,6 @@ Qed.
Global Instance frame_pure_embed `{BiEmbedding PROP PROP'} p P Q (Q' : PROP') φ :
Frame p ⌜φ⌝ P Q MakeEmbed Q Q' Frame p ⌜φ⌝ P Q'.
Proof. rewrite /Frame /MakeEmbed -bi_embed_pure. apply (frame_embed p P Q). Qed.
Global Instance frame_eq_embed `{BiEmbedding PROP PROP'} p P Q (Q' : PROP')
{A : ofeT} (a b : A) :
Frame p (a b) P Q MakeEmbed Q Q' Frame p (a b) P Q'.
Proof. rewrite /Frame /MakeEmbed -bi_embed_internal_eq. apply (frame_embed p P Q). Qed.
Class MakeSep (P Q PQ : PROP) := make_sep : P Q PQ.
Arguments MakeSep _%I _%I _%I.
......@@ -1087,6 +1054,9 @@ Global Instance from_assumption_fupd `{FUpdFacts PROP} E p P Q :
Proof. rewrite /FromAssumption=>->. apply bupd_fupd. Qed.
(* FromPure *)
Global Instance from_pure_internal_eq {A : ofeT} (a b : A) :
@FromPure PROP (a b) (a b).
Proof. by rewrite /FromPure pure_internal_eq. Qed.
Global Instance from_pure_later P φ : FromPure P φ FromPure ( P) φ.
Proof. rewrite /FromPure=> ->. apply later_intro. Qed.
Global Instance from_pure_laterN n P φ : FromPure P φ FromPure (^n P) φ.
......@@ -1097,6 +1067,11 @@ Global Instance from_pure_fupd `{FUpdFacts PROP} E P φ :
FromPure P φ FromPure (|={E}=> P) φ.
Proof. rewrite /FromPure. intros <-. apply fupd_intro. Qed.
(* IntoPure *)
Global Instance into_pure_eq {A : ofeT} (a b : A) :
Discrete a @IntoPure PROP (a b) (a b).
Proof. intros. by rewrite /IntoPure discrete_eq. Qed.
(* IntoWand *)
Global Instance into_wand_later p q R P Q :
IntoWand p q R P Q IntoWand p q ( R) ( P) ( Q).
......@@ -1331,6 +1306,27 @@ Proof. apply except_0_intro. Qed.
Global Instance from_modal_fupd E P `{FUpdFacts PROP} : FromModal (|={E}=> P) P.
Proof. rewrite /FromModal. apply fupd_intro. Qed.
(* IntoInternalEq *)
Global Instance into_internal_eq_internal_eq {A : ofeT} (x y : A) :
@IntoInternalEq PROP A (x y) x y.
Proof. by rewrite /IntoInternalEq. Qed.
Global Instance into_internal_eq_affinely {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq (bi_affinely P) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite affinely_elim. Qed.
Global Instance into_internal_eq_absorbingly {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq (bi_absorbingly P) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite absorbingly_internal_eq. Qed.
Global Instance into_internal_eq_plainly {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq (bi_plainly P) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite plainly_elim. Qed.
Global Instance into_internal_eq_persistently {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq (bi_persistently P) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite persistently_elim. Qed.
Global Instance into_internal_eq_embed
`{SbiEmbedding PROP PROP'} {A : ofeT} (x y : A) P :
IntoInternalEq P x y IntoInternalEq P x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite sbi_embed_internal_eq. Qed.
(* IntoExcept0 *)
Global Instance into_except_0_except_0 P : IntoExcept0 ( P) P.
Proof. by rewrite /IntoExcept0. Qed.
......@@ -1400,6 +1396,11 @@ Global Instance add_modal_fupd `{FUpdFacts PROP} E1 E2 P Q :
Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_trans. Qed.
(* Frame *)
Global Instance frame_eq_embed `{SbiEmbedding PROP PROP'} p P Q (Q' : PROP')
{A : ofeT} (a b : A) :
Frame p (a b) P Q MakeEmbed Q Q' Frame p (a b) P Q'.
Proof. rewrite /Frame /MakeEmbed -sbi_embed_internal_eq. apply (frame_embed p P Q). Qed.
Class MakeLater (P lP : PROP) := make_later : P lP.
Arguments MakeLater _%I _%I.
......
......@@ -56,7 +56,7 @@ Proof. by exists φ. Qed.
Hint Extern 0 (FromPureT _ _) =>
notypeclasses refine (from_pureT_hint _ _ _) : typeclass_instances.
Class IntoInternalEq {PROP : bi} {A : ofeT} (P : PROP) (x y : A) :=
Class IntoInternalEq {PROP : sbi} {A : ofeT} (P : PROP) (x y : A) :=
into_internal_eq : P x y.
Arguments IntoInternalEq {_ _} _%I _%type_scope _%type_scope : simpl never.
Arguments into_internal_eq {_ _} _%I _%type_scope _%type_scope {_}.
......
......@@ -914,43 +914,6 @@ Proof.
by rewrite into_wand /= HP1 wand_elim_l.
Qed.
(** * Rewriting *)
Lemma tac_rewrite Δ i p Pxy d Q :
envs_lookup i Δ = Some (p, Pxy)
{A : ofeT} (x y : A) (Φ : A PROP),
IntoInternalEq Pxy x y
(Q Φ (if d is Left then y else x))
NonExpansive Φ
envs_entails Δ (Φ (if d is Left then x else y)) envs_entails Δ Q.
Proof.
intros ? A x y ? HPxy -> ?; apply internal_eq_rewrite'; auto.
rewrite {1}envs_lookup_sound //.
rewrite HPxy affinely_persistently_if_elim sep_elim_l.
destruct d; auto using internal_eq_sym.
Qed.
Lemma tac_rewrite_in Δ i p Pxy j q P d Q :
envs_lookup i Δ = Some (p, Pxy)
envs_lookup j Δ = Some (q, P)
{A : ofeT} Δ' (x y : A) (Φ : A PROP),
IntoInternalEq Pxy x y
(P Φ (if d is Left then y else x))
NonExpansive Φ
envs_simple_replace j q (Esnoc Enil j (Φ (if d is Left then x else y))) Δ = Some Δ'
envs_entails Δ' Q
envs_entails Δ Q.
Proof.
rewrite /envs_entails => ?? A Δ' x y Φ HPxy HP ?? <-.
rewrite -(idemp bi_and (of_envs Δ)) {2}(envs_lookup_sound _ i) //.
rewrite (envs_simple_replace_singleton_sound _ _ j) //=.
rewrite HP HPxy (affinely_persistently_if_elim _ (_ _)%I) sep_elim_l.
rewrite persistent_and_affinely_sep_r -assoc. apply wand_elim_r'.
rewrite -persistent_and_affinely_sep_r. apply impl_elim_r'. destruct d.
- apply (internal_eq_rewrite x y (λ y, ?q Φ y - of_envs Δ')%I). solve_proper.
- rewrite internal_eq_sym.
eapply (internal_eq_rewrite y x (λ y, ?q Φ y - of_envs Δ')%I). solve_proper.
Qed.
(** * Conjunction splitting *)
Lemma tac_and_split Δ P Q1 Q2 :
FromAnd P Q1 Q2 envs_entails Δ Q1 envs_entails Δ Q2 envs_entails Δ P.
......@@ -1140,6 +1103,43 @@ Implicit Types Γ : env PROP.
Implicit Types Δ : envs PROP.
Implicit Types P Q : PROP.
(** * Rewriting *)
Lemma tac_rewrite Δ i p Pxy d Q :
envs_lookup i Δ = Some (p, Pxy)
{A : ofeT} (x y : A) (Φ : A PROP),
IntoInternalEq Pxy x y
(Q Φ (if d is Left then y else x))
NonExpansive Φ
envs_entails Δ (Φ (if d is Left then x else y)) envs_entails Δ Q.
Proof.
intros ? A x y ? HPxy -> ?; apply internal_eq_rewrite'; auto.
rewrite {1}envs_lookup_sound //.
rewrite (into_internal_eq Pxy x y) affinely_persistently_if_elim sep_elim_l.
destruct d; auto using internal_eq_sym.
Qed.
Lemma tac_rewrite_in Δ i p Pxy j q P d Q :
envs_lookup i Δ = Some (p, Pxy)
envs_lookup j Δ = Some (q, P)
{A : ofeT} Δ' (x y : A) (Φ : A PROP),
IntoInternalEq Pxy x y
(P Φ (if d is Left then y else x))
NonExpansive Φ
envs_simple_replace j q (Esnoc Enil j (Φ (if d is Left then x else y))) Δ = Some Δ'
envs_entails Δ' Q
envs_entails Δ Q.
Proof.
rewrite /envs_entails /IntoInternalEq => ?? A Δ' x y Φ HPxy HP ?? <-.
rewrite -(idemp bi_and (of_envs Δ)) {2}(envs_lookup_sound _ i) //.
rewrite (envs_simple_replace_singleton_sound _ _ j) //=.
rewrite HP HPxy (affinely_persistently_if_elim _ (_ _)%I) sep_elim_l.
rewrite persistent_and_affinely_sep_r -assoc. apply wand_elim_r'.
rewrite -persistent_and_affinely_sep_r. apply impl_elim_r'. destruct d.
- apply (internal_eq_rewrite x y (λ y, ?q Φ y - of_envs Δ')%I). solve_proper.
- rewrite internal_eq_sym.
eapply (internal_eq_rewrite y x (λ y, ?q Φ y - of_envs Δ')%I). solve_proper.
Qed.
(** * Later *)
Class IntoLaterNEnv (n : nat) (Γ1 Γ2 : env PROP) :=
into_laterN_env : env_Forall2 (IntoLaterN n) Γ1 Γ2.
......
......@@ -25,9 +25,6 @@ Implicit Types i j : I.
Global Instance make_monPred_at_pure φ i : MakeMonPredAt i ⌜φ⌝ ⌜φ⌝.
Proof. by rewrite /MakeMonPredAt monPred_at_pure. Qed.
Global Instance make_monPred_at_internal_eq {A : ofeT} (x y : A) i :
MakeMonPredAt i (x y) (x y).
Proof. by rewrite /MakeMonPredAt monPred_at_internal_eq. Qed.
Global Instance make_monPred_at_emp i : MakeMonPredAt i emp emp.
Proof. by rewrite /MakeMonPredAt monPred_at_emp. Qed.
Global Instance make_monPred_at_sep i P 𝓟 Q 𝓠 :
......@@ -133,10 +130,6 @@ Proof. by rewrite /IntoPure monPred_at_in. Qed.
Global Instance from_pure_monPred_in i j : @FromPure PROP (monPred_in i j) (i j).
Proof. by rewrite /FromPure monPred_at_in. Qed.
Global Instance into_internal_eq_monPred_at {A : ofeT} (x y : A) P i :
IntoInternalEq P x y IntoInternalEq (P i) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite monPred_at_internal_eq. Qed.
Global Instance into_persistent_monPred_at p P Q 𝓠 i :
IntoPersistent p P Q MakeMonPredAt i Q 𝓠 IntoPersistent p (P i) 𝓠 | 0.
Proof.
......@@ -391,6 +384,9 @@ Global Instance is_except_0_monPred_at i P :
IsExcept0 P IsExcept0 (P i).
Proof. rewrite /IsExcept0=>- [/(_ i)]. by rewrite monPred_at_except_0. Qed.
Global Instance make_monPred_at_internal_eq {A : ofeT} (x y : A) i :
@MakeMonPredAt I PROP i (x y) (x y).
Proof. by rewrite /MakeMonPredAt monPred_at_internal_eq. Qed.
Global Instance make_monPred_at_except_0 i P 𝓠 :
MakeMonPredAt i P 𝓠 MakeMonPredAt i ( P)%I ( 𝓠)%I.
Proof. by rewrite /MakeMonPredAt monPred_at_except_0=><-. Qed.
......@@ -404,6 +400,10 @@ Global Instance make_monPred_at_fupd `{FUpdFacts PROP} i E1 E2 P 𝓟 :
MakeMonPredAt i P 𝓟 MakeMonPredAt i (|={E1,E2}=> P)%I (|={E1,E2}=> 𝓟)%I.
Proof. by rewrite /MakeMonPredAt monPred_at_fupd=> <-. Qed.
Global Instance into_internal_eq_monPred_at {A : ofeT} (x y : A) P i :
IntoInternalEq P x y IntoInternalEq (P i) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite monPred_at_internal_eq. Qed.
Global Instance into_except_0_monPred_at_fwd i P Q 𝓠 :
IntoExcept0 P Q MakeMonPredAt i Q 𝓠 IntoExcept0 (P i) 𝓠.
Proof. rewrite /IntoExcept0 /MakeMonPredAt=> -> <-. by rewrite monPred_at_except_0. 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