Commit 453f4d30 authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan

Merge remote-tracking branch 'origin/master' into gen_proofmode

parents 0c94e327 71d78026
...@@ -18,6 +18,7 @@ Changes in Coq: ...@@ -18,6 +18,7 @@ Changes in Coq:
* Rename some things and change notation: * Rename some things and change notation:
- The unit of a camera: `empty` -> `unit`, `∅` -> `ε` - The unit of a camera: `empty` -> `unit`, `∅` -> `ε`
- Disjointness: `⊥` -> `##`
- A proof mode type class `IntoOp` -> `IsOp` - A proof mode type class `IntoOp` -> `IsOp`
- OFEs with all elements being discrete: `Discrete` -> `OfeDiscrete` - OFEs with all elements being discrete: `Discrete` -> `OfeDiscrete`
- OFE elements whose equality is discrete: `Timeless` -> `Discrete` - OFE elements whose equality is discrete: `Timeless` -> `Discrete`
...@@ -85,6 +86,8 @@ sed 's/\bPersistentP\b/Persistent/g; s/\bTimelessP\b/Timeless/g; s/\bCMRADiscret ...@@ -85,6 +86,8 @@ sed 's/\bPersistentP\b/Persistent/g; s/\bTimelessP\b/Timeless/g; s/\bCMRADiscret
of evars, which often led to divergence. There are a few places where type of evars, which often led to divergence. There are a few places where type
annotations are now needed. annotations are now needed.
* Move the `prelude` folder to its own project: std++ * Move the `prelude` folder to its own project: std++
* The rules `internal_eq_rewrite` and `internal_eq_rewrite_contractive` are now
stated in the logic, i.e. they are `iApply` friendly.
## Iris 3.0.0 (released 2017-01-11) ## Iris 3.0.0 (released 2017-01-11)
...@@ -113,7 +116,7 @@ sed 's/\bPersistentP\b/Persistent/g; s/\bTimelessP\b/Timeless/g; s/\bCMRADiscret ...@@ -113,7 +116,7 @@ sed 's/\bPersistentP\b/Persistent/g; s/\bTimelessP\b/Timeless/g; s/\bCMRADiscret
* Slightly weaker notion of atomicity: an expression is atomic if it reduces in * Slightly weaker notion of atomicity: an expression is atomic if it reduces in
one step to something that does not reduce further. one step to something that does not reduce further.
* Changed notation for embedding Coq assertions into Iris. The new notation is * Changed notation for embedding Coq assertions into Iris. The new notation is
⌜φ⌝. Also removed `=` and `##` from the Iris scope. (The old notations are ⌜φ⌝. Also removed `=` and `` from the Iris scope. (The old notations are
provided in `base_logic.deprecated`.) provided in `base_logic.deprecated`.)
* Up-closure of namespaces is now a notation (↑) instead of a coercion. * Up-closure of namespaces is now a notation (↑) instead of a coercion.
* With invariants and the physical state being handled in the logic, there is no * With invariants and the physical state being handled in the logic, there is no
......
...@@ -55,7 +55,7 @@ done ...@@ -55,7 +55,7 @@ done
# Upgrade cached things. # Upgrade cached things.
echo echo
echo "[opam-ci] Upgrading opam" echo "[opam-ci] Upgrading opam"
opam upgrade -y --fixup opam upgrade -y --fixup && opam upgrade -y
# Install build-dependencies. # Install build-dependencies.
echo echo
......
...@@ -9,7 +9,7 @@ Module Import uPred. ...@@ -9,7 +9,7 @@ Module Import uPred.
End uPred. End uPred.
(* Hint DB for the logic *) (* Hint DB for the logic *)
Hint Resolve pure_intro. Hint Resolve pure_intro : I.
Hint Resolve or_elim or_intro_l' or_intro_r' : I. Hint Resolve or_elim or_intro_l' or_intro_r' : I.
Hint Resolve and_intro and_elim_l' and_elim_r' : I. Hint Resolve and_intro and_elim_l' and_elim_r' : I.
Hint Resolve persistently_mono : I. Hint Resolve persistently_mono : I.
......
...@@ -272,7 +272,7 @@ Proof. ...@@ -272,7 +272,7 @@ Proof.
iExists γ1, γ2. iIntros "{$% $#} !>". iSplit; last iSplit; try iPureIntro. iExists γ1, γ2. iIntros "{$% $#} !>". iSplit; last iSplit; try iPureIntro.
{ by eapply lookup_insert_None. } { by eapply lookup_insert_None. }
{ by apply (lookup_insert_None (delete γ f) γ1 γ2 true). } { by apply (lookup_insert_None (delete γ f) γ1 γ2 true). }
iNext. eapply internal_eq_rewrite_contractive'; [by apply _| |by eauto]. iNext. iApply (internal_eq_rewrite_contractive with "[Heq] Hbox").
iNext. iRewrite "Heq". iPureIntro. by rewrite assoc (comm _ Q2). iNext. iRewrite "Heq". iPureIntro. by rewrite assoc (comm _ Q2).
- iMod (slice_delete_empty with "Hslice Hbox") as (P') "[Heq Hbox]"; try done. - iMod (slice_delete_empty with "Hslice Hbox") as (P') "[Heq Hbox]"; try done.
iMod (slice_insert_empty with "Hbox") as (γ1 ?) "[#Hslice1 Hbox]". iMod (slice_insert_empty with "Hbox") as (γ1 ?) "[#Hslice1 Hbox]".
...@@ -280,7 +280,7 @@ Proof. ...@@ -280,7 +280,7 @@ Proof.
iExists γ1, γ2. iIntros "{$% $#} !>". iSplit; last iSplit; try iPureIntro. iExists γ1, γ2. iIntros "{$% $#} !>". iSplit; last iSplit; try iPureIntro.
{ by eapply lookup_insert_None. } { by eapply lookup_insert_None. }
{ by apply (lookup_insert_None (delete γ f) γ1 γ2 false). } { by apply (lookup_insert_None (delete γ f) γ1 γ2 false). }
iNext. eapply internal_eq_rewrite_contractive'; [by apply _| |by eauto]. iNext. iApply (internal_eq_rewrite_contractive with "[Heq] Hbox").
iNext. iRewrite "Heq". iPureIntro. by rewrite assoc (comm _ Q2). iNext. iRewrite "Heq". iPureIntro. by rewrite assoc (comm _ Q2).
Qed. Qed.
...@@ -297,14 +297,14 @@ Proof. ...@@ -297,14 +297,14 @@ Proof.
iMod (slice_insert_full _ _ _ _ (Q1 Q2)%I with "[$HQ1 $HQ2] Hbox") iMod (slice_insert_full _ _ _ _ (Q1 Q2)%I with "[$HQ1 $HQ2] Hbox")
as (γ ?) "[#Hslice Hbox]"; first done. as (γ ?) "[#Hslice Hbox]"; first done.
iExists γ. iIntros "{$% $#} !>". iNext. iExists γ. iIntros "{$% $#} !>". iNext.
eapply internal_eq_rewrite_contractive'; [by apply _| |by eauto]. iApply (internal_eq_rewrite_contractive with "[Heq1 Heq2] Hbox").
iNext. iRewrite "Heq1". iRewrite "Heq2". by rewrite assoc. iNext. iRewrite "Heq1". iRewrite "Heq2". by rewrite assoc.
- iMod (slice_delete_empty with "Hslice1 Hbox") as (P1) "(Heq1 & Hbox)"; try done. - iMod (slice_delete_empty with "Hslice1 Hbox") as (P1) "(Heq1 & Hbox)"; try done.
iMod (slice_delete_empty with "Hslice2 Hbox") as (P2) "(Heq2 & Hbox)"; first done. iMod (slice_delete_empty with "Hslice2 Hbox") as (P2) "(Heq2 & Hbox)"; first done.
{ by simplify_map_eq. } { by simplify_map_eq. }
iMod (slice_insert_empty with "Hbox") as (γ ?) "[#Hslice Hbox]". iMod (slice_insert_empty with "Hbox") as (γ ?) "[#Hslice Hbox]".
iExists γ. iIntros "{$% $#} !>". iNext. iExists γ. iIntros "{$% $#} !>". iNext.
eapply internal_eq_rewrite_contractive'; [by apply _| |by eauto]. iApply (internal_eq_rewrite_contractive with "[Heq1 Heq2] Hbox").
iNext. iRewrite "Heq1". iRewrite "Heq2". by rewrite assoc. iNext. iRewrite "Heq1". iRewrite "Heq2". by rewrite assoc.
Qed. Qed.
End box. End box.
......
...@@ -80,6 +80,25 @@ Qed. ...@@ -80,6 +80,25 @@ Qed.
Lemma fupd_frame_r E1 E2 P Q : (|={E1,E2}=> P) Q ={E1,E2}= P Q. Lemma fupd_frame_r E1 E2 P Q : (|={E1,E2}=> P) Q ={E1,E2}= P Q.
Proof. rewrite fupd_eq /fupd_def. by iIntros "[HwP $]". Qed. Proof. rewrite fupd_eq /fupd_def. by iIntros "[HwP $]". Qed.
Lemma fupd_plain' E1 E2 E2' P Q `{!Plain P} :
E1 E2
(Q ={E1, E2'}= P) - (|={E1, E2}=> Q) ={E1}= (|={E1, E2}=> Q) P.
Proof.
iIntros ((E3&->&HE)%subseteq_disjoint_union_L) "HQP HQ".
rewrite fupd_eq /fupd_def ownE_op //. iIntros "H".
iMod ("HQ" with "H") as ">(Hws & [HE1 HE3] & HQ)"; iModIntro.
iAssert ( P)%I as "#HP".
{ by iMod ("HQP" with "HQ [$]") as "(_ & _ & HP)". }
iMod "HP". iFrame. auto.
Qed.
Lemma later_fupd_plain E P `{!Plain P} : ( |={E}=> P) ={E}= P.
Proof.
rewrite fupd_eq /fupd_def. iIntros "HP [Hw HE]".
iAssert ( P)%I with "[-]" as "#$"; last by iFrame.
iNext. by iMod ("HP" with "[$]") as "(_ & _ & HP)".
Qed.
(** * Derived rules *) (** * Derived rules *)
Global Instance fupd_mono' E1 E2 : Proper (() ==> ()) (@fupd Σ _ E1 E2). Global Instance fupd_mono' E1 E2 : Proper (() ==> ()) (@fupd Σ _ E1 E2).
Proof. intros P Q; apply fupd_mono. Qed. Proof. intros P Q; apply fupd_mono. Qed.
...@@ -139,6 +158,13 @@ Proof. ...@@ -139,6 +158,13 @@ Proof.
apply (big_opS_forall (λ P Q, P ={E}= Q)); auto using fupd_intro. apply (big_opS_forall (λ P Q, P ={E}= Q)); auto using fupd_intro.
intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep. intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep.
Qed. Qed.
Lemma fupd_plain E1 E2 P Q `{!Plain P} :
E1 E2 (Q - P) - (|={E1, E2}=> Q) ={E1}= (|={E1, E2}=> Q) P.
Proof.
iIntros (HE) "HQP HQ". iApply (fupd_plain' _ _ E1 with "[HQP] HQ"); first done.
iIntros "?". iApply fupd_intro. by iApply "HQP".
Qed.
End fupd. End fupd.
(** Proofmode class instances *) (** Proofmode class instances *)
...@@ -212,7 +238,7 @@ Section proofmode_classes. ...@@ -212,7 +238,7 @@ Section proofmode_classes.
Proof. by rewrite /ElimModal fupd_frame_r wand_elim_r fupd_trans. Qed. Proof. by rewrite /ElimModal fupd_frame_r wand_elim_r fupd_trans. Qed.
End proofmode_classes. End proofmode_classes.
Hint Extern 2 (coq_tactics.of_envs _ |={_}=> _) => iModIntro. Hint Extern 2 (coq_tactics.envs_entails _ (|={_}=> _)) => iModIntro.
(** Fancy updates that take a step. *) (** Fancy updates that take a step. *)
......
...@@ -151,6 +151,5 @@ End iProp_solution. ...@@ -151,6 +151,5 @@ End iProp_solution.
Lemma iProp_unfold_equivI {Σ} (P Q : iProp Σ) : Lemma iProp_unfold_equivI {Σ} (P Q : iProp Σ) :
iProp_unfold P iProp_unfold Q (P Q : iProp Σ). iProp_unfold P iProp_unfold Q (P Q : iProp Σ).
Proof. Proof.
rewrite -{2}(iProp_fold_unfold P) -{2}(iProp_fold_unfold Q). rewrite -{2}(iProp_fold_unfold P) -{2}(iProp_fold_unfold Q). apply: bi.f_equiv.
apply: bi.f_equiv.
Qed. Qed.
...@@ -44,7 +44,6 @@ Section saved_prop. ...@@ -44,7 +44,6 @@ Section saved_prop.
assert ( z, G2 (G1 z) z) as help. assert ( z, G2 (G1 z) z) as help.
{ intros z. rewrite /G1 /G2 -cFunctor_compose -{2}[z]cFunctor_id. { intros z. rewrite /G1 /G2 -cFunctor_compose -{2}[z]cFunctor_id.
apply (ne_proper (cFunctor_map F)); split=>?; apply iProp_fold_unfold. } apply (ne_proper (cFunctor_map F)); split=>?; apply iProp_fold_unfold. }
rewrite -{2}[x]help -{2}[y]help. apply later_mono. rewrite -{2}[x]help -{2}[y]help. apply later_mono, f_equiv, _.
apply f_equiv. solve_proper.
Qed. Qed.
End saved_prop. End saved_prop.
...@@ -4,7 +4,7 @@ From iris.algebra Require Import proofmode_classes. ...@@ -4,7 +4,7 @@ From iris.algebra Require Import proofmode_classes.
Import uPred. Import uPred.
Import bi. Import bi.
Hint Extern 1 (coq_tactics.of_envs _ |==> _) => iModIntro. Hint Extern 1 (coq_tactics.envs_entails _ (|==> _)) => iModIntro.
Section class_instances. Section class_instances.
Context {M : ucmraT}. Context {M : ucmraT}.
......
...@@ -842,6 +842,3 @@ Section gmultiset. ...@@ -842,6 +842,3 @@ Section gmultiset.
End gmultiset. End gmultiset.
End sbi_big_op. End sbi_big_op.
End bi. End bi.
Hint Resolve bi.big_sepL_nil' bi.big_sepM_empty'
bi.big_sepS_empty' bi.big_sepMS_empty' | 0.
...@@ -1741,9 +1741,9 @@ Global Instance from_option_persistent {A} P (Ψ : A → PROP) (mx : option A) : ...@@ -1741,9 +1741,9 @@ Global Instance from_option_persistent {A} P (Ψ : A → PROP) (mx : option A) :
( x, Persistent (Ψ x)) Persistent P Persistent (from_option Ψ P mx). ( x, Persistent (Ψ x)) Persistent P Persistent (from_option Ψ P mx).
Proof. destruct mx; apply _. Qed. Proof. destruct mx; apply _. Qed.
(* Not an instance, see the bottom of this file *)
Lemma plain_persistent P : Plain P Persistent P. Lemma plain_persistent P : Plain P Persistent P.
Proof. intros. by rewrite /Persistent -plainly_elim_persistently. Qed. Proof. intros. by rewrite /Persistent -plainly_elim_persistently. Qed.
Hint Immediate plain_persistent.
(* Properties of persistent propositions *) (* Properties of persistent propositions *)
Lemma persistent_persistently_2 P `{!Persistent P} : P bi_persistently P. Lemma persistent_persistently_2 P `{!Persistent P} : P bi_persistently P.
...@@ -1925,6 +1925,12 @@ Global Instance later_proper' : ...@@ -1925,6 +1925,12 @@ Global Instance later_proper' :
Proper (() ==> ()) (@bi_later PROP) := ne_proper _. Proper (() ==> ()) (@bi_later PROP) := ne_proper _.
(* Equality *) (* Equality *)
Lemma internal_eq_rewrite_contractive {A : ofeT} a b (Ψ : A PROP)
{HΨ : Contractive Ψ} : (a b) Ψ a Ψ b.
Proof.
rewrite later_eq_2. move: HΨ=>/contractive_alt [g [? HΨ]]. rewrite !HΨ.
by apply internal_eq_rewrite.
Qed.
Lemma internal_eq_rewrite_contractive' {A : ofeT} a b (Ψ : A PROP) P Lemma internal_eq_rewrite_contractive' {A : ofeT} a b (Ψ : A PROP) P
{HΨ : Contractive Ψ} : (P (a b)) (P Ψ a) P Ψ b. {HΨ : Contractive Ψ} : (P (a b)) (P Ψ a) P Ψ b.
Proof. Proof.
...@@ -2113,8 +2119,18 @@ Proof. ...@@ -2113,8 +2119,18 @@ Proof.
- rewrite sep_or_r !sep_or_l {1}(later_intro P) {1}(later_intro Q). - rewrite sep_or_r !sep_or_l {1}(later_intro P) {1}(later_intro Q).
rewrite -!later_sep !left_absorb right_absorb. auto. rewrite -!later_sep !left_absorb right_absorb. auto.
Qed. Qed.
Lemma except_0_forall_1 {A} (Φ : A PROP) : ( a, Φ a) a, Φ a. Lemma except_0_forall {A} (Φ : A PROP) : ( a, Φ a) a, Φ a.
Proof. apply forall_intro=> a. by rewrite (forall_elim a). Qed. Proof.
apply (anti_symm _).
{ apply forall_intro=> a. by rewrite (forall_elim a). }
trans ( ( a : A, Φ a) ( a : A, Φ a))%I.
{ apply and_intro, reflexivity. rewrite later_forall. apply forall_mono=> a.
apply or_elim; auto using later_intro. }
rewrite later_false_em and_or_r. apply or_elim.
{ rewrite and_elim_l. apply or_intro_l. }
apply or_intro_r', forall_intro=> a. rewrite !(forall_elim a).
by rewrite and_or_l impl_elim_l and_elim_r idemp.
Qed.
Lemma except_0_exist_2 {A} (Φ : A PROP) : ( a, Φ a) a, Φ a. Lemma except_0_exist_2 {A} (Φ : A PROP) : ( a, Φ a) a, Φ a.
Proof. apply exist_elim=> a. by rewrite (exist_intro a). Qed. Proof. apply exist_elim=> a. by rewrite (exist_intro a). Qed.
Lemma except_0_exist `{Inhabited A} (Φ : A PROP) : Lemma except_0_exist `{Inhabited A} (Φ : A PROP) :
...@@ -2157,6 +2173,13 @@ Proof. ...@@ -2157,6 +2173,13 @@ Proof.
by apply and_mono, except_0_intro. by apply and_mono, except_0_intro.
Qed. Qed.
Global Instance except_0_plain P : Plain P Plain ( P).
Proof. rewrite /bi_except_0; apply _. Qed.
Global Instance except_0_persistent P : Persistent P Persistent ( P).
Proof. rewrite /bi_except_0; apply _. Qed.
Global Instance except_0_absorbing P : Absorbing P Absorbing ( P).
Proof. rewrite /bi_except_0; apply _. Qed.
(* Timeless instances *) (* Timeless instances *)
Global Instance Timeless_proper : Proper (() ==> iff) (@Timeless PROP). Global Instance Timeless_proper : Proper (() ==> iff) (@Timeless PROP).
Proof. solve_proper. Qed. Proof. solve_proper. Qed.
...@@ -2198,11 +2221,8 @@ Qed. ...@@ -2198,11 +2221,8 @@ Qed.
Global Instance forall_timeless {A} (Ψ : A PROP) : Global Instance forall_timeless {A} (Ψ : A PROP) :
( x, Timeless (Ψ x)) Timeless ( x, Ψ x). ( x, Timeless (Ψ x)) Timeless ( x, Ψ x).
Proof. Proof.
rewrite /Timeless=> HQ. rewrite later_false_em. rewrite /Timeless=> HQ. rewrite except_0_forall later_forall.
apply or_mono; first done. apply forall_intro=> x. apply forall_mono; auto.
rewrite -(löb (Ψ x)); apply impl_intro_l.
rewrite HQ /bi_except_0 !and_or_r. apply or_elim; last auto.
by rewrite impl_elim_r (forall_elim x).
Qed. Qed.
Global Instance exist_timeless {A} (Ψ : A PROP) : Global Instance exist_timeless {A} (Ψ : A PROP) :
( x, Timeless (Ψ x)) Timeless ( x, Ψ x). ( x, Timeless (Ψ x)) Timeless ( x, Ψ x).
...@@ -2297,3 +2317,12 @@ Global Instance bi_except_0_sep_entails_homomorphism : ...@@ -2297,3 +2317,12 @@ Global Instance bi_except_0_sep_entails_homomorphism :
Proof. split; try apply _. apply except_0_intro. Qed. Proof. split; try apply _. apply except_0_intro. Qed.
End sbi_derived. End sbi_derived.
End bi. End bi.
(* When declared as an actual instance, [plain_persistent] will cause
failing proof searches to take exponential time, as Coq will try to
apply it the instance at any node in the proof search tree.
To avoid that, we declare it using a [Hint Immediate], so that it will
only be used at the leaves of the proof search tree, i.e. when the
premise of the hint can be derived from just the current context. *)
Hint Immediate bi.plain_persistent : typeclass_instances.
...@@ -109,14 +109,6 @@ Fixpoint to_val (e : expr) : option val := ...@@ -109,14 +109,6 @@ Fixpoint to_val (e : expr) : option val :=
| _ => None | _ => None
end. end.
Class AsRec (e : expr) (f x : binder) (erec : expr) :=
as_rec : e = Rec f x erec.
Instance AsRec_rec f x e : AsRec (Rec f x e) f x e := eq_refl.
Instance AsRec_rec_locked_val v f x e :
AsRec (of_val v) f x e AsRec (of_val (locked v)) f x e.
Proof. by unlock. Qed.
(** The state: heaps of vals. *) (** The state: heaps of vals. *)
Definition state := gmap loc val. Definition state := gmap loc val.
...@@ -420,7 +412,7 @@ Lemma is_closed_of_val X v : is_closed X (of_val v). ...@@ -420,7 +412,7 @@ Lemma is_closed_of_val X v : is_closed X (of_val v).
Proof. apply is_closed_weaken_nil. induction v; simpl; auto. Qed. Proof. apply is_closed_weaken_nil. induction v; simpl; auto. Qed.
Lemma is_closed_to_val X e v : to_val e = Some v is_closed X e. Lemma is_closed_to_val X e v : to_val e = Some v is_closed X e.
Proof. intros Hev; rewrite -(of_to_val e v Hev); apply is_closed_of_val. Qed. Proof. intros <-%of_to_val. apply is_closed_of_val. Qed.
Lemma is_closed_subst X e x es : Lemma is_closed_subst X e x es :
is_closed [] es is_closed (x :: X) e is_closed X (subst x es e). is_closed [] es is_closed (x :: X) e is_closed X (subst x es e).
......
...@@ -83,16 +83,21 @@ Qed. ...@@ -83,16 +83,21 @@ Qed.
Local Ltac solve_exec_safe := intros; subst; do 3 eexists; econstructor; eauto. Local Ltac solve_exec_safe := intros; subst; do 3 eexists; econstructor; eauto.
Local Ltac solve_exec_puredet := simpl; intros; by inv_head_step. Local Ltac solve_exec_puredet := simpl; intros; by inv_head_step.
Local Ltac solve_pure_exec := Local Ltac solve_pure_exec :=
repeat lazymatch goal with unfold IntoVal, AsVal in *; subst;
| H: IntoVal ?e _ |- _ => rewrite -(of_to_val e _ into_val); clear H repeat match goal with H : is_Some _ |- _ => destruct H as [??] end;
| H: AsRec _ _ _ _ |- _ => rewrite H; clear H
end;
apply det_head_step_pure_exec; [ solve_exec_safe | solve_exec_puredet ]. apply det_head_step_pure_exec; [ solve_exec_safe | solve_exec_puredet ].
Global Instance pure_rec f x (erec e1 e2 : expr) (v2 : val) Class AsRec (e : expr) (f x : binder) (erec : expr) :=
`{!IntoVal e2 v2, AsRec e1 f x erec, Closed (f :b: x :b: []) erec} : as_rec : e = Rec f x erec.
Global Instance AsRec_rec f x e : AsRec (Rec f x e) f x e := eq_refl.
Global Instance AsRec_rec_locked_val v f x e :
AsRec (of_val v) f x e AsRec (of_val (locked v)) f x e.
Proof. by unlock. Qed.
Global Instance pure_rec f x (erec e1 e2 : expr)
`{!AsVal e2, AsRec e1 f x erec, Closed (f :b: x :b: []) erec} :
PureExec True (App e1 e2) (subst' x e2 (subst' f e1 erec)). PureExec True (App e1 e2) (subst' x e2 (subst' f e1 erec)).
Proof. solve_pure_exec. Qed. Proof. unfold AsRec in *; solve_pure_exec. Qed.
Global Instance pure_unop op e v v' `{!IntoVal e v} : Global Instance pure_unop op e v v' `{!IntoVal e v} :
PureExec (un_op_eval op v = Some v') (UnOp op e) (of_val v'). PureExec (un_op_eval op v = Some v') (UnOp op e) (of_val v').
...@@ -110,11 +115,11 @@ Global Instance pure_if_false e1 e2 : ...@@ -110,11 +115,11 @@ Global Instance pure_if_false e1 e2 :
PureExec True (If (Lit (LitBool false)) e1 e2) e2. PureExec True (If (Lit (LitBool false)) e1 e2) e2.
Proof. solve_pure_exec. Qed. Proof. solve_pure_exec. Qed.
Global Instance pure_fst e1 e2 v1 v2 `{!IntoVal e1 v1, !IntoVal e2 v2} : Global Instance pure_fst e1 e2 v1 `{!IntoVal e1 v1, !AsVal e2} :
PureExec True (Fst (Pair e1 e2)) e1. PureExec True (Fst (Pair e1 e2)) e1.
Proof. solve_pure_exec. Qed. Proof. solve_pure_exec. Qed.
Global Instance pure_snd e1 e2 v1 v2 `{!IntoVal e1 v1, !IntoVal e2 v2} : Global Instance pure_snd e1 e2 v2 `{!AsVal e1, !IntoVal e2 v2} :
PureExec True (Snd (Pair e1 e2)) e2. PureExec True (Snd (Pair e1 e2)) e2.
Proof. solve_pure_exec. Qed. Proof. solve_pure_exec. Qed.
...@@ -128,7 +133,7 @@ Proof. solve_pure_exec. Qed. ...@@ -128,7 +133,7 @@ Proof. solve_pure_exec. Qed.
(** Heap *) (** Heap *)
Lemma wp_alloc E e v : Lemma wp_alloc E e v :
to_val e = Some v IntoVal e v
{{{ True }}} Alloc e @ E {{{ l, RET LitV (LitLoc l); l v }}}. {{{ True }}} Alloc e @ E {{{ l, RET LitV (LitLoc l); l v }}}.
Proof. Proof.
iIntros (<-%of_to_val Φ) "_ HΦ". iApply wp_lift_atomic_head_step_no_fork; auto. iIntros (<-%of_to_val Φ) "_ HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
...@@ -149,7 +154,7 @@ Proof. ...@@ -149,7 +154,7 @@ Proof.
Qed. Qed.
Lemma wp_store E l v' e v : Lemma wp_store E l v' e v :
to_val e = Some v IntoVal e v
{{{ l v' }}} Store (Lit (LitLoc l)) e @ E {{{ RET LitV LitUnit; l v }}}. {{{ l v' }}} Store (Lit (LitLoc l)) e @ E {{{ RET LitV LitUnit; l v }}}.
Proof. Proof.
iIntros (<-%of_to_val Φ) ">Hl HΦ". iIntros (<-%of_to_val Φ) ">Hl HΦ".
...@@ -160,12 +165,12 @@ Proof. ...@@ -160,12 +165,12 @@ Proof.
iModIntro. iSplit=>//. by iApply "HΦ". iModIntro. iSplit=>//. by iApply "HΦ".
Qed. Qed.
Lemma wp_cas_fail E l q v' e1 v1 e2 v2 : Lemma wp_cas_fail E l q v' e1 v1 e2 :
to_val e1 = Some v1 to_val e2 = Some v2 v' v1 IntoVal e1 v1 AsVal e2 v' v1
{{{ l {q} v' }}} CAS (Lit (LitLoc l)) e1 e2 @ E {{{ l {q} v' }}} CAS (Lit (LitLoc l)) e1 e2 @ E
{{{ RET LitV (LitBool false); l {q} v' }}}. {{{ RET LitV (LitBool false); l {q} v' }}}.
Proof. Proof.
iIntros (<-%of_to_val <-%of_to_val ? Φ) ">Hl HΦ". iIntros (<-%of_to_val [v2 <-%of_to_val] ? Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto. iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (v2' σ2 efs Hstep); inv_head_step. iSplit; first by eauto. iNext; iIntros (v2' σ2 efs Hstep); inv_head_step.
...@@ -173,7 +178,7 @@ Proof. ...@@ -173,7 +178,7 @@ Proof.
Qed. Qed.
Lemma wp_cas_suc E l e1 v1 e2 v2 : Lemma wp_cas_suc E l e1 v1 e2 v2 :
to_val e1 = Some v1 to_val e2 = Some v2 IntoVal e1 v1 IntoVal e2 v2
{{{ l v1 }}} CAS (Lit (LitLoc l)) e1 e2 @ E {{{ l v1 }}} CAS (Lit (LitLoc l)) e1 e2 @ E
{{{ RET LitV (LitBool true); l v2 }}}. {{{ RET LitV (LitBool true); l v2 }}}.
Proof. Proof.
...@@ -184,23 +189,4 @@ Proof. ...@@ -184,23 +189,4 @@ Proof.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ". iModIntro. iSplit=>//. by iApply "HΦ".
Qed. Qed.
(** Proof rules for derived constructs *)
Lemma wp_seq E e1 e2 Φ :
is_Some (to_val e1) Closed [] e2
WP e2 @ E {{ Φ }} WP Seq e1 e2 @ E {{ Φ }}.
Proof. iIntros ([? ?] ?). rewrite -wp_pure_step_later; by eauto. Qed.
Lemma wp_skip E Φ : Φ (LitV LitUnit) WP Skip @ E {{ Φ }}.
Proof. rewrite -wp_seq; last eauto. by rewrite -wp_value. Qed.
Lemma wp_match_inl E e0 x1 e1 x2 e2 Φ :
is_Some (to_val e0) Closed (x1 :b: []) e1
WP subst' x1 e0 e1 @ E {{ Φ }} WP Match (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. iIntros ([? ?] ?) "?". rewrite -!wp_pure_step_later; by eauto. Qed.
Lemma wp_match_inr E e0 x1 e1 x2 e2 Φ :
is_Some (to_val e0) Closed (x2 :b: []) e2
WP subst' x2 e0 e2 @ E {{ Φ }} WP Match (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. iIntros ([? ?] ?) "?". rewrite -!wp_pure_step_later; by eauto. Qed.
End lifting. End lifting.
...@@ -9,20 +9,25 @@ Lemma tac_wp_pure `{heapG Σ} K Δ Δ' E e1 e2 φ Φ : ...@@ -9,20 +9,25 @@ Lemma tac_wp_pure `{heapG Σ} K Δ Δ' E e1 e2 φ Φ :
PureExec φ e1 e2 PureExec φ e1 e2
φ φ
IntoLaterNEnvs 1 Δ Δ' IntoLaterNEnvs 1 Δ Δ'
(Δ' WP fill K e2 @ E {{ Φ }}) envs_entails Δ' (WP fill K e2 @ E {{ Φ }})
(Δ WP fill K e1 @ E {{ Φ }}). envs_entails Δ (WP fill K e1 @ E {{ Φ }}).
Proof. Proof.
intros ??? HΔ'. rewrite into_laterN_env_sound /=. rewrite /envs_entails=> ??? HΔ'. rewrite into_laterN_env_sound /=.
rewrite -lifting.wp_bind HΔ' -wp_pure_step_later //. rewrite -lifting.wp_bind HΔ' -wp_pure_step_later //.
by rewrite -ectx_lifting.wp_ectx_bind_inv. by rewrite -ectx_lifting.wp_ectx_bind_inv.
Qed. Qed.
Ltac wp_value_head := etrans; [|eapply wp_value; apply _]; simpl. Lemma tac_wp_value `{heapG Σ} Δ E Φ e v :
IntoVal e v
envs_entails Δ (Φ v) envs_entails Δ (WP e @ E {{ Φ }}).
Proof. rewrite /envs_entails=> ? ->. by apply wp_value. Qed.