Section FixX.
Variable X : Type.
Implicit Types R S : X -> X -> Prop.
Implicit Types x y z : X.
Definition reflexive R := forall x, R x x.
Definition symmetric R := forall x y, R x y -> R y x.
Definition transitive R := forall x y z, R x y -> R y z -> R x z.
(* Reflexive transitive closure *)
Inductive star R : X -> X -> Prop :=
| starR x : star R x x
| starC x y z : R x y -> star R y z -> star R x z.
Definition evaluates R x y := star R x y /\ terminal R y.
(* Making first argument a non-uniform parameter doesn't simplify the induction principle. *)
Instance star_PO R: PreOrder (star R).
(* Power characterization *)
(* Equivalence closure *)
Inductive ecl R : X -> X -> Prop :=
| eclR x : ecl R x x
| eclC x y z : R x y -> ecl R y z -> ecl R x z
| eclS x y z : R y x -> ecl R y z -> ecl R x z.
(* Diamond, confluence, Church-Rosser *)
Definition joinable R x y :=
exists z, R x z /\ R y z.
Definition diamond R :=
forall x y z, R x y -> R x z -> joinable R y z.
Definition confluent R := diamond (star R).
Definition semi_confluent R :=
forall x y z, R x y -> star R x z -> joinable (star R) y z.
Definition church_rosser R :=
ecl R <=2 joinable (star R).
Goal forall R, diamond R -> semi_confluent R.
(* End Semantics Library *)
(* Uniform confluence and parametrized confluence *)
Definition uniform_confluent (R : X -> X -> Prop ) := forall s t1 t2, R s t1 -> R s t2 -> t1 = t2 \/ exists u, R t1 u /\ R t2 u.

Lemma parametrized_confluence (R : X -> X -> Prop) (m n : nat) (s t1 t2 : X) :
uniform_confluent R ->
pow R m s t1 ->
pow R n s t2 ->
exists k l u,
k <= n /\ l <= m /\ pow R k t1 u /\ pow R l t2 u /\ m + k = n + l.