Section Normalize.
Context (A : Type).
Class Normalizes (m : crelation A) (m' : crelation A) :=
normalizes : relation_equivalence m m'.
(** Current strategy: add [flip] everywhere and reduce using [subrelation] afterwards. *)
End Normalize.
Ltac normalizes :=
match goal with
| [ |- Normalizes _ (respectful _ _) _ ] => class_apply @flip_arrow
| _ => class_apply @flip_atom
end.
Ltac proper_normalization :=
match goal with
| [ _ : normalization_done |- _ ] => fail 1
| [ _ : apply_subrelation |- @Proper _ ?R _ ] =>
let H := fresh "H" in
set(H:=did_normalization) ; class_apply @proper_normalizes_proper
end.
Hint Extern 1 (Normalizes _ _ _) => normalizes : typeclass_instances.
Hint Extern 6 (@Proper _ _ _) => proper_normalization
: typeclass_instances.
(** When the crelation on the domain is symmetric, we can flip the crelation on the codomain. Same for binary functions. *)
(** When the crelation on the domain is symmetric, a predicate is compatible with [iff] as soon as it is compatible with [impl]. Same with a binary crelation. *)
(** A [PartialOrder] is compatible with its underlying equivalence. *)
Instance PartialOrder_proper_type `(PartialOrder A eqA R) :
Proper (eqA==>eqA==>iffT) R.
(** From a [PartialOrder] to the corresponding [StrictOrder]: [lt = le /\ ~eq]. If the order is total, we could also say [gt = ~le]. *)
(** From a [StrictOrder] to the corresponding [PartialOrder]: [le = lt \/ eq]. If the order is total, we could also say [ge = ~lt]. *)
Hint Extern 4 (PreOrder (relation_disjunction _ _)) =>
class_apply StrictOrder_PreOrder : typeclass_instances.

Lemma StrictOrder_PartialOrder
`(Equivalence A eqA, StrictOrder A R, Proper _ (eqA==>eqA==>iffT) R) :
PartialOrder eqA (relation_disjunction R eqA).