Commit 1c0a0e04 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Enable proof mode to destruct non-separating conjunctions in spatial context.

This is allowed as long as one of the conjuncts is thrown away (i.e. is a
wildcard _ in the introduction pattern). It corresponds to the principle of
"external choice" in linear logic.
parent 832cc0a5
...@@ -11,9 +11,9 @@ Implicit Types P Q : iProp Σ. ...@@ -11,9 +11,9 @@ Implicit Types P Q : iProp Σ.
Implicit Types Φ : val iProp Σ. Implicit Types Φ : val iProp Σ.
Implicit Types Δ : envs (iResUR Σ). Implicit Types Δ : envs (iResUR Σ).
Global Instance into_sep_mapsto l q v : Global Instance into_and_mapsto l q v :
IntoSep false (l {q} v) (l {q/2} v) (l {q/2} v). IntoAnd false (l {q} v) (l {q/2} v) (l {q/2} v).
Proof. by rewrite /IntoSep heap_mapsto_op_eq Qp_div_2. Qed. Proof. by rewrite /IntoAnd heap_mapsto_op_eq Qp_div_2. Qed.
Lemma tac_wp_alloc Δ Δ' E j e v Φ : Lemma tac_wp_alloc Δ Δ' E j e v Φ :
to_val e = Some v to_val e = Some v
......
...@@ -169,44 +169,44 @@ Global Instance into_op_Some {A : cmraT} (a : A) b1 b2 : ...@@ -169,44 +169,44 @@ Global Instance into_op_Some {A : cmraT} (a : A) b1 b2 :
IntoOp a b1 b2 IntoOp (Some a) (Some b1) (Some b2). IntoOp a b1 b2 IntoOp (Some a) (Some b1) (Some b2).
Proof. by constructor. Qed. Proof. by constructor. Qed.
(* IntoSep *) (* IntoAnd *)
Global Instance into_sep_sep p P Q : IntoSep p (P Q) P Q. Global Instance into_and_sep p P Q : IntoAnd p (P Q) P Q.
Proof. by apply mk_into_sep_sep. Qed. Proof. by apply mk_into_and_sep. Qed.
Global Instance into_sep_ownM p (a b1 b2 : M) : Global Instance into_and_ownM p (a b1 b2 : M) :
IntoOp a b1 b2 IntoOp a b1 b2
IntoSep p (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2). IntoAnd p (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
Proof. intros. apply mk_into_sep_sep. by rewrite (into_op a) ownM_op. Qed. Proof. intros. apply mk_into_and_sep. by rewrite (into_op a) ownM_op. Qed.
Global Instance into_sep_and P Q : IntoSep true (P Q) P Q. Global Instance into_and_and P Q : IntoAnd true (P Q) P Q.
Proof. done. Qed. Proof. done. Qed.
Global Instance into_sep_and_persistent_l P Q : Global Instance into_and_and_persistent_l P Q :
PersistentP P IntoSep false (P Q) P Q. PersistentP P IntoAnd false (P Q) P Q.
Proof. intros; by rewrite /IntoSep /= always_and_sep_l. Qed. Proof. intros; by rewrite /IntoAnd /= always_and_sep_l. Qed.
Global Instance into_sep_and_persistent_r P Q : Global Instance into_and_and_persistent_r P Q :
PersistentP Q IntoSep false (P Q) P Q. PersistentP Q IntoAnd false (P Q) P Q.
Proof. intros; by rewrite /IntoSep /= always_and_sep_r. Qed. Proof. intros; by rewrite /IntoAnd /= always_and_sep_r. Qed.
Global Instance into_sep_later p P Q1 Q2 : Global Instance into_and_later p P Q1 Q2 :
IntoSep p P Q1 Q2 IntoSep p ( P) ( Q1) ( Q2). IntoAnd p P Q1 Q2 IntoAnd p ( P) ( Q1) ( Q2).
Proof. rewrite /IntoSep=>->. destruct p; by rewrite ?later_and ?later_sep. Qed. Proof. rewrite /IntoAnd=>->. destruct p; by rewrite ?later_and ?later_sep. Qed.
Global Instance into_sep_big_sepM Global Instance into_and_big_sepM
`{Countable K} {A} (Φ Ψ1 Ψ2 : K A uPred M) p m : `{Countable K} {A} (Φ Ψ1 Ψ2 : K A uPred M) p m :
( k x, IntoSep p (Φ k x) (Ψ1 k x) (Ψ2 k x)) ( k x, IntoAnd p (Φ k x) (Ψ1 k x) (Ψ2 k x))
IntoSep p ([ map] k x m, Φ k x) IntoAnd p ([ map] k x m, Φ k x)
([ map] k x m, Ψ1 k x) ([ map] k x m, Ψ2 k x). ([ map] k x m, Ψ1 k x) ([ map] k x m, Ψ2 k x).
Proof. Proof.
rewrite /IntoSep=> HΦ. destruct p. rewrite /IntoAnd=> HΦ. destruct p.
- apply and_intro; apply big_sepM_mono; auto. - apply and_intro; apply big_sepM_mono; auto.
+ intros k x ?. by rewrite HΦ and_elim_l. + intros k x ?. by rewrite HΦ and_elim_l.
+ intros k x ?. by rewrite HΦ and_elim_r. + intros k x ?. by rewrite HΦ and_elim_r.
- rewrite -big_sepM_sepM. apply big_sepM_mono; auto. - rewrite -big_sepM_sepM. apply big_sepM_mono; auto.
Qed. Qed.
Global Instance into_sep_big_sepS `{Countable A} (Φ Ψ1 Ψ2 : A uPred M) p X : Global Instance into_and_big_sepS `{Countable A} (Φ Ψ1 Ψ2 : A uPred M) p X :
( x, IntoSep p (Φ x) (Ψ1 x) (Ψ2 x)) ( x, IntoAnd p (Φ x) (Ψ1 x) (Ψ2 x))
IntoSep p ([ set] x X, Φ x) ([ set] x X, Ψ1 x) ([ set] x X, Ψ2 x). IntoAnd p ([ set] x X, Φ x) ([ set] x X, Ψ1 x) ([ set] x X, Ψ2 x).
Proof. Proof.
rewrite /IntoSep=> HΦ. destruct p. rewrite /IntoAnd=> HΦ. destruct p.
- apply and_intro; apply big_sepS_mono; auto. - apply and_intro; apply big_sepS_mono; auto.
+ intros x ?. by rewrite HΦ and_elim_l. + intros x ?. by rewrite HΦ and_elim_l.
+ intros x ?. by rewrite HΦ and_elim_r. + intros x ?. by rewrite HΦ and_elim_r.
......
...@@ -32,12 +32,12 @@ Global Arguments from_and : clear implicits. ...@@ -32,12 +32,12 @@ Global Arguments from_and : clear implicits.
Class FromSep (P Q1 Q2 : uPred M) := from_sep : Q1 Q2 P. Class FromSep (P Q1 Q2 : uPred M) := from_sep : Q1 Q2 P.
Global Arguments from_sep : clear implicits. Global Arguments from_sep : clear implicits.
Class IntoSep (p : bool) (P Q1 Q2 : uPred M) := Class IntoAnd (p : bool) (P Q1 Q2 : uPred M) :=
into_sep : P if p then Q1 Q2 else Q1 Q2. into_and : P if p then Q1 Q2 else Q1 Q2.
Global Arguments into_sep : clear implicits. Global Arguments into_and : clear implicits.
Lemma mk_into_sep_sep p P Q1 Q2 : (P Q1 Q2) IntoSep p P Q1 Q2. Lemma mk_into_and_sep p P Q1 Q2 : (P Q1 Q2) IntoAnd p P Q1 Q2.
Proof. rewrite /IntoSep=>->. destruct p; auto using sep_and. Qed. Proof. rewrite /IntoAnd=>->. destruct p; auto using sep_and. Qed.
Class IntoOp {A : cmraT} (a b1 b2 : A) := into_op : a b1 b2. Class IntoOp {A : cmraT} (a b1 b2 : A) := into_op : a b1 b2.
Global Arguments into_op {_} _ _ _ {_}. Global Arguments into_op {_} _ _ _ {_}.
......
...@@ -652,15 +652,29 @@ Proof. ...@@ -652,15 +652,29 @@ Proof.
Qed. Qed.
(** * Conjunction/separating conjunction elimination *) (** * Conjunction/separating conjunction elimination *)
Lemma tac_sep_destruct Δ Δ' i p j1 j2 P P1 P2 Q : Lemma tac_and_destruct Δ Δ' i p j1 j2 P P1 P2 Q :
envs_lookup i Δ = Some (p, P) IntoSep p P P1 P2 envs_lookup i Δ = Some (p, P) IntoAnd p P P1 P2
envs_simple_replace i p (Esnoc (Esnoc Enil j1 P1) j2 P2) Δ = Some Δ' envs_simple_replace i p (Esnoc (Esnoc Enil j1 P1) j2 P2) Δ = Some Δ'
(Δ' Q) Δ Q. (Δ' Q) Δ Q.
Proof. Proof.
intros. rewrite envs_simple_replace_sound //; simpl. rewrite (into_sep p P). intros. rewrite envs_simple_replace_sound //; simpl. rewrite (into_and p P).
by destruct p; rewrite /= ?right_id (comm _ P1) ?always_and_sep wand_elim_r. by destruct p; rewrite /= ?right_id (comm _ P1) ?always_and_sep wand_elim_r.
Qed. Qed.
(* Using this tactic, one can destruct a (non-separating) conjunction in the
spatial context as long as one of the conjuncts is thrown away. It corresponds
to the principle of "external choice" in linear logic. *)
Lemma tac_and_destruct_choice Δ Δ' i p (lr : bool) j P P1 P2 Q :
envs_lookup i Δ = Some (p, P) IntoAnd true P P1 P2
envs_simple_replace i p (Esnoc Enil j (if lr then P1 else P2)) Δ = Some Δ'
(Δ' Q) Δ Q.
Proof.
intros. rewrite envs_simple_replace_sound //; simpl.
rewrite right_id (into_and true P). destruct lr.
- by rewrite and_elim_l wand_elim_r.
- by rewrite and_elim_r wand_elim_r.
Qed.
(** * Framing *) (** * Framing *)
Lemma tac_frame Δ Δ' i p R P Q : Lemma tac_frame Δ Δ' i p R P Q :
envs_lookup_delete i Δ = Some (p, R, Δ') Frame R P Q envs_lookup_delete i Δ = Some (p, R, Δ') Frame R P Q
......
...@@ -6,9 +6,9 @@ Section ghost. ...@@ -6,9 +6,9 @@ Section ghost.
Context `{inG Σ A}. Context `{inG Σ A}.
Implicit Types a b : A. Implicit Types a b : A.
Global Instance into_sep_own p γ a b1 b2 : Global Instance into_and_own p γ a b1 b2 :
IntoOp a b1 b2 IntoSep p (own γ a) (own γ b1) (own γ b2). IntoOp a b1 b2 IntoAnd p (own γ a) (own γ b1) (own γ b2).
Proof. intros. apply mk_into_sep_sep. by rewrite (into_op a) own_op. Qed. Proof. intros. apply mk_into_and_sep. by rewrite (into_op a) own_op. Qed.
Global Instance from_sep_own γ a b : Global Instance from_sep_own γ a b :
FromSep (own γ (a b)) (own γ a) (own γ b) | 90. FromSep (own γ (a b)) (own γ a) (own γ b) | 90.
Proof. by rewrite /FromSep own_op. Qed. Proof. by rewrite /FromSep own_op. Qed.
......
...@@ -363,7 +363,7 @@ Local Tactic Notation "iOrDestruct" constr(H) "as" constr(H1) constr(H2) := ...@@ -363,7 +363,7 @@ Local Tactic Notation "iOrDestruct" constr(H) "as" constr(H1) constr(H2) :=
eapply tac_or_destruct with _ _ H _ H1 H2 _ _ _; (* (i:=H) (j1:=H1) (j2:=H2) *) eapply tac_or_destruct with _ _ H _ H1 H2 _ _ _; (* (i:=H) (j1:=H1) (j2:=H2) *)
[env_cbv; reflexivity || fail "iOrDestruct:" H "not found" [env_cbv; reflexivity || fail "iOrDestruct:" H "not found"
|let P := match goal with |- IntoOr ?P _ _ => P end in |let P := match goal with |- IntoOr ?P _ _ => P end in
apply _ || fail "iOrDestruct:" P "not a disjunction" apply _ || fail "iOrDestruct: cannot destruct" P
|env_cbv; reflexivity || fail "iOrDestruct:" H1 "not fresh" |env_cbv; reflexivity || fail "iOrDestruct:" H1 "not fresh"
|env_cbv; reflexivity || fail "iOrDestruct:" H2 "not fresh"| |]. |env_cbv; reflexivity || fail "iOrDestruct:" H2 "not fresh"| |].
...@@ -395,12 +395,19 @@ Tactic Notation "iSplitR" constr(Hs) := ...@@ -395,12 +395,19 @@ Tactic Notation "iSplitR" constr(Hs) :=
Tactic Notation "iSplitL" := iSplitR "". Tactic Notation "iSplitL" := iSplitR "".
Tactic Notation "iSplitR" := iSplitL "". Tactic Notation "iSplitR" := iSplitL "".
Local Tactic Notation "iSepDestruct" constr(H) "as" constr(H1) constr(H2) := Local Tactic Notation "iAndDestruct" constr(H) "as" constr(H1) constr(H2) :=
eapply tac_sep_destruct with _ H _ H1 H2 _ _ _; (* (i:=H) (j1:=H1) (j2:=H2) *) eapply tac_and_destruct with _ H _ H1 H2 _ _ _; (* (i:=H) (j1:=H1) (j2:=H2) *)
[env_cbv; reflexivity || fail "iSepDestruct:" H "not found" [env_cbv; reflexivity || fail "iAndDestruct:" H "not found"
|let P := match goal with |- IntoSep _ ?P _ _ => P end in |let P := match goal with |- IntoAnd _ ?P _ _ => P end in
apply _ || fail "iSepDestruct:" P "not separating destructable" apply _ || fail "iAndDestruct: cannot destruct" P
|env_cbv; reflexivity || fail "iSepDestruct:" H1 "or" H2 " not fresh"|]. |env_cbv; reflexivity || fail "iAndDestruct:" H1 "or" H2 " not fresh"|].
Local Tactic Notation "iAndDestructChoice" constr(H) "as" constr(lr) constr(H') :=
eapply tac_and_destruct_choice with _ H _ lr H' _ _ _;
[env_cbv; reflexivity || fail "iAndDestruct:" H "not found"
|let P := match goal with |- IntoAnd _ ?P _ _ => P end in
apply _ || fail "iAndDestruct: cannot destruct" P
|env_cbv; reflexivity || fail "iAndDestruct:" H' " not fresh"|].
Tactic Notation "iCombine" constr(H1) constr(H2) "as" constr(H) := Tactic Notation "iCombine" constr(H1) constr(H2) "as" constr(H) :=
eapply tac_combine with _ _ _ H1 _ _ H2 _ _ H _; eapply tac_combine with _ _ _ H1 _ _ H2 _ _ H _;
...@@ -480,7 +487,7 @@ Local Tactic Notation "iExistDestruct" constr(H) ...@@ -480,7 +487,7 @@ Local Tactic Notation "iExistDestruct" constr(H)
eapply tac_exist_destruct with H _ Hx _ _; (* (i:=H) (j:=Hx) *) eapply tac_exist_destruct with H _ Hx _ _; (* (i:=H) (j:=Hx) *)
[env_cbv; reflexivity || fail "iExistDestruct:" H "not found" [env_cbv; reflexivity || fail "iExistDestruct:" H "not found"
|let P := match goal with |- IntoExist ?P _ => P end in |let P := match goal with |- IntoExist ?P _ => P end in
apply _ || fail "iExistDestruct:" P "not an existential"|]; apply _ || fail "iExistDestruct: cannot destruct" P|];
let y := fresh in let y := fresh in
intros y; eexists; split; intros y; eexists; split;
[env_cbv; reflexivity || fail "iExistDestruct:" Hx "not fresh" [env_cbv; reflexivity || fail "iExistDestruct:" Hx "not fresh"
...@@ -501,7 +508,7 @@ Tactic Notation "iNext":= ...@@ -501,7 +508,7 @@ Tactic Notation "iNext":=
Tactic Notation "iTimeless" constr(H) := Tactic Notation "iTimeless" constr(H) :=
eapply tac_timeless with _ H _ _ _; eapply tac_timeless with _ H _ _ _;
[let Q := match goal with |- IsNowTrue ?Q => Q end in [let Q := match goal with |- IsNowTrue ?Q => Q end in
apply _ || fail "iTimeless: cannot remove later of timeless hypothesis in goal" Q apply _ || fail "iTimeless: cannot remove later when goal is" Q
|env_cbv; reflexivity || fail "iTimeless:" H "not found" |env_cbv; reflexivity || fail "iTimeless:" H "not found"
|let P := match goal with |- IntoNowTrue ?P _ => P end in |let P := match goal with |- IntoNowTrue ?P _ => P end in
apply _ || fail "iTimeless:" P "not timeless" apply _ || fail "iTimeless:" P "not timeless"
...@@ -531,8 +538,10 @@ Local Tactic Notation "iDestructHyp" constr(H) "as" constr(pat) := ...@@ -531,8 +538,10 @@ Local Tactic Notation "iDestructHyp" constr(H) "as" constr(pat) :=
| IFrame => iFrame Hz | IFrame => iFrame Hz
| IName ?y => iRename Hz into y | IName ?y => iRename Hz into y
| IList [[]] => iExFalso; iExact Hz | IList [[]] => iExFalso; iExact Hz
| IList [[?pat1; IDrop]] => iAndDestructChoice Hz as true Hz; go Hz pat1
| IList [[IDrop; ?pat2]] => iAndDestructChoice Hz as false Hz; go Hz pat2
| IList [[?pat1; ?pat2]] => | IList [[?pat1; ?pat2]] =>
let Hy := iFresh in iSepDestruct Hz as Hz Hy; go Hz pat1; go Hy pat2 let Hy := iFresh in iAndDestruct Hz as Hz Hy; go Hz pat1; go Hy pat2
| IList [[?pat1];[?pat2]] => iOrDestruct Hz as Hz Hz; [go Hz pat1|go Hz pat2] | IList [[?pat1];[?pat2]] => iOrDestruct Hz as Hz Hz; [go Hz pat1|go Hz pat2]
| IPureElim => iPure Hz as ? | IPureElim => iPure Hz as ?
| IAlwaysElim ?pat => iPersistent Hz; go Hz pat | IAlwaysElim ?pat => iPersistent Hz; go Hz pat
......
...@@ -81,12 +81,15 @@ Proof. ...@@ -81,12 +81,15 @@ Proof.
by iIntros "# _". by iIntros "# _".
Qed. Qed.
Lemma demo_7 (M : ucmraT) (P Q1 Q2 : uPred M) : P (Q1 Q2) P Q1.
Proof. iIntros "[H1 [H2 _]]". by iFrame. Qed.
Section iris. Section iris.
Context `{irisG Λ Σ}. Context `{irisG Λ Σ}.
Implicit Types E : coPset. Implicit Types E : coPset.
Implicit Types P Q : iProp Σ. Implicit Types P Q : iProp Σ.
Lemma demo_7 N E P Q R : Lemma demo_8 N E P Q R :
nclose N E nclose N E
(True - P - inv N Q - True - R) P - Q ={E}= R. (True - P - inv N Q - True - R) P - Q ={E}= R.
Proof. Proof.
......
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