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.

Lemma diamond_to_semi_confluent R :
diamond R -> semi_confluent R.