Make progress on wt_unique

This commit is contained in:
Yiyun Liu 2025-04-03 23:20:49 -04:00
parent fbbce90304
commit 5eb1f9df0b
6 changed files with 145 additions and 31 deletions

View file

@ -497,7 +497,7 @@ Qed.
Inductive Tm : Type :=
| VarTm : nat -> Tm
| Abs : Tm -> Tm
| Abs : Tm -> Tm -> Tm
| App : Tm -> Tm -> Tm
| Pair : Tm -> Tm -> Tm
| Proj : PTag -> Tm -> Tm
@ -507,9 +507,11 @@ Inductive Tm : Type :=
| Bool : Tm
| If : Tm -> Tm -> Tm -> Tm.
Lemma congr_Abs {s0 : Tm} {t0 : Tm} (H0 : s0 = t0) : Abs s0 = Abs t0.
Lemma congr_Abs {s0 : Tm} {s1 : Tm} {t0 : Tm} {t1 : Tm} (H0 : s0 = t0)
(H1 : s1 = t1) : Abs s0 s1 = Abs t0 t1.
Proof.
exact (eq_trans eq_refl (ap (fun x => Abs x) H0)).
exact (eq_trans (eq_trans eq_refl (ap (fun x => Abs x s1) H0))
(ap (fun x => Abs t0 x) H1)).
Qed.
Lemma congr_App {s0 : Tm} {s1 : Tm} {t0 : Tm} {t1 : Tm} (H0 : s0 = t0)
@ -574,7 +576,7 @@ Defined.
Fixpoint ren_Tm (xi_Tm : nat -> nat) (s : Tm) {struct s} : Tm :=
match s with
| VarTm s0 => VarTm (xi_Tm s0)
| Abs s0 => Abs (ren_Tm (upRen_Tm_Tm xi_Tm) s0)
| Abs s0 s1 => Abs (ren_Tm xi_Tm s0) (ren_Tm (upRen_Tm_Tm xi_Tm) s1)
| App s0 s1 => App (ren_Tm xi_Tm s0) (ren_Tm xi_Tm s1)
| Pair s0 s1 => Pair (ren_Tm xi_Tm s0) (ren_Tm xi_Tm s1)
| Proj s0 s1 => Proj s0 (ren_Tm xi_Tm s1)
@ -594,7 +596,7 @@ Defined.
Fixpoint subst_Tm (sigma_Tm : nat -> Tm) (s : Tm) {struct s} : Tm :=
match s with
| VarTm s0 => sigma_Tm s0
| Abs s0 => Abs (subst_Tm (up_Tm_Tm sigma_Tm) s0)
| Abs s0 s1 => Abs (subst_Tm sigma_Tm s0) (subst_Tm (up_Tm_Tm sigma_Tm) s1)
| App s0 s1 => App (subst_Tm sigma_Tm s0) (subst_Tm sigma_Tm s1)
| Pair s0 s1 => Pair (subst_Tm sigma_Tm s0) (subst_Tm sigma_Tm s1)
| Proj s0 s1 => Proj s0 (subst_Tm sigma_Tm s1)
@ -622,8 +624,9 @@ Fixpoint idSubst_Tm (sigma_Tm : nat -> Tm)
subst_Tm sigma_Tm s = s :=
match s with
| VarTm s0 => Eq_Tm s0
| Abs s0 =>
congr_Abs (idSubst_Tm (up_Tm_Tm sigma_Tm) (upId_Tm_Tm _ Eq_Tm) s0)
| Abs s0 s1 =>
congr_Abs (idSubst_Tm sigma_Tm Eq_Tm s0)
(idSubst_Tm (up_Tm_Tm sigma_Tm) (upId_Tm_Tm _ Eq_Tm) s1)
| App s0 s1 =>
congr_App (idSubst_Tm sigma_Tm Eq_Tm s0) (idSubst_Tm sigma_Tm Eq_Tm s1)
| Pair s0 s1 =>
@ -656,10 +659,10 @@ Fixpoint extRen_Tm (xi_Tm : nat -> nat) (zeta_Tm : nat -> nat)
ren_Tm xi_Tm s = ren_Tm zeta_Tm s :=
match s with
| VarTm s0 => ap (VarTm) (Eq_Tm s0)
| Abs s0 =>
congr_Abs
| Abs s0 s1 =>
congr_Abs (extRen_Tm xi_Tm zeta_Tm Eq_Tm s0)
(extRen_Tm (upRen_Tm_Tm xi_Tm) (upRen_Tm_Tm zeta_Tm)
(upExtRen_Tm_Tm _ _ Eq_Tm) s0)
(upExtRen_Tm_Tm _ _ Eq_Tm) s1)
| App s0 s1 =>
congr_App (extRen_Tm xi_Tm zeta_Tm Eq_Tm s0)
(extRen_Tm xi_Tm zeta_Tm Eq_Tm s1)
@ -695,10 +698,10 @@ Fixpoint ext_Tm (sigma_Tm : nat -> Tm) (tau_Tm : nat -> Tm)
subst_Tm sigma_Tm s = subst_Tm tau_Tm s :=
match s with
| VarTm s0 => Eq_Tm s0
| Abs s0 =>
congr_Abs
| Abs s0 s1 =>
congr_Abs (ext_Tm sigma_Tm tau_Tm Eq_Tm s0)
(ext_Tm (up_Tm_Tm sigma_Tm) (up_Tm_Tm tau_Tm) (upExt_Tm_Tm _ _ Eq_Tm)
s0)
s1)
| App s0 s1 =>
congr_App (ext_Tm sigma_Tm tau_Tm Eq_Tm s0)
(ext_Tm sigma_Tm tau_Tm Eq_Tm s1)
@ -730,10 +733,10 @@ Fixpoint compRenRen_Tm (xi_Tm : nat -> nat) (zeta_Tm : nat -> nat)
(s : Tm) {struct s} : ren_Tm zeta_Tm (ren_Tm xi_Tm s) = ren_Tm rho_Tm s :=
match s with
| VarTm s0 => ap (VarTm) (Eq_Tm s0)
| Abs s0 =>
congr_Abs
| Abs s0 s1 =>
congr_Abs (compRenRen_Tm xi_Tm zeta_Tm rho_Tm Eq_Tm s0)
(compRenRen_Tm (upRen_Tm_Tm xi_Tm) (upRen_Tm_Tm zeta_Tm)
(upRen_Tm_Tm rho_Tm) (up_ren_ren _ _ _ Eq_Tm) s0)
(upRen_Tm_Tm rho_Tm) (up_ren_ren _ _ _ Eq_Tm) s1)
| App s0 s1 =>
congr_App (compRenRen_Tm xi_Tm zeta_Tm rho_Tm Eq_Tm s0)
(compRenRen_Tm xi_Tm zeta_Tm rho_Tm Eq_Tm s1)
@ -772,10 +775,10 @@ Fixpoint compRenSubst_Tm (xi_Tm : nat -> nat) (tau_Tm : nat -> Tm)
subst_Tm tau_Tm (ren_Tm xi_Tm s) = subst_Tm theta_Tm s :=
match s with
| VarTm s0 => Eq_Tm s0
| Abs s0 =>
congr_Abs
| Abs s0 s1 =>
congr_Abs (compRenSubst_Tm xi_Tm tau_Tm theta_Tm Eq_Tm s0)
(compRenSubst_Tm (upRen_Tm_Tm xi_Tm) (up_Tm_Tm tau_Tm)
(up_Tm_Tm theta_Tm) (up_ren_subst_Tm_Tm _ _ _ Eq_Tm) s0)
(up_Tm_Tm theta_Tm) (up_ren_subst_Tm_Tm _ _ _ Eq_Tm) s1)
| App s0 s1 =>
congr_App (compRenSubst_Tm xi_Tm tau_Tm theta_Tm Eq_Tm s0)
(compRenSubst_Tm xi_Tm tau_Tm theta_Tm Eq_Tm s1)
@ -828,10 +831,10 @@ Fixpoint compSubstRen_Tm (sigma_Tm : nat -> Tm) (zeta_Tm : nat -> nat)
ren_Tm zeta_Tm (subst_Tm sigma_Tm s) = subst_Tm theta_Tm s :=
match s with
| VarTm s0 => Eq_Tm s0
| Abs s0 =>
congr_Abs
| Abs s0 s1 =>
congr_Abs (compSubstRen_Tm sigma_Tm zeta_Tm theta_Tm Eq_Tm s0)
(compSubstRen_Tm (up_Tm_Tm sigma_Tm) (upRen_Tm_Tm zeta_Tm)
(up_Tm_Tm theta_Tm) (up_subst_ren_Tm_Tm _ _ _ Eq_Tm) s0)
(up_Tm_Tm theta_Tm) (up_subst_ren_Tm_Tm _ _ _ Eq_Tm) s1)
| App s0 s1 =>
congr_App (compSubstRen_Tm sigma_Tm zeta_Tm theta_Tm Eq_Tm s0)
(compSubstRen_Tm sigma_Tm zeta_Tm theta_Tm Eq_Tm s1)
@ -884,10 +887,10 @@ Fixpoint compSubstSubst_Tm (sigma_Tm : nat -> Tm) (tau_Tm : nat -> Tm)
subst_Tm tau_Tm (subst_Tm sigma_Tm s) = subst_Tm theta_Tm s :=
match s with
| VarTm s0 => Eq_Tm s0
| Abs s0 =>
congr_Abs
| Abs s0 s1 =>
congr_Abs (compSubstSubst_Tm sigma_Tm tau_Tm theta_Tm Eq_Tm s0)
(compSubstSubst_Tm (up_Tm_Tm sigma_Tm) (up_Tm_Tm tau_Tm)
(up_Tm_Tm theta_Tm) (up_subst_subst_Tm_Tm _ _ _ Eq_Tm) s0)
(up_Tm_Tm theta_Tm) (up_subst_subst_Tm_Tm _ _ _ Eq_Tm) s1)
| App s0 s1 =>
congr_App (compSubstSubst_Tm sigma_Tm tau_Tm theta_Tm Eq_Tm s0)
(compSubstSubst_Tm sigma_Tm tau_Tm theta_Tm Eq_Tm s1)
@ -981,10 +984,10 @@ Fixpoint rinst_inst_Tm (xi_Tm : nat -> nat) (sigma_Tm : nat -> Tm)
: ren_Tm xi_Tm s = subst_Tm sigma_Tm s :=
match s with
| VarTm s0 => Eq_Tm s0
| Abs s0 =>
congr_Abs
| Abs s0 s1 =>
congr_Abs (rinst_inst_Tm xi_Tm sigma_Tm Eq_Tm s0)
(rinst_inst_Tm (upRen_Tm_Tm xi_Tm) (up_Tm_Tm sigma_Tm)
(rinstInst_up_Tm_Tm _ _ Eq_Tm) s0)
(rinstInst_up_Tm_Tm _ _ Eq_Tm) s1)
| App s0 s1 =>
congr_App (rinst_inst_Tm xi_Tm sigma_Tm Eq_Tm s0)
(rinst_inst_Tm xi_Tm sigma_Tm Eq_Tm s1)