Commit f88e1b37 authored by Dan Frumin's avatar Dan Frumin
Browse files

Use a single tp_pure tactic that depends on the PureExec typeclass

+ add some discussion in comments.org
parent 3f2ae145
......@@ -141,7 +141,7 @@ Section proof.
unfold with_lock. unlock.
tp_rec j.
tp_rec j.
tp_rec j; eauto using to_of_val.
tp_rec j.
tp_bind j (App acquire (Loc l)).
tp_apply j steps_acquire with "Hl" as "Hl".
tp_rec j.
......
......@@ -146,7 +146,7 @@ Section masked.
iDestruct (interp_env_dom with "HΓ") as %Hdom.
(* TODO: how to get rid of/ simplify those proofs? *)
assert (Closed (x :b: f :b: )
(env_subst (delete f (delete x (fst <$> vvs))) e)).
(subst_p (delete f (delete x (fst <$> vvs))) e)).
{ eapply subst_p_closes; eauto.
rewrite ?dom_delete_binder Hdom.
rewrite dom_fmap.
......@@ -160,13 +160,12 @@ Section masked.
set_solver.
+ rewrite ?(right_id union).
rewrite (comm union {[x]} {[f]}) !assoc.
rewrite difference_union_id.
rewrite difference_union_id.
rewrite -!assoc (comm union {[f]} {[x]}) !assoc.
rewrite difference_union_id.
set_solver.
}
rewrite difference_union_id.
set_solver. }
assert (Closed (x :b: f :b: )
(env_subst (delete f (delete x (snd <$> vvs))) e')).
(subst_p (delete f (delete x (snd <$> vvs))) e')).
{ eapply subst_p_closes; eauto.
rewrite ?dom_delete_binder Hdom.
rewrite dom_fmap.
......@@ -185,13 +184,14 @@ Section masked.
rewrite difference_union_id.
set_solver.
}
iModIntro. value_case; eauto. rewrite decide_left; eauto.
iModIntro. value_case; eauto.
{ rewrite decide_left; eauto. }
iExists (RecV f x (subst_p (delete f (delete x (snd <$> vvs))) e')). iIntros "{$Hj} !#".
iLöb as "IH". iIntros ([v v']) "#Hiv". simpl. iIntros (j' K') "Hj".
iModIntro. simpl.
iApply (wp_rec _ f x (subst_p _ e)); eauto 2 using to_of_val. iNext.
iApply fupd_wp.
tp_rec j'; auto.
tp_rec j'.
pose (vvs':=(<[x:=(v,v')]>(<[f:=(RecV f x (subst_p (delete f (delete x (fst <$> vvs))) e), RecV f x (subst_p (delete f (delete x (snd <$> vvs))) e'))]>vvs))).
iAssert (interp_env (<[x:=τ1]> (<[f:=TArrow τ1 τ2]> Γ)) Δ vvs') as "#HΓ'".
{ unfold vvs'. destruct f as [|f], x as [|x]; cbn; eauto;
......@@ -249,24 +249,25 @@ Section masked.
iIntros (vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
smart_bind j (env_subst _ e0) (env_subst _ e0') "IH1" v v' "IH1".
iDestruct "IH1" as "[Hiv|Hiv]";
iDestruct "Hiv" as ([w w']) "[% #Hw]"; simplify_eq; iApply fupd_wp.
- tp_case_inl j; eauto.
iApply wp_case_inl; eauto using to_of_val. fold of_val.
iDestruct "Hiv" as ([w w']) "[% #Hw]"; simplify_eq;
tp_case j.
- iApply wp_case_inl; eauto using to_of_val. fold of_val.
iNext.
iSpecialize ("IH2" with "Hs [HΓ]"); auto.
tp_bind j (env_subst (snd <$> vvs) e1').
iApply (fupd_mask_mono _); eauto.
iMod ("IH2" with "Hj") as "IH2". iModIntro. iNext. simpl.
iApply fupd_wp. iApply (fupd_mask_mono _); eauto.
iMod ("IH2" with "Hj") as "IH2". iModIntro.
wp_bind (env_subst (fst <$> vvs) e1).
iApply (wp_wand with "IH2").
iIntros (v). iDestruct 1 as (v') "[Hj #Ht]".
iSpecialize ("Ht" $! (w, w') with "Hw Hj"). cbn.
by iApply fupd_wp.
- tp_case_inr j; eauto.
iApply wp_case_inr; eauto using to_of_val. fold of_val.
- iApply wp_case_inr; eauto using to_of_val. fold of_val.
iNext.
iSpecialize ("IH3" with "Hs [HΓ]"); auto.
tp_bind j (env_subst (snd <$> vvs) e2').
iApply (fupd_mask_mono _); eauto.
iMod ("IH3" with "Hj") as "IH3". iModIntro. iNext. simpl.
iApply fupd_wp. iApply (fupd_mask_mono _); eauto.
iMod ("IH3" with "Hj") as "IH3". iModIntro.
wp_bind (env_subst (fst <$> vvs) e2).
iApply (wp_wand with "IH3").
iIntros (v). iDestruct 1 as (v') "[Hj #Ht]".
......@@ -285,12 +286,11 @@ Section masked.
iIntros (?) "IH1 IH2 IH3".
iIntros (vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
smart_bind j (env_subst _ e0) (env_subst _ e0') "IH1" v v' "IH1".
iDestruct "IH1" as ([]) "[% %]"; simplify_eq/=; iApply fupd_wp.
- tp_if_true j; eauto. iModIntro.
iApply wp_if_true. iNext. iApply fupd_wp.
iDestruct "IH1" as ([]) "[% %]"; simplify_eq/=;
tp_if j.
- iApply wp_if_true. iNext.
smart_bind j (env_subst _ e1) (env_subst _ e1') "IH2" v v' "?".
- tp_if_false j; eauto. iModIntro.
iApply wp_if_false. iNext. iApply fupd_wp.
- iApply wp_if_false. iNext.
smart_bind j (env_subst _ e2) (env_subst _ e2') "IH3" v v' "?".
Qed.
......@@ -308,11 +308,10 @@ Section masked.
smart_bind j (env_subst _ e2) (env_subst _ e2') "IH2" w w' "IH2".
iDestruct "IH1" as (n) "[% %]"; simplify_eq/=.
iDestruct "IH2" as (n') "[% %]"; simplify_eq/=.
iApply fupd_wp.
destruct (binop_nat_typed_safe op n n' _ Hopτ) as [v' Hopv'].
tp_binop j; eauto; tp_normalise j.
iApply wp_nat_binop; eauto. iModIntro. iExists _; iSplitL; eauto.
repeat iModIntro.
iModIntro.
destruct op; simpl in Hopv'; simplify_eq/=; try destruct eq_nat_dec; try destruct le_dec;
try destruct lt_dec; eauto.
Qed.
......@@ -331,11 +330,9 @@ Section masked.
smart_bind j (env_subst _ e2) (env_subst _ e2') "IH2" w w' "IH2".
iDestruct "IH1" as (n) "[% %]"; simplify_eq/=.
iDestruct "IH2" as (n') "[% %]"; simplify_eq/=.
iApply fupd_wp.
destruct (binop_bool_typed_safe op n n' _ Hopτ) as [v' Hopv'].
tp_binop j; eauto; tp_normalise j.
iApply wp_nat_binop; eauto. iModIntro. iExists _; iSplitL; eauto.
repeat iModIntro.
destruct op; simpl in Hopv'; simplify_eq/=; try destruct eq_nat_dec; try destruct le_dec;
try destruct lt_dec; eauto.
Qed.
......
(* the contents of this file sould belong elsewhere *)
From iris.proofmode Require Import tactics.
From iris_logrel.F_mu_ref_conc Require Import lang subst tactics rules rules_binary logrel_binary.
From iris_logrel.F_mu_ref_conc Require Import lang logrel_binary.
Definition lamsubst (e : expr) (v : val) : expr :=
match e with
......
From iris_logrel.F_mu_ref_conc Require Export fundamental_binary logrel_binary.
From iris.proofmode Require Import tactics.
From iris_logrel.F_mu_ref_conc Require Import rules_binary hax.
From iris.program_logic Require Import ectx_lifting.
From iris_logrel.F_mu_ref_conc Require Export lang subst hax.
Class PureExec (P : Prop) (e1 e2 : expr) := {
pure_exec_safe : P -> σ, head_reducible e1 σ;
......@@ -18,7 +15,7 @@ split; intros Hval.
- intros. by inv_head_step.
Qed.
Instance pure_rec f x e1 e2 v2 `{Closed (x :b: f :b: ) e1} `(to_val e2 = Some v2) :
Instance pure_rec f x e1 e2 v2 `{Closed (Rec f x e1)} `(to_val e2 = Some v2) :
PureExec True
(App (Rec f x e1) e2)
(subst' f (Rec f x e1) (subst' x e2 e1)).
......@@ -40,7 +37,7 @@ split; intros ?; subst.
Qed.
Instance pure_fst e1 v1 e2 v2 `(to_val e1 = Some v1) `(to_val e2 = Some v2) :
PureExec True (Fst (e1, e2)) e1.
PureExec True (Fst (Pair e1 e2)) e1.
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
......@@ -48,7 +45,7 @@ split; intros ?.
Qed.
Instance pure_snd e1 v1 e2 v2 `(to_val e1 = Some v1) `(to_val e2 = Some v2) :
PureExec True (Snd (e1, e2)) e2.
PureExec True (Snd (Pair e1 e2)) e2.
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
......@@ -64,7 +61,7 @@ split; intros ?.
Qed.
Instance pure_if_true e1 e2 `{Closed e1} `{Closed e2} :
Instance pure_if_true e1 e2 :
PureExec True (If true e1 e2) e1.
Proof.
split; intros ?.
......@@ -72,7 +69,7 @@ split; intros ?.
- intros. by inv_head_step.
Qed.
Instance pure_if_false e1 e2 `{Closed e1} `{Closed e2} :
Instance pure_if_false e1 e2 :
PureExec True (If false e1 e2) e2.
Proof.
split; intros ?.
......@@ -80,7 +77,7 @@ split; intros ?.
- intros. by inv_head_step.
Qed.
Instance pure_case_inl e0 v `(to_val e0 = Some v) e1 e2 `{Closed e1} `{Closed e2} :
Instance pure_case_inl e0 v `(to_val e0 = Some v) e1 e2 :
PureExec True (Case (InjL e0) e1 e2) (e1 e0).
Proof.
split; intros ?.
......@@ -88,7 +85,7 @@ split; intros ?.
- intros. by inv_head_step.
Qed.
Instance pure_case_inr e0 v `(to_val e0 = Some v) e1 e2 `{Closed e1} `{Closed e2} :
Instance pure_case_inr e0 v `(to_val e0 = Some v) e1 e2 :
PureExec True (Case (InjR e0) e1 e2) (e2 e0).
Proof.
split; intros ?.
......
......@@ -2,7 +2,7 @@ From iris.program_logic Require Export weakestpre.
From iris.proofmode Require Import coq_tactics sel_patterns.
From iris.proofmode Require Export tactics.
From iris_logrel.F_mu_ref_conc Require Import rules rules_binary.
From iris_logrel.F_mu_ref_conc Require Export lang reflection.
From iris_logrel.F_mu_ref_conc Require Export lang reflection proofmode.classes.
Set Default Proof Using "Type".
Import lang.
......@@ -254,20 +254,21 @@ Tactic Notation "tp_load" constr(j) :=
|env_cbv; reflexivity || fail "tp_load: this should not happen"
|(* new goal *)].
Lemma tac_tp_rec `{logrelG Σ} j Δ1 Δ2 E1 E2 ρ i1 i2 p K' e f x e1 e2 v Q :
Lemma tac_tp_pure `{logrelG Σ} j K' e1 Δ1 Δ2 E1 ρ i1 i2 p e ϕ e2 Q :
( P, ElimModal (|={E1}=> P) P Q Q)
nclose specN E1
envs_lookup i1 Δ1 = Some (p, spec_ctx ρ)
envs_lookup i2 Δ1 = Some (false, j e)%I
e = fill K' (App (Rec f x e1) e2)
to_val e2 = Some v
Closed (x :b: f :b: ) e1
e = fill K' e1
PureExec ϕ e1 e2
ϕ
envs_simple_replace i2 false
(Esnoc Enil i2
(j fill K' (subst' f (Rec f x e1) (subst' x e2 e1)))) Δ1 = Some Δ2
(Δ2 |={E1,E2}=> Q)
(Δ1 |={E1,E2}=> Q).
(j fill K' e2)) Δ1 = Some Δ2
(Δ2 Q)
(Δ1 Q).
Proof.
intros ? HΔ1 ? Hfill Hval ?? HQ.
intros ?? HΔ1 ? Hfill Hpure Hϕ ??.
rewrite -(idemp uPred_and Δ1).
rewrite {2}(envs_lookup_sound' Δ1). 2: apply HΔ1.
rewrite uPred.sep_elim_l uPred.always_and_sep_r.
......@@ -275,73 +276,47 @@ Proof.
rewrite right_id.
rewrite Hfill.
rewrite comm.
(* (S (spec_ctx ρ) (S (j => fill) (S (l v) ..))) *)
rewrite (assoc _ (spec_ctx ρ) (j _)%I).
rewrite step_rec //.
rewrite -(fupd_trans E1 E1 E2).
rewrite fupd_frame_r.
apply fupd_mono.
rewrite step_pure //; last first.
{ intros σ.
destruct Hpure as [Hsafe Hstep].
destruct (Hsafe Hϕ σ) as [e2' [σ2' [? Hstep']]].
destruct (Hstep Hϕ _ _ _ _ Hstep') as (? & ? & ?); subst.
done. }
rewrite -[Q]elim_modal.
apply uPred.sep_mono_r.
apply uPred.wand_intro_l.
rewrite uPred.wand_elim_r.
done.
Qed.
Tactic Notation "tp_rec" constr(j) :=
Tactic Notation "tp_pure" constr(j) open_constr(ef) :=
iStartProof;
eapply (tac_tp_rec j);
[solve_ndisj || fail "tp_rec: cannot prove 'nclose specN ⊆ ?'"
|iAssumptionCore || fail "tp_rec: cannot find spec_ctx" (* spec_ctx *)
|iAssumptionCore || fail "tp_rec: cannot find '" j " ⤇ ?'"
|tp_bind_helper
|try fast_done
|try solve_closed
|env_cbv; reflexivity || fail "tp_rec: this should not happen"
eapply (tac_tp_pure j _ ef);
[apply _ || fail "tp_pure: cannot eliminate modality in the goal"
|solve_ndisj || fail "tp_pure: cannot prove 'nclose specN ⊆ ?'"
|iAssumptionCore || fail "tp_pure: cannot find spec_ctx" (* spec_ctx *)
|iAssumptionCore || fail "tp_pure: cannot find '" j " ⤇ ?'"
|tp_bind_helper (* e = K'[e1]*)
|apply _ (* PureExec ϕ e1 e2 *)
|try (exact I || reflexivity || tac_rel_done) (* ϕ *)
|env_cbv; reflexivity || fail "tp_pure: this should not happen"
|simpl_subst (* new goal *)].
Tactic Notation "tp_pure" constr(j) := tp_pure j _.
Lemma tac_tp_nat_binop `{logrelG Σ} j Δ1 Δ2 E1 E2 ρ i1 i2 p K' e op e1 e2 v1 v2 v Q :
nclose specN E1
envs_lookup i1 Δ1 = Some (p, spec_ctx ρ)
envs_lookup i2 Δ1 = Some (false, j e)%I
e = fill K' (BinOp op e1 e2)
to_val e1 = Some v1
to_val e2 = Some v2
binop_eval op v1 v2 = Some v
envs_simple_replace i2 false
(Esnoc Enil i2 (j fill K' (of_val v))) Δ1 = Some Δ2
(Δ2 |={E1,E2}=> Q)
(Δ1 |={E1,E2}=> Q).
Proof.
intros ??? Hfill ???? HQ.
rewrite -(idemp uPred_and Δ1).
rewrite {2}(envs_lookup_sound' Δ1). 2: apply H1.
rewrite uPred.sep_elim_l uPred.always_and_sep_r.
rewrite (envs_simple_replace_sound Δ1 Δ2 i2) //; simpl.
rewrite right_id.
rewrite Hfill.
rewrite comm.
rewrite (assoc _ (spec_ctx ρ) (j _)%I).
rewrite step_nat_binop //.
rewrite -(fupd_trans E1 E1 E2).
rewrite fupd_frame_r.
apply fupd_mono.
rewrite uPred.wand_elim_r.
done.
Qed.
Tactic Notation "tp_binop" constr(j) :=
iStartProof;
eapply (tac_tp_nat_binop j);
[solve_ndisj || fail "tp_binop: cannot prove 'nclose specN ⊆ ?'"
|iAssumptionCore || fail "tp_binop: cannot find spec_ctx" (* spec_ctx *)
|iAssumptionCore || fail "tp_binop: cannot find '" j " ⤇ ?'"
|tp_bind_helper
|solve_to_val || fail "tp_binop: cannot prove that the first argument is a value"
|solve_to_val || fail "tp_binop: cannot prove that the second argument is a value"
|(fast_done || auto) || fail "tp_binop: cannot evaluate the binop"
|env_cbv; reflexivity || fail "tp_binop: this should not happen"
|(* new goal *)].
Tactic Notation "tp_rec" constr(j) := tp_pure j (App (Rec _ _ _) _).
Tactic Notation "tp_binop" constr(j) := tp_pure j (BinOp _ _ _).
Tactic Notation "tp_op" constr(j) := tp_binop j.
Tactic Notation "tp_fold" constr(j) := tp_pure j (Unfold (Fold _)).
Tactic Notation "tp_fst" constr(j) := tp_pure j (Fst (Pair _ _)).
Tactic Notation "tp_snd" constr(j) := tp_pure j (Snd (Pair _ _)).
Tactic Notation "tp_case_inl" constr(j) := tp_pure j (Case (InjL _) _ _).
Tactic Notation "tp_case_inr" constr(j) := tp_pure j (Case (InjR _) _ _).
Tactic Notation "tp_case" constr(j) := tp_pure j (Case _ _ _).
Tactic Notation "tp_if_true" constr(j) := tp_pure j (If true _ _).
Tactic Notation "tp_if_false" constr(j) := tp_pure j (If false _ _).
Tactic Notation "tp_if" constr(j) := tp_pure j (If _ _ _).
Lemma tac_tp_cas_fail `{logrelG Σ} j Δ1 Δ2 Δ3 E1 E2 ρ i1 i2 i3 p K' e l e1 e2 v' v1 v2 Q q :
nclose specN E1
......@@ -482,43 +457,6 @@ Tactic Notation "tp_tlam" constr(j) :=
|env_cbv; reflexivity || fail "tp_tlam: this should not happen"
|(* new goal *)].
Lemma tac_tp_fold `{logrelG Σ} j Δ1 Δ2 E1 E2 ρ i1 i2 p K' e e' v Q :
nclose specN E1
envs_lookup i1 Δ1 = Some (p, spec_ctx ρ)
envs_lookup i2 Δ1 = Some (false, j e)%I
e = fill K' (Unfold (Fold e'))
to_val e' = Some v
envs_simple_replace i2 false
(Esnoc Enil i2 (j fill K' e')) Δ1 = Some Δ2
(Δ2 |={E1,E2}=> Q)
(Δ1 |={E1,E2}=> Q).
Proof.
intros ??? Hfill ?? HQ.
rewrite -(idemp uPred_and Δ1).
rewrite {2}(envs_lookup_sound' Δ1 _). 2: exact H1.
rewrite uPred.sep_elim_l uPred.always_and_sep_r comm.
rewrite (envs_simple_replace_sound Δ1 Δ2 i2) //; simpl.
rewrite right_id. rewrite Hfill.
(* (S (spec_ctx ρ) (S (j => fill) (S (l v) ..))) *)
rewrite (assoc _ (spec_ctx ρ) (j _)%I).
rewrite step_Fold //.
rewrite -(fupd_trans E1 E1 E2).
rewrite fupd_frame_r.
apply fupd_mono. rewrite uPred.wand_elim_r.
done.
Qed.
Tactic Notation "tp_fold" constr(j) :=
iStartProof;
eapply (tac_tp_fold j);
[solve_ndisj || fail "tp_fold: cannot prove 'nclose specN ⊆ ?'"
|iAssumptionCore || fail "tp_fold: cannot find spec_ctx" (* spec_ctx *)
|iAssumptionCore || fail "tp_fold: cannot find '" j " ⤇ ?'"
|tp_bind_helper
|try fast_done
|env_cbv; reflexivity || fail "tp_fold: this should not happen"
|(* new goal *)].
Lemma tac_tp_pack `{logrelG Σ} j Δ1 Δ2 E1 E2 ρ i1 i2 p K' e e1 e2 v Q :
nclose specN E1
envs_lookup i1 Δ1 = Some (p, spec_ctx ρ)
......@@ -556,231 +494,6 @@ Tactic Notation "tp_pack" constr(j) :=
|env_cbv; reflexivity || fail "tp_pack: this should not happen"
|(* new goal *)].
Lemma tac_tp_fst `{logrelG Σ} j Δ1 Δ2 E1 E2 ρ i1 i2 p K' e e1 e2 v1 v2 Q :
nclose specN E1
envs_lookup i1 Δ1 = Some (p, spec_ctx ρ)
envs_lookup i2 Δ1 = Some (false, j e)%I
e = fill K' (Fst (Pair e1 e2))
to_val e1 = Some v1
to_val e2 = Some v2
envs_simple_replace i2 false
(Esnoc Enil i2 (j fill K' e1)) Δ1 = Some Δ2
(Δ2 |={E1,E2}=> Q)
(Δ1 |={E1,E2}=> Q).
Proof.
intros ??? Hfill ??? HQ.
rewrite -(idemp uPred_and Δ1).
rewrite {2}(envs_lookup_sound' Δ1 _). 2: exact H1.
rewrite uPred.sep_elim_l uPred.always_and_sep_r comm.
rewrite (envs_simple_replace_sound Δ1 Δ2 i2) //; simpl.
rewrite right_id. rewrite Hfill.
(* (S (spec_ctx ρ) (S (j => fill) (S (l v) ..))) *)
rewrite (assoc _ (spec_ctx ρ) (j _)%I).
rewrite step_fst //.
rewrite -(fupd_trans E1 E1 E2).
rewrite fupd_frame_r.
apply fupd_mono. rewrite uPred.wand_elim_r.
done.
Qed.
Tactic Notation "tp_fst" constr(j) :=
iStartProof;
eapply (tac_tp_fst j);
[solve_ndisj || fail "tp_fst: cannot prove 'nclose specN ⊆ ?'"
|iAssumptionCore || fail "tp_fst: cannot find spec_ctx" (* spec_ctx *)
|iAssumptionCore || fail "tp_fst: cannot find '" j " ⤇ ?'"
|tp_bind_helper
|try fast_done
|try fast_done
|env_cbv; reflexivity || fail "tp_fst: this should not happen"
|(* new goal *)].
Lemma tac_tp_snd `{logrelG Σ} j Δ1 Δ2 E1 E2 ρ i1 i2 p K' e e1 e2 v1 v2 Q :
nclose specN E1
envs_lookup i1 Δ1 = Some (p, spec_ctx ρ)
envs_lookup i2 Δ1 = Some (false, j e)%I
e = fill K' (Snd (Pair e1 e2))
to_val e1 = Some v1
to_val e2 = Some v2
envs_simple_replace i2 false
(Esnoc Enil i2 (j fill K' e2)) Δ1 = Some Δ2
(Δ2 |={E1,E2}=> Q)
(Δ1 |={E1,E2}=> Q).
Proof.
intros ??? Hfill ??? HQ.
rewrite -(idemp uPred_and Δ1).
rewrite {2}(envs_lookup_sound' Δ1 _). 2: exact H1.
rewrite uPred.sep_elim_l uPred.always_and_sep_r comm.
rewrite (envs_simple_replace_sound Δ1 Δ2 i2) //; simpl.
rewrite right_id. rewrite Hfill.
(* (S (spec_ctx ρ) (S (j => fill) (S (l v) ..))) *)
rewrite (assoc _ (spec_ctx ρ) (j _)%I).
rewrite step_snd //.
rewrite -(fupd_trans E1 E1 E2).
rewrite fupd_frame_r.
apply fupd_mono. rewrite uPred.wand_elim_r.
done.
Qed.
Tactic Notation "tp_snd" constr(j) :=
iStartProof;
eapply (tac_tp_snd j);
[solve_ndisj || fail "tp_snd: cannot prove 'nclose specN ⊆ ?'"
|iAssumptionCore || fail "tp_snd: cannot find spec_ctx" (* spec_ctx *)
|iAssumptionCore || fail "tp_snd: cannot find '" j " ⤇ ?'"
|tp_bind_helper
|try fast_done
|try fast_done
|env_cbv; reflexivity || fail "tp_snd: this should not happen"
|(* new goal *)].
Lemma tac_tp_case_inl `{logrelG Σ} j Δ1 Δ2 E1 E2 ρ i1 i2 p K' e e0 e1 e2 v Q :
nclose specN E1
envs_lookup i1 Δ1 = Some (p, spec_ctx ρ)
envs_lookup i2 Δ1 = Some (false, j e)%I
e = fill K' (Case (InjL e0) e1 e2)
to_val e0 = Some v
envs_simple_replace i2 false
(Esnoc Enil i2 (j fill K' (App e1 e0))) Δ1 = Some Δ2
(Δ2 |={E1,E2}=> Q)
(Δ1 |={E1,E2}=> Q).
Proof.
intros ??? Hfill ?? HQ.
rewrite -(idemp uPred_and Δ1).
rewrite {2}(envs_lookup_sound' Δ1 _). 2: exact H1.
rewrite uPred.sep_elim_l uPred.always_and_sep_r comm.
rewrite (envs_simple_replace_sound Δ1 Δ2 i2) //; simpl.
rewrite right_id. rewrite Hfill.
(* (S (spec_ctx ρ) (S (j => fill) (S (l v) ..))) *)
rewrite (assoc _ (spec_ctx ρ) (j _)%I).
rewrite step_case_inl //.
rewrite -(fupd_trans E1 E1 E2).
rewrite fupd_frame_r.
apply fupd_mono. rewrite uPred.wand_elim_r.
done.
Qed.
Tactic Notation "tp_case_inl" constr(j) :=
iStartProof;
eapply (tac_tp_case_inl j);
[solve_ndisj || fail "tp_case_inl: cannot prove 'nclose specN ⊆ ?'"
|iAssumptionCore || fail "tp_case_inl: cannot find spec_ctx" (* spec_ctx *)
|iAssumptionCore || fail "tp_case_inl: cannot find '" j " ⤇ ?'"
|tp_bind_helper
|try fast_done
|env_cbv; reflexivity || fail "tp_case_inl: this should not happen"
|(* new goal *)].
Lemma tac_tp_case_inr `{logrelG Σ} j Δ1 Δ2 E1 E2 ρ i1 i2 p K' e e0 e1 e2 v Q :
nclose specN E1
envs_lookup i1 Δ1 = Some (p, spec_ctx ρ)
envs_lookup i2 Δ1 = Some (false, j e)%I
e = fill K' (Case (InjR e0) e1 e2)
to_val e0 = Some v
envs_simple_replace i2 false
(Esnoc Enil i2 (j fill K' (App e2 e0))) Δ1 = Some Δ2
(Δ2 |={E1,E2}=> Q)
(Δ1 |={E1,E2}=> Q).
Proof.
intros ??? Hfill ?? HQ.
rewrite -(idemp uPred_and Δ1).
rewrite {2}(envs_lookup_sound' Δ1 _). 2: exact H1.
rewrite uPred.sep_elim_l uPred.always_and_sep_r comm.
rewrite (envs_simple_replace_sound Δ1 Δ2 i2) //; simpl.
rewrite right_id. rewrite Hfill.
(* (S (spec_ctx ρ) (S (j => fill) (S (l v) ..))) *)
rewrite (assoc _ (spec_ctx ρ) (j _)%I).
rewrite step_case_inr //.
rewrite -(fupd_trans E1 E1 E2).
rewrite fupd_frame_r.
apply fupd_mono. rewrite uPred.wand_elim_r.
done.
Qed.
Tactic Notation "tp_case_inr" constr(j) :=
iStartProof;
eapply (tac_tp_case_inr j);
[solve_ndisj || fail "tp_case_inr: cannot prove 'nclose specN ⊆ ?'"
|iAssumptionCore || fail "tp_case_inr: cannot find spec_ctx" (* spec_ctx *)
|iAssumptionCore || fail "tp_case_inr: cannot find '" j " ⤇ ?'"
|tp_bind_helper
|try fast_done
|env_cbv; reflexivity || fail "tp_case_inr: this should not happen"
|(* new goal *)].
Lemma tac_tp_if_true `{logrelG Σ} j Δ1 Δ2 E1 E2 ρ i1 i2 p K' e e1 e2 Q :
nclose specN E1
envs_lookup i1 Δ1 = Some (p, spec_ctx ρ)
envs_lookup i2 Δ1 = Some (false, j e)%I
e = fill K' (If (# true) e1 e2)
envs_simple_replace i2 false
(Esnoc Enil i2 (j fill K' e1)) Δ1 = Some Δ2
(Δ2 |={E1,E2}=> Q)
(Δ1 |={E1,E2}=> Q).
Proof.
intros ??? Hfill ? HQ.
rewrite -(idemp uPred_and Δ1).
rewrite {2}(envs_lookup_sound' Δ1 _). 2: exact H1.
rewrite uPred.sep_elim_l uPred.always_and_sep_r comm.