(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(****************************************************************************)
(*                 The Calculus of Inductive Constructions                  *)
(*                                                                          *)
(*                                Projet Coq                                *)
(*                                                                          *)
(*                     INRIA                        ENS-CNRS                *)
(*              Rocquencourt                        Lyon                    *)
(*                                                                          *)
(*                                Coq V5.10                                 *)
(*                              Nov 25th 1994                               *)
(*                                                                          *)
(****************************************************************************)
(*                                Yokouchi.v                                *)
(****************************************************************************)
(*****************************************************************************)
(*          Projet Coq  - Calculus of Inductive Constructions V5.8           *)
(*****************************************************************************)
(*                                                                           *)
(*      Meta-theory of the explicit substitution calculus lambda-env         *)
(*      Amokrane Saibi                                                       *)
(*                                                                           *)
(*      September 1993                                                       *)
(*                                                                           *)
(*****************************************************************************)
(* Theoreme utilise pour la preuve de confluence du lambda-sigma-lift-calcul *)
Section YokouchiS.
Variable A : Set.
Variable R S : A -> A -> Prop.
Hypothesis C : explicit_confluence _ R.
Hypothesis N : explicit_noetherian _ R.
Hypothesis SC : explicit_strong_confluence _ S.
Definition Rstar_S_Rstar :=
explicit_comp_rel _ (explicit_star _ R)
(explicit_comp_rel _ S (explicit_star _ R)).
Hypothesis
commut1 :
forall f g h : A,
R f h ->
S f g -> exists k : A, explicit_star _ R g k /\ Rstar_S_Rstar h k.
Goal
forall f g h : A,
explicit_star _ R f g -> Rstar_S_Rstar g h -> Rstar_S_Rstar f h.
intros f g h H1 H2.
elim
(comp_case A (explicit_star _ R)
(explicit_comp_rel _ S (explicit_star _ R)) g h H2).
intros f' H3; elim H3; intros H4 H5.
red in |- *; apply comp_2rel with f'.
apply star_trans with g; assumption.
assumption.
Save comp_l.
Goal
forall f g h : A,
Rstar_S_Rstar f g -> explicit_star _ R g h -> Rstar_S_Rstar f h.
intros f g h H1 H2.
elim
(comp_case A (explicit_star _ R)
(explicit_comp_rel _ S (explicit_star _ R)) f g H1).
intros f' H3; elim H3; intros H4 H5.
elim (comp_case A S (explicit_star _ R) f' g H5).
intros f'' H6; elim H6; intros H7 H8.
red in |- *; apply comp_2rel with f'.
assumption.
apply comp_2rel with f''.
assumption.
apply star_trans with g; assumption.
Save comp_r.
Goal
forall f g h : A,
explicit_star _ R f h ->
S f g -> exists k : A, explicit_star _ R g k /\ Rstar_S_Rstar h k.
intro f; pattern f in |- *; apply (noetherian_induction A R N);
intros f0 H g h H1 H2.
elim (star_case A R f0 h H1); intro H3.
(* cas f0=h *)
exists g; split.
apply star_refl.
elim H3; red in |- *; apply comp_2rel with f0.
apply star_refl.
apply comp_2rel with g; [ assumption | apply star_refl ].
(* cas f0 R f1 R* h *)
elim H3; intros f1 H4; elim H4; intros H5 H6.
cut (exists k : A, explicit_star _ R g k /\ Rstar_S_Rstar f1 k).
intro H7; elim H7; intros g1 H8; elim H8; intros H9 H10.
2: apply commut1 with f0; assumption.
cut
(exists f2 : A,
explicit_star _ R f1 f2 /\
explicit_comp_rel _ S (explicit_star _ R) f2 g1).
2: apply comp_case; assumption.
intro H11; elim H11; intros f2 H12; elim H12; intros H13 H14.
cut (exists f3 : A, S f2 f3 /\ explicit_star _ R f3 g1).
2: apply comp_case; assumption.
intro H15; elim H15; intros f3 H16; elim H16; intros H17 H18.
elim (C f1 h f2 H6 H13); intros h1 H19; elim H19; intros H20 H21.
elim (H f2) with f3 h1.
2: apply comp_relplus; apply comp_2rel with f1; assumption.
2: assumption.
2: assumption.
intros h2 H22; elim H22; intros H23 H24.
elim (C f3 h2 g1 H23 H18); intros k H25; elim H25; intros H26 H27.
exists k; split.
apply star_trans with g1; assumption.
apply comp_l with h1.
assumption.
apply comp_r with h2; assumption.
Save commut2.

(* Specifications: *)
Theorem Yokouchi : explicit_strong_confluence _ Rstar_S_Rstar.
unfold explicit_strong_confluence in |- *; intro f; pattern f in |- *;
apply (noetherian_induction1 A R N).