Section ALMOST_RING.
Variable R : Type.
Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
Variable req : R -> R -> Prop.
Notation "0" := rO.  Notation "1" := rI.
Infix "==" := req. Infix "+" := radd.  Infix "* " := rmul.
(* a semi_morph can be extended to a ring_morph for the almost_ring derived from a semi_ring, provided the ring is a setoid (we only need reflexivity) *)
Variable C : Type.
Variable (cO cI : C) (cadd cmul: C->C->C).
Variable (ceqb : C -> C -> bool).
Variable phi : C -> R.
Variable Smorph : semi_morph rO rI radd rmul req cO cI cadd cmul ceqb phi.
End  SEMI_RING.
Infix "-" := rsub.
Notation "- x" := (ropp x).
Variable Reqe : ring_eq_ext radd rmul ropp req.
Add Morphism radd with signature (req ==> req ==> req) as radd_ext2.
Proof
(mk_art 0 1 radd rmul rsub ropp req (Radd_0_l Rth) (Radd_comm Rth) (Radd_assoc Rth)
(Rmul_1_l Rth) Rmul_0_l (Rmul_comm Rth) (Rmul_assoc Rth) (Rdistr_l Rth)
Ropp_mul_l Ropp_add (Rsub_def Rth)).
(** Every semi morphism between two rings is a morphism*)
Variable C : Type.
Variable (cO cI : C) (cadd cmul csub: C->C->C) (copp : C -> C).
Variable (ceq : C -> C -> Prop) (ceqb : C -> C -> bool).
Variable phi : C -> R.
Infix "+!" := cadd. Infix "*!" := cmul.
Infix "-!" := csub. Notation "-! x" := (copp x).
Notation "?=!" := ceqb. Notation "[ x ]" := (phi x).
Variable Csth : Equivalence ceq.
Variable Ceqe : ring_eq_ext cadd cmul copp ceq.
Add Parametric Relation : C ceq
reflexivity  proved by (@Equivalence_Reflexive _ _ Csth)
symmetry     proved by (@Equivalence_Symmetric _ _ Csth)
transitivity proved by (@Equivalence_Transitive _ _ Csth)
as C_setoid.
Add Morphism cadd with signature (ceq ==> ceq ==> ceq) as cadd_ext.
Proof
(mkmorph 0 1 radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi
(Smorph0 Smorph) (Smorph1 Smorph)
(Smorph_add Smorph) Smorph_sub (Smorph_mul Smorph) Smorph_opp
(Smorph_eq Smorph)).
End RING.
(** Useful lemmas on almost ring *)
Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
Instance ARsub_ext : Proper (req ==> req ==> req) rsub.
Ltac mrewrite :=
repeat first
[ rewrite (ARadd_0_l ARth)
| rewrite <- ((ARadd_comm ARth) 0)
| rewrite (ARmul_1_l ARth)
| rewrite <- ((ARmul_comm ARth) 1)
| rewrite (ARmul_0_l ARth)
| rewrite <- ((ARmul_comm ARth) 0)
| rewrite (ARdistr_l ARth)
| reflexivity
| match goal with
| |- context [?z * (?x + ?y)] => rewrite ((ARmul_comm ARth) z (x+y))
end].

Lemma ARopp_mul_r x y : - (x * y) == x * -y.