Fix Abs_EPar

theories/fp_red.v

@@ -186,12 +186,14 @@ Local Ltac com_helper :=
   split; [hauto lq:on ctrs:RPar.R use: RPar.refl, RPar.renaming
          |hauto lq:on ctrs:EPar.R use:EPar.refl, EPar.renaming].
 
-Lemma RPars_AbsCong n (a b : Tm (S n)) :
+Module RPars.
+
+  Lemma AbsCong n (a b : Tm (S n)) :
     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 AppCong n (a0 a1 b : Tm n) :
     rtc RPar.R a0 a1 ->
     rtc RPar.R (App a0 b) (App a1 b).
   Proof.
@@ -203,7 +205,7 @@ Proof.
       hauto lq:on ctrs:RPar.R use:RPar.refl.
   Qed.
 
-Lemma RPars_PairCong n (a0 a1 b0 b1 : Tm n) :
+  Lemma PairCong n (a0 a1 b0 b1 : Tm n) :
     rtc RPar.R a0 a1 ->
     rtc RPar.R b0 b1 ->
     rtc RPar.R (Pair a0 b0) (Pair a1 b1).
@@ -222,7 +224,7 @@ Proof.
   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 (ren_Tm ξ a0) (ren_Tm ξ a1).
   Proof.
@@ -231,7 +233,7 @@ Proof.
     - eauto using RPar.renaming, rtc_l.
   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'.
   Proof.
     move E : (Abs a) => b0 h. move : a E.
@@ -239,39 +241,34 @@ Proof.
     - hauto lq:on ctrs:rtc.
     - hauto lq:on ctrs:rtc inv:RPar.R, rtc.
   Qed.
+End RPars.
 
 Lemma Abs_EPar n a (b : Tm n) :
   EPar.R (Abs a) b ->
-  (forall c m (ξ : fin n -> fin m), exists d,
-    EPar.R (subst_Tm (scons c VarTm) a) d /\
-      rtc RPar.R (App b c) d) /\
+  (exists d, EPar.R a d /\
+     rtc RPar.R (App (ren_Tm shift b) (VarTm var_zero)) d) /\
          (exists d,
          EPar.R a d /\
          rtc RPar.R (Proj1 b) (Abs (Proj1 d)) /\
          rtc RPar.R (Proj2 b) (Abs (Proj2 d))).
 Proof.
-(*   move E : (Abs a) => u h. *)
-(*   move : a E. *)
-(*   elim : n u b /h => //=. *)
-(*   - move => n a0 a1 ha iha b ?. subst. *)
-(*     split. *)
-(*     + move => c. *)
-(*       specialize iha with (1 := eq_refl). *)
-(*       move : iha => [+ _]. move /(_ c) => [d [ih0 ih1]]. *)
-(*       exists d. *)
-(*       split => //. *)
-(*       apply : rtc_l. *)
-(*       apply RPar.AppAbs; eauto => //=. *)
-(*       apply RPar.refl. *)
-(*       by apply RPar.refl. *)
-(*       by asimpl. *)
-(*     + specialize iha with (1 := eq_refl). *)
-(*       move : iha => [_ [d [ih0 [ih1 ih2]]]]. *)
-(*       exists d. *)
-(*       repeat split => //. *)
-(*       * apply : rtc_l. apply : RPar.Proj1Abs. apply RPar.refl. *)
-(*       apply : RPars_AbsCong. *)
-(*       apply *)
+  move E : (Abs a) => u h.
+  move : a E.
+  elim : n u b /h => //=.
+  - move => n a0 a1 ha iha b ?. subst.
+    specialize iha with (1 := eq_refl).
+    move : iha => [[d [ih0 ih1]] _].
+    split; exists d.
+    + split => //.
+      apply : rtc_l.
+      apply RPar.AppAbs; eauto => //=.
+      apply RPar.refl.
+      by apply RPar.refl.
+      move :ih1; substify; by asimpl.
+    + repeat split => //.
+      * apply : rtc_l. apply : RPar.Proj1Abs. apply RPar.refl.
+        apply : RPars.AbsCong.
+
 (*   - move => n a0 a1 ha iha a ? c. subst. *)
 (*     specialize iha with (1 := eq_refl) (c := c). *)
 (*     move : iha => [d [ih0 ih1]]. *)