Commit 6dc7e98a authored by Ralf Jung's avatar Ralf Jung
Browse files

replace iAndDestruct hack for [% %] by more general IntoExist instances

parent b9d25e99
...@@ -807,22 +807,32 @@ Proof. rewrite /IntoExist=> HP. by rewrite HP affinely_exist. Qed. ...@@ -807,22 +807,32 @@ Proof. rewrite /IntoExist=> HP. by rewrite HP affinely_exist. Qed.
Global Instance into_exist_intuitionistically {A} P (Φ : A PROP) name : Global Instance into_exist_intuitionistically {A} P (Φ : A PROP) name :
IntoExist P Φ name IntoExist ( P) (λ a, (Φ a))%I name. IntoExist P Φ name IntoExist ( P) (λ a, (Φ a))%I name.
Proof. rewrite /IntoExist=> HP. by rewrite HP intuitionistically_exist. Qed. Proof. rewrite /IntoExist=> HP. by rewrite HP intuitionistically_exist. Qed.
(* [to_ident_name H] makes the default name [H] when [P] is destructed with (* Low-priority instance falling back to treating a conjunction with a pure
left-hand side as an existential. This lets us use [iIntros (P) "..."] and [as
[% ...]].
[to_ident_name H] makes the default name [H] when [P] is destructed with
[iExistDestruct] *) [iExistDestruct] *)
Global Instance into_exist_and_pure P Q φ : Global Instance into_exist_and_pure PQ P Q φ :
IntoPureT P φ IntoExist (P Q) (λ _ : φ, Q) (to_ident_name H). IntoAnd false PQ P Q
IntoPureT P φ
IntoExist PQ (λ _ : φ, Q) (to_ident_name H) | 100.
Proof. Proof.
intros (φ'&->&?). rewrite /IntoExist (into_pure P). intros HPQ (φ'&->&?). rewrite /IntoAnd /= in HPQ.
rewrite /IntoExist HPQ (into_pure P).
apply pure_elim_l=> Hφ. by rewrite -(exist_intro Hφ). apply pure_elim_l=> Hφ. by rewrite -(exist_intro Hφ).
Qed. Qed.
(* [to_ident_name H] makes the default name [H] when [P] is destructed with (* Low-priority instance falling back to treating a sep. conjunction with a pure
left-hand side as an existential. This lets us use [iIntros (P) "..."] and [as
[% ...]].
[to_ident_name H] makes the default name [H] when [P] is destructed with
[iExistDestruct] *) [iExistDestruct] *)
Global Instance into_exist_sep_pure P Q φ : Global Instance into_exist_sep_pure PQ P Q φ :
IntoSep PQ P Q
IntoPureT P φ IntoPureT P φ
TCOr (Affine P) (Absorbing Q) TCOr (Affine P) (Absorbing Q)
IntoExist (P Q) (λ _ : φ, Q) (to_ident_name H). IntoExist PQ (λ _ : φ, Q) (to_ident_name H) | 100.
Proof. Proof.
intros (φ'&->&?) ?. rewrite /IntoExist. intros HPQ (φ'&->&?) ?. rewrite /IntoSep in HPQ. rewrite /IntoExist HPQ.
eapply (pure_elim φ'); [by rewrite (into_pure P); apply sep_elim_l, _|]=>?. eapply (pure_elim φ'); [by rewrite (into_pure P); apply sep_elim_l, _|]=>?.
rewrite -exist_intro //. apply sep_elim_r, _. rewrite -exist_intro //. apply sep_elim_r, _.
Qed. Qed.
......
...@@ -1456,9 +1456,9 @@ Local Ltac iDestructHypGo Hz pat0 pat := ...@@ -1456,9 +1456,9 @@ Local Ltac iDestructHypGo Hz pat0 pat :=
| IList [[IDrop; ?pat2]] => | IList [[IDrop; ?pat2]] =>
iAndDestructChoice Hz as Right Hz; iAndDestructChoice Hz as Right Hz;
iDestructHypGo Hz pat0 pat2 iDestructHypGo Hz pat0 pat2
(* heuristic to fallback to [iAndDestruct] when both patterns are pure, since (* [% ...] is always interpreted as an existential; there are [IntoExist]
the instances for [IntoAnd] are more general than for [IntoExist]. *) instances in place to handle conjunctions with a pure left-hand side this way
| IList [[IPure ?id1; IPure ?id2]] => iAndDestructAs (IPure id1) (IPure id2) as well. *)
| IList [[IPure ?gallina_id; ?pat2]] => iExistDestructPure gallina_id pat2 | IList [[IPure ?gallina_id; ?pat2]] => iExistDestructPure gallina_id pat2
| IList [[?pat1; ?pat2]] => iAndDestructAs pat1 pat2 | IList [[?pat1; ?pat2]] => iAndDestructAs pat1 pat2
| IList [_ :: _ :: _] => fail "iDestruct:" pat0 "has too many conjuncts" | IList [_ :: _ :: _] => fail "iDestruct:" pat0 "has too many conjuncts"
......
...@@ -455,6 +455,27 @@ Lemma test_iPure_intro_2 (φ : nat → Prop) P Q R `{!Persistent Q} : ...@@ -455,6 +455,27 @@ Lemma test_iPure_intro_2 (φ : nat → Prop) P Q R `{!Persistent Q} :
φ 0 P - Q R - x : nat, <affine> φ x φ x . φ 0 P - Q R - x : nat, <affine> φ x φ x .
Proof. iIntros (?) "HP #HQ HR". iPureIntro; eauto. Qed. Proof. iIntros (?) "HP #HQ HR". iPureIntro; eauto. Qed.
(* Ensure that [% ...] works as a pattern when the left-hand side of and/sep is
pure. *)
Lemma test_pure_and_sep_destruct `{!BiAffine PROP} (φ : Prop) (P : PROP) :
⌜φ⌝ (⌜φ⌝ P) - P.
Proof.
iIntros "[% [% $]]".
Qed.
(* Ensure that [% %] also works when the conjunction is *inside* ⌜...⌝ *)
Lemma test_pure_inner_and_destruct :
False True @{PROP} False.
Proof.
iIntros "[% %]". done.
Qed.
(* Ensure that [% %] works as a pattern for an existential with a pure body. *)
Lemma test_exist_pure_destruct :
( x, x = 0 ) @{PROP} True.
Proof.
iIntros "[% %]". done.
Qed.
Lemma test_fresh P Q: Lemma test_fresh P Q:
(P Q) - (P Q). (P Q) - (P Q).
Proof. Proof.
...@@ -1391,8 +1412,8 @@ Abort. ...@@ -1391,8 +1412,8 @@ Abort.
Lemma test_exists_intro_pattern P (Φ: nat PROP) : Lemma test_exists_intro_pattern P (Φ: nat PROP) :
P ( y:nat, Φ y) - x, P Φ x. P ( y:nat, Φ y) - x, P Φ x.
Proof. Proof.
iIntros "[HP1 [%y HP2]]". iIntros "[HP1 [%yy HP2]]".
iExists y. iExists yy.
iFrame "HP1 HP2". iFrame "HP1 HP2".
Qed. 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