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

Finish the indcong rule

Browse source
This commit is contained in:
Yiyun Liu 2025-02-25 15:29:25 -05:00
parent e89aaf14a0
commit 890f97365c
1 changed files with 41 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

56
theories/logrel.v
View file

@ -686,6 +686,10 @@ Qed.
Definition smorphing_ok {n m} (Δ : fin m -> PTm m) Γ (ρ : fin n -> PTm m) := Definition smorphing_ok {n m} (Δ : fin m -> PTm m) Γ (ρ : fin n -> PTm m) :=
forall ξ, ρ_ok Δ ξ -> ρ_ok Γ (funcomp (subst_PTm ξ) ρ). forall ξ, ρ_ok Δ ξ -> ρ_ok Γ (funcomp (subst_PTm ξ) ρ).
Lemma smorphing_ok_refl n (Δ : fin n -> PTm n) : smorphing_ok Δ Δ VarPTm.
rewrite /smorphing_ok => ξ. apply.
Qed.
Lemma smorphing_ren n m p Ξ Δ Γ Lemma smorphing_ren n m p Ξ Δ Γ
(ρ : fin n -> PTm m) (ξ : fin m -> fin p) : (ρ : fin n -> PTm m) (ξ : fin m -> fin p) :
renaming_ok Ξ Δ ξ -> smorphing_ok Δ Γ ρ -> renaming_ok Ξ Δ ξ -> smorphing_ok Δ Γ ρ ->
@ -724,7 +728,6 @@ Proof.
eauto using InterpUniv_Functional'. eauto using InterpUniv_Functional'.
Qed. Qed.
Lemma morphing_SemWt : forall n Γ (a A : PTm n), Lemma morphing_SemWt : forall n Γ (a A : PTm n),
Γ ⊨ a ∈ A -> forall m Δ (ρ : fin n -> PTm m), Γ ⊨ a ∈ A -> forall m Δ (ρ : fin n -> PTm m),
smorphing_ok Δ Γ ρ -> Δ ⊨ subst_PTm ρ a ∈ subst_PTm ρ A. smorphing_ok Δ Γ ρ -> Δ ⊨ subst_PTm ρ a ∈ subst_PTm ρ A.
@ -734,6 +737,16 @@ Proof.
asimpl. eauto. asimpl. eauto.
Qed. Qed.
Lemma morphing_SemWt_Univ : forall n Γ (a : PTm n) i,
Γ ⊨ a ∈ PUniv i -> forall m Δ (ρ : fin n -> PTm m),
smorphing_ok Δ Γ ρ -> Δ ⊨ subst_PTm ρ a ∈ PUniv i.
Proof.
move => n Γ a i ha.
move => m Δ ρ.
have -> : PUniv i = subst_PTm ρ (PUniv i) by reflexivity.
by apply morphing_SemWt.
Qed.
Lemma weakening_Sem n Γ (a : PTm n) A B i Lemma weakening_Sem n Γ (a : PTm n) A B i
(h0 : Γ ⊨ B ∈ PUniv i) (h0 : Γ ⊨ B ∈ PUniv i)
(h1 : Γ ⊨ a ∈ A) : (h1 : Γ ⊨ a ∈ A) :
@ -783,16 +796,21 @@ Proof.
Qed. Qed.
(* Semantic typing rules *) (* Semantic typing rules *)
Lemma ST_Var n Γ (i : fin n) : Lemma ST_Var' n Γ (i : fin n) j :
⊨ Γ -> Γ ⊨ Γ i ∈ PUniv j ->
Γ ⊨ VarPTm i ∈ Γ i. Γ ⊨ VarPTm i ∈ Γ i.
Proof. Proof.
move /(_ i) => [j /SemWt_Univ h]. move => /SemWt_Univ h.
rewrite /SemWt => ρ /[dup] hρ {}/h [S hS]. rewrite /SemWt => ρ /[dup] hρ {}/h [S hS].
exists j,S. exists j,S.
asimpl. firstorder. asimpl. firstorder.
Qed. Qed.
Lemma ST_Var n Γ (i : fin n) :
⊨ Γ ->
Γ ⊨ VarPTm i ∈ Γ i.
Proof. hauto l:on use:ST_Var' unfold:SemWff. Qed.
Lemma InterpUniv_Bind_nopf n p i (A : PTm n) B PA : Lemma InterpUniv_Bind_nopf n p i (A : PTm n) B PA :
⟦ A ⟧ i ↘ PA -> ⟦ A ⟧ i ↘ PA ->
(forall a, PA a -> exists PB, ⟦ subst_PTm (scons a VarPTm) B ⟧ i ↘ PB) -> (forall a, PA a -> exists PB, ⟦ subst_PTm (scons a VarPTm) B ⟧ i ↘ PB) ->
@ -1461,14 +1479,12 @@ Proof.
Qed. Qed.
Lemma SE_IndCong n Γ P0 P1 (a0 a1 : PTm n) b0 b1 c0 c1 i : Lemma SE_IndCong n Γ P0 P1 (a0 a1 : PTm n) b0 b1 c0 c1 i :
⊨ Γ ->
funcomp (ren_PTm shift) (scons PNat Γ) ⊨ P0 ≡ P1 ∈ PUniv i -> funcomp (ren_PTm shift) (scons PNat Γ) ⊨ P0 ≡ P1 ∈ PUniv i ->
Γ ⊨ a0 ≡ a1 ∈ PNat -> Γ ⊨ a0 ≡ a1 ∈ PNat ->
Γ ⊨ b0 ≡ b1 ∈ subst_PTm (scons PZero VarPTm) P0 -> Γ ⊨ b0 ≡ b1 ∈ subst_PTm (scons PZero VarPTm) P0 ->
funcomp (ren_PTm shift) (scons P0 (funcomp (ren_PTm shift) (scons PNat Γ))) ⊨ c0 ≡ c1 ∈ ren_PTm shift (subst_PTm (scons (PSuc (VarPTm var_zero)) (funcomp VarPTm shift) ) P0) -> funcomp (ren_PTm shift) (scons P0 (funcomp (ren_PTm shift) (scons PNat Γ))) ⊨ c0 ≡ c1 ∈ ren_PTm shift (subst_PTm (scons (PSuc (VarPTm var_zero)) (funcomp VarPTm shift) ) P0) ->
Γ ⊨ PInd P0 a0 b0 c0 ≡ PInd P1 a1 b1 c1 ∈ subst_PTm (scons a0 VarPTm) P0. Γ ⊨ PInd P0 a0 b0 c0 ≡ PInd P1 a1 b1 c1 ∈ subst_PTm (scons a0 VarPTm) P0.
Proof. Proof.
move => hΓ.
move /SemEq_SemWt=>[hP0][hP1]hPe. move /SemEq_SemWt=>[hP0][hP1]hPe.
move /SemEq_SemWt=>[ha0][ha1]hae. move /SemEq_SemWt=>[ha0][ha1]hae.
move /SemEq_SemWt=>[hb0][hb1]hbe. move /SemEq_SemWt=>[hb0][hb1]hbe.
@ -1477,21 +1493,25 @@ Proof.
apply ST_Conv_E with (A := subst_PTm (scons a1 VarPTm) P1) (i := i); apply ST_Conv_E with (A := subst_PTm (scons a1 VarPTm) P1) (i := i);
last by eauto using DJoin.cong', DJoin.symmetric. last by eauto using DJoin.cong', DJoin.symmetric.
apply : ST_Ind; eauto. eapply ST_Conv_E with (i := i); eauto. apply : ST_Ind; eauto. eapply ST_Conv_E with (i := i); eauto.
change (PUniv i) with (subst_PTm (scons PZero VarPTm) (@PUniv (S n) i)). apply : morphing_SemWt_Univ; eauto.
apply : morphing_SemWt; eauto.
apply smorphing_ext. rewrite /smorphing_ok. apply smorphing_ext. rewrite /smorphing_ok.
move => ξ. rewrite /funcomp. by asimpl. move => ξ. rewrite /funcomp. by asimpl.
by apply ST_Zero. by apply ST_Zero.
by apply DJoin.substing. move {hc0}. by apply DJoin.substing.
move => ρ hρ. eapply ST_Conv_E with (i := i); eauto.
have : ρ_ok (funcomp (ren_PTm shift) (scons P0 (funcomp (ren_PTm shift) (scons PNat Γ)))) ρ. apply : Γ_sub'_SemWt; eauto.
move : Γ_eq_ρ_ok hρ => /[apply]. apply : Γ_sub'_cons; eauto using DJoin.symmetric, Sub.FromJoin.
apply. by eauto using Γ_eq_cons, DJoin.symmetric, DJoin.refl, Γ_eq_refl. apply : Γ_sub'_cons; eauto using Sub.refl, Γ_sub'_refl, (@ST_Nat _ _ 0).
apply : SemWff_cons; eauto. change (PUniv i) with (ren_PTm shift (@PUniv (S n) i)).
apply : SemWff_cons; eauto using (@ST_Nat _ _ 0). apply : weakening_Sem; eauto. move : hP1.
move : hc1 => /[apply]. move /morphing_SemWt. apply. apply smorphing_ext.
have -> : (funcomp VarPTm shift) = funcomp (ren_PTm shift) (@VarPTm n) by asimpl.
apply : smorphing_ren; eauto using smorphing_ok_refl. hauto l:on inv:option.
apply ST_Suc. apply ST_Var' with (j := 0). apply ST_Nat.
apply DJoin.renaming. by apply DJoin.substing.
apply : morphing_SemWt_Univ; eauto.
apply smorphing_ext; eauto using smorphing_ok_refl.
Qed.
Lemma SE_ProjPair1 n Γ (a b : PTm n) A B i : Lemma SE_ProjPair1 n Γ (a b : PTm n) A B i :
Γ ⊨ PBind PSig A B ∈ (PUniv i) -> Γ ⊨ PBind PSig A B ∈ (PUniv i) ->