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

Almost done!

Browse source
This commit is contained in:
Yiyun Liu 2024-12-25 01:57:46 -05:00
parent 3de6dae199
commit add8a62d85
1 changed files with 16 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
theories/fp_red.v
View file

@ -892,10 +892,9 @@ Local Ltac extract_tac := rewrite -?depth_subst_bool;hauto use:depth_subst_bool.
prov A B Bot := False; prov A B Bot := False;
prov A B (VarTm _) := False. prov A B (VarTm _) := False.
#[tactic="extract_tac"]Equations extract {n} (a : Tm n) : Tm n by wf (depth_tm a) lt := #[tactic="prov_tac"]Equations extract {n} (a : Tm n) : Tm n by wf (depth_tm a) lt :=
extract (Pi A B) := Pi A B; extract (Pi A B) := Pi A B;
extract (Abs a) := subst_Tm (scons Bot VarTm) (extract a) extract (Abs a) := subst_Tm (scons Bot VarTm) (extract a);
extract (App a b) := extract a; extract (App a b) := extract a;
extract (Pair a b) := extract a; extract (Pair a b) := extract a;
extract (Proj p a) := extract a; extract (Proj p a) := extract a;
@ -922,7 +921,14 @@ Proof.
move : m ξ. elim : n/a. move : m ξ. elim : n/a.
- sfirstorder. - sfirstorder.
- move => n a ih m ξ. simpl. simp extract. - move => n a ih m ξ. simpl. simp extract.
(* Admitted. *) rewrite ih.
by asimpl.
- hauto q:on rew:db:extract.
- hauto q:on rew:db:extract.
- hauto q:on rew:db:extract.
- hauto q:on rew:db:extract.
- sfirstorder.
Qed.
Lemma tm_depth_ind (P : forall n, Tm n -> Prop) : Lemma tm_depth_ind (P : forall n, Tm n -> Prop) :
(forall n (a : Tm n), (forall m (b : Tm m), depth_tm b < depth_tm a -> P m b) -> P n a) -> forall n a, P n a. (forall n (a : Tm n), (forall m (b : Tm m), depth_tm b < depth_tm a -> P m b) -> P n a) -> forall n a, P n a.
@ -986,7 +992,7 @@ Proof.
elim : n a b /h. elim : n a b /h.
- move => n a0 a1 b0 b1 ha iha hb ihb A B /=. - move => n a0 a1 b0 b1 ha iha hb ihb A B /=.
simp prov => h. simp prov => h.
have : prov (ren_Tm shift A) (ren_Tm (upRen_Tm_Tm shift) B) a1 by admit. move /iha : h.
move /(prov_morph _ _ (scons b1 VarTm)). move /(prov_morph _ _ (scons b1 VarTm)).
by asimpl. by asimpl.
- hauto lq:on rew:db:prov. - hauto lq:on rew:db:prov.
@ -1004,7 +1010,7 @@ Proof.
move => [hA0 hA1]. move => [hA0 hA1].
eauto using rtc_r. eauto using rtc_r.
- sfirstorder. - sfirstorder.
Admitted. Qed.
Lemma prov_pars n (A : Tm n) B a b : prov A B a -> rtc Par.R a b -> prov A B b. Lemma prov_pars n (A : Tm n) B a b : prov A B a -> rtc Par.R a b -> prov A B b.
Proof. Proof.
@ -1028,11 +1034,10 @@ Proof.
by admit. by admit.
move => [B1 [h5 h6]]. move => [B1 [h5 h6]].
subst. subst.
have {}h0 : extract a = ren_Tm shift (Pi A1 B1) by done. have {}h0 : subst_Tm (scons Bot VarTm) (extract a) =
have : exists a1, extract a1 = Pi A1 B1 /\ ren_Tm shift a1 = a by admit. subst_Tm (scons Bot VarTm) (ren_Tm shift (Pi A1 B1)) by sauto lq:on.
move => [a1 [h6 ?]]. subst. move : h0. asimpl. move => ->.
asimpl. exists A1, B1. hauto lq:on.
repeat split => //=.
- hauto l:on rew:db:prov, extract. - hauto l:on rew:db:prov, extract.
- hauto l:on rew:db:prov, extract. - hauto l:on rew:db:prov, extract.
- hauto l:on rew:db:prov, extract. - hauto l:on rew:db:prov, extract.