(** Rewrite relation on a given support: declares a relation as a rewrite
   relation 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
   relations on a given type `A`. This is also done automatically by
   the [Declare Relation A RA] commands. It has no mode declaration:
   it will assign `?A := Prop, ?R := iff` on an entirely unspecified query
   `RewriteRelation ?A ?R`, or any prefered rewrite relation of priority < 2. *)

  Class RewriteRelation (RA : relation A).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 relation.
        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.(** Disequality is symmetric. *)
    Global Instance neq_Symmetric : Symmetric (fun x y : A => x <> y) := (@not_eq_sym A).(** Default rewrite relations handled by [setoid_rewrite] on Prop. *)
#[global]
Instance inverse_impl_rewrite_relation : RewriteRelation (flip impl) | 3 := {}.#[global]
Instance impl_rewrite_relation : RewriteRelation impl | 3 := {}.#[global]
Instance iff_rewrite_relation : RewriteRelation iff | 2 := {}.(** Any [Equivalence] declared in the context is automatically considered
  a rewrite relation. This only applies if the relation is at least partially
  defined: setoid_rewrite won't try to infer arbitrary user rewrite relations. *)

Definition equivalence_rewrite_relation `(eqa : Equivalence A eqA) : RewriteRelation eqA :=
  Build_RewriteRelation _.Ltac equiv_rewrite_relation R :=
  tryif is_evar R then fail
  else class_apply equivalence_rewrite_relation.Ltac solve_relation :=
  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_relation :=
  unfold flip, impl, arrow ; try reduce ; program_simpl ;
    try ( solve [ dintuition auto with relations ]).(** 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 relation. *)

#[global]
Program Instance iff_equivalence : Equivalence iff.(** A compact representation of non-dependent arities, with the codomain singled-out. *)

(* Note, we do not use [list Type] because it imposes unnecessary universe constraints *)
Inductive Tlist : Type := Tnil : Tlist | Tcons : Type -> Tlist -> Tlist.(** A compact representation of non-dependent arities, with the codomain singled-out. *)

(* Note, we do not use [list Type] because it imposes unnecessary universe constraints *)
Inductive Tlist : Type := Tnil : Tlist | Tcons : Type -> Tlist -> Tlist.(** A compact representation of non-dependent arities, with the codomain singled-out. *)

(* Note, we do not use [list Type] because it imposes unnecessary universe constraints *)
Inductive Tlist : Type := Tnil : Tlist | Tcons : Type -> Tlist -> Tlist.Local Infix "::" := Tcons.Fixpoint arrows (l : Tlist) (r : Type) : Type :=
  match l with
    | Tnil => r
    | A :: l' => A -> arrows l' r
  end.(** We can define abbreviations for operation and relation types based on [arrows]. *)

Definition unary_operation A := arrows (A::Tnil) A.Definition binary_operation A := arrows (A::A::Tnil) A.Definition ternary_operation A := arrows (A::A::A::Tnil) A.(** We define n-ary [predicate]s as functions into [Prop]. *)

Notation predicate l := (arrows l Prop).(** Unary predicates, or sets. *)

Definition unary_predicate A := predicate (A::Tnil).(** Homogeneous binary relations, equivalent to [relation A]. *)

Definition binary_relation A := predicate (A::A::Tnil).(** We can close a predicate by universal or existential quantification. *)

Fixpoint predicate_all (l : Tlist) : predicate l -> Prop :=
  match l with
    | Tnil => fun f => f
    | A :: tl => fun f => forall x : A, predicate_all tl (f x)
  end.Fixpoint predicate_exists (l : Tlist) : predicate l -> Prop :=
  match l with
    | Tnil => fun f => f
    | A :: tl => fun f => exists x : A, predicate_exists tl (f x)
  end.(** Pointwise extension of a binary operation on [T] to a binary operation
   on functions whose codomain is [T].
   For an operator on [Prop] this lifts the operator to a binary operation. *)

Fixpoint pointwise_extension {T : Type} (op : binary_operation T)
  (l : Tlist) : binary_operation (arrows l T) :=
  match l with
    | Tnil => fun R R' => op R R'
    | A :: tl => fun R R' =>
      fun x => pointwise_extension op tl (R x) (R' x)
  end.(** Pointwise lifting, equivalent to doing [pointwise_extension] and closing using [predicate_all]. *)

Fixpoint pointwise_lifting (op : binary_relation Prop)  (l : Tlist) : binary_relation (predicate l) :=
  match l with
    | Tnil => fun R R' => op R R'
    | A :: tl => fun R R' =>
      forall x, pointwise_lifting op tl (R x) (R' x)
  end.(** The n-ary equivalence relation, defined by lifting the 0-ary [iff] relation. *)

Definition predicate_equivalence {l : Tlist} : binary_relation (predicate l) :=
  pointwise_lifting iff l.(** The n-ary implication relation, defined by lifting the 0-ary [impl] relation. *)

Definition predicate_implication {l : Tlist} :=
  pointwise_lifting impl l.Infix "<∙>" := predicate_equivalence (at level 95, no associativity) : predicate_scope.Infix "-∙>" := predicate_implication (at level 70, right associativity) : predicate_scope.(** The pointwise liftings of conjunction and disjunctions.
   Note that these are [binary_operation]s, building new relations out of old ones. *)

Definition predicate_intersection := pointwise_extension and.Definition predicate_union := pointwise_extension or.Infix "/∙\" := predicate_intersection (at level 80, right associativity) : predicate_scope.Infix "\∙/" := predicate_union (at level 85, right associativity) : predicate_scope.(** The always [True] and always [False] predicates. *)

Fixpoint true_predicate {l : Tlist} : predicate l :=
  match l with
    | Tnil => True
    | A :: tl => fun _ => @true_predicate tl
  end.Fixpoint false_predicate {l : Tlist} : predicate l :=
  match l with
    | Tnil => False
    | A :: tl => fun _ => @false_predicate tl
  end.Notation "∙⊤∙" := true_predicate : predicate_scope.Notation "∙⊥∙" := false_predicate : predicate_scope.(** Predicate equivalence is an equivalence, and predicate implication defines a preorder. *)

#[global]
Program Instance predicate_equivalence_equivalence {l} :
  Equivalence (@predicate_equivalence l).#[global]
Program Instance predicate_implication_preorder {l} :
  PreOrder (@predicate_implication l).Definition relation_equivalence : relation (relation A) :=
    @predicate_equivalence (_::_::Tnil).Global Instance relation_equivalence_rewrite_relation: RewriteRelation relation_equivalence := {}.Definition relation_conjunction (R : relation A) (R' : relation A) : relation A :=
    @predicate_intersection (A::A::Tnil) R R'.Definition relation_disjunction (R : relation A) (R' : relation A) : relation A :=
    @predicate_union (A::A::Tnil) R R'.(** 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 relation
   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 relation
   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 A eqA R.

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