(************************************************************************)
(*         *      The Rocq Prover / The Rocq Development Team           *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
(*                      Evgeny Makarov, INRIA, 2007                     *)
(************************************************************************)
(** Generic properties of ordered rings on a setoid equality *)
Set Implicit Arguments.
Module Import OrderedRingSyntax.
Export RingSyntax.
Reserved Notation "x ~= y" (at level 70, no associativity).
Reserved Notation "x [=] y" (at level 70, no associativity).
Reserved Notation "x [~=] y" (at level 70, no associativity).
Reserved Notation "x [<] y" (at level 70, no associativity).
Reserved Notation "x [<=] y" (at level 70, no associativity).
End OrderedRingSyntax.
Section DEFINITIONS.
Variable R : Type.
Variable (rO rI : R) (rplus rtimes rminus: R -> R -> R) (ropp : R -> R).
Variable req rle rlt : R -> R -> Prop.
Notation "0" := rO.
Notation "1" := rI.
Notation "x + y" := (rplus x y).
Notation "x * y " := (rtimes x y).
Notation "x - y " := (rminus x y).
Notation "- x" := (ropp x).
Notation "x == y" := (req x y).
Notation "x ~= y" := (~ req x y).
Notation "x <= y" := (rle x y).
Notation "x < y" := (rlt x y).
Record SOR : Prop := mk_SOR_theory {
SORsetoid : Setoid_Theory R req;
SORplus_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 + y1 == x2 + y2;
SORtimes_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 * y1 == x2 * y2;
SORopp_wd : forall x1 x2, x1 == x2 ->  -x1 == -x2;
SORle_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> (x1 <= y1 <-> x2 <= y2);
SORlt_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> (x1 < y1 <-> x2 < y2);
SORrt : ring_theory rO rI rplus rtimes rminus ropp req;
SORle_refl : forall n : R, n <= n;
SORle_antisymm : forall n m : R, n <= m -> m <= n -> n == m;
SORle_trans : forall n m p : R, n <= m -> m <= p -> n <= p;
SORlt_le_neq : forall n m : R, n < m <-> n <= m /\ n ~= m;
SORlt_trichotomy : forall n m : R,  n < m \/ n == m \/ m < n;
SORplus_le_mono_l : forall n m p : R, n <= m -> p + n <= p + m;
SORtimes_pos_pos : forall n m : R, 0 < n -> 0 < m -> 0 < n * m;
SORneq_0_1 : 0 ~= 1
}.
(* We cannot use Relation_Definitions.order.ord_antisym and Relations_1.Antisymmetric because they refer to Leibniz equality *)
End DEFINITIONS.
Section STRICT_ORDERED_RING.
Variable R : Type.
Variable (rO rI : R) (rplus rtimes rminus: R -> R -> R) (ropp : R -> R).
Variable req rle rlt : R -> R -> Prop.
Variable sor : SOR rO rI rplus rtimes rminus ropp req rle rlt.
Notation "0" := rO.
Notation "1" := rI.
Notation "x + y" := (rplus x y).
Notation "x * y " := (rtimes x y).
Notation "x - y " := (rminus x y).
Notation "- x" := (ropp x).
Notation "x == y" := (req x y).
Notation "x ~= y" := (~ req x y).
Notation "x <= y" := (rle x y).
Notation "x < y" := (rlt x y).
Add Relation R req
reflexivity proved by (@Equivalence_Reflexive _ _ (SORsetoid sor))
symmetry proved by (@Equivalence_Symmetric _ _ (SORsetoid sor))
transitivity proved by (@Equivalence_Transitive _ _ (SORsetoid sor))
as sor_setoid.
Add Morphism rplus with signature req ==> req ==> req as rplus_morph.
Add Morphism rtimes with signature req ==> req ==> req as rtimes_morph.
Add Morphism ropp with signature req ==> req as ropp_morph.
Add Morphism rle with signature req ==> req ==> iff as rle_morph.
Add Morphism rlt with signature req ==> req ==> iff as rlt_morph.
Add Ring SOR : (SORrt sor).
Add Morphism rminus with signature req ==> req ==> req as rminus_morph.

(* Specifications: *)
Theorem Rneq_symm : forall n m : R, n ~= m -> m ~= n.
(* Properties of plus, minus and opp *)
Theorem Rplus_0_l : forall n : R, 0 + n == n.
Theorem Rplus_0_r : forall n : R, n + 0 == n.
Theorem Rtimes_0_r : forall n : R, n * 0 == 0.
Theorem Rplus_comm : forall n m : R, n + m == m + n.
Theorem Rtimes_0_l : forall n : R, 0 * n == 0.
Theorem Rtimes_comm : forall n m : R, n * m == m * n.
Theorem Rminus_eq_0 : forall n m : R, n - m == 0 <-> n == m.
Theorem Rplus_cancel_l : forall n m p : R, p + n == p + m <-> n == m.
(* Relations *)
Theorem Rle_refl : forall n : R, n <= n.
Proof (SORle_refl sor).
Theorem Rle_antisymm : forall n m : R, n <= m -> m <= n -> n == m.
Proof (SORle_antisymm sor).
Theorem Rle_trans : forall n m p : R, n <= m -> m <= p -> n <= p.
Proof (SORle_trans sor).
Theorem Rlt_trichotomy : forall n m : R,  n < m \/ n == m \/ m < n.
Proof (SORlt_trichotomy sor).
Theorem Rlt_le_neq : forall n m : R, n < m <-> n <= m /\ n ~= m.
Proof (SORlt_le_neq sor).
Theorem Rneq_0_1 : 0 ~= 1.
Proof (SORneq_0_1 sor).
Theorem Req_em : forall n m : R, n == m \/ n ~= m.
Theorem Req_dne : forall n m : R, ~ ~ n == m <-> n == m.
Theorem Rle_lt_eq : forall n m : R, n <= m <-> n < m \/ n == m.
Ltac le_less := rewrite Rle_lt_eq; left; try assumption.