Commit 5c232f1e authored by Ralf Jung's avatar Ralf Jung

Merge branch 'v2.0' of gitlab.mpi-sws.org:FP/iris-coq into v2.0

parents 83979416 a39468f8
...@@ -7,10 +7,11 @@ This version is known to compile with: ...@@ -7,10 +7,11 @@ This version is known to compile with:
- Ssreflect 1.6 - Ssreflect 1.6
- Autosubst 1.4 - Autosubst 1.4
For development, better make sure you have a version of Ssreflect that includes commit be724937 For development, better make sure you have a version of Ssreflect that includes
(no such version has been released so far, you'll have to fetch the development branch yourself). commit be724937 (no such version has been released so far, you will have to
Iris compiles fine even without this patch, but proof bullets will only be in 'strict' (enforcing) fetch the development branch yourself). Iris compiles fine even without this
mode with the fixed version of Ssreflect. patch, but proof bullets will only be in 'strict' (enforcing) mode with the
fixed version of Ssreflect.
BUILDING INSTRUCTIONS BUILDING INSTRUCTIONS
--------------------- ---------------------
......
...@@ -36,6 +36,8 @@ prelude/list.v ...@@ -36,6 +36,8 @@ prelude/list.v
prelude/error.v prelude/error.v
modures/option.v modures/option.v
modures/cmra.v modures/cmra.v
modures/cmra_big_op.v
modures/cmra_tactics.v
modures/sts.v modures/sts.v
modures/auth.v modures/auth.v
modures/fin_maps.v modures/fin_maps.v
...@@ -45,7 +47,6 @@ modures/base.v ...@@ -45,7 +47,6 @@ modures/base.v
modures/dra.v modures/dra.v
modures/cofe_solver.v modures/cofe_solver.v
modures/agree.v modures/agree.v
modures/ra.v
modures/excl.v modures/excl.v
iris/model.v iris/model.v
iris/adequacy.v iris/adequacy.v
...@@ -56,14 +57,13 @@ iris/viewshifts.v ...@@ -56,14 +57,13 @@ iris/viewshifts.v
iris/wsat.v iris/wsat.v
iris/ownership.v iris/ownership.v
iris/weakestpre.v iris/weakestpre.v
iris/language.v
iris/pviewshifts.v iris/pviewshifts.v
iris/resources.v iris/resources.v
iris/hoare.v iris/hoare.v
iris/parameter.v iris/language.v
iris/functor.v
iris/tests.v iris/tests.v
barrier/heap_lang.v barrier/heap_lang.v
barrier/parameter.v
barrier/lifting.v barrier/lifting.v
barrier/sugar.v barrier/sugar.v
barrier/tests.v barrier/tests.v
...@@ -390,8 +390,10 @@ Section Language. ...@@ -390,8 +390,10 @@ Section Language.
Definition ectx_step e1 σ1 e2 σ2 (ef: option expr) := Definition ectx_step e1 σ1 e2 σ2 (ef: option expr) :=
K e1' e2', e1 = fill K e1' e2 = fill K e2' K e1' e2', e1 = fill K e1' e2 = fill K e2'
prim_step e1' σ1 e2' σ2 ef. prim_step e1' σ1 e2' σ2 ef.
Program Canonical Structure heap_lang : language := {|
Global Program Instance heap_lang : Language expr value state := {| language.expr := expr;
language.val := value;
language.state := state;
of_val := v2e; of_val := v2e;
to_val := e2v; to_val := e2v;
language.atomic := atomic; language.atomic := atomic;
......
Require Import prelude.gmap iris.lifting. Require Import prelude.gmap iris.lifting.
Require Export iris.weakestpre barrier.parameter. Require Export iris.weakestpre barrier.heap_lang.
Import uPred. Import uPred.
(* TODO RJ: Figure out a way to to always use our Σ. *) Section lifting.
Context {Σ : iFunctor}.
Implicit Types P : iProp heap_lang Σ.
Implicit Types Q : val heap_lang iProp heap_lang Σ.
(** Bind. *) (** Bind. *)
Lemma wp_bind {E e} K Q : Lemma wp_bind {E e} K Q :
wp (Σ:=Σ) E e (λ v, wp (Σ:=Σ) E (fill K (v2e v)) Q) wp (Σ:=Σ) E (fill K e) Q. wp E e (λ v, wp E (fill K (v2e v)) Q) wp E (fill K e) Q.
Proof. Proof. apply (wp_bind (K:=fill K)), fill_is_ctx. Qed.
by apply (wp_bind (Σ:=Σ) (K := fill K)), fill_is_ctx.
Qed.
(** Base axioms for core primitives of the language: Stateful reductions. *) (** Base axioms for core primitives of the language: Stateful reductions. *)
...@@ -17,9 +18,9 @@ Lemma wp_lift_step E1 E2 (φ : expr → state → Prop) Q e1 σ1 : ...@@ -17,9 +18,9 @@ Lemma wp_lift_step E1 E2 (φ : expr → state → Prop) Q e1 σ1 :
E1 E2 to_val e1 = None E1 E2 to_val e1 = None
reducible e1 σ1 reducible e1 σ1
( e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef ef = None φ e2 σ2) ( e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef ef = None φ e2 σ2)
pvs E2 E1 (ownP (Σ:=Σ) σ1 e2 σ2, ( φ e2 σ2 ownP (Σ:=Σ) σ2) - pvs E2 E1 (ownP σ1 e2 σ2, ( φ e2 σ2 ownP σ2) -
pvs E1 E2 (wp (Σ:=Σ) E2 e2 Q)) pvs E1 E2 (wp E2 e2 Q))
wp (Σ:=Σ) E2 e1 Q. wp E2 e1 Q.
Proof. Proof.
intros ? He Hsafe Hstep. intros ? He Hsafe Hstep.
(* RJ: working around https://coq.inria.fr/bugs/show_bug.cgi?id=4536 *) (* RJ: working around https://coq.inria.fr/bugs/show_bug.cgi?id=4536 *)
...@@ -45,8 +46,8 @@ Qed. ...@@ -45,8 +46,8 @@ Qed.
postcondition a predicate over a *location* *) postcondition a predicate over a *location* *)
Lemma wp_alloc_pst E σ e v Q : Lemma wp_alloc_pst E σ e v Q :
e2v e = Some v e2v e = Some v
(ownP (Σ:=Σ) σ ( l, (σ !! l = None) ownP (Σ:=Σ) (<[l:=v]>σ) - Q (LocV l))) (ownP σ ( l, (σ !! l = None) ownP (<[l:=v]>σ) - Q (LocV l)))
wp (Σ:=Σ) E (Alloc e) Q. wp E (Alloc e) Q.
Proof. Proof.
(* RJ FIXME (also for most other lemmas in this file): rewrite would be nicer... *) (* RJ FIXME (also for most other lemmas in this file): rewrite would be nicer... *)
intros Hvl. etransitivity; last eapply wp_lift_step with (σ1 := σ) intros Hvl. etransitivity; last eapply wp_lift_step with (σ1 := σ)
...@@ -72,7 +73,7 @@ Qed. ...@@ -72,7 +73,7 @@ Qed.
Lemma wp_load_pst E σ l v Q : Lemma wp_load_pst E σ l v Q :
σ !! l = Some v σ !! l = Some v
(ownP (Σ:=Σ) σ (ownP σ - Q v)) wp (Σ:=Σ) E (Load (Loc l)) Q. (ownP σ (ownP σ - Q v)) wp E (Load (Loc l)) Q.
Proof. Proof.
intros Hl. etransitivity; last eapply wp_lift_step with (σ1 := σ) intros Hl. etransitivity; last eapply wp_lift_step with (σ1 := σ)
(φ := λ e' σ', e' = v2e v σ' = σ); last first. (φ := λ e' σ', e' = v2e v σ' = σ); last first.
...@@ -93,7 +94,7 @@ Qed. ...@@ -93,7 +94,7 @@ Qed.
Lemma wp_store_pst E σ l e v v' Q : Lemma wp_store_pst E σ l e v v' Q :
e2v e = Some v e2v e = Some v
σ !! l = Some v' σ !! l = Some v'
(ownP (Σ:=Σ) σ (ownP (<[l:=v]>σ) - Q LitUnitV)) wp (Σ:=Σ) E (Store (Loc l) e) Q. (ownP σ (ownP (<[l:=v]>σ) - Q LitUnitV)) wp E (Store (Loc l) e) Q.
Proof. Proof.
intros Hvl Hl. etransitivity; last eapply wp_lift_step with (σ1 := σ) intros Hvl Hl. etransitivity; last eapply wp_lift_step with (σ1 := σ)
(φ := λ e' σ', e' = LitUnit σ' = <[l:=v]>σ); last first. (φ := λ e' σ', e' = LitUnit σ' = <[l:=v]>σ); last first.
...@@ -114,17 +115,12 @@ Qed. ...@@ -114,17 +115,12 @@ Qed.
Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Q : Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Q :
e2v e1 = Some v1 e2v e2 = Some v2 e2v e1 = Some v1 e2v e2 = Some v2
σ !! l = Some v' v' <> v1 σ !! l = Some v' v' <> v1
(ownP (Σ:=Σ) σ (ownP σ - Q LitFalseV)) wp (Σ:=Σ) E (Cas (Loc l) e1 e2) Q. (ownP σ (ownP σ - Q LitFalseV)) wp E (Cas (Loc l) e1 e2) Q.
Proof. Proof.
intros Hvl Hl. etransitivity; last eapply wp_lift_step with (σ1 := σ) intros Hvl Hl. etransitivity; last eapply wp_lift_step with (σ1 := σ)
(φ := λ e' σ', e' = LitFalse σ' = σ); last first. (φ := λ e' σ', e' = LitFalse σ' = σ) (E1:=E); auto; last first.
- intros e2' σ2' ef Hstep. inversion_clear Hstep; first done. - by inversion_clear 1; simplify_map_equality.
(* FIXME this rewriting is rather ugly. *) - do 3 eexists; econstructor; eauto.
exfalso. rewrite Hvl in Hv1. case:Hv1=>?; subst v1. rewrite Hlookup in H.
case:H=>?; subst v'. done.
- do 3 eexists. eapply CasFailS; eassumption.
- reflexivity.
- reflexivity.
- rewrite -pvs_intro. - rewrite -pvs_intro.
apply sep_mono; first done. apply later_mono. apply sep_mono; first done. apply later_mono.
apply forall_intro=>e2'. apply forall_intro=>σ2'. apply forall_intro=>e2'. apply forall_intro=>σ2'.
...@@ -137,7 +133,7 @@ Qed. ...@@ -137,7 +133,7 @@ Qed.
Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Q : Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Q :
e2v e1 = Some v1 e2v e2 = Some v2 e2v e1 = Some v1 e2v e2 = Some v2
σ !! l = Some v1 σ !! l = Some v1
(ownP (Σ:=Σ) σ (ownP (<[l:=v2]>σ) - Q LitTrueV)) wp (Σ:=Σ) E (Cas (Loc l) e1 e2) Q. (ownP σ (ownP (<[l:=v2]>σ) - Q LitTrueV)) wp E (Cas (Loc l) e1 e2) Q.
Proof. Proof.
intros Hvl Hl. etransitivity; last eapply wp_lift_step with (σ1 := σ) intros Hvl Hl. etransitivity; last eapply wp_lift_step with (σ1 := σ)
(φ := λ e' σ', e' = LitTrue σ' = <[l:=v2]>σ); last first. (φ := λ e' σ', e' = LitTrue σ' = <[l:=v2]>σ); last first.
...@@ -162,7 +158,8 @@ Qed. ...@@ -162,7 +158,8 @@ Qed.
(** Base axioms for core primitives of the language: Stateless reductions *) (** Base axioms for core primitives of the language: Stateless reductions *)
Lemma wp_fork E e : Lemma wp_fork E e :
wp (Σ:=Σ) coPset_all e (λ _, True) wp (Σ:=Σ) E (Fork e) (λ v, (v = LitUnitV)). wp coPset_all e (λ _, True : iProp heap_lang Σ)
wp E (Fork e) (λ v, (v = LitUnitV)).
Proof. Proof.
etransitivity; last eapply wp_lift_pure_step with etransitivity; last eapply wp_lift_pure_step with
(φ := λ e' ef, e' = LitUnit ef = Some e); (φ := λ e' ef, e' = LitUnit ef = Some e);
...@@ -175,21 +172,16 @@ Proof. ...@@ -175,21 +172,16 @@ Proof.
eapply ForkS. eapply ForkS.
- reflexivity. - reflexivity.
- apply later_mono. - apply later_mono.
apply forall_intro=>e2. apply forall_intro=>ef. apply forall_intro=>e2; apply forall_intro=>ef.
apply impl_intro_l. apply const_elim_l. intros [-> ->]. apply impl_intro_l, const_elim_l=>-[-> ->] /=; apply sep_intro_True_l; auto.
(* FIXME RJ This is ridicolous. *) by rewrite -wp_value' //; apply const_intro.
transitivity (True wp coPset_all e (λ _ : ival Σ, True))%I;
first by rewrite left_id.
apply sep_mono; last reflexivity.
rewrite -wp_value'; last reflexivity.
by apply const_intro.
Qed. Qed.
Lemma wp_lift_pure_step E (φ : expr Prop) Q e1 : Lemma wp_lift_pure_step E (φ : expr Prop) Q e1 :
to_val e1 = None to_val e1 = None
( σ1, reducible e1 σ1) ( σ1, reducible e1 σ1)
( σ1 e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef σ1 = σ2 ef = None φ e2) ( σ1 e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef σ1 = σ2 ef = None φ e2)
( e2, φ e2 wp (Σ:=Σ) E e2 Q) wp (Σ:=Σ) E e1 Q. ( e2, φ e2 wp E e2 Q) wp E e1 Q.
Proof. Proof.
intros He Hsafe Hstep. intros He Hsafe Hstep.
(* RJ: working around https://coq.inria.fr/bugs/show_bug.cgi?id=4536 *) (* RJ: working around https://coq.inria.fr/bugs/show_bug.cgi?id=4536 *)
...@@ -209,7 +201,7 @@ Qed. ...@@ -209,7 +201,7 @@ Qed.
Lemma wp_rec E ef e v Q : Lemma wp_rec E ef e v Q :
e2v e = Some v e2v e = Some v
wp (Σ:=Σ) E ef.[Rec ef, e /] Q wp (Σ:=Σ) E (App (Rec ef) e) Q. wp E ef.[Rec ef, e /] Q wp E (App (Rec ef) e) Q.
Proof. Proof.
etransitivity; last eapply wp_lift_pure_step with etransitivity; last eapply wp_lift_pure_step with
(φ := λ e', e' = ef.[Rec ef, e /]); last first. (φ := λ e', e' = ef.[Rec ef, e /]); last first.
...@@ -221,7 +213,7 @@ Proof. ...@@ -221,7 +213,7 @@ Proof.
Qed. Qed.
Lemma wp_plus n1 n2 E Q : Lemma wp_plus n1 n2 E Q :
Q (LitNatV (n1 + n2)) wp (Σ:=Σ) E (Plus (LitNat n1) (LitNat n2)) Q. Q (LitNatV (n1 + n2)) wp E (Plus (LitNat n1) (LitNat n2)) Q.
Proof. Proof.
etransitivity; last eapply wp_lift_pure_step with etransitivity; last eapply wp_lift_pure_step with
(φ := λ e', e' = LitNat (n1 + n2)); last first. (φ := λ e', e' = LitNat (n1 + n2)); last first.
...@@ -235,7 +227,7 @@ Qed. ...@@ -235,7 +227,7 @@ Qed.
Lemma wp_le_true n1 n2 E Q : Lemma wp_le_true n1 n2 E Q :
n1 n2 n1 n2
Q LitTrueV wp (Σ:=Σ) E (Le (LitNat n1) (LitNat n2)) Q. Q LitTrueV wp E (Le (LitNat n1) (LitNat n2)) Q.
Proof. Proof.
intros Hle. etransitivity; last eapply wp_lift_pure_step with intros Hle. etransitivity; last eapply wp_lift_pure_step with
(φ := λ e', e' = LitTrue); last first. (φ := λ e', e' = LitTrue); last first.
...@@ -250,7 +242,7 @@ Qed. ...@@ -250,7 +242,7 @@ Qed.
Lemma wp_le_false n1 n2 E Q : Lemma wp_le_false n1 n2 E Q :
n1 > n2 n1 > n2
Q LitFalseV wp (Σ:=Σ) E (Le (LitNat n1) (LitNat n2)) Q. Q LitFalseV wp E (Le (LitNat n1) (LitNat n2)) Q.
Proof. Proof.
intros Hle. etransitivity; last eapply wp_lift_pure_step with intros Hle. etransitivity; last eapply wp_lift_pure_step with
(φ := λ e', e' = LitFalse); last first. (φ := λ e', e' = LitFalse); last first.
...@@ -265,7 +257,7 @@ Qed. ...@@ -265,7 +257,7 @@ Qed.
Lemma wp_fst e1 v1 e2 v2 E Q : Lemma wp_fst e1 v1 e2 v2 E Q :
e2v e1 = Some v1 e2v e2 = Some v2 e2v e1 = Some v1 e2v e2 = Some v2
Q v1 wp (Σ:=Σ) E (Fst (Pair e1 e2)) Q. Q v1 wp E (Fst (Pair e1 e2)) Q.
Proof. Proof.
intros Hv1 Hv2. etransitivity; last eapply wp_lift_pure_step with intros Hv1 Hv2. etransitivity; last eapply wp_lift_pure_step with
(φ := λ e', e' = e1); last first. (φ := λ e', e' = e1); last first.
...@@ -279,7 +271,7 @@ Qed. ...@@ -279,7 +271,7 @@ Qed.
Lemma wp_snd e1 v1 e2 v2 E Q : Lemma wp_snd e1 v1 e2 v2 E Q :
e2v e1 = Some v1 e2v e2 = Some v2 e2v e1 = Some v1 e2v e2 = Some v2
Q v2 wp (Σ:=Σ) E (Snd (Pair e1 e2)) Q. Q v2 wp E (Snd (Pair e1 e2)) Q.
Proof. Proof.
intros Hv1 Hv2. etransitivity; last eapply wp_lift_pure_step with intros Hv1 Hv2. etransitivity; last eapply wp_lift_pure_step with
(φ := λ e', e' = e2); last first. (φ := λ e', e' = e2); last first.
...@@ -293,7 +285,7 @@ Qed. ...@@ -293,7 +285,7 @@ Qed.
Lemma wp_case_inl e0 v0 e1 e2 E Q : Lemma wp_case_inl e0 v0 e1 e2 E Q :
e2v e0 = Some v0 e2v e0 = Some v0
wp (Σ:=Σ) E e1.[e0/] Q wp (Σ:=Σ) E (Case (InjL e0) e1 e2) Q. wp E e1.[e0/] Q wp E (Case (InjL e0) e1 e2) Q.
Proof. Proof.
intros Hv0. etransitivity; last eapply wp_lift_pure_step with intros Hv0. etransitivity; last eapply wp_lift_pure_step with
(φ := λ e', e' = e1.[e0/]); last first. (φ := λ e', e' = e1.[e0/]); last first.
...@@ -306,7 +298,7 @@ Qed. ...@@ -306,7 +298,7 @@ Qed.
Lemma wp_case_inr e0 v0 e1 e2 E Q : Lemma wp_case_inr e0 v0 e1 e2 E Q :
e2v e0 = Some v0 e2v e0 = Some v0
wp (Σ:=Σ) E e2.[e0/] Q wp (Σ:=Σ) E (Case (InjR e0) e1 e2) Q. wp E e2.[e0/] Q wp E (Case (InjR e0) e1 e2) Q.
Proof. Proof.
intros Hv0. etransitivity; last eapply wp_lift_pure_step with intros Hv0. etransitivity; last eapply wp_lift_pure_step with
(φ := λ e', e' = e2.[e0/]); last first. (φ := λ e', e' = e2.[e0/]); last first.
...@@ -322,7 +314,7 @@ Qed. ...@@ -322,7 +314,7 @@ Qed.
Lemma wp_le n1 n2 E P Q : Lemma wp_le n1 n2 E P Q :
(n1 n2 P Q LitTrueV) (n1 n2 P Q LitTrueV)
(n1 > n2 P Q LitFalseV) (n1 > n2 P Q LitFalseV)
P wp (Σ:=Σ) E (Le (LitNat n1) (LitNat n2)) Q. P wp E (Le (LitNat n1) (LitNat n2)) Q.
Proof. Proof.
intros HPle HPgt. intros HPle HPgt.
assert (Decision (n1 n2)) as Hn12 by apply _. assert (Decision (n1 n2)) as Hn12 by apply _.
...@@ -330,3 +322,4 @@ Proof. ...@@ -330,3 +322,4 @@ Proof.
- rewrite -wp_le_true; auto. - rewrite -wp_le_true; auto.
- assert (n1 > n2) by omega. rewrite -wp_le_false; auto. - assert (n1 > n2) by omega. rewrite -wp_le_false; auto.
Qed. Qed.
End lifting.
Require Export barrier.heap_lang.
Require Import iris.parameter.
Definition Σ := IParamConst heap_lang unitRA.
...@@ -16,10 +16,14 @@ Definition LamV (e : {bind expr}) := RecV e.[ren(+1)]. ...@@ -16,10 +16,14 @@ Definition LamV (e : {bind expr}) := RecV e.[ren(+1)].
Definition LetCtx (K1 : ectx) (e2 : {bind expr}) := AppRCtx (LamV e2) K1. Definition LetCtx (K1 : ectx) (e2 : {bind expr}) := AppRCtx (LamV e2) K1.
Definition SeqCtx (K1 : ectx) (e2 : expr) := LetCtx K1 (e2.[ren(+1)]). Definition SeqCtx (K1 : ectx) (e2 : expr) := LetCtx K1 (e2.[ren(+1)]).
Section suger.
Context {Σ : iFunctor}.
Implicit Types P : iProp heap_lang Σ.
Implicit Types Q : val heap_lang iProp heap_lang Σ.
(** Proof rules for the sugar *) (** Proof rules for the sugar *)
Lemma wp_lam E ef e v Q : Lemma wp_lam E ef e v Q :
e2v e = Some v e2v e = Some v wp E ef.[e/] Q wp E (App (Lam ef) e) Q.
wp (Σ:=Σ) E ef.[e/] Q wp (Σ:=Σ) E (App (Lam ef) e) Q.
Proof. Proof.
intros Hv. rewrite -wp_rec; last eassumption. intros Hv. rewrite -wp_rec; last eassumption.
(* RJ: This pulls in functional extensionality. If that bothers us, we have (* RJ: This pulls in functional extensionality. If that bothers us, we have
...@@ -28,20 +32,20 @@ Proof. ...@@ -28,20 +32,20 @@ Proof.
Qed. Qed.
Lemma wp_let e1 e2 E Q : Lemma wp_let e1 e2 E Q :
wp (Σ:=Σ) E e1 (λ v, wp (Σ:=Σ) E (e2.[v2e v/]) Q) wp (Σ:=Σ) E (Let e1 e2) Q. wp E e1 (λ v, wp E (e2.[v2e v/]) Q) wp E (Let e1 e2) Q.
Proof. Proof.
rewrite -(wp_bind (LetCtx EmptyCtx e2)). apply wp_mono=>v. rewrite -(wp_bind (LetCtx EmptyCtx e2)). apply wp_mono=>v.
rewrite -wp_lam //. by rewrite v2v. rewrite -wp_lam //. by rewrite v2v.
Qed. Qed.
Lemma wp_if_true e1 e2 E Q : Lemma wp_if_true e1 e2 E Q :
wp (Σ:=Σ) E e1 Q wp (Σ:=Σ) E (If LitTrue e1 e2) Q. wp E e1 Q wp E (If LitTrue e1 e2) Q.
Proof. Proof.
rewrite -wp_case_inl //. by asimpl. rewrite -wp_case_inl //. by asimpl.
Qed. Qed.
Lemma wp_if_false e1 e2 E Q : Lemma wp_if_false e1 e2 E Q :
wp (Σ:=Σ) E e2 Q wp (Σ:=Σ) E (If LitFalse e1 e2) Q. wp E e2 Q wp E (If LitFalse e1 e2) Q.
Proof. Proof.
rewrite -wp_case_inr //. by asimpl. rewrite -wp_case_inr //. by asimpl.
Qed. Qed.
...@@ -49,7 +53,7 @@ Qed. ...@@ -49,7 +53,7 @@ Qed.
Lemma wp_lt n1 n2 E P Q : Lemma wp_lt n1 n2 E P Q :
(n1 < n2 P Q LitTrueV) (n1 < n2 P Q LitTrueV)
(n1 n2 P Q LitFalseV) (n1 n2 P Q LitFalseV)
P wp (Σ:=Σ) E (Lt (LitNat n1) (LitNat n2)) Q. P wp E (Lt (LitNat n1) (LitNat n2)) Q.
Proof. Proof.
intros HPlt HPge. intros HPlt HPge.
rewrite -(wp_bind (LeLCtx EmptyCtx _)) -wp_plus -later_intro. simpl. rewrite -(wp_bind (LeLCtx EmptyCtx _)) -wp_plus -later_intro. simpl.
...@@ -59,7 +63,7 @@ Qed. ...@@ -59,7 +63,7 @@ Qed.
Lemma wp_eq n1 n2 E P Q : Lemma wp_eq n1 n2 E P Q :
(n1 = n2 P Q LitTrueV) (n1 = n2 P Q LitTrueV)
(n1 n2 P Q LitFalseV) (n1 n2 P Q LitFalseV)
P wp (Σ:=Σ) E (Eq (LitNat n1) (LitNat n2)) Q. P wp E (Eq (LitNat n1) (LitNat n2)) Q.
Proof. Proof.
intros HPeq HPne. intros HPeq HPne.
rewrite -wp_let -wp_value' // -later_intro. asimpl. rewrite -wp_let -wp_value' // -later_intro. asimpl.
...@@ -72,3 +76,4 @@ Proof. ...@@ -72,3 +76,4 @@ Proof.
- asimpl. rewrite -wp_case_inr // -later_intro -wp_value' //. - asimpl. rewrite -wp_case_inr // -later_intro -wp_value' //.
apply HPne; omega. apply HPne; omega.
Qed. Qed.
End suger.
...@@ -25,16 +25,16 @@ Module LangTests. ...@@ -25,16 +25,16 @@ Module LangTests.
Qed. Qed.
End LangTests. End LangTests.
Module ParamTests.
Print Assumptions Σ.
End ParamTests.
Module LiftingTests. Module LiftingTests.
Context {Σ : iFunctor}.
Implicit Types P : iProp heap_lang Σ.
Implicit Types Q : val heap_lang iProp heap_lang Σ.
(* TODO RJ: Some syntactic sugar for language expressions would be nice. *) (* TODO RJ: Some syntactic sugar for language expressions would be nice. *)
Definition e3 := Load (Var 0). Definition e3 := Load (Var 0).
Definition e2 := Seq (Store (Var 0) (Plus (Load $ Var 0) (LitNat 1))) e3. Definition e2 := Seq (Store (Var 0) (Plus (Load $ Var 0) (LitNat 1))) e3.
Definition e := Let (Alloc (LitNat 1)) e2. Definition e := Let (Alloc (LitNat 1)) e2.
Goal σ E, (ownP (Σ:=Σ) σ) (wp (Σ:=Σ) E e (λ v, (v = LitNatV 2))). Goal σ E, (ownP σ : iProp heap_lang Σ) (wp E e (λ v, (v = LitNatV 2))).
Proof. Proof.
move=> σ E. rewrite /e. move=> σ E. rewrite /e.
rewrite -wp_let. rewrite -wp_alloc_pst; last done. rewrite -wp_let. rewrite -wp_alloc_pst; last done.
...@@ -74,7 +74,7 @@ Module LiftingTests. ...@@ -74,7 +74,7 @@ Module LiftingTests.
Lemma FindPred_spec n1 n2 E Q : Lemma FindPred_spec n1 n2 E Q :
((n1 < n2) Q (LitNatV $ pred n2)) ((n1 < n2) Q (LitNatV $ pred n2))
wp (Σ:=Σ) E (App (FindPred (LitNat n2)) (LitNat n1)) Q. wp E (App (FindPred (LitNat n2)) (LitNat n1)) Q.
Proof. Proof.
revert n1. apply löb_all_1=>n1. revert n1. apply löb_all_1=>n1.
rewrite -wp_rec //. asimpl. rewrite -wp_rec //. asimpl.
...@@ -104,7 +104,7 @@ Module LiftingTests. ...@@ -104,7 +104,7 @@ Module LiftingTests.
Qed. Qed.
Lemma Pred_spec n E Q : Lemma Pred_spec n E Q :
Q (LitNatV $ pred n) wp (Σ:=Σ) E (App Pred (LitNat n)) Q. Q (LitNatV $ pred n) wp E (App Pred (LitNat n)) Q.
Proof. Proof.
rewrite -wp_lam //. asimpl. rewrite -wp_lam //. asimpl.
rewrite -(wp_bind (CaseCtx EmptyCtx _ _)). rewrite -(wp_bind (CaseCtx EmptyCtx _ _)).
...@@ -118,7 +118,9 @@ Module LiftingTests. ...@@ -118,7 +118,9 @@ Module LiftingTests.
+ done. + done.
Qed. Qed.
Goal E, True wp (Σ:=Σ) E (Let (App Pred (LitNat 42)) (App Pred (Var 0))) (λ v, (v = LitNatV 40)). Goal E,
(True : iProp heap_lang Σ)
wp E (Let (App Pred (LitNat 42)) (App Pred (Var 0))) (λ v, (v = LitNatV 40)).
Proof. Proof.
intros E. rewrite -wp_let. rewrite -Pred_spec -!later_intro. intros E. rewrite -wp_let. rewrite -Pred_spec -!later_intro.
asimpl. (* TODO RJ: Can we somehow make it so that Pred gets folded again? *) asimpl. (* TODO RJ: Can we somehow make it so that Pred gets folded again? *)
......
...@@ -7,9 +7,10 @@ Local Hint Extern 10 (✓{_} _) => ...@@ -7,9 +7,10 @@ Local Hint Extern 10 (✓{_} _) =>
solve_validN. solve_validN.
Section adequacy. Section adequacy.
Context {Σ : iParam}. Context {Λ : language} {Σ : iFunctor}.
Implicit Types e : iexpr Σ. Implicit Types e : expr Λ.
Implicit Types Q : ival Σ iProp Σ. Implicit Types Q : val Λ iProp Λ Σ.
Implicit Types m : iGst Λ Σ.
Transparent uPred_holds. Transparent uPred_holds.
Notation wptp n := (Forall3 (λ e Q r, uPred_holds (wp coPset_all e Q) n r)). Notation wptp n := (Forall3 (λ e Q r, uPred_holds (wp coPset_all e Q) n r)).
...@@ -46,7 +47,7 @@ Proof. ...@@ -46,7 +47,7 @@ Proof.
* apply (IH (Qs1 ++ Q :: Qs2) (rs1 ++ r2 r2' :: rs2)). * apply (IH (Qs1 ++ Q :: Qs2) (rs1 ++ r2 r2' :: rs2)).
{ rewrite /option_list right_id_L. { rewrite /option_list right_id_L.
apply Forall3_app, Forall3_cons; eauto using wptp_le. apply Forall3_app, Forall3_cons; eauto using wptp_le.
apply uPred_weaken with r2 (k + n); eauto using @ra_included_l. } apply uPred_weaken with r2 (k + n); eauto using cmra_included_l. }
by rewrite -Permutation_middle /= big_op_app. by rewrite -Permutation_middle /= big_op_app.
Qed. Qed.
Lemma ht_adequacy_steps P Q k n e1 t2 σ1 σ2 r1 : Lemma ht_adequacy_steps P Q k n e1 t2 σ1 σ2 r1 :
...@@ -60,7 +61,7 @@ Proof. ...@@ -60,7 +61,7 @@ Proof.
intros Hht ????; apply (nsteps_wptp [pvs coPset_all coPset_all Q] k n intros Hht ????; apply (nsteps_wptp [pvs coPset_all coPset_all Q] k n
([e1],σ1) (t2,σ2) [r1]); rewrite /big_op ?right_id; auto. ([e1],σ1) (t2,σ2) [r1]); rewrite /big_op ?right_id; auto.
constructor; last constructor. constructor; last constructor.
apply Hht with r1 (k + n); eauto using @ra_included_unit. apply Hht with r1 (k + n); eauto using cmra_included_unit.
by destruct (k + n). by destruct (k + n).
Qed. Qed.
Lemma ht_adequacy_own Q e1 t2 σ1 m σ2 : Lemma ht_adequacy_own Q e1 t2 σ1 m σ2 :
...@@ -70,15 +71,16 @@ Lemma ht_adequacy_own Q e1 t2 σ1 m σ2 : ...@@ -70,15 +71,16 @@ Lemma ht_adequacy_own Q e1 t2 σ1 m σ2 :
rs2 Qs', wptp 3 t2 ((λ v, pvs coPset_all coPset_all (Q v)) :: Qs') rs2 rs2 Qs', wptp 3 t2 ((λ v, pvs coPset_all coPset_all (Q v)) :: Qs') rs2
wsat 3 coPset_all σ2 (big_op rs2). wsat 3 coPset_all σ2 (big_op rs2).
Proof. Proof.
intros Hv ? [k ?]%rtc_nsteps. eapply ht_adequacy_steps with (r1 := (Res (Excl σ1) m)); eauto; [|]. intros Hv ? [k ?]%rtc_nsteps.
- by rewrite Nat.add_comm; apply wsat_init, cmra_valid_validN. eapply ht_adequacy_steps with (r1 := (Res (Excl σ1) m)); eauto; [|].
- exists (Res (Excl σ1) ), (Res m). split_ands.