(** Rewrite crelation on a given support: declares a crelation as a rewrite
   crelation for use by the generalized rewriting tactic.
   It helps choosing if a rewrite should be handled
   by the generalized or the regular rewriting tactic using leibniz equality.
   Users can declare an [RewriteRelation A RA] anywhere to declare default
   crelations. This is also done automatically by the [Declare Relation A RA]
   commands. *)

  Class RewriteRelation (RA : crelation A).(** Any [Equivalence] declared in the context is automatically considered
   a rewrite crelation. *)
    
  Global Instance equivalence_rewrite_crelation `(Equivalence eqA) : RewriteRelation eqA.Global Instance eq_Reflexive : Reflexive (@eq A) := @eq_refl A.Global Instance eq_Symmetric : Symmetric (@eq A) := @eq_sym A.Global Instance eq_Transitive : Transitive (@eq A) := @eq_trans A.(** Leibinz equality [eq] is an equivalence crelation.
        The instance has low priority as it is always applicable
        if only the type is constrained. *)
    
    Global Program Instance eq_equivalence : Equivalence (@eq A) | 10.Global Instance: RewriteRelation relation_equivalence.Ltac solve_crelation :=
  match goal with
  | [ |- ?R ?x ?x ] => reflexivity
  | [ H : ?R ?x ?y |- ?R ?y ?x ] => symmetry ; exact H
  end.(** We can already dualize all these properties. *)

(** * Standard instances. *)

Ltac reduce_hyp H :=
  match type of H with
    | context [ _ <-> _ ] => fail 1
    | _ => red in H ; try reduce_hyp H
  end.Ltac reduce_goal :=
  match goal with
    | [ |- _ <-> _ ] => fail 1
    | _ => red ; intros ; try reduce_goal
  end.Ltac reduce := reduce_goal.Ltac simpl_crelation :=
  unfold flip, impl, arrow ; try reduce ; program_simpl ;
    try ( solve [ dintuition auto with crelations ]).(** Logical implication. *)

#[global]
Program Instance impl_Reflexive : Reflexive impl.#[global]
Program Instance impl_Transitive : Transitive impl.(** Logical equivalence. *)

#[global]
Instance iff_Reflexive : Reflexive iff := iff_refl.#[global]
Instance iff_Symmetric : Symmetric iff := iff_sym.#[global]
Instance iff_Transitive : Transitive iff := iff_trans.(** Logical equivalence [iff] is an equivalence crelation. *)

#[global]
Program Instance iff_equivalence : Equivalence iff.#[global]
Program Instance arrow_Reflexive : Reflexive arrow.#[global]
Program Instance arrow_Transitive : Transitive arrow.#[global]
Instance iffT_Reflexive : Reflexive iffT.#[global]
Instance iffT_Symmetric : Symmetric iffT.#[global]
Instance iffT_Transitive : Transitive iffT.Definition relation_equivalence : crelation (crelation A) :=
    fun R R' => forall x y, iffT (R x y) (R' x y).Definition relation_conjunction (R : crelation A) (R' : crelation A) : crelation A :=
    fun x y => prod (R x y) (R' x y).Definition relation_disjunction (R : crelation A) (R' : crelation A) : crelation A :=
    fun x y => sum (R x y) (R' x y).(** Relation equivalence is an equivalence, and subrelation defines a partial order. *)

  Global Instance relation_equivalence_equivalence :
    Equivalence relation_equivalence.Global Instance relation_implication_preorder : PreOrder (@subrelation A).(** *** Partial Order.
   A partial order is a preorder which is additionally antisymmetric.
   We give an equivalent definition, up-to an equivalence crelation
   on the carrier. *)

  Class PartialOrder eqA `{equ : Equivalence A eqA} R `{preo : PreOrder A R} :=
    partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (flip R)).(** *** Partial Order.
   A partial order is a preorder which is additionally antisymmetric.
   We give an equivalent definition, up-to an equivalence crelation
   on the carrier. *)

  Class PartialOrder eqA `{equ : Equivalence A eqA} R `{preo : PreOrder A R} :=
    partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (flip R)).(** The equivalence proof is sufficient for proving that [R] must be a
   morphism for equivalence (see Morphisms).  It is also sufficient to
   show that [R] is antisymmetric w.r.t. [eqA] *)

  Global Instance partial_order_antisym `(PartialOrder eqA R) : Antisymmetric eqA R.

(* Specifications: *)
Lemma PartialOrder_inverse `(PartialOrder eqA R) : PartialOrder eqA (flip R).