Section PaddX.
Variable Padd:Pol->Pol->Pol.
Variable P:Pol.
(* 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.
End PaddX.
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.
Reserved Notation "P @ l " (at level 10, no associativity).
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.
Ltac Esimpl :=
repeat (progress (
match goal with
| |- context [?P@?l] =>
match P with
| P0 => rewrite (Pphi0 l)
| P1 => rewrite (Pphi1 l)
| (mkPX ?P ?i ?n ?Q) => rewrite (mkPX_ok l P i n Q)
end
| |- context [[?c]] =>
match c with
| 0 => rewrite ring_morphism0
| 1 => rewrite ring_morphism1
| ?x + ?y => rewrite ring_morphism_add
| ?x * ?y => rewrite ring_morphism_mul
| ?x - ?y => rewrite ring_morphism_sub
| - ?x => rewrite ring_morphism_opp
end
end));
simpl; rsimpl.
Ltac Esimpl2 :=
Esimpl;
repeat (progress (
match goal with
| |- context [(PaddCl ?c ?P)@?l] => rewrite (PaddCl_ok c P l)
| |- context [(PmulC ?P ?c)@?l] => rewrite (PmulC_ok c P l)
| |- context [(--?P)@?l] => rewrite (Popp_ok P l)
end)); Esimpl.
induction Q; reflexivity.
Qed.
induction P2;simpl;intros. split. intros. apply PaddCl_ok.
induction P.  unfold PaddX. intros. rewrite mkPX_ok.
simpl. rsimpl.
intros. simpl.
destruct (Pos.compare_spec k p) as [Hh|Hh|Hh].
destr_pos_sub H1h. Esimpl2.
rewrite Hh; trivial. rewrite H1h. reflexivity.
simpl. rewrite mkPX_ok. rewrite IHP1. Esimpl2.
rewrite Pos.add_comm in H1h.
rewrite H1h.
rewrite pow_pos_add.  Esimpl2.
rewrite Hh; trivial. reflexivity.
rewrite mkPX_ok. rewrite PaddCl_ok. Esimpl2. rewrite Pos.add_comm in H1h.
rewrite H1h.  Esimpl2. rewrite pow_pos_add. Esimpl2.
rewrite Hh; trivial. reflexivity.
rewrite mkPX_ok. rewrite IHP2. Esimpl2.
rewrite (ring_add_comm  (P2 @ l * pow_pos (nth 0 p l) p0)
([c] * pow_pos (nth 0 k l) n)).
reflexivity.  assert (H1h := ring_morphism_eq c 0);case_eq (Ceqb c  0);
intros; simpl.
rewrite H1h;trivial. Esimpl2. apply Ceqb_eq; trivial. reflexivity.
decompose [and] IHP2_1. decompose [and] IHP2_2. clear IHP2_1 IHP2_2.
split. intros. rewrite H0. rewrite H1.
Esimpl2.
induction P. unfold PaddX. intros. rewrite mkPX_ok. simpl. reflexivity.
intros. rewrite PaddXPX.
destruct (Pos.compare_spec k p1) as [H3h|H3h|H3h].
destr_pos_sub H4h.
rewrite mkPX_ok. simpl. rewrite H0. rewrite H1. Esimpl2.
rewrite H4h. rewrite H3h;trivial. reflexivity.
rewrite mkPX_ok. rewrite IHP1. Esimpl2. rewrite H3h;trivial.
rewrite Pos.add_comm in H4h.
rewrite H4h. rewrite pow_pos_add. Esimpl2.
rewrite mkPX_ok. simpl. rewrite H0. rewrite H1.
rewrite mkPX_ok.
Esimpl2. rewrite H3h;trivial.
rewrite Pos.add_comm in H4h.
rewrite H4h. rewrite pow_pos_add. Esimpl2.
rewrite mkPX_ok. simpl. rewrite IHP2. Esimpl2.
gen_add_push (P2 @ l * pow_pos (nth 0 p1 l) p2). try reflexivity.
rewrite mkPX_ok. simpl. reflexivity.
Qed.
intro P. elim (PaddX_ok2 P); auto.
Qed.
intro P2. elim (PaddX_ok2 P2); auto.
Qed.
unfold Psub. intros. rewrite Padd_ok. rewrite Popp_ok. rsimpl.
Qed.
induction P'; simpl; intros. rewrite PmulC_ok. reflexivity.
rewrite PaddX_ok. rewrite IHP'1. rewrite IHP'2. Esimpl2.
Qed.

Lemma Psquare_ok : forall P l, (Psquare P)@l == P@l * P@l.