(** Generic evaluation of polynomial towards R avoiding parenthesis *)
Variable get_sign : C -> option C.
Variable get_sign_spec : sign_theory copp ceqb get_sign.
Section EVALUATION.
(* [mkpow x p] = x^p *)
Variable mkpow : R -> positive -> R.
(* [mkpow x p] = -(x^p) *)
Variable mkopp_pow : R -> positive -> R.
(* [mkmult_pow r x p] = r * x^p *)
Variable mkmult_pow : R -> R -> positive -> R.
Fixpoint mkmult_rec (r:R) (lm:list (R*positive)) {struct lm}: R :=
match lm with
| nil => r
| cons (x,p) t => mkmult_rec (mkmult_pow r x p) t
end.
Definition mkmult1 lm :=
match lm with
| nil => 1
| cons (x,p) t => mkmult_rec (mkpow x p) t
end.
Definition mkmultm1 lm :=
match lm with
| nil => ropp rI
| cons (x,p) t => mkmult_rec (mkopp_pow x p) t
end.
Definition mkmult_c_pos c lm :=
if c ?=! cI then mkmult1 (rev' lm)
else mkmult_rec [c] (rev' lm).
Definition mkmult_c c lm :=
match get_sign c with
| None => mkmult_c_pos c lm
| Some c' =>
if c' ?=! cI then mkmultm1 (rev' lm)
else mkmult_rec [c] (rev' lm)
end.
Definition mkadd_mult rP c lm :=
match get_sign c with
| None => rP + mkmult_c_pos c lm
| Some c' => rP - mkmult_c_pos c' lm
end.
Definition add_pow_list (r:R) n l :=
match n with
| N0 => l
| Npos p => (r,p)::l
end.
Fixpoint add_mult_dev
(rP:R) (P:Pol) (fv:list R) (n:N) (lm:list (R*positive)) {struct P} : R :=
match P with
| Pc c =>
let lm := add_pow_list (hd fv) n lm in
mkadd_mult rP c lm
| Pinj j Q =>
add_mult_dev rP Q (jump j fv) N0 (add_pow_list (hd fv) n lm)
| PX P i Q =>
let rP := add_mult_dev rP P fv (N.add (Npos i) n) lm in
if Q ?== P0 then rP
else add_mult_dev rP Q (tail fv) N0 (add_pow_list (hd fv) n lm)
end.
Fixpoint mult_dev (P:Pol) (fv : list R) (n:N)
(lm:list (R*positive)) {struct P} : R :=
(* P@l * (hd 0 l)^n * lm *)
match P with
| Pc c => mkmult_c c (add_pow_list (hd fv) n lm)
| Pinj j Q => mult_dev Q (jump j fv) N0 (add_pow_list (hd fv) n lm)
| PX P i Q =>
let rP := mult_dev P fv (N.add (Npos i) n) lm in
if Q ?== P0 then rP
else
let lmq := add_pow_list (hd fv) n lm in
add_mult_dev rP Q (tail fv) N0 lmq
end.
Definition Pphi_avoid fv P := mult_dev P fv N0 nil.
Fixpoint r_list_pow (l:list (R*positive)) : R :=
match l with
| nil => rI
| cons (r,p) l => pow_pos rmul r p * r_list_pow l
end.
Hypothesis mkpow_spec : forall r p, mkpow r p == pow_pos rmul r p.
Hypothesis mkopp_pow_spec : forall r p, mkopp_pow r p == - (pow_pos rmul r p).
Hypothesis mkmult_pow_spec : forall r x p, mkmult_pow r x p == r * pow_pos rmul x p.

(* Specifications: *)
Lemma mkmult_rec_ok : forall lm r, mkmult_rec r lm == r * r_list_pow lm.
Lemma mkmult1_ok : forall lm, mkmult1 lm == r_list_pow lm.
Lemma mkmultm1_ok : forall lm, mkmultm1 lm == - r_list_pow lm.
Lemma r_list_pow_rev :  forall l, r_list_pow (rev' l) == r_list_pow l.
Lemma mkmult_c_pos_ok : forall c lm, mkmult_c_pos c lm == [c]* r_list_pow lm.
Lemma mkmult_c_ok : forall c lm, mkmult_c c lm == [c] * r_list_pow lm.
Lemma mkadd_mult_ok : forall rP c lm, mkadd_mult rP c lm == rP + [c]*r_list_pow lm.
Lemma add_pow_list_ok :
forall r n l, r_list_pow (add_pow_list r n l) == pow_N rI rmul r n * r_list_pow l.
Lemma add_mult_dev_ok : forall P rP fv n lm,
add_mult_dev rP P fv n lm == rP + P@fv*pow_N rI rmul (hd fv) n * r_list_pow lm.
Lemma mult_dev_ok : forall P fv n lm,
mult_dev P fv n lm == P@fv * pow_N rI rmul (hd fv) n * r_list_pow lm.
Lemma Pphi_avoid_ok : forall P fv, Pphi_avoid fv P  == P@fv.
End EVALUATION.