Ltac rsimpl := repeat (gen_rewrite || rewrite phiCR_comm).Ltac add_push := gen_add_push .(* Definition of non commutative multivariable polynomials
   with coefficients in C :
 *)

Inductive Pol : Type :=
  | Pc : C -> Pol
  | PX : Pol -> positive -> positive -> Pol -> Pol.(* Definition of non commutative multivariable polynomials
   with coefficients in C :
 *)

Inductive Pol : Type :=
  | Pc : C -> Pol
  | PX : Pol -> positive -> positive -> Pol -> Pol.(* Definition of non commutative multivariable polynomials
   with coefficients in C :
 *)

Inductive Pol : Type :=
  | Pc : C -> Pol
  | PX : Pol -> positive -> positive -> Pol -> Pol.(* PX P i n Q represents P * X_i^n + Q *)
Definition cO:C .Definition cI:C .Definition P0 := Pc 0.Definition P1 := Pc 1.#[universes(template)]
Class Equalityb (A : Type):= {equalityb : A -> A -> bool}.#[universes(template)]
Class Equalityb (A : Type):= {equalityb : A -> A -> bool}.Notation "x =? y" := (equalityb x y) (at level 70, no associativity).Instance equalityb_coef : Equalityb C :=
  {equalityb x y := Ceqb x y}.Fixpoint Peq (P P' : Pol) {struct P'} : bool :=
  match P, P' with
  | Pc c, Pc c' => c =? c'
  | PX P i n Q, PX P' i' n' Q' =>
    match Pos.compare i i', Pos.compare n n' with
    | Eq, Eq => if Peq P P' then Peq Q Q' else false
    | _,_ => false
    end
  | _, _ => false
end.Instance equalityb_pol : Equalityb Pol :=
  {equalityb x y := Peq x y}.(* Q a ses variables de queue < i *)
Definition mkPX P i n Q :=
  match P with
  | Pc c => if c =? 0 then Q else PX P i n Q
  | PX P' i' n' Q' =>
    match Pos.compare i i' with
    | Eq => if Q' =? P0 then PX P' i (n + n') Q else PX P i n Q
    | _ => PX P i n Q
    end
  end.Definition mkXi i n := PX P1 i n P0.Definition mkX i := mkXi i 1.(** Opposite of addition *)

Fixpoint Popp (P:Pol) : Pol :=
  match P with
  | Pc c => Pc (- c)
  | PX P i n Q => PX (Popp P) i n (Popp Q)
  end.Notation "-- P" := (Popp P)(at level 30).(** Addition et subtraction *)

Fixpoint PaddCl (c:C)(P:Pol) {struct P} : Pol :=
  match P with
  | Pc c1 => Pc (c + c1)
  | PX P i n Q => PX P i n (PaddCl c Q)
  end.(* Xi^n * P + Q
les variables de tete de Q ne sont pas forcement < i
mais Q est normalisé : variables de tete decroissantes *)

Fixpoint PaddX (i n:positive)(Q:Pol){struct Q}:=
  match Q with
  | Pc c => mkPX P i n Q
  | PX P' i' n' Q' =>
      match Pos.compare i i' with
      | (* i > i' *)
        Gt => mkPX P i n Q
      | (* i < i' *)
        Lt => mkPX P' i' n' (PaddX i n Q')
      | (* i = i' *)
        Eq => match Z.pos_sub n n' with
              | (* n > n' *)
                Zpos k => mkPX (PaddX i k P') i' n' Q'
              | (* n = n' *)
                Z0 => mkPX (Padd P P') i n Q'
              | (* n < n' *)
                Zneg k => mkPX (Padd P (mkPX P' i k P0)) i n Q'
              end
      end
  end.Fixpoint Padd (P1 P2: Pol) {struct P1} : Pol :=
  match P1 with
  | Pc c => PaddCl c P2
  | PX P' i' n' Q' =>
      PaddX Padd P' i' n' (Padd Q' P2)
  end.Notation "P ++ P'" := (Padd P P').Definition Psub(P P':Pol):= P ++ (--P').Notation "P -- P'" := (Psub P P')(at level 50).(** Multiplication *)

Fixpoint PmulC_aux (P:Pol) (c:C)  {struct P} : Pol :=
  match P with
  | Pc c' => Pc (c' * c)
  | PX P i n Q => mkPX (PmulC_aux P c) i n (PmulC_aux Q c)
  end.Definition PmulC P c :=
  if c =? 0 then P0 else
  if c =? 1 then P else PmulC_aux P c.Fixpoint Pmul (P1 P2 : Pol) {struct P2} : Pol :=
  match P2 with
  | Pc c => PmulC P1 c
  | PX P i n Q =>
    PaddX Padd (Pmul P1 P) i n (Pmul P1 Q)
  end.Notation "P ** P'" := (Pmul P P')(at level 40).Definition Psquare (P:Pol) : Pol := P ** P.(** Evaluation of a polynomial towards R *)

Fixpoint Pphi(l:list R) (P:Pol) {struct P} : R :=
  match P with
  | Pc c => [c]
  | PX P i n Q =>
     let x := nth 0 i l in
     let xn := pow_pos x n in
    (Pphi l P) * xn + (Pphi l Q)
  end.Notation "P @ l " := (Pphi l P).(** Proofs *)

Ltac destr_pos_sub H :=
  match goal with |- context [Z.pos_sub ?x ?y] =>
    assert (H := Z.pos_sub_discr x y); destruct (Z.pos_sub x y)
  end.

(* Specifications: *)
Lemma Peq_ok : forall P P', (P =? P') = true -> forall l, P@l == P'@ l.
Lemma Pphi0 : forall l, P0@l == 0.
Lemma Pphi1 : forall l, P1@l == 1.
Lemma mkPX_ok : forall l P i n Q, (mkPX P i n Q)@l == P@l * (pow_pos (nth 0 i l) n) + Q@l.