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.
(* classical *)
Definition classical R x := terminal R x \/ exists y, R x y.
(* Strong normalisation *)
Inductive SN R : X -> Prop :=
| SNC x : (forall y, R x y -> SN R y) -> SN R x.
Fact SN_unfold R x :
SN R x <-> forall y, R x y -> SN R y.
End FixX.
Existing Instance star_PO.
(* A notion of a reduction sequence which keeps track of the largest occuring state *)
Inductive redWithMaxSize {X} (size:X -> nat) (step : X -> X -> Prop): nat -> X -> X -> Prop:=
redWithMaxSizeR m s: m = size s -> redWithMaxSize size step m s s
| redWithMaxSizeC s s' t m m': step s s' -> redWithMaxSize size step m' s' t -> m = max (size s) m' -> redWithMaxSize size step m s t.
Instance ecl_Equivalence {X} (R:X->X->Prop) : Equivalence (ecl R).
Instance star_ecl_subrel {X} (R:X->X->Prop) : subrelation (star R) (ecl R).
Instance pow_ecl_subrel {X} (R:X->X->Prop) n : subrelation (pow R n) (ecl R).

Lemma uniform_confluent_confluent (X : Type) (R : X -> X -> Prop):
uniform_confluent R -> confluent R.