Commit f1ae6242 by Amin Timany

### 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. Canonical Structure leibniz_val := leibnizC val. Canonical Structure leibniz_le n m := leibnizC (n ≤ m). (* Ltac ipropsimpl := repeat match goal with ... ... @@ -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_r : itauto. Local Hint Extern 2 (_ ⊢ ▷ _)%I => etransitivity; [|rewrite -later_intro] : itauto. 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 τ (Htyped : typed k Γ e τ) (Hctx : closed_ctx k Γ) (HC : closed_type k τ) (HΔ : VlistAlwaysStable Δ) : length Γ = length vs → : List.length Γ = List.length vs → Π∧ zip_with (λ τ v, interp k (` τ) (proj2_sig τ) Δ v) (closed_ctx_list _ Γ Hctx) vs ⊢ WP (e.[env_subst vs]) @ ⊤ {{ λ v, (@interp Σ) k τ HC Δ v }}. Proof. 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 *) destruct (lookup_lt_is_Some_2 vs x) as [v Hv]. { 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. etransitivity. apply big_and_elem_of, elem_of_list_lookup_2 with x. iApply interp_closed_irrel_turnstile. iApply big_and_elem_of "HΓ"; eauto. apply elem_of_list_lookup_2 with x. rewrite lookup_zip_with; simplify_option_eq; trivial. rewrite interp_closed_irrel; trivial. - (* unit *) value_case. - (* pair *) smart_wp_bind (PairLCtx e2.[env_subst vs]) _ v; eauto. (* weird!: and_alwaysstable is an instance but is not resolved! *) smart_wp_bind (PairRCtx v) (and_persistent _ _ _ _) v'. smart_wp_bind (PairLCtx e2.[env_subst vs]) v "# Hv" IHHtyped1. smart_wp_bind (PairRCtx v) v' "# Hv'" IHHtyped2. value_case; eauto 10 with itauto. - (* fst *) smart_wp_bind (FstCtx) v. ipropsimpl; eauto. apply const_elim_l; intros H; rewrite H. rewrite -wp_fst; eauto using to_of_val, and_elim_l. rewrite and_elim_l; rewrite interp_closed_irrel; eauto. smart_wp_bind (FstCtx) v "# Hv" IHHtyped; cbn. iApply double_exists; [|trivial]. intros w w'; cbn; iIntros "#[% [H2 H3]]"; rewrite H; cbn. iApply wp_fst; eauto using to_of_val; cbn. iNext; iApply interp_closed_irrel_turnstile; trivial. - (* snd *) smart_wp_bind SndCtx v. ipropsimpl; eauto. apply const_elim_l; intros H; rewrite H. rewrite -wp_snd; eauto using to_of_val, and_elim_l. rewrite and_elim_r; rewrite interp_closed_irrel; eauto. - (* injl *) smart_wp_bind InjLCtx v; value_case; eauto 7 with itauto. - (* injr *) smart_wp_bind InjRCtx v; value_case; eauto 7 with itauto. smart_wp_bind (SndCtx) v "# Hv" IHHtyped; cbn. iApply double_exists; [|trivial]. intros w w'; cbn; iIntros "#[% [H2 H3]]"; rewrite H. iApply wp_snd; eauto using to_of_val. iNext; iApply interp_closed_irrel_turnstile; trivial. - (* 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 *) smart_wp_bind (CaseCtx _ _) _ v. cbn. rewrite (later_intro (Π∧ zip_with (λ (τ : {τ : type | closed_type k τ}) (v0 : leibniz_val), ((interp k (` τ) (proj2_sig τ)) Δ) v0) (closed_ctx_list k Γ Hctx) vs)); rewrite or_elim; [apply impl_elim_l| |]. + 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_inl; eauto using to_of_val. asimpl. specialize (IHHtyped2 Δ (typed_closed_ctx _ _ _ _ Htyped2) HC HΔ (v'::vs)). erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto). rewrite -IHHtyped2; cbn; auto. 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. smart_wp_bind (CaseCtx _ _) v "#Hv" IHHtyped1; cbn. iDestruct "Hv" as "[Hv|Hv]"; eauto; iRevert "HΓ"; iApply exist_elim; eauto; cbn; iIntros {w} "#[% Hw2] #HΓ"; rewrite H; cbn; [iApply wp_case_inl|iApply wp_case_inr]; auto 1 using to_of_val; asimpl; [specialize (IHHtyped2 Δ (typed_closed_ctx _ _ _ _ Htyped2) HC HΔ (w::vs)) | specialize (IHHtyped3 Δ (typed_closed_ctx _ _ _ _ Htyped3) HC HΔ (w::vs))]; erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto); iNext; [iApply IHHtyped2 | iApply IHHtyped3]; cbn; auto; (iSplit; [iApply interp_closed_irrel_turnstile| iApply type_context_closed_irrel_turnstile]; trivial). - (* lam *) value_case; apply (always_intro _ _), forall_intro=> v /=; apply impl_intro_l. rewrite -wp_lam ?to_of_val //=. asimpl. erewrite typed_subst_head_simpl; [|eauto|cbn]; eauto. rewrite (later_intro (Π∧ _)) -later_and; apply later_mono. rewrite interp_closed_irrel type_context_closed_irrel /closed_ctx_list. rewrite -(IHHtyped Δ (typed_closed_ctx _ _ _ _ Htyped) (closed_type_arrow_2 HC) HΔ (v :: vs)); simpl; auto with f_equal. value_case; apply (always_intro _ _); iIntros {w} "#Hw". iApply wp_lam; auto 1 using to_of_val. asimpl; erewrite typed_subst_head_simpl; [|eauto|cbn]; eauto. iNext; iApply (IHHtyped Δ (typed_closed_ctx _ _ _ _ Htyped) (closed_type_arrow_2 HC) HΔ (w :: vs)); cbn; auto. (iSplit; [iApply interp_closed_irrel_turnstile| iApply type_context_closed_irrel_turnstile]; trivial). - (* app *) smart_wp_bind (AppLCtx (e2.[env_subst vs])) _ v. rewrite -(@wp_bind _ _ _ [AppRCtx v]) /=. rewrite -wp_impl_l /=; apply and_intro. 2: etransitivity; [|apply IHHtyped2]; eauto using and_elim_r. 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. smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHHtyped1. smart_wp_bind (AppRCtx v) w "#Hw" IHHtyped2. iApply wp_mono; [|iApply "Hv"; auto with itauto]. intros; apply interp_closed_irrel_turnstile. - (* TLam *) value_case; rewrite -exist_intro; apply and_intro; auto. apply forall_intro =>τi; apply (always_intro _ _). rewrite map_length in IHHtyped. destruct τi as [τi τiAS]. specialize (IHHtyped (Vlist_cons τi Δ) (closed_ctx_map _ _ _ _ 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. value_case; iApply exist_intro; iSplit; trivial. iIntros {τi}; destruct τi as [τi τiPr]. iPoseProof always_intro "HΓ" as "HP"; try typeclasses eauto; try iExact "HP". iIntros "#HΓ"; iNext. iApply IHHtyped; [rewrite map_length|]; trivial. iRevert "HΓ". rewrite zip_with_closed_ctx_list_subst. iIntros "#HΓ"; trivial. - (* TApp *) smart_wp_bind TAppCtx _ v; cbn. rewrite and_elim_l. rewrite exist_elim; eauto => e'. apply const_elim_l; intros H'; rewrite H'. rewrite (forall_elim ((interp k τ' H Δ) ↾ _)). rewrite always_elim. rewrite -wp_TLam; apply later_mono. apply wp_mono=> w. rewrite interp_subst; trivial. smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn. iApply exist_elim; [|iExact "Hv"]; cbn. iIntros {e'} "[% #He']"; rewrite H0. iApply wp_TLam. iSpecialize "He'" {((interp k τ' H Δ) ↾ _)}; cbn. iApply always_elim. iApply always_mono; [|trivial]. iIntros "He'"; iNext. iApply wp_mono; [|trivial]. intros w; rewrite interp_subst; trivial. - (* 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. specialize (IHHtyped (Vlist_cons (interp k (TRec τ) HC Δ) Δ) (closed_ctx_map _ _ _ _ Hctx (λ τ, closed_type_S_ren2 τ 1 0 _)) (closed_type_rec HC) (alwyas_stable_Vlist_cons _ _ _ _) _ 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. iApply (@wp_bind _ _ _ [FoldCtx]); iApply wp_impl_l; iSplit; [eapply (@always_intro _ _ _ _)| iApply (IHHtyped _ _ (closed_type_rec HC)); trivial]; cbn. + iIntros {v} "#Hv". value_case. rewrite /interp_rec fixpoint_unfold. unfold interp_rec_pre at 1; cbn. eapply (@always_intro _ _ _ _). iApply exist_intro; iSplit; trivial. iNext. change (fixpoint (interp_rec_pre (Vlist_cons_apply Δ (interp (S k) τ (closed_type_rec HC))))) with ((interp k (TRec τ) HC) Δ); trivial. + iRevert "HΓ"; rewrite zip_with_closed_ctx_list_subst; iIntros "#HΓ"; trivial. - (* Unfold *) smart_wp_bind UnfoldCtx _ v; cbn. rewrite and_elim_l. unfold interp_rec. rewrite fixpoint_unfold /interp_rec_pre; cbn. replace (fixpoint (λ rec_apr : leibniz_val -n> iProp lang Σ, CofeMor (λ w : leibniz_val, □ (∃ e1 : expr, w = FoldV e1 ∧ ▷ WP e1 @ ⊤ {{ λ v1 : val, ((interp (S k) τ (closed_type_rec ?HC4)) (Vlist_cons rec_apr Δ)) v1 }}))%I)) with (interp k (TRec τ) (typed_closed_type _ _ _ _ Htyped) Δ) by (cbn; unfold interp_rec; trivial). rewrite always_elim. rewrite exist_elim; eauto => e'. apply const_elim_l; intros H'; rewrite H'. rewrite -wp_Fold. apply later_mono, wp_mono => w. rewrite -interp_subst; eauto. iApply (@wp_bind _ _ _ [UnfoldCtx]); iApply wp_impl_l; iSplit; [eapply (@always_intro _ _ _ _)| iApply (IHHtyped _ _ (typed_closed_type _ _ _ _ Htyped)); trivial]; cbn. iIntros {v}. rewrite /interp_rec fixpoint_unfold. unfold interp_rec_pre at 1; cbn. iIntros "#Hv". iApply exist_elim; [|iAssumption]. iIntros {w}; cbn. change (fixpoint (interp_rec_pre (Vlist_cons_apply Δ (interp (S k) τ (closed_type_rec (typed_closed_type k Γ e (TRec τ) Htyped)))))) with ((interp k (TRec τ) (typed_closed_type k Γ e (TRec τ) Htyped)) Δ); trivial. iIntros "[% #Hw]"; rewrite H. iApply wp_Fold; cbn; auto using to_of_val. iRevert "Hw". rewrite -interp_subst. iIntros "#Hw". trivial. (* unshelving *) 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. End typed_interp. \ No newline at end of file
 ... ... @@ -36,7 +36,7 @@ Module lang. | PairV (v1 v2 : val) | InjLV (v : val) | InjRV (v : val) | FoldV (e : expr). | FoldV (v : val). Fixpoint of_val (v : val) : expr := match v with ... ... @@ -46,7 +46,7 @@ Module lang. | PairV v1 v2 => Pair (of_val v1) (of_val v2) | InjLV v => InjL (of_val v) | InjRV v => InjR (of_val v) | FoldV e => Fold e | FoldV v => Fold (of_val v) end. Fixpoint to_val (e : expr) : option val := match e with ... ... @@ -56,7 +56,7 @@ Module lang. | Pair e1 e2 => v1 ← to_val e1; v2 ← to_val e2; Some (PairV v1 v2) | InjL e => InjLV <\$> to_val e | InjR e => InjRV <\$> to_val e | Fold e => Some (FoldV e) | Fold e => v ← to_val e; Some (FoldV v) | _ => None end. ... ... @@ -72,6 +72,7 @@ Module lang. | InjLCtx | InjRCtx | CaseCtx (e1 : {bind expr}) (e2 : {bind expr}) | FoldCtx | UnfoldCtx. Notation ectx := (list ectx_item). ... ... @@ -88,6 +89,7 @@ Module lang. | InjLCtx => InjL e | InjRCtx => InjR e | CaseCtx e1 e2 => Case e e1 e2 | FoldCtx => Fold e | UnfoldCtx => Unfold e end. Definition fill (K : ectx) (e : expr) : expr := fold_right fill_item e K. ... ... @@ -114,14 +116,15 @@ Module lang. to_val e0 = Some v0 → head_step (Case (InjR e0) e1 e2) σ e2.[e0/] σ None (* Recursive Types *) | Unfold_Fold e σ : | Unfold_Fold e v σ : to_val e = Some v → head_step (Unfold (Fold e)) σ e σ None (* Polymorphic Types *) | TBeta e σ : head_step (TApp (TLam e)) σ e σ None. (** Atomic expressions: we don't consider any atomic operations. *) Definition atomic (e: expr) := False. Definition atomic (e: expr) := false. (** Close reduction under evaluation contexts. We could potentially make this a generic construction. *) ... ... @@ -247,4 +250,4 @@ Global Instance lang_ctx_item Ki : LanguageCtx lang (lang.fill_item Ki). Proof. change (LanguageCtx lang (lang.fill [Ki])). by apply _. Qed. Export lang. \ No newline at end of file Export lang.
 ... ... @@ -17,11 +17,10 @@ Section logrel. 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 /. Definition interp_unit : leibniz_val -n> iProp lang Σ := {| cofe_mor_car := λ w, (w = UnitV)%I ... ... @@ -124,22 +123,22 @@ Section logrel. (rec_apr : (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. Proof. intros τ1 τ1' H1 τ2 τ2' H2 w. apply always_proper; apply exist_proper=>e; apply and_proper; trivial. apply later_proper, wp_proper=>v. apply always_proper, exist_proper=>e; apply and_proper; trivial. apply later_proper. rewrite H1 H2; trivial. Qed. Global Instance interp_rec_pre_ne n : Proper (dist n ==> dist n ==> dist n) interp_rec_pre. Proof. intros τ1 τ1' H1 τ2 τ2' H2 w. apply always_ne; apply exist_ne=>e; apply and_ne; trivial. apply (contractive_ne _), wp_ne=>v. apply always_ne, exist_ne=>e; apply and_ne; trivial. apply (contractive_ne _). rewrite H1 H2; trivial. Qed. ... ... @@ -149,9 +148,9 @@ Section logrel. Contractive (interp_rec_pre τi). Proof. 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 wp_ne; intros v; rewrite H; trivial. rewrite H; trivial. Qed. Definition interp_rec (τi : (leibniz_val -n> iProp lang Σ) -n> (leibniz_val -n> iProp lang Σ)) ... ... @@ -242,12 +241,21 @@ Section logrel. let H := fresh "H" in intros H; inversion H; congruence end. 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 := from_option (Var x) (of_val <\$> vs !! x). 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)] . Proof. ... ... @@ -264,7 +272,7 @@ Section logrel. (f : leibniz_val -n> iProp lang Σ) {Hf : Val_to_IProp_AlwaysStable f} (v : val) : Persistent (f v). : PersistentP (f v). Proof. apply Hf. Qed. Global Instance interp_always_stable ... ... @@ -272,20 +280,21 @@ Section logrel. {HΔ : VlistAlwaysStable Δ} : Val_to_IProp_AlwaysStable (interp k τ H Δ). Proof. induction τ; cbn; intros v; try apply _. - rewrite /interp_rec /Persistent fixpoint_unfold /interp_rec_pre. apply always_intro'; trivial. - apply (@force_lookup_Forall _ _ (λ f : leibniz_val -n> iProp lang Σ, Persistent (f v))). apply Forall_forall => f H1. eapply Forall_forall in HΔ; [apply HΔ|trivial]. revert k H Δ HΔ. induction τ; cbn; intros k H Δ HΔ v; try apply _. - rewrite /PersistentP /interp_rec fixpoint_unfold /interp_rec_pre; cbn. apply always_intro'; trivial. - apply (@force_lookup_Forall _ _ (λ f : leibniz_val -n> iProp lang Σ, PersistentP (f v))). apply Forall_forall => f H1. eapply Forall_forall in HΔ; [apply HΔ|trivial]. Qed. Global Instance alwyas_stable_Δ k Δ Γ vs (Hctx : closed_ctx k Γ) {HΔ : VlistAlwaysStable Δ} : Persistent (Π∧ zip_with (λ τ v, interp k (` τ) (proj2_sig τ) Δ v) (closed_ctx_list _ Γ Hctx) vs)%I. : PersistentP (Π∧ zip_with (λ τ v, interp k (` τ) (proj2_sig τ) Δ v) (closed_ctx_list _ Γ Hctx) vs)%I. Proof. typeclasses eauto. Qed. Global Instance alwyas_stable_Vlist_cons k f Δ ... ... @@ -318,6 +327,25 @@ Section logrel. - apply IHΓ. Qed. Lemma type_context_closed_irrel_turnstile (k : nat) (Δ : Vlist (leibniz_val -n> iProp lang Σ) k) (Γ : list type) (vs : list leibniz_val) (Hctx Hctx' : closed_ctx k Γ) : (Π∧ zip_with (λ (τ : {τ : type | closed_type k τ}) (v0 : leibniz_val), ((interp k (` τ) (proj2_sig τ)) Δ) v0) (closed_ctx_list k Γ Hctx) vs)%I ⊢ (Π∧ zip_with (λ (τ : {τ : type | closed_type k τ}) (v : leibniz_val), ((interp k (` τ) (proj2_sig τ)) Δ) v) (closed_ctx_list k Γ Hctx') vs)%I. Proof. rewrite type_context_closed_irrel; trivial. Qed. Local Ltac ipropsimpl := repeat match goal with ... ... @@ -514,4 +542,4 @@ Section logrel. - apply IHΓ. Qed. End logrel. \ No newline at end of file End logrel.
 ... ... @@ -94,11 +94,13 @@ Section lang_rules. - by rewrite right_id. Qed. Lemma wp_Fold E e Q : ▷ wp E e Q ⊢ wp E (Unfold (Fold e)) Q. Lemma wp_Fold E e v Q : to_val e = Some v → ▷ Q v ⊢ wp E (Unfold (Fold e)) Q. Proof. rewrite -(wp_lift_pure_det_step (Unfold _) e None) //=; auto. - by rewrite right_id. intros <-%of_to_val. rewrite -(wp_lift_pure_det_step (Unfold _) (of_val v) None) //=; auto. - rewrite right_id; auto using uPred.later_mono, wp_value'. Qed. Lemma wp_fst E e1 v1 e2 v2 Q : ... ...
 ... ... @@ -334,4 +334,14 @@ Proof. (s1 s2 : nat → A) x, (x ≠ 0 → s1 (pred x) = s2 (pred x)) → up s1 x = up s2 x). { intros A H1 H2. rewrite /up=> s1 s2 [|x] //=; auto with f_equal omega. } induction Htyped => s1 s2 Hs; f_equal/=; eauto using lookup_lt_Some with omega typed_subst_invariant. Qed. Lemma closed_ctx_map_S_back (k : nat) (Γ : list type) (e : expr) (τ : type) : closed_ctx k Γ → closed_ctx (S k) (map (λ t : type, t.[ren (+1)]) Γ). Proof. intros H. eapply closed_ctx_map; [eassumption|]. clear; intros τ' H'. set (HW := closed_type_S_ren2 τ' 1 0); cbn in HW; apply HW; trivial. Qed. \ No newline at end of file
This diff is collapsed.
 ... ... @@ -53,7 +53,7 @@ Module lang. | PairV (v1 v2 : val) | InjLV (v :