Commit eacc2cf9 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Fix issue #206.

parent e76659e6
...@@ -11,5 +11,5 @@ install: [make "install"] ...@@ -11,5 +11,5 @@ install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris"] remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris"]
depends: [ depends: [
"coq" { (>= "8.7.1" & < "8.10~") | (= "dev") } "coq" { (>= "8.7.1" & < "8.10~") | (= "dev") }
"coq-stdpp" { (= "dev.2018-12-12.0.9cbafb67") | (= "dev") } "coq-stdpp" { (= "dev.2019-01-13.0.48758ab8") | (= "dev") }
] ]
...@@ -60,6 +60,18 @@ Proof. iIntros "[#? _] [_ #?]". Show. auto. Qed. ...@@ -60,6 +60,18 @@ Proof. iIntros "[#? _] [_ #?]". Show. auto. Qed.
Lemma test_iIntros_persistent P Q `{!Persistent Q} : (P Q P Q)%I. Lemma test_iIntros_persistent P Q `{!Persistent Q} : (P Q P Q)%I.
Proof. iIntros "H1 #H2". by iFrame "∗#". Qed. Proof. iIntros "H1 #H2". by iFrame "∗#". Qed.
Lemma test_iDestruct_intuitionistic_1 P Q `{!Persistent P}:
Q (Q - P) - P Q.
Proof. iIntros "[HQ #HQP]". iDestruct ("HQP" with "HQ") as "#HP". by iFrame. Qed.
Lemma test_iDestruct_intuitionistic_2 P Q `{!Persistent P, !Affine P}:
Q (Q - P) - P.
Proof. iIntros "[HQ HQP]". iDestruct ("HQP" with "HQ") as "#HP". done. Qed.
Lemma test_iDestruct_intuitionistic_affine_bi `{BiAffine PROP} P Q `{!Persistent P}:
Q (Q - P) - P Q.
Proof. iIntros "[HQ HQP]". iDestruct ("HQP" with "HQ") as "#HP". by iFrame. Qed.
Lemma test_iIntros_pure (ψ φ : Prop) P : ψ ( φ P φ ψ P)%I. Lemma test_iIntros_pure (ψ φ : Prop) P : ψ ( φ P φ ψ P)%I.
Proof. iIntros (??) "H". auto. Qed. Proof. iIntros (??) "H". auto. Qed.
......
...@@ -311,18 +311,20 @@ Qed. ...@@ -311,18 +311,20 @@ Qed.
Lemma tac_specialize_intuitionistic_helper Δ Δ'' j q P R R' Q : Lemma tac_specialize_intuitionistic_helper Δ Δ'' j q P R R' Q :
envs_lookup j Δ = Some (q,P) envs_lookup j Δ = Some (q,P)
(if q then TCTrue else BiAffine PROP)
envs_entails Δ (<absorb> R) envs_entails Δ (<absorb> R)
IntoPersistent false R R' IntoPersistent false R R'
(if q then TCTrue else BiAffine PROP)
envs_replace j q true (Esnoc Enil j R') Δ = Some Δ'' envs_replace j q true (Esnoc Enil j R') Δ = Some Δ''
envs_entails Δ'' Q envs_entails Δ Q. envs_entails Δ'' Q envs_entails Δ Q.
Proof. Proof.
rewrite envs_entails_eq => ? HR ? Hpos ? <-. rewrite -(idemp bi_and (of_envs Δ)) {1}HR. rewrite envs_entails_eq => ?? HR ?? <-. rewrite -(idemp bi_and (of_envs Δ)) {1}HR.
rewrite envs_replace_singleton_sound //; destruct q; simpl. rewrite envs_replace_singleton_sound //; destruct q; simpl.
- by rewrite (_ : R = <pers>?false R)%I // (into_persistent _ R) - by rewrite (_ : R = <pers>?false R)%I // (into_persistent _ R)
absorbingly_elim_persistently sep_elim_r persistently_and_intuitionistically_sep_l wand_elim_r. absorbingly_elim_persistently sep_elim_r
persistently_and_intuitionistically_sep_l wand_elim_r.
- by rewrite (absorbing_absorbingly R) (_ : R = <pers>?false R)%I // - by rewrite (absorbing_absorbingly R) (_ : R = <pers>?false R)%I //
(into_persistent _ R) sep_elim_r persistently_and_intuitionistically_sep_l wand_elim_r. (into_persistent _ R) sep_elim_r
persistently_and_intuitionistically_sep_l wand_elim_r.
Qed. Qed.
(* A special version of [tac_assumption] that does not do any of the (* A special version of [tac_assumption] that does not do any of the
......
...@@ -862,40 +862,58 @@ Tactic Notation "iSpecializeCore" open_constr(H) ...@@ -862,40 +862,58 @@ Tactic Notation "iSpecializeCore" open_constr(H)
| _ => H | _ => H
end in end in
iSpecializeArgs H xs; [..| iSpecializeArgs H xs; [..|
lazymatch type of H with lazymatch type of H with
| ident => | ident =>
(* The lemma [tac_specialize_intuitionistic_helper] allows one to use all (* The lemma [tac_specialize_intuitionistic_helper] allows one to use the
spatial hypotheses for both proving the premises of the lemma we whole spatial context for:
specialize as well as those of the remaining goal. We can only use it when - proving the premises of the lemma we specialize, and,
the result of the specialization is intuitionistic, and no modality is - the remaining goal.
eliminated. We do not use [tac_specialize_intuitionistic_helper] in the case
only universal quantifiers and no implications or wands are instantiated We can only use if all of the following properties hold:
(i.e [pat = []]) because it is a.) not needed, and b.) more efficient. *) - The result of the specialization is persistent.
let pat := spec_pat.parse pat in - No modality is eliminated.
lazymatch eval compute in - If the BI is not affine, the hypothesis should be in the intuitionistic
(p && bool_decide (pat []) && negb (existsb spec_pat_modal pat)) with context.
| true =>
(* FIXME: do something reasonable when the BI is not affine *) As an optimization, we do only use [tac_specialize_intuitionistic_helper]
notypeclasses refine (tac_specialize_intuitionistic_helper _ _ H _ _ _ _ _ _ _ _ _ _ _); if no implications nor wands are eliminated, i.e. [pat ≠ []]. *)
[pm_reflexivity || let pat := spec_pat.parse pat in
let H := pretty_ident H in lazymatch eval compute in
fail "iSpecialize:" H "not found" (p && bool_decide (pat []) && negb (existsb spec_pat_modal pat)) with
|iSpecializePat H pat; | true =>
[.. (* Check that if the BI is not affine, the hypothesis is in the
|notypeclasses refine (tac_specialize_intuitionistic_helper_done _ H _ _ _); intuitionistic context. *)
pm_reflexivity] lazymatch iTypeOf H with
|iSolveTC || | Some (?q, _) =>
let Q := match goal with |- IntoPersistent _ ?Q _ => Q end in let PROP := iBiOfGoal in
fail "iSpecialize:" Q "not persistent" lazymatch eval compute in (q || tc_to_bool (BiAffine PROP)) with
|pm_reduce; iSolveTC || | true =>
let Q := match goal with |- TCAnd _ (Affine ?Q) => Q end in notypeclasses refine (tac_specialize_intuitionistic_helper _ _ H _ _ _ _ _ _ _ _ _ _ _);
fail "iSpecialize:" Q "not affine" [pm_reflexivity
|pm_reflexivity (* This premise, [envs_lookup j Δ = Some (q,P)],
|(* goal *)] holds because [iTypeOf] succeeded *)
| false => iSpecializePat H pat |pm_reduce; iSolveTC
end (* This premise, [if q then TCTrue else BiAffine PROP],
| _ => fail "iSpecialize:" H "should be a hypothesis, use iPoseProof instead" holds because [q || TC_to_bool (BiAffine PROP)] is true *)
end]. |iSpecializePat H pat;
[..
|notypeclasses refine (tac_specialize_intuitionistic_helper_done _ H _ _ _);
pm_reflexivity]
|iSolveTC ||
let Q := match goal with |- IntoPersistent _ ?Q _ => Q end in
fail "iSpecialize:" Q "not persistent"
|pm_reflexivity
|(* goal *)]
| false => iSpecializePat H pat
end
| None =>
let H := pretty_ident H in
fail "iSpecialize:" H "not found"
end
| false => iSpecializePat H pat
end
| _ => fail "iSpecialize:" H "should be a hypothesis, use iPoseProof instead"
end].
Tactic Notation "iSpecializeCore" open_constr(t) "as" constr(p) := Tactic Notation "iSpecializeCore" open_constr(t) "as" constr(p) :=
lazymatch type of t with lazymatch type of t with
......
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