Commit 858d6407 authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan

Add a bunch of proofmode instances for monPred_car and morphisms.

parent cedd9645
......@@ -91,6 +91,7 @@ theories/proofmode/tactics.v
theories/proofmode/notation.v
theories/proofmode/classes.v
theories/proofmode/class_instances.v
theories/proofmode/monpred.v
theories/tests/heap_lang.v
theories/tests/one_shot.v
theories/tests/proofmode.v
......
......@@ -2305,6 +2305,16 @@ Section bi_morphims.
Proof. apply (ne_proper _). Qed.
Global Instance bi_mor_mono_flip : Proper (flip () ==> flip ()) bi_embedding.
Proof. solve_proper. Qed.
Global Instance bi_mor_inj : Inj () () bi_embedding.
Proof.
intros ?? EQ. apply bi.equiv_spec, conj; apply (inj bi_embedding);
rewrite EQ //.
Qed.
Lemma bi_mor_valid (P : PROP1) : @bi_embedding PROP1 PROP2 _ P P.
Proof.
by rewrite /bi_valid -bi_mor_emp; split=>?; [apply (inj bi_embedding)|f_equiv].
Qed.
Lemma bi_mor_forall A (Φ : A PROP1) : x, Φ x x, ⎡Φ x.
Proof.
......
......@@ -536,6 +536,7 @@ Typeclasses Opaque bi_embedding.
Class BiMorphism (PROP1 PROP2 : bi) `{BiEmbedding PROP1 PROP2} := {
bi_mor_ne :> NonExpansive bi_embedding;
bi_mor_mono :> Proper (() ==> ()) bi_embedding;
bi_mor_entails_inj :> Inj () () bi_embedding;
bi_mor_emp : emp emp;
bi_mor_impl_2 P Q : (P Q) P Q;
bi_mor_forall_2 A (Φ : A PROP1) : ( x, ⎡Φ x) x, Φ x;
......
......@@ -465,9 +465,10 @@ Proof.
Qed.
Global Instance monPred_ipure_bi_mor :
@BiMorphism PROP (monPredI I PROP) bi_embedding.
Inhabited I @BiMorphism PROP (monPredI I PROP) bi_embedding.
Proof.
split; try apply _; unseal; try done.
- move =>?? /= [/(_ inhabitant) ?] //.
- split=>? /=.
by rewrite bi.forall_elim bi.pure_impl_forall bi.forall_elim.
- split=>? /=.
......@@ -497,6 +498,6 @@ Proof.
Qed.
Global Instance monPred_ipure_sbi_mor :
@SbiMorphism PROP (monPredSI I PROP) bi_embedding.
Inhabited I @SbiMorphism PROP (monPredSI I PROP) bi_embedding.
Proof. split; try apply _. by unseal. Qed.
End sbi_facts.
This diff is collapsed.
From iris.bi Require Export monpred.
From iris.proofmode Require Import tactics.
Import MonPred.
Section bi.
Context {I : bi_index} {PROP : bi}.
Local Notation monPred := (monPred I PROP).
Implicit Types P Q R : monPred.
Implicit Types φ : Prop.
Implicit Types i j : I.
Global Instance as_valid_monPred_car φ P :
AsValid φ P AsValid φ ( i, P i).
Proof.
rewrite /AsValid /bi_valid=> ->; unseal; split.
- move=>[/= /bi.forall_intro //].
- move=>H. split=>i. rewrite /= H bi.forall_elim //.
Qed.
Global Instance into_pure_monPred_car P φ i : IntoPure P φ IntoPure (P i) φ.
Proof. rewrite /IntoPure=> ->. by unseal. Qed.
Global Instance from_pure_monPred_car P φ i : FromPure P φ FromPure (P i) φ.
Proof. rewrite /FromPure=> <-. by unseal. Qed.
Global Instance into_internal_eq_monPred_car {A : ofeT} (x y : A) P i :
IntoInternalEq P x y IntoInternalEq (P i) x y.
Proof. rewrite /IntoInternalEq=> ->. by unseal. Qed.
Global Instance into_persistent_monPred_car p P Q i:
IntoPersistent p P Q IntoPersistent p (P i) (Q i) | 0.
Proof.
rewrite /IntoPersistent /bi_persistently_if. unseal=>-[/(_ i)].
by destruct p.
Qed.
Global Instance from_always_monPred_car a pe P Q i :
FromAlways a pe false P Q FromAlways a pe false (P i) (Q i) | 0.
Proof.
rewrite /FromAlways /bi_persistently_if /bi_affinely_if=><-.
by destruct a, pe; try unseal.
Qed.
Global Instance into_wand_monPred_car p q R P Q i :
IntoWand p q R P Q IntoWand p q (R i) (P i) (Q i).
Proof.
rewrite /IntoWand /bi_affinely_if /bi_persistently_if=>/bi.wand_elim_l' <-.
apply bi.wand_intro_r. by destruct p, q; unseal.
Qed.
Global Instance from_forall_monPred_car_wand P Q i :
FromForall ((P - Q) i)%I (λ j, i j P j - Q j)%I.
Proof. rewrite /FromForall. by unseal. Qed.
Global Instance into_forall_monPred_car_wand P Q i :
IntoForall ((P - Q) i) (λ j, i j P j - Q j)%I.
Proof. rewrite /IntoForall. by unseal. Qed.
Global Instance from_forall_monPred_car_impl P Q i :
FromForall ((P Q) i)%I (λ j, i j P j Q j)%I.
Proof. rewrite /FromForall. by unseal. Qed.
Global Instance into_forall_monPred_car_impl P Q i :
IntoForall ((P Q) i) (λ j, i j P j Q j)%I.
Proof. rewrite /IntoForall. by unseal. Qed.
Global Instance from_and_monPred_car P Q1 Q2 i:
FromAnd P Q1 Q2 FromAnd (P i) (Q1 i) (Q2 i).
Proof. rewrite /FromAnd=> <-. by unseal. Qed.
Global Instance into_and_monPred_car p P Q1 Q2 i:
IntoAnd p P Q1 Q2 IntoAnd p (P i) (Q1 i) (Q2 i).
Proof.
rewrite /IntoAnd /bi_affinely_if /bi_persistently_if=>-[/(_ i)].
by destruct p; unseal.
Qed.
Global Instance from_sep_monPred_car P Q1 Q2 i:
FromSep P Q1 Q2 FromSep (P i) (Q1 i) (Q2 i).
Proof. rewrite /FromSep=> <-. by unseal. Qed.
Global Instance into_sep_monPred_car P Q1 Q2 i:
IntoSep P Q1 Q2 IntoSep (P i) (Q1 i) (Q2 i).
Proof. rewrite /IntoSep=> ->. by unseal. Qed.
Global Instance from_or_monPred_car P Q1 Q2 i:
FromOr P Q1 Q2 FromOr (P i) (Q1 i) (Q2 i).
Proof. rewrite /FromOr=> <-. by unseal. Qed.
Global Instance into_or_monPred_car P Q1 Q2 i:
IntoOr P Q1 Q2 IntoOr (P i) (Q1 i) (Q2 i).
Proof. rewrite /IntoOr=> ->. by unseal. Qed.
Global Instance from_exist_monPred_car {A} P (Φ : A monPred) i :
FromExist P Φ FromExist (P i) (λ a, Φ a i).
Proof. rewrite /FromExist=><-. by unseal. Qed.
Global Instance into_exist_monPred_car {A} P (Φ : A monPred) i :
IntoExist P Φ IntoExist (P i) (λ a, Φ a i).
Proof. rewrite /IntoExist=>->. by unseal. Qed.
Global Instance from_forall_monPred_car {A} P (Φ : A monPred) i :
FromForall P Φ FromForall (P i) (λ a, Φ a i).
Proof. rewrite /FromForall=><-. by unseal. Qed.
Global Instance into_forall_monPred_car {A} P (Φ : A monPred) i :
IntoForall P Φ IntoForall (P i) (λ a, Φ a i).
Proof. rewrite /IntoForall=>->. by unseal. Qed.
Class MakeMonPredCar i P (Q : PROP) :=
make_monPred_car : P i Q.
Arguments MakeMonPredCar _ _%I _%I.
Global Instance make_monPred_car_true i : MakeMonPredCar i True True.
Proof. rewrite /MakeMonPredCar. by unseal. Qed.
Global Instance make_monPred_car_emp i : MakeMonPredCar i emp emp.
Proof. rewrite /MakeMonPredCar. by unseal. Qed.
Global Instance make_monPred_car_default i P : MakeMonPredCar i P (P i).
Proof. by rewrite /MakeMonPredCar. Qed.
(* FIXME : there are two good ways to frame under a call to
monPred_car. This may cause some backtracking in the typeclass
search, and hence performance issues. *)
Global Instance frame_monPred_car i p P Q (Q' : PROP) R :
Frame p R P Q MakeMonPredCar i Q Q' Frame p (R i) (P i) Q'.
Proof.
rewrite /Frame /MakeMonPredCar /bi_affinely_if /bi_persistently_if=> <- <-.
by destruct p; unseal.
Qed.
Global Instance frame_monPred_car_embed i p P Q (Q' R: PROP) :
Frame p R P Q MakeMonPredCar i Q Q' Frame p R (P i) Q'.
Proof.
rewrite /Frame /MakeMonPredCar /bi_affinely_if /bi_persistently_if=> <- <-.
by destruct p; unseal.
Qed.
Global Instance from_modal_monPred_car i P Q :
FromModal P Q FromModal (P i) (Q i).
Proof. by rewrite /FromModal=>->. Qed.
End bi.
Section sbi.
Context {I : bi_index} {PROP : sbi}.
Local Notation monPred := (monPred I PROP).
Implicit Types P Q R : monPred.
Implicit Types φ : Prop.
Implicit Types i j : I.
Global Instance is_except_0_monPred_car i P :
IsExcept0 P IsExcept0 (P i).
Proof. rewrite /IsExcept0=>- [/(_ i)]. by unseal. Qed.
Global Instance into_except_0_monPred_car i P Q :
IntoExcept0 P Q IntoExcept0 (P i) (Q i).
Proof. rewrite /IntoExcept0=> ->. by unseal. Qed.
Global Instance into_later_monPred_car i n P Q :
IntoLaterN n P Q IntoLaterN n (P i) (Q i).
Proof.
rewrite /IntoLaterN=> ->. induction n as [|? IH]=>//. rewrite /= -IH. by unseal.
Qed.
Global Instance from_later_monPred_car i n P Q :
FromLaterN n P Q FromLaterN n (P i) (Q i).
Proof.
rewrite /FromLaterN=> <-. induction n as [|? IH]=>//. rewrite /= IH. by unseal.
Qed.
End sbi.
......@@ -65,22 +65,29 @@ Proof. by apply as_valid. Qed.
Instance as_valid_valid {PROP : bi} (P : PROP) : AsValid (bi_valid P) P | 0.
Proof. by rewrite /AsValid. Qed.
Instance as_valid_entails {PROP : bi} (P Q : PROP) : AsValid (P Q) (P - Q) | 1.
Instance as_valid_entails {PROP : bi} (P Q : PROP) : AsValid (P Q) (P - Q) | 0.
Proof. split. apply bi.entails_wand. apply bi.wand_entails. Qed.
Instance as_valid_equiv {PROP : bi} (P Q : PROP) : AsValid (P Q) (P - Q).
Instance as_valid_equiv {PROP : bi} (P Q : PROP) : AsValid (P Q) (P - Q) | 0.
Proof. split. apply bi.equiv_wand_iff. apply bi.wand_iff_equiv. Qed.
Instance as_valid_morphism `{BiMorphism PROP PROP'} (φ : Prop) (P : PROP) :
AsValid φ P AsValid φ P.
Proof. rewrite /AsValid=> ->. rewrite bi_mor_valid //. Qed.
(** * Start a proof *)
Ltac iStartProof :=
Tactic Notation "iStartProof" uconstr(PROP) :=
lazymatch goal with
| |- envs_entails _ _ => idtac
| |- @envs_entails ?PROP' _ _ =>
let x := type_term (eq_refl : PROP = PROP') in idtac
| |- let _ := _ in _ => fail
| |- ?φ => eapply (as_valid_2 φ);
| |- ?φ => eapply (@as_valid_2 φ PROP);
[apply _ || fail "iStartProof: not a Bi entailment"
|apply tac_adequate]
end.
Tactic Notation "iStartProof" := iStartProof _.
(** * Context manipulation *)
Tactic Notation "iRename" constr(H1) "into" constr(H2) :=
eapply tac_rename with _ H1 H2 _ _; (* (i:=H1) (j:=H2) *)
......
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