Commit f1ae6242 authored by Amin Timany's avatar Amin Timany
Browse files

Squashed commit of the following:

commit 392b7b43
Author: Amin Timany <amintimany@gmail.com>
Date:   Tue May 3 21:25:10 2016 +0200

    Finish using new iris with "proof mode"

    In Fμ and Fμ_ref we do support reduction under Fold.
    In fact `Unfold (Fold v)` is reduced to `v` if and only if v is a variable.

commit 9825e341
Author: Amin Timany <amintimany@gmail.com>
Date:   Mon May 2 20:35:57 2016 +0200

    Prove fundamental lemma of stlc is proven

    Change the Fμ to make the operational semantics reduce under Fold.
    Fundamental lemma for Fμ is partially proven (up to App).
parent a0f07fe1
...@@ -13,7 +13,7 @@ Section typed_interp. ...@@ -13,7 +13,7 @@ Section typed_interp.
Canonical Structure leibniz_val := leibnizC val. Canonical Structure leibniz_val := leibnizC val.
Canonical Structure leibniz_le n m := leibnizC (n m). Canonical Structure leibniz_le n m := leibnizC (n m).
(*
Ltac ipropsimpl := Ltac ipropsimpl :=
repeat repeat
match goal with match goal with
...@@ -39,172 +39,173 @@ Section typed_interp. ...@@ -39,172 +39,173 @@ Section typed_interp.
Local Hint Extern 3 (_ (_ _))%I => rewrite -or_intro_l : itauto. Local Hint Extern 3 (_ (_ _))%I => rewrite -or_intro_l : itauto.
Local Hint Extern 3 (_ (_ _))%I => rewrite -or_intro_r : itauto. Local Hint Extern 3 (_ (_ _))%I => rewrite -or_intro_r : itauto.
Local Hint Extern 2 (_ _)%I => etransitivity; [|rewrite -later_intro] : itauto. Local Hint Extern 2 (_ _)%I => etransitivity; [|rewrite -later_intro] : itauto.
Local Ltac value_case := rewrite -wp_value/= ?to_of_val //; auto 2. Local Ltac value_case := rewrite -wp_value/= ?to_of_val //; auto 2.
*)
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
_ : ?A, _) => let W := fresh "W" in evar (W : A); iExists W; unfold W; clear W
end : itauto.
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
_) => iNext
end : itauto.
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
(_ _)) => iSplit
end : itauto.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) :=
iApply (@wp_bind _ _ _ [ctx]);
iApply wp_impl_l;
iSplit; [| iApply Hp; trivial]; cbn;
eapply (@always_intro _ _ _ _);
iIntros {v} Hv.
Local Ltac value_case := iApply wp_value; cbn; rewrite ?to_of_val; trivial.
Lemma typed_interp k Δ Γ vs e τ Lemma typed_interp k Δ Γ vs e τ
(Htyped : typed k Γ e τ) (Htyped : typed k Γ e τ)
(Hctx : closed_ctx k Γ) (Hctx : closed_ctx k Γ)
(HC : closed_type k τ) (HC : closed_type k τ)
(HΔ : VlistAlwaysStable Δ) (HΔ : VlistAlwaysStable Δ)
: length Γ = length vs : List.length Γ = List.length vs
Π∧ zip_with (λ τ v, interp k (` τ) (proj2_sig τ) Δ v) (closed_ctx_list _ Γ Hctx) vs Π∧ zip_with (λ τ v, interp k (` τ) (proj2_sig τ) Δ v) (closed_ctx_list _ Γ Hctx) vs
WP (e.[env_subst vs]) @ {{ λ v, (@interp Σ) k τ HC Δ v }}. WP (e.[env_subst vs]) @ {{ λ v, (@interp Σ) k τ HC Δ v }}.
Proof. Proof.
revert Hctx HC HΔ vs. revert Hctx HC HΔ vs.
induction Htyped; intros Hctx HC HΔ vs Hlen; cbn. induction Htyped; intros Hctx HC 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 τ. }
rewrite /env_subst Hv /= -wp_value; eauto using to_of_val. rewrite /env_subst Hv; value_case.
edestruct (zipwith_Forall_lookup _ Hctx) as [Hτ' Hτ'eq]; eauto. edestruct (zipwith_Forall_lookup _ Hctx) as [Hτ' Hτ'eq]; eauto.
etransitivity. iApply interp_closed_irrel_turnstile.
apply big_and_elem_of, elem_of_list_lookup_2 with x. iApply big_and_elem_of "HΓ"; eauto.
apply elem_of_list_lookup_2 with x.
rewrite lookup_zip_with; simplify_option_eq; trivial. rewrite lookup_zip_with; simplify_option_eq; trivial.
rewrite interp_closed_irrel; trivial.
- (* unit *) value_case. - (* unit *) value_case.
- (* pair *) - (* pair *)
smart_wp_bind (PairLCtx e2.[env_subst vs]) _ v; eauto. smart_wp_bind (PairLCtx e2.[env_subst vs]) v "# Hv" IHHtyped1.
(* weird!: and_alwaysstable is an instance but is not resolved! *) smart_wp_bind (PairRCtx v) v' "# Hv'" IHHtyped2.
smart_wp_bind (PairRCtx v) (and_persistent _ _ _ _) v'.
value_case; eauto 10 with itauto. value_case; eauto 10 with itauto.
- (* fst *) - (* fst *)
smart_wp_bind (FstCtx) v. ipropsimpl; eauto. smart_wp_bind (FstCtx) v "# Hv" IHHtyped; cbn.
apply const_elim_l; intros H; rewrite H. iApply double_exists; [|trivial].
rewrite -wp_fst; eauto using to_of_val, and_elim_l. intros w w'; cbn; iIntros "#[% [H2 H3]]"; rewrite H; cbn.
rewrite and_elim_l; rewrite interp_closed_irrel; eauto. iApply wp_fst; eauto using to_of_val; cbn.
iNext; iApply interp_closed_irrel_turnstile; trivial.
- (* snd *) - (* snd *)
smart_wp_bind SndCtx v. ipropsimpl; eauto. smart_wp_bind (SndCtx) v "# Hv" IHHtyped; cbn.
apply const_elim_l; intros H; rewrite H. iApply double_exists; [|trivial].
rewrite -wp_snd; eauto using to_of_val, and_elim_l. intros w w'; cbn; iIntros "#[% [H2 H3]]"; rewrite H.
rewrite and_elim_r; rewrite interp_closed_irrel; eauto. iApply wp_snd; eauto using to_of_val.
- (* injl *) smart_wp_bind InjLCtx v; value_case; eauto 7 with itauto. iNext; iApply interp_closed_irrel_turnstile; trivial.
- (* injr *) smart_wp_bind InjRCtx v; value_case; eauto 7 with itauto. - (* injl *)
smart_wp_bind (InjLCtx) v "# Hv" IHHtyped; cbn.
value_case; iLeft; auto with itauto.
- (* injr *)
smart_wp_bind (InjRCtx) v "# Hv" IHHtyped; cbn.
value_case; iRight; auto with itauto.
- (* case *) - (* case *)
smart_wp_bind (CaseCtx _ _) _ v. cbn. smart_wp_bind (CaseCtx _ _) v "#Hv" IHHtyped1; cbn.
rewrite (later_intro (Π∧ zip_with iDestruct "Hv" as "[Hv|Hv]"; eauto; iRevert "HΓ";
(λ (τ : {τ : type | closed_type k τ}) (v0 : leibniz_val), iApply exist_elim; eauto; cbn;
((interp k (` τ) (proj2_sig τ)) Δ) v0) (closed_ctx_list k Γ Hctx) vs)); iIntros {w} "#[% Hw2] #HΓ"; rewrite H; cbn;
rewrite or_elim; [apply impl_elim_l| |]. [iApply wp_case_inl|iApply wp_case_inr];
+ rewrite exist_elim; eauto; intros v'. auto 1 using to_of_val;
apply const_elim_l; intros H; rewrite H. asimpl;
rewrite -impl_intro_r //; rewrite -later_and later_mono; eauto. [specialize (IHHtyped2 Δ (typed_closed_ctx _ _ _ _ Htyped2) HC HΔ (w::vs)) |
rewrite -wp_case_inl; eauto using to_of_val. specialize (IHHtyped3 Δ (typed_closed_ctx _ _ _ _ Htyped3) HC HΔ (w::vs))];
asimpl. erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto); iNext;
specialize (IHHtyped2 Δ (typed_closed_ctx _ _ _ _ Htyped2) HC HΔ (v'::vs)). [iApply IHHtyped2 | iApply IHHtyped3]; cbn; auto;
erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto). (iSplit; [iApply interp_closed_irrel_turnstile|
rewrite -IHHtyped2; cbn; auto. iApply type_context_closed_irrel_turnstile]; trivial).
rewrite interp_closed_irrel type_context_closed_irrel /closed_ctx_list.
apply later_mono, and_intro; eauto 3 with itauto.
+ rewrite exist_elim; eauto; intros v'.
apply const_elim_l; intros H; rewrite H.
rewrite -impl_intro_r //; rewrite -later_and later_mono; eauto.
rewrite -wp_case_inr; eauto using to_of_val.
asimpl.
specialize (IHHtyped3 Δ (typed_closed_ctx _ _ _ _ Htyped3) HC HΔ (v'::vs)).
erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto).
rewrite -IHHtyped3; cbn; auto.
rewrite interp_closed_irrel type_context_closed_irrel /closed_ctx_list.
apply later_mono, and_intro; eauto 3 with itauto.
- (* lam *) - (* lam *)
value_case; apply (always_intro _ _), forall_intro=> v /=; apply impl_intro_l. value_case; apply (always_intro _ _); iIntros {w} "#Hw".
rewrite -wp_lam ?to_of_val //=. iApply wp_lam; auto 1 using to_of_val.
asimpl. erewrite typed_subst_head_simpl; [|eauto|cbn]; eauto. asimpl; erewrite typed_subst_head_simpl; [|eauto|cbn]; eauto.
rewrite (later_intro (Π∧ _)) -later_and; apply later_mono. iNext; iApply (IHHtyped Δ (typed_closed_ctx _ _ _ _ Htyped) (closed_type_arrow_2 HC)
rewrite interp_closed_irrel type_context_closed_irrel /closed_ctx_list. HΔ (w :: vs)); cbn; auto.
rewrite -(IHHtyped Δ (typed_closed_ctx _ _ _ _ Htyped) (closed_type_arrow_2 HC) HΔ (v :: vs)); (iSplit; [iApply interp_closed_irrel_turnstile|
simpl; auto with f_equal. iApply type_context_closed_irrel_turnstile]; trivial).
- (* app *) - (* app *)
smart_wp_bind (AppLCtx (e2.[env_subst vs])) _ v. smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHHtyped1.
rewrite -(@wp_bind _ _ _ [AppRCtx v]) /=. smart_wp_bind (AppRCtx v) w "#Hw" IHHtyped2.
rewrite -wp_impl_l /=; apply and_intro. iApply wp_mono; [|iApply "Hv"; auto with itauto].
2: etransitivity; [|apply IHHtyped2]; eauto using and_elim_r. intros; apply interp_closed_irrel_turnstile.
rewrite and_elim_l. apply always_mono.
apply forall_intro =>v'.
rewrite forall_elim.
apply impl_intro_l.
rewrite -(later_intro).
etransitivity; [apply impl_elim_r|].
apply wp_mono => w.
rewrite interp_closed_irrel; trivial.
- (* TLam *) - (* TLam *)
value_case; rewrite -exist_intro; apply and_intro; auto. value_case; iApply exist_intro; iSplit; trivial.
apply forall_intro =>τi; iIntros {τi}; destruct τi as [τi τiPr].
apply (always_intro _ _). iPoseProof always_intro "HΓ" as "HP"; try typeclasses eauto; try iExact "HP".
rewrite map_length in IHHtyped. iIntros "#HΓ"; iNext.
destruct τi as [τi τiAS]. iApply IHHtyped; [rewrite map_length|]; trivial.
specialize (IHHtyped iRevert "HΓ".
(Vlist_cons τi Δ) rewrite zip_with_closed_ctx_list_subst.
(closed_ctx_map iIntros "#HΓ"; trivial.
_ _ _ _
Hctx (λ τ, closed_type_S_ren2 τ 1 0 _))
(closed_type_forall HC)
(alwyas_stable_Vlist_cons _ _ _ τiAS)
_
Hlen
).
rewrite -wp_impl_l -later_intro. apply and_intro;
[ apply (always_intro _ _), forall_intro=> v /=; apply impl_intro_l|].
2: etransitivity; [|apply IHHtyped].
+ rewrite and_elim_l; trivial.
+ rewrite zip_with_closed_ctx_list_subst; trivial.
- (* TApp *) - (* TApp *)
smart_wp_bind TAppCtx _ v; cbn. smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn.
rewrite and_elim_l. iApply exist_elim; [|iExact "Hv"]; cbn.
rewrite exist_elim; eauto => e'. iIntros {e'} "[% #He']"; rewrite H0.
apply const_elim_l; intros H'; rewrite H'. iApply wp_TLam.
rewrite (forall_elim ((interp k τ' H Δ) _)). iSpecialize "He'" {((interp k τ' H Δ) _)}; cbn.
rewrite always_elim. iApply always_elim. iApply always_mono; [|trivial].
rewrite -wp_TLam; apply later_mono. iIntros "He'"; iNext.
apply wp_mono=> w. iApply wp_mono; [|trivial].
rewrite interp_subst; trivial. intros w; rewrite interp_subst; trivial.
- (* Fold *) - (* Fold *)
value_case. unfold interp_rec.
rewrite fixpoint_unfold.
cbn.
rewrite -exist_intro.
apply (always_intro _ _).
apply and_intro; auto.
rewrite map_length in IHHtyped. rewrite map_length in IHHtyped.
specialize (IHHtyped iApply (@wp_bind _ _ _ [FoldCtx]);
(Vlist_cons (interp k (TRec τ) HC Δ) Δ) iApply wp_impl_l;
(closed_ctx_map iSplit; [eapply (@always_intro _ _ _ _)|
_ _ _ _ iApply (IHHtyped _ _ (closed_type_rec HC)); trivial]; cbn.
Hctx (λ τ, closed_type_S_ren2 τ 1 0 _)) + iIntros {v} "#Hv".
(closed_type_rec HC) value_case. rewrite /interp_rec fixpoint_unfold. unfold interp_rec_pre at 1; cbn.
(alwyas_stable_Vlist_cons _ _ _ _) eapply (@always_intro _ _ _ _).
_ iApply exist_intro; iSplit; trivial.
Hlen iNext.
). change (fixpoint (interp_rec_pre
rewrite -wp_impl_l -later_intro. apply and_intro; (Vlist_cons_apply Δ (interp (S k) τ (closed_type_rec HC)))))
[ apply (always_intro _ _), forall_intro=> v /=; apply impl_intro_l|]. with ((interp k (TRec τ) HC) Δ); trivial.
2: etransitivity; [|apply IHHtyped]. + iRevert "HΓ"; rewrite zip_with_closed_ctx_list_subst; iIntros "#HΓ"; trivial.
+ rewrite and_elim_l; trivial.
+ rewrite zip_with_closed_ctx_list_subst; trivial.
- (* Unfold *) - (* Unfold *)
smart_wp_bind UnfoldCtx _ v; cbn. iApply (@wp_bind _ _ _ [UnfoldCtx]);
rewrite and_elim_l. iApply wp_impl_l;
unfold interp_rec. rewrite fixpoint_unfold /interp_rec_pre; cbn. iSplit; [eapply (@always_intro _ _ _ _)|
replace (fixpoint iApply (IHHtyped _ _ (typed_closed_type _ _ _ _ Htyped)); trivial]; cbn.
(λ rec_apr : leibniz_val -n> iProp lang Σ, iIntros {v}.
CofeMor rewrite /interp_rec fixpoint_unfold. unfold interp_rec_pre at 1; cbn.
(λ w : leibniz_val, iIntros "#Hv".
( e1 : expr, iApply exist_elim; [|iAssumption].
w = FoldV e1 iIntros {w}; cbn.
WP e1 @ {{ λ v1 : val, change (fixpoint (interp_rec_pre
((interp (S k) τ (closed_type_rec ?HC4)) (Vlist_cons_apply
(Vlist_cons rec_apr Δ)) v1 }}))%I)) Δ
with (interp
(interp k (TRec τ) (typed_closed_type _ _ _ _ Htyped) Δ) by (cbn; unfold interp_rec; trivial). (S k) τ
rewrite always_elim. (closed_type_rec
rewrite exist_elim; eauto => e'. (typed_closed_type k Γ e (TRec τ) Htyped))))))
apply const_elim_l; intros H'; rewrite H'. with ((interp k (TRec τ) (typed_closed_type k Γ e (TRec τ) Htyped)) Δ); trivial.
rewrite -wp_Fold. iIntros "[% #Hw]"; rewrite H.
apply later_mono, wp_mono => w. iApply wp_Fold; cbn; auto using to_of_val.
rewrite -interp_subst; eauto. iRevert "Hw". rewrite -interp_subst. iIntros "#Hw". trivial.
(* unshelving *) (* unshelving *)
Unshelve. Unshelve.
all: solve [eauto 2 using typed_closed_type | try typeclasses eauto]. all: cbn; solve [eauto 2 using closed_ctx_map_S_back,
typed_closed_type | try typeclasses eauto].
Qed. Qed.
End typed_interp. End typed_interp.
\ No newline at end of file
...@@ -36,7 +36,7 @@ Module lang. ...@@ -36,7 +36,7 @@ Module lang.
| PairV (v1 v2 : val) | PairV (v1 v2 : val)
| InjLV (v : val) | InjLV (v : val)
| InjRV (v : val) | InjRV (v : val)
| FoldV (e : expr). | FoldV (v : val).
Fixpoint of_val (v : val) : expr := Fixpoint of_val (v : val) : expr :=
match v with match v with
...@@ -46,7 +46,7 @@ Module lang. ...@@ -46,7 +46,7 @@ Module lang.
| PairV v1 v2 => Pair (of_val v1) (of_val v2) | PairV v1 v2 => Pair (of_val v1) (of_val v2)
| InjLV v => InjL (of_val v) | InjLV v => InjL (of_val v)
| InjRV v => InjR (of_val v) | InjRV v => InjR (of_val v)
| FoldV e => Fold e | FoldV v => Fold (of_val v)
end. end.
Fixpoint to_val (e : expr) : option val := Fixpoint to_val (e : expr) : option val :=
match e with match e with
...@@ -56,7 +56,7 @@ Module lang. ...@@ -56,7 +56,7 @@ Module lang.
| Pair e1 e2 => v1 to_val e1; v2 to_val e2; Some (PairV v1 v2) | Pair e1 e2 => v1 to_val e1; v2 to_val e2; Some (PairV v1 v2)
| InjL e => InjLV <$> to_val e | InjL e => InjLV <$> to_val e
| InjR e => InjRV <$> to_val e | InjR e => InjRV <$> to_val e
| Fold e => Some (FoldV e) | Fold e => v to_val e; Some (FoldV v)
| _ => None | _ => None
end. end.
...@@ -72,6 +72,7 @@ Module lang. ...@@ -72,6 +72,7 @@ Module lang.
| InjLCtx | InjLCtx
| InjRCtx | InjRCtx
| CaseCtx (e1 : {bind expr}) (e2 : {bind expr}) | CaseCtx (e1 : {bind expr}) (e2 : {bind expr})
| FoldCtx
| UnfoldCtx. | UnfoldCtx.
Notation ectx := (list ectx_item). Notation ectx := (list ectx_item).
...@@ -88,6 +89,7 @@ Module lang. ...@@ -88,6 +89,7 @@ Module lang.
| InjLCtx => InjL e | InjLCtx => InjL e
| InjRCtx => InjR e | InjRCtx => InjR e
| CaseCtx e1 e2 => Case e e1 e2 | CaseCtx e1 e2 => Case e e1 e2
| FoldCtx => Fold e
| UnfoldCtx => Unfold e | UnfoldCtx => Unfold e
end. end.
Definition fill (K : ectx) (e : expr) : expr := fold_right fill_item e K. Definition fill (K : ectx) (e : expr) : expr := fold_right fill_item e K.
...@@ -114,14 +116,15 @@ Module lang. ...@@ -114,14 +116,15 @@ Module lang.
to_val e0 = Some v0 to_val e0 = Some v0
head_step (Case (InjR e0) e1 e2) σ e2.[e0/] σ None head_step (Case (InjR e0) e1 e2) σ e2.[e0/] σ None
(* Recursive Types *) (* Recursive Types *)
| Unfold_Fold e σ : | Unfold_Fold e v σ :
to_val e = Some v
head_step (Unfold (Fold e)) σ e σ None head_step (Unfold (Fold e)) σ e σ None
(* Polymorphic Types *) (* Polymorphic Types *)
| TBeta e σ : | TBeta e σ :
head_step (TApp (TLam e)) σ e σ None. head_step (TApp (TLam e)) σ e σ None.
(** Atomic expressions: we don't consider any atomic operations. *) (** Atomic expressions: we don't consider any atomic operations. *)
Definition atomic (e: expr) := False. Definition atomic (e: expr) := false.
(** Close reduction under evaluation contexts. (** Close reduction under evaluation contexts.
We could potentially make this a generic construction. *) We could potentially make this a generic construction. *)
...@@ -247,4 +250,4 @@ Global Instance lang_ctx_item Ki : ...@@ -247,4 +250,4 @@ Global Instance lang_ctx_item Ki :
LanguageCtx lang (lang.fill_item Ki). LanguageCtx lang (lang.fill_item Ki).
Proof. change (LanguageCtx lang (lang.fill [Ki])). by apply _. Qed. Proof. change (LanguageCtx lang (lang.fill [Ki])). by apply _. Qed.
Export lang. Export lang.
\ No newline at end of file
...@@ -17,11 +17,10 @@ Section logrel. ...@@ -17,11 +17,10 @@ Section logrel.
Class Val_to_IProp_AlwaysStable (f : leibniz_val -n> iProp lang Σ) := Class Val_to_IProp_AlwaysStable (f : leibniz_val -n> iProp lang Σ) :=
val_to_iprop_always_stable : v : val, Persistent ((cofe_mor_car _ _ f) v). val_to_iprop_always_stable : v : val, PersistentP ((cofe_mor_car _ _ f) v).
Arguments val_to_iprop_always_stable /. Arguments val_to_iprop_always_stable /.
Definition interp_unit : leibniz_val -n> iProp lang Σ := Definition interp_unit : leibniz_val -n> iProp lang Σ :=
{| {|
cofe_mor_car := λ w, (w = UnitV)%I cofe_mor_car := λ w, (w = UnitV)%I
...@@ -124,22 +123,22 @@ Section logrel. ...@@ -124,22 +123,22 @@ Section logrel.
(rec_apr : (leibniz_val -n> iProp lang Σ)) (rec_apr : (leibniz_val -n> iProp lang Σ))
: (leibniz_val -n> iProp lang Σ) := : (leibniz_val -n> iProp lang Σ) :=
{| {|
cofe_mor_car := λ w, ( ( e, w = FoldV e WP e @ {{ λ v, τi rec_apr v}}))%I cofe_mor_car := λ w, ( ( v, w = FoldV v (τi rec_apr v)))%I
|}. |}.
Global Instance interp_rec_pre_proper : Proper (() ==> () ==> ()) interp_rec_pre. Global Instance interp_rec_pre_proper : Proper (() ==> () ==> ()) interp_rec_pre.
Proof. Proof.
intros τ1 τ1' H1 τ2 τ2' H2 w. intros τ1 τ1' H1 τ2 τ2' H2 w.
apply always_proper; apply exist_proper=>e; apply and_proper; trivial. apply always_proper, exist_proper=>e; apply and_proper; trivial.
apply later_proper, wp_proper=>v. apply later_proper.
rewrite H1 H2; trivial. rewrite H1 H2; trivial.
Qed. Qed.
Global Instance interp_rec_pre_ne n : Proper (dist n ==> dist n ==> dist n) interp_rec_pre. Global Instance interp_rec_pre_ne n : Proper (dist n ==> dist n ==> dist n) interp_rec_pre.
Proof. Proof.
intros τ1 τ1' H1 τ2 τ2' H2 w. intros τ1 τ1' H1 τ2 τ2' H2 w.
apply always_ne; apply exist_ne=>e; apply and_ne; trivial. apply always_ne, exist_ne=>e; apply and_ne; trivial.
apply (contractive_ne _), wp_ne=>v. apply (contractive_ne _).
rewrite H1 H2; trivial. rewrite H1 H2; trivial.
Qed. Qed.
...@@ -149,9 +148,9 @@ Section logrel. ...@@ -149,9 +148,9 @@ Section logrel.
Contractive (interp_rec_pre τi). Contractive (interp_rec_pre τi).
Proof. Proof.
intros n f g H w; cbn. intros n f g H w; cbn.
apply always_ne;apply exist_ne; intros e; apply and_ne; trivial. apply always_ne, exist_ne; intros e; apply and_ne; trivial.
apply later_contractive =>i Hi. apply later_contractive =>i Hi.
apply wp_ne; intros v; rewrite H; trivial. rewrite H; trivial.
Qed. Qed.
Definition interp_rec (τi : (leibniz_val -n> iProp lang Σ) -n> (leibniz_val -n> iProp lang Σ)) Definition interp_rec (τi : (leibniz_val -n> iProp lang Σ) -n> (leibniz_val -n> iProp lang Σ))
...@@ -242,12 +241,21 @@ Section logrel. ...@@ -242,12 +241,21 @@ Section logrel.
let H := fresh "H" in intros H; inversion H; congruence let H := fresh "H" in intros H; inversion H; congruence
end. end.
Qed. Qed.
Lemma interp_closed_irrel_turnstile
(k : nat) (τ : type) (HC HC': closed_type k τ)
(Δ : Vlist (leibniz_val -n> iProp lang Σ) k)
(v : val)
: interp k τ HC Δ v interp k τ HC' Δ v.
Proof.
rewrite interp_closed_irrel; trivial.
Qed.
Definition env_subst (vs : list val) (x : var) : expr := Definition env_subst (vs : list val) (x : var) : expr :=
from_option (Var x) (of_val <$> vs !! x). from_option (Var x) (of_val <$> vs !! x).
Lemma typed_subst_head_simpl k Δ τ e w ws : Lemma typed_subst_head_simpl k Δ τ e w ws :
typed k Δ e τ -> length Δ = S (length ws) typed k Δ e τ -> List.length Δ = S (List.length ws)
e.[# w .: env_subst ws] = e.[env_subst (w :: ws)] e.[# w .: env_subst ws] = e.[env_subst (w :: ws)]
. .
Proof. Proof.
...@@ -264,7 +272,7 @@ Section logrel. ...@@ -264,7 +272,7 @@ Section logrel.
(f : leibniz_val -n> iProp lang Σ) (f : leibniz_val -n> iProp lang Σ)
{Hf : Val_to_IProp_AlwaysStable f} {Hf : Val_to_IProp_AlwaysStable f}
(v : val) (v : val)
: Persistent (f v). : PersistentP (f v).
Proof. apply Hf. Qed. Proof. apply Hf. Qed.
Global Instance interp_always_stable Global Instance interp_always_stable
...@@ -272,20 +280,21 @@ Section logrel. ...@@ -272,20 +280,21 @@ Section logrel.
{HΔ : VlistAlwaysStable Δ} {HΔ : VlistAlwaysStable Δ}
: Val_to_IProp_AlwaysStable (interp k τ H Δ). : Val_to_IProp_AlwaysStable (interp k τ H Δ).
Proof. Proof.
induction τ; cbn; intros v; try apply _. revert k H Δ HΔ.
- rewrite /interp_rec /Persistent fixpoint_unfold /interp_rec_pre. induction τ; cbn; intros k H Δ HΔ v; try apply _.
apply always_intro'; trivial. - rewrite /PersistentP /interp_rec fixpoint_unfold /interp_rec_pre; cbn.
- apply (@force_lookup_Forall apply always_intro<