(************************************************************************)
(*         *      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)         *)
(************************************************************************)
(* F. Besson: to evaluate polynomials, the original code is using a list. For big polynomials, this is inefficient -- linear access. I have modified the code to use binary trees -- logarithmic access.  *)
Set Implicit Arguments.
Require Export Ring_theory.
Local Open Scope positive_scope.
(** Definition of polynomial expressions *)
#[universes(template)]
Inductive PExpr {C} : Type :=
| PEc : C -> PExpr
| PEX : positive -> PExpr
| PEadd : PExpr -> PExpr -> PExpr
| PEsub : PExpr -> PExpr -> PExpr
| PEmul : PExpr -> PExpr -> PExpr
| PEopp : PExpr -> PExpr
| PEpow : PExpr -> N -> PExpr.
Arguments PExpr : clear implicits.
Register PEc as micromega.PExpr.PEc.
Register PEX as micromega.PExpr.PEX.
Register PEadd as micromega.PExpr.PEadd.
Register PEsub as micromega.PExpr.PEsub.
Register PEmul as micromega.PExpr.PEmul.
Register PEopp as micromega.PExpr.PEopp.
Register PEpow as micromega.PExpr.PEpow.
(* Definition of multivariable polynomials with coefficients in C : Type [Pol] represents [X1 ... Xn]. The representation is Horner's where a [n] variable polynomial (C[X1..Xn]) is seen as a polynomial on [X1] which coefficients are polynomials with [n-1] variables (C[X2..Xn]). There are several optimisations to make the repr compacter: - [Pc c] is the constant polynomial of value c == c*X1^0*..*Xn^0 - [Pinj j Q] is a polynomial constant w.r.t the [j] first variables. variable indices are shifted of j in Q. == X1^0 *..* Xj^0 * Q{X1 <- Xj+1;..; Xn-j <- Xn} - [PX P i Q] is an optimised Horner form of P*X^i + Q with P not the null polynomial == P * X1^i + Q{X1 <- X2; ..; Xn-1 <- Xn}  In addition: - polynomials of the form (PX (PX P i (Pc 0)) j Q) are forbidden since they can be represented by the simpler form (PX P (i+j) Q) - (Pinj i (Pinj j P)) is (Pinj (i+j) P) - (Pinj i (Pc c)) is (Pc c) *)
#[universes(template)]
Inductive Pol {C} : Type :=
| Pc : C -> Pol
| Pinj : positive -> Pol -> Pol
| PX : Pol -> positive -> Pol -> Pol.
Arguments Pol : clear implicits.
Register Pc as micromega.Pol.Pc.
Register Pinj as micromega.Pol.Pinj.
Register PX   as micromega.Pol.PX.
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.
(* 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.

(* Specifications: *)
Lemma Peq_spec P P' :
BoolSpec (forall l, P@l == P'@l) True (P ?== P').
Lemma Pphi0 l : P0@l == 0.
Lemma Pphi1 l : P1@l == 1.
Lemma env_morph p e1 e2 :
(forall x, e1 x = e2 x) -> p @ e1 = p @ e2.
Lemma Pjump_add P i j l :
P @ (jump (i + j) l) = P @ (jump j (jump i l)).
Lemma Pjump_xO_tail P p l :
P @ (jump (xO p) (tail l)) = P @ (jump (xI p) l).
Lemma Pjump_pred_double P p l :
P @ (jump (Pos.pred_double p) (tail l)) = P @ (jump (xO p) l).
Lemma mkPinj_ok j l P : (mkPinj j P)@l == P@(jump j l).
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).