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

Fix Abs_EPar

Browse source
This commit is contained in:
Yiyun Liu 2024-12-20 22:56:08 -05:00
parent 67bcc69de7
commit 393a022f04
1 changed files with 70 additions and 73 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

143
theories/fp_red.v
View file

@ -186,92 +186,89 @@ Local Ltac com_helper :=
split; [hauto lq:on ctrs:RPar.R use: RPar.refl, RPar.renaming split; [hauto lq:on ctrs:RPar.R use: RPar.refl, RPar.renaming
|hauto lq:on ctrs:EPar.R use:EPar.refl, EPar.renaming]. |hauto lq:on ctrs:EPar.R use:EPar.refl, EPar.renaming].
Lemma RPars_AbsCong n (a b : Tm (S n)) : Module RPars.
rtc RPar.R a b ->
rtc RPar.R (Abs a) (Abs b).
Proof. induction 1; hauto l:on ctrs:RPar.R, rtc. Qed.
Lemma RPars_AppCong n (a0 a1 b : Tm n) : Lemma AbsCong n (a b : Tm (S n)) :
rtc RPar.R a0 a1 -> rtc RPar.R a b ->
rtc RPar.R (App a0 b) (App a1 b). rtc RPar.R (Abs a) (Abs b).
Proof. Proof. induction 1; hauto l:on ctrs:RPar.R, rtc. Qed.
move => h. move : b.
elim : a0 a1 /h.
- qauto ctrs:RPar.R, rtc.
- move => x y z h0 h1 ih b.
apply rtc_l with (y := App y b) => //.
hauto lq:on ctrs:RPar.R use:RPar.refl.
Qed.
Lemma RPars_PairCong n (a0 a1 b0 b1 : Tm n) : Lemma AppCong n (a0 a1 b : Tm n) :
rtc RPar.R a0 a1 -> rtc RPar.R a0 a1 ->
rtc RPar.R b0 b1 -> rtc RPar.R (App a0 b) (App a1 b).
rtc RPar.R (Pair a0 b0) (Pair a1 b1). Proof.
Proof. move => h. move : b.
move => h. move : b0 b1. elim : a0 a1 /h.
elim : a0 a1 /h. - qauto ctrs:RPar.R, rtc.
- move => x b0 b1 h. - move => x y z h0 h1 ih b.
elim : b0 b1 /h. apply rtc_l with (y := App y b) => //.
by auto using rtc_refl. hauto lq:on ctrs:RPar.R use:RPar.refl.
move => x0 y z h0 h1 h2. Qed.
apply : rtc_l; eauto.
by eauto using RPar.refl, RPar.PairCong. Lemma PairCong n (a0 a1 b0 b1 : Tm n) :
- move => x y z h0 h1 ih b0 b1 h. rtc RPar.R a0 a1 ->
apply : rtc_l; eauto. rtc RPar.R b0 b1 ->
by eauto using RPar.refl, RPar.PairCong. rtc RPar.R (Pair a0 b0) (Pair a1 b1).
Qed. Proof.
move => h. move : b0 b1.
elim : a0 a1 /h.
- move => x b0 b1 h.
elim : b0 b1 /h.
by auto using rtc_refl.
move => x0 y z h0 h1 h2.
apply : rtc_l; eauto.
by eauto using RPar.refl, RPar.PairCong.
- move => x y z h0 h1 ih b0 b1 h.
apply : rtc_l; eauto.
by eauto using RPar.refl, RPar.PairCong.
Qed.
Lemma RPars_renaming n (a0 a1 : Tm n) m (ξ : fin n -> fin m) : Lemma renaming n (a0 a1 : Tm n) m (ξ : fin n -> fin m) :
rtc RPar.R a0 a1 -> rtc RPar.R a0 a1 ->
rtc RPar.R (ren_Tm ξ a0) (ren_Tm ξ a1). rtc RPar.R (ren_Tm ξ a0) (ren_Tm ξ a1).
Proof. Proof.
induction 1. induction 1.
- apply rtc_refl. - apply rtc_refl.
- eauto using RPar.renaming, rtc_l. - eauto using RPar.renaming, rtc_l.
Qed. Qed.
Lemma RPars_Abs_inv n (a : Tm (S n)) b : Lemma Abs_inv n (a : Tm (S n)) b :
rtc RPar.R (Abs a) b -> exists a', b = Abs a' /\ rtc RPar.R a a'. rtc RPar.R (Abs a) b -> exists a', b = Abs a' /\ rtc RPar.R a a'.
Proof. Proof.
move E : (Abs a) => b0 h. move : a E. move E : (Abs a) => b0 h. move : a E.
elim : b0 b / h. elim : b0 b / h.
- hauto lq:on ctrs:rtc. - hauto lq:on ctrs:rtc.
- hauto lq:on ctrs:rtc inv:RPar.R, rtc. - hauto lq:on ctrs:rtc inv:RPar.R, rtc.
Qed. Qed.
End RPars.
Lemma Abs_EPar n a (b : Tm n) : Lemma Abs_EPar n a (b : Tm n) :
EPar.R (Abs a) b -> EPar.R (Abs a) b ->
(forall c m (ξ : fin n -> fin m), exists d, (exists d, EPar.R a d /\
EPar.R (subst_Tm (scons c VarTm) a) d /\ rtc RPar.R (App (ren_Tm shift b) (VarTm var_zero)) d) /\
rtc RPar.R (App b c) d) /\
(exists d, (exists d,
EPar.R a d /\ EPar.R a d /\
rtc RPar.R (Proj1 b) (Abs (Proj1 d)) /\ rtc RPar.R (Proj1 b) (Abs (Proj1 d)) /\
rtc RPar.R (Proj2 b) (Abs (Proj2 d))). rtc RPar.R (Proj2 b) (Abs (Proj2 d))).
Proof. Proof.
(* move E : (Abs a) => u h. *) move E : (Abs a) => u h.
(* move : a E. *) move : a E.
(* elim : n u b /h => //=. *) elim : n u b /h => //=.
(* - move => n a0 a1 ha iha b ?. subst. *) - move => n a0 a1 ha iha b ?. subst.
(* split. *) specialize iha with (1 := eq_refl).
(* + move => c. *) move : iha => [[d [ih0 ih1]] _].
(* specialize iha with (1 := eq_refl). *) split; exists d.
(* move : iha => [+ _]. move /(_ c) => [d [ih0 ih1]]. *) + split => //.
(* exists d. *) apply : rtc_l.
(* split => //. *) apply RPar.AppAbs; eauto => //=.
(* apply : rtc_l. *) apply RPar.refl.
(* apply RPar.AppAbs; eauto => //=. *) by apply RPar.refl.
(* apply RPar.refl. *) move :ih1; substify; by asimpl.
(* by apply RPar.refl. *) + repeat split => //.
(* by asimpl. *) * apply : rtc_l. apply : RPar.Proj1Abs. apply RPar.refl.
(* + specialize iha with (1 := eq_refl). *) apply : RPars.AbsCong.
(* move : iha => [_ [d [ih0 [ih1 ih2]]]]. *)
(* exists d. *)
(* repeat split => //. *)
(* * apply : rtc_l. apply : RPar.Proj1Abs. apply RPar.refl. *)
(* apply : RPars_AbsCong. *)
(* apply *)
(* - move => n a0 a1 ha iha a ? c. subst. *) (* - move => n a0 a1 ha iha a ? c. subst. *)
(* specialize iha with (1 := eq_refl) (c := c). *) (* specialize iha with (1 := eq_refl) (c := c). *)
(* move : iha => [d [ih0 ih1]]. *) (* move : iha => [d [ih0 ih1]]. *)