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

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]).
......
......@@ -12,56 +12,33 @@ Section logrel.
(** Just to get nicer closed forms, we define extend_context_interp in three steps. *)
Program Definition extend_context_interp_fun1
(τi : valC -n> iProp lang Σ)
(f : varC -n> valC -n> iProp lang Σ) :
(varC -n> valC -n> iProp lang Σ) :=
{| cofe_mor_car :=
λ x,
match x return valC -n> iProp lang Σ with
| O => τi
| S x' => f x'
end
|}.
(τi : valC -n> iProp lang Σ)
(f : varC -n> valC -n> iProp lang Σ) :
(varC -n> valC -n> iProp lang Σ) := λne x,
match x return valC -n> iProp lang Σ with O => τi | S x' => f x' end.
Program Definition extend_context_interp_fun2
(τi : valC -n> iProp lang Σ) :
(varC -n> valC -n> iProp lang Σ) -n>
(varC -n> valC -n> iProp lang Σ) :=
{|
cofe_mor_car := λ f, extend_context_interp_fun1 τi f
|}.
Next Obligation.
Proof. intros ???? Hfg x; destruct x; cbn; trivial. Qed.
(varC -n> valC -n> iProp lang Σ) := λne f, extend_context_interp_fun1 τi f.
Next Obligation. intros ???? Hfg x; destruct x; cbn; trivial. Qed.
Program Definition extend_context_interp :
(valC -n> iProp lang Σ) -n>
(varC -n> valC -n> iProp lang Σ) -n>
(varC -n> valC -n> iProp lang Σ) :=
{|
cofe_mor_car := λ τi, extend_context_interp_fun2 τi
|}.
Next Obligation.
Proof. intros n g h H Δ x y. destruct x; cbn; auto. Qed.
(varC -n> valC -n> iProp lang Σ) := λne τi, extend_context_interp_fun2 τi.
Next Obligation. intros n g h H Δ x y. destruct x; cbn; auto. Qed.
Program Definition extend_context_interp_apply :
((varC -n> valC -n> iProp lang Σ)) -n>
((varC -n> valC -n> iProp lang Σ) -n>
valC -n> iProp lang Σ) -n>
(valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ) :=
{|
cofe_mor_car := λ Δ,
{|
cofe_mor_car := λ f,
{|
cofe_mor_car := λ g, f (extend_context_interp g Δ)
|}
|}
|}.
((varC -n> valC -n> iProp lang Σ)) -n>
((varC -n> valC -n> iProp lang Σ) -n>
valC -n> iProp lang Σ) -n>
(valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ) := λne Δ f g,
f (extend_context_interp g Δ).
Solve Obligations with
repeat intros ?; (cbn + idtac);
try match goal with [H : _ {_} _|- _] => rewrite H end; trivial.
Next Obligation.
Proof.
intros n Δ Δ' HΔ f g x. cbn.
match goal with
|- _ _ ?F x {n} _ _ ?G x =>
......@@ -71,173 +48,71 @@ Section logrel.
destruct y; trivial.
Qed.
Definition interp_unit : valC -n> iProp lang Σ :=
{|
cofe_mor_car := λ w, (w = UnitV)%I
|}.
Definition interp_unit : valC -n> iProp lang Σ := λne w, (w = UnitV)%I.
Program Definition interp_prod :
(valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ) -n>
valC -n> iProp lang Σ :=
{|
cofe_mor_car :=
λ τ1i,
{|
cofe_mor_car :=
λ τ2i,
{|
cofe_mor_car :=
λ w, ( w1 w2, w = PairV w1 w2 τ1i w1 τ2i w2)%I
|}
|}
|}.
Solve Obligations with
repeat intros ?; cbn;
repeat apply exist_ne =>?;
try match goal with [H : _ {_} _|- _] => rewrite H end; trivial.
(valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ) -n>
valC -n> iProp lang Σ := λne τ1i τ2i w,
( w1 w2, w = PairV w1 w2 τ1i w1 τ2i w2)%I.
Solve Obligations with solve_proper.
Program Definition interp_sum :
(valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ) -n>
valC -n> iProp lang Σ :=
{|
cofe_mor_car :=
λ τ1i,
{|
cofe_mor_car :=
λ τ2i,
{|
cofe_mor_car :=
λ w, (( w1, w = InjLV w1 τ1i w1)
( w2, w = InjRV w2 τ2i w2))%I
|}
|}
|}.
Solve Obligations with
repeat intros ?; cbn; try apply or_ne;
try apply exist_ne =>?;
try match goal with [H : _ {_} _|- _] => rewrite H end; trivial.
(valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ) -n>
valC -n> iProp lang Σ := λne τ1i τ2i w,
(( w1, w = InjLV w1 τ1i w1) ( w2, w = InjRV w2 τ2i w2))%I.
Solve Obligations with solve_proper.
Program Definition interp_arrow :
(valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ) -n>
valC -n> iProp lang Σ :=
{|
cofe_mor_car :=
λ τ1i,
{|
cofe_mor_car :=
λ τ2i,
{|
cofe_mor_car :=
λ w, ( v, τ1i v WP App (# w) (# v) {{τ2i}})%I
|}
|}
|}.
Solve Obligations with
repeat intros ?; cbn;
try apply always_ne;
try apply forall_ne=>?; try apply impl_ne; trivial;
try apply wp_ne =>?;
try match goal with [H : _ {_} _|- _] => rewrite H end; trivial.
(valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ) -n>
valC -n> iProp lang Σ := λne τ1i τ2i w,
( v, τ1i v WP App (# w) (# v) {{ τ2i }})%I.
Solve Obligations with solve_proper.
Program Definition interp_forall :
((valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ)) -n>
valC -n> iProp lang Σ :=
{|
cofe_mor_car :=
λ τi,
{|
cofe_mor_car :=
λ w,
( (τ'i : {f : (valC -n> iProp lang Σ) | v, PersistentP (f v)}%type),
WP TApp (# w) {{λ v, (τi (`τ'i) v)}})%I
|}
|}.
Next Obligation.
Proof.
intros τ τ' x y Hxy; cbn; rewrite Hxy; trivial.
Qed.
Next Obligation.
intros n f g Hfg x; cbn.
apply forall_ne=> P.
apply always_ne, wp_ne => w.
rewrite Hfg; trivial.
Qed.
((valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ)) -n>
valC -n> iProp lang Σ := λne τi w,
( τ'i : valC -n> iProp lang Σ,
( ( v, PersistentP (τ'i v)) WP TApp (# w) {{ τi τ'i }}))%I.
Solve Obligations with solve_proper.
Program Definition interp_rec_pre :
((valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ)) -n>
(valC -n> iProp lang Σ) -n>
(valC -n> iProp lang Σ) :=
{|
cofe_mor_car :=
λ τi,
{| cofe_mor_car :=
λ rec_appr,
{|
cofe_mor_car := λ w, ( ( v, w = FoldV v (τi rec_appr v)))%I
|}
|}
|}.
Next Obligation.
Proof.
intros τi rec_appr n x y Hxy; rewrite Hxy; trivial.
Qed.
Next Obligation.
Proof.
intros τi n f g Hfg x. cbn.
apply always_ne, exist_ne =>w; rewrite Hfg; trivial.
Qed.
Next Obligation.
Proof.
intros n τi τi' Hτi f x. cbn.
apply always_ne, exist_ne =>w; rewrite Hτi; trivial.
Qed.
((valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ)) -n>
(valC -n> iProp lang Σ) -n>
(valC -n> iProp lang Σ) := λne τi rec_appr w,
( ( v, w = FoldV v τi rec_appr v))%I.
Solve Obligations with solve_proper.
Global Instance interp_rec_pre_contr
(τi : (valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ))
:
Contractive (interp_rec_pre τi).
(τi : (valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ)) :
Contractive (interp_rec_pre τi).
Proof.
intros n f g H w; cbn.
apply always_ne, exist_ne; intros e; apply and_ne; trivial.
apply later_contractive =>i Hi.
rewrite H; trivial.
apply later_contractive =>i Hi. rewrite H; trivial.
Qed.
Program Definition interp_rec :
((valC -n> iProp lang Σ) -n> (valC -n> iProp lang Σ)) -n>
(valC -n> iProp lang Σ)
:=
{|
cofe_mor_car := λ τi, fixpoint (interp_rec_pre τi)
|}.
Next Obligation.
Proof. intros n f g H; apply fixpoint_ne => z; rewrite H; trivial. Qed.
(valC -n> iProp lang Σ) := λne τi, fixpoint (interp_rec_pre τi).
Next Obligation. intros n f g H; apply fixpoint_ne => z; rewrite H; trivial. Qed.
Program Fixpoint interp (τ : type) {struct τ}
: (varC -n> (valC -n> iProp lang Σ)) -n> valC -n> iProp lang Σ
:=
match τ with
| TUnit => {| cofe_mor_car := λ Δ, interp_unit |}
| TProd τ1 τ2 =>
{| cofe_mor_car := λ Δ, interp_prod (interp τ1 Δ) (interp τ2 Δ)|}
| TSum τ1 τ2 => {| cofe_mor_car := λ Δ,interp_sum (interp τ1 Δ) (interp τ2 Δ)|}
| TArrow τ1 τ2 => {|cofe_mor_car := λ Δ, interp_arrow (interp τ1 Δ) (interp τ2 Δ)|}
| TVar v => {| cofe_mor_car :=
λ Δ : (varC -n> (valC -n> iProp lang Σ)), (Δ v) |}
| TForall τ' =>
{| cofe_mor_car := λ Δ,
interp_forall (extend_context_interp_apply Δ (interp τ'))|}
| TRec τ' =>
{| cofe_mor_car := λ Δ,
interp_rec (extend_context_interp_apply Δ (interp τ'))|}
end%I.
Program Fixpoint interp (τ : type) {struct τ} :
(varC -n> (valC -n> iProp lang Σ)) -n> valC -n> iProp lang Σ :=
match τ with
| TUnit => λne Δ, interp_unit
| TProd τ1 τ2 => λne Δ, interp_prod (interp τ1 Δ) (interp τ2 Δ)
| TSum τ1 τ2 => λne Δ, interp_sum (interp τ1 Δ) (interp τ2 Δ)
| TArrow τ1 τ2 => λne Δ, interp_arrow (interp τ1 Δ) (interp τ2 Δ)
| TVar v => λne Δ : varC -n> (valC -n> iProp lang Σ), (Δ v)
| TForall τ' => λne Δ, interp_forall (extend_context_interp_apply Δ (interp τ'))
| TRec τ' => λne Δ, interp_rec (extend_context_interp_apply Δ (interp τ'))
end%I.
Solve Obligations with
repeat intros ?; match goal with [H : _ {_} _|- _] => rewrite H end; trivial.
Global Instance interp_Persistent
τ (Δ : varC -n> valC -n> iProp lang Σ)
{HΔ : x v, PersistentP (Δ x v)}
: v, PersistentP (interp τ Δ v).
τ (Δ : varC -n> valC -n> iProp lang Σ) {HΔ : x v, PersistentP (Δ x v)} :
v, PersistentP (interp τ Δ v).
Proof.
revert Δ HΔ.
induction τ; cbn; intros Δ HΔ v; try apply _.
......@@ -246,33 +121,31 @@ Section logrel.
Qed.
Global Instance extend_context_interp_Persistent
(f : valC -n> iProp lang Σ) (Δ : varC -n> valC -n> iProp lang Σ)
(Hf : v, PersistentP (f v))
{HΔ : x v, PersistentP (Δ x v)}
: x v, PersistentP (@extend_context_interp f Δ x v).
(f : valC -n> iProp lang Σ) (Δ : varC -n> valC -n> iProp lang Σ)
(Hf : v, PersistentP (f v))
{HΔ : x v, PersistentP (Δ x v)} :
x v, PersistentP (@extend_context_interp f Δ x v).
Proof. intros x v. destruct x; cbn; trivial. Qed.
Local Ltac properness :=
repeat
match goal with
| |- ( _: _, _)%I ( _: _, _)%I => apply exist_proper =>?
| |- ( _: _, _)%I ( _: _, _)%I => apply forall_proper =>?
| |- (_ _)%I (_ _)%I => apply and_proper
| |- (_ _)%I (_ _)%I => apply or_proper
| |- (_ _)%I (_ _)%I => apply impl_proper
| |- (WP _ {{ _ }})%I (WP _ {{ _ }})%I => apply wp_proper =>?
| |- ( _)%I ( _)%I => apply later_proper
| |- ( _)%I ( _)%I => apply always_proper
end.
match goal with
| |- ( _: _, _)%I ( _: _, _)%I => apply exist_proper =>?
| |- ( _: _, _)%I ( _: _, _)%I => apply forall_proper =>?
| |- (_ _)%I (_ _)%I => apply and_proper
| |- (_ _)%I (_ _)%I => apply or_proper
| |- (_ _)%I (_ _)%I => apply impl_proper
| |- (WP _ {{ _ }})%I (WP _ {{ _ }})%I => apply wp_proper =>?
| |- ( _)%I ( _)%I => apply later_proper
| |- ( _)%I ( _)%I => apply always_proper
end.
Lemma interp_unused_contex_irrel
(m n : nat)
(Δ Δ' : varC -n> valC -n> iProp lang Σ)
(HΔ : v, Δ (if lt_dec v m then v else (n + v))
Δ' (if lt_dec v m then v else (n + v)))
(τ : type)
:
interp τ.[iter m up (ren (+n))] Δ interp τ.[iter m up (ren (+n))] Δ'.
(m n : nat) (Δ Δ' : varC -n> valC -n> iProp lang Σ)
(HΔ : v, Δ (if lt_dec v m then v else (n + v))
Δ' (if lt_dec v m then v else (n + v)))
(τ : type) :
interp τ.[iter m up (ren (+n))] Δ interp τ.[iter m up (ren (+n))] Δ'.
Proof.
revert m n Δ Δ' HΔ.
induction τ; intros m n Δ Δ' HΔ v; cbn; auto.
......@@ -314,28 +187,21 @@ Section logrel.
Qed.
Program Definition hop_context_interp (m n : nat) :
(varC -n> valC -n> iProp lang Σ) -n>
(varC -n> valC -n> iProp lang Σ) :=
{| cofe_mor_car :=
λ Δ,
{| cofe_mor_car := λ v, if lt_dec v m then Δ v else Δ (v - n) |}
|}.
(varC -n> valC -n> iProp lang Σ) -n>
(varC -n> valC -n> iProp lang Σ) := λne Δ v,
if lt_dec v m then Δ v else Δ (v - n).
Next Obligation. intros ?????? Hxy; destruct Hxy; trivial. Qed.
Next Obligation.
Proof. intros ?????? Hxy; destruct Hxy; trivial. Qed.
Next Obligation.
Proof.
intros ????? Hfg ?; cbn. destruct lt_dec; rewrite Hfg; trivial.
Qed.
Lemma extend_bofore_hop_context_interp (m n : nat)
(Δ : varC -n> valC -n> iProp lang Σ)
(τi : valC -n> iProp lang Σ)
(v : var)
:
(extend_context_interp τi (hop_context_interp m n Δ)
(if lt_dec v (S m) then v else n + v))
(hop_context_interp (S m) n (extend_context_interp τi Δ)
(if lt_dec v (S m) then v else n + v)).
(Δ : varC -n> valC -n> iProp lang Σ)
(τi : valC -n> iProp lang Σ) (v : var) :
(extend_context_interp τi (hop_context_interp m n Δ)
(if lt_dec v (S m) then v else n + v))
(hop_context_interp (S m) n (extend_context_interp τi Δ)
(if lt_dec v (S m) then v else n + v)).
Proof.
destruct v; cbn; trivial.
repeat (destruct lt_dec; cbn); auto with omega.
......@@ -347,10 +213,8 @@ Section logrel.
Qed.
Lemma interp_subst_weaken
(m n : nat)
(Δ : varC -n> valC -n> iProp lang Σ)
(τ : type)
: interp τ Δ interp τ.[iter m up (ren (+n))] (hop_context_interp m n Δ).
(m n : nat) (Δ : varC -n> valC -n> iProp lang Σ) (τ : type) :
interp τ Δ interp τ.[iter m up (ren (+n))] (hop_context_interp m n Δ).
Proof.
revert m n Δ.
induction τ; intros m n Δ v; cbn -[extend_context_interp]; auto.
......@@ -371,12 +235,7 @@ Section logrel.
asimpl; unfold ids; cbn; destruct lt_dec; cbn; destruct lt_dec; auto with omega.
replace (m + n + (x - m)) with (x + n) by omega.
replace (x + n - n) with x; trivial.
{ (** An incompleteness in omega and lia! *)
clear.
replace (x + n) with (n + x) by omega.
induction n; cbn; auto with omega.
induction x; cbn; trivial.
}
{ unfold var in *; omega. }
- properness; trivial.
change (up (iter m up (ren (+n)))) with (iter (S m) up (ren (+n))).
rewrite IHτ.
......@@ -385,9 +244,9 @@ Section logrel.
Qed.
Lemma interp_ren_S (τ : type)
(Δ : varC -n> valC -n> iProp lang Σ)
(τi : valC -n> iProp lang Σ)
: interp τ Δ interp τ.[ren (+1)] (extend_context_interp τi Δ).
(Δ : varC -n> valC -n> iProp lang Σ)
(τi : valC -n> iProp lang Σ) :
interp τ Δ interp τ.[ren (+1)] (extend_context_interp τi Δ).
Proof.
rewrite (interp_subst_weaken 0 1).
apply interp_unused_contex_irrel.
......@@ -399,37 +258,24 @@ Section logrel.
Program Definition context_interp_insert (m : nat) :
(valC -n> iProp lang Σ) -n>
(varC -n> valC -n> iProp lang Σ) -n>
(varC -n> valC -n> iProp lang Σ) :=
{| cofe_mor_car :=
λ τi,
{| cofe_mor_car :=
λ Δ,
{| cofe_mor_car :=
λ v, if lt_dec v m then Δ v else
if eq_nat_dec v m then τi else Δ (v - 1)
|}
|}
|}.
Next Obligation.
Proof. intros m τi Δ n x y Hxy; destruct Hxy; trivial. Qed.
(varC -n> valC -n> iProp lang Σ) := λne τi Δ v,
if lt_dec v m then Δ v else if eq_nat_dec v m then τi else Δ (v - 1).
Next Obligation. intros m τi Δ n x y Hxy; destruct Hxy; trivial. Qed.
Next Obligation.
Proof.
intros m τi n Δ Δ' HΔ x; cbn;
destruct lt_dec; try destruct eq_nat_dec; auto.
Qed.
Next Obligation.
Proof.
intros m n f g Hfg F Δ x; cbn;
destruct lt_dec; try destruct eq_nat_dec; auto.
Qed.
Lemma extend_context_interp_insert (m : nat)
(τi : valC -n> iProp lang Σ)
(Δ : varC -n> valC -n> iProp lang Σ)
(Ti : valC -n> iProp lang Σ)
:
(extend_context_interp Ti (context_interp_insert m τi Δ))
(context_interp_insert (S m) τi (extend_context_interp Ti Δ)).
(τi : valC -n> iProp lang Σ)
(Δ : varC -n> valC -n> iProp lang Σ)
(Ti : valC -n> iProp lang Σ) :
extend_context_interp Ti (context_interp_insert m τi Δ)
context_interp_insert (S m) τi (extend_context_interp Ti Δ).
Proof.
intros [|v]; cbn; trivial.
repeat destruct lt_dec; trivial;
......@@ -439,11 +285,8 @@ Section logrel.
Qed.
Lemma context_interp_insert_O_extend
(τi : valC -n> iProp lang Σ)
(Δ : varC -n> valC -n> iProp lang Σ)
:
(context_interp_insert O τi Δ)
(extend_context_interp τi Δ).
(τi : valC -n> iProp lang Σ) (Δ : varC -n> valC -n> iProp lang Σ) :
context_interp_insert O τi Δ extend_context_interp τi Δ.
Proof.
intros [|v]; cbn; trivial.
repeat destruct lt_dec; trivial;
......@@ -451,9 +294,8 @@ Section logrel.
destruct v; cbn; auto with omega.
Qed.
Lemma iter_up_subst_type (m : nat) (τ : type) (x : var)
:
(iter m up (τ .: ids) x) =
Lemma iter_up_subst_type (m : nat) (τ : type) (x : var) :
iter m up (τ .: ids) x =
if lt_dec x m then ids x else
if eq_nat_dec x m then τ.[ren (+m)] else ids (x - 1).
Proof.
......@@ -470,12 +312,11 @@ Section logrel.
Qed.
Lemma interp_subst_iter_up
(m : nat)
(Δ : varC -n> valC -n> iProp lang Σ)
(τ : type)
(τ' : type)
: interp τ (context_interp_insert m (interp τ'.[ren (+m)] Δ) Δ)
interp τ.[iter m up (τ' .: ids)] Δ.
(m : nat)
(Δ : varC -n> valC -n> iProp lang Σ)
(τ : type) (τ' : type) :
interp τ (context_interp_insert m (interp τ'.[ren (+m)] Δ) Δ)
interp τ.[iter m up (τ' .: ids)] Δ.
Proof.
revert m Δ.
induction τ; intros m Δ v; cbn -[extend_context_interp]; auto.
......@@ -505,10 +346,9 @@ Section logrel.
Qed.
Lemma interp_subst
(Δ : varC -n> valC -n> iProp lang Σ)
(τ : type)
(τ' : type)
: interp τ (extend_context_interp (interp τ' Δ) Δ) interp τ.[τ'/] Δ.
(Δ : varC -n> valC -n> iProp lang Σ)
(τ : type) (τ' : type) :
interp τ (extend_context_interp (interp τ' Δ) Δ) interp τ.[τ'/] Δ.
Proof.
rewrite -(interp_subst_iter_up O Δ τ τ').
rewrite context_interp_insert_O_extend.
......@@ -518,15 +358,13 @@ Section logrel.
Lemma zip_with_context_interp_subst
(Δ : varC -n> valC -n> iProp lang Σ) (Γ : list type)
(vs : list valC) (τi : valC -n> iProp lang Σ) :
(([] zip_with (λ τ, interp τ Δ) Γ vs)%I)
([] zip_with (λ τ, interp τ (extend_context_interp τi Δ))
(map (λ t : type, t.[ren (+1)]) Γ) vs)%I.
([] zip_with (λ τ, interp τ Δ) Γ vs)
⊣⊢ ([] zip_with (λ τ, interp τ (extend_context_interp τi Δ))
(map (λ t : type, t.[ren (+1)]) Γ) vs).
Proof.
revert Δ vs τi.
induction Γ as [|Γ]; intros Δ vs τi; cbn; trivial.
destruct vs; cbn; trivial.
apply and_proper.
- apply interp_ren_S.
- apply IHΓ.
apply and_proper. apply interp_ren_S. apply IHΓ.
Qed.
End logrel.
......@@ -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 *)