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

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
Pipeline #2631 passed with stage
in 8 minutes and 55 seconds
......@@ -11,9 +11,9 @@ Implicit Types P Q : iProp Σ.
Implicit Types Φ : val iProp Σ.
Implicit Types Δ : envs (iResUR Σ).
Global Instance into_sep_mapsto l q v :
IntoSep false (l {q} v) (l {q/2} v) (l {q/2} v).
Proof. by rewrite /IntoSep heap_mapsto_op_eq Qp_div_2. Qed.
Global Instance into_and_mapsto l q v :
IntoAnd false (l {q} v) (l {q/2} v) (l {q/2} v).
Proof. by rewrite /IntoAnd heap_mapsto_op_eq Qp_div_2. Qed.
Lemma tac_wp_alloc Δ Δ' E j e v Φ :
to_val e = Some v
......
......@@ -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).
Proof. by constructor. Qed.
(* IntoSep *)
Global Instance into_sep_sep p P Q : IntoSep p (P Q) P Q.
Proof. by apply mk_into_sep_sep. Qed.
Global Instance into_sep_ownM p (a b1 b2 : M) :
(* IntoAnd *)
Global Instance into_and_sep p P Q : IntoAnd p (P Q) P Q.
Proof. by apply mk_into_and_sep. Qed.
Global Instance into_and_ownM p (a b1 b2 : M) :
IntoOp a b1 b2
IntoSep 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.
IntoAnd p (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
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.
Global Instance into_sep_and_persistent_l P Q :
PersistentP P IntoSep false (P Q) P Q.
Proof. intros; by rewrite /IntoSep /= always_and_sep_l. Qed.
Global Instance into_sep_and_persistent_r P Q :
PersistentP Q IntoSep false (P Q) P Q.
Proof. intros; by rewrite /IntoSep /= always_and_sep_r. Qed.
Global Instance into_sep_later p P Q1 Q2 :
IntoSep p P Q1 Q2 IntoSep p ( P) ( Q1) ( Q2).
Proof. rewrite /IntoSep=>->. destruct p; by rewrite ?later_and ?later_sep. Qed.
Global Instance into_sep_big_sepM
Global Instance into_and_and_persistent_l P Q :
PersistentP P IntoAnd false (P Q) P Q.
Proof. intros; by rewrite /IntoAnd /= always_and_sep_l. Qed.
Global Instance into_and_and_persistent_r P Q :
PersistentP Q IntoAnd false (P Q) P Q.
Proof. intros; by rewrite /IntoAnd /= always_and_sep_r. Qed.
Global Instance into_and_later p P Q1 Q2 :
IntoAnd p P Q1 Q2 IntoAnd p ( P) ( Q1) ( Q2).
Proof. rewrite /IntoAnd=>->. destruct p; by rewrite ?later_and ?later_sep. Qed.
Global Instance into_and_big_sepM
`{Countable K} {A} (Φ Ψ1 Ψ2 : K A uPred M) p m :
( k x, IntoSep p (Φ k x) (Ψ1 k x) (Ψ2 k x))
IntoSep p ([ map] k x m, Φ k x)
( k x, IntoAnd p (Φ k x) (Ψ1 k x) (Ψ2 k x))
IntoAnd p ([ map] k x m, Φ k x)
([ map] k x m, Ψ1 k x) ([ map] k x m, Ψ2 k x).
Proof.
rewrite /IntoSep=> HΦ. destruct p.
rewrite /IntoAnd=> HΦ. destruct p.
- 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_r.
- rewrite -big_sepM_sepM. apply big_sepM_mono; auto.
Qed.
Global Instance into_sep_big_sepS `{Countable A} (Φ Ψ1 Ψ2 : A uPred M) p X :
( x, IntoSep p (Φ x) (Ψ1 x) (Ψ2 x))
IntoSep p ([ set] x X, Φ x) ([ set] x X, Ψ1 x) ([ set] x X, Ψ2 x).
Global Instance into_and_big_sepS `{Countable A} (Φ Ψ1 Ψ2 : A uPred M) p X :
( x, IntoAnd p (Φ x) (Ψ1 x) (Ψ2 x))
IntoAnd p ([ set] x X, Φ x) ([ set] x X, Ψ1 x) ([ set] x X, Ψ2 x).
Proof.
rewrite /IntoSep=> HΦ. destruct p.
rewrite /IntoAnd=> HΦ. destruct p.
- apply and_intro; apply big_sepS_mono; auto.
+ intros x ?. by rewrite HΦ and_elim_l.
+ intros x ?. by rewrite HΦ and_elim_r.
......
......@@ -32,12 +32,12 @@ Global Arguments from_and : clear implicits.
Class FromSep (P Q1 Q2 : uPred M) := from_sep : Q1 Q2 P.
Global Arguments from_sep : clear implicits.
Class IntoSep (p : bool) (P Q1 Q2 : uPred M) :=
into_sep : P if p then Q1 Q2 else Q1 Q2.
Global Arguments into_sep : clear implicits.
Class IntoAnd (p : bool) (P Q1 Q2 : uPred M) :=
into_and : P if p then Q1 Q2 else Q1 Q2.
Global Arguments into_and : clear implicits.
Lemma mk_into_sep_sep p P Q1 Q2 : (P Q1 Q2) IntoSep p P Q1 Q2.
Proof. rewrite /IntoSep=>->. destruct p; auto using sep_and. Qed.
Lemma mk_into_and_sep p P Q1 Q2 : (P Q1 Q2) IntoAnd p P Q1 Q2.
Proof. rewrite /IntoAnd=>->. destruct p; auto using sep_and. Qed.
Class IntoOp {A : cmraT} (a b1 b2 : A) := into_op : a b1 b2.
Global Arguments into_op {_} _ _ _ {_}.
......
......@@ -652,15 +652,29 @@ Proof.
Qed.
(** * Conjunction/separating conjunction elimination *)
Lemma tac_sep_destruct Δ Δ' i p j1 j2 P P1 P2 Q :
envs_lookup i Δ = Some (p, P) IntoSep p P P1 P2
Lemma tac_and_destruct Δ Δ' i p j1 j2 P P1 P2 Q :
envs_lookup i Δ = Some (p, P) IntoAnd p P P1 P2
envs_simple_replace i p (Esnoc (Esnoc Enil j1 P1) j2 P2) Δ = Some Δ'
(Δ' Q) Δ Q.
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.
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 *)
Lemma tac_frame Δ Δ' i p R P Q :
envs_lookup_delete i Δ = Some (p, R, Δ') Frame R P Q
......
......@@ -6,9 +6,9 @@ Section ghost.
Context `{inG Σ A}.
Implicit Types a b : A.
Global Instance into_sep_own p γ a b1 b2 :
IntoOp a b1 b2 IntoSep p (own γ a) (own γ b1) (own γ b2).
Proof. intros. apply mk_into_sep_sep. by rewrite (into_op a) own_op. Qed.
Global Instance into_and_own p γ a b1 b2 :
IntoOp a b1 b2 IntoAnd p (own γ a) (own γ b1) (own γ b2).
Proof. intros. apply mk_into_and_sep. by rewrite (into_op a) own_op. Qed.
Global Instance from_sep_own γ a b :
FromSep (own γ (a b)) (own γ a) (own γ b) | 90.
Proof. by rewrite /FromSep own_op. Qed.
......
......@@ -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) *)
[env_cbv; reflexivity || fail "iOrDestruct:" H "not found"
|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:" H2 "not fresh"| |].
......@@ -395,12 +395,19 @@ Tactic Notation "iSplitR" constr(Hs) :=
Tactic Notation "iSplitL" := iSplitR "".
Tactic Notation "iSplitR" := iSplitL "".
Local Tactic Notation "iSepDestruct" constr(H) "as" constr(H1) constr(H2) :=
eapply tac_sep_destruct with _ H _ H1 H2 _ _ _; (* (i:=H) (j1:=H1) (j2:=H2) *)
[env_cbv; reflexivity || fail "iSepDestruct:" H "not found"
|let P := match goal with |- IntoSep _ ?P _ _ => P end in
apply _ || fail "iSepDestruct:" P "not separating destructable"
|env_cbv; reflexivity || fail "iSepDestruct:" H1 "or" H2 " not fresh"|].
Local Tactic Notation "iAndDestruct" constr(H) "as" constr(H1) constr(H2) :=
eapply tac_and_destruct with _ H _ H1 H2 _ _ _; (* (i:=H) (j1:=H1) (j2:=H2) *)
[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:" 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) :=
eapply tac_combine with _ _ _ H1 _ _ H2 _ _ H _;
......@@ -480,7 +487,7 @@ Local Tactic Notation "iExistDestruct" constr(H)
eapply tac_exist_destruct with H _ Hx _ _; (* (i:=H) (j:=Hx) *)
[env_cbv; reflexivity || fail "iExistDestruct:" H "not found"
|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
intros y; eexists; split;
[env_cbv; reflexivity || fail "iExistDestruct:" Hx "not fresh"
......@@ -501,7 +508,7 @@ Tactic Notation "iNext":=
Tactic Notation "iTimeless" constr(H) :=
eapply tac_timeless with _ H _ _ _;
[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"
|let P := match goal with |- IntoNowTrue ?P _ => P end in
apply _ || fail "iTimeless:" P "not timeless"
......@@ -531,8 +538,10 @@ Local Tactic Notation "iDestructHyp" constr(H) "as" constr(pat) :=
| IFrame => iFrame Hz
| IName ?y => iRename Hz into y
| 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]] =>
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]
| IPureElim => iPure Hz as ?
| IAlwaysElim ?pat => iPersistent Hz; go Hz pat
......
......@@ -81,12 +81,15 @@ Proof.
by iIntros "# _".
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.
Context `{irisG Λ Σ}.
Implicit Types E : coPset.
Implicit Types P Q : iProp Σ.
Lemma demo_7 N E P Q R :
Lemma demo_8 N E P Q R :
nclose N E
(True - P - inv N Q - True - R) P - Q ={E}= R.
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