(************************************************************************)
(*         *      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)         *)
(************************************************************************)
Set Implicit Arguments.
Require Export Ring_theory.
Local Open Scope positive_scope.
(* Set Universe Polymorphism. *)
Section MakeRingPol.
(* Ring elements *)
Variable R:Type.
Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R->R).
Variable req : R -> R -> Prop.
(* Ring properties *)
Variable Rsth : Equivalence req.
Variable Reqe : ring_eq_ext radd rmul ropp req.
Variable ARth : almost_ring_theory rO rI radd rmul rsub ropp req.
(* Coefficients *)
Variable C: Type.
Variable (cO cI: C) (cadd cmul csub : C->C->C) (copp : C->C).
Variable ceqb : C->C->bool.
Variable phi : C -> R.
Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req
cO cI cadd cmul csub copp ceqb phi.
(* Power coefficients *)
Variable Cpow : Type.
Variable Cp_phi : N -> Cpow.
Variable rpow : R -> Cpow -> R.
Variable pow_th : power_theory rI rmul req Cp_phi rpow.
(* division is ok *)
Variable cdiv: C -> C -> C * C.
Variable div_th: div_theory req cadd cmul phi cdiv.
(* R notations *)
Notation "0" := rO. Notation "1" := rI.
Infix "+" := radd. Infix "*" := rmul.
Infix "-" := rsub. Notation "- x" := (ropp x).
Infix "==" := req.
Infix "^" := (pow_pos rmul).
(* C notations *)
Infix "+!" := cadd. Infix "*!" := cmul.
Infix "-! " := csub. Notation "-! x" := (copp x).
Infix "?=!" := ceqb. Notation "[ x ]" := (phi x).
(* Useful tactics *)
Add Morphism radd with signature (req ==> req ==> req) as radd_ext.
Instance Pphi_ext : Proper (eq ==> Pequiv ==> req) Pphi.
Instance Pinj_ext : Proper (eq ==> Pequiv ==> Pequiv) Pinj.
Instance PX_ext : Proper (Pequiv ==> eq ==> Pequiv ==> Pequiv) PX.
(** Evaluation of a monomial towards R *)
Fixpoint Mphi(l:list R) (M: Mon) : R :=
match M with
| mon0 => rI
| zmon j M1 => Mphi (jump j l) M1
| vmon i M1 => Mphi (tail l) M1 * (hd l) ^ i
end.
Notation "M @@ l" := (Mphi l M) (at level 10, no associativity).
(** Proofs *)
Ltac destr_pos_sub :=
match goal with |- context [Z.pos_sub ?x ?y] =>
generalize (Z.pos_sub_discr x y); destruct (Z.pos_sub x y)
end.

(* Specifications: *)
Lemma jump_add' i j (l:list R) : jump (i + j) l = jump j (jump i l).
Lemma Peq_spec P P' : BoolSpec (P === P') True (P ?== P').
Lemma Pphi0 l : P0@l == 0.
Lemma Pphi1 l : P1@l == 1.
Lemma mkPinj_ok j l P : (mkPinj j P)@l == P@(jump j l).
Instance mkPinj_ext : Proper (eq ==> Pequiv ==> Pequiv) mkPinj.
Lemma pow_pos_add x i j : x^(j + i) == x^i * x^j.
Lemma ceqb_spec c c' : BoolSpec ([c] == [c']) True (c ?=! c').
Lemma mkPX_ok l P i Q :
(mkPX P i Q)@l == P@l * (hd l)^i + Q@(tail l).