RunST.lam_beta.lam_beta_part2
From RunST Require Import IC base lang rules typing reduction regions
future contextual_refinement saved_pred ST_Lang_reduction
logrel_shared soundness logrel fundamental.
From iris.proofmode Require Import tactics.
Hint Resolve to_of_val.
Lemma lam_beta_push_lam_2 F Γ e2' τ e1 e2 τ1' τ2' τ'' :
(∀ e2, ∃ K, ∀ e1, F e1 e2 = fill_item K e1) →
(∀ v1, ∃ K, ∀ e2, F (of_val v1) e2 = fill_item K e2) →
(∀ f e1 e2, (F e1 e2).[f] = F e1.[f] e2.[f]) →
(∀ Γ e1 e2, Γ ⊢ₜ e1 : τ1' → Γ ⊢ₜ e2 : τ2' → Γ ⊢ₜ F e1 e2 : τ'') →
(∀ `{ICG_ST Σ} `{LogRelG Σ} Δ (HΔ : env_PersistentP Δ) v1 v1' v2 v2',
reg_inv ∧ ⟦τ1'⟧ Δ (v1, v1') ★ ⟦τ2'⟧ Δ (v2, v2') ⊢
⟦τ''⟧ₑ Δ (F (of_val v1) (of_val v2), F (of_val v1') (of_val v2'))) →
τ :: Γ ⊢ₜ e1 : τ1' →
τ :: Γ ⊢ₜ e2 : τ2' →
Γ ⊢ₜ e2' : τ →
Γ ⊨ App (Rec (F e1 e2).[ren (+1)]) e2'
≤ctx≤ F (App (Rec e1.[ren (+1)]) e2') (App (Rec e2.[ren (+1)]) e2') : τ''.
Proof.
intros HK1 HK2 Hsubst Htp HLR Ht1 Ht2 Ht2'.
apply binary_soundness.
{ repeat econstructor; eauto;
apply (context_weakening [_]); eauto. }
{ apply Htp; repeat econstructor; eauto;
apply (context_weakening [_]); eauto. }
iIntros (Σ ST Hlr Δ vvs HΔ) "[#Hinv #Hvvs]"; asimpl.
iDestruct (interp_env_length with "[]") as %Hvvsl; eauto.
iIntros (γh γh' σ1') "Hσ1' /=".
rewrite ic_eq /ic_def.
iIntros (σ1 σ2 vf n) "(Hrd & Hσ1)".
iDestruct "Hrd" as %Hrd.
apply (nsteps_bind (fill_item (AppRCtx (RecV _)))) in Hrd.
destruct Hrd as (k1 & σ3 & w2 & Hk1 & Hrd1 & Hrd2). simpl in *.
apply rec_red_step in Hrd2.
destruct Hrd2 as (m & Hm & Hrd2).
asimpl in Hrd2.
rewrite Hsubst in Hrd2.
repeat (erewrite typed_subst_head_simpl in Hrd2; eauto;
last by rewrite /= !fmap_length Hvvsl).
edestruct HK1 as (K1 & HK1eq); erewrite HK1eq in Hrd2.
apply (nsteps_bind (fill_item K1)) in Hrd2.
destruct Hrd2 as (k2 & σ4 & w1 & Hk2 & Hrd21 & Hrd22). simpl in *.
rewrite -HK1eq in Hrd22.
edestruct HK2 as (K2 & HK2eq); erewrite HK2eq in Hrd22.
apply (nsteps_bind (fill_item K2)) in Hrd22.
destruct Hrd22 as (k3 & σ5 & w3 & Hk3 & Hrd221 & Hrd222). simpl in *.
rewrite -HK2eq in Hrd222.
set (Q := (|={⊤}=> Nat.iter k1 (λ Q, ▷ Q) (◇ (∃ (σ3' : state) (w2' : val),
■ (rtc (pstep' det_lang)
(e2'.[env_subst (vvs.*2)], σ1') (of_val w2', σ3')))))%I : iProp Σ).
iAssert Q as "HQ".
{ unfold Q.
iMod (allocate_full_state σ1) as (γh3) "[Hfσ1 Hnσ1]".
iMod (allocate_full_state σ1') as (γh4) "[Hfσ1' Hnσ1']".
iPoseProof (binary_fundamental _ _ _ Ht2' Δ vvs HΔ with "[]") as "Hrel";
first iFrame "#".
iSpecialize ("Hrel" $! _ _ _ with "[$Hfσ1']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("Hrel" $! _ _ _ _ with "[$Hfσ1]"); auto.
iApply (future_plain with "[-]").
iMod "Hrel" as "[Hrel _]". iModIntro.
iDestruct "Hrel" as (σ3' ?) "(Hrd2&Hσ3'&?)".
iDestruct "Hrd2" as %Hrd2.
iExists _, _; iPureIntro; repeat split; eauto. }
iMod "HQ" as "#HQ". iModIntro. clear Q.
rewrite later_n_except_0_exist. iDestruct "HQ" as (σ3') "HQ".
rewrite later_n_except_0_exist. iDestruct "HQ" as (w2') "HQ".
set (Q := (|={⊤}=> Nat.iter (k1 + k2) (λ Q, ▷ Q) (◇ (∃ (σ4' : state) (w1' : val),
■ (rtc (pstep' det_lang)
(e1.[env_subst (w2' :: vvs.*2)], σ3') (of_val w1', σ4')))))%I : iProp Σ).
iAssert Q as "HQ2".
{ unfold Q.
iMod (allocate_full_state σ1) as (γh3) "[Hfσ1 Hnσ1]".
iMod (allocate_full_state σ1') as (γh4) "[Hfσ1' Hnσ1']".
iPoseProof (binary_fundamental _ _ _ Ht2' Δ vvs HΔ with "[]") as "Hrel";
first iFrame "#".
iSpecialize ("Hrel" $! _ _ _ with "[$Hfσ1']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("Hrel" $! _ _ _ _ with "[$Hfσ1]"); auto.
iApply (future_plain with "[-]").
iDestruct (later_n_except_0_future with "[$HQ]") as "HQ'".
iCombine "Hrel" "HQ'" as "Hrel".
iMod "Hrel" as "[[Hrel Hσ3] HQ']". iDestruct "HQ'" as %HQ.
iDestruct "Hrel" as (σ3'' w2'') "(Hrd2&Hσ3''&#Hww2)".
iDestruct "Hrd2" as %Hrd2.
apply rtc_nsteps in HQ. destruct HQ as [n1 HQ].
apply rtc_nsteps in Hrd2. destruct Hrd2 as [n2 Hrd2].
destruct (nsteps_deterministic' Hrd2 HQ) as [? [? ?]]; subst.
iPoseProof (binary_fundamental _ _ _ Ht1 Δ ((w2, w2') :: vvs) HΔ with "[]")
as "Hrel"; first by rewrite interp_env_cons; iFrame "#".
iSpecialize ("Hrel" $! _ _ _ with "[$Hσ3'']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("Hrel" $! _ _ _ _ with "[$Hσ3]"); auto.
iMod "Hrel" as "[Hrel _]".
iDestruct "Hrel" as (σ4' w1') "(Hrd3&Hσ4'&?)".
iDestruct "Hrd3" as %Hrd3. iModIntro.
iExists _, _; iPureIntro; repeat split; eauto. }
iMod "HQ2" as "#HQ2". iModIntro. clear Q.
rewrite later_n_except_0_exist. iDestruct "HQ2" as (σ4') "HQ2".
rewrite later_n_except_0_exist. iDestruct "HQ2" as (w1') "HQ2".
iDestruct (later_n_except_0_future with "[$HQ]") as "HQ3".
iDestruct (later_n_except_0_future with "[$HQ2]") as "HQ4".
iClear "HQ HQ2".
iPoseProof (binary_fundamental _ _ _ Ht2' Δ vvs HΔ with "[]") as "He21";
first iFrame "#".
iSpecialize ("He21" $! _ _ _ with "[$Hσ1']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("He21" $! _ _ _ _ with "[$Hσ1]"); auto.
iMod (allocate_full_state σ1) as (γh3) "[Hfσ1 _]".
iMod (allocate_full_state σ4') as (γh4) "[Hfσ4' Hnσ4']".
iPoseProof (binary_fundamental _ _ _ Ht2' Δ vvs HΔ with "[]") as "He22";
first iFrame "#".
iSpecialize ("He22" $! _ _ _ with "[$Hfσ4']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("He22" $! _ _ _ _ with "[$Hfσ1]"); auto.
iCombine "HQ3" "He21" as "He21". iCombine "He21" "He22" as "He2".
iPoseProof (future_cancel_2 with "[He2 HQ4]") as "He"; first trivial.
{ iSplitL "HQ4"; iFrame. }
iMod "He" as "(HQ' & [HQ [He21 Hσ3]] & [He22 Hfσ3])".
iDestruct "HQ" as %HQ.
apply rtc_nsteps in HQ. destruct HQ as [n1 HQ].
iDestruct "He21" as (σ3'' w2'') "(Hrd2 & Hσ3' & #Hww2)".
iDestruct "Hrd2" as %Hrd2.
apply rtc_nsteps in Hrd2. destruct Hrd2 as [n2 Hrd2].
destruct (nsteps_deterministic' Hrd2 HQ) as [? [? ?]]; subst.
iDestruct "He22" as (σ5' w2'') "(Hrd3 & Hσ5' & #Hww2')".
iDestruct "Hrd3" as %Hrd3.
apply rtc_nsteps in Hrd3. destruct Hrd3 as [n3 Hrd3].
replace (k1 + k2 - k1) with k2 by omega.
iDestruct (heap_included with "[$Hnσ4' $Hσ5']") as %[Hincl Hvl].
iClear "Hnσ4' Hσ5' Hfσ3".
iPoseProof (binary_fundamental _ _ _ Ht1 Δ ((w2, w2') :: vvs) HΔ with "[]")
as "He1"; first by rewrite interp_env_cons; iFrame "#".
iSpecialize ("He1" $! _ _ _ with "[$Hσ3']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("He1" $! _ _ _ _ with "[$Hσ3]"); auto.
iCombine "HQ'" "He1" as "He1".
iMod "He1" as "[HQ' [He1 Hσ4]]".
iDestruct "HQ'" as %HQ'.
apply rtc_nsteps in HQ'. destruct HQ' as [n1' HQ'].
iDestruct "He1" as (σ4'' w1'') "(Hrd4 & Hσ4' & #Hww1)".
iDestruct "Hrd4" as %Hrd4.
apply rtc_nsteps in Hrd4. destruct Hrd4 as [n4 Hrd4].
destruct (nsteps_deterministic' Hrd4 HQ') as [? [? ?]]; subst.
iMod (heap_catch_up with "Hσ4'") as "Hσ5'"; eauto.
iPoseProof (binary_fundamental _ _ _ Ht2 Δ ((w2, w2'') :: vvs) HΔ with "[]")
as "He2"; first by rewrite interp_env_cons; iFrame "#".
iSpecialize ("He2" $! _ _ _ with "[$Hσ5']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("He2" $! _ _ _ _ with "[$Hσ4]"); auto.
iMod "He2" as "[He2 Hσ5]".
iDestruct "He2" as (σ6' w3') "(Hrd5 & Hσ6' & #Hww3)".
iDestruct "Hrd5" as %Hrd5.
apply rtc_nsteps in Hrd5. destruct Hrd5 as [n5 Hrd5].
iPoseProof (HLR with "[]") as "Hlr"; first iFrame "#".
iSpecialize ("Hlr" $! _ _ _ with "[$Hσ6']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("Hlr" $! _ _ _ _ with "[$Hσ5]"); auto.
iMod "Hlr" as "[Hlr Hσ6]".
iDestruct "Hlr" as (σ7' vf') "(Hrd6 & Hσ7' & #Hvvf)".
iDestruct "Hrd6" as %Hrd6.
apply rtc_nsteps in Hrd6. destruct Hrd6 as [n6 Hrd6].
iModIntro; iFrame.
iExists _, _; iFrame; iFrame "#".
iPureIntro.
rewrite Hsubst. asimpl.
edestruct HK1 as (K1' & HK1'eq); erewrite HK1'eq.
edestruct (HK2 w1') as (K2' & HK2'eq).
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K1'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang).
eapply (@nsteps_ctx det_lang (fill_item (AppRCtx (RecV _))));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang). }
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K1'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang).
eapply (nsteps_l _ _ (_, _) (_, _)); simpl.
{ apply head_prim_step. econstructor; eauto. }
asimpl. econstructor. }
erewrite typed_subst_head_simpl; eauto;
last by rewrite /= !fmap_length Hvvsl.
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K1'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang). }
rewrite -HK1'eq HK2'eq.
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K2'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang).
eapply (@nsteps_ctx det_lang (fill_item (AppRCtx (RecV _))));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang). }
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K2'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang).
eapply (nsteps_l _ _ (_, _) (_, _)); simpl.
{ apply head_prim_step. econstructor; eauto. }
asimpl. econstructor. }
erewrite typed_subst_head_simpl; eauto;
last by rewrite /= !fmap_length Hvvsl.
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K2'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang). }
rewrite -HK2'eq.
eapply (nsteps_rtc _); eauto.
Qed.
future contextual_refinement saved_pred ST_Lang_reduction
logrel_shared soundness logrel fundamental.
From iris.proofmode Require Import tactics.
Hint Resolve to_of_val.
Lemma lam_beta_push_lam_2 F Γ e2' τ e1 e2 τ1' τ2' τ'' :
(∀ e2, ∃ K, ∀ e1, F e1 e2 = fill_item K e1) →
(∀ v1, ∃ K, ∀ e2, F (of_val v1) e2 = fill_item K e2) →
(∀ f e1 e2, (F e1 e2).[f] = F e1.[f] e2.[f]) →
(∀ Γ e1 e2, Γ ⊢ₜ e1 : τ1' → Γ ⊢ₜ e2 : τ2' → Γ ⊢ₜ F e1 e2 : τ'') →
(∀ `{ICG_ST Σ} `{LogRelG Σ} Δ (HΔ : env_PersistentP Δ) v1 v1' v2 v2',
reg_inv ∧ ⟦τ1'⟧ Δ (v1, v1') ★ ⟦τ2'⟧ Δ (v2, v2') ⊢
⟦τ''⟧ₑ Δ (F (of_val v1) (of_val v2), F (of_val v1') (of_val v2'))) →
τ :: Γ ⊢ₜ e1 : τ1' →
τ :: Γ ⊢ₜ e2 : τ2' →
Γ ⊢ₜ e2' : τ →
Γ ⊨ App (Rec (F e1 e2).[ren (+1)]) e2'
≤ctx≤ F (App (Rec e1.[ren (+1)]) e2') (App (Rec e2.[ren (+1)]) e2') : τ''.
Proof.
intros HK1 HK2 Hsubst Htp HLR Ht1 Ht2 Ht2'.
apply binary_soundness.
{ repeat econstructor; eauto;
apply (context_weakening [_]); eauto. }
{ apply Htp; repeat econstructor; eauto;
apply (context_weakening [_]); eauto. }
iIntros (Σ ST Hlr Δ vvs HΔ) "[#Hinv #Hvvs]"; asimpl.
iDestruct (interp_env_length with "[]") as %Hvvsl; eauto.
iIntros (γh γh' σ1') "Hσ1' /=".
rewrite ic_eq /ic_def.
iIntros (σ1 σ2 vf n) "(Hrd & Hσ1)".
iDestruct "Hrd" as %Hrd.
apply (nsteps_bind (fill_item (AppRCtx (RecV _)))) in Hrd.
destruct Hrd as (k1 & σ3 & w2 & Hk1 & Hrd1 & Hrd2). simpl in *.
apply rec_red_step in Hrd2.
destruct Hrd2 as (m & Hm & Hrd2).
asimpl in Hrd2.
rewrite Hsubst in Hrd2.
repeat (erewrite typed_subst_head_simpl in Hrd2; eauto;
last by rewrite /= !fmap_length Hvvsl).
edestruct HK1 as (K1 & HK1eq); erewrite HK1eq in Hrd2.
apply (nsteps_bind (fill_item K1)) in Hrd2.
destruct Hrd2 as (k2 & σ4 & w1 & Hk2 & Hrd21 & Hrd22). simpl in *.
rewrite -HK1eq in Hrd22.
edestruct HK2 as (K2 & HK2eq); erewrite HK2eq in Hrd22.
apply (nsteps_bind (fill_item K2)) in Hrd22.
destruct Hrd22 as (k3 & σ5 & w3 & Hk3 & Hrd221 & Hrd222). simpl in *.
rewrite -HK2eq in Hrd222.
set (Q := (|={⊤}=> Nat.iter k1 (λ Q, ▷ Q) (◇ (∃ (σ3' : state) (w2' : val),
■ (rtc (pstep' det_lang)
(e2'.[env_subst (vvs.*2)], σ1') (of_val w2', σ3')))))%I : iProp Σ).
iAssert Q as "HQ".
{ unfold Q.
iMod (allocate_full_state σ1) as (γh3) "[Hfσ1 Hnσ1]".
iMod (allocate_full_state σ1') as (γh4) "[Hfσ1' Hnσ1']".
iPoseProof (binary_fundamental _ _ _ Ht2' Δ vvs HΔ with "[]") as "Hrel";
first iFrame "#".
iSpecialize ("Hrel" $! _ _ _ with "[$Hfσ1']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("Hrel" $! _ _ _ _ with "[$Hfσ1]"); auto.
iApply (future_plain with "[-]").
iMod "Hrel" as "[Hrel _]". iModIntro.
iDestruct "Hrel" as (σ3' ?) "(Hrd2&Hσ3'&?)".
iDestruct "Hrd2" as %Hrd2.
iExists _, _; iPureIntro; repeat split; eauto. }
iMod "HQ" as "#HQ". iModIntro. clear Q.
rewrite later_n_except_0_exist. iDestruct "HQ" as (σ3') "HQ".
rewrite later_n_except_0_exist. iDestruct "HQ" as (w2') "HQ".
set (Q := (|={⊤}=> Nat.iter (k1 + k2) (λ Q, ▷ Q) (◇ (∃ (σ4' : state) (w1' : val),
■ (rtc (pstep' det_lang)
(e1.[env_subst (w2' :: vvs.*2)], σ3') (of_val w1', σ4')))))%I : iProp Σ).
iAssert Q as "HQ2".
{ unfold Q.
iMod (allocate_full_state σ1) as (γh3) "[Hfσ1 Hnσ1]".
iMod (allocate_full_state σ1') as (γh4) "[Hfσ1' Hnσ1']".
iPoseProof (binary_fundamental _ _ _ Ht2' Δ vvs HΔ with "[]") as "Hrel";
first iFrame "#".
iSpecialize ("Hrel" $! _ _ _ with "[$Hfσ1']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("Hrel" $! _ _ _ _ with "[$Hfσ1]"); auto.
iApply (future_plain with "[-]").
iDestruct (later_n_except_0_future with "[$HQ]") as "HQ'".
iCombine "Hrel" "HQ'" as "Hrel".
iMod "Hrel" as "[[Hrel Hσ3] HQ']". iDestruct "HQ'" as %HQ.
iDestruct "Hrel" as (σ3'' w2'') "(Hrd2&Hσ3''&#Hww2)".
iDestruct "Hrd2" as %Hrd2.
apply rtc_nsteps in HQ. destruct HQ as [n1 HQ].
apply rtc_nsteps in Hrd2. destruct Hrd2 as [n2 Hrd2].
destruct (nsteps_deterministic' Hrd2 HQ) as [? [? ?]]; subst.
iPoseProof (binary_fundamental _ _ _ Ht1 Δ ((w2, w2') :: vvs) HΔ with "[]")
as "Hrel"; first by rewrite interp_env_cons; iFrame "#".
iSpecialize ("Hrel" $! _ _ _ with "[$Hσ3'']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("Hrel" $! _ _ _ _ with "[$Hσ3]"); auto.
iMod "Hrel" as "[Hrel _]".
iDestruct "Hrel" as (σ4' w1') "(Hrd3&Hσ4'&?)".
iDestruct "Hrd3" as %Hrd3. iModIntro.
iExists _, _; iPureIntro; repeat split; eauto. }
iMod "HQ2" as "#HQ2". iModIntro. clear Q.
rewrite later_n_except_0_exist. iDestruct "HQ2" as (σ4') "HQ2".
rewrite later_n_except_0_exist. iDestruct "HQ2" as (w1') "HQ2".
iDestruct (later_n_except_0_future with "[$HQ]") as "HQ3".
iDestruct (later_n_except_0_future with "[$HQ2]") as "HQ4".
iClear "HQ HQ2".
iPoseProof (binary_fundamental _ _ _ Ht2' Δ vvs HΔ with "[]") as "He21";
first iFrame "#".
iSpecialize ("He21" $! _ _ _ with "[$Hσ1']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("He21" $! _ _ _ _ with "[$Hσ1]"); auto.
iMod (allocate_full_state σ1) as (γh3) "[Hfσ1 _]".
iMod (allocate_full_state σ4') as (γh4) "[Hfσ4' Hnσ4']".
iPoseProof (binary_fundamental _ _ _ Ht2' Δ vvs HΔ with "[]") as "He22";
first iFrame "#".
iSpecialize ("He22" $! _ _ _ with "[$Hfσ4']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("He22" $! _ _ _ _ with "[$Hfσ1]"); auto.
iCombine "HQ3" "He21" as "He21". iCombine "He21" "He22" as "He2".
iPoseProof (future_cancel_2 with "[He2 HQ4]") as "He"; first trivial.
{ iSplitL "HQ4"; iFrame. }
iMod "He" as "(HQ' & [HQ [He21 Hσ3]] & [He22 Hfσ3])".
iDestruct "HQ" as %HQ.
apply rtc_nsteps in HQ. destruct HQ as [n1 HQ].
iDestruct "He21" as (σ3'' w2'') "(Hrd2 & Hσ3' & #Hww2)".
iDestruct "Hrd2" as %Hrd2.
apply rtc_nsteps in Hrd2. destruct Hrd2 as [n2 Hrd2].
destruct (nsteps_deterministic' Hrd2 HQ) as [? [? ?]]; subst.
iDestruct "He22" as (σ5' w2'') "(Hrd3 & Hσ5' & #Hww2')".
iDestruct "Hrd3" as %Hrd3.
apply rtc_nsteps in Hrd3. destruct Hrd3 as [n3 Hrd3].
replace (k1 + k2 - k1) with k2 by omega.
iDestruct (heap_included with "[$Hnσ4' $Hσ5']") as %[Hincl Hvl].
iClear "Hnσ4' Hσ5' Hfσ3".
iPoseProof (binary_fundamental _ _ _ Ht1 Δ ((w2, w2') :: vvs) HΔ with "[]")
as "He1"; first by rewrite interp_env_cons; iFrame "#".
iSpecialize ("He1" $! _ _ _ with "[$Hσ3']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("He1" $! _ _ _ _ with "[$Hσ3]"); auto.
iCombine "HQ'" "He1" as "He1".
iMod "He1" as "[HQ' [He1 Hσ4]]".
iDestruct "HQ'" as %HQ'.
apply rtc_nsteps in HQ'. destruct HQ' as [n1' HQ'].
iDestruct "He1" as (σ4'' w1'') "(Hrd4 & Hσ4' & #Hww1)".
iDestruct "Hrd4" as %Hrd4.
apply rtc_nsteps in Hrd4. destruct Hrd4 as [n4 Hrd4].
destruct (nsteps_deterministic' Hrd4 HQ') as [? [? ?]]; subst.
iMod (heap_catch_up with "Hσ4'") as "Hσ5'"; eauto.
iPoseProof (binary_fundamental _ _ _ Ht2 Δ ((w2, w2'') :: vvs) HΔ with "[]")
as "He2"; first by rewrite interp_env_cons; iFrame "#".
iSpecialize ("He2" $! _ _ _ with "[$Hσ5']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("He2" $! _ _ _ _ with "[$Hσ4]"); auto.
iMod "He2" as "[He2 Hσ5]".
iDestruct "He2" as (σ6' w3') "(Hrd5 & Hσ6' & #Hww3)".
iDestruct "Hrd5" as %Hrd5.
apply rtc_nsteps in Hrd5. destruct Hrd5 as [n5 Hrd5].
iPoseProof (HLR with "[]") as "Hlr"; first iFrame "#".
iSpecialize ("Hlr" $! _ _ _ with "[$Hσ6']"). asimpl.
rewrite ic_eq /ic_def.
iSpecialize ("Hlr" $! _ _ _ _ with "[$Hσ5]"); auto.
iMod "Hlr" as "[Hlr Hσ6]".
iDestruct "Hlr" as (σ7' vf') "(Hrd6 & Hσ7' & #Hvvf)".
iDestruct "Hrd6" as %Hrd6.
apply rtc_nsteps in Hrd6. destruct Hrd6 as [n6 Hrd6].
iModIntro; iFrame.
iExists _, _; iFrame; iFrame "#".
iPureIntro.
rewrite Hsubst. asimpl.
edestruct HK1 as (K1' & HK1'eq); erewrite HK1'eq.
edestruct (HK2 w1') as (K2' & HK2'eq).
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K1'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang).
eapply (@nsteps_ctx det_lang (fill_item (AppRCtx (RecV _))));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang). }
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K1'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang).
eapply (nsteps_l _ _ (_, _) (_, _)); simpl.
{ apply head_prim_step. econstructor; eauto. }
asimpl. econstructor. }
erewrite typed_subst_head_simpl; eauto;
last by rewrite /= !fmap_length Hvvsl.
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K1'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang). }
rewrite -HK1'eq HK2'eq.
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K2'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang).
eapply (@nsteps_ctx det_lang (fill_item (AppRCtx (RecV _))));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang). }
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K2'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang).
eapply (nsteps_l _ _ (_, _) (_, _)); simpl.
{ apply head_prim_step. econstructor; eauto. }
asimpl. econstructor. }
erewrite typed_subst_head_simpl; eauto;
last by rewrite /= !fmap_length Hvvsl.
etrans.
{ eapply (nsteps_rtc _).
eapply (@nsteps_ctx det_lang (fill_item K2'));
eauto using (@ectxi_lang_ctx_item _ _ _ _ det_ectxi_lang). }
rewrite -HK2'eq.
eapply (nsteps_rtc _); eauto.
Qed.