Commit a3479c77 by Amin Timany

### Make lambda in Fμ,ref,par recursive

```We used to have:

(λ x, b) a ->β b[a/x]

But now we have:

(λ f x, b) a ->β b[a/x, (λ f x, b)/f]```
parent c7a553d3
 ... ... @@ -186,23 +186,27 @@ Section typed_interp. Lemma typed_binary_interp_Lam Δ Γ e e' τ1 τ2 {HΔ : ✓✓ Δ} (Htyped : typed (τ1 :: Γ) e τ2) (Htyped' : typed (τ1 :: Γ) e' τ2) (IHHtyped : Δ ∥ τ1 :: Γ ⊩ e ≤log≤ e' ∷ τ2) (Htyped : typed (TArrow τ1 τ2 :: τ1 :: Γ) e τ2) (Htyped' : typed (TArrow τ1 τ2 :: τ1 :: Γ) e' τ2) (IHHtyped : Δ ∥ TArrow τ1 τ2 :: τ1 :: Γ ⊩ e ≤log≤ e' ∷ τ2) : Δ ∥ Γ ⊩ Lam e ≤log≤ Lam e' ∷ TArrow τ1 τ2. Proof. intros vs Hlen ρ j K. iIntros "[#Hheap [#Hspec [#HΓ Htr]]]"; cbn. value_case. iExists (LamV _). iFrame "Htr". iApply löb. rewrite -always_later. iIntros "#Hlat". iAlways. iIntros {j' K' v} "[#Hiv Hv]". iApply wp_lam; auto 1 using to_of_val. iNext. iPvs (step_lam _ _ _ j' K' _ (# (v.2)) (v.2) _ _ with "* -") as "Hz". iFrame "Hspec Hv"; trivial. asimpl. erewrite ?typed_subst_head_simpl; eauto; simpl; try rewrite map_length; eauto with f_equal. specialize (IHHtyped (v::vs)); simpl in IHHtyped. asimpl. specialize (IHHtyped ((LamV e.[upn 2 (env_subst (map fst vs))], LamV e'.[upn 2 (env_subst (map snd vs))]) :: v :: vs)). simpl in IHHtyped. erewrite <- ?typed_subst_head_simpl_2 in IHHtyped; eauto; simpl; try rewrite map_length; auto. iApply IHHtyped; auto. iFrame "Hheap Hspec Hiv HΓ"; trivial. repeat iSplitR; trivial. repeat iSplit; trivial. (* unshelving *) Unshelve. all: eauto using to_of_val. Qed. ... ...
 ... ... @@ -106,10 +106,13 @@ Section typed_interp. erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto); iNext; [iApply IHHtyped2 | iApply IHHtyped3]; cbn; auto with itauto. - (* lam *) value_case; apply (always_intro _ _); iIntros {w} "#Hw". value_case. iApply löb. rewrite -always_later. iIntros "#Hlat". iAlways. iIntros {w} "#Hw". iApply wp_lam; auto 1 using to_of_val. asimpl; erewrite typed_subst_head_simpl; [|eauto|cbn]; eauto. iNext; iApply (IHHtyped Δ HΔ (w :: vs)); cbn; auto with itauto. asimpl. change (Lam _) with (# (LamV e.[upn 2 (env_subst vs)])). erewrite typed_subst_head_simpl_2; [|eauto|cbn]; eauto. iNext; iApply (IHHtyped Δ HΔ (_ :: w :: vs)); cbn; auto. repeat iSplit; trivial. - (* app *) smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHHtyped1. smart_wp_bind (AppRCtx v) w "#Hw" IHHtyped2. ... ...
 ... ... @@ -10,7 +10,7 @@ Module lang. Inductive expr := | Var (x : var) | Lam (e : {bind 1 of expr}) | Lam (e : {bind 2 of expr}) | App (e1 e2 : expr) (* Unit *) | Unit ... ... @@ -155,7 +155,7 @@ Module lang. (* β *) | BetaS e1 e2 v2 σ : to_val e2 = Some v2 → head_step (App (Lam e1) e2) σ e1.[e2/] σ None head_step (App (Lam e1) e2) σ e1.[(Lam e1), e2/] σ None (* Products *) | FstS e1 v1 e2 v2 σ : to_val e1 = Some v1 → to_val e2 = Some v2 → ... ...
 ... ... @@ -365,10 +365,12 @@ Section lang_rules. (** Helper Lemmas for weakestpre. *) Lemma wp_lam E e1 e2 v Φ : to_val e2 = Some v → ▷ WP e1.[e2 /] @ E {{Φ}} ⊢ WP (App (Lam e1) e2) @ E {{Φ}}. to_val e2 = Some v → ▷ WP e1.[(Lam e1), e2 /] @ E {{Φ}} ⊢ WP (App (Lam e1) e2) @ E {{Φ}}. Proof. intros <-%of_to_val. rewrite -(wp_lift_pure_det_step (App _ _) e1.[of_val v /] None) //=. rewrite -(wp_lift_pure_det_step (App _ _) e1.[(Lam e1), of_val v /] None) //=. - by rewrite right_id. - intros. inv_step; auto. Qed. ... ...
 ... ... @@ -781,7 +781,7 @@ Section lang_rules. Lemma step_lam N E ρ j K e1 e2 v : to_val e2 = Some v → nclose N ⊆ E → (Spec_ctx N ρ ★ j ⤇ (fill K (App (Lam e1) e2))%I) ⊢ |={E}=>(j ⤇ (fill K ((e1.[e2/]))))%I. ⊢ |={E}=>(j ⤇ (fill K ((e1.[Lam e1,e2/]))))%I. Proof. intros H1; apply step_pure => σ; econstructor; eauto. Qed. Lemma step_Tlam N E ρ j K e : ... ...
 ... ... @@ -82,7 +82,7 @@ Local Open Scope bin_logrel_scope. Inductive typed_context_item : context_item → (list type) → type → (list type) → type → Prop := | TP_CTX_Lam : ∀ Γ τ τ', typed_context_item CTX_Lam (τ :: Γ) τ' Γ (TArrow τ τ') typed_context_item CTX_Lam (TArrow τ τ' :: τ :: Γ) τ' Γ (TArrow τ τ') | TP_CTX_AppL (e2 : expr) : ∀ Γ τ τ', typed Γ e2 τ → typed_context_item (CTX_AppL e2) Γ (TArrow τ τ') Γ τ' ... ...
 ... ... @@ -39,7 +39,7 @@ Inductive typed (Γ : list type) : expr → type → Prop := typed (τ1 :: Γ) e1 τ3 → typed (τ2 :: Γ) e2 τ3 → typed Γ (Case e0 e1 e2) τ3 | Lam_typed e τ1 τ2 : typed (τ1 :: Γ) e τ2 → typed Γ (Lam e) (TArrow τ1 τ2) typed (TArrow τ1 τ2 :: τ1 :: Γ) e τ2 → typed Γ (Lam e) (TArrow τ1 τ2) | App_typed e1 e2 τ1 τ2 : typed Γ e1 (TArrow τ1 τ2) → typed Γ e2 τ1 → typed Γ (App e1 e2) τ2 | TLam_typed e τ : ... ... @@ -93,6 +93,16 @@ Proof. by rewrite Hv. Qed. Lemma typed_subst_head_simpl_2 Δ τ e w w' ws : typed Δ e τ -> List.length Δ = 2 + (List.length ws) → e.[# w .: # w' .: env_subst ws] = e.[env_subst (w :: w' :: ws)] . Proof. intros H1 H2. rewrite /env_subst. eapply typed_subst_invariant; eauto => /= -[|[|x]] H3 //=. destruct (lookup_lt_is_Some_2 ws x) as [v' Hv]; first omega; simpl. by rewrite Hv. Qed. Local Opaque eq_nat_dec. ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment