Commit 09ef8477 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Use λne notation and many clean ups.

parent 655c9011
......@@ -17,13 +17,11 @@ Section typed_interp.
Local Ltac value_case := iApply wp_value; cbn; rewrite ?to_of_val; trivial.
Lemma typed_interp (Δ : varC -n> valC -n> iProp lang Σ) Γ vs e τ
(Htyped : typed Γ e τ)
(HΔ : x v, PersistentP (Δ x v))
: List.length Γ = List.length vs
[] zip_with (λ τ, interp τ Δ) Γ vs WP e.[env_subst vs] {{ interp τ Δ }}.
(Htyped : typed Γ e τ) (HΔ : x v, PersistentP (Δ x v)) :
List.length Γ = List.length vs
[] zip_with (λ τ, interp τ Δ) Γ vs WP e.[env_subst vs] {{ interp τ Δ }}.
Proof.
revert Δ HΔ vs.
induction Htyped; intros Δ HΔ vs Hlen; iIntros "#HΓ"; cbn.
revert Δ HΔ vs. induction Htyped; iIntros {Δ HΔ vs Hlen} "#HΓ"; cbn.
- (* var *)
destruct (lookup_lt_is_Some_2 vs x) as [v Hv].
{ by rewrite -Hlen; apply lookup_lt_Some with τ. }
......@@ -72,14 +70,13 @@ Section typed_interp.
iApply wp_mono; [|iApply "Hv"]; auto.
- (* TLam *)
value_case.
iIntros { [τi τiPr] } "!". iApply wp_TLam; iNext; simpl in *.
iIntros { τi } "! %". iApply wp_TLam; iNext; simpl in *.
iApply (IHHtyped (extend_context_interp_fun1 τi Δ)); [rewrite map_length|]; trivial.
by iDestruct (zip_with_context_interp_subst with "HΓ") as "?".
- (* TApp *)
smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn.
unshelve iSpecialize ("Hv" $! ((interp τ' Δ) _)); try apply _; cbn.
iApply always_elim. iApply always_mono; [|trivial].
apply wp_mono => w. by rewrite interp_subst.
iApply wp_wand_r; iSplitL; [iApply ("Hv" $! (interp τ' Δ)); iPureIntro; apply _|].
iIntros{w} "?". by rewrite interp_subst.
- (* Fold *)
rewrite map_length in IHHtyped.
iApply (@wp_bind _ _ _ [FoldCtx]).
......
This diff is collapsed.
......@@ -18,17 +18,10 @@ Section Soundness.
Qed.
Definition free_type_context : varC -n> valC -n> iProp lang (globalF Σ) :=
{|
cofe_mor_car :=
λ x,
{|
cofe_mor_car :=
λ y, True%I
|}
|}.
λne x y, True%I.
Lemma wp_soundness e τ
: typed [] e τ True WP e {{ @interp (globalF Σ) τ free_type_context}}.
Lemma wp_soundness e τ :
typed [] e τ True WP e {{ @interp (globalF Σ) τ free_type_context }}.
Proof.
iIntros {H} "". rewrite -(empty_env_subst e).
by iApply (@typed_interp _ _ _ []).
......
......@@ -23,12 +23,12 @@ Section typed_interp.
Local Ltac value_case := iApply wp_value; [cbn; rewrite ?to_of_val; trivial|].
Lemma typed_interp N (Δ : varC -n> valC -n> iPropG lang Σ) Γ vs e τ
(HNLdisj : l : loc, N L .@ l)
(Htyped : typed Γ e τ)
(HΔ : x v, PersistentP (Δ x v))
: List.length Γ = List.length vs
heap_ctx N [] zip_with (λ τ, interp L τ Δ) Γ vs
WP e.[env_subst vs] {{ interp L τ Δ }}.
(HNLdisj : l : loc, N L .@ l)
(Htyped : typed Γ e τ)
(HΔ : x v, PersistentP (Δ x v)) :
List.length Γ = List.length vs
heap_ctx N [] zip_with (λ τ, interp L τ Δ) Γ vs
WP e.[env_subst vs] {{ interp L τ Δ }}.
Proof.
revert Δ HΔ vs.
induction Htyped; intros Δ HΔ vs Hlen; iIntros "#[Hheap HΓ]"; cbn.
......@@ -79,15 +79,14 @@ Section typed_interp.
smart_wp_bind (AppRCtx v) w "#Hw" IHHtyped2.
iApply wp_mono; [|iApply "Hv"]; auto.
- (* TLam *)
value_case. iIntros { [τi τiPr] } "!".
value_case. iIntros {τi} "! %".
iApply wp_TLam; iNext. simpl.
iApply (IHHtyped (extend_context_interp_fun1 τi Δ)); [rewrite map_length|]; trivial.
rewrite -zip_with_context_interp_subst. auto.
- (* TApp *)
smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn.
unshelve iSpecialize ("Hv" $! ((interp L τ' Δ) _)); try apply _; cbn.
iApply wp_mono; [|done].
intros w; rewrite interp_subst; trivial.
iApply wp_wand_r; iSplitL; [iApply ("Hv" $! (interp L τ' Δ)); iPureIntro; apply _|]; cbn.
iIntros {w} "?"; rewrite interp_subst; trivial.
- (* Fold *)
rewrite map_length in IHHtyped.
iApply (@wp_bind _ _ _ [FoldCtx]).
......
This diff is collapsed.
......@@ -18,18 +18,11 @@ Section Soundness.
Qed.
Definition free_type_context: varC -n> valC -n> iPropG lang Σ :=
{|
cofe_mor_car :=
λ x,
{|
cofe_mor_car :=
λ y, True%I
|}
|}.
λne x y, True%I.
Lemma wp_soundness e τ
: typed [] e τ
ownership.ownP WP e {{v, H, @interp Σ H (nroot .@ "Fμ,ref" .@ 1)
Lemma wp_soundness e τ :
typed [] e τ
ownership.ownP WP e {{ v, H, @interp Σ H (nroot .@ "Fμ,ref" .@ 1)
τ free_type_context v}}.
Proof.
iIntros {H1} "Hemp".
......
......@@ -26,7 +26,7 @@ Section CG_Counter.
Proof. intros H f. unfold CG_increment. asimpl. rewrite ?H; trivial. Qed.
Lemma CG_increment_subst (x : expr) f :
(CG_increment x).[f] = CG_increment x.[f].
(CG_increment x).[f] = CG_increment x.[f].
Proof. unfold CG_increment; asimpl; trivial. Qed.
Lemma steps_CG_increment N E ρ j K x n:
......
......@@ -18,9 +18,8 @@ Section Stack_refinement.
set (Hdsj := ndot_ne_disjoint N n n' Hneq); set_solver_ndisj.
Lemma FG_CG_counter_refinement N Δ
{HΔ : x vw, PersistentP (Δ x vw)}
:
(@bin_log_related _ _ _ N Δ [] FG_stack CG_stack
{HΔ : x vw, PersistentP (Δ x vw)}:
(@bin_log_related _ _ _ N Δ [] FG_stack CG_stack
(TForall
(TProd
(TProd
......@@ -38,8 +37,7 @@ Section Stack_refinement.
unfold CG_stack, FG_stack.
iApply wp_value; eauto.
iExists (TLamV _); iFrame "Hj".
iIntros {τi}. destruct τi as [τi Hτ]; simpl.
iAlways. clear j K. iIntros {j K} "Hj".
clear j K. iAlways. iIntros {τi j K} "% Hj /=".
iPvs (step_Tlam _ _ _ j K with "[Hj]") as "Hj"; eauto.
iApply wp_TLam; iNext.
iPvs (steps_newlock _ _ _ j (K ++ [AppRCtx (LamV _)]) _ with "[Hj]")
......@@ -334,7 +332,7 @@ Section Stack_refinement.
rewrite ?fill_app. simpl.
rewrite -FG_iter_folding.
iRevert {istk3 w} "Hj HLK'". iLöb as "Hlat".
iIntros {istk3 w} "Hj". iIntros "HLK". (* A bug in iIntros? *)
iIntros {istk3 w} "Hj HLK".
rewrite -> FG_iter_folding at 1.
iApply wp_lam; simpl; trivial.
rewrite -FG_iter_folding. asimpl. rewrite FG_iter_subst.
......@@ -422,105 +420,13 @@ Section Stack_refinement.
all: try match goal with
|- _ _ => let H := fresh "H" in intros H; inversion H; auto
end.
(* This seems to be a bug in all: mechanism!? *)
match goal with
all: match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
abstract (prove_disj N A B)
end.
match goal with
|- @subseteq
_ _ (nclose (N .@ ?A))
(@difference _ _ (nclose (N .@ ?B))) =>
_ _ (nclose (?N .@ ?A))
(@difference _ _ (nclose (?N .@ ?B))) =>
abstract (prove_disj N A B)
end.
Qed.
End Stack_refinement.
Definition Σ := #[authGF heapUR; authGF cfgUR; authGF stackUR].
......
......@@ -52,35 +52,17 @@ Section Rules.
Qed.
Program Definition StackLink_pre (Q : bivalC -n> iPropG lang Σ)
{HQ : vw, PersistentP (Q vw)} :
(bivalC -n> iPropG lang Σ) -n> bivalC -n> iPropG lang Σ :=
{|
cofe_mor_car :=
λ P,
{|
cofe_mor_car :=
λ v, ( l w, v.1 = LocV l l ↦ˢᵗᵏ w
((w = InjLV UnitV
v.2 = FoldV (InjLV UnitV))
( y1 z1 y2 z2,
(w = InjRV (PairV y1 (FoldV z1)))
(v.2 = FoldV (InjRV (PairV y2 z2)))
Q (y1, y2) P(z1, z2)
)
)
)%I
|}
|}.
{HQ : vw, PersistentP (Q vw)} :
(bivalC -n> iPropG lang Σ) -n> bivalC -n> iPropG lang Σ := λne P v,
( l w, v.1 = LocV l l ↦ˢᵗᵏ w
((w = InjLV UnitV v.2 = FoldV (InjLV UnitV))
( y1 z1 y2 z2, w = InjRV (PairV y1 (FoldV z1))
v.2 = FoldV (InjRV (PairV y2 z2)) Q (y1, y2) P(z1, z2))))%I.
Next Obligation.
intros Q HQ P n [v1 v2] [w1 w2] [Hv1 Hv2]; simpl in *;
by rewrite Hv1 Hv2.
Qed.
Next Obligation.
intros Q HQ n P1 P2 HP v; simpl in *.
repeat (apply exist_ne => ?). repeat apply sep_ne; trivial.
rewrite or_ne; trivial. repeat (apply exist_ne => ?).
by rewrite HP.
Qed.
Next Obligation. solve_proper. Qed.
Global Instance StackLink_pre_contractive Q {HQ} :
Contractive (@StackLink_pre Q HQ).
......
......@@ -36,15 +36,13 @@ Section typed_interp.
Qed.
Definition bin_log_related Δ Γ e e' τ {HΔ : x vw, PersistentP (Δ x vw)} :=
vs,
List.length Γ = List.length vs
ρ j K,
heapI_ctx (N .@ 2) Spec_ctx (N .@ 3) ρ
[] zip_with (λ τ, interp (N .@ 1) τ Δ) Γ vs
j fill K (e'.[env_subst (map snd vs)])
WP e.[env_subst (map fst vs)]
{{ λ v, v', j fill K (# v')
interp (N .@ 1) τ Δ (v, v') }}.
vs, List.length Γ = List.length vs
ρ j K,
heapI_ctx (N .@ 2) Spec_ctx (N .@ 3) ρ
[] zip_with (λ τ, interp (N .@ 1) τ Δ) Γ vs
j fill K (e'.[env_subst (map snd vs)])
WP e.[env_subst (map fst vs)] {{ v, v',
j fill K (# v') interp (N .@ 1) τ Δ (v, v') }}.
Notation "Δ ∥ Γ ⊩ e '≤log≤' e' ∷ τ" := (bin_log_related Δ Γ e e' τ)
(at level 20) : bin_logrel_scope.
......@@ -54,10 +52,9 @@ Section typed_interp.
Notation "✓✓ Δ" := ( x v, PersistentP (Δ x v)) (at level 20).
Lemma typed_binary_interp_Pair Δ Γ e1 e2 e1' e2' τ1 τ2 {HΔ : ✓✓ Δ}
(IHHtyped1 : Δ Γ e1 log e1' τ1)
(IHHtyped2 : Δ Γ e2 log e2' τ2)
:
Δ Γ Pair e1 e2 log Pair e1' e2' TProd τ1 τ2.
(IHHtyped1 : Δ Γ e1 log e1' τ1)
(IHHtyped2 : Δ Γ e2 log e2' τ2) :
Δ Γ Pair e1 e2 log Pair e1' e2' TProd τ1 τ2.
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr) /=".
smart_wp_bind (PairLCtx e2.[env_subst (map fst vs)]) v v' "[Hv #Hiv]"
......@@ -72,9 +69,8 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_Fst Δ Γ e e' τ1 τ2 {HΔ : ✓✓ Δ}
(IHHtyped : Δ Γ e log e' (TProd τ1 τ2))
:
Δ Γ Fst e log Fst e' τ1.
(IHHtyped : Δ Γ e log e' TProd τ1 τ2) :
Δ Γ Fst e log Fst e' τ1.
Proof.
intros vs Hlen ρ j K. iIntros "[#Hheap [#Hspec [#HΓ Htr]]]"; cbn.
smart_wp_bind (FstCtx) v v' "[Hv #Hiv]"
......@@ -90,9 +86,8 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_Snd Δ Γ e e' τ1 τ2 {HΔ : ✓✓ Δ}
(IHHtyped : Δ Γ e log e' (TProd τ1 τ2))
:
Δ Γ Snd e log Snd e' τ2.
(IHHtyped : Δ Γ e log e' TProd τ1 τ2) :
Δ Γ Snd e log Snd e' τ2.
Proof.
intros vs Hlen ρ j K. iIntros "[#Hheap [#Hspec [#HΓ Htr]]]"; cbn.
smart_wp_bind (SndCtx) v v' "[Hv #Hiv]"
......@@ -108,9 +103,8 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_InjL Δ Γ e e' τ1 τ2 {HΔ : ✓✓ Δ}
(IHHtyped : Δ Γ e log e' τ1)
:
Δ Γ InjL e log InjL e' (TSum τ1 τ2).
(IHHtyped : Δ Γ e log e' τ1) :
Δ Γ InjL e log InjL e' (TSum τ1 τ2).
Proof.
intros vs Hlen ρ j K. iIntros "[#Hheap [#Hspec [#HΓ Htr]]]"; cbn.
smart_wp_bind (InjLCtx) v v' "[Hv #Hiv]"
......@@ -122,9 +116,8 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_InjR Δ Γ e e' τ1 τ2 {HΔ : ✓✓ Δ}
(IHHtyped : Δ Γ e log e' τ2)
:
Δ Γ InjR e log InjR e' (TSum τ1 τ2).
(IHHtyped : Δ Γ e log e' τ2) :
Δ Γ InjR e log InjR e' TSum τ1 τ2.
Proof.
intros vs Hlen ρ j K. iIntros "[#Hheap [#Hspec [#HΓ Htr]]]"; cbn.
smart_wp_bind (InjRCtx) v v' "[Hv #Hiv]"
......@@ -136,16 +129,15 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_Case Δ Γ (e0 e1 e2 e0' e1' e2' : expr) τ1 τ2 τ3
{HΔ : ✓✓ Δ}
(Hclosed2 : f, e1.[iter (S (List.length Γ)) up f] = e1)
(Hclosed3 : f, e2.[iter (S (List.length Γ)) up f] = e2)
(Hclosed2' : f, e1'.[iter (S (List.length Γ)) up f] = e1')
(Hclosed3' : f, e2'.[iter (S (List.length Γ)) up f] = e2')
(IHHtyped1 : Δ Γ e0 log e0' TSum τ1 τ2)
(IHHtyped2 : Δ τ1 :: Γ e1 log e1' τ3)
(IHHtyped3 : Δ τ2 :: Γ e2 log e2' τ3)
:
Δ Γ Case e0 e1 e2 log Case e0' e1' e2' τ3.
{HΔ : ✓✓ Δ}
(Hclosed2 : f, e1.[iter (S (List.length Γ)) up f] = e1)
(Hclosed3 : f, e2.[iter (S (List.length Γ)) up f] = e2)
(Hclosed2' : f, e1'.[iter (S (List.length Γ)) up f] = e1')
(Hclosed3' : f, e2'.[iter (S (List.length Γ)) up f] = e2')
(IHHtyped1 : Δ Γ e0 log e0' TSum τ1 τ2)
(IHHtyped2 : Δ τ1 :: Γ e1 log e1' τ3)
(IHHtyped3 : Δ τ2 :: Γ e2 log e2' τ3) :
Δ Γ Case e0 e1 e2 log Case e0' e1' e2' τ3.
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr) /=".
smart_wp_bind (CaseCtx _ _) v v' "[Hv #Hiv]"
......@@ -175,11 +167,10 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_If Δ Γ e0 e1 e2 e0' e1' e2' τ {HΔ : ✓✓ Δ}
(IHHtyped1 : Δ Γ e0 log e0' TBool)
(IHHtyped2 : Δ Γ e1 log e1' τ)
(IHHtyped3 : Δ Γ e2 log e2' τ)
:
Δ Γ If e0 e1 e2 log If e0' e1' e2' τ.
(IHHtyped1 : Δ Γ e0 log e0' TBool)
(IHHtyped2 : Δ Γ e1 log e1' τ)
(IHHtyped3 : Δ Γ e2 log e2' τ) :
Δ Γ If e0 e1 e2 log If e0' e1' e2' τ.
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr) /=".
smart_wp_bind (IfCtx _ _) v v' "[Hv #Hiv]"
......@@ -196,10 +187,9 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_nat_bin_op Δ Γ op e1 e2 e1' e2' {HΔ : ✓✓ Δ}
(IHHtyped1 : Δ Γ e1 log e1' TNat)
(IHHtyped2 : Δ Γ e2 log e2' TNat)
:
Δ Γ NBOP op e1 e2 log NBOP op e1' e2' (NatBinOP_res_type op).
(IHHtyped1 : Δ Γ e1 log e1' TNat)
(IHHtyped2 : Δ Γ e2 log e2' TNat) :
Δ Γ NBOP op e1 e2 log NBOP op e1' e2' NatBinOP_res_type op.
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr)"; cbn.
smart_wp_bind (NBOPLCtx _ _) v v' "[Hv #Hiv]"
......@@ -218,11 +208,10 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_Lam Δ Γ (e e' : expr) τ1 τ2 {HΔ : ✓✓ Δ}
(Hclosed : f, e.[iter (S (S (List.length Γ))) up f] = e)
(Hclosed' : f, e'.[iter (S (S (List.length Γ))) up f] = e')
(IHHtyped : Δ TArrow τ1 τ2 :: τ1 :: Γ e log e' τ2)
:
Δ Γ Lam e log Lam e' TArrow τ1 τ2.
(Hclosed : f, e.[iter (S (S (List.length Γ))) up f] = e)
(Hclosed' : f, e'.[iter (S (S (List.length Γ))) up f] = e')
(IHHtyped : Δ TArrow τ1 τ2 :: τ1 :: Γ e log e' τ2) :
Δ Γ Lam e log Lam e' TArrow τ1 τ2.
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr) /=".
value_case. iExists (LamV _). iFrame "Htr". iAlways.
......@@ -242,10 +231,9 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_App Δ Γ e1 e2 e1' e2' τ1 τ2 {HΔ : ✓✓ Δ}
(IHHtyped1 : Δ Γ e1 log e1' TArrow τ1 τ2)
(IHHtyped2 : Δ Γ e2 log e2' τ1)
:
Δ Γ App e1 e2 log App e1' e2' τ2.
(IHHtyped1 : Δ Γ e1 log e1' TArrow τ1 τ2)
(IHHtyped2 : Δ Γ e2 log e2' τ1) :
Δ Γ App e1 e2 log App e1' e2' τ2.
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr) /=".
smart_wp_bind (AppLCtx (e2.[env_subst (map fst vs)])) v v' "[Hv #Hiv]"
......@@ -259,15 +247,14 @@ Section typed_interp.
Qed.
Lemma typed_binary_interp_TLam Δ Γ e e' τ {HΔ : ✓✓ Δ}
(IHHtyped : (τi : bivalC -n> _) (Hpr: vw, PersistentP (τi vw)),
(extend_context_interp_fun1 τi Δ) map (λ t : type, t.[ren (+1)]) Γ
e log e' τ)
:
Δ Γ TLam e log TLam e' TForall τ.
(IHHtyped : (τi : bivalC -n> _) (Hpr: vw, PersistentP (τi vw)),
(extend_context_interp_fun1 τi Δ) map (λ t : type, t.[ren (+1)]) Γ
e log e' τ) :
Δ Γ TLam e log TLam e' TForall τ.
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr) /=".
value_case. iExists (TLamV _). iFrame "Htr"; simpl.
iIntros { [τi τiPr] } "!"; iIntros {j' K'} "Hv /=".
iAlways; iIntros {τi j' K'} "% Hv /=".
iApply wp_TLam; iNext.
iPvs (step_Tlam _ _ _ j' K' (e'.[env_subst (map snd vs)]) _ with "* [-]")
as "Hz".
......@@ -276,29 +263,26 @@ Section typed_interp.
iFrame "Hheap Hspec".
rewrite zip_with_context_interp_subst; by iFrame "HΓ".
Unshelve. all: trivial.
Qed.
Qed.
Lemma typed_binary_interp_TApp Δ Γ e e' τ τ' {HΔ : ✓✓ Δ}
(IHHtyped : Δ Γ e log e' TForall τ)
:
Δ Γ TApp e log TApp e' τ.[τ'/].
(IHHtyped : Δ Γ e log e' TForall τ) :
Δ Γ TApp e log TApp e' τ.[τ'/].
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr) /=".
smart_wp_bind (TAppCtx) v v' "[Hj #Hv]"
(IHHtyped _ _ _ j (K ++ [TAppCtx])); cbn.
iSpecialize ("Hv" $! (interp (N .@ 1) τ' Δ) _); cbn.
iDestruct "Hv" as "#Hv".
iApply wp_wand_l; iSplitR; [|iApply "Hv"; auto].
iApply wp_wand_r; iSplitL.
{ iApply ("Hv" $! (interp (N .@ 1) τ' Δ) with "[#] Hj"); iPureIntro; apply _. }
iIntros {w} "Hw". iDestruct "Hw" as {w'} "[Hw #Hiw]".
iExists _; rewrite -interp_subst; eauto.
(* unshelving *)
Unshelve. all: trivial. simpl; typeclasses eauto.
Unshelve. all: trivial.
Qed.
Lemma typed_binary_interp_Fold Δ Γ e e' τ {HΔ : ✓✓ Δ}
(IHHtyped : Δ Γ e log e' τ.[(TRec τ)/])
:
Δ Γ Fold e log Fold e' TRec τ.
(IHHtyped : Δ Γ e log e' τ.[(TRec τ)/]) :
Δ Γ Fold e log Fold e' TRec τ.
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr) /=".
iApply (@wp_bind _ _ _ [FoldCtx]);
......@@ -316,9 +300,8 @@ Qed.
Qed.
Lemma typed_binary_interp_Unfold Δ Γ e e' τ {HΔ : ✓✓ Δ}
(IHHtyped : Δ Γ e log e' TRec τ)
:
Δ Γ Unfold e log Unfold e' τ.[(TRec τ)/].
(IHHtyped : Δ Γ e log e' TRec τ) :
Δ Γ Unfold e log Unfold e' τ.[(TRec τ)/].
Proof.
iIntros {vs Hlen ρ j K} "(#Hheap & #Hspec & #HΓ & Htr) /=".
iApply (@wp_bind _ _ _ [UnfoldCtx]);
......@@ -339,9 +322,8 @@ Qed.