Section NWORDMORPHISM.
Variable R : Type.
Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
Variable req : R -> R -> Prop.
Notation "0" := rO.  Notation "1" := rI.
Notation "x + y" := (radd x y).  Notation "x * y " := (rmul x y).
Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
Notation "x == y" := (req x y).
Variable Rsth : Setoid_Theory R req.
Add Parametric Relation : R req
reflexivity  proved by (@Equivalence_Reflexive _ _ Rsth)
symmetry     proved by (@Equivalence_Symmetric _ _ Rsth)
transitivity proved by (@Equivalence_Transitive _ _ Rsth)
as R_setoid5.
Ltac rrefl := gen_reflexivity Rsth.
Variable Reqe : ring_eq_ext radd rmul ropp req.
Add Morphism radd with signature (req ==> req ==> req) as radd_ext5.
induction w.
destruct n; simpl; norm.
intros.
destruct n; norm.
Qed.
destruct w; intros.
destruct n; norm.
unfold Nwcons.
rewrite gen_phiNword_cons.
reflexivity.
Qed.
induction w1; intros.
simpl.
rewrite (gen_phiNword0_ok _ H).
reflexivity.
rewrite gen_phiNword_cons.
destruct w2.
simpl in H.
destruct a; try  discriminate.
rewrite (gen_phiNword0_ok _ H).
norm.
simpl in H.
rewrite gen_phiNword_cons.
case_eq (N.eqb a n); intros H0.
rewrite H0 in H.
apply N.eqb_eq in H0. rewrite <- H0.
rewrite (IHw1 _ H).
reflexivity.
rewrite H0 in H;  discriminate H.
Qed.
induction x; intros.
simpl.
norm.
destruct y.
simpl Nwadd; norm.
simpl Nwadd.
repeat rewrite gen_phiNword_cons.
rewrite (fun sreq => gen_phiN_add Rsth sreq (ARth_SRth ARth)) by
(destruct Reqe; constructor; trivial).
rewrite IHx.
norm.
add_push (- gen_phiNword x); reflexivity.
Qed.
simpl.
unfold Nwopp; simpl.
intros.
rewrite gen_phiNword_Nwcons; norm.
Qed.
induction x; intros.
norm.
simpl Nwscal.
repeat rewrite gen_phiNword_cons.
rewrite (fun sreq => gen_phiN_mult Rsth sreq (ARth_SRth ARth))
by (destruct Reqe; constructor; trivial).
rewrite IHx.
norm.
Qed.
induction x; intros.
norm.
destruct a.
simpl Nwmul.
rewrite Nwopp_ok.
rewrite IHx.
rewrite gen_phiNword_cons.
norm.
simpl Nwmul.
unfold Nwsub.
rewrite Nwadd_ok.
rewrite Nwscal_ok.
rewrite Nwopp_ok.
rewrite IHx.
rewrite gen_phiNword_cons.
norm.
Qed.

(* Proof that [.] satisfies morphism specifications *)
Lemma gen_phiNword_morph :
ring_morph 0 1 radd rmul rsub ropp req
NwO NwI Nwadd Nwmul Nwsub Nwopp Nweq_bool gen_phiNword.