Commit 75cfa329 authored by Amin Timany's avatar Amin Timany

Simplify env_subst

parent 76c60e8f
...@@ -23,7 +23,7 @@ Section fundamental. ...@@ -23,7 +23,7 @@ Section fundamental.
induction 1; iIntros (Δ vs HΔ) "#HΓ"; cbn. induction 1; iIntros (Δ vs HΔ) "#HΓ"; cbn.
- (* var *) - (* var *)
iDestruct (interp_env_Some_l with "HΓ") as (v) "[% ?]"; first done. iDestruct (interp_env_Some_l with "HΓ") as (v) "[% ?]"; first done.
rewrite /env_subst. simplify_option_eq. by iApply wp_value. erewrite env_subst_lookup; eauto. by iApply wp_value.
- (* unit *) by iApply wp_value. - (* unit *) by iApply wp_value.
- (* pair *) - (* pair *)
smart_wp_bind (PairLCtx e2.[env_subst vs]) v "# Hv" IHtyped1. smart_wp_bind (PairLCtx e2.[env_subst vs]) v "# Hv" IHtyped1.
...@@ -48,16 +48,14 @@ Section fundamental. ...@@ -48,16 +48,14 @@ Section fundamental.
iDestruct (interp_env_length with "HΓ") as %?. iDestruct (interp_env_length with "HΓ") as %?.
iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as (w) "[% Hw]"; simplify_eq/=. iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as (w) "[% Hw]"; simplify_eq/=.
+ iApply wp_pure_step_later; auto; asimpl. iNext. + iApply wp_pure_step_later; auto; asimpl. iNext.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped2 Δ (w :: vs)). iApply interp_env_cons; auto. iApply (IHtyped2 Δ (w :: vs)). iApply interp_env_cons; auto.
+ iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext. + iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped3 Δ (w :: vs)). iApply interp_env_cons; auto. iApply (IHtyped3 Δ (w :: vs)). iApply interp_env_cons; auto.
- (* lam *) - (* lam *)
iApply wp_value; simpl; iAlways; iIntros (w) "#Hw". iApply wp_value; simpl; iAlways; iIntros (w) "#Hw".
iDestruct (interp_env_length with "HΓ") as %?. iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext. iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
asimpl. erewrite typed_subst_head_simpl by naive_solver. asimpl.
iApply (IHtyped Δ (w :: vs)). iApply interp_env_cons; auto. iApply (IHtyped Δ (w :: vs)). iApply interp_env_cons; auto.
- (* app *) - (* app *)
smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHtyped1. smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHtyped1.
......
...@@ -10,7 +10,7 @@ Proof. ...@@ -10,7 +10,7 @@ Proof.
intros Hlog ??. cut (adequate NotStuck e σ (λ _ _, True)); first (intros [_ ?]; eauto). intros Hlog ??. cut (adequate NotStuck e σ (λ _ _, True)); first (intros [_ ?]; eauto).
eapply (wp_adequacy Σ); eauto. eapply (wp_adequacy Σ); eauto.
iIntros (Hinv ?). iModIntro. iExists (λ _ _, True%I). iSplit=> //. iIntros (Hinv ?). iModIntro. iExists (λ _ _, True%I). iSplit=> //.
rewrite -(empty_env_subst e). replace e with e.[env_subst[]] by by asimpl.
set (HΣ := IrisG _ _ Hinv (λ _ _ _, True)%I (λ _, True)%I). set (HΣ := IrisG _ _ Hinv (λ _ _ _, True)%I (λ _, True)%I).
iApply (wp_wand with "[]"). iApply Hlog; eauto. by iApply interp_env_nil. auto. iApply (wp_wand with "[]"). iApply Hlog; eauto. by iApply interp_env_nil. auto.
Qed. Qed.
......
...@@ -48,18 +48,18 @@ Proof. ...@@ -48,18 +48,18 @@ Proof.
induction Htyped => s1 s2 Hs; f_equal/=; eauto using lookup_lt_Some with lia. induction Htyped => s1 s2 Hs; f_equal/=; eauto using lookup_lt_Some with lia.
Qed. Qed.
Definition env_subst (vs : list val) (x : var) : expr := Fixpoint env_subst (vs : list val) : var expr :=
from_option id (Var x) (of_val <$> vs !! x). match vs with
| [] => ids
| v :: vs' => #v .: env_subst vs'
end.
Lemma typed_subst_head_simpl Δ τ e w ws : Lemma env_subst_lookup vs x v :
Δ e : τ length Δ = S (length ws) vs !! x = Some v env_subst vs x = of_val v.
e.[# w .: env_subst ws] = e.[env_subst (w :: ws)].
Proof. Proof.
intros H1 H2. rewrite /env_subst. revert vs; induction x => vs.
eapply typed_subst_invariant; eauto=> /= -[|x] ? //=. - by destruct vs; inversion 1.
destruct (lookup_lt_is_Some_2 ws x) as [v' ?]; first lia. - destruct vs as [|w vs]; first by inversion 1.
by simplify_option_eq. rewrite -lookup_tail /=.
Qed. apply IHx.
Qed.
Lemma empty_env_subst e : e.[env_subst []] = e. \ No newline at end of file
Proof. change (env_subst []) with (@ids expr _). by asimpl. Qed.
...@@ -22,7 +22,7 @@ Section fundamental. ...@@ -22,7 +22,7 @@ Section fundamental.
induction 1; iIntros (Δ vs HΔ) "#HΓ /=". induction 1; iIntros (Δ vs HΔ) "#HΓ /=".
- (* var *) - (* var *)
iDestruct (interp_env_Some_l with "HΓ") as (v) "[% ?]"; first done. iDestruct (interp_env_Some_l with "HΓ") as (v) "[% ?]"; first done.
rewrite /env_subst. simplify_option_eq. by iApply wp_value. erewrite env_subst_lookup; eauto. by iApply wp_value.
- (* unit *) by iApply wp_value. - (* unit *) by iApply wp_value.
- (* pair *) - (* pair *)
smart_wp_bind (PairLCtx e2.[env_subst vs]) v "#Hv" IHtyped1. smart_wp_bind (PairLCtx e2.[env_subst vs]) v "#Hv" IHtyped1.
...@@ -47,16 +47,14 @@ Section fundamental. ...@@ -47,16 +47,14 @@ Section fundamental.
iDestruct (interp_env_length with "HΓ") as %?. iDestruct (interp_env_length with "HΓ") as %?.
iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as (w) "[% Hw]"; simplify_eq/=. iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as (w) "[% Hw]"; simplify_eq/=.
+ iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext. + iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped2 Δ (w :: vs)). iApply interp_env_cons; auto. iApply (IHtyped2 Δ (w :: vs)). iApply interp_env_cons; auto.
+ iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext. + iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped3 Δ (w :: vs)). iApply interp_env_cons; auto. iApply (IHtyped3 Δ (w :: vs)). iApply interp_env_cons; auto.
- (* lam *) - (* lam *)
iApply wp_value. simpl. iAlways. iIntros (w) "#Hw". iApply wp_value. simpl. iAlways. iIntros (w) "#Hw".
iDestruct (interp_env_length with "HΓ") as %?. iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext. iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
asimpl. erewrite typed_subst_head_simpl by naive_solver. asimpl.
iApply (IHtyped Δ (w :: vs)). iApply interp_env_cons; auto. iApply (IHtyped Δ (w :: vs)). iApply interp_env_cons; auto.
- (* app *) - (* app *)
smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHtyped1. smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHtyped1.
......
...@@ -48,8 +48,9 @@ Section fundamental. ...@@ -48,8 +48,9 @@ Section fundamental.
Γ !! x = Some τ Γ Var x log Var x : τ. Γ !! x = Some τ Γ Var x log Var x : τ.
Proof. Proof.
iIntros (? Δ vvs ρ ?) "[#Hρ #HΓ]". iIntros (K) "Hj /=". iIntros (? Δ vvs ρ ?) "[#Hρ #HΓ]". iIntros (K) "Hj /=".
iDestruct (interp_env_Some_l with "HΓ") as ([v v']) "[% Hv]"; first done. iDestruct (interp_env_Some_l with "HΓ") as ([v v']) "[Heq Hv]"; first done.
rewrite /env_subst !list_lookup_fmap; simplify_option_eq. iDestruct "Heq" as %Heq.
erewrite !env_subst_lookup; rewrite ?list_lookup_fmap ?Heq; eauto.
iApply wp_value; auto. iApply wp_value; auto.
Qed. Qed.
...@@ -137,15 +138,15 @@ Section fundamental. ...@@ -137,15 +138,15 @@ Section fundamental.
iDestruct "Hiv" as "[Hiv|Hiv]". iDestruct "Hiv" as "[Hiv|Hiv]".
- iDestruct "Hiv" as ([w w']) "[% Hw]"; simplify_eq. - iDestruct "Hiv" as ([w w']) "[% Hw]"; simplify_eq.
iMod (step_case_inl _ _ K (of_val w') with "* [-]") as "Hz"; eauto. iMod (step_case_inl _ _ K (of_val w') with "* [-]") as "Hz"; eauto.
simpl.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext. iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
asimpl. erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto). asimpl. iApply ('`IHHtyped2 _ ((w,w') :: vvs)); repeat iSplit; eauto.
iApply ('`IHHtyped2 _ ((w,w') :: vvs)); repeat iSplit; eauto.
iApply interp_env_cons; auto. iApply interp_env_cons; auto.
- iDestruct "Hiv" as ([w w']) "[% Hw]"; simplify_eq. - iDestruct "Hiv" as ([w w']) "[% Hw]"; simplify_eq.
iMod (step_case_inr _ _ K (of_val w') with "* [-]") as "Hz"; eauto. iMod (step_case_inr _ _ K (of_val w') with "* [-]") as "Hz"; eauto.
simpl.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext. iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
asimpl. erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto). asimpl. iApply ('`IHHtyped3 _ ((w,w') :: vvs)); repeat iSplit; eauto.
iApply ('`IHHtyped3 _ ((w,w') :: vvs)); repeat iSplit; eauto.
iApply interp_env_cons; auto. iApply interp_env_cons; auto.
Qed. Qed.
...@@ -161,8 +162,7 @@ Section fundamental. ...@@ -161,8 +162,7 @@ Section fundamental.
iDestruct (interp_env_length with "HΓ") as %?. iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext. iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
iMod (step_lam _ _ K' _ (of_val v') with "* [-]") as "Hz"; eauto. iMod (step_lam _ _ K' _ (of_val v') with "* [-]") as "Hz"; eauto.
asimpl. erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto). asimpl. iApply ('`IHHtyped _ ((v,v') :: vvs)); repeat iSplit; eauto.
iApply ('`IHHtyped _ ((v,v') :: vvs)); repeat iSplit; eauto.
iApply interp_env_cons; iSplit; auto. iApply interp_env_cons; iSplit; auto.
Qed. Qed.
......
...@@ -21,7 +21,7 @@ Proof. ...@@ -21,7 +21,7 @@ Proof.
iModIntro. iExists (λ σ _, own γ ( to_gen_heap σ)); iFrame. iModIntro. iExists (λ σ _, own γ ( to_gen_heap σ)); iFrame.
set (HeapΣ := (HeapG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))). set (HeapΣ := (HeapG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
iApply (wp_wand with "[]"). iApply (wp_wand with "[]").
- rewrite -(empty_env_subst e). - replace e with e.[env_subst[]] by by asimpl.
iApply (Hlog HeapΣ [] []). iApply (@interp_env_nil _ HeapΣ). iApply (Hlog HeapΣ [] []). iApply (@interp_env_nil _ HeapΣ).
- auto. - auto.
Qed. Qed.
...@@ -32,8 +32,8 @@ Corollary type_soundness e τ e' thp σ σ' : ...@@ -32,8 +32,8 @@ Corollary type_soundness e τ e' thp σ σ' :
is_Some (to_val e') reducible e' σ'. is_Some (to_val e') reducible e' σ'.
Proof. Proof.
intros ??. set (Σ := #[invΣ ; gen_heapΣ loc val]). intros ??. set (Σ := #[invΣ ; gen_heapΣ loc val]).
set (HG := HeapPreG Σ _ _). set (HG := HeapPreG Σ _ _).
eapply (soundness Σ). eapply (soundness Σ).
- intros ?. by apply fundamental. - intros ?. by apply fundamental.
- eauto. - eauto.
Qed. Qed.
...@@ -30,8 +30,9 @@ Proof. ...@@ -30,8 +30,9 @@ Proof.
iApply wp_fupd. iApply (wp_wand with "[-]"). iApply wp_fupd. iApply (wp_wand with "[-]").
- iPoseProof (Hlog _ _ with "[$Hcfg]") as "Hrel". - iPoseProof (Hlog _ _ with "[$Hcfg]") as "Hrel".
{ iApply (@logrel_binary.interp_env_nil Σ HeapΣ). } { iApply (@logrel_binary.interp_env_nil Σ HeapΣ). }
rewrite (empty_env_subst e). iApply ("Hrel" $! []). replace e with e.[env_subst[]] at 2 by by asimpl.
rewrite /tpool_mapsto (empty_env_subst e'). asimpl. iFrame. iApply ("Hrel" $! []).
rewrite /tpool_mapsto. asimpl. iFrame.
- iModIntro. iIntros (v'). iDestruct 1 as (v2) "[Hj #Hinterp]". - iModIntro. iIntros (v'). iDestruct 1 as (v2) "[Hj #Hinterp]".
iInv specN as ">Hinv" "Hclose". iInv specN as ">Hinv" "Hclose".
iDestruct "Hinv" as (e'' σ) "[Hown %]". iDestruct "Hinv" as (e'' σ) "[Hown %]".
......
...@@ -87,9 +87,21 @@ Proof. ...@@ -87,9 +87,21 @@ Proof.
asimpl; rewrite H1; auto with lia. asimpl; rewrite H1; auto with lia.
Qed. Qed.
Definition env_subst (vs : list val) (x : var) : expr := Fixpoint env_subst (vs : list val) : var expr :=
from_option id (Var x) (of_val <$> vs !! x). match vs with
| [] => ids
| v :: vs' => #v .: env_subst vs'
end.
Lemma env_subst_lookup vs x v :
vs !! x = Some v env_subst vs x = of_val v.
Proof.
revert vs; induction x => vs.
- by destruct vs; inversion 1.
- destruct vs as [|w vs]; first by inversion 1.
rewrite -lookup_tail /=.
apply IHx.
Qed.
Lemma typed_n_closed Γ τ e : Γ e : τ ( f, e.[upn (length Γ) f] = e). Lemma typed_n_closed Γ τ e : Γ e : τ ( f, e.[upn (length Γ) f] = e).
Proof. Proof.
intros H. induction H => f; asimpl; simpl in *; auto with f_equal. intros H. induction H => f; asimpl; simpl in *; auto with f_equal.
...@@ -97,40 +109,6 @@ Proof. ...@@ -97,40 +109,6 @@ Proof.
- by f_equal; rewrite map_length in IHtyped. - by f_equal; rewrite map_length in IHtyped.
Qed. Qed.
Lemma n_closed_subst_head_simpl n e w ws :
( f, e.[upn n f] = e)
S (length ws) = n
e.[of_val w .: env_subst ws] = e.[env_subst (w :: ws)].
Proof.
intros H1 H2.
rewrite /env_subst. eapply n_closed_invariant; eauto=> /= -[|x] ? //=.
destruct (lookup_lt_is_Some_2 ws x) as [v' Hv]; first lia; simpl.
by rewrite Hv.
Qed.
Lemma typed_subst_head_simpl Δ τ e w ws :
Δ e : τ length Δ = S (length ws)
e.[of_val w .: env_subst ws] = e.[env_subst (w :: ws)].
Proof. eauto using n_closed_subst_head_simpl, typed_n_closed. Qed.
Lemma n_closed_subst_head_simpl_2 n e w w' ws :
( f, e.[upn n f] = e) (S (S (length ws))) = n
e.[of_val w .: of_val w' .: env_subst ws] = e.[env_subst (w :: w' :: ws)].
Proof.
intros H1 H2.
rewrite /env_subst. eapply n_closed_invariant; eauto => /= -[|[|x]] H3 //=.
destruct (lookup_lt_is_Some_2 ws x) as [v' Hv]; first lia; simpl.
by rewrite Hv.
Qed.
Lemma typed_subst_head_simpl_2 Δ τ e w w' ws :
Δ e : τ length Δ = 2 + length ws
e.[of_val w .: of_val w' .: env_subst ws] = e.[env_subst (w :: w' :: ws)].
Proof. eauto using n_closed_subst_head_simpl_2, typed_n_closed. Qed.
Lemma empty_env_subst e : e.[env_subst []] = e.
Proof. change (env_subst []) with (@ids expr _). by asimpl. Qed.
(** Weakening *) (** Weakening *)
Lemma context_gen_weakening ξ Γ' Γ e τ : Lemma context_gen_weakening ξ Γ' Γ e τ :
Γ' ++ Γ e : τ Γ' ++ Γ e : τ
......
...@@ -76,7 +76,6 @@ Section fact_equiv. ...@@ -76,7 +76,6 @@ Section fact_equiv.
Proof. Proof.
iIntros (? vs ρ _) "[#HE HΔ]". iIntros (? vs ρ _) "[#HE HΔ]".
iDestruct (interp_env_length with "HΔ") as %?; destruct vs; simplify_eq. iDestruct (interp_env_length with "HΔ") as %?; destruct vs; simplify_eq.
rewrite !empty_env_subst.
iClear "HΔ". simpl. iClear "HΔ". simpl.
iIntros (j K) "Hj"; simpl. iIntros (j K) "Hj"; simpl.
iApply wp_value; iExists (LamV _); iFrame. iApply wp_value; iExists (LamV _); iFrame.
...@@ -155,7 +154,6 @@ Section fact_equiv. ...@@ -155,7 +154,6 @@ Section fact_equiv.
Proof. Proof.
iIntros (? vs ρ _) "[#HE HΔ]". iIntros (? vs ρ _) "[#HE HΔ]".
iDestruct (interp_env_length with "HΔ") as %?; destruct vs; simplify_eq. iDestruct (interp_env_length with "HΔ") as %?; destruct vs; simplify_eq.
rewrite !empty_env_subst.
iClear "HΔ". simpl. iClear "HΔ". simpl.
iIntros (j K) "Hj"; simpl. iIntros (j K) "Hj"; simpl.
iApply wp_value; iExists (RecV _); iFrame. iApply wp_value; iExists (RecV _); iFrame.
......
...@@ -48,8 +48,10 @@ Section fundamental. ...@@ -48,8 +48,10 @@ Section fundamental.
Γ !! x = Some τ Γ Var x log Var x : τ. Γ !! x = Some τ Γ Var x log Var x : τ.
Proof. Proof.
iIntros (? Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=". iIntros (? Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
iDestruct (interp_env_Some_l with "HΓ") as ([v v']) "[% ?]"; first done. iDestruct (interp_env_Some_l with "HΓ") as ([v v']) "[Heq ?]"; first done.
rewrite /env_subst !list_lookup_fmap; simplify_option_eq. iApply wp_value; eauto. iDestruct "Heq" as %Heq.
erewrite !env_subst_lookup; rewrite ?list_lookup_fmap ?Heq; eauto.
iApply wp_value; eauto.
Qed. Qed.
Lemma bin_log_related_unit Γ : Γ Unit log Unit : TUnit. Lemma bin_log_related_unit Γ : Γ Unit log Unit : TUnit.
...@@ -150,14 +152,12 @@ Section fundamental. ...@@ -150,14 +152,12 @@ Section fundamental.
iMod (step_case_inl with "[Hs Hv]") as "Hz"; eauto. iMod (step_case_inl with "[Hs Hv]") as "Hz"; eauto.
iApply wp_pure_step_later; auto. fold of_val. iModIntro. iNext. iApply wp_pure_step_later; auto. fold of_val. iModIntro. iNext.
asimpl. asimpl.
erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto).
iApply ('`IHHtyped2 _ ((w,w') :: vvs)). repeat iSplit; eauto. iApply ('`IHHtyped2 _ ((w,w') :: vvs)). repeat iSplit; eauto.
iApply interp_env_cons; auto. iApply interp_env_cons; auto.
- iApply fupd_wp. - iApply fupd_wp.
iMod (step_case_inr with "[Hs Hv]") as "Hz"; eauto. iMod (step_case_inr with "[Hs Hv]") as "Hz"; eauto.
iApply wp_pure_step_later; auto. fold of_val. iModIntro. iNext. iApply wp_pure_step_later; auto. fold of_val. iModIntro. iNext.
asimpl. asimpl.
erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto).
iApply ('`IHHtyped3 _ ((w,w') :: vvs)); repeat iSplit; eauto. iApply ('`IHHtyped3 _ ((w,w') :: vvs)); repeat iSplit; eauto.
iApply interp_env_cons; auto. iApply interp_env_cons; auto.
Qed. Qed.
...@@ -214,7 +214,6 @@ Section fundamental. ...@@ -214,7 +214,6 @@ Section fundamental.
iApply fupd_wp. iApply fupd_wp.
iMod (step_rec _ _ j' K' _ (of_val v') v' with "* [-]") as "Hz"; eauto. iMod (step_rec _ _ j' K' _ (of_val v') v' with "* [-]") as "Hz"; eauto.
asimpl. change (Rec ?e) with (of_val (RecV e)). asimpl. change (Rec ?e) with (of_val (RecV e)).
erewrite !n_closed_subst_head_simpl_2 by (rewrite ?fmap_length; eauto).
iApply ('`IHHtyped _ ((_,_) :: (v,v') :: vvs)); repeat iSplit; eauto. iApply ('`IHHtyped _ ((_,_) :: (v,v') :: vvs)); repeat iSplit; eauto.
iModIntro. iModIntro.
rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto. rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto.
...@@ -234,7 +233,6 @@ Section fundamental. ...@@ -234,7 +233,6 @@ Section fundamental.
iApply fupd_wp. iApply fupd_wp.
iMod (step_lam _ _ j' K' _ (of_val v') v' with "* [-]") as "Hz"; eauto. iMod (step_lam _ _ j' K' _ (of_val v') v' with "* [-]") as "Hz"; eauto.
asimpl. iFrame "#". change (Lam ?e) with (of_val (LamV e)). asimpl. iFrame "#". change (Lam ?e) with (of_val (LamV e)).
erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto).
iApply ('`IHHtyped _ ((v,v') :: vvs)); repeat iSplit; eauto. iApply ('`IHHtyped _ ((v,v') :: vvs)); repeat iSplit; eauto.
iModIntro. iModIntro.
rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto. rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto.
...@@ -254,7 +252,6 @@ Section fundamental. ...@@ -254,7 +252,6 @@ Section fundamental.
iMod (step_letin _ _ j K with "[-]") as "Hz"; eauto. iMod (step_letin _ _ j K with "[-]") as "Hz"; eauto.
iApply wp_pure_step_later; auto. iModIntro. iApply wp_pure_step_later; auto. iModIntro.
asimpl. asimpl.
erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto).
iApply ('`IHHtyped2 _ ((v, v') :: vvs)); repeat iSplit; eauto. iApply ('`IHHtyped2 _ ((v, v') :: vvs)); repeat iSplit; eauto.
rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto. rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto.
Qed. Qed.
......
...@@ -23,7 +23,8 @@ Section typed_interp. ...@@ -23,7 +23,8 @@ Section typed_interp.
induction 1; iIntros (Δ vs HΔ) "#HΓ /=". induction 1; iIntros (Δ vs HΔ) "#HΓ /=".
- (* var *) - (* var *)
iDestruct (interp_env_Some_l with "HΓ") as (v) "[% ?]"; first done. iDestruct (interp_env_Some_l with "HΓ") as (v) "[% ?]"; first done.
rewrite /env_subst. simplify_option_eq. by iApply wp_value. erewrite env_subst_lookup; eauto.
by iApply wp_value.
- (* unit *) iApply wp_value; trivial. - (* unit *) iApply wp_value; trivial.
- (* nat *) iApply wp_value; simpl; eauto. - (* nat *) iApply wp_value; simpl; eauto.
- (* bool *) iApply wp_value; simpl; eauto. - (* bool *) iApply wp_value; simpl; eauto.
...@@ -57,10 +58,8 @@ Section typed_interp. ...@@ -57,10 +58,8 @@ Section typed_interp.
iDestruct (interp_env_length with "HΓ") as %?. iDestruct (interp_env_length with "HΓ") as %?.
iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as (w) "[% Hw]"; simplify_eq/=. iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as (w) "[% Hw]"; simplify_eq/=.
+ iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext. + iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped2 Δ (w :: vs)). iApply interp_env_cons; auto. iApply (IHtyped2 Δ (w :: vs)). iApply interp_env_cons; auto.
+ iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext. + iApply wp_pure_step_later; auto 1 using to_of_val; asimpl. iNext.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped3 Δ (w :: vs)). iApply interp_env_cons; auto. iApply (IHtyped3 Δ (w :: vs)). iApply interp_env_cons; auto.
- (* If *) - (* If *)
smart_wp_bind (IfCtx _ _) v "#Hv" IHtyped1; cbn. smart_wp_bind (IfCtx _ _) v "#Hv" IHtyped1; cbn.
...@@ -72,7 +71,6 @@ Section typed_interp. ...@@ -72,7 +71,6 @@ Section typed_interp.
iDestruct (interp_env_length with "HΓ") as %?. iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext. iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
asimpl. change (Rec _) with (of_val (RecV e.[upn 2 (env_subst vs)])) at 2. asimpl. change (Rec _) with (of_val (RecV e.[upn 2 (env_subst vs)])) at 2.
erewrite typed_subst_head_simpl_2 by naive_solver.
iApply (IHtyped Δ (_ :: w :: vs)). iApply (IHtyped Δ (_ :: w :: vs)).
iApply interp_env_cons; iSplit; [|iApply interp_env_cons]; auto. iApply interp_env_cons; iSplit; [|iApply interp_env_cons]; auto.
- (* Lam *) - (* Lam *)
...@@ -80,15 +78,13 @@ Section typed_interp. ...@@ -80,15 +78,13 @@ Section typed_interp.
iDestruct (interp_env_length with "HΓ") as %?. iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext. iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
asimpl. asimpl.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped Δ (w :: vs)); auto. iApply (IHtyped Δ (w :: vs)); auto.
iApply interp_env_cons; iSplit; auto. iApply interp_env_cons; iSplit; auto.
- (* LetIn *) - (* LetIn *)
smart_wp_bind (LetInCtx _) v "#Hv" IHtyped1; cbn. smart_wp_bind (LetInCtx _) v "#Hv" IHtyped1; cbn.
iDestruct (interp_env_length with "HΓ") as %?. iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext. iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
asimpl. erewrite typed_subst_head_simpl by naive_solver. asimpl. iApply (IHtyped2 Δ (v :: vs)).
iApply (IHtyped2 Δ (v :: vs)).
iApply interp_env_cons; iSplit; eauto. iApply interp_env_cons; iSplit; eauto.
- (* Seq *) - (* Seq *)
smart_wp_bind (SeqCtx _) v "#Hv" IHtyped1; cbn. smart_wp_bind (SeqCtx _) v "#Hv" IHtyped1; cbn.
......
...@@ -29,8 +29,9 @@ Proof. ...@@ -29,8 +29,9 @@ Proof.
iPoseProof ((Hlog _ _ [] [] ([e'], )) with "[$Hcfg]") as "Hrel". iPoseProof ((Hlog _ _ [] [] ([e'], )) with "[$Hcfg]") as "Hrel".
{ iApply (@logrel_binary.interp_env_nil Σ HeapΣ). } { iApply (@logrel_binary.interp_env_nil Σ HeapΣ). }
simpl. simpl.
rewrite empty_env_subst empty_env_subst. iApply ("Hrel" $! 0 []). replace e with e.[env_subst[]] at 2 by by asimpl.
{ rewrite /tpool_mapsto. iAsimpl. by iFrame. } iApply ("Hrel" $! 0 []).
{ rewrite /tpool_mapsto. asimpl. by iFrame. }
iModIntro. iIntros (v1); iDestruct 1 as (v2) "[Hj #Hinterp]". iModIntro. iIntros (v1); iDestruct 1 as (v2) "[Hj #Hinterp]".
iInv specN as (tp σ) ">[Hown Hsteps]" "Hclose"; iDestruct "Hsteps" as %Hsteps'. iInv specN as (tp σ) ">[Hown Hsteps]" "Hclose"; iDestruct "Hsteps" as %Hsteps'.
rewrite /tpool_mapsto /=. rewrite /tpool_mapsto /=.
......
...@@ -20,7 +20,7 @@ Proof. ...@@ -20,7 +20,7 @@ Proof.
iModIntro. iExists (λ σ _, own γ ( to_gen_heap σ)); iFrame. iModIntro. iExists (λ σ _, own γ ( to_gen_heap σ)); iFrame.
set (HeapΣ := (HeapIG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))). set (HeapΣ := (HeapIG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
iApply (wp_wand with "[]"). iApply (wp_wand with "[]").
- rewrite -(empty_env_subst e). - replace e with e.[env_subst[]] by by asimpl.
iApply (Hlog HeapΣ [] []). iApply (@interp_env_nil _ HeapΣ). iApply (Hlog HeapΣ [] []). iApply (@interp_env_nil _ HeapΣ).
- eauto. - eauto.
Qed. Qed.
......
...@@ -123,8 +123,21 @@ Proof. ...@@ -123,8 +123,21 @@ Proof.
asimpl; rewrite H1; auto with lia. asimpl; rewrite H1; auto with lia.
Qed. Qed.
Definition env_subst (vs : list val) (x : var) : expr := Fixpoint env_subst (vs : list val) : var expr :=
from_option id (Var x) (of_val <$> vs !! x). match vs with
| [] => ids