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

Clean up heap_lang and remove some FIXMEs.

Notable changes:
* I am now using the same names for the fields of the language record and the
  instances in heap_lang. In order to deal with shadowing, I have put all
  definitions in heap_lang.v in a module.
* Instead of defining evaluation contexts recursively, these are now defined
  using lists. This way we can easily reuse operations on lists. For example,
  composition of evaluation contexts is just appending lists. Also, it allowed
  me to simplify the rather complicated proof of step_by_val as induction on
  the shape of contexts no longer results in a blow-up of the number of cases.
* Use better automation to prove all lemmas of heap_lang.
* I have introduced tactics to invert steps and to do steps. These tactics
  greatly helped simplifying boring parts of lifting lemmas.
parent f3ff3b28
...@@ -64,6 +64,7 @@ iris/language.v ...@@ -64,6 +64,7 @@ iris/language.v
iris/functor.v iris/functor.v
iris/tests.v iris/tests.v
barrier/heap_lang.v barrier/heap_lang.v
barrier/heap_lang_tactics.v
barrier/lifting.v barrier/lifting.v
barrier/sugar.v barrier/sugar.v
barrier/tests.v barrier/tests.v
This diff is collapsed.
Require Export barrier.heap_lang.
Require Import prelude.fin_maps.
Import heap_lang.
Ltac inv_step :=
repeat match goal with
| _ => progress simplify_map_equality' (* simplify memory stuff *)
| H : to_val _ = Some _ |- _ => apply of_to_val in H
| H : context [to_val (of_val _)] |- _ => rewrite to_of_val in H
| H : prim_step _ _ _ _ _ |- _ => destruct H; subst
| H : _ = fill ?K ?e |- _ =>
destruct K as [|[]];
simpl in H; first [subst e|discriminate H|injection' H]
(* ensure that we make progress for each subgoal *)
| H : head_step ?e _ _ _ _, Hv : of_val ?v = fill ?K ?e |- _ =>
apply values_head_stuck, (fill_not_val K) in H;
by rewrite -Hv to_of_val in H (* maybe use a helper lemma here? *)
| H : head_step ?e _ _ _ _ |- _ =>
try (is_var e; fail 1); (* inversion yields many goals if e is a variable
and can thus better be avoided. *)
inversion H; subst; clear H
end.
Ltac reshape_expr e tac :=
let rec go K e :=
match e with
| _ => tac (reverse K) e
| App ?e1 ?e2 =>
lazymatch e1 with
| of_val ?v1 => go (AppRCtx v1 :: K) e2 | _ => go (AppLCtx e2 :: K) e1
end
| Plus ?e1 ?e2 =>
lazymatch e1 with
| of_val ?v1 => go (PlusRCtx v1 :: K) e2 | _ => go (PlusLCtx e2 :: K) e1
end
| Le ?e1 ?e2 =>
lazymatch e1 with
| of_val ?v1 => go (LeRCtx v1 :: K) e2 | _ => go (LeLCtx e2 :: K) e1
end
| Pair ?e1 ?e2 =>
lazymatch e1 with
| of_val ?v1 => go (PairRCtx v1 :: K) e2 | _ => go (PairLCtx e2 :: K) e1
end
| Fst ?e => go (FstCtx :: K) e
| Snd ?e => go (SndCtx :: K) e
| InjL ?e => go (InjLCtx :: K) e
| InjR ?e => go (InjRCtx :: K) e
| Case ?e0 ?e1 ?e2 => go (CaseCtx e1 e2 :: K) e0
| Alloc ?e => go (AllocCtx :: K) e
| Load ?e => go (LoadCtx :: K) e
| Store ?e1 ?e2 => go (StoreLCtx e2 :: K) e1 || go (StoreRCtx e1 :: K) e2
| Cas ?e0 ?e1 ?e2 =>
lazymatch e0 with
| of_val ?v0 =>
lazymatch e1 with
| of_val ?v1 => go (CasRCtx v0 v1 :: K) e2
| _ => go (CasMCtx v0 e2 :: K) e1
end
| _ => go (CasLCtx e1 e2 :: K) e0
end
end in go (@nil ectx_item) e.
Ltac do_step tac :=
try match goal with |- reducible _ _ => eexists _, _, _ end;
simpl;
match goal with
| |- prim_step ?e1 ?σ1 ?e2 ?σ2 ?ef =>
reshape_expr e1 ltac:(fun K e1' =>
eapply Ectx_step with K e1' _); [reflexivity|reflexivity|];
first [apply alloc_fresh|econstructor];
rewrite ?to_of_val; tac; fail
end.
Require Import prelude.gmap iris.lifting. Require Import prelude.gmap iris.lifting.
Require Export iris.weakestpre barrier.heap_lang. Require Export iris.weakestpre barrier.heap_lang_tactics.
Import uPred. Import uPred.
Import heap_lang.
Local Hint Extern 0 (reducible _ _) => do_step ltac:(eauto 2).
Section lifting. Section lifting.
Context {Σ : iFunctor}. Context {Σ : iFunctor}.
Implicit Types P : iProp heap_lang Σ. Implicit Types P : iProp heap_lang Σ.
Implicit Types Q : val heap_lang iProp heap_lang Σ. Implicit Types Q : val iProp heap_lang Σ.
Implicit Types K : ectx.
(** 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 (of_val v)) Q) wp E (fill K e) Q.
Proof. apply wp_bind. Qed. Proof. apply wp_bind. Qed.
(** Base axioms for core primitives of the language: Stateful reductions. *) (** Base axioms for core primitives of the language: Stateful reductions. *)
Lemma wp_lift_step E1 E2 (φ : expr state Prop) Q e1 σ1 : 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
...@@ -23,303 +25,176 @@ Lemma wp_lift_step E1 E2 (φ : expr → state → Prop) Q e1 σ1 : ...@@ -23,303 +25,176 @@ Lemma wp_lift_step E1 E2 (φ : expr → state → Prop) Q e1 σ1 :
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 *) rewrite -(wp_lift_step E1 E2 (λ e' σ' ef, ef = None φ e' σ') _ _ σ1) //.
etransitivity; last eapply wp_lift_step with (σ2 := σ1) apply pvs_mono, sep_mono, later_mono; first done.
(φ0 := λ e' σ' ef, ef = None φ e' σ'); last first. apply forall_mono=>e2; apply forall_mono=>σ2.
- intros e2 σ2 ef Hstep'%prim_ectx_step; last done. apply forall_intro=>ef; apply wand_intro_l.
by apply Hstep. rewrite always_and_sep_l' -associative -always_and_sep_l'.
- destruct Hsafe as (e' & σ' & ? & ?). apply const_elim_l=>-[-> ?] /=.
do 3 eexists. exists EmptyCtx. do 2 eexists. by rewrite const_equiv // left_id wand_elim_r right_id.
split_ands; try (by rewrite fill_empty); eassumption.
- done.
- eassumption.
- apply pvs_mono. apply sep_mono; first done.
apply later_mono. apply forall_mono=>e2. apply forall_mono=>σ2.
apply forall_intro=>ef. apply wand_intro_l.
rewrite always_and_sep_l' -associative -always_and_sep_l'.
apply const_elim_l; move=>[-> Hφ]. eapply const_intro_l; first eexact Hφ.
rewrite always_and_sep_l' associative -always_and_sep_l' wand_elim_r.
apply pvs_mono. rewrite right_id. done.
Qed. Qed.
(* TODO RJ: Figure out some better way to make the (* TODO RJ: Figure out some better way to make the
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 to_val 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... *) intros; set (φ e' σ' := l, e' = Loc l σ' = <[l:=v]>σ σ !! l = None).
intros Hvl. etransitivity; last eapply wp_lift_step with (σ1 := σ) rewrite -(wp_lift_step E E φ _ _ σ) // /φ; last by intros; inv_step; eauto.
(φ := λ e' σ', l, e' = Loc l σ' = <[l:=v]>σ σ !! l = None); rewrite -pvs_intro. apply sep_mono, later_mono; first done.
last first. apply forall_intro=>e2; apply forall_intro=>σ2; apply wand_intro_l.
- intros e2 σ2 ef Hstep. inversion_clear Hstep. split; first done. rewrite -pvs_intro always_and_sep_l' -associative -always_and_sep_l'.
rewrite Hv in Hvl. inversion_clear Hvl. apply const_elim_l=>-[l [-> [-> ?]]].
eexists; split_ands; done. by rewrite (forall_elim l) const_equiv // left_id wand_elim_r -wp_value'.
- set (l := fresh $ dom (gset loc) σ).
exists (Loc l), ((<[l:=v]>)σ), None. eapply AllocS; first done.
apply (not_elem_of_dom (D := gset loc)). apply is_fresh.
- reflexivity.
- reflexivity.
- rewrite -pvs_intro. apply sep_mono; first done. apply later_mono.
apply forall_intro=>e2. apply forall_intro=>σ2.
apply wand_intro_l. rewrite -pvs_intro.
rewrite always_and_sep_l' -associative -always_and_sep_l'.
apply const_elim_l. intros [l [-> [-> Hl]]].
rewrite (forall_elim l). eapply const_intro_l; first eexact Hl.
rewrite always_and_sep_l' associative -always_and_sep_l' wand_elim_r.
rewrite -wp_value'; done.
Qed. 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; rewrite -(wp_lift_step E E (λ e' σ', e' = of_val v σ' = σ)) //;
(φ := λ e' σ', e' = v2e v σ' = σ); last first. last by intros; inv_step; eauto.
- intros e2 σ2 ef Hstep. move: Hl. inversion_clear Hstep=>{σ}. rewrite -pvs_intro; apply sep_mono, later_mono; first done.
rewrite Hlookup. case=>->. done. apply forall_intro=>e2; apply forall_intro=>σ2; apply wand_intro_l.
- do 3 eexists. econstructor; eassumption. rewrite -pvs_intro always_and_sep_l' -associative -always_and_sep_l'.
- reflexivity. apply const_elim_l=>-[-> ->]; by rewrite wand_elim_r -wp_value.
- reflexivity.
- rewrite -pvs_intro.
apply sep_mono; first done. apply later_mono.
apply forall_intro=>e2. apply forall_intro=>σ2.
apply wand_intro_l. rewrite -pvs_intro.
rewrite always_and_sep_l' -associative -always_and_sep_l'.
apply const_elim_l. intros [-> ->].
by rewrite wand_elim_r -wp_value.
Qed. 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 to_val 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.
(φ := λ e' σ', e' = LitUnit σ' = <[l:=v]>σ); last first. rewrite -(wp_lift_step E E (λ e' σ', e' = LitUnit σ' = <[l:=v]>σ)) //;
- intros e2 σ2 ef Hstep. move: Hl. inversion_clear Hstep=>{σ2}. last by intros; inv_step; eauto.
rewrite Hvl in Hv. inversion_clear Hv. done. rewrite -pvs_intro; apply sep_mono, later_mono; first done.
- do 3 eexists. eapply StoreS; last (eexists; eassumption). eassumption. apply forall_intro=>e2; apply forall_intro=>σ2; apply wand_intro_l.
- reflexivity. rewrite -pvs_intro always_and_sep_l' -associative -always_and_sep_l'.
- reflexivity. apply const_elim_l=>-[-> ->]; by rewrite wand_elim_r -wp_value'.
- rewrite -pvs_intro.
apply sep_mono; first done. apply later_mono.
apply forall_intro=>e2. apply forall_intro=>σ2.
apply wand_intro_l. rewrite -pvs_intro.
rewrite always_and_sep_l' -associative -always_and_sep_l'.
apply const_elim_l. intros [-> ->].
by rewrite wand_elim_r -wp_value'.
Qed. 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 to_val e1 = Some v1 to_val 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; rewrite -(wp_lift_step E E (λ e' σ', e' = LitFalse σ' = σ)) //;
(φ := λ e' σ', e' = LitFalse σ' = σ) (E1:=E); auto; last first. last by intros; inv_step; eauto.
- by inversion_clear 1; simplify_map_equality. rewrite -pvs_intro; apply sep_mono, later_mono; first done.
- do 3 eexists; econstructor; eauto. apply forall_intro=>e2'; apply forall_intro=>σ2; apply wand_intro_l.
- rewrite -pvs_intro. rewrite -pvs_intro always_and_sep_l' -associative -always_and_sep_l'.
apply sep_mono; first done. apply later_mono. apply const_elim_l=>-[-> ->]; by rewrite wand_elim_r -wp_value'.
apply forall_intro=>e2'. apply forall_intro=>σ2'.
apply wand_intro_l. rewrite -pvs_intro.
rewrite always_and_sep_l' -associative -always_and_sep_l'.
apply const_elim_l. intros [-> ->].
by rewrite wand_elim_r -wp_value'.
Qed. 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 to_val e1 = Some v1 to_val 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.
(φ := λ e' σ', e' = LitTrue σ' = <[l:=v2]>σ); last first. rewrite -(wp_lift_step E E (λ e' σ', e' = LitTrue σ' = <[l:=v2]>σ)) //;
- intros e2' σ2' ef Hstep. move:H. inversion_clear Hstep=>H. last by intros; inv_step; eauto.
(* FIXME this rewriting is rather ugly. *) rewrite -pvs_intro; apply sep_mono, later_mono; first done.
+ exfalso. rewrite H in Hlookup. case:Hlookup=>?; subst vl. apply forall_intro=>e2'; apply forall_intro=>σ2; apply wand_intro_l.
rewrite Hvl in Hv1. case:Hv1=>?; subst v1. done. rewrite -pvs_intro always_and_sep_l' -associative -always_and_sep_l'.
+ rewrite H in Hlookup. case:Hlookup=>?; subst v1. apply const_elim_l=>-[-> ->]; by rewrite wand_elim_r -wp_value'.
rewrite Hl in Hv2. case:Hv2=>?; subst v2. done.
- do 3 eexists. eapply CasSucS; eassumption.
- reflexivity.
- reflexivity.
- rewrite -pvs_intro.
apply sep_mono; first done. apply later_mono.
apply forall_intro=>e2'. apply forall_intro=>σ2'.
apply wand_intro_l. rewrite -pvs_intro.
rewrite always_and_sep_l' -associative -always_and_sep_l'.
apply const_elim_l. intros [-> ->].
by rewrite wand_elim_r -wp_value'.
Qed. 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 : iProp heap_lang Σ) wp (Σ:=Σ) coPset_all e (λ _, True) wp E (Fork e) (λ v, (v = LitUnitV)).
wp E (Fork e) (λ v, (v = LitUnitV)).
Proof. Proof.
etransitivity; last eapply wp_lift_pure_step with rewrite -(wp_lift_pure_step E (λ e' ef, e' = LitUnit ef = Some e)) //=;
(φ := λ e' ef, e' = LitUnit ef = Some e); last by intros; inv_step; eauto.
last first. apply later_mono, forall_intro=>e2; apply forall_intro=>ef.
- intros σ1 e2 σ2 ef Hstep%prim_ectx_step; last first. apply impl_intro_l, const_elim_l=>-[-> ->] /=.
{ do 3 eexists. eapply ForkS. } apply sep_intro_True_l; last done.
inversion_clear Hstep. done. by rewrite -wp_value' //; apply const_intro.
- intros ?. do 3 eexists. exists EmptyCtx. do 2 eexists.
split_ands; try (by rewrite fill_empty); [].
eapply ForkS.
- reflexivity.
- apply later_mono.
apply forall_intro=>e2; apply forall_intro=>ef.
apply impl_intro_l, const_elim_l=>-[-> ->] /=; apply sep_intro_True_l; auto.
by rewrite -wp_value' //; 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; rewrite -(wp_lift_pure_step E (λ e' ef, ef = None φ e')) //=.
(* RJ: working around https://coq.inria.fr/bugs/show_bug.cgi?id=4536 *) apply later_mono, forall_mono=>e2; apply forall_intro=>ef.
etransitivity; last eapply wp_lift_pure_step with apply impl_intro_l, const_elim_l=>-[-> ?] /=.
(φ0 := λ e' ef, ef = None φ e'); last first. by rewrite const_equiv // left_id right_id.
- intros σ1 e2 σ2 ef Hstep'%prim_ectx_step; last done.
by apply Hstep.
- intros σ1. destruct (Hsafe σ1) as (e' & σ' & ? & ?).
do 3 eexists. exists EmptyCtx. do 2 eexists.
split_ands; try (by rewrite fill_empty); eassumption.
- done.
- apply later_mono. apply forall_mono=>e2. apply forall_intro=>ef.
apply impl_intro_l. apply const_elim_l; move=>[-> Hφ].
eapply const_intro_l; first eexact Hφ. rewrite impl_elim_r.
rewrite right_id. done.
Qed. Qed.
Lemma wp_rec E ef e v Q : Lemma wp_rec E ef e v Q :
e2v e = Some v to_val 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 intros; rewrite -(wp_lift_pure_step E (λ e', e' = ef.[Rec ef, e /])
(φ := λ e', e' = ef.[Rec ef, e /]); last first. Q (App (Rec ef) e)) //=; last by intros; inv_step; eauto.
- intros ? ? ? ? Hstep. inversion_clear Hstep. done. by apply later_mono, forall_intro=>e2; apply impl_intro_l, const_elim_l=>->.
- intros ?. do 3 eexists. eapply BetaS; eassumption.
- reflexivity.
- apply later_mono, forall_intro=>e2. apply impl_intro_l.
apply const_elim_l=>->. done.
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 rewrite -(wp_lift_pure_step E (λ e', e' = LitNat (n1 + n2))) //=;
(φ := λ e', e' = LitNat (n1 + n2)); last first. last by intros; inv_step; eauto.
- intros ? ? ? ? Hstep. inversion_clear Hstep; done. apply later_mono, forall_intro=>e2; apply impl_intro_l, const_elim_l=>->.
- intros ?. do 3 eexists. econstructor. by rewrite -wp_value'.
- reflexivity.
- apply later_mono, forall_intro=>e2. apply impl_intro_l.
apply const_elim_l=>->.
rewrite -wp_value'; last reflexivity; done.
Qed. 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; rewrite -(wp_lift_pure_step E (λ e', e' = LitTrue)) //=;
(φ := λ e', e' = LitTrue); last first. last by intros; inv_step; eauto with lia.
- intros ? ? ? ? Hstep. inversion_clear Hstep; first done. apply later_mono, forall_intro=>e2; apply impl_intro_l, const_elim_l=>->.
exfalso. eapply le_not_gt with (n := n1); eassumption. by rewrite -wp_value'.
- intros ?. do 3 eexists. econstructor; done.
- reflexivity.
- apply later_mono, forall_intro=>e2. apply impl_intro_l.
apply const_elim_l=>->.
rewrite -wp_value'; last reflexivity; done.
Qed. 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; rewrite -(wp_lift_pure_step E (λ e', e' = LitFalse)) //=;
(φ := λ e', e' = LitFalse); last first. last by intros; inv_step; eauto with lia.
- intros ? ? ? ? Hstep. inversion_clear Hstep; last done. apply later_mono, forall_intro=>e2; apply impl_intro_l, const_elim_l=>->.
exfalso. eapply le_not_gt with (n := n1); eassumption. by rewrite -wp_value'.
- intros ?. do 3 eexists. econstructor; done.
- reflexivity.
- apply later_mono, forall_intro=>e2. apply impl_intro_l.
apply const_elim_l=>->.
rewrite -wp_value'; last reflexivity; done.
Qed. 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 to_val e1 = Some v1 to_val 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; rewrite -(wp_lift_pure_step E (λ e', e' = e1)) //=;
(φ := λ e', e' = e1); last first. last by intros; inv_step; eauto.
- intros ? ? ? ? Hstep. inversion_clear Hstep. done. apply later_mono, forall_intro=>e2'; apply impl_intro_l, const_elim_l=>->.
- intros ?. do 3 eexists. econstructor; eassumption. by rewrite -wp_value'.
- reflexivity.
- apply later_mono, forall_intro=>e2'. apply impl_intro_l.
apply const_elim_l=>->.
rewrite -wp_value'; last eassumption; done.
Qed. 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 to_val e1 = Some v1 to_val 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; rewrite -(wp_lift_pure_step E (λ e', e' = e2)) //=;
(φ := λ e', e' = e2); last first. last by intros; inv_step; eauto.
- intros ? ? ? ? Hstep. inversion_clear Hstep; done. apply later_mono, forall_intro=>e2'; apply impl_intro_l, const_elim_l=>->.
- intros ?. do 3 eexists. econstructor; eassumption. by rewrite -wp_value'.
- reflexivity.
- apply later_mono, forall_intro=>e2'. apply impl_intro_l.
apply const_elim_l=>->.
rewrite -wp_value'; last eassumption; done.
Qed. 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 to_val 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; rewrite -(wp_lift_pure_step E (λ e', e' = e1.[e0/]) _
(φ := λ e', e' = e1.[e0/]); last first. (Case (InjL e0) e1 e2)) //=; last by intros; inv_step; eauto.
- intros ? ? ? ? Hstep. inversion_clear Hstep; done. by apply later_mono, forall_intro=>e1'; apply impl_intro_l, const_elim_l=>->.
- intros ?. do 3 eexists. econstructor; eassumption.
- reflexivity.
- apply later_mono, forall_intro=>e1'. apply impl_intro_l.
by apply const_elim_l=>->.
Qed. Qed.
Lemma wp_case_inr e0 v0 e1 e2 E Q :