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