yiyunliu/sp-eta-postpone
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add E_AppEta

Browse source
This commit is contained in:
Yiyun Liu 2025-04-18 16:38:34 -04:00
parent 43daff1b27
commit 2b92845e3e
3 changed files with 114 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

60
theories/preservation.v
View file

@ -4,32 +4,6 @@ Require Import ssreflect.
Require Import Psatz.
Require Import Coq.Logic.FunctionalExtensionality.
Lemma App_Inv Γ (b a : PTm) U :
Γ ⊢ PApp b a ∈ U ->
exists A B, Γ ⊢ b ∈ PBind PPi A B /\ Γ ⊢ a ∈ A /\ Γ ⊢ subst_PTm (scons a VarPTm) B ≲ U.
Proof.
move E : (PApp b a) => u hu.
move : b a E. elim : Γ u U / hu => //=.
- move => Γ b a A B hb _ ha _ b0 a0 [*]. subst.
exists A,B.
repeat split => //=.
have [i] : exists i, Γ ⊢ PBind PPi A B ∈ PUniv i by sfirstorder use:regularity.
hauto lq:on use:bind_inst, E_Refl.
- hauto lq:on rew:off ctrs:LEq.
Qed.
Lemma Abs_Inv Γ (a : PTm) U :
Γ ⊢ PAbs a ∈ U ->
exists A B, (cons A Γ) ⊢ a ∈ B /\ Γ ⊢ PBind PPi A B ≲ U.
Proof.
move E : (PAbs a) => u hu.
move : a E. elim : Γ u U / hu => //=.
- move => Γ a A B i hP _ ha _ a0 [*]. subst.
exists A, B. repeat split => //=.
hauto lq:on use:E_Refl, Su_Eq.
- hauto lq:on rew:off ctrs:LEq.
Qed.
Lemma Proj1_Inv Γ (a : PTm ) U :
Γ ⊢ PProj PL a ∈ U ->
exists A B, Γ ⊢ a ∈ PBind PSig A B /\ Γ ⊢ A ≲ U.
@ -93,40 +67,6 @@ Proof.
- hauto lq:on rew:off ctrs:LEq.
Qed.
Lemma E_AppAbs : forall (a : PTm) (b : PTm) Γ (A : PTm),
Γ ⊢ PApp (PAbs a) b ∈ A -> Γ ⊢ PApp (PAbs a) b ≡ subst_PTm (scons b VarPTm) a ∈ A.
Proof.
move => a b Γ A ha.
move /App_Inv : ha.
move => [A0][B0][ha][hb]hS.
move /Abs_Inv : ha => [A1][B1][ha]hS0.
have hb' := hb.
move /E_Refl in hb.
have hS1 : Γ ⊢ A0 ≲ A1 by sfirstorder use:Su_Pi_Proj1.
have [i hPi] : exists i, Γ ⊢ PBind PPi A1 B1 ∈ PUniv i by sfirstorder use:regularity_sub0.
move : Su_Pi_Proj2 hS0 hb; repeat move/[apply].
move : hS => /[swap]. move : Su_Transitive. repeat move/[apply].
move => h.
apply : E_Conv; eauto.
apply : E_AppAbs; eauto.
eauto using T_Conv.
Qed.
Lemma T_Eta Γ A a B :
A :: Γ ⊢ a ∈ B ->
A :: Γ ⊢ PApp (PAbs (ren_PTm (upRen_PTm_PTm shift) a)) (VarPTm var_zero) ∈ B.
Proof.
move => ha.
have hΓ' : ⊢ A :: Γ by sfirstorder use:wff_mutual.
have [i hA] : exists i, Γ ⊢ A ∈ PUniv i by hauto lq:on inv:Wff.
have hΓ : ⊢ Γ by hauto lq:on inv:Wff.
eapply T_App' with (B := ren_PTm (upRen_PTm_PTm shift) B). by asimpl; rewrite subst_scons_id.
apply T_Abs. eapply renaming; eauto; cycle 1. apply renaming_up. apply renaming_shift.
econstructor; eauto. sauto l:on use:renaming.
apply T_Var => //.
by constructor.
Qed.
Lemma E_Abs Γ a b A B :
A :: Γ ⊢ a ≡ b ∈ B ->
Γ ⊢ PAbs a ≡ PAbs b ∈ PBind PPi A B.