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.

(* Specifications: *)
Lemma PaddCl_ok : forall c P l, (PaddCl c P)@l == [c] + P@l .
Lemma PmulC_aux_ok : forall c P l, (PmulC_aux P c)@l ==  P@l * [c].
Lemma PmulC_ok : forall c P l, (PmulC P c)@l ==  P@l * [c].
Lemma Popp_ok : forall P l, (--P)@l == - P@l.
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.
Lemma PaddXPX: forall P i n Q,
PaddX Padd P i n 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 Padd P i n Q')
| (* i = i' *)
Eq => match Z.pos_sub n n' with
| (* n > n' *)
Zpos k => mkPX (PaddX Padd P 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.
Lemma PaddX_ok2 : forall P2,
(forall P l, (P2 ++ P) @ l == P2 @ l + P @ l)
/\
(forall P k n l,
(PaddX Padd P2 k n P) @ l ==
P2 @ l * pow_pos (nth 0 k l) n  + P @ l).
Lemma Padd_ok : forall P Q l, (P ++ Q) @ l == P @ l + Q @ l.
Lemma PaddX_ok : forall P2 P k n l,
(PaddX Padd P2 k n P) @ l ==  P2 @ l * pow_pos (nth 0 k l) n  + P @ l.
Lemma Psub_ok : forall P' P l, (P -- P')@l == P@l - P'@l.
Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
Lemma Psquare_ok : forall P l, (Psquare P)@l == P@l * P@l.
Section POWER.