[build] Consolidate stdlib's .v files under a single directory.

Currently, `.v` under the `Coq.` prefix are found in both `theories`
and `plugins`. Usually these two directories are merged by special
loadpath code that allows double-binding of the prefix.

This adds some complexity to the build and loadpath system; and in
particular, it prevents from handling the `Coq.*` prefix in the
simple, `-R theories Coq` standard way.

We thus move all `.v` files to theories, leaving `plugins` as an
OCaml-only directory, and modify accordingly the loadpath / build
infrastructure.

Note that in general `plugins/foo/Foo.v` was not self-contained, in
the sense that it depended on files in `theories` and files in
`theories` depended on it; moreover, Coq saw all these files as
belonging to the same namespace so it didn't really care where they
lived.

This could also imply a performance gain as we now effectively
traverse less directories when locating a library.

See also discussion in #10003

24 files changed, 0 insertions, 8285 deletions

diff --git a/plugins/setoid_ring/Algebra_syntax.v b/plugins/setoid_ring/Algebra_syntax.v
deleted file mode 100644
index 5f594d29cd..0000000000
--- a/plugins/setoid_ring/Algebra_syntax.v
+++ /dev/null
@@ -1,34 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Class Zero (A : Type) := zero : A.
-Notation "0" := zero.
-Class One (A : Type) := one : A.
-Notation "1" := one.
-Class Addition (A : Type) := addition : A -> A -> A.
-Notation "_+_" := addition.
-Notation "x + y" := (addition x y).
-Class Multiplication {A B : Type} := multiplication : A -> B -> B.
-Notation "_*_" := multiplication.
-Notation "x * y" := (multiplication x y).
-Class Subtraction (A : Type) := subtraction : A -> A -> A.
-Notation "_-_" := subtraction.
-Notation "x - y" := (subtraction x y).
-Class Opposite (A : Type) := opposite : A -> A.
-Notation "-_" := opposite.
-Notation "- x" := (opposite(x)).
-Class Equality {A : Type}:= equality : A -> A -> Prop.
-Notation "_==_" := equality.
-Notation "x == y" := (equality x y) (at level 70, no associativity).
-Class Bracket (A B: Type):= bracket : A -> B.
-Notation "[ x ]" := (bracket(x)).
-Class Power {A B: Type} := power : A -> B -> A.
-Notation "x ^ y" := (power x y).
-
diff --git a/plugins/setoid_ring/ArithRing.v b/plugins/setoid_ring/ArithRing.v
deleted file mode 100644
index 727e99f0b4..0000000000
--- a/plugins/setoid_ring/ArithRing.v
+++ /dev/null
@@ -1,75 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Import Mult.
-Require Import BinNat.
-Require Import Nnat.
-Require Export Ring.
-Set Implicit Arguments.
-
-Lemma natSRth : semi_ring_theory O (S O) plus mult (@eq nat).
- Proof.
-  constructor. exact plus_0_l. exact plus_comm. exact plus_assoc.
-  exact mult_1_l. exact mult_0_l. exact mult_comm. exact mult_assoc.
-  exact mult_plus_distr_r.
- Qed.
-
-Lemma nat_morph_N :
-   semi_morph 0 1 plus mult (eq (A:=nat))
-          0%N 1%N N.add N.mul N.eqb N.to_nat.
-Proof.
-  constructor;trivial.
-  exact N2Nat.inj_add.
-  exact N2Nat.inj_mul.
-  intros x y H. apply N.eqb_eq in H. now subst.
-Qed.
-
-Ltac natcst t :=
-  match isnatcst t with
-    true => constr:(N.of_nat t)
-  | _ => constr:(InitialRing.NotConstant)
-  end.
-
-Ltac Ss_to_add f acc :=
-  match f with
-  | S ?f1 => Ss_to_add f1 (S acc)
-  | _ => constr:((acc + f)%nat)
-  end.
-
-(* For internal use only *)
-Local Definition protected_to_nat := N.to_nat.
-
-Ltac natprering :=
-  match goal with
-  |- context C [S ?p] =>
-    match p with
-      O => fail 1 (* avoid replacing 1 with 1+0 ! *)
-    | p => match isnatcst p with
-           | true => fail 1
-           | false => let v := Ss_to_add p (S 0) in
-                         fold v; natprering
-           end
-    end
-  | _ => change N.to_nat with protected_to_nat
-  end.
-
-Ltac natpostring :=
-  match goal with
-  | |- context [N.to_nat ?x] =>
-    let v := eval cbv in (N.to_nat x) in
-    change (N.to_nat x) with v;
-    natpostring
-  | _ => change protected_to_nat with N.to_nat
-  end.
-
-Add Ring natr : natSRth
-  (morphism nat_morph_N, constants [natcst],
-   preprocess [natprering], postprocess [natpostring]).
-
diff --git a/plugins/setoid_ring/BinList.v b/plugins/setoid_ring/BinList.v
deleted file mode 100644
index 958832274b..0000000000
--- a/plugins/setoid_ring/BinList.v
+++ /dev/null
@@ -1,82 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Import BinPos.
-Require Export List.
-Set Implicit Arguments.
-Local Open Scope positive_scope.
-
-Section MakeBinList.
- Variable A : Type.
- Variable default : A.
-
- Fixpoint jump (p:positive) (l:list A) {struct p} : list A :=
-  match p with
-  | xH => tl l
-  | xO p => jump p (jump p l)
-  | xI p  => jump p (jump p (tl l))
-  end.
-
- Fixpoint nth (p:positive) (l:list A) {struct p} : A:=
-  match p with
-  | xH => hd default l
-  | xO p => nth p (jump p l)
-  | xI p => nth p (jump p (tl l))
-  end.
-
- Lemma jump_tl : forall j l, tl (jump j l) = jump j (tl l).
- Proof.
-  induction j;simpl;intros; now rewrite ?IHj.
- Qed.
-
- Lemma jump_succ : forall j l,
-  jump (Pos.succ j) l = jump 1 (jump j l).
- Proof.
-  induction j;simpl;intros.
-  - rewrite !IHj; simpl; now rewrite !jump_tl.
-  - now rewrite !jump_tl.
-  - trivial.
- Qed.
-
- Lemma jump_add : forall i j l,
-  jump (i + j) l = jump i (jump j l).
- Proof.
-  induction i using Pos.peano_ind; intros.
-  - now rewrite Pos.add_1_l, jump_succ.
-  - now rewrite Pos.add_succ_l, !jump_succ, IHi.
- Qed.
-
- Lemma jump_pred_double : forall i l,
-  jump (Pos.pred_double i) (tl l) = jump i (jump i l).
- Proof.
-  induction i;intros;simpl.
-  - now rewrite !jump_tl.
-  - now rewrite IHi, <- 2 jump_tl, IHi.
-  - trivial.
- Qed.
-
- Lemma nth_jump : forall p l, nth p (tl l) = hd default (jump p l).
- Proof.
-  induction p;simpl;intros.
-  - now rewrite <-jump_tl, IHp.
-  - now rewrite <-jump_tl, IHp.
-  - trivial.
- Qed.
-
- Lemma nth_pred_double :
-  forall p l, nth (Pos.pred_double p) (tl l) = nth p (jump p l).
- Proof.
-  induction p;simpl;intros.
-  - now rewrite !jump_tl.
-  - now rewrite jump_pred_double, <- !jump_tl, IHp.
-  - trivial.
- Qed.
-
-End MakeBinList.
diff --git a/plugins/setoid_ring/Cring.v b/plugins/setoid_ring/Cring.v
deleted file mode 100644
index df0313a624..0000000000
--- a/plugins/setoid_ring/Cring.v
+++ /dev/null
@@ -1,275 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Export List.
-Require Import Setoid.
-Require Import BinPos.
-Require Import BinList.
-Require Import Znumtheory.
-Require Export Morphisms Setoid Bool.
-Require Import ZArith_base.
-Require Export Algebra_syntax.
-Require Export Ncring.
-Require Export Ncring_initial.
-Require Export Ncring_tac.
-Require Import InitialRing.
-
-Class Cring {R:Type}`{Rr:Ring R} := 
- cring_mul_comm: forall x y:R, x * y == y * x.
-
-
-Ltac reify_goal lvar lexpr lterm:=
-  (*idtac lvar; idtac lexpr; idtac lterm;*)
-  match lexpr with
-     nil => idtac
-   | ?e1::?e2::_ =>  
-        match goal with
-          |- (?op ?u1 ?u2) =>
-           change (op 
-             (@Ring_polynom.PEeval
-               _ zero one _+_ _*_ _-_ -_ Z Ncring_initial.gen_phiZ N (fun n:N => n)
-               (@Ring_theory.pow_N _ 1 multiplication) lvar e1)
-             (@Ring_polynom.PEeval
-               _ zero one _+_ _*_ _-_ -_ Z Ncring_initial.gen_phiZ N (fun n:N => n)
-               (@Ring_theory.pow_N _ 1 multiplication) lvar e2))
-        end
-  end.
-
-Section cring.
-Context {R:Type}`{Rr:Cring R}.
-
-Lemma cring_eq_ext: ring_eq_ext _+_ _*_ -_ _==_.
-Proof.
-intros. apply mk_reqe; solve_proper.
-Defined.
-
-Lemma cring_almost_ring_theory:
-   almost_ring_theory (R:=R) zero one _+_ _*_ _-_ -_ _==_.
-intros. apply mk_art ;intros. 
-rewrite ring_add_0_l; reflexivity. 
-rewrite ring_add_comm; reflexivity. 
-rewrite ring_add_assoc; reflexivity. 
-rewrite ring_mul_1_l; reflexivity. 
-apply ring_mul_0_l.
-rewrite cring_mul_comm; reflexivity. 
-rewrite ring_mul_assoc; reflexivity. 
-rewrite ring_distr_l; reflexivity. 
-rewrite ring_opp_mul_l; reflexivity. 
-apply ring_opp_add.
-rewrite ring_sub_def ; reflexivity. Defined.
-
-Lemma cring_morph:
-  ring_morph  zero one _+_ _*_ _-_ -_ _==_
-             0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool
-             Ncring_initial.gen_phiZ.
-intros. apply mkmorph ; intros; simpl; try reflexivity.
-rewrite Ncring_initial.gen_phiZ_add; reflexivity.
-rewrite ring_sub_def. unfold Z.sub. rewrite Ncring_initial.gen_phiZ_add.
-rewrite Ncring_initial.gen_phiZ_opp; reflexivity.
-rewrite Ncring_initial.gen_phiZ_mul; reflexivity.
-rewrite Ncring_initial.gen_phiZ_opp; reflexivity.
-rewrite (Zeqb_ok x y H). reflexivity. Defined.
-
-Lemma cring_power_theory : 
-  @Ring_theory.power_theory R one _*_ _==_ N (fun n:N => n)
-  (@Ring_theory.pow_N _  1 multiplication).
-intros; apply Ring_theory.mkpow_th. reflexivity. Defined.
-
-Lemma cring_div_theory: 
-  div_theory _==_ Z.add Z.mul Ncring_initial.gen_phiZ Z.quotrem.
-intros. apply InitialRing.Ztriv_div_th. unfold Setoid_Theory.
-simpl.   apply ring_setoid. Defined.
-
-End cring.
-
-Ltac cring_gen :=
-  match goal with
-    |- ?g => let lterm := lterm_goal g in
-        match eval red in (list_reifyl (lterm:=lterm)) with
-          | (?fv, ?lexpr) => 
-           (*idtac "variables:";idtac fv;
-           idtac "terms:"; idtac lterm;
-           idtac "reifications:"; idtac lexpr; *)
-           reify_goal fv lexpr lterm;
-           match goal with 
-             |- ?g => 
-               generalize
-                 (@Ring_polynom.ring_correct _ 0 1 _+_ _*_ _-_ -_ _==_
-                        ring_setoid
-                        cring_eq_ext
-                        cring_almost_ring_theory
-                        Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool
-                        Ncring_initial.gen_phiZ
-                        cring_morph
-                        N
-                        (fun n:N => n)
-                        (@Ring_theory.pow_N _  1 multiplication)
-                        cring_power_theory
-                        Z.quotrem
-                        cring_div_theory
-                        O fv nil);
-                 let rc := fresh "rc"in
-                   intro rc; apply rc
-           end
-        end
-  end.
-
-Ltac cring_compute:= vm_compute; reflexivity.
-
-Ltac cring:= 
-  intros;
-  cring_gen;
-  cring_compute.
-
-Instance Zcri: (Cring (Rr:=Zr)).
-red. exact Z.mul_comm. Defined.
-
-(* Cring_simplify *)
-
-Ltac cring_simplify_aux lterm fv lexpr hyp :=
-    match lterm with
-      | ?t0::?lterm =>
-    match lexpr with
-      | ?e::?le =>
-        let t := constr:(@Ring_polynom.norm_subst
-          Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool Z.quotrem O nil e) in
-        let te := 
-          constr:(@Ring_polynom.Pphi_dev
-            _ 0 1 _+_ _*_ _-_ -_ 
-            
-            Z 0%Z 1%Z Zeq_bool
-            Ncring_initial.gen_phiZ
-            get_signZ fv t) in
-        let eq1 := fresh "ring" in
-        let nft := eval vm_compute in t in
-        let t':= fresh "t" in
-        pose (t' := nft);
-        assert (eq1 : t = t');
-        [vm_cast_no_check (eq_refl t')|
-        let eq2 := fresh "ring" in
-        assert (eq2:(@Ring_polynom.PEeval
-          _ zero _+_ _*_ _-_ -_ Z Ncring_initial.gen_phiZ N (fun n:N => n)
-          (@Ring_theory.pow_N _ 1 multiplication) fv e) == te);
-        [let eq3 := fresh "ring" in
-          generalize (@ring_rw_correct _ 0 1 _+_ _*_ _-_ -_ _==_
-            ring_setoid
-            cring_eq_ext
-            cring_almost_ring_theory
-            Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool
-            Ncring_initial.gen_phiZ
-            cring_morph
-            N
-            (fun n:N => n)
-            (@Ring_theory.pow_N _ 1 multiplication)
-            cring_power_theory
-            Z.quotrem
-            cring_div_theory
-            get_signZ get_signZ_th
-            O nil fv I nil (eq_refl nil) );
-          intro eq3; apply eq3; reflexivity|
-              match hyp with
-                | 1%nat => rewrite eq2
-                | ?H => try rewrite eq2 in H
-              end];
-        let P:= fresh "P" in
-        match hyp with
-          | 1%nat => 
-            rewrite eq1;
-            pattern (@Ring_polynom.Pphi_dev
-            _ 0 1 _+_ _*_ _-_ -_ 
-            
-            Z 0%Z 1%Z Zeq_bool
-            Ncring_initial.gen_phiZ
-            get_signZ fv t');
-            match goal with
-              |- (?p ?t) => set (P:=p)
-            end;
-              unfold t' in *; clear t' eq1 eq2;
-              unfold Pphi_dev, Pphi_avoid; simpl;
-                repeat (unfold mkmult1, mkmultm1, mkmult_c_pos, mkmult_c,
-                  mkadd_mult, mkmult_c_pos, mkmult_pow, mkadd_mult,
-                  mkpow;simpl)
-          | ?H =>
-               rewrite eq1 in H;
-               pattern (@Ring_polynom.Pphi_dev
-            _ 0 1 _+_ _*_ _-_ -_ 
-            
-            Z 0%Z 1%Z Zeq_bool
-            Ncring_initial.gen_phiZ
-            get_signZ fv t') in H; 
-               match type of H with
-                  | (?p ?t)  => set (P:=p) in H
-               end;
-               unfold t' in *; clear t' eq1 eq2;
-               unfold Pphi_dev, Pphi_avoid in H; simpl in H;
-                repeat (unfold mkmult1, mkmultm1, mkmult_c_pos, mkmult_c,
-                  mkadd_mult, mkmult_c_pos, mkmult_pow, mkadd_mult,
-                  mkpow in H;simpl in H)
-        end; unfold P in *; clear P
-        ]; cring_simplify_aux lterm fv le hyp
-      | nil => idtac
-    end
-    | nil => idtac
-    end.
-
-Ltac set_variables fv :=
-  match fv with
-    | nil => idtac
-    | ?t::?fv =>
-        let v := fresh "X" in
-        set (v:=t) in *; set_variables fv
-  end.
-
-Ltac deset n:=
-   match n with
-    | 0%nat => idtac
-    | S ?n1 =>
-      match goal with
-        | h:= ?v : ?t |- ?g => unfold h in *; clear h; deset n1
-      end
-   end.
-
-(* a est soit un terme de l'anneau, soit une liste de termes.
-J'ai pas réussi à un décomposer les Vlists obtenues avec ne_constr_list
- dans Tactic Notation *)
-
-Ltac cring_simplify_gen a hyp :=
-  let lterm :=
-    match a with
-      | _::_ => a
-      | _ => constr:(a::nil)
-    end in
-    match eval red in (list_reifyl (lterm:=lterm)) with
-      | (?fv, ?lexpr) => idtac lterm; idtac fv; idtac lexpr;
-      let n := eval compute in (length fv) in
-      idtac n;
-      let lt:=fresh "lt" in
-      set (lt:= lterm);
-      let lv:=fresh "fv" in
-      set (lv:= fv);
-      (* les termes de fv sont remplacés par des variables 
-         pour pouvoir utiliser simpl ensuite sans risquer
-         des simplifications indésirables *)
-      set_variables fv;
-      let lterm1 := eval unfold lt in lt in
-      let lv1 := eval unfold lv in lv in
-        idtac lterm1; idtac lv1;
-      cring_simplify_aux lterm1 lv1 lexpr hyp;
-      clear lt lv;
-      (* on remet les termes de fv *)
-      deset n
-    end.
-
-Tactic Notation "cring_simplify" constr(lterm):=
- cring_simplify_gen lterm 1%nat.
-
-Tactic Notation "cring_simplify" constr(lterm) "in" ident(H):=
- cring_simplify_gen lterm H.
-
diff --git a/plugins/setoid_ring/Field.v b/plugins/setoid_ring/Field.v
deleted file mode 100644
index 9ff07948df..0000000000
--- a/plugins/setoid_ring/Field.v
+++ /dev/null
@@ -1,12 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Export Field_theory.
-Require Export Field_tac.
diff --git a/plugins/setoid_ring/Field_tac.v b/plugins/setoid_ring/Field_tac.v
deleted file mode 100644
index a5390efc7f..0000000000
--- a/plugins/setoid_ring/Field_tac.v
+++ /dev/null
@@ -1,584 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Import Ring_tac BinList Ring_polynom InitialRing.
-Require Export Field_theory.
-
- (* syntaxification *)
- (* We do not assume that Cst recognizes the rO and rI terms as constants, as *)
- (* the tactic could be used to discriminate occurrences of an opaque *)
- (* constant phi, with (phi 0) not convertible to 0 for instance *)
- Ltac mkFieldexpr C Cst CstPow rO rI radd rmul rsub ropp rdiv rinv rpow t fv :=
- let rec mkP t :=
-    let f :=
-    match Cst t with
-    | InitialRing.NotConstant =>
-        match t with
-        | rO => 
-          fun _ => constr:(@FEO C)
-        | rI => 
-          fun _ => constr:(@FEI C)
-        | (radd ?t1 ?t2) =>
-          fun _ =>
-          let e1 := mkP t1 in
-          let e2 := mkP t2 in constr:(@FEadd C e1 e2)
-        | (rmul ?t1 ?t2) =>
-          fun _ =>
-          let e1 := mkP t1 in
-          let e2 := mkP t2 in constr:(@FEmul C e1 e2)
-        | (rsub ?t1 ?t2) =>
-          fun _ =>
-          let e1 := mkP t1 in
-          let e2 := mkP t2 in constr:(@FEsub C e1 e2)
-        | (ropp ?t1) =>
-          fun _ => let e1 := mkP t1 in constr:(@FEopp C e1)
-        | (rdiv ?t1 ?t2) =>
-          fun _ =>
-          let e1 := mkP t1 in
-          let e2 := mkP t2 in constr:(@FEdiv C e1 e2)
-        | (rinv ?t1) =>
-          fun _ => let e1 := mkP t1 in constr:(@FEinv C e1)
-        | (rpow ?t1 ?n) =>
-          match CstPow n with
-          | InitialRing.NotConstant =>
-            fun _ =>
-            let p := Find_at t fv in
-            constr:(@FEX C p)
-          | ?c => fun _ => let e1 := mkP t1 in constr:(@FEpow C e1 c)
-          end
-        | _ =>
-          fun _ =>
-          let p := Find_at t fv in
-          constr:(@FEX C p)
-        end
-    | ?c => fun _ => constr:(@FEc C c)
-    end in
-    f ()
- in mkP t.
-
- (* We do not assume that Cst recognizes the rO and rI terms as constants, as *)
- (* the tactic could be used to discriminate occurrences of an opaque *)
- (* constant phi, with (phi 0) not convertible to 0 for instance *)
-Ltac FFV Cst CstPow rO rI add mul sub opp div inv pow t fv :=
- let rec TFV t fv :=
-  match Cst t with
-  | InitialRing.NotConstant =>
-      match t with
-      | rO => fv
-      | rI => fv
-      | (add ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
-      | (mul ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
-      | (sub ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
-      | (opp ?t1) => TFV t1 fv
-      | (div ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
-      | (inv ?t1) => TFV t1 fv
-      | (pow ?t1 ?n) =>
-        match CstPow n with
-        | InitialRing.NotConstant =>
-            AddFvTail t fv
-        | _ => TFV t1 fv
-        end
-      | _ => AddFvTail t fv
-      end
-  | _ => fv
-  end
- in TFV t fv.
-
-(* packaging the field structure *)
-
-(* TODO: inline PackField into field_lookup *)
-Ltac PackField F req Cst_tac Pow_tac L1 L2 L3 L4 cond_ok pre post :=
-  let FLD :=
-    match type of L1 with
-    | context [req (@FEeval ?R ?rO ?rI ?radd ?rmul ?rsub ?ropp ?rdiv ?rinv
-                                      ?C ?phi ?Cpow ?Cp_phi ?rpow _ _) _ ] =>
-        (fun proj =>
-           proj Cst_tac Pow_tac pre post
-             req rO rI radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok)
-    | _ => fail 1 "field anomaly: bad correctness lemma (parse)"
-    end in
-  F FLD.
-
-Ltac get_FldPre FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       pre).
-
-Ltac get_FldPost FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       post).
-
-Ltac get_L1 FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       L1).
-
-Ltac get_SimplifyEqLemma FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       L2).
-
-Ltac get_SimplifyLemma FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       L3).
-
-Ltac get_L4 FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       L4).
-
-Ltac get_CondLemma FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       cond_ok).
-
-Ltac get_FldEq FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       req).
-
-Ltac get_FldCarrier FLD :=
-  let req := get_FldEq FLD in
-  relation_carrier req.
-
-Ltac get_RingFV FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       FV Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rpow).
-
-Ltac get_FFV FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       FFV Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rdiv rinv rpow).
-
-Ltac get_RingMeta FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       mkPolexpr C Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rpow).
-
-Ltac get_Meta FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       mkFieldexpr C Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rdiv rinv rpow).
-
-Ltac get_Hyp_tac FLD :=
-  FLD ltac:
-      (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C
-           L1 L2 L3 L4 cond_ok =>
-       let mkPol := mkPolexpr C Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rpow in
-       fun fv lH => mkHyp_tac C req ltac:(fun t => mkPol t fv) lH).
-
-Ltac get_FEeval FLD :=
-  let L1 := get_L1 FLD in
-  match type of L1 with
-  | context
-    [(@FEeval
-      ?R ?r0 ?r1 ?add ?mul ?sub ?opp ?div ?inv ?C ?phi ?Cpow ?powphi ?pow _ _)] =>
-       constr:(@FEeval R r0 r1 add mul sub opp div inv C phi Cpow powphi pow)
-  | _ => fail 1 "field anomaly: bad correctness lemma (get_FEeval)"
-  end.
-
-(* simplifying the non-zero condition... *)
-
-Ltac fold_field_cond req :=
-  let rec fold_concl t :=
-    match t with
-      ?x /\ ?y =>
-        let fx := fold_concl x in let fy := fold_concl y in constr:(fx/\fy)
-    | req ?x ?y -> False => constr:(~ req x y)
-    | _ => t
-    end in
-  let ft := fold_concl Get_goal in
-  change ft.
-
-Ltac simpl_PCond FLD :=
-  let req := get_FldEq FLD in
-  let lemma := get_CondLemma FLD in
-  try (apply lemma; intros lock lock_def; vm_compute; rewrite lock_def; clear lock_def lock); 
-  protect_fv "field_cond";
-  fold_field_cond req;
-  try exact I.
-
-Ltac simpl_PCond_BEURK FLD :=
-  let req := get_FldEq FLD in
-  let lemma := get_CondLemma FLD in
-  (apply lemma; intros lock lock_def; vm_compute; rewrite lock_def; clear lock_def lock);
-  protect_fv "field_cond";
-  fold_field_cond req.
-
-(* Rewriting (field_simplify) *)
-Ltac Field_norm_gen f n FLD lH rl :=
-  let mkFV := get_RingFV FLD in
-  let mkFFV := get_FFV FLD in
-  let mkFE :=  get_Meta FLD in
-  let fv0 := FV_hypo_tac mkFV ltac:(get_FldEq FLD) lH in
-  let lemma_tac fv kont :=
-    let lemma := get_SimplifyLemma FLD in
-    (* reify equations of the context *)
-    let lpe := get_Hyp_tac FLD fv lH in
-    let vlpe := fresh "hyps" in
-    pose (vlpe := lpe);
-    let prh := proofHyp_tac lH in
-    (* compute the normal form of the reified hyps *)
-    let vlmp := fresh "hyps'" in
-    let vlmp_eq := fresh "hyps_eq" in
-    let mk_monpol := get_MonPol lemma in
-    compute_assertion vlmp_eq vlmp (mk_monpol vlpe);
-    (* partially instantiate the lemma *)
-    let lem := fresh "f_rw_lemma" in
-    (assert (lem := lemma n vlpe fv prh vlmp vlmp_eq)
-     || fail "type error when building the rewriting lemma");
-    (* continuation will call main_tac for all reified terms *)
-    kont lem;
-    (* at the end, cleanup *)
-    (clear lem vlmp_eq vlmp vlpe||idtac"Field_norm_gen:cleanup failed") in
-  (* each instance of the lemma is simplified then passed to f *)
-  let main_tac H := protect_fv "field" in H; f H in
-  (* generate and use equations for each expression *)
-  ReflexiveRewriteTactic mkFFV mkFE lemma_tac main_tac fv0 rl;
-  try simpl_PCond FLD.
-
-Ltac Field_simplify_gen f FLD lH rl :=
-  get_FldPre FLD ();
-  Field_norm_gen f ring_subst_niter FLD lH rl;
-  get_FldPost FLD ().
-
-Ltac Field_simplify :=
-  Field_simplify_gen ltac:(fun H => rewrite H).
-
-Tactic Notation (at level 0) "field_simplify" constr_list(rl) :=
-  let G := Get_goal in
-  field_lookup (PackField Field_simplify) [] rl G.
-
-Tactic Notation (at level 0)
-  "field_simplify" "[" constr_list(lH) "]" constr_list(rl) :=
-  let G := Get_goal in
-  field_lookup (PackField Field_simplify) [lH] rl G.
-
-Tactic Notation "field_simplify" constr_list(rl) "in" hyp(H):=
-  let G := Get_goal in
-  let t := type of H in
-  let g := fresh "goal" in
-  set (g:= G);
-  revert H;
-  field_lookup (PackField Field_simplify) [] rl t;
-  intro H;
-  unfold g;clear g.
-
-Tactic Notation "field_simplify"
-    "["constr_list(lH) "]" constr_list(rl) "in" hyp(H):=
-  let G := Get_goal in
-  let t := type of H in
-  let g := fresh "goal" in
-  set (g:= G);
-  revert H;
-  field_lookup (PackField Field_simplify) [lH] rl t;
-  intro H;
-  unfold g;clear g.
-
-(*
-Ltac Field_simplify_in hyp:=
-   Field_simplify_gen ltac:(fun H => rewrite H in hyp).
-
-Tactic Notation (at level 0)
-  "field_simplify" constr_list(rl) "in" hyp(h) :=
-  let t := type of h in
-  field_lookup (Field_simplify_in h) [] rl t.
-
-Tactic Notation (at level 0)
-  "field_simplify" "[" constr_list(lH) "]" constr_list(rl) "in" hyp(h) :=
-  let t := type of h in
-  field_lookup (Field_simplify_in h) [lH] rl t.
-*)
-
-(** Generic tactic for solving equations *)
-
-Ltac Field_Scheme Simpl_tac n lemma FLD lH :=
-  let req := get_FldEq FLD in
-  let mkFV := get_RingFV FLD in
-  let mkFFV := get_FFV FLD in
-  let mkFE := get_Meta FLD in
-  let Main_eq t1 t2 :=
-    let fv := FV_hypo_tac mkFV req lH in
-    let fv := mkFFV t1 fv in
-    let fv := mkFFV t2 fv in
-    let lpe := get_Hyp_tac FLD fv lH in
-    let prh := proofHyp_tac lH in
-    let vlpe := fresh "list_hyp" in
-    let fe1 := mkFE t1 fv in
-    let fe2 := mkFE t2 fv in
-    pose (vlpe := lpe);
-    let nlemma := fresh "field_lemma" in
-    (assert (nlemma := lemma n fv vlpe fe1 fe2 prh)
-     || fail "field anomaly:failed to build lemma");
-    ProveLemmaHyps nlemma
-      ltac:(fun ilemma =>
-              apply ilemma
-               || fail "field anomaly: failed in applying lemma";
-              [ Simpl_tac | simpl_PCond FLD]);
-    clear nlemma;
-    subst vlpe in
-  OnEquation req Main_eq.
-
-(* solve completely a field equation, leaving non-zero conditions to be
-   proved (field) *)
-
-Ltac FIELD FLD lH rl :=
-  let Simpl := vm_compute; reflexivity || fail "not a valid field equation" in
-  let lemma := get_L1 FLD in
-  get_FldPre FLD ();
-  Field_Scheme Simpl Ring_tac.ring_subst_niter lemma FLD lH;
-  try exact I;
-  get_FldPost FLD().
-
-Tactic Notation (at level 0) "field" :=
-  let G := Get_goal in
-  field_lookup (PackField FIELD) [] G.
-
-Tactic Notation (at level 0) "field" "[" constr_list(lH) "]" :=
-  let G := Get_goal in
-  field_lookup (PackField FIELD) [lH] G.
-
-(* transforms a field equation to an equivalent (simplified) ring equation,
-   and leaves non-zero conditions to be proved (field_simplify_eq) *)
-Ltac FIELD_SIMPL FLD lH rl :=
-  let Simpl := (protect_fv "field") in
-  let lemma := get_SimplifyEqLemma FLD in
-  get_FldPre FLD ();
-  Field_Scheme Simpl Ring_tac.ring_subst_niter lemma FLD lH;
-  get_FldPost FLD ().
-
-Tactic Notation (at level 0) "field_simplify_eq" :=
-  let G := Get_goal in
-  field_lookup (PackField FIELD_SIMPL) [] G.
-
-Tactic Notation (at level 0) "field_simplify_eq" "[" constr_list(lH) "]" :=
-  let G := Get_goal in
-  field_lookup (PackField FIELD_SIMPL) [lH] G.
-
-(* Same as FIELD_SIMPL but in hypothesis *)
-
-Ltac Field_simplify_eq n FLD lH :=
-  let req := get_FldEq FLD in
-  let mkFV := get_RingFV FLD in
-  let mkFFV := get_FFV FLD in
-  let mkFE := get_Meta FLD in
-  let lemma := get_L4 FLD in
-  let hyp := fresh "hyp" in
-  intro hyp;
-  OnEquationHyp req hyp ltac:(fun t1 t2 =>
-      let fv := FV_hypo_tac mkFV req lH in
-      let fv := mkFFV t1 fv in
-      let fv := mkFFV t2 fv in
-      let lpe := get_Hyp_tac FLD fv lH in
-      let prh := proofHyp_tac lH in
-      let fe1 := mkFE t1 fv in
-      let fe2 := mkFE t2 fv in
-      let vlpe := fresh "vlpe" in
-      ProveLemmaHyps (lemma n fv lpe fe1 fe2 prh)
-         ltac:(fun ilemma =>
-             match type of ilemma with
-             | req _ _ ->  _ -> ?EQ =>
-               let tmp := fresh "tmp" in
-               assert (tmp : EQ);
-               [ apply ilemma; [ exact hyp | simpl_PCond_BEURK FLD]
-               | protect_fv "field" in tmp; revert tmp ];
-               clear hyp
-             end)).
-
-Ltac FIELD_SIMPL_EQ FLD lH rl :=
-  get_FldPre FLD ();
-  Field_simplify_eq Ring_tac.ring_subst_niter FLD lH;
-  get_FldPost FLD ().
-
-Tactic Notation (at level 0) "field_simplify_eq" "in" hyp(H) :=
-  let t := type of H in
-  generalize H;
-  field_lookup (PackField FIELD_SIMPL_EQ) [] t;
-  [ try exact I
-  | clear H;intro H].
-
-
-Tactic Notation (at level 0)
-  "field_simplify_eq" "[" constr_list(lH) "]"  "in" hyp(H) :=
-  let t := type of H in
-  generalize H;
-  field_lookup (PackField FIELD_SIMPL_EQ) [lH] t;
-  [ try exact I
-  |clear H;intro H].
-
-(* More generic tactics to build variants of field *)
-
-(* This tactic reifies c and pass to F:
-   - the FLD structure gathering all info in the field DB
-   - the atom list
-   - the expression (FExpr)
- *)
-Ltac gen_with_field F c :=
-  let MetaExpr FLD _ rl :=
-    let R := get_FldCarrier FLD in
-    let mkFFV := get_FFV FLD in
-    let mkFE  := get_Meta FLD in
-    let csr :=
-      match rl with
-      | List.cons ?r _ => r
-      | _ => fail 1 "anomaly: ill-formed list"
-      end in
-    let fv := mkFFV csr (@List.nil R) in
-    let expr := mkFE csr fv in
-    F FLD fv expr in
-  field_lookup (PackField MetaExpr) [] (c=c).
-
-
-(* pushes the equation expr = ope(expr) in the goal, and
-   discharge it with field *)
-Ltac prove_field_eqn ope FLD fv expr :=
-  let res := ope expr in
-  let expr' := fresh "input_expr" in
-  pose (expr' := expr);
-  let res' := fresh "result" in
-  pose (res' := res);
-  let lemma := get_L1 FLD in
-  let lemma :=
-    constr:(lemma O fv List.nil expr' res' I List.nil (eq_refl _)) in
-  let ty := type of lemma in
-  let lhs := match ty with
-    forall _, ?lhs=_ -> _ => lhs
-    end in
-  let rhs := match ty with
-    forall _, _=_ -> forall _, ?rhs=_ -> _ => rhs
-    end in
-  let lhs' := fresh "lhs" in let lhs_eq := fresh "lhs_eq" in
-  let rhs' := fresh "rhs" in let rhs_eq := fresh "rhs_eq" in
-  compute_assertion lhs_eq lhs' lhs;
-  compute_assertion rhs_eq rhs' rhs;
-  let H := fresh "fld_eqn" in
-  refine (_ (lemma lhs' lhs_eq rhs' rhs_eq _ _));
-    (* main goal *)
-    [intro H;protect_fv "field" in H; revert H
-    (* ring-nf(lhs') = ring-nf(rhs') *)
-    | vm_compute; reflexivity || fail "field cannot prove this equality"
-    (* denominator condition *)
-    | simpl_PCond FLD];
-  clear lhs_eq rhs_eq; subst lhs' rhs'.
-
-Ltac prove_with_field ope c :=
-  gen_with_field ltac:(prove_field_eqn ope) c.
-
-(* Prove an equation x=ope(x) and rewrite with it *)
-Ltac prove_rw ope x :=
-  prove_with_field ope x;
-  [ let H := fresh "Heq_maple" in
-    intro H; rewrite H; clear H
-  |..].
-
-(* Apply ope (FExpr->FExpr) on an expression *)
-Ltac reduce_field_expr ope kont FLD fv expr :=
-  let evfun := get_FEeval FLD in
-  let res := ope expr in
-  let c := (eval simpl_field_expr in (evfun fv res)) in
-  kont c.
-
-(* Hack to let a Ltac return a term in the context of a primitive tactic *)
-Ltac return_term x := generalize (eq_refl x).
-Ltac get_term :=
-  match goal with
-  | |- ?x = _ -> _ => x
-  end.
-
-(* Turn an operation on field expressions (FExpr) into a reduction
-   on terms (in the field carrier). Because of field_lookup,
-   the tactic cannot return a term directly, so it is returned
-   via the conclusion of the goal (return_term). *)
-Ltac reduce_field_ope ope c :=
-  gen_with_field ltac:(reduce_field_expr ope return_term) c.
-
-
-(* Adding a new field *)
-
-Ltac ring_of_field f :=
-  match type of f with
-  | almost_field_theory _ _ _ _ _ _ _ _ _ => constr:(AF_AR f)
-  | field_theory _ _ _ _ _ _ _ _ _ => constr:(F_R f)
-  | semi_field_theory _ _ _ _ _ _ _ => constr:(SF_SR f)
-  end.
-
-Ltac coerce_to_almost_field set ext f :=
-  match type of f with
-  | almost_field_theory _ _ _ _ _ _ _ _ _ => f
-  | field_theory _ _ _ _ _ _ _ _ _ => constr:(F2AF set ext f)
-  | semi_field_theory _ _ _ _ _ _ _ => constr:(SF2AF set f)
-  end.
-
-Ltac field_elements set ext fspec pspec sspec dspec rk :=
-  let afth := coerce_to_almost_field set ext fspec in
-  let rspec := ring_of_field fspec in
-  ring_elements set ext rspec pspec sspec dspec rk
-  ltac:(fun arth ext_r morph p_spec s_spec d_spec f => f afth ext_r morph p_spec s_spec d_spec).
-
-Ltac field_lemmas set ext inv_m fspec pspec sspec dspec rk :=
-  let get_lemma :=
-    match pspec with None => fun x y => x | _ => fun x y => y end in
-  let simpl_eq_lemma := get_lemma
-       Field_simplify_eq_correct       Field_simplify_eq_pow_correct in
-  let simpl_eq_in_lemma := get_lemma
-       Field_simplify_eq_in_correct   Field_simplify_eq_pow_in_correct in
-  let rw_lemma := get_lemma
-       Field_rw_correct                    Field_rw_pow_correct in
-  field_elements set ext fspec pspec sspec dspec rk
-   ltac:(fun afth ext_r morph p_spec s_spec d_spec =>
-     match morph with
-     | _ =>
-       let field_ok1 := constr:(Field_correct set ext_r inv_m afth morph) in
-       match p_spec with
-       | mkhypo ?pp_spec =>
-         let field_ok2 := constr:(field_ok1 _ _ _ pp_spec) in
-         match s_spec with
-         | mkhypo ?ss_spec =>
-           match d_spec with
-           | mkhypo ?dd_spec =>
-             let field_ok := constr:(field_ok2 _ dd_spec) in
-             let mk_lemma lemma :=
-              constr:(lemma _ _ _  _ _ _  _ _ _ _
-                   set ext_r inv_m afth
-                   _ _ _  _ _ _  _ _ _ morph
-                   _ _ _ pp_spec _ ss_spec _ dd_spec) in
-             let field_simpl_eq_ok := mk_lemma simpl_eq_lemma  in
-             let field_simpl_ok := mk_lemma rw_lemma in
-             let field_simpl_eq_in := mk_lemma simpl_eq_in_lemma in
-             let cond1_ok :=
-                constr:(Pcond_simpl_gen set ext_r afth morph pp_spec dd_spec) in
-             let cond2_ok :=
-               constr:(Pcond_simpl_complete set ext_r afth morph pp_spec dd_spec) in
-             (fun f =>
-               f afth ext_r morph field_ok field_simpl_ok field_simpl_eq_ok field_simpl_eq_in
-                  cond1_ok cond2_ok)
-           | _ => fail 4 "field: bad coefficient division specification"
-           end
-         | _ => fail 3 "field: bad sign specification"
-         end
-       | _ => fail 2 "field: bad power specification"
-       end
-     | _ => fail 1 "field internal error : field_lemmas, please report"
-     end).
diff --git a/plugins/setoid_ring/Field_theory.v b/plugins/setoid_ring/Field_theory.v
deleted file mode 100644
index 3736bc47a5..0000000000
--- a/plugins/setoid_ring/Field_theory.v
+++ /dev/null
@@ -1,1819 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Ring.
-Import Ring_polynom Ring_tac Ring_theory InitialRing Setoid List Morphisms.
-Require Import ZArith_base.
-Set Implicit Arguments.
-(* Set Universe Polymorphism. *)
-
-Section MakeFieldPol.
-
-(* Field elements : R *)
-
-Variable R:Type.
-Declare Scope R_scope.
-Bind Scope R_scope with R.
-Delimit Scope R_scope with ring.
-Local Open Scope R_scope.
-
-Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R->R).
-Variable (rdiv : R->R->R) (rinv : R->R).
-Variable req : R -> R -> Prop.
-
-Notation "0" := rO : R_scope.
-Notation "1" := rI : R_scope.
-Infix "+" := radd : R_scope.
-Infix "-" := rsub : R_scope.
-Infix "*" := rmul : R_scope.
-Infix "/" := rdiv : R_scope.
-Notation "- x" := (ropp x) : R_scope.
-Notation "/ x" := (rinv x) : R_scope.
-Infix "==" := req (at level 70, no associativity) : R_scope.
-
-(* Equality properties *)
-Variable Rsth : Equivalence req.
-Variable Reqe : ring_eq_ext radd rmul ropp req.
-Variable SRinv_ext : forall p q, p == q ->  / p == / q.
-
-(* Field properties *)
-Record almost_field_theory : Prop := mk_afield {
- AF_AR : almost_ring_theory rO rI radd rmul rsub ropp req;
- AF_1_neq_0 : ~ 1 == 0;
- AFdiv_def : forall p q, p / q == p * / q;
- AFinv_l : forall p, ~ p == 0 ->  / p * p == 1
-}.
-
-Section AlmostField.
-
-Variable AFth : almost_field_theory.
-Let ARth := (AF_AR AFth).
-Let rI_neq_rO := (AF_1_neq_0 AFth).
-Let rdiv_def := (AFdiv_def AFth).
-Let rinv_l := (AFinv_l AFth).
-
-Add Morphism radd with signature (req ==> req ==> req) as radd_ext.
-Proof. exact (Radd_ext Reqe). Qed.
-Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext.
-Proof. exact (Rmul_ext Reqe). Qed.
-Add Morphism ropp with signature (req ==> req) as ropp_ext.
-Proof. exact (Ropp_ext Reqe). Qed.
-Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext.
-Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
-Add Morphism rinv with signature (req ==> req) as rinv_ext.
-Proof. exact SRinv_ext. Qed.
-
-Let eq_trans := Setoid.Seq_trans _ _ Rsth.
-Let eq_sym := Setoid.Seq_sym _ _ Rsth.
-Let eq_refl := Setoid.Seq_refl _ _ Rsth.
-
-Let radd_0_l := ARadd_0_l ARth.
-Let radd_comm := ARadd_comm ARth.
-Let radd_assoc := ARadd_assoc ARth.
-Let rmul_1_l := ARmul_1_l ARth.
-Let rmul_0_l := ARmul_0_l ARth.
-Let rmul_comm := ARmul_comm ARth.
-Let rmul_assoc := ARmul_assoc ARth.
-Let rdistr_l := ARdistr_l ARth.
-Let ropp_mul_l := ARopp_mul_l ARth.
-Let ropp_add := ARopp_add ARth.
-Let rsub_def := ARsub_def ARth.
-
-Let radd_0_r := ARadd_0_r Rsth ARth.
-Let rmul_0_r := ARmul_0_r Rsth ARth.
-Let rmul_1_r := ARmul_1_r Rsth ARth.
-Let ropp_0 := ARopp_zero Rsth Reqe ARth.
-Let rdistr_r := ARdistr_r Rsth Reqe ARth.
-
-(* Coefficients : C *)
-
-Variable C: Type.
-Declare Scope C_scope.
-Bind Scope C_scope with C.
-Delimit Scope C_scope with coef.
-
-Variable (cO cI: C) (cadd cmul csub : C->C->C) (copp : C->C).
-Variable ceqb : C->C->bool.
-Variable phi : C -> R.
-
-Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req
-                              cO cI cadd cmul csub copp ceqb phi.
-
-Notation "0" := cO : C_scope.
-Notation "1" := cI : C_scope.
-Infix "+" := cadd : C_scope.
-Infix "-" := csub : C_scope.
-Infix "*" := cmul : C_scope.
-Notation "- x" := (copp x) : C_scope.
-Infix "=?" := ceqb : C_scope.
-Notation "[ x ]" := (phi x) (at level 0).
-
-Let phi_0 := (morph0 CRmorph).
-Let phi_1 := (morph1 CRmorph).
-
-Lemma ceqb_spec c c' : BoolSpec ([c] == [c']) True (c =? c')%coef.
-Proof.
-generalize ((morph_eq CRmorph) c c').
-destruct (c =? c')%coef; auto.
-Qed.
-
-(* Power coefficients : Cpow *)
-
-Variable Cpow : Type.
-Variable Cp_phi : N -> Cpow.
-Variable rpow : R -> Cpow -> R.
-Variable pow_th : power_theory rI rmul req Cp_phi rpow.
-(* sign function *)
-Variable get_sign : C -> option C.
-Variable get_sign_spec : sign_theory copp ceqb get_sign.
-
-Variable cdiv:C -> C -> C*C.
-Variable cdiv_th : div_theory req cadd cmul phi cdiv.
-
-Let rpow_pow := (rpow_pow_N pow_th).
-
-(* Polynomial expressions : (PExpr C) *)
-
-Declare Scope PE_scope.
-Bind Scope PE_scope with PExpr.
-Delimit Scope PE_scope with poly.
-
-Notation NPEeval := (PEeval rO rI radd rmul rsub ropp phi Cp_phi rpow).
-Notation "P @ l" := (NPEeval l P) (at level 10, no associativity).
-
-Arguments PEc _ _%coef.
-
-Notation "0" := (PEc 0) : PE_scope.
-Notation "1" := (PEc 1) : PE_scope.
-Infix "+" := PEadd : PE_scope.
-Infix "-" := PEsub : PE_scope.
-Infix "*" := PEmul : PE_scope.
-Notation "- e" := (PEopp e) : PE_scope.
-Infix "^" := PEpow : PE_scope.
-
-Definition NPEequiv e e' := forall l, e@l == e'@l.
-Infix "===" := NPEequiv (at level 70, no associativity) : PE_scope.
-
-Instance NPEequiv_eq : Equivalence NPEequiv.
-Proof.
- split; red; unfold NPEequiv; intros; [reflexivity|symmetry|etransitivity];
-  eauto.
-Qed.
-
-Instance NPEeval_ext : Proper (eq ==> NPEequiv ==> req) NPEeval.
-Proof.
- intros l l' <- e e' He. now rewrite (He l).
-Qed.
-
-Notation Nnorm :=
-  (norm_subst cO cI cadd cmul csub copp ceqb cdiv).
-Notation NPphi_dev :=
-  (Pphi_dev rO rI radd rmul rsub ropp cO cI ceqb phi get_sign).
-Notation NPphi_pow :=
-  (Pphi_pow rO rI radd rmul rsub ropp cO cI ceqb phi Cp_phi rpow get_sign).
-
-(* add abstract semi-ring to help with some proofs *)
-Add Ring Rring : (ARth_SRth ARth).
-
-(* additional ring properties *)
-
-Lemma rsub_0_l r : 0 - r == - r.
-Proof.
-rewrite rsub_def; ring.
-Qed.
-
-Lemma rsub_0_r r : r - 0 == r.
-Proof.
-rewrite rsub_def, ropp_0; ring.
-Qed.
-
-(***************************************************************************
-
-                       Properties of division
-
-  ***************************************************************************)
-
-Theorem rdiv_simpl p q : ~ q == 0 ->  q * (p / q) == p.
-Proof.
-intros.
-rewrite rdiv_def.
-transitivity (/ q * q * p); [ ring | ].
-now rewrite rinv_l.
-Qed.
-
-Instance rdiv_ext: Proper (req ==> req ==> req) rdiv.
-Proof.
-intros p1 p2 Ep q1 q2 Eq. now rewrite !rdiv_def, Ep, Eq.
-Qed.
-
-Lemma rmul_reg_l p q1 q2 :
-  ~ p == 0 -> p * q1 == p * q2 -> q1 == q2.
-Proof.
-intros H EQ.
-assert (H' : p * (q1 / p) == p * (q2 / p)).
-{ now rewrite !rdiv_def, !rmul_assoc, EQ. }
-now rewrite !rdiv_simpl in H'.
-Qed.
-
-Theorem field_is_integral_domain r1 r2 :
-  ~ r1 == 0 -> ~ r2 == 0 -> ~ r1 * r2 == 0.
-Proof.
-intros H1 H2. contradict H2.
-transitivity (/r1 * r1 * r2).
-- now rewrite rinv_l.
-- now rewrite <- rmul_assoc, H2.
-Qed.
-
-Theorem ropp_neq_0 r :
-  ~ -(1) == 0 -> ~ r == 0 -> ~ -r == 0.
-Proof.
-intros.
-setoid_replace (- r) with (- (1) * r).
-- apply field_is_integral_domain; trivial.
-- now rewrite <- ropp_mul_l, rmul_1_l.
-Qed.
-
-Theorem rdiv_r_r r : ~ r == 0 -> r / r == 1.
-Proof.
-intros. rewrite rdiv_def, rmul_comm. now apply rinv_l.
-Qed.
-
-Theorem rdiv1 r : r == r / 1.
-Proof.
-transitivity (1 * (r / 1)).
-- symmetry; apply rdiv_simpl. apply rI_neq_rO.
-- apply rmul_1_l.
-Qed.
-
-Theorem rdiv2 a b c d :
- ~ b == 0 ->
- ~ d == 0 ->
- a / b + c / d == (a * d + c * b) / (b * d).
-Proof.
-intros H H0.
-assert (~ b * d == 0) by now apply field_is_integral_domain.
-apply rmul_reg_l with (b * d); trivial.
-rewrite rdiv_simpl; trivial.
-rewrite rdistr_r.
-apply radd_ext.
-- now rewrite <- rmul_assoc, (rmul_comm d), rmul_assoc, rdiv_simpl.
-- now rewrite (rmul_comm c), <- rmul_assoc, rdiv_simpl.
-Qed.
-
-
-Theorem rdiv2b a b c d e :
- ~ (b*e) == 0 ->
- ~ (d*e) == 0 ->
- a / (b*e) + c / (d*e) == (a * d + c * b) / (b * (d * e)).
-Proof.
-intros H H0.
-assert (~ b == 0) by (contradict H; rewrite H; ring).
-assert (~ e == 0) by (contradict H; rewrite H; ring).
-assert (~ d == 0) by (contradict H0; rewrite H0; ring).
-assert (~ b * (d * e) == 0)
-   by (repeat apply field_is_integral_domain; trivial).
-apply rmul_reg_l with (b * (d * e)); trivial.
-rewrite rdiv_simpl; trivial.
-rewrite rdistr_r.
-apply radd_ext.
-- transitivity ((b * e) * (a / (b * e)) * d);
-  [ ring | now rewrite rdiv_simpl ].
-- transitivity ((d * e) * (c / (d * e)) * b);
-  [ ring | now rewrite rdiv_simpl ].
-Qed.
-
-Theorem rdiv5 a b : - (a / b) == - a / b.
-Proof.
-now rewrite !rdiv_def, ropp_mul_l.
-Qed.
-
-Theorem rdiv3b a b c d e :
- ~ (b * e) == 0 ->
- ~ (d * e) == 0 ->
- a / (b*e) - c / (d*e) == (a * d - c * b) / (b * (d * e)).
-Proof.
-intros H H0.
-rewrite !rsub_def, rdiv5, ropp_mul_l.
-now apply rdiv2b.
-Qed.
-
-Theorem rdiv6 a b :
- ~ a == 0 -> ~ b == 0 ->  / (a / b) == b / a.
-Proof.
-intros H H0.
-assert (Hk : ~ a / b == 0).
-{ contradict H.
-  transitivity (b * (a / b)).
-  - now rewrite rdiv_simpl.
-  - rewrite H. apply rmul_0_r. }
-apply rmul_reg_l with (a / b); trivial.
-rewrite (rmul_comm (a / b)), rinv_l; trivial.
-rewrite !rdiv_def.
-transitivity (/ a * a * (/ b * b)); [ | ring ].
-now rewrite !rinv_l, rmul_1_l.
-Qed.
-
-Theorem rdiv4 a b c d :
- ~ b == 0 ->
- ~ d == 0 ->
- (a / b) * (c / d) == (a * c) / (b * d).
-Proof.
-intros H H0.
-assert (~ b * d == 0) by now apply field_is_integral_domain.
-apply rmul_reg_l with (b * d); trivial.
-rewrite rdiv_simpl; trivial.
-transitivity (b * (a / b) * (d * (c / d))); [ ring | ].
-rewrite !rdiv_simpl; trivial.
-Qed.
-
-Theorem rdiv4b a b c d e f :
- ~ b * e == 0 ->
- ~ d * f == 0 ->
- ((a * f) / (b * e)) * ((c * e) / (d * f)) == (a * c) / (b * d).
-Proof.
-intros H H0.
-assert (~ b == 0) by (contradict H; rewrite H; ring).
-assert (~ e == 0) by (contradict H; rewrite H; ring).
-assert (~ d == 0) by (contradict H0; rewrite H0; ring).
-assert (~ f == 0) by (contradict H0; rewrite H0; ring).
-assert (~ b*d == 0) by now apply field_is_integral_domain.
-assert (~ e*f == 0) by now apply field_is_integral_domain.
-rewrite rdiv4; trivial.
-transitivity ((e * f) * (a * c) / ((e * f) * (b * d))).
-- apply rdiv_ext; ring.
-- rewrite <- rdiv4, rdiv_r_r; trivial.
-Qed.
-
-Theorem rdiv7 a b c d :
- ~ b == 0 ->
- ~ c == 0 ->
- ~ d == 0 ->
- (a / b) / (c / d) == (a * d) / (b * c).
-Proof.
-intros.
-rewrite (rdiv_def (a / b)).
-rewrite rdiv6; trivial.
-apply rdiv4; trivial.
-Qed.
-
-Theorem rdiv7b a b c d e f :
- ~ b * f == 0 ->
- ~ c * e == 0 ->
- ~ d * f == 0 ->
- ((a * e) / (b * f)) / ((c * e) / (d * f)) == (a * d) / (b * c).
-Proof.
-intros Hbf Hce Hdf.
-assert (~ c==0) by (contradict Hce; rewrite Hce; ring).
-assert (~ e==0) by (contradict Hce; rewrite Hce; ring).
-assert (~ b==0) by (contradict Hbf; rewrite Hbf; ring).
-assert (~ f==0) by (contradict Hbf; rewrite Hbf; ring).
-assert (~ b*c==0) by now apply field_is_integral_domain.
-assert (~ e*f==0) by now apply field_is_integral_domain.
-rewrite rdiv7; trivial.
-transitivity ((e * f) * (a * d) / ((e * f) * (b * c))).
-- apply rdiv_ext; ring.
-- now rewrite <- rdiv4, rdiv_r_r.
-Qed.
-
-Theorem rinv_nz a : ~ a == 0 -> ~ /a == 0.
-Proof.
-intros H H0. apply rI_neq_rO.
-rewrite <- (rdiv_r_r H), rdiv_def, H0. apply rmul_0_r.
-Qed.
-
-Theorem rdiv8 a b : ~ b == 0 -> a == 0 ->  a / b == 0.
-Proof.
-intros H H0.
-now rewrite rdiv_def, H0, rmul_0_l.
-Qed.
-
-Theorem cross_product_eq a b c d :
-  ~ b == 0 -> ~ d == 0 -> a * d == c * b -> a / b == c / d.
-Proof.
-intros.
-transitivity (a / b * (d / d)).
-- now rewrite rdiv_r_r, rmul_1_r.
-- now rewrite rdiv4, H1, (rmul_comm b d), <- rdiv4, rdiv_r_r.
-Qed.
-
-(* Results about [pow_pos] and [pow_N] *)
-
-Instance pow_ext : Proper (req ==> eq ==> req) (pow_pos rmul).
-Proof.
-intros x y H p p' <-.
-induction p as [p IH| p IH|];simpl; trivial; now rewrite !IH, ?H.
-Qed.
-
-Instance pow_N_ext : Proper (req ==> eq ==> req) (pow_N rI rmul).
-Proof.
-intros x y H n n' <-. destruct n; simpl; trivial. now apply pow_ext.
-Qed.
-
-Lemma pow_pos_0 p : pow_pos rmul 0 p == 0.
-Proof.
-induction p;simpl;trivial; now rewrite !IHp.
-Qed.
-
-Lemma pow_pos_1 p : pow_pos rmul 1 p == 1.
-Proof.
-induction p;simpl;trivial; ring [IHp].
-Qed.
-
-Lemma pow_pos_cst c p : pow_pos rmul [c] p == [pow_pos cmul c p].
-Proof.
-induction p;simpl;trivial; now rewrite !(morph_mul CRmorph), !IHp.
-Qed.
-
-Lemma pow_pos_mul_l x y p :
- pow_pos rmul (x * y) p == pow_pos rmul x p * pow_pos rmul y p.
-Proof.
-induction p;simpl;trivial; ring [IHp].
-Qed.
-
-Lemma pow_pos_add_r x p1 p2 :
- pow_pos rmul x (p1+p2) == pow_pos rmul x p1 * pow_pos rmul x p2.
-Proof.
- exact (Ring_theory.pow_pos_add Rsth rmul_ext rmul_assoc x p1 p2).
-Qed.
-
-Lemma pow_pos_mul_r x p1 p2 :
-  pow_pos rmul x (p1*p2) == pow_pos rmul (pow_pos rmul x p1) p2.
-Proof.
-induction p1;simpl;intros; rewrite ?pow_pos_mul_l, ?pow_pos_add_r;
- simpl; trivial; ring [IHp1].
-Qed.
-
-Lemma pow_pos_nz x p : ~x==0 -> ~pow_pos rmul x p == 0.
-Proof.
- intros Hx. induction p;simpl;trivial;
-  repeat (apply field_is_integral_domain; trivial).
-Qed.
-
-Lemma pow_pos_div a b p : ~ b == 0 ->
- pow_pos rmul (a / b) p == pow_pos rmul a p / pow_pos rmul b p.
-Proof.
- intros.
- induction p; simpl; trivial.
- - rewrite IHp.
-   assert (nz := pow_pos_nz p H).
-   rewrite !rdiv4; trivial.
-   apply field_is_integral_domain; trivial.
- - rewrite IHp.
-   assert (nz := pow_pos_nz p H).
-   rewrite !rdiv4; trivial.
-Qed.
-
-(* === is a morphism *)
-
-Instance PEadd_ext : Proper (NPEequiv ==> NPEequiv ==> NPEequiv) (@PEadd C).
-Proof. intros ? ? E ? ? E' l. simpl. now rewrite E, E'. Qed.
-Instance PEsub_ext : Proper (NPEequiv ==> NPEequiv ==> NPEequiv) (@PEsub C).
-Proof. intros ? ? E ? ? E' l. simpl. now rewrite E, E'. Qed.
-Instance PEmul_ext : Proper (NPEequiv ==> NPEequiv ==> NPEequiv) (@PEmul C).
-Proof. intros ? ? E ? ? E' l. simpl. now rewrite E, E'. Qed.
-Instance PEopp_ext : Proper (NPEequiv ==> NPEequiv) (@PEopp C).
-Proof. intros ? ? E l. simpl. now rewrite E. Qed.
-Instance PEpow_ext : Proper (NPEequiv ==> eq ==> NPEequiv) (@PEpow C).
-Proof.
- intros ? ? E ? ? <- l. simpl. rewrite !rpow_pow. apply pow_N_ext; trivial.
-Qed.
-
-Lemma PE_1_l (e : PExpr C) : (1 * e === e)%poly.
-Proof.
- intros l. simpl. rewrite phi_1. apply rmul_1_l.
-Qed.
-
-Lemma PE_1_r (e : PExpr C) : (e * 1 === e)%poly.
-Proof.
- intros l. simpl. rewrite phi_1. apply rmul_1_r.
-Qed.
-
-Lemma PEpow_0_r (e : PExpr C) : (e ^ 0 === 1)%poly.
-Proof.
- intros l. simpl. now rewrite !rpow_pow.
-Qed.
-
-Lemma PEpow_1_r (e : PExpr C) : (e ^ 1 === e)%poly.
-Proof.
- intros l. simpl. now rewrite !rpow_pow.
-Qed.
-
-Lemma PEpow_1_l n : (1 ^ n === 1)%poly.
-Proof.
- intros l. simpl. rewrite rpow_pow. destruct n; simpl.
- - now rewrite phi_1.
- - now rewrite phi_1, pow_pos_1.
-Qed.
-
-Lemma PEpow_add_r (e : PExpr C) n n' :
- (e ^ (n+n') === e ^ n * e ^ n')%poly.
-Proof.
- intros l. simpl. rewrite !rpow_pow.
- destruct n; simpl.
- - rewrite rmul_1_l. trivial.
- - destruct n'; simpl.
-   + rewrite rmul_1_r. trivial.
-   + apply pow_pos_add_r.
-Qed.
-
-Lemma PEpow_mul_l (e e' : PExpr C) n :
- ((e * e') ^ n === e ^ n * e' ^ n)%poly.
-Proof.
- intros l. simpl. rewrite !rpow_pow. destruct n; simpl; trivial.
- - symmetry; apply rmul_1_l.
- - apply pow_pos_mul_l.
-Qed.
-
-Lemma PEpow_mul_r (e : PExpr C) n n' :
- (e ^ (n * n') === (e ^ n) ^ n')%poly.
-Proof.
- intros l. simpl. rewrite !rpow_pow.
- destruct n, n'; simpl; trivial.
- - now rewrite pow_pos_1.
- - apply pow_pos_mul_r.
-Qed.
-
-Lemma PEpow_nz l e n : ~ e @ l == 0 -> ~ (e^n) @ l == 0.
-Proof.
- intros. simpl. rewrite rpow_pow. destruct n; simpl.
- - apply rI_neq_rO.
- - now apply pow_pos_nz.
-Qed.
-
-
-(***************************************************************************
-
-                       Some equality test
-
-  ***************************************************************************)
-
-Local Notation "a &&& b" := (if a then b else false)
- (at level 40, left associativity).
-
-(* equality test *)
-Fixpoint PExpr_eq (e e' : PExpr C) {struct e} : bool :=
- match e, e' with
-  | PEc c, PEc c' => ceqb c c'
-  | PEX _ p, PEX _ p' => Pos.eqb p p'
-  | e1 + e2, e1' + e2' => PExpr_eq e1 e1' &&& PExpr_eq e2 e2'
-  | e1 - e2, e1' - e2' => PExpr_eq e1 e1' &&& PExpr_eq e2 e2'
-  | e1 * e2, e1' * e2' => PExpr_eq e1 e1' &&& PExpr_eq e2 e2'
-  | - e, - e' => PExpr_eq e e'
-  | e ^ n, e' ^ n' => N.eqb n n' &&& PExpr_eq e e'
-  | _, _ => false
- end%poly.
-
-Lemma if_true (a b : bool) : a &&& b = true -> a = true /\ b = true.
-Proof.
- destruct a, b; split; trivial.
-Qed.
-
-Theorem PExpr_eq_semi_ok e e' :
- PExpr_eq e e' = true ->  (e === e')%poly.
-Proof.
-revert e'; induction e; destruct e'; simpl; try discriminate.
-- intros H l. now apply (morph_eq CRmorph).
-- case Pos.eqb_spec; intros; now subst.
-- intros H; destruct (if_true _ _ H). now rewrite IHe1, IHe2.
-- intros H; destruct (if_true _ _ H). now rewrite IHe1, IHe2.
-- intros H; destruct (if_true _ _ H). now rewrite IHe1, IHe2.
-- intros H. now rewrite IHe.
-- intros H. destruct (if_true _ _ H).
-  apply N.eqb_eq in H0. now rewrite IHe, H0.
-Qed.
-
-Lemma PExpr_eq_spec e e' : BoolSpec (e === e')%poly True (PExpr_eq e e').
-Proof.
- assert (H := PExpr_eq_semi_ok e e').
- destruct PExpr_eq; constructor; intros; trivial. now apply H.
-Qed.
-
-(** Smart constructors for polynomial expression,
-    with reduction of constants *)
-
-Definition NPEadd e1 e2 :=
-  match e1, e2 with
-  | PEc c1, PEc c2 => PEc (c1 + c2)
-  | PEc c, _ => if (c =? 0)%coef then e2 else e1 + e2
-  |  _, PEc c => if (c =? 0)%coef then e1 else e1 + e2
-    (* Peut t'on factoriser ici ??? *)
-  | _, _ => (e1 + e2)
-  end%poly.
-Infix "++" := NPEadd (at level 60, right associativity).
-
-Theorem NPEadd_ok e1 e2 : (e1 ++ e2 === e1 + e2)%poly.
-Proof.
-intros l.
-destruct e1, e2; simpl; try reflexivity; try (case ceqb_spec);
-try intro H; try rewrite H; simpl;
-try apply eq_refl; try (ring [phi_0]).
-apply (morph_add CRmorph).
-Qed.
-
-Definition NPEsub e1 e2 :=
-  match e1, e2 with
-  | PEc c1, PEc c2 => PEc (c1 - c2)
-  | PEc c, _ => if (c =? 0)%coef then - e2 else e1 - e2
-  |  _, PEc c => if (c =? 0)%coef then e1 else e1 - e2
-     (* Peut-on factoriser ici *)
-  | _, _ => e1 - e2
-  end%poly.
-Infix "--" := NPEsub (at level 50, left associativity).
-
-Theorem NPEsub_ok e1 e2: (e1 -- e2 === e1 - e2)%poly.
-Proof.
-intros l.
-destruct e1, e2; simpl; try reflexivity; try case ceqb_spec;
- try intro H; try rewrite H; simpl;
- try rewrite phi_0; try reflexivity;
- try (symmetry; apply rsub_0_l); try (symmetry; apply rsub_0_r).
-apply (morph_sub CRmorph).
-Qed.
-
-Definition NPEopp e1 :=
-  match e1 with PEc c1 => PEc (- c1) | _ => - e1 end%poly.
-
-Theorem NPEopp_ok e : (NPEopp e === -e)%poly.
-Proof.
-intros l. destruct e; simpl; trivial. apply (morph_opp CRmorph).
-Qed.
-
-Definition NPEpow x n :=
-  match n with
-  | N0 => 1
-  | Npos p =>
-    if (p =? 1)%positive then x else
-    match x with
-    | PEc c =>
-      if (c =? 1)%coef then 1
-      else if (c =? 0)%coef then 0
-      else PEc (pow_pos cmul c p)
-    | _ => x ^ n
-    end
-  end%poly.
-Infix "^^" := NPEpow (at level 35, right associativity).
-
-Theorem NPEpow_ok e n : (e ^^ n === e ^ n)%poly.
-Proof.
- intros l. unfold NPEpow; destruct n.
- - simpl; now rewrite rpow_pow.
- - case Pos.eqb_spec; [intro; subst | intros _].
-   + simpl. now rewrite rpow_pow.
-   + destruct e;simpl;trivial.
-     repeat case ceqb_spec; intros; rewrite ?rpow_pow, ?H; simpl.
-     * now rewrite phi_1, pow_pos_1.
-     * now rewrite phi_0, pow_pos_0.
-     * now rewrite pow_pos_cst.
-Qed.
-
-Fixpoint NPEmul (x y : PExpr C) {struct x} : PExpr C :=
-  match x, y with
-  | PEc c1, PEc c2 => PEc (c1 * c2)
-  | PEc c, _ => if (c =? 1)%coef then y else if (c =? 0)%coef then 0 else x * y
-  | _, PEc c => if (c =? 1)%coef then x else if (c =? 0)%coef then 0 else x * y
-  | e1 ^ n1, e2 ^ n2 => if (n1 =? n2)%N then (NPEmul e1 e2)^^n1 else x * y
-  | _, _ => x * y
-  end%poly.
-Infix "**" := NPEmul (at level 40, left associativity).
-
-Theorem NPEmul_ok e1 e2 : (e1 ** e2 === e1 * e2)%poly.
-Proof.
-intros l.
-revert e2; induction e1;destruct e2; simpl;try reflexivity;
- repeat (case ceqb_spec; intro H; try rewrite H; clear H);
- simpl; try reflexivity; try ring [phi_0 phi_1].
- apply (morph_mul CRmorph).
-case N.eqb_spec; [intros <- | reflexivity].
-rewrite NPEpow_ok. simpl.
-rewrite !rpow_pow. rewrite IHe1.
-destruct n; simpl; [ ring | apply pow_pos_mul_l ].
-Qed.
-
-(* simplification *)
-Fixpoint PEsimp (e : PExpr C) : PExpr C :=
- match e with
-  | e1 + e2 => (PEsimp e1) ++ (PEsimp e2)
-  | e1 * e2 => (PEsimp e1) ** (PEsimp e2)
-  | e1 - e2 => (PEsimp e1) -- (PEsimp e2)
-  | - e1 => NPEopp (PEsimp e1)
-  | e1 ^ n1 => (PEsimp e1) ^^ n1
-  | _ => e
- end%poly.
-
-Theorem PEsimp_ok e : (PEsimp e === e)%poly.
-Proof.
-induction e; simpl.
-- reflexivity.
-- reflexivity.
-- intro l; trivial.
-- intro l; trivial.
-- rewrite NPEadd_ok. now f_equiv.
-- rewrite NPEsub_ok. now f_equiv.
-- rewrite NPEmul_ok. now f_equiv.
-- rewrite NPEopp_ok. now f_equiv.
-- rewrite NPEpow_ok. now f_equiv.
-Qed.
-
-
-(****************************************************************************
-
-                               Datastructure
-
-  ***************************************************************************)
-
-(* The input: syntax of a field expression *)
-
-Inductive FExpr : Type :=
- | FEO : FExpr
- | FEI : FExpr
- | FEc: C ->  FExpr
- | FEX: positive ->  FExpr
- | FEadd: FExpr -> FExpr ->  FExpr
- | FEsub: FExpr -> FExpr ->  FExpr
- | FEmul: FExpr -> FExpr ->  FExpr
- | FEopp: FExpr ->  FExpr
- | FEinv: FExpr ->  FExpr
- | FEdiv: FExpr -> FExpr ->  FExpr
- | FEpow: FExpr -> N -> FExpr .
-
-Fixpoint FEeval (l : list R) (pe : FExpr) {struct pe} : R :=
-  match pe with
-  | FEO       => rO
-  | FEI       => rI
-  | FEc c     => phi c
-  | FEX x     => BinList.nth 0 x l
-  | FEadd x y => FEeval l x + FEeval l y
-  | FEsub x y => FEeval l x - FEeval l y
-  | FEmul x y => FEeval l x * FEeval l y
-  | FEopp x   => - FEeval l x
-  | FEinv x   => / FEeval l x
-  | FEdiv x y => FEeval l x / FEeval l y
-  | FEpow x n => rpow (FEeval l x) (Cp_phi n)
-  end.
-
-Strategy expand [FEeval].
-
-(* The result of the normalisation *)
-
-Record linear : Type := mk_linear {
-   num : PExpr C;
-   denum : PExpr C;
-   condition : list (PExpr C) }.
-
-(***************************************************************************
-
-                Semantics and properties of side condition
-
-  ***************************************************************************)
-
-Fixpoint PCond (l : list R) (le : list (PExpr C)) {struct le} : Prop :=
-  match le with
-  | nil => True
-  | e1 :: nil => ~ req (e1 @ l) rO
-  | e1 :: l1 => ~ req (e1 @ l) rO /\ PCond l l1
-  end.
-
-Theorem PCond_cons l a l1 :
- PCond l (a :: l1) <-> ~ a @ l == 0 /\ PCond l l1.
-Proof.
-destruct l1.
-- simpl. split; [split|destruct 1]; trivial.
-- reflexivity.
-Qed.
-
-Theorem PCond_cons_inv_l l a l1 : PCond l (a::l1) ->  ~ a @ l == 0.
-Proof.
-rewrite PCond_cons. now destruct 1.
-Qed.
-
-Theorem PCond_cons_inv_r l a l1 : PCond l (a :: l1) ->  PCond l l1.
-Proof.
-rewrite PCond_cons. now destruct 1.
-Qed.
-
-Theorem PCond_app l l1 l2 :
- PCond l (l1 ++ l2) <-> PCond l l1 /\ PCond l l2.
-Proof.
-induction l1.
-- simpl. split; [split|destruct 1]; trivial.
-- simpl app. rewrite !PCond_cons, IHl1. symmetry; apply and_assoc.
-Qed.
-
-
-(* An unsatisfiable condition: issued when a division by zero is detected *)
-Definition absurd_PCond := cons 0%poly nil.
-
-Lemma absurd_PCond_bottom : forall l, ~ PCond l absurd_PCond.
-Proof.
-unfold absurd_PCond; simpl.
-red; intros.
-apply H.
-apply phi_0.
-Qed.
-
-(***************************************************************************
-
-                               Normalisation
-
-  ***************************************************************************)
-
-Definition default_isIn e1 p1 e2 p2 :=
-  if PExpr_eq e1 e2 then
-    match Z.pos_sub p1 p2 with
-     | Zpos p => Some (Npos p, 1%poly)
-     | Z0 => Some (N0, 1%poly)
-     | Zneg p => Some (N0, e2 ^^ Npos p)
-    end
-  else None.
-
-Fixpoint isIn e1 p1 e2 p2 {struct e2}: option (N * PExpr C) :=
-  match e2 with
-  | e3 * e4 =>
-       match isIn e1 p1 e3 p2 with
-       | Some (N0, e5) => Some (N0, e5 ** (e4 ^^ Npos p2))
-       | Some (Npos p, e5) =>
-          match isIn e1 p e4 p2 with
-          | Some (n, e6) => Some (n, e5 ** e6)
-          | None => Some (Npos p, e5 ** (e4 ^^ Npos p2))
-          end
-       | None =>
-         match isIn e1 p1 e4 p2 with
-         | Some (n, e5) => Some (n, (e3 ^^ Npos p2) ** e5)
-         | None => None
-         end
-       end
-  | e3 ^ N0 => None
-  | e3 ^ Npos p3 => isIn e1 p1 e3 (Pos.mul p3 p2)
-  | _ => default_isIn e1 p1 e2 p2
-   end%poly.
-
- Definition ZtoN z := match z with Zpos p => Npos p | _ => N0 end.
- Definition NtoZ n := match n with Npos p => Zpos p | _ => Z0 end.
-
- Lemma Z_pos_sub_gt p q : (p > q)%positive ->
-  Z.pos_sub p q = Zpos (p - q).
- Proof. intros; now apply Z.pos_sub_gt, Pos.gt_lt. Qed.
-
- Ltac simpl_pos_sub := rewrite ?Z_pos_sub_gt in * by assumption.
-
- Lemma default_isIn_ok e1 e2 p1 p2 :
-  match default_isIn e1 p1 e2 p2 with
-   | Some(n, e3) =>
-       let n' := ZtoN (Zpos p1 - NtoZ n) in
-       (e2 ^ N.pos p2 === e1 ^ n' * e3)%poly
-       /\ (Zpos p1 > NtoZ n)%Z
-   | _ => True
-  end.
-Proof.
-  unfold default_isIn.
-  case PExpr_eq_spec; trivial. intros EQ.
-  rewrite Z.pos_sub_spec.
-  case Pos.compare_spec;intros H; split; try reflexivity.
-  - simpl. now rewrite PE_1_r, H, EQ.
-  - rewrite NPEpow_ok, EQ, <- PEpow_add_r. f_equiv.
-    simpl. f_equiv. now rewrite Pos.add_comm, Pos.sub_add.
-  - simpl. rewrite PE_1_r, EQ. f_equiv.
-    rewrite Z.pos_sub_gt by now apply Pos.sub_decr. simpl. f_equiv.
-    rewrite Pos.sub_sub_distr, Pos.add_comm; trivial.
-    rewrite Pos.add_sub; trivial.
-    apply Pos.sub_decr; trivial.
-  - simpl. now apply Z.lt_gt, Pos.sub_decr.
-Qed.
-
-Ltac npe_simpl := rewrite ?NPEmul_ok, ?NPEpow_ok, ?PEpow_mul_l.
-Ltac npe_ring := intro l; simpl; ring.
-
-Theorem isIn_ok e1 p1 e2 p2 :
-  match isIn e1 p1 e2 p2 with
-   | Some(n, e3) =>
-       let n' := ZtoN (Zpos p1 - NtoZ n) in
-       (e2 ^ N.pos p2 === e1 ^ n' * e3)%poly
-       /\ (Zpos p1 > NtoZ n)%Z
-   |  _ => True
-  end.
-Proof.
-Opaque NPEpow.
-revert p1 p2.
-induction e2; intros p1 p2;
- try refine (default_isIn_ok e1 _ p1 p2); simpl isIn.
-- specialize (IHe2_1 p1 p2).
-  destruct isIn as [([|p],e)|].
-  + split; [|reflexivity].
-    clear IHe2_2.
-    destruct IHe2_1 as (IH,_).
-    npe_simpl. rewrite IH. npe_ring.
-  + specialize (IHe2_2 p p2).
-    destruct isIn as [([|p'],e')|].
-    * destruct IHe2_1 as (IH1,GT1).
-      destruct IHe2_2 as (IH2,GT2).
-      split; [|simpl; apply Zgt_trans with (Z.pos p); trivial].
-      npe_simpl. rewrite IH1, IH2. simpl. simpl_pos_sub. simpl.
-      replace (N.pos p1) with (N.pos p + N.pos (p1 - p))%N.
-      rewrite PEpow_add_r; npe_ring.
-      { simpl. f_equal. rewrite Pos.add_comm, Pos.sub_add. trivial.
-        now apply Pos.gt_lt. }
-    * destruct IHe2_1 as (IH1,GT1).
-      destruct IHe2_2 as (IH2,GT2).
-      assert (Z.pos p1 > Z.pos p')%Z by (now apply Zgt_trans with (Zpos p)).
-      split; [|simpl; trivial].
-      npe_simpl. rewrite IH1, IH2. simpl. simpl_pos_sub. simpl.
-      replace (N.pos (p1 - p')) with (N.pos (p1 - p) + N.pos (p - p'))%N.
-      rewrite PEpow_add_r; npe_ring.
-      { simpl. f_equal. rewrite Pos.add_sub_assoc, Pos.sub_add; trivial.
-        now apply Pos.gt_lt.
-        now apply Pos.gt_lt. }
-    * destruct IHe2_1 as (IH,GT). split; trivial.
-      npe_simpl. rewrite IH. npe_ring.
-  + specialize (IHe2_2 p1 p2).
-    destruct isIn as [(n,e)|]; trivial.
-    destruct IHe2_2 as (IH,GT). split; trivial.
-    set (d := ZtoN (Z.pos p1 - NtoZ n)) in *; clearbody d.
-    npe_simpl. rewrite IH. npe_ring.
-- destruct n; trivial.
-  specialize (IHe2 p1 (p * p2)%positive).
-  destruct isIn as [(n,e)|]; trivial.
-  destruct IHe2 as (IH,GT). split; trivial.
-  set (d := ZtoN (Z.pos p1 - NtoZ n)) in *; clearbody d.
-  now rewrite <- PEpow_mul_r.
-Qed.
-
-Record rsplit : Type := mk_rsplit {
-   rsplit_left : PExpr C;
-   rsplit_common : PExpr C;
-   rsplit_right : PExpr C}.
-
-(* Stupid name clash *)
-Notation left := rsplit_left.
-Notation right := rsplit_right.
-Notation common := rsplit_common.
-
-Fixpoint split_aux e1 p e2 {struct e1}: rsplit :=
-  match e1 with
-  | e3 * e4 =>
-      let r1 := split_aux e3 p e2 in
-      let r2 := split_aux e4 p (right r1) in
-      mk_rsplit (left r1 ** left r2)
-                (common r1 ** common r2)
-                (right r2)
-  | e3 ^ N0 => mk_rsplit 1 1 e2
-  | e3 ^ Npos p3 => split_aux e3 (Pos.mul p3 p) e2
-  | _ =>
-       match isIn e1 p e2 1 with
-       | Some (N0,e3) => mk_rsplit 1 (e1 ^^ Npos p) e3
-       | Some (Npos q, e3) => mk_rsplit (e1 ^^ Npos q) (e1 ^^ Npos (p - q)) e3
-       | None => mk_rsplit (e1 ^^ Npos p) 1 e2
-       end
-  end%poly.
-
-Lemma split_aux_ok1 e1 p e2 :
-  (let res := match isIn e1 p e2 1 with
-       | Some (N0,e3) => mk_rsplit 1 (e1 ^^ Npos p) e3
-       | Some (Npos q, e3) => mk_rsplit (e1 ^^ Npos q) (e1 ^^ Npos (p - q)) e3
-       | None => mk_rsplit (e1 ^^ Npos p) 1 e2
-       end
-  in
-  e1 ^ Npos p === left res * common res
-  /\ e2 === right res * common res)%poly.
-Proof.
- Opaque NPEpow NPEmul.
- intros. unfold res;clear res; generalize (isIn_ok e1 p e2 xH).
- destruct (isIn e1 p e2 1) as [([|p'],e')|]; simpl.
- - intros (H1,H2); split; npe_simpl.
-   + now rewrite PE_1_l.
-   + rewrite PEpow_1_r in H1. rewrite H1. npe_ring.
- - intros (H1,H2); split; npe_simpl.
-   + rewrite <- PEpow_add_r. f_equiv. simpl. f_equal.
-     rewrite Pos.add_comm, Pos.sub_add; trivial.
-     now apply Z.gt_lt in H2.
-   + rewrite PEpow_1_r in H1. rewrite H1. simpl_pos_sub. simpl. npe_ring.
- - intros _; split; npe_simpl; now rewrite PE_1_r.
-Qed.
-
-Theorem split_aux_ok: forall e1 p e2,
-  (e1 ^ Npos p === left (split_aux e1 p e2) * common (split_aux e1 p e2)
-  /\ e2 === right (split_aux e1 p e2) * common (split_aux e1 p e2))%poly.
-Proof.
-induction e1;intros k e2; try refine (split_aux_ok1 _ k e2);simpl.
-destruct (IHe1_1 k e2) as (H1,H2).
-destruct (IHe1_2 k (right (split_aux e1_1 k e2))) as (H3,H4).
-clear IHe1_1 IHe1_2.
-- npe_simpl; split.
-  * rewrite H1, H3. npe_ring.
-  * rewrite H2 at 1. rewrite H4 at 1. npe_ring.
-- destruct n; simpl.
-  + rewrite PEpow_0_r, PEpow_1_l, !PE_1_r. now split.
-  + rewrite <- PEpow_mul_r. simpl. apply IHe1.
-Qed.
-
-Definition split e1 e2 := split_aux e1 xH e2.
-
-Theorem split_ok_l e1 e2 :
-  (e1 === left (split e1 e2) * common (split e1 e2))%poly.
-Proof.
-destruct (split_aux_ok e1 xH e2) as (H,_). now rewrite <- H, PEpow_1_r.
-Qed.
-
-Theorem split_ok_r e1 e2 :
-  (e2 === right (split e1 e2) * common (split e1 e2))%poly.
-Proof.
-destruct (split_aux_ok e1 xH e2) as (_,H). trivial.
-Qed.
-
-Lemma split_nz_l l e1 e2 :
- ~ e1 @ l == 0 -> ~ left (split e1 e2) @ l == 0.
-Proof.
- intros H. contradict H. rewrite (split_ok_l e1 e2); simpl.
- now rewrite H, rmul_0_l.
-Qed.
-
-Lemma split_nz_r l e1 e2 :
- ~ e2 @ l == 0 -> ~ right (split e1 e2) @ l == 0.
-Proof.
- intros H. contradict H. rewrite (split_ok_r e1 e2); simpl.
- now rewrite H, rmul_0_l.
-Qed.
-
-Fixpoint Fnorm (e : FExpr) : linear :=
-  match e with
-  | FEO => mk_linear 0 1 nil
-  | FEI => mk_linear 1 1 nil
-  | FEc c => mk_linear (PEc c) 1 nil
-  | FEX x => mk_linear (PEX C x) 1 nil
-  | FEadd e1 e2 =>
-      let x := Fnorm e1 in
-      let y := Fnorm e2 in
-      let s := split (denum x) (denum y) in
-      mk_linear
-        ((num x ** right s) ++ (num y ** left s))
-        (left s ** (right s ** common s))
-        (condition x ++ condition y)%list
-  | FEsub e1 e2 =>
-      let x := Fnorm e1 in
-      let y := Fnorm e2 in
-      let s := split (denum x) (denum y) in
-      mk_linear
-        ((num x ** right s) -- (num y ** left s))
-        (left s ** (right s ** common s))
-        (condition x ++ condition y)%list
-  | FEmul e1 e2 =>
-      let x := Fnorm e1 in
-      let y := Fnorm e2 in
-      let s1 := split (num x) (denum y) in
-      let s2 := split (num y) (denum x) in
-      mk_linear (left s1 ** left s2)
-        (right s2 ** right s1)
-        (condition x ++ condition y)%list
-  | FEopp e1 =>
-      let x := Fnorm e1 in
-      mk_linear (NPEopp (num x)) (denum x) (condition x)
-  | FEinv e1 =>
-      let x := Fnorm e1 in
-      mk_linear (denum x) (num x) (num x :: condition x)
-  | FEdiv e1 e2 =>
-      let x := Fnorm e1 in
-      let y := Fnorm e2 in
-      let s1 := split (num x) (num y) in
-      let s2 := split (denum x) (denum y) in
-      mk_linear (left s1 ** right s2)
-        (left s2 ** right s1)
-        (num y :: condition x ++ condition y)%list
-  | FEpow e1 n =>
-      let x := Fnorm e1 in
-      mk_linear ((num x)^^n) ((denum x)^^n) (condition x)
-  end.
-
-(* Example *)
-(*
-Eval compute
-   in (Fnorm
-        (FEdiv
-          (FEc cI)
-          (FEadd (FEinv (FEX xH%positive)) (FEinv (FEX (xO xH)%positive))))).
-*)
-
-Theorem Pcond_Fnorm l e :
- PCond l (condition (Fnorm e)) ->  ~ (denum (Fnorm e))@l == 0.
-Proof.
-induction e; simpl condition; rewrite ?PCond_cons, ?PCond_app;
- simpl denum; intros (Hc1,Hc2) || intros Hc; rewrite ?NPEmul_ok.
-- simpl. rewrite phi_1; exact rI_neq_rO.
-- simpl. rewrite phi_1; exact rI_neq_rO.
-- simpl; intros. rewrite phi_1; exact rI_neq_rO.
-- simpl; intros. rewrite phi_1; exact rI_neq_rO.
-- rewrite <- split_ok_r. simpl. apply field_is_integral_domain.
-  + apply split_nz_l, IHe1, Hc1.
-  + apply IHe2, Hc2.
-- rewrite <- split_ok_r. simpl. apply field_is_integral_domain.
-  + apply split_nz_l, IHe1, Hc1.
-  + apply IHe2, Hc2.
-- simpl. apply field_is_integral_domain.
-  + apply split_nz_r, IHe1, Hc1.
-  + apply split_nz_r, IHe2, Hc2.
-- now apply IHe.
-- trivial.
-- destruct Hc2 as (Hc2,_). simpl. apply field_is_integral_domain.
-  + apply split_nz_l, IHe1, Hc2.
-  + apply split_nz_r, Hc1.
-- rewrite NPEpow_ok. apply PEpow_nz, IHe, Hc.
-Qed.
-
-
-(***************************************************************************
-
-                       Main theorem
-
-  ***************************************************************************)
-
-Ltac uneval :=
- repeat match goal with
-  | |- context [ ?x @ ?l * ?y @ ?l ] => change (x@l * y@l) with ((x*y)@l)
-  | |- context [ ?x @ ?l + ?y @ ?l ] => change (x@l + y@l) with ((x+y)@l)
- end.
-
-Theorem Fnorm_FEeval_PEeval l fe:
- PCond l (condition (Fnorm fe)) ->
- FEeval l fe == (num (Fnorm fe)) @ l / (denum (Fnorm fe)) @ l.
-Proof.
-induction fe; simpl condition; rewrite ?PCond_cons, ?PCond_app; simpl;
- intros (Hc1,Hc2) || intros Hc;
- try (specialize (IHfe1 Hc1);apply Pcond_Fnorm in Hc1);
- try (specialize (IHfe2 Hc2);apply Pcond_Fnorm in Hc2);
- try set (F1 := Fnorm fe1) in *; try set (F2 := Fnorm fe2) in *.
-
-- now rewrite phi_1, phi_0, rdiv_def.
-- now rewrite phi_1; apply rdiv1.
-- rewrite phi_1; apply rdiv1.
-- rewrite phi_1; apply rdiv1.
-- rewrite NPEadd_ok, !NPEmul_ok. simpl.
-  rewrite <- rdiv2b; uneval; rewrite <- ?split_ok_l, <- ?split_ok_r; trivial.
-  now f_equiv.
-
-- rewrite NPEsub_ok, !NPEmul_ok. simpl.
-  rewrite <- rdiv3b; uneval; rewrite <- ?split_ok_l, <- ?split_ok_r; trivial.
-  now f_equiv.
-
-- rewrite !NPEmul_ok. simpl.
-  rewrite IHfe1, IHfe2.
-  rewrite (split_ok_l (num F1) (denum F2) l),
-          (split_ok_r (num F1) (denum F2) l),
-          (split_ok_l (num F2) (denum F1) l),
-          (split_ok_r (num F2) (denum F1) l) in *.
-  apply rdiv4b; trivial.
-
-- rewrite NPEopp_ok; simpl; rewrite (IHfe Hc); apply rdiv5.
-
-- rewrite (IHfe Hc2); apply rdiv6; trivial;
-   apply Pcond_Fnorm; trivial.
-
-- destruct Hc2 as (Hc2,Hc3).
-  rewrite !NPEmul_ok. simpl.
-  assert (U1 := split_ok_l (num F1) (num F2) l).
-  assert (U2 := split_ok_r (num F1) (num F2) l).
-  assert (U3 := split_ok_l (denum F1) (denum F2) l).
-  assert (U4 := split_ok_r (denum F1) (denum F2) l).
-  rewrite (IHfe1 Hc2), (IHfe2 Hc3), U1, U2, U3, U4.
-  simpl in U2, U3, U4. apply rdiv7b;
-   rewrite <- ?U2, <- ?U3, <- ?U4; try apply Pcond_Fnorm; trivial.
-
-- rewrite !NPEpow_ok. simpl. rewrite !rpow_pow, (IHfe Hc).
-  destruct n; simpl.
-  + apply rdiv1.
-  + apply pow_pos_div. apply Pcond_Fnorm; trivial.
-Qed.
-
-Theorem Fnorm_crossproduct l fe1 fe2 :
- let nfe1 := Fnorm fe1 in
- let nfe2 := Fnorm fe2 in
- (num nfe1 * denum nfe2) @ l == (num nfe2 * denum nfe1) @ l ->
- PCond l (condition nfe1 ++ condition nfe2) ->
- FEeval l fe1 == FEeval l fe2.
-Proof.
-simpl. rewrite PCond_app. intros Hcrossprod (Hc1,Hc2).
-rewrite !Fnorm_FEeval_PEeval; trivial.
-apply cross_product_eq; trivial;
- apply Pcond_Fnorm; trivial.
-Qed.
-
-(* Correctness lemmas of reflexive tactics *)
-Notation Ninterp_PElist :=
-  (interp_PElist rO rI radd rmul rsub ropp req phi Cp_phi rpow).
-Notation Nmk_monpol_list :=
-  (mk_monpol_list cO cI cadd cmul csub copp ceqb cdiv).
-
-Theorem Fnorm_ok:
- forall n l lpe fe,
-  Ninterp_PElist l lpe ->
-  Peq ceqb (Nnorm n (Nmk_monpol_list lpe) (num (Fnorm fe))) (Pc cO) = true ->
-  PCond l (condition (Fnorm fe)) ->  FEeval l fe == 0.
-Proof.
-intros n l lpe fe Hlpe H H1.
-rewrite (Fnorm_FEeval_PEeval l fe H1).
-apply rdiv8. apply Pcond_Fnorm; trivial.
-transitivity (0@l); trivial.
-rewrite (norm_subst_ok Rsth Reqe ARth CRmorph pow_th cdiv_th n l lpe); trivial.
-change (0 @ l) with (Pphi 0 radd rmul phi l (Pc cO)).
-apply (Peq_ok Rsth Reqe CRmorph); trivial.
-Qed.
-
-Notation ring_rw_correct :=
- (ring_rw_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec).
-
-Notation ring_rw_pow_correct :=
- (ring_rw_pow_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec).
-
-Notation ring_correct :=
- (ring_correct Rsth Reqe ARth CRmorph pow_th cdiv_th).
-
-(* simplify a field expression into a fraction *)
-Definition display_linear l num den :=
-  let lnum := NPphi_dev l num in
-    match den with
-    | Pc c => if ceqb c cI then lnum else lnum / NPphi_dev l den
-    | _ => lnum / NPphi_dev l den
-    end.
-
-Definition display_pow_linear l num den :=
-  let lnum := NPphi_pow l num in
-    match den with
-    | Pc c => if ceqb c cI then lnum else lnum / NPphi_pow l den
-    | _ => lnum / NPphi_pow l den
-    end.
-
-Theorem Field_rw_correct n lpe l :
-   Ninterp_PElist l lpe ->
-   forall lmp, Nmk_monpol_list lpe = lmp ->
-   forall fe nfe, Fnorm fe = nfe ->
-   PCond l (condition nfe) ->
-   FEeval l fe ==
-     display_linear l (Nnorm n lmp (num nfe)) (Nnorm n lmp (denum nfe)).
-Proof.
-  intros Hlpe lmp lmp_eq fe nfe eq_nfe H; subst nfe lmp.
-  rewrite (Fnorm_FEeval_PEeval _ _ H).
-  unfold display_linear.
-  destruct (Nnorm _ _ _) as [c | | ] eqn: HN;
-  try ( apply rdiv_ext;
-        eapply ring_rw_correct; eauto).
-  destruct (ceqb_spec c cI).
-    set (nnum := NPphi_dev _ _).
-    apply eq_trans with (nnum / NPphi_dev l (Pc c)).
-      apply rdiv_ext;
-      eapply ring_rw_correct; eauto.
-    rewrite Pphi_dev_ok; try eassumption.
-    now simpl; rewrite H0, phi_1, <- rdiv1.
-  apply rdiv_ext;
-  eapply ring_rw_correct; eauto.
-Qed.
-
-Theorem Field_rw_pow_correct n lpe l :
-   Ninterp_PElist l lpe ->
-   forall lmp, Nmk_monpol_list lpe = lmp ->
-   forall fe nfe, Fnorm fe = nfe ->
-   PCond l (condition nfe) ->
-   FEeval l fe ==
-     display_pow_linear l (Nnorm n lmp (num nfe)) (Nnorm n lmp (denum nfe)).
-Proof.
-  intros Hlpe lmp lmp_eq fe nfe eq_nfe H; subst nfe lmp.
-  rewrite (Fnorm_FEeval_PEeval _ _ H).
-  unfold display_pow_linear.
-  destruct (Nnorm _ _ _) as [c | | ] eqn: HN;
-  try ( apply rdiv_ext;
-        eapply ring_rw_pow_correct; eauto).
-  destruct (ceqb_spec c cI).
-    set (nnum := NPphi_pow _ _).
-    apply eq_trans with (nnum / NPphi_pow l (Pc c)).
-      apply rdiv_ext;
-      eapply ring_rw_pow_correct; eauto.
-    rewrite Pphi_pow_ok; try eassumption.
-    now simpl; rewrite H0, phi_1, <- rdiv1.
-  apply rdiv_ext;
-  eapply ring_rw_pow_correct; eauto.
-Qed.
-
-Theorem Field_correct n l lpe fe1 fe2 :
- Ninterp_PElist l lpe ->
- forall lmp, Nmk_monpol_list lpe = lmp ->
- forall nfe1, Fnorm fe1 = nfe1 ->
- forall nfe2, Fnorm fe2 = nfe2 ->
- Peq ceqb (Nnorm n lmp (num nfe1 * denum nfe2))
-          (Nnorm n lmp (num nfe2 * denum nfe1)) = true ->
- PCond l (condition nfe1 ++ condition nfe2) ->
- FEeval l fe1 == FEeval l fe2.
-Proof.
-intros Hlpe lmp eq_lmp nfe1 eq1 nfe2 eq2 Hnorm Hcond; subst nfe1 nfe2 lmp.
-apply Fnorm_crossproduct; trivial.
-eapply ring_correct; eauto.
-Qed.
-
-(* simplify a field equation : generate the crossproduct and simplify
-   polynomials *)
-
-(** This allows rewriting modulo the simplification of PEeval on PMul *)
-Declare Equivalent Keys PEeval rmul.
-
-Theorem Field_simplify_eq_correct :
- forall n l lpe fe1 fe2,
-    Ninterp_PElist l lpe ->
- forall lmp, Nmk_monpol_list lpe = lmp ->
- forall nfe1, Fnorm fe1 = nfe1 ->
- forall nfe2, Fnorm fe2 = nfe2 ->
- forall den, split (denum nfe1) (denum nfe2) = den ->
- NPphi_dev l (Nnorm n lmp (num nfe1 * right den)) ==
- NPphi_dev l (Nnorm n lmp (num nfe2 * left den)) ->
- PCond l (condition nfe1 ++ condition nfe2) ->
- FEeval l fe1 == FEeval l fe2.
-Proof.
-intros n l lpe fe1 fe2 Hlpe lmp Hlmp nfe1 eq1 nfe2 eq2 den eq3 Hcrossprod Hcond.
-apply Fnorm_crossproduct; rewrite ?eq1, ?eq2; trivial.
-simpl.
-rewrite (split_ok_l (denum nfe1) (denum nfe2) l), eq3.
-rewrite (split_ok_r (denum nfe1) (denum nfe2) l), eq3.
-simpl.
-rewrite !rmul_assoc.
-apply rmul_ext; trivial.
-rewrite (ring_rw_correct n lpe l Hlpe Logic.eq_refl (num nfe1 * right den) Logic.eq_refl),
- (ring_rw_correct n lpe l Hlpe Logic.eq_refl (num nfe2 * left den) Logic.eq_refl).
-rewrite Hlmp.
-apply Hcrossprod.
-Qed.
-
-Theorem Field_simplify_eq_pow_correct :
- forall n l lpe fe1 fe2,
-    Ninterp_PElist l lpe ->
- forall lmp, Nmk_monpol_list lpe = lmp ->
- forall nfe1, Fnorm fe1 = nfe1 ->
- forall nfe2, Fnorm fe2 = nfe2 ->
- forall den, split (denum nfe1) (denum nfe2) = den ->
- NPphi_pow l (Nnorm n lmp (num nfe1 * right den)) ==
- NPphi_pow l (Nnorm n lmp (num nfe2 * left den)) ->
- PCond l (condition nfe1 ++ condition nfe2) ->
- FEeval l fe1 == FEeval l fe2.
-Proof.
-intros n l lpe fe1 fe2 Hlpe lmp Hlmp nfe1 eq1 nfe2 eq2 den eq3 Hcrossprod Hcond.
-apply Fnorm_crossproduct; rewrite ?eq1, ?eq2; trivial.
-simpl.
-rewrite (split_ok_l (denum nfe1) (denum nfe2) l), eq3.
-rewrite (split_ok_r (denum nfe1) (denum nfe2) l), eq3.
-simpl.
-rewrite !rmul_assoc.
-apply rmul_ext; trivial.
-rewrite
- (ring_rw_pow_correct n lpe l Hlpe Logic.eq_refl (num nfe1 * right den) Logic.eq_refl),
- (ring_rw_pow_correct n lpe l Hlpe Logic.eq_refl (num nfe2 * left den) Logic.eq_refl).
-rewrite Hlmp.
-apply Hcrossprod.
-Qed.
-
-Theorem Field_simplify_aux_ok l fe1 fe2 den :
- FEeval l fe1 == FEeval l fe2 ->
- split (denum (Fnorm fe1)) (denum (Fnorm fe2)) = den ->
- PCond l (condition (Fnorm fe1) ++ condition (Fnorm fe2)) ->
- (num (Fnorm fe1) * right den) @ l == (num (Fnorm fe2) * left den) @ l.
-Proof.
- rewrite PCond_app; intros Hfe Hden (Hc1,Hc2); simpl.
- assert (Hc1' := Pcond_Fnorm _ _ Hc1).
- assert (Hc2' := Pcond_Fnorm _ _ Hc2).
- set (N1 := num (Fnorm fe1)) in *. set (N2 := num (Fnorm fe2)) in *.
- set (D1 := denum (Fnorm fe1)) in *. set (D2 := denum (Fnorm fe2)) in *.
- assert (~ (common den) @ l == 0).
- { intro H. apply Hc1'.
-   rewrite (split_ok_l D1 D2 l).
-   rewrite Hden. simpl. ring [H]. }
- apply (@rmul_reg_l ((common den) @ l)); trivial.
- rewrite !(rmul_comm ((common den) @ l)), <- !rmul_assoc.
- change
-  (N1@l * (right den * common den) @ l ==
-   N2@l * (left den * common den) @ l).
- rewrite <- Hden, <- split_ok_l, <- split_ok_r.
- apply (@rmul_reg_l (/ D2@l)). { apply rinv_nz; trivial. }
- rewrite (rmul_comm (/ D2 @ l)), <- !rmul_assoc.
- rewrite <- rdiv_def, rdiv_r_r, rmul_1_r by trivial.
- apply (@rmul_reg_l (/ (D1@l))). { apply rinv_nz; trivial. }
- rewrite !(rmul_comm  (/ D1@l)), <- !rmul_assoc.
- rewrite <- !rdiv_def, rdiv_r_r, rmul_1_r by trivial.
- rewrite (rmul_comm (/ D2@l)), <- rdiv_def.
- unfold N1,N2,D1,D2; rewrite <- !Fnorm_FEeval_PEeval; trivial.
-Qed.
-
-Theorem Field_simplify_eq_pow_in_correct :
- forall n l lpe fe1 fe2,
-    Ninterp_PElist l lpe ->
- forall lmp, Nmk_monpol_list lpe = lmp ->
- forall nfe1, Fnorm fe1 = nfe1 ->
- forall nfe2, Fnorm fe2 = nfe2 ->
- forall den, split (denum nfe1) (denum nfe2) = den ->
- forall np1, Nnorm n lmp (num nfe1 * right den) = np1 ->
- forall np2, Nnorm n lmp (num nfe2 * left den) = np2 ->
- FEeval l fe1 == FEeval l fe2 ->
- PCond l (condition nfe1 ++ condition nfe2) ->
- NPphi_pow l np1 ==
- NPphi_pow l np2.
-Proof.
- intros. subst nfe1 nfe2 lmp np1 np2.
- rewrite !(Pphi_pow_ok Rsth Reqe ARth CRmorph pow_th get_sign_spec).
- repeat (rewrite <- (norm_subst_ok Rsth Reqe ARth CRmorph pow_th);trivial).
- simpl. apply Field_simplify_aux_ok; trivial.
-Qed.
-
-Theorem Field_simplify_eq_in_correct :
-forall n l lpe fe1 fe2,
-    Ninterp_PElist l lpe ->
- forall lmp, Nmk_monpol_list lpe = lmp ->
- forall nfe1, Fnorm fe1 = nfe1 ->
- forall nfe2, Fnorm fe2 = nfe2 ->
- forall den, split (denum nfe1) (denum nfe2) = den ->
- forall np1, Nnorm n lmp (num nfe1 * right den) = np1 ->
- forall np2, Nnorm n lmp (num nfe2 * left den) = np2 ->
- FEeval l fe1 == FEeval l fe2 ->
- PCond l (condition nfe1 ++ condition nfe2) ->
- NPphi_dev l np1 == NPphi_dev l np2.
-Proof.
- intros. subst nfe1 nfe2 lmp np1 np2.
- rewrite !(Pphi_dev_ok Rsth Reqe ARth CRmorph  get_sign_spec).
- repeat (rewrite <- (norm_subst_ok Rsth Reqe ARth CRmorph pow_th);trivial).
- apply Field_simplify_aux_ok; trivial.
-Qed.
-
-
-Section Fcons_impl.
-
-Variable Fcons : PExpr C -> list (PExpr C) -> list (PExpr C).
-
-Hypothesis PCond_fcons_inv : forall l a l1,
-  PCond l (Fcons a l1) ->  ~ a @ l == 0 /\ PCond l l1.
-
-Fixpoint Fapp (l m:list (PExpr C)) {struct l} : list (PExpr C) :=
-  match l with
-  | nil => m
-  | cons a l1 => Fcons a (Fapp l1 m)
-  end.
-
-Lemma fcons_ok : forall l l1,
-  (forall lock, lock = PCond l -> lock (Fapp l1 nil)) -> PCond l l1.
-Proof.
-intros l l1 h1; assert (H := h1 (PCond l) (refl_equal _));clear h1.
-induction l1; simpl; intros.
- trivial.
- elim PCond_fcons_inv with (1 := H); intros.
- destruct l1; trivial. split; trivial. apply IHl1; trivial.
-Qed.
-
-End Fcons_impl.
-
-Section Fcons_simpl.
-
-(* Some general simpifications of the condition: eliminate duplicates,
-   split multiplications *)
-
-Fixpoint Fcons (e:PExpr C) (l:list (PExpr C)) {struct l} : list (PExpr C) :=
- match l with
-   nil       => cons e nil
- | cons a l1 => if PExpr_eq e a then l else cons a (Fcons e l1)
- end.
-
-Theorem PFcons_fcons_inv:
- forall l a l1, PCond l (Fcons a l1) ->  ~ a @ l == 0 /\ PCond l l1.
-Proof.
-induction l1 as [|e l1]; simpl Fcons.
-- simpl; now split.
-- case PExpr_eq_spec; intros H; rewrite !PCond_cons; intros (H1,H2);
-   repeat split; trivial.
-  + now rewrite H.
-  + now apply IHl1.
-  + now apply IHl1.
-Qed.
-
-(* equality of normal forms rather than syntactic equality *)
-Fixpoint Fcons0 (e:PExpr C) (l:list (PExpr C)) {struct l} : list (PExpr C) :=
- match l with
-   nil       => cons e nil
- | cons a l1 =>
-     if Peq ceqb (Nnorm O nil e) (Nnorm O nil a) then l
-     else cons a (Fcons0 e l1)
- end.
-
-Theorem PFcons0_fcons_inv:
- forall l a l1, PCond l (Fcons0 a l1) ->  ~ a @ l == 0 /\ PCond l l1.
-Proof.
-induction l1 as [|e l1]; simpl Fcons0.
-- simpl; now split.
-- generalize (ring_correct O l nil a e). lazy zeta; simpl Peq.
-  case Peq; intros H; rewrite !PCond_cons; intros (H1,H2);
-   repeat split; trivial.
-  + now rewrite H.
-  + now apply IHl1.
-  + now apply IHl1.
-Qed.
-
-(* split factorized denominators *)
-Fixpoint Fcons00 (e:PExpr C) (l:list (PExpr C)) {struct e} : list (PExpr C) :=
- match e with
-   PEmul e1 e2 => Fcons00 e1 (Fcons00 e2 l)
- | PEpow e1 _ => Fcons00 e1 l
- | _ => Fcons0 e l
- end.
-
-Theorem PFcons00_fcons_inv:
-  forall l a l1, PCond l (Fcons00 a l1) -> ~ a @ l == 0 /\ PCond l l1.
-Proof.
-intros l a; elim a; try (intros; apply PFcons0_fcons_inv; trivial; fail).
-- intros p H p0 H0 l1 H1.
-  simpl in H1.
-  destruct (H _ H1) as (H2,H3).
-  destruct (H0 _ H3) as (H4,H5). split; trivial.
-  simpl.
-  apply field_is_integral_domain; trivial.
-- intros. destruct (H _ H0). split; trivial.
-  apply PEpow_nz; trivial.
-Qed.
-
-Definition Pcond_simpl_gen :=
-  fcons_ok _ PFcons00_fcons_inv.
-
-
-(* Specific case when the equality test of coefs is complete w.r.t. the
-   field equality: non-zero coefs can be eliminated, and opposite can
-   be simplified (if -1 <> 0) *)
-
-Hypothesis ceqb_complete : forall c1 c2, [c1] == [c2] -> ceqb c1 c2 = true.
-
-Lemma ceqb_spec' c1 c2 : Bool.reflect ([c1] == [c2]) (ceqb c1 c2).
-Proof.
-assert (H := morph_eq CRmorph c1 c2).
-assert (H' := @ceqb_complete c1 c2).
-destruct (ceqb c1 c2); constructor.
-- now apply H.
-- intro E. specialize (H' E). discriminate.
-Qed.
-
-Fixpoint Fcons1 (e:PExpr C) (l:list (PExpr C)) {struct e} : list (PExpr C) :=
- match e with
- | PEmul e1 e2 => Fcons1 e1 (Fcons1 e2 l)
- | PEpow e _ => Fcons1 e l
- | PEopp e => if (-(1) =? 0)%coef then absurd_PCond else Fcons1 e l
- | PEc c => if (c =? 0)%coef then absurd_PCond else l
- | _ => Fcons0 e l
- end.
-
-Theorem PFcons1_fcons_inv:
-  forall l a l1, PCond l (Fcons1 a l1) -> ~ a @ l == 0 /\ PCond l l1.
-Proof.
-intros l a; elim a; try (intros; apply PFcons0_fcons_inv; trivial; fail).
-- simpl; intros c l1.
-  case ceqb_spec'; intros H H0.
-  + elim (@absurd_PCond_bottom l H0).
-  + split; trivial. rewrite <- phi_0; trivial.
-- intros p H p0 H0 l1 H1. simpl in H1.
-  destruct (H _ H1) as (H2,H3).
-  destruct (H0 _ H3) as (H4,H5).
-  split; trivial. simpl. apply field_is_integral_domain; trivial.
-- simpl; intros p H l1.
-  case ceqb_spec'; intros H0 H1.
-  + elim (@absurd_PCond_bottom l H1).
-  + destruct (H _ H1).
-    split; trivial.
-    apply ropp_neq_0; trivial.
-    rewrite (morph_opp CRmorph), phi_0, phi_1 in H0. trivial.
-- intros. destruct (H _ H0);split;trivial. apply PEpow_nz; trivial.
-Qed.
-
-Definition Fcons2 e l := Fcons1 (PEsimp e) l.
-
-Theorem PFcons2_fcons_inv:
- forall l a l1, PCond l (Fcons2 a l1) -> ~ a @ l == 0 /\ PCond l l1.
-Proof.
-unfold Fcons2; intros l a l1 H; split;
- case (PFcons1_fcons_inv l (PEsimp a) l1); trivial.
-intros H1 H2 H3; case H1.
-transitivity (a@l); trivial.
-apply PEsimp_ok.
-Qed.
-
-Definition Pcond_simpl_complete :=
-  fcons_ok _ PFcons2_fcons_inv.
-
-End Fcons_simpl.
-
-End AlmostField.
-
-Section FieldAndSemiField.
-
-  Record field_theory : Prop := mk_field {
-    F_R : ring_theory rO rI radd rmul rsub ropp req;
-    F_1_neq_0 : ~ 1 == 0;
-    Fdiv_def : forall p q, p / q == p * / q;
-    Finv_l : forall p, ~ p == 0 ->  / p * p == 1
-  }.
-
-  Definition F2AF f :=
-    mk_afield
-      (Rth_ARth Rsth Reqe (F_R f)) (F_1_neq_0 f) (Fdiv_def f) (Finv_l f).
-
-  Record semi_field_theory : Prop := mk_sfield {
-    SF_SR : semi_ring_theory rO rI radd rmul req;
-    SF_1_neq_0 : ~ 1 == 0;
-    SFdiv_def : forall p q, p / q == p * / q;
-    SFinv_l : forall p, ~ p == 0 ->  / p * p == 1
-  }.
-
-End FieldAndSemiField.
-
-End MakeFieldPol.
-
-  Definition SF2AF R (rO rI:R) radd rmul rdiv rinv req Rsth
-    (sf:semi_field_theory rO rI radd rmul rdiv rinv req)  :=
-    mk_afield _ _
-      (SRth_ARth Rsth (SF_SR sf))
-      (SF_1_neq_0 sf)
-      (SFdiv_def sf)
-      (SFinv_l sf).
-
-
-Section Complete.
- Variable R : Type.
- Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
- Variable (rdiv : R -> R ->  R) (rinv : 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 " := (rdiv x y).  Notation "/ x" := (rinv x).
-  Notation "x == y" := (req x y) (at level 70, no associativity).
- 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_setoid3.
- Variable Reqe : ring_eq_ext radd rmul ropp req.
-   Add Morphism radd with signature (req ==> req ==> req) as radd_ext3.
-   Proof. exact (Radd_ext Reqe). Qed.
-   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext3.
-   Proof. exact (Rmul_ext Reqe). Qed.
-   Add Morphism ropp with signature (req ==> req) as ropp_ext3.
-   Proof. exact (Ropp_ext Reqe). Qed.
-
-Section AlmostField.
-
- Variable AFth : almost_field_theory rO rI radd rmul rsub ropp rdiv rinv req.
- Let ARth := (AF_AR AFth).
- Let rI_neq_rO := (AF_1_neq_0 AFth).
- Let rdiv_def := (AFdiv_def AFth).
- Let rinv_l := (AFinv_l AFth).
-
-Hypothesis S_inj : forall x y, 1+x==1+y -> x==y.
-
-Hypothesis gen_phiPOS_not_0 : forall p, ~ gen_phiPOS1 rI radd rmul p == 0.
-
-Lemma add_inj_r p x y :
-   gen_phiPOS1 rI radd rmul p + x == gen_phiPOS1 rI radd rmul p + y -> x==y.
-Proof.
-elim p using Pos.peano_ind; simpl; intros.
- apply S_inj; trivial.
- apply H.
-   apply S_inj.
-   rewrite !(ARadd_assoc ARth).
-   rewrite <- (ARgen_phiPOS_Psucc Rsth Reqe ARth); trivial.
-Qed.
-
-Lemma gen_phiPOS_inj x y :
-  gen_phiPOS rI radd rmul x == gen_phiPOS rI radd rmul y ->
-  x = y.
-Proof.
-rewrite <- !(same_gen Rsth Reqe ARth).
-case (Pos.compare_spec x y).
- intros.
-   trivial.
- intros.
-   elim gen_phiPOS_not_0 with (y - x)%positive.
-   apply add_inj_r with x.
-   symmetry.
-   rewrite (ARadd_0_r Rsth ARth).
-   rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth).
-   now rewrite Pos.add_comm, Pos.sub_add.
- intros.
-   elim gen_phiPOS_not_0 with (x - y)%positive.
-   apply add_inj_r with y.
-   rewrite (ARadd_0_r Rsth ARth).
-   rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth).
-   now rewrite Pos.add_comm, Pos.sub_add.
-Qed.
-
-
-Lemma gen_phiN_inj x y :
-  gen_phiN rO rI radd rmul x == gen_phiN rO rI radd rmul y ->
-  x = y.
-Proof.
-destruct x; destruct y; simpl; intros; trivial.
- elim gen_phiPOS_not_0 with p.
-   symmetry .
-   rewrite (same_gen Rsth Reqe ARth); trivial.
- elim gen_phiPOS_not_0 with p.
-   rewrite (same_gen Rsth Reqe ARth); trivial.
- rewrite gen_phiPOS_inj with (1 := H); trivial.
-Qed.
-
-Lemma gen_phiN_complete x y :
-  gen_phiN rO rI radd rmul x == gen_phiN rO rI radd rmul y ->
-  N.eqb x y = true.
-Proof.
-intros. now apply N.eqb_eq, gen_phiN_inj.
-Qed.
-
-End AlmostField.
-
-Section Field.
-
- Variable Fth : field_theory rO rI radd rmul rsub ropp rdiv rinv req.
- Let Rth := (F_R Fth).
- Let rI_neq_rO := (F_1_neq_0 Fth).
- Let rdiv_def := (Fdiv_def Fth).
- Let rinv_l := (Finv_l Fth).
- Let AFth := F2AF Rsth Reqe Fth.
- Let ARth := Rth_ARth Rsth Reqe Rth.
-
-Lemma ring_S_inj x y : 1+x==1+y -> x==y.
-Proof.
-intros.
-rewrite <- (ARadd_0_l ARth x), <- (ARadd_0_l ARth y).
-rewrite <- (Ropp_def Rth 1), (ARadd_comm ARth 1).
-rewrite <- !(ARadd_assoc ARth). now apply (Radd_ext Reqe).
-Qed.
-
-Hypothesis gen_phiPOS_not_0 : forall p, ~ gen_phiPOS1 rI radd rmul p == 0.
-
-Let gen_phiPOS_inject :=
-   gen_phiPOS_inj AFth ring_S_inj gen_phiPOS_not_0.
-
-Lemma gen_phiPOS_discr_sgn x y :
-  ~ gen_phiPOS rI radd rmul x == - gen_phiPOS rI radd rmul y.
-Proof.
-red; intros.
-apply gen_phiPOS_not_0 with (y + x)%positive.
-rewrite (ARgen_phiPOS_add Rsth Reqe ARth).
-transitivity (gen_phiPOS1 1 radd rmul y + - gen_phiPOS1 1 radd rmul y).
- apply (Radd_ext Reqe); trivial.
-  reflexivity.
-  rewrite (same_gen Rsth Reqe ARth).
-    rewrite (same_gen Rsth Reqe ARth).
-    trivial.
- apply (Ropp_def Rth).
-Qed.
-
-Lemma gen_phiZ_inj x y :
-  gen_phiZ rO rI radd rmul ropp x == gen_phiZ rO rI radd rmul ropp y ->
-  x = y.
-Proof.
-destruct x; destruct y; simpl; intros.
- trivial.
- elim gen_phiPOS_not_0 with p.
-   rewrite (same_gen Rsth Reqe ARth).
-   symmetry ; trivial.
- elim gen_phiPOS_not_0 with p.
-   rewrite (same_gen Rsth Reqe ARth).
-   rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)).
-   rewrite <- H.
-   apply (ARopp_zero Rsth Reqe ARth).
- elim gen_phiPOS_not_0 with p.
-   rewrite (same_gen Rsth Reqe ARth).
-   trivial.
- rewrite gen_phiPOS_inject  with (1 := H); trivial.
- elim gen_phiPOS_discr_sgn with (1 := H).
- elim gen_phiPOS_not_0 with p.
-   rewrite (same_gen Rsth Reqe ARth).
-   rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)).
-   rewrite H.
-   apply (ARopp_zero Rsth Reqe ARth).
- elim gen_phiPOS_discr_sgn with p0 p.
-   symmetry ; trivial.
- replace p0 with p; trivial.
-   apply gen_phiPOS_inject.
-   rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)).
-   rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p0)).
-   rewrite H; trivial.
-   reflexivity.
-Qed.
-
-Lemma gen_phiZ_complete x y :
-  gen_phiZ rO rI radd rmul ropp x == gen_phiZ rO rI radd rmul ropp y ->
-  Zeq_bool x y = true.
-Proof.
-intros.
- replace y with x.
- unfold Zeq_bool.
-   rewrite Z.compare_refl; trivial.
- apply gen_phiZ_inj; trivial.
-Qed.
-
-End Field.
-
-End Complete.
-
-Arguments FEO {C}.
-Arguments FEI {C}.
diff --git a/plugins/setoid_ring/InitialRing.v b/plugins/setoid_ring/InitialRing.v
deleted file mode 100644
index dc096554c8..0000000000
--- a/plugins/setoid_ring/InitialRing.v
+++ /dev/null
@@ -1,894 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Import Zbool.
-Require Import BinInt.
-Require Import BinNat.
-Require Import Setoid.
-Require Import Ring_theory.
-Require Import Ring_polynom.
-Import List.
-
-Set Implicit Arguments.
-(* Set Universe Polymorphism. *)
-
-Import RingSyntax.
-
-(* An object to return when an expression is not recognized as a constant *)
-Definition NotConstant := false.
-
-(** Z is a ring and a setoid*)
-
-Lemma Zsth : Setoid_Theory Z (@eq Z).
-Proof (Eqsth Z).
-
-Lemma Zeqe : ring_eq_ext Z.add Z.mul Z.opp (@eq Z).
-Proof (Eq_ext Z.add Z.mul Z.opp).
-
-Lemma Zth : ring_theory Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp (@eq Z).
-Proof.
- constructor. exact Z.add_0_l. exact Z.add_comm. exact Z.add_assoc.
- exact Z.mul_1_l. exact Z.mul_comm. exact Z.mul_assoc.
- exact Z.mul_add_distr_r. trivial. exact Z.sub_diag.
-Qed.
-
-(** Two generic morphisms from Z to (abrbitrary) rings, *)
-(**second one is more convenient for proofs but they are ext. equal*)
-Section ZMORPHISM.
- 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_setoid3.
-     Ltac rrefl := gen_reflexivity Rsth.
- Variable Reqe : ring_eq_ext radd rmul ropp req.
-   Add Morphism radd with signature (req ==> req ==> req) as radd_ext3.
-   Proof. exact (Radd_ext Reqe). Qed.
-   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext3.
-   Proof. exact (Rmul_ext Reqe). Qed.
-   Add Morphism ropp with signature (req ==> req) as ropp_ext3.
-   Proof. exact (Ropp_ext Reqe). Qed.
-
- Fixpoint gen_phiPOS1 (p:positive) : R :=
-  match p with
-  | xH => 1
-  | xO p => (1 + 1) * (gen_phiPOS1 p)
-  | xI p => 1 + ((1 + 1) * (gen_phiPOS1 p))
-  end.
-
- Fixpoint gen_phiPOS (p:positive) : R :=
-  match p with
-  | xH => 1
-  | xO xH => (1 + 1)
-  | xO p => (1 + 1) * (gen_phiPOS p)
-  | xI xH => 1 + (1 +1)
-  | xI p => 1 + ((1 + 1) * (gen_phiPOS p))
-  end.
-
- Definition gen_phiZ1 z :=
-  match z with
-  | Zpos p => gen_phiPOS1 p
-  | Z0 => 0
-  | Zneg p => -(gen_phiPOS1 p)
-  end.
-
- Definition gen_phiZ z :=
-  match z with
-  | Zpos p => gen_phiPOS p
-  | Z0 => 0
-  | Zneg p => -(gen_phiPOS p)
-  end.
- Notation "[ x ]" := (gen_phiZ x).
-
- Definition get_signZ z :=
-  match z with
-  | Zneg p => Some (Zpos p)
-  | _ => None
-  end.
-
- Lemma get_signZ_th : sign_theory Z.opp Zeq_bool get_signZ.
- Proof.
-  constructor.
-  destruct c;intros;try discriminate.
-  injection H as [= <-].
-  simpl. unfold Zeq_bool. rewrite Z.compare_refl. trivial.
- Qed.
-
-
- Section ALMOST_RING.
- Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
-   Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext3.
-   Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
-   Ltac norm := gen_srewrite Rsth Reqe ARth.
-   Ltac add_push := gen_add_push radd Rsth Reqe ARth.
-
- Lemma same_gen : forall x, gen_phiPOS1 x == gen_phiPOS x.
- Proof.
-  induction x;simpl.
-  rewrite IHx;destruct x;simpl;norm.
-  rewrite IHx;destruct x;simpl;norm.
-  rrefl.
- Qed.
-
- Lemma ARgen_phiPOS_Psucc : forall x,
-   gen_phiPOS1 (Pos.succ x) == 1 + (gen_phiPOS1 x).
- Proof.
-  induction x;simpl;norm.
-  rewrite IHx;norm.
-  add_push 1;rrefl.
- Qed.
-
- Lemma ARgen_phiPOS_add : forall x y,
-   gen_phiPOS1 (x + y) == (gen_phiPOS1 x) + (gen_phiPOS1 y).
- Proof.
-  induction x;destruct y;simpl;norm.
-  rewrite Pos.add_carry_spec.
-  rewrite ARgen_phiPOS_Psucc.
-  rewrite IHx;norm.
-  add_push (gen_phiPOS1 y);add_push 1;rrefl.
-  rewrite IHx;norm;add_push (gen_phiPOS1 y);rrefl.
-  rewrite ARgen_phiPOS_Psucc;norm;add_push 1;rrefl.
-  rewrite IHx;norm;add_push(gen_phiPOS1 y); add_push 1;rrefl.
-  rewrite IHx;norm;add_push(gen_phiPOS1 y);rrefl.
-  add_push 1;rrefl.
-  rewrite ARgen_phiPOS_Psucc;norm;add_push 1;rrefl.
- Qed.
-
- Lemma ARgen_phiPOS_mult :
-   forall x y, gen_phiPOS1 (x * y) == gen_phiPOS1 x * gen_phiPOS1 y.
- Proof.
-  induction x;intros;simpl;norm.
-  rewrite ARgen_phiPOS_add;simpl;rewrite IHx;norm.
-  rewrite IHx;rrefl.
- Qed.
-
- End ALMOST_RING.
-
- Variable Rth : ring_theory 0 1 radd rmul rsub ropp req.
- Let ARth := Rth_ARth Rsth Reqe Rth.
-   Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext4.
-   Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
-   Ltac norm := gen_srewrite Rsth Reqe ARth.
-   Ltac add_push := gen_add_push radd Rsth Reqe ARth.
-
-(*morphisms are extensionally equal*)
- Lemma same_genZ : forall x, [x] == gen_phiZ1 x.
- Proof.
-  destruct x;simpl; try rewrite (same_gen ARth);rrefl.
- Qed.
-
- Lemma gen_Zeqb_ok : forall x y,
-   Zeq_bool x y = true -> [x] == [y].
- Proof.
-  intros x y H.
-  assert (H1 := Zeq_bool_eq x y H);unfold IDphi in H1.
-  rewrite H1;rrefl.
- Qed.
-
- Lemma gen_phiZ1_pos_sub : forall x y,
- gen_phiZ1 (Z.pos_sub x y) == gen_phiPOS1 x + -gen_phiPOS1 y.
- Proof.
-  intros x y.
-  rewrite Z.pos_sub_spec.
-  case Pos.compare_spec; intros H; simpl.
-  rewrite H. rewrite (Ropp_def Rth);rrefl.
-  rewrite <- (Pos.sub_add y x H) at 2. rewrite Pos.add_comm.
-  rewrite (ARgen_phiPOS_add ARth);simpl;norm.
-  rewrite (Ropp_def Rth);norm.
-  rewrite <- (Pos.sub_add x y H) at 2.
-  rewrite (ARgen_phiPOS_add ARth);simpl;norm.
-  add_push (gen_phiPOS1 (x-y));rewrite (Ropp_def Rth); norm.
- Qed.
-
- Lemma gen_phiZ_add : forall x y, [x + y] == [x] + [y].
- Proof.
-  intros x y; repeat rewrite same_genZ; generalize x y;clear x y.
-  destruct x, y; simpl; norm.
-  apply (ARgen_phiPOS_add ARth).
-  apply gen_phiZ1_pos_sub.
-  rewrite gen_phiZ1_pos_sub. apply (Radd_comm Rth).
-  rewrite (ARgen_phiPOS_add ARth); norm.
- Qed.
-
- Lemma gen_phiZ_mul : forall x y, [x * y] == [x] * [y].
- Proof.
-  intros x y;repeat rewrite same_genZ.
-  destruct x;destruct y;simpl;norm;
-  rewrite  (ARgen_phiPOS_mult ARth);try (norm;fail).
-  rewrite (Ropp_opp Rsth Reqe Rth);rrefl.
- Qed.
-
- Lemma gen_phiZ_ext : forall x y : Z, x = y -> [x] == [y].
- Proof. intros;subst;rrefl. Qed.
-
-(*proof that [.] satisfies morphism specifications*)
- Lemma gen_phiZ_morph :
-  ring_morph 0 1 radd rmul rsub ropp req Z0 (Zpos xH)
-   Z.add Z.mul Z.sub Z.opp Zeq_bool gen_phiZ.
- Proof.
-  assert ( SRmorph : semi_morph 0 1 radd rmul req Z0 (Zpos xH)
-                  Z.add Z.mul Zeq_bool gen_phiZ).
-   apply mkRmorph;simpl;try rrefl.
-   apply gen_phiZ_add.  apply gen_phiZ_mul. apply gen_Zeqb_ok.
-  apply  (Smorph_morph Rsth Reqe Rth Zth SRmorph gen_phiZ_ext).
- Qed.
-
-End ZMORPHISM.
-
-(** N is a semi-ring and a setoid*)
-Lemma Nsth : Setoid_Theory N (@eq N).
-Proof (Eqsth N).
-
-Lemma Nseqe : sring_eq_ext N.add N.mul (@eq N).
-Proof (Eq_s_ext N.add N.mul).
-
-Lemma Nth : semi_ring_theory 0%N 1%N N.add N.mul (@eq N).
-Proof.
- constructor. exact N.add_0_l. exact N.add_comm. exact N.add_assoc.
- exact N.mul_1_l. exact N.mul_0_l. exact N.mul_comm. exact N.mul_assoc.
- exact N.mul_add_distr_r.
-Qed.
-
-Definition Nsub := SRsub N.add.
-Definition Nopp := (@SRopp N).
-
-Lemma Neqe : ring_eq_ext N.add N.mul Nopp (@eq N).
-Proof (SReqe_Reqe Nseqe).
-
-Lemma Nath :
- almost_ring_theory 0%N 1%N N.add N.mul Nsub Nopp (@eq N).
-Proof (SRth_ARth Nsth Nth).
-
-Lemma Neqb_ok : forall x y, N.eqb x y = true -> x = y.
-Proof. exact (fun x y => proj1 (N.eqb_eq x y)). Qed.
-
-(**Same as above : definition of two, extensionally equal, generic morphisms *)
-(**from N to any semi-ring*)
-Section NMORPHISM.
- Variable R : Type.
- Variable  (rO rI : R) (radd rmul: R->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).
- 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_setoid4.
-     Ltac rrefl := gen_reflexivity Rsth.
- Variable SReqe : sring_eq_ext radd rmul req.
- Variable SRth : semi_ring_theory 0 1 radd rmul req.
- Let ARth := SRth_ARth Rsth SRth.
- Let Reqe := SReqe_Reqe SReqe.
- Let ropp := (@SRopp R).
- Let rsub := (@SRsub R radd).
-  Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
-  Notation "x == y" := (req x y).
-   Add Morphism radd with signature (req ==> req ==> req) as radd_ext4.
-   Proof. exact (Radd_ext Reqe). Qed.
-   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext4.
-   Proof. exact (Rmul_ext Reqe). Qed.
-   Ltac norm := gen_srewrite_sr Rsth Reqe ARth.
-
- Definition gen_phiN1 x :=
-  match x with
-  | N0 => 0
-  | Npos x => gen_phiPOS1 1 radd rmul x
-  end.
-
- Definition gen_phiN x :=
-  match x with
-  | N0 => 0
-  | Npos x => gen_phiPOS 1 radd rmul x
-  end.
- Notation "[ x ]" := (gen_phiN x).
-
- Lemma same_genN : forall x, [x] == gen_phiN1 x.
- Proof.
-  destruct x;simpl. reflexivity.
-  now rewrite (same_gen Rsth Reqe ARth).
- Qed.
-
- Lemma gen_phiN_add : forall x y, [x + y] == [x] + [y].
- Proof.
-  intros x y;repeat rewrite same_genN.
-  destruct x;destruct y;simpl;norm.
-  apply (ARgen_phiPOS_add Rsth Reqe ARth).
- Qed.
-
- Lemma gen_phiN_mult : forall x y, [x * y] == [x] * [y].
- Proof.
-  intros x y;repeat rewrite same_genN.
-  destruct x;destruct y;simpl;norm.
-  apply (ARgen_phiPOS_mult Rsth Reqe ARth).
- Qed.
-
- Lemma gen_phiN_sub : forall x y, [Nsub x y] == [x] - [y].
- Proof. exact gen_phiN_add. Qed.
-
-(*gen_phiN satisfies morphism specifications*)
- Lemma gen_phiN_morph : ring_morph 0 1 radd rmul rsub ropp req
-                           0%N 1%N N.add N.mul Nsub Nopp N.eqb gen_phiN.
- Proof.
-  constructor; simpl; try reflexivity.
-  apply gen_phiN_add. apply gen_phiN_sub. apply gen_phiN_mult.
-  intros x y EQ. apply N.eqb_eq in EQ. now subst.
- Qed.
-
-End NMORPHISM.
-
-(* Words on N : initial structure for almost-rings. *)
-Definition Nword := list N.
-Definition NwO : Nword := nil.
-Definition NwI : Nword := 1%N :: nil.
-
-Definition Nwcons n (w : Nword) : Nword :=
-  match w, n with
-  | nil, 0%N => nil
-  | _, _ => n :: w
-  end.
-
-Fixpoint Nwadd (w1 w2 : Nword) {struct w1} : Nword :=
-  match w1, w2 with
-  | n1::w1', n2:: w2' => (n1+n2)%N :: Nwadd w1' w2'
-  | nil, _ => w2
-  | _, nil => w1
-  end.
-
-Definition Nwopp (w:Nword) : Nword := Nwcons 0%N w.
-
-Definition Nwsub w1 w2 := Nwadd w1 (Nwopp w2).
-
-Fixpoint Nwscal (n : N) (w : Nword) {struct w} : Nword :=
-  match w with
-  | m :: w' => (n*m)%N :: Nwscal n w'
-  | nil => nil
-  end.
-
-Fixpoint Nwmul (w1 w2 : Nword) {struct w1} : Nword :=
-  match w1 with
-  | 0%N::w1' => Nwopp (Nwmul w1' w2)
-  | n1::w1' => Nwsub (Nwscal n1 w2) (Nwmul w1' w2)
-  | nil => nil
-  end.
-Fixpoint Nw_is0 (w : Nword) : bool :=
-  match w with
-  | nil => true
-  | 0%N :: w' => Nw_is0 w'
-  | _ => false
-  end.
-
-Fixpoint Nweq_bool (w1 w2 : Nword) {struct w1} : bool :=
-  match w1, w2 with
-  | n1::w1', n2::w2' =>
-     if N.eqb n1 n2 then Nweq_bool w1' w2' else false
-  | nil, _ => Nw_is0 w2
-  | _, nil => Nw_is0 w1
-  end.
-
-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.
-   Proof. exact (Radd_ext Reqe). Qed.
-   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext5.
-   Proof. exact (Rmul_ext Reqe). Qed.
-   Add Morphism ropp with signature (req ==> req) as ropp_ext5.
-   Proof. exact (Ropp_ext Reqe). Qed.
-
- Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
-   Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext7.
-   Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
-   Ltac norm := gen_srewrite Rsth Reqe ARth.
-   Ltac add_push := gen_add_push radd Rsth Reqe ARth.
-
- Fixpoint gen_phiNword (w : Nword) : R :=
-  match w with
-  | nil => 0
-  | n :: nil => gen_phiN rO rI radd rmul n
-  | N0 :: w' => - gen_phiNword w'
-  | n::w' => gen_phiN rO rI radd rmul n - gen_phiNword w'
-  end.
-
- Lemma gen_phiNword0_ok : forall w, Nw_is0 w = true -> gen_phiNword w == 0.
-Proof.
-induction w; simpl; intros; auto.
- reflexivity.
-
- destruct a.
-  destruct w.
-   reflexivity.
-
-   rewrite IHw; trivial.
-   apply (ARopp_zero Rsth Reqe ARth).
-
-   discriminate.
-Qed.
-
-  Lemma gen_phiNword_cons : forall w n,
-    gen_phiNword (n::w) == gen_phiN rO rI radd rmul n - gen_phiNword w.
-induction w.
- destruct n; simpl; norm.
-
- intros.
- destruct n; norm.
-Qed.
-
-  Lemma gen_phiNword_Nwcons : forall w n,
-    gen_phiNword (Nwcons n w) == gen_phiN rO rI radd rmul n - gen_phiNword w.
-destruct w; intros.
- destruct n; norm.
-
- unfold Nwcons.
- rewrite gen_phiNword_cons.
- reflexivity.
-Qed.
-
- Lemma gen_phiNword_ok : forall w1 w2,
-   Nweq_bool w1 w2 = true -> gen_phiNword w1 == gen_phiNword w2.
-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.
-
-
-Lemma Nwadd_ok : forall x y,
-   gen_phiNword (Nwadd x y) == gen_phiNword x + gen_phiNword y.
-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.
-
-Lemma Nwopp_ok : forall x, gen_phiNword (Nwopp x) == - gen_phiNword x.
-simpl.
-unfold Nwopp; simpl.
-intros.
-rewrite gen_phiNword_Nwcons; norm.
-Qed.
-
-Lemma Nwscal_ok : forall n x,
-  gen_phiNword (Nwscal n x) == gen_phiN rO rI radd rmul n * gen_phiNword x.
-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.
-
-Lemma Nwmul_ok : forall x y,
-   gen_phiNword (Nwmul x y) == gen_phiNword x * gen_phiNword y.
-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.
-constructor.
- reflexivity.
-
- reflexivity.
-
- exact Nwadd_ok.
-
- intros.
- unfold Nwsub.
- rewrite Nwadd_ok.
- rewrite Nwopp_ok.
- norm.
-
- exact Nwmul_ok.
-
- exact Nwopp_ok.
-
- exact gen_phiNword_ok.
-Qed.
-
-End NWORDMORPHISM.
-
-Section GEN_DIV.
-
-  Variables  (R : Type) (rO : R) (rI : R) (radd : R -> R -> R)
-              (rmul : R -> R -> R) (rsub : R -> R -> R) (ropp : R -> R)
-              (req : R -> R -> Prop) (C : Type) (cO : C) (cI : C)
-              (cadd : C -> C -> C) (cmul : C -> C -> C) (csub : C -> C -> C)
-              (copp : C -> C) (ceqb : C -> C -> bool) (phi : C -> R).
- Variable Rsth : Setoid_Theory R req.
- Variable Reqe : ring_eq_ext radd rmul ropp req.
- Variable ARth : almost_ring_theory rO rI radd rmul rsub ropp req.
- Variable morph : ring_morph rO rI radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi.
-
-  (* Useful tactics *)
-  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_set1.
- Ltac rrefl := gen_reflexivity Rsth.
-  Add Morphism radd with signature (req ==> req ==> req) as radd_ext.
-  Proof. exact (Radd_ext Reqe). Qed.
-  Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext.
-  Proof. exact (Rmul_ext Reqe). Qed.
-  Add Morphism ropp with signature (req ==> req) as ropp_ext.
-  Proof. exact (Ropp_ext Reqe). Qed.
-  Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext.
-  Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
- Ltac rsimpl := gen_srewrite Rsth Reqe ARth.
-
- Definition triv_div x y :=
-   if ceqb x y then (cI, cO)
-   else (cO, x).
-
- Ltac Esimpl :=repeat (progress (
-   match goal with
-   | |- context [phi cO] => rewrite (morph0 morph)
-   | |- context [phi cI] => rewrite (morph1 morph)
-   | |- context [phi (cadd ?x  ?y)] => rewrite ((morph_add morph) x y)
-   | |- context [phi (cmul ?x  ?y)] => rewrite ((morph_mul morph) x y)
-   | |- context [phi (csub ?x  ?y)] => rewrite ((morph_sub morph) x y)
-   | |- context [phi (copp ?x)] => rewrite ((morph_opp morph) x)
-   end)).
-
- Lemma triv_div_th : Ring_theory.div_theory  req cadd cmul phi triv_div.
- Proof.
-  constructor.
-  intros a b;unfold triv_div.
-  assert (X:= morph_eq morph a b);destruct (ceqb a b).
-  Esimpl.
-  rewrite X; trivial.
-  rsimpl.
-  Esimpl;  rsimpl.
-Qed.
-
- Variable zphi : Z -> R.
-
- Lemma Ztriv_div_th : div_theory req Z.add Z.mul zphi Z.quotrem.
- Proof.
-  constructor.
-  intros; generalize (Z.quotrem_eq a b); case Z.quotrem; intros; subst.
-  rewrite Z.mul_comm; rsimpl.
- Qed.
-
- Variable nphi : N -> R.
-
- Lemma Ntriv_div_th : div_theory req N.add N.mul nphi N.div_eucl.
-  constructor.
-  intros; generalize (N.div_eucl_spec a b); case N.div_eucl; intros; subst.
-  rewrite N.mul_comm; rsimpl.
- Qed.
-
-End GEN_DIV.
-
- (* syntaxification of constants in an abstract ring:
-    the inverse of gen_phiPOS *)
- Ltac inv_gen_phi_pos rI add mul t :=
-   let rec inv_cst t :=
-   match t with
-     rI => constr:(1%positive)
-   | (add rI rI) => constr:(2%positive)
-   | (add rI (add rI rI)) => constr:(3%positive)
-   | (mul (add rI rI) ?p) => (* 2p *)
-       match inv_cst p with
-         NotConstant => constr:(NotConstant)
-       | 1%positive => constr:(NotConstant) (* 2*1 is not convertible to 2 *)
-       | ?p => constr:(xO p)
-       end
-   | (add rI (mul (add rI rI) ?p)) => (* 1+2p *)
-       match inv_cst p with
-         NotConstant => constr:(NotConstant)
-       | 1%positive => constr:(NotConstant)
-       | ?p => constr:(xI p)
-       end
-   | _ => constr:(NotConstant)
-   end in
-   inv_cst t.
-
-(* The (partial) inverse of gen_phiNword *)
- Ltac inv_gen_phiNword rO rI add mul opp t :=
-   match t with
-     rO => constr:(NwO)
-   | _ =>
-     match inv_gen_phi_pos rI add mul t with
-       NotConstant => constr:(NotConstant)
-     | ?p => constr:(Npos p::nil)
-     end
-   end.
-
-
-(* The inverse of gen_phiN *)
- Ltac inv_gen_phiN rO rI add mul t :=
-   match t with
-     rO => constr:(0%N)
-   | _ =>
-     match inv_gen_phi_pos rI add mul t with
-       NotConstant => constr:(NotConstant)
-     | ?p => constr:(Npos p)
-     end
-   end.
-
-(* The inverse of gen_phiZ *)
- Ltac inv_gen_phiZ rO rI add mul opp t :=
-   match t with
-     rO => constr:(0%Z)
-   | (opp ?p) =>
-     match inv_gen_phi_pos rI add mul p with
-       NotConstant => constr:(NotConstant)
-     | ?p => constr:(Zneg p)
-     end
-   | _ =>
-     match inv_gen_phi_pos rI add mul t with
-       NotConstant => constr:(NotConstant)
-     | ?p => constr:(Zpos p)
-     end
-   end.
-
-(* A simple tactic recognizing only 0 and 1. The inv_gen_phiX above
-   are only optimisations that directly returns the reified constant
-   instead of resorting to the constant propagation of the simplification
-   algorithm. *)
-Ltac inv_gen_phi rO rI cO cI t :=
-  match t with
-  | rO => cO
-  | rI => cI
-  end.
-
-(* A simple tactic recognizing no constant *)
- Ltac inv_morph_nothing t := constr:(NotConstant).
-
-Ltac coerce_to_almost_ring set ext rspec :=
-  match type of rspec with
-  | ring_theory _ _ _ _ _ _ _ => constr:(Rth_ARth set ext rspec)
-  | semi_ring_theory _ _ _ _ _ => constr:(SRth_ARth set rspec)
-  | almost_ring_theory _ _ _ _ _ _ _ => rspec
-  | _ => fail 1 "not a valid ring theory"
-  end.
-
-Ltac coerce_to_ring_ext ext :=
-  match type of ext with
-  | ring_eq_ext _ _ _ _ => ext
-  | sring_eq_ext _ _ _ => constr:(SReqe_Reqe ext)
-  | _ => fail 1 "not a valid ring_eq_ext theory"
-  end.
-
-Ltac abstract_ring_morphism set ext rspec :=
-  match type of rspec with
-  | ring_theory _ _ _ _ _ _ _ => constr:(gen_phiZ_morph set ext rspec)
-  | semi_ring_theory _ _ _ _ _ => constr:(gen_phiN_morph set ext rspec)
-  | almost_ring_theory _ _ _ _ _ _ _ =>
-      constr:(gen_phiNword_morph set ext rspec)
-  | _ => fail 1 "bad ring structure"
-  end.
-
-Record hypo : Type := mkhypo {
-   hypo_type : Type;
-   hypo_proof : hypo_type
- }.
-
-Ltac gen_ring_pow set arth pspec :=
- match pspec with
- | None =>
-   match type of arth with
-   | @almost_ring_theory ?R ?rO ?rI ?radd ?rmul ?rsub ?ropp ?req =>
-     constr:(mkhypo (@pow_N_th R rI rmul req set))
-   | _ => fail 1 "gen_ring_pow"
-   end
- | Some ?t => constr:(t)
- end.
-
-Ltac gen_ring_sign morph sspec :=
-  match sspec with
-  | None =>
-    match type of morph with
-    | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req
-               Z ?c0 ?c1 ?cadd ?cmul ?csub ?copp ?ceqb ?phi =>
-       constr:(@mkhypo (sign_theory copp ceqb get_signZ) get_signZ_th)
-    | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req
-               ?C  ?c0 ?c1 ?cadd ?cmul ?csub ?copp ?ceqb ?phi =>
-        constr:(mkhypo (@get_sign_None_th C copp ceqb))
-    | _ => fail 2 "ring anomaly : default_sign_spec"
-    end
- | Some ?t => constr:(t)
- end.
-
-Ltac default_div_spec set reqe arth morph :=
- match type of morph with
- | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req
-               Z ?c0 ?c1 Z.add Z.mul ?csub ?copp ?ceq_b ?phi =>
-      constr:(mkhypo (Ztriv_div_th set phi))
- | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req
-               N ?c0 ?c1 N.add N.mul ?csub ?copp ?ceq_b ?phi =>
-      constr:(mkhypo (Ntriv_div_th set phi))
- | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req
-               ?C ?c0 ?c1 ?cadd ?cmul ?csub ?copp ?ceq_b ?phi =>
-      constr:(mkhypo (triv_div_th set reqe arth morph))
- | _ => fail 1 "ring anomaly : default_sign_spec"
- end.
-
-Ltac gen_ring_div set reqe arth morph dspec  :=
- match dspec with
- | None => default_div_spec set reqe arth morph
- | Some ?t => constr:(t)
- end.
-
-Ltac ring_elements set ext rspec pspec sspec dspec rk :=
-  let arth := coerce_to_almost_ring set ext rspec in
-  let ext_r := coerce_to_ring_ext ext in
-  let morph :=
-    match rk with
-    | Abstract => abstract_ring_morphism set ext rspec
-    | @Computational ?reqb_ok =>
-        match type of arth with
-        | almost_ring_theory ?rO ?rI ?add ?mul ?sub ?opp _ =>
-            constr:(IDmorph rO rI add mul sub opp set _ reqb_ok)
-        | _ => fail 2 "ring anomaly"
-        end
-    | @Morphism ?m =>
-       match type of m with
-       | ring_morph _ _ _ _ _ _ _  _ _ _ _ _ _  _ _ => m
-       | @semi_morph _ _ _ _ _ _  _ _ _ _ _  _ _   =>
-           constr:(SRmorph_Rmorph set m)
-       | _ => fail 2 "ring anomaly"
-       end
-    | _ => fail 1 "ill-formed ring kind"
-    end in
-  let p_spec := gen_ring_pow set arth pspec in
-  let s_spec := gen_ring_sign morph sspec in
-  let d_spec := gen_ring_div set ext_r arth morph dspec in
-  fun f => f arth ext_r morph p_spec s_spec d_spec.
-
-(* Given a ring structure and the kind of morphism,
-   returns 2 lemmas (one for ring, and one for ring_simplify). *)
-
- Ltac ring_lemmas set ext rspec pspec sspec dspec rk :=
-  let gen_lemma2 :=
-    match pspec with
-    | None => constr:(ring_rw_correct)
-    | Some _ => constr:(ring_rw_pow_correct)
-    end in
-  ring_elements set ext rspec pspec sspec dspec rk
-    ltac:(fun arth ext_r morph p_spec s_spec d_spec =>
-       lazymatch type of morph with
-       | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req
-               ?C ?c0 ?c1 ?cadd ?cmul ?csub ?copp ?ceq_b ?phi =>
-          let gen_lemma2_0 :=
-              constr:(gen_lemma2 R  r0 rI  radd rmul rsub ropp req set ext_r arth
-                                C  c0 c1 cadd cmul csub copp ceq_b phi morph) in
-          lazymatch p_spec with
-          | @mkhypo (power_theory _ _ _ ?Cp_phi ?rpow) ?pp_spec =>
-             let gen_lemma2_1 := constr:(gen_lemma2_0 _ Cp_phi rpow pp_spec) in
-             lazymatch d_spec with
-             | @mkhypo (div_theory _ _ _ _  ?cdiv) ?dd_spec =>
-                let gen_lemma2_2 := constr:(gen_lemma2_1 cdiv dd_spec) in
-                lazymatch s_spec with
-                | @mkhypo (sign_theory _ _ ?get_sign) ?ss_spec =>
-                  let lemma2 := constr:(gen_lemma2_2 get_sign ss_spec) in
-                  let lemma1 :=
-                    constr:(ring_correct set ext_r arth morph pp_spec dd_spec) in
-                  fun f => f arth ext_r morph lemma1 lemma2
-                | _ => fail "ring: bad sign specification"
-                end
-             | _ => fail "ring: bad coefficient division specification"
-             end
-          | _ => fail "ring: bad power specification"
-          end
-       | _ => fail "ring internal error: ring_lemmas, please report"
-       end).
-
-(* Tactic for constant *)
-Ltac isnatcst t :=
-  match t with
-    O => constr:(true)
-  | S ?p => isnatcst p
-  | _ => constr:(false)
-  end.
-
-Ltac isPcst t :=
-  match t with
-  | xI ?p => isPcst p
-  | xO ?p => isPcst p
-  | xH => constr:(true)
-  (* nat -> positive *)
-  | Pos.of_succ_nat ?n => isnatcst n
-  | _ => constr:(false)
-  end.
-
-Ltac isNcst t :=
-  match t with
-    N0 => constr:(true)
-  | Npos ?p => isPcst p
-  | _ => constr:(false)
-  end.
-
-Ltac isZcst t :=
-  match t with
-    Z0 => constr:(true)
-  | Zpos ?p => isPcst p
-  | Zneg ?p => isPcst p
-  (* injection nat -> Z *)
-  | Z.of_nat ?n => isnatcst n
-  (* injection N -> Z *)
-  | Z.of_N ?n => isNcst n
-  (* *)
-  | _ => constr:(false)
-  end.
diff --git a/plugins/setoid_ring/Integral_domain.v b/plugins/setoid_ring/Integral_domain.v
deleted file mode 100644
index f1394c51d5..0000000000
--- a/plugins/setoid_ring/Integral_domain.v
+++ /dev/null
@@ -1,53 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Export Cring.
-
-
-(* Definition of integral domains: commutative ring without zero divisor *)
-
-Class Integral_domain {R : Type}`{Rcr:Cring R} := {
- integral_domain_product:
-   forall x y, x * y == 0 -> x == 0 \/ y == 0;
- integral_domain_one_zero: not (1 == 0)}.
-
-Section integral_domain.
-
-Context {R:Type}`{Rid:Integral_domain R}.
-
-Lemma integral_domain_minus_one_zero: ~ - (1:R) == 0.
-red;intro. apply integral_domain_one_zero. 
-assert (0 == - (0:R)). cring.
-rewrite H0. rewrite <- H. cring.
-Qed.
-
-
-Definition pow (r : R) (n : nat) := Ring_theory.pow_N 1 mul r (N.of_nat n).
-
-Lemma pow_not_zero: forall p n, pow p n == 0 -> p == 0.
-induction n. unfold pow; simpl. intros. absurd (1 == 0). 
-simpl. apply integral_domain_one_zero.
- trivial. setoid_replace (pow p (S n)) with (p * (pow p n)).
-intros. 
-case (integral_domain_product p (pow p n) H). trivial. trivial. 
-unfold pow; simpl. 
-clear IHn. induction n; simpl; try cring. 
- rewrite Ring_theory.pow_pos_succ. cring. apply ring_setoid.
-apply ring_mult_comp.
-apply ring_mul_assoc.
-Qed.
-
-Lemma Rintegral_domain_pow:
-  forall c p r, ~c == 0 -> c * (pow p r) == ring0 -> p == ring0.
-intros. case (integral_domain_product c (pow p r) H0). intros; absurd (c == ring0); auto. 
-intros. apply pow_not_zero with r. trivial. Qed.   
-
-End integral_domain.
-
diff --git a/plugins/setoid_ring/NArithRing.v b/plugins/setoid_ring/NArithRing.v
deleted file mode 100644
index 8cda4ad714..0000000000
--- a/plugins/setoid_ring/NArithRing.v
+++ /dev/null
@@ -1,23 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Export Ring.
-Require Import BinPos BinNat.
-Import InitialRing.
-
-Set Implicit Arguments.
-
-Ltac Ncst t :=
-  match isNcst t with
-    true => t
-  | _ => constr:(NotConstant)
-  end.
-
-Add Ring Nr : Nth (decidable Neqb_ok, constants [Ncst]).
diff --git a/plugins/setoid_ring/Ncring.v b/plugins/setoid_ring/Ncring.v
deleted file mode 100644
index 8f3de26272..0000000000
--- a/plugins/setoid_ring/Ncring.v
+++ /dev/null
@@ -1,308 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-(* non commutative rings *)
-
-Require Import Setoid.
-Require Import BinPos.
-Require Import BinNat.
-Require Export Morphisms Setoid Bool.
-Require Export ZArith_base.
-Require Export Algebra_syntax.
-
-Set Implicit Arguments.
-
-Class Ring_ops(T:Type)
-   {ring0:T}
-   {ring1:T}
-   {add:T->T->T}
-   {mul:T->T->T}
-   {sub:T->T->T}
-   {opp:T->T}
-   {ring_eq:T->T->Prop}.
-
-Instance zero_notation(T:Type)`{Ring_ops T}:Zero T:= ring0. 
-Instance one_notation(T:Type)`{Ring_ops T}:One T:= ring1.
-Instance add_notation(T:Type)`{Ring_ops T}:Addition T:= add.
-Instance mul_notation(T:Type)`{Ring_ops T}:@Multiplication T T:= mul.
-Instance sub_notation(T:Type)`{Ring_ops T}:Subtraction T:= sub.
-Instance opp_notation(T:Type)`{Ring_ops T}:Opposite T:= opp.
-Instance eq_notation(T:Type)`{Ring_ops T}:@Equality T:= ring_eq.
-
-Class Ring `{Ro:Ring_ops}:={
- ring_setoid: Equivalence _==_;
- ring_plus_comp: Proper (_==_ ==> _==_ ==>_==_) _+_;
- ring_mult_comp: Proper (_==_ ==> _==_ ==>_==_) _*_;
- ring_sub_comp: Proper (_==_ ==> _==_ ==>_==_) _-_;
- ring_opp_comp: Proper (_==_==>_==_) -_;
- ring_add_0_l    : forall x, 0 + x == x;
- ring_add_comm   : forall x y, x + y == y + x;
- ring_add_assoc  : forall x y z, x + (y + z) == (x + y) + z;
- ring_mul_1_l    : forall x, 1 * x == x;
- ring_mul_1_r    : forall x, x * 1 == x;
- ring_mul_assoc  : forall x y z, x * (y * z) == (x * y) * z;
- ring_distr_l    : forall x y z, (x + y) * z == x * z + y * z;
- ring_distr_r    : forall x y z, z * ( x + y) == z * x + z * y;
- ring_sub_def    : forall x y, x - y == x + -y;
- ring_opp_def    : forall x, x + -x == 0
-}.
-(* inutile! je sais plus pourquoi j'ai mis ca...
-Instance ring_Ring_ops(R:Type)`{Ring R}
-  :@Ring_ops R 0 1 addition multiplication subtraction opposite equality.
-*)
-Existing Instance ring_setoid.
-Existing Instance ring_plus_comp.
-Existing Instance ring_mult_comp.
-Existing Instance ring_sub_comp.
-Existing Instance ring_opp_comp.
-
-Section Ring_power.
-
-Context {R:Type}`{Ring R}.
-
- Fixpoint pow_pos (x:R) (i:positive) {struct i}: R :=
-  match i with
-  | xH => x
-  | xO i => let p := pow_pos x i in p * p
-  | xI i => let p := pow_pos x i in x * (p * p)
-  end.
-
- Definition pow_N (x:R) (p:N) :=
-  match p with
-  | N0 => 1
-  | Npos p => pow_pos x p
-  end.
-
-End Ring_power.
-
-Definition ZN(x:Z):=
-  match x with
-    Z0 => N0
-    |Zpos p | Zneg p => Npos p
-end.
-
-Instance power_ring {R:Type}`{Ring R} : Power:=
-  {power x y := pow_N x (ZN y)}.
-
-(** Interpretation morphisms definition*)
-
-Class Ring_morphism (C R:Type)`{Cr:Ring C} `{Rr:Ring R}`{Rh:Bracket C R}:= {
-    ring_morphism0    : [0] == 0;
-    ring_morphism1    : [1] == 1;
-    ring_morphism_add : forall x y, [x + y] == [x] + [y];
-    ring_morphism_sub : forall x y, [x - y] == [x] - [y];
-    ring_morphism_mul : forall x y, [x * y] == [x] * [y];
-    ring_morphism_opp : forall  x, [-x] == -[x];
-    ring_morphism_eq  : forall x y, x == y -> [x] == [y]}.
-
-Section Ring.
-
-Context {R:Type}`{Rr:Ring R}.
-
-(* Powers *)
-
-Lemma pow_pos_comm : forall  x j,  x * pow_pos x j == pow_pos x j * x.
-Proof.
-induction j; simpl. rewrite <- ring_mul_assoc.
-rewrite <- ring_mul_assoc.
-rewrite <- IHj. rewrite (ring_mul_assoc (pow_pos x j) x (pow_pos x j)).
-rewrite <- IHj. rewrite <- ring_mul_assoc. reflexivity.
-rewrite <- ring_mul_assoc. rewrite <- IHj.
-rewrite ring_mul_assoc. rewrite IHj.
-rewrite <- ring_mul_assoc. rewrite IHj. reflexivity. reflexivity.
-Qed.
-
-Lemma pow_pos_succ : forall  x j, pow_pos x (Pos.succ j) == x * pow_pos x j.
-Proof.
-induction j; simpl.
-  rewrite IHj.
-rewrite <- (ring_mul_assoc x (pow_pos x j) (x * pow_pos x j)).
-rewrite (ring_mul_assoc (pow_pos x j) x  (pow_pos x j)).
-  rewrite <- pow_pos_comm.
-rewrite <- ring_mul_assoc. reflexivity.
-reflexivity. reflexivity.
-Qed.
-
-Lemma pow_pos_add : forall  x i j,
-  pow_pos x (i + j) == pow_pos x i * pow_pos x j.
-Proof.
-  intro x;induction i;intros.
-  rewrite Pos.xI_succ_xO;rewrite <- Pos.add_1_r.
-  rewrite <- Pos.add_diag;repeat rewrite <- Pos.add_assoc.
-  repeat rewrite IHi.
-  rewrite Pos.add_comm;rewrite Pos.add_1_r;
-  rewrite pow_pos_succ.
-  simpl;repeat rewrite ring_mul_assoc. reflexivity.
-  rewrite <- Pos.add_diag;repeat rewrite <- Pos.add_assoc.
-  repeat rewrite IHi. rewrite ring_mul_assoc. reflexivity.
-  rewrite Pos.add_comm;rewrite Pos.add_1_r;rewrite pow_pos_succ.
-   simpl. reflexivity.
- Qed.
-
- Definition id_phi_N (x:N) : N := x.
-
- Lemma pow_N_pow_N : forall  x n, pow_N x (id_phi_N n) == pow_N x n.
- Proof.
-  intros; reflexivity.
- Qed.
-
- (** Identity is a morphism *)
- (*
- Instance IDmorph : Ring_morphism _ _ _  (fun x => x).
- Proof.
-  apply (Build_Ring_morphism H6 H6 (fun x => x));intros;
-  try reflexivity. trivial.
- Qed.
-*)
- (** rings are almost rings*)
- Lemma ring_mul_0_l : forall  x, 0 * x == 0.
- Proof.
-  intro x. setoid_replace (0*x) with ((0+1)*x + -x). 
-  rewrite ring_add_0_l. rewrite ring_mul_1_l .
-  rewrite ring_opp_def . fold zero. reflexivity.
-  rewrite ring_distr_l . rewrite ring_mul_1_l .
-  rewrite <- ring_add_assoc ; rewrite ring_opp_def .
-  rewrite ring_add_comm ; rewrite ring_add_0_l ;reflexivity.
- Qed.
-
- Lemma ring_mul_0_r : forall  x, x * 0 == 0.
- Proof.
-  intro x; setoid_replace (x*0)  with (x*(0+1) + -x).
-  rewrite ring_add_0_l ; rewrite ring_mul_1_r .
-  rewrite ring_opp_def ; fold zero; reflexivity.
-
-  rewrite ring_distr_r ;rewrite ring_mul_1_r .
-  rewrite <- ring_add_assoc ; rewrite ring_opp_def .
-  rewrite ring_add_comm ; rewrite ring_add_0_l ;reflexivity.
- Qed.
-
- Lemma ring_opp_mul_l : forall x y, -(x * y) == -x * y.
- Proof.
-  intros x y;rewrite <- (ring_add_0_l (- x * y)).
-  rewrite ring_add_comm .
-  rewrite <- (ring_opp_def (x*y)).
-  rewrite ring_add_assoc .
-  rewrite <- ring_distr_l.
-  rewrite (ring_add_comm (-x));rewrite ring_opp_def .
-  rewrite ring_mul_0_l;rewrite ring_add_0_l ;reflexivity.
- Qed.
-
-Lemma ring_opp_mul_r : forall x y, -(x * y) == x * -y.
- Proof.
-  intros x y;rewrite <- (ring_add_0_l (x * - y)).
-  rewrite ring_add_comm .
-  rewrite <- (ring_opp_def (x*y)).
-  rewrite ring_add_assoc .
-  rewrite <- ring_distr_r .
-  rewrite (ring_add_comm (-y));rewrite ring_opp_def .
-  rewrite ring_mul_0_r;rewrite ring_add_0_l ;reflexivity.
- Qed.
-
- Lemma ring_opp_add : forall x y, -(x + y) == -x + -y.
- Proof.
-  intros x y;rewrite <- (ring_add_0_l  (-(x+y))).
-  rewrite <- (ring_opp_def  x).
-  rewrite <- (ring_add_0_l  (x + - x + - (x + y))).
-  rewrite <- (ring_opp_def  y).
-  rewrite (ring_add_comm  x).
-  rewrite (ring_add_comm  y).
-  rewrite <- (ring_add_assoc  (-y)).
-  rewrite <- (ring_add_assoc  (- x)).
-  rewrite (ring_add_assoc   y).
-  rewrite (ring_add_comm  y).
-  rewrite <- (ring_add_assoc   (- x)).
-  rewrite (ring_add_assoc  y).
-  rewrite (ring_add_comm  y);rewrite ring_opp_def .
-  rewrite (ring_add_comm  (-x) 0);rewrite ring_add_0_l .
-  rewrite ring_add_comm; reflexivity.
- Qed.
-
- Lemma ring_opp_opp : forall  x, - -x == x.
- Proof.
-  intros x; rewrite <- (ring_add_0_l (- -x)).
-  rewrite <- (ring_opp_def x).
-  rewrite <- ring_add_assoc ; rewrite ring_opp_def .
-  rewrite (ring_add_comm  x); rewrite ring_add_0_l . reflexivity.
- Qed.
-
- Lemma ring_sub_ext :
-      forall  x1 x2, x1 == x2 -> forall  y1 y2, y1 == y2 -> x1 - y1 == x2 - y2.
- Proof.
-  intros.
-  setoid_replace (x1 - y1)  with (x1 + -y1).
-  setoid_replace (x2 - y2)  with (x2 + -y2).
-  rewrite H;rewrite H0;reflexivity.
-  rewrite ring_sub_def. reflexivity.
-  rewrite ring_sub_def. reflexivity.
- Qed.
-
- Ltac mrewrite :=
-   repeat first
-     [ rewrite ring_add_0_l
-     | rewrite <- (ring_add_comm 0)
-     | rewrite ring_mul_1_l
-     | rewrite ring_mul_0_l
-     | rewrite ring_distr_l
-     | reflexivity
-     ].
-
- Lemma ring_add_0_r : forall  x, (x + 0) == x.
- Proof. intros; mrewrite. Qed.
-
- 
- Lemma ring_add_assoc1 : forall x y z, (x + y) + z == (y + z) + x.
- Proof.
-  intros;rewrite <- (ring_add_assoc x).
-  rewrite (ring_add_comm x);reflexivity.
- Qed.
-
- Lemma ring_add_assoc2 : forall x y z, (y + x) + z == (y + z) + x.
- Proof.
-  intros; repeat rewrite <- ring_add_assoc.
-   rewrite (ring_add_comm x); reflexivity.
- Qed.
-
- Lemma ring_opp_zero : -0 == 0.
- Proof.
-  rewrite <- (ring_mul_0_r 0). rewrite ring_opp_mul_l.
-  repeat rewrite ring_mul_0_r. reflexivity.
- Qed.
-
-End Ring.
-
-(** Some simplification tactics*)
-Ltac gen_reflexivity := reflexivity.
- 
-Ltac gen_rewrite :=
-  repeat first
-     [ reflexivity
-     | progress rewrite ring_opp_zero
-     | rewrite ring_add_0_l
-     | rewrite ring_add_0_r
-     | rewrite ring_mul_1_l 
-     | rewrite ring_mul_1_r
-     | rewrite ring_mul_0_l 
-     | rewrite ring_mul_0_r 
-     | rewrite ring_distr_l 
-     | rewrite ring_distr_r 
-     | rewrite ring_add_assoc 
-     | rewrite ring_mul_assoc
-     | progress rewrite ring_opp_add 
-     | progress rewrite ring_sub_def 
-     | progress rewrite <- ring_opp_mul_l 
-     | progress rewrite <- ring_opp_mul_r ].
-
-Ltac gen_add_push x :=
-repeat (match goal with
-  | |- context [(?y + x) + ?z] =>
-     progress rewrite (ring_add_assoc2 x y z)
-  | |- context [(x + ?y) + ?z] =>
-     progress rewrite  (ring_add_assoc1 x y z)
-  end).
diff --git a/plugins/setoid_ring/Ncring_initial.v b/plugins/setoid_ring/Ncring_initial.v
deleted file mode 100644
index e40ef6056d..0000000000
--- a/plugins/setoid_ring/Ncring_initial.v
+++ /dev/null
@@ -1,214 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Import ZArith_base.
-Require Import Zpow_def.
-Require Import BinInt.
-Require Import BinNat.
-Require Import Setoid.
-Require Import BinList.
-Require Import BinPos.
-Require Import BinNat.
-Require Import BinInt.
-Require Import Setoid.
-Require Export Ncring.
-Require Export Ncring_polynom.
-
-Set Implicit Arguments.
-
-(* An object to return when an expression is not recognized as a constant *)
-Definition NotConstant := false.
-
-(** Z is a ring and a setoid*)
-
-Lemma Zsth : Equivalence (@eq Z).
-Proof. exact Z.eq_equiv. Qed.
-
-Instance Zops:@Ring_ops Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (@eq Z).
-Defined.
-
-Instance Zr: (@Ring _ _ _ _ _ _ _ _ Zops).
-Proof.
-constructor; try apply Zsth; try solve_proper.
- exact Z.add_comm. exact Z.add_assoc.
- exact Z.mul_1_l.  exact Z.mul_1_r. exact Z.mul_assoc.
- exact Z.mul_add_distr_r.  intros; apply Z.mul_add_distr_l.  exact Z.sub_diag.
-Defined.
-
-(*Instance ZEquality: @Equality Z:= (@eq Z).*)
-
-(** Two generic morphisms from Z to (arbitrary) rings, *)
-(**second one is more convenient for proofs but they are ext. equal*)
-Section ZMORPHISM.
-Context {R:Type}`{Ring R}.
-
- Ltac rrefl := reflexivity.
-
- Fixpoint gen_phiPOS1 (p:positive) : R :=
-  match p with
-  | xH => 1
-  | xO p => (1 + 1) * (gen_phiPOS1 p)
-  | xI p => 1 + ((1 + 1) * (gen_phiPOS1 p))
-  end.
-
- Fixpoint gen_phiPOS (p:positive) : R :=
-  match p with
-  | xH => 1
-  | xO xH => (1 + 1)
-  | xO p => (1 + 1) * (gen_phiPOS p)
-  | xI xH => 1 + (1 +1)
-  | xI p => 1 + ((1 + 1) * (gen_phiPOS p))
-  end.
-
- Definition gen_phiZ1 z :=
-  match z with
-  | Zpos p => gen_phiPOS1 p
-  | Z0 => 0
-  | Zneg p => -(gen_phiPOS1 p)
-  end.
-
- Definition gen_phiZ z :=
-  match z with
-  | Zpos p => gen_phiPOS p
-  | Z0 => 0
-  | Zneg p => -(gen_phiPOS p)
-  end.
- Declare Scope ZMORPHISM.
- Notation "[ x ]" := (gen_phiZ x) : ZMORPHISM.
- Open Scope ZMORPHISM.
-
- Definition get_signZ z :=
-  match z with
-  | Zneg p => Some (Zpos p)
-  | _ => None
-  end.
-
-   Ltac norm := gen_rewrite.
-   Ltac add_push :=  Ncring.gen_add_push.
-Ltac rsimpl := simpl.
-
- Lemma same_gen : forall x, gen_phiPOS1 x == gen_phiPOS x.
- Proof.
-  induction x;rsimpl.
-  rewrite IHx. destruct x;simpl;norm.
-  rewrite IHx;destruct x;simpl;norm.
-  reflexivity.
- Qed.
-
- Lemma ARgen_phiPOS_Psucc : forall x,
-   gen_phiPOS1 (Pos.succ x) == 1 + (gen_phiPOS1 x).
- Proof.
-  induction x;rsimpl;norm.
- rewrite IHx. gen_rewrite. add_push 1. reflexivity.
- Qed.
-
- Lemma ARgen_phiPOS_add : forall x y,
-   gen_phiPOS1 (x + y) == (gen_phiPOS1 x) + (gen_phiPOS1 y).
- Proof.
-  induction x;destruct y;simpl;norm.
-  rewrite Pos.add_carry_spec.
-  rewrite ARgen_phiPOS_Psucc.
-  rewrite IHx;norm.
-  add_push (gen_phiPOS1 y);add_push 1;reflexivity.
-  rewrite IHx;norm;add_push (gen_phiPOS1 y);reflexivity.
-  rewrite ARgen_phiPOS_Psucc;norm;add_push 1;reflexivity.
-  rewrite IHx;norm;add_push(gen_phiPOS1 y); add_push 1;reflexivity.
-  rewrite IHx;norm;add_push(gen_phiPOS1 y);reflexivity.
-  add_push 1;reflexivity.
-  rewrite ARgen_phiPOS_Psucc;norm;add_push 1;reflexivity.
- Qed.
-
- Lemma ARgen_phiPOS_mult :
-   forall x y, gen_phiPOS1 (x * y) == gen_phiPOS1 x * gen_phiPOS1 y.
- Proof.
-  induction x;intros;simpl;norm.
-  rewrite ARgen_phiPOS_add;simpl;rewrite IHx;norm.
-  rewrite IHx;reflexivity.
- Qed.
-
-
-(*morphisms are extensionally equal*)
- Lemma same_genZ : forall x, [x] == gen_phiZ1 x.
- Proof.
-  destruct x;rsimpl; try rewrite same_gen; reflexivity.
- Qed.
-
- Lemma gen_Zeqb_ok : forall x y,
-   Zeq_bool x y = true -> [x] == [y].
- Proof.
-  intros x y H7.
-  assert (H10 := Zeq_bool_eq x y H7);unfold IDphi in H10.
-  rewrite H10;reflexivity.
- Qed.
-
- Lemma gen_phiZ1_add_pos_neg : forall x y,
- gen_phiZ1 (Z.pos_sub x y)
- == gen_phiPOS1 x + -gen_phiPOS1 y.
- Proof.
-  intros x y.
-  generalize (Z.pos_sub_discr x y).
-  destruct (Z.pos_sub x y) as [|p|p]; intros; subst.
-  - now rewrite ring_opp_def.
-  - rewrite ARgen_phiPOS_add;simpl;norm.
-    add_push (gen_phiPOS1 p). rewrite ring_opp_def;norm.
-  - rewrite ARgen_phiPOS_add;simpl;norm.
-    rewrite ring_opp_def;norm.
- Qed.
-
- Lemma match_compOpp : forall x (B:Type) (be bl bg:B),
-  match CompOpp x with Eq => be | Lt => bl | Gt => bg end
-  = match x with Eq => be | Lt => bg | Gt => bl end.
- Proof. destruct x;simpl;intros;trivial. Qed.
-
- Lemma gen_phiZ_add : forall x y, [x + y] == [x] + [y].
- Proof.
-  intros x y; repeat rewrite same_genZ; generalize x y;clear x y.
-  induction x;destruct y;simpl;norm.
-  apply ARgen_phiPOS_add.
-  apply gen_phiZ1_add_pos_neg. 
-   rewrite gen_phiZ1_add_pos_neg. rewrite ring_add_comm.
-reflexivity.
- rewrite ARgen_phiPOS_add. rewrite ring_opp_add. reflexivity.
-Qed.
-
-Lemma gen_phiZ_opp : forall x, [- x] == - [x].
- Proof.
-  intros x. repeat rewrite same_genZ. generalize x ;clear x.
-  induction x;simpl;norm.
-  rewrite ring_opp_opp.  reflexivity.
- Qed.
-
- Lemma gen_phiZ_mul : forall x y, [x * y] == [x] * [y].
- Proof.
-  intros x y;repeat rewrite same_genZ.
-  destruct x;destruct y;simpl;norm;
-  rewrite  ARgen_phiPOS_mult;try (norm;fail).
-  rewrite ring_opp_opp ;reflexivity.
- Qed.
-
- Lemma gen_phiZ_ext : forall x y : Z, x = y -> [x] == [y].
- Proof. intros;subst;reflexivity. Qed.
-
-Declare Equivalent Keys bracket gen_phiZ.
-(*proof that [.] satisfies morphism specifications*)
-Global Instance gen_phiZ_morph :
-(@Ring_morphism (Z:Type) R _ _ _ _ _ _ _ Zops Zr _ _ _ _ _ _ _ _ _ gen_phiZ) . (* beurk!*)
- apply Build_Ring_morphism; simpl;try reflexivity.
-   apply gen_phiZ_add. intros. rewrite ring_sub_def.
-replace (x-y)%Z with (x + (-y))%Z.
-now rewrite gen_phiZ_add, gen_phiZ_opp, ring_sub_def.
-reflexivity.
- apply gen_phiZ_mul. apply gen_phiZ_opp. apply gen_phiZ_ext.
- Defined.
-
-End ZMORPHISM.
-
-Instance multiplication_phi_ring{R:Type}`{Ring R} : Multiplication  :=
-  {multiplication x y := (gen_phiZ x) * y}.
diff --git a/plugins/setoid_ring/Ncring_polynom.v b/plugins/setoid_ring/Ncring_polynom.v
deleted file mode 100644
index 048c8eecf9..0000000000
--- a/plugins/setoid_ring/Ncring_polynom.v
+++ /dev/null
@@ -1,594 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-(*  A <X1,...,Xn>: non commutative polynomials on a commutative ring A *)
-
-Set Implicit Arguments.
-Require Import Setoid.
-Require Import BinList.
-Require Import BinPos.
-Require Import BinNat.
-Require Import BinInt.
-Require Export Ring_polynom. (* n'utilise que PExpr *)
-Require Export Ncring.
-
-Section MakeRingPol.
-
-Context (C R:Type) `{Rh:Ring_morphism C R}.
-
-Variable phiCR_comm: forall (c:C)(x:R), x * [c] == [c] * x.
-
- 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. 
-    (* PX P i n Q represents P * X_i^n + Q *)
-Definition cO:C . exact ring0. Defined.
-Definition cI:C . exact ring1. Defined.
-
- Definition P0 := Pc 0.
- Definition P1 := Pc 1.
-
-Variable Ceqb:C->C->bool.
-#[universes(template)]
-Class Equalityb (A : Type):= {equalityb : A -> A -> bool}.
-Notation "x =? y" := (equalityb x y) (at level 70, no associativity).
-Variable Ceqb_eq: forall x y:C, Ceqb x y = true -> (x == y).
-
-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.
-
-(* Q quelconque *)
-
-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.
-
- Lemma Peq_ok : forall P P',
-    (P =? P') = true -> forall l, P@l == P'@ l.
- Proof.
- induction P;destruct P';simpl;intros ;try easy.
- - now apply ring_morphism_eq, Ceqb_eq.
- - specialize (IHP1 P'1). specialize (IHP2 P'2).
-   simpl in IHP1, IHP2.
-   destruct (Pos.compare_spec p p1); try discriminate;
-   destruct (Pos.compare_spec p0 p2); try discriminate.
-   destruct (Peq P2 P'1); try discriminate.
-   subst; now rewrite IHP1, IHP2.
- Qed.
-
- Lemma Pphi0 : forall l, P0@l == 0.
- Proof.
-  intros;simpl. 
- rewrite ring_morphism0. reflexivity.
- Qed.
-
- Lemma Pphi1 : forall l,  P1@l == 1.
- Proof.
-  intros;simpl; rewrite ring_morphism1. reflexivity.
- Qed.
-
- 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.
- Proof.
-  intros l P i n Q;unfold mkPX.
-  destruct P;try (simpl;reflexivity).
-  assert (Hh := ring_morphism_eq  c 0). 
-  simpl; case_eq (Ceqb c 0);simpl;try reflexivity.
-  intros.
-  rewrite Hh. rewrite ring_morphism0.
-  rsimpl. apply Ceqb_eq. trivial.
-  destruct (Pos.compare_spec i p).
-  assert (Hh := @Peq_ok P3 P0). case_eq (P3=? P0). intro. simpl. 
-  rewrite Hh. 
-  rewrite Pphi0. rsimpl. rewrite Pos.add_comm. rewrite pow_pos_add;rsimpl.
-  subst;trivial. reflexivity. trivial. intros. simpl. reflexivity. simpl. reflexivity.
- simpl. reflexivity.
- Qed.
-
-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.
-
- Lemma PaddCl_ok : forall c P l, (PaddCl c P)@l == [c] + P@l .
- Proof.
-  induction P; simpl; intros; Esimpl; try reflexivity.
- rewrite IHP2. rsimpl. 
-rewrite (ring_add_comm  (P2 @ l * pow_pos (nth 0 p l) p0) [c]).
-reflexivity.
- Qed.
-
- Lemma PmulC_aux_ok : forall c P l, (PmulC_aux P c)@l ==  P@l * [c].
- Proof.
-  induction P;simpl;intros.  rewrite ring_morphism_mul.
-try reflexivity.
-  simpl. Esimpl.  rewrite IHP1;rewrite IHP2;rsimpl. 
-  Qed.
-
- Lemma PmulC_ok : forall c P l, (PmulC P c)@l ==  P@l * [c].
- Proof.
-  intros c P l; unfold PmulC.
-  assert (Hh:= ring_morphism_eq c 0);case_eq (c =? 0). intros.
-  rewrite Hh;Esimpl. apply Ceqb_eq;trivial. 
-  assert (H1h:= ring_morphism_eq c 1);case_eq (c =? 1);intros.
-  rewrite H1h;Esimpl. apply Ceqb_eq;trivial.
-  apply PmulC_aux_ok.
- Qed.
-
- Lemma Popp_ok : forall P l, (--P)@l == - P@l.
- Proof.
-  induction P;simpl;intros.
-  Esimpl.
-  rewrite IHP1;rewrite IHP2;rsimpl.
- Qed.
-
- 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.
-induction Q; reflexivity.
-Qed.
-
-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).
-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.
-
-Lemma Padd_ok : forall P Q l, (P ++ Q) @ l == P @ l + Q @ l.
-intro P. elim (PaddX_ok2 P); auto.
-Qed.
-
-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.
-intro P2. elim (PaddX_ok2 P2); auto.
-Qed.
-
- Lemma Psub_ok : forall P' P l, (P -- P')@l == P@l - P'@l.
-unfold Psub. intros. rewrite Padd_ok. rewrite Popp_ok. rsimpl.
- Qed.
-
- Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
-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.
- Proof.
-  intros. unfold Psquare. apply Pmul_ok.
- Qed.
-
- (** Definition of polynomial expressions *)
-
-(*
- Inductive PExpr : Type :=
-  | PEc : C -> PExpr
-  | PEX : positive -> PExpr
-  | PEadd : PExpr -> PExpr -> PExpr
-  | PEsub : PExpr -> PExpr -> PExpr
-  | PEmul : PExpr -> PExpr -> PExpr
-  | PEopp : PExpr -> PExpr
-  | PEpow : PExpr -> N -> PExpr.
-*)
-
- (** Specification of the power function *)
- Section POWER.
-  Variable Cpow : Set.
-  Variable Cp_phi : N -> Cpow.
-  Variable rpow : R -> Cpow -> R.
-
-  Record power_theory : Prop := mkpow_th {
-    rpow_pow_N : forall r n,  (rpow r (Cp_phi n))== (pow_N r n)
-  }.
-
- End POWER.
- Variable Cpow : Set.
- Variable Cp_phi : N -> Cpow.
- Variable rpow : R -> Cpow -> R.
- Variable pow_th : power_theory Cp_phi rpow.
-
- (** evaluation of polynomial expressions towards R *)
-
- Fixpoint PEeval (l:list R) (pe:PExpr C) {struct pe} : R :=
-   match pe with
-   | PEO => 0
-   | PEI => 1
-   | PEc c => [c]
-   | PEX _ j => nth 0 j l
-   | PEadd pe1 pe2 => (PEeval l pe1) + (PEeval l pe2)
-   | PEsub pe1 pe2 => (PEeval l pe1) - (PEeval l pe2)
-   | PEmul pe1 pe2 => (PEeval l pe1) * (PEeval l pe2)
-   | PEopp pe1 => - (PEeval l pe1)
-   | PEpow pe1 n => rpow (PEeval l pe1) (Cp_phi n)
-   end.
-
-Strategy expand [PEeval].
-
- Definition mk_X j := mkX j.
-
- (** Correctness proofs *)
-
- Lemma mkX_ok : forall p l, nth 0 p l == (mk_X p) @ l.
- Proof.
-  destruct p;simpl;intros;Esimpl;trivial.
- Qed.
-
- Ltac Esimpl3 :=
-  repeat match goal with
-  | |- context [(?P1 ++ ?P2)@?l] => rewrite (Padd_ok P1 P2 l)
-  | |- context [(?P1 -- ?P2)@?l] => rewrite (Psub_ok P1 P2 l)
-  end;try Esimpl2;try reflexivity;try apply ring_add_comm.
-
-(* Power using the chinise algorithm *)
-
-Section POWER2.
-  Variable subst_l : Pol -> Pol.
-  Fixpoint Ppow_pos (res P:Pol) (p:positive){struct p} : Pol :=
-   match p with
-   | xH => subst_l (Pmul P res)
-   | xO p => Ppow_pos (Ppow_pos res P p) P p
-   | xI p => subst_l (Pmul P (Ppow_pos (Ppow_pos res P p) P p))
-   end.
-
-  Definition Ppow_N P n :=
-   match n with
-   | N0 => P1
-   | Npos p => Ppow_pos P1 P p
-   end.
-
-  Fixpoint pow_pos_gen (R:Type)(m:R->R->R)(x:R) (i:positive) {struct i}: R :=
-  match i with
-  | xH => x
-  | xO i => let p := pow_pos_gen m x i in m p p
-  | xI i => let p := pow_pos_gen m x i in m x (m p p)
-  end.
-
-Lemma Ppow_pos_ok : forall l, (forall P, subst_l P@l == P@l) ->
-         forall res P p, (Ppow_pos res P p)@l == (pow_pos_gen Pmul P p)@l * res@l.
-  Proof.
-   intros l subst_l_ok res P p. generalize res;clear res.
-   induction p;simpl;intros. try rewrite subst_l_ok.
- repeat rewrite Pmul_ok. repeat rewrite IHp.
-   rsimpl. repeat rewrite Pmul_ok. repeat rewrite IHp. rsimpl.
- try rewrite subst_l_ok.
- repeat rewrite Pmul_ok. reflexivity.
-  Qed.
-
-Definition pow_N_gen (R:Type)(x1:R)(m:R->R->R)(x:R) (p:N) :=
-  match p with
-  | N0 => x1
-  | Npos p => pow_pos_gen m x p
-  end.
-
-  Lemma Ppow_N_ok : forall l,  (forall P, subst_l P@l == P@l) ->
-         forall P n, (Ppow_N P n)@l == (pow_N_gen P1 Pmul P n)@l.
-  Proof.  destruct n;simpl. reflexivity. rewrite Ppow_pos_ok; trivial. Esimpl.  Qed.
-
- End POWER2.
-
- (** Normalization and rewriting *)
-
- Section NORM_SUBST_REC.
-  Let subst_l (P:Pol) := P.
-  Let Pmul_subst P1 P2 := subst_l (Pmul P1 P2).
-  Let Ppow_subst := Ppow_N subst_l.
-
-  Fixpoint norm_aux (pe:PExpr C) : Pol :=
-   match pe with
-   | PEO => Pc cO
-   | PEI => Pc cI
-   | PEc c => Pc c
-   | PEX _ j => mk_X j
-   | PEadd pe1 (PEopp pe2) =>
-     Psub (norm_aux pe1) (norm_aux pe2)
-   | PEadd pe1 pe2 => Padd (norm_aux  pe1) (norm_aux pe2)
-   | PEsub pe1 pe2 => Psub (norm_aux pe1) (norm_aux pe2)
-   | PEmul pe1 pe2 => Pmul (norm_aux pe1) (norm_aux pe2)
-   | PEopp pe1 => Popp (norm_aux pe1)
-   | PEpow pe1 n => Ppow_N (fun p => p) (norm_aux pe1) n
-   end.
-
-  Definition norm_subst pe := subst_l (norm_aux pe).
-
- 
- Lemma norm_aux_spec :
-     forall l pe, 
-       PEeval l pe == (norm_aux pe)@l.
-  Proof.
-   intros.
-   induction pe.
-   - now simpl; rewrite <- ring_morphism0.
-   - now simpl; rewrite <- ring_morphism1.
-   - Esimpl3. 
-   - Esimpl3. 
-   - simpl.
-     rewrite IHpe1;rewrite IHpe2.
-     destruct pe2; Esimpl3. 
-     unfold Psub.
-     destruct pe1; destruct pe2; rewrite Padd_ok; rewrite Popp_ok; reflexivity.
-   - simpl. unfold Psub. rewrite IHpe1;rewrite IHpe2.
-     now destruct pe1; 
-       [destruct pe2; rewrite Padd_ok; rewrite Popp_ok; Esimpl3 | Esimpl3..]. 
-   - simpl. rewrite IHpe1;rewrite IHpe2. rewrite Pmul_ok. reflexivity.
-   - now simpl; rewrite IHpe; Esimpl3. 
-   - simpl.
-     rewrite Ppow_N_ok; (intros;try reflexivity). 
-     rewrite rpow_pow_N; [| now apply pow_th]. 
-     induction n;simpl; [now Esimpl3|]. 
-     induction p; simpl; trivial.
-     + try rewrite IHp;try rewrite IHpe;
-         repeat rewrite Pms_ok; repeat rewrite Pmul_ok;reflexivity.
-     + rewrite Pmul_ok. 
-       try rewrite IHp;try rewrite IHpe; repeat rewrite Pms_ok;
-         repeat rewrite Pmul_ok;reflexivity. 
-  Qed.
-
- Lemma norm_subst_spec :
-     forall l pe, 
-       PEeval l pe == (norm_subst pe)@l.
- Proof.
-  intros;unfold norm_subst.
-  unfold subst_l.  apply norm_aux_spec. 
- Qed.
-
- End NORM_SUBST_REC.
-
- Fixpoint interp_PElist (l:list R) (lpe:list (PExpr C * PExpr C)) {struct lpe} : Prop :=
-   match lpe with
-   | nil => True
-   | (me,pe)::lpe =>
-     match lpe with
-     | nil => PEeval l me == PEeval l pe
-     | _ => PEeval l me == PEeval l pe /\ interp_PElist l lpe
-     end
-  end.
-
-
- Lemma norm_subst_ok : forall l pe,
-   PEeval l pe == (norm_subst pe)@l.
- Proof.
-   intros;apply norm_subst_spec. 
-  Qed.
-
-
- Lemma ring_correct : forall l pe1 pe2,
-   (norm_subst pe1 =? norm_subst pe2) = true ->
-   PEeval l pe1 == PEeval l pe2.
- Proof.
-  simpl;intros.
-  do 2 (rewrite (norm_subst_ok l);trivial).
-  apply Peq_ok;trivial.
- Qed.
-
-End MakeRingPol.
diff --git a/plugins/setoid_ring/Ncring_tac.v b/plugins/setoid_ring/Ncring_tac.v
deleted file mode 100644
index 65233873b1..0000000000
--- a/plugins/setoid_ring/Ncring_tac.v
+++ /dev/null
@@ -1,328 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Import List.
-Require Import Setoid.
-Require Import BinPos.
-Require Import BinList.
-Require Import Znumtheory.
-Require Export Morphisms Setoid Bool.
-Require Import ZArith.
-Require Import Algebra_syntax.
-Require Export Ncring.
-Require Import Ncring_polynom.
-Require Import Ncring_initial.
-
-
-Set Implicit Arguments.
-
-Class nth (R:Type) (t:R) (l:list R) (i:nat).
-
-Instance  Ifind0 (R:Type) (t:R) l
- : nth t(t::l) 0.
-Defined.
-
-Instance  IfindS (R:Type) (t2 t1:R) l i 
- {_:nth t1 l i} 
- : nth t1 (t2::l) (S i) | 1.
-Defined.
-
-Class closed (T:Type) (l:list T).
-
-Instance Iclosed_nil T 
- : closed (T:=T) nil.
-Defined.
-
-Instance Iclosed_cons T t (l:list T) 
- {_:closed l} 
- : closed (t::l).
-Defined.
-
-Class reify (R:Type)`{Rr:Ring (T:=R)} (e:PExpr Z) (lvar:list R) (t:R).
-
-Instance  reify_zero (R:Type)  lvar op
- `{Ring (T:=R)(ring0:=op)}
- : reify (ring0:=op)(PEc 0%Z) lvar op.
-Defined.
-
-Instance  reify_one (R:Type)  lvar op
- `{Ring (T:=R)(ring1:=op)}
- : reify (ring1:=op) (PEc 1%Z) lvar op.
-Defined.
-
-Instance  reifyZ0 (R:Type)  lvar 
- `{Ring (T:=R)}
- : reify (PEc Z0) lvar Z0|11.
-Defined.
-
-Instance  reifyZpos (R:Type)  lvar (p:positive)
- `{Ring (T:=R)}
- : reify (PEc (Zpos p)) lvar (Zpos p)|11.
-Defined.
-
-Instance  reifyZneg (R:Type)  lvar (p:positive)
- `{Ring (T:=R)}
- : reify (PEc (Zneg p)) lvar (Zneg p)|11.
-Defined.
-
-Instance  reify_add (R:Type)
-  e1 lvar t1 e2 t2 op 
- `{Ring (T:=R)(add:=op)}
- {_:reify (add:=op) e1 lvar t1}
- {_:reify (add:=op) e2 lvar t2}
- : reify (add:=op) (PEadd e1 e2) lvar (op t1 t2).
-Defined.
-
-Instance  reify_mul (R:Type) 
-  e1 lvar t1 e2 t2 op 
- `{Ring (T:=R)(mul:=op)}
- {_:reify (mul:=op) e1 lvar t1}
- {_:reify (mul:=op) e2 lvar t2}
- : reify (mul:=op) (PEmul e1 e2) lvar (op t1 t2)|10.
-Defined.
-
-Instance  reify_mul_ext (R:Type) `{Ring R}
-  lvar (z:Z) e2 t2 
- `{Ring (T:=R)}
- {_:reify e2 lvar t2}
- : reify (PEmul (PEc z) e2) lvar
-      (@multiplication Z _ _ z t2)|9.
-Defined.
-
-Instance  reify_sub (R:Type)
- e1 lvar t1 e2 t2 op
- `{Ring (T:=R)(sub:=op)}
- {_:reify (sub:=op) e1 lvar t1}
- {_:reify (sub:=op) e2 lvar t2}
- : reify (sub:=op) (PEsub e1 e2) lvar (op t1 t2).
-Defined.
-
-Instance  reify_opp (R:Type)
- e1 lvar t1  op
- `{Ring (T:=R)(opp:=op)}
- {_:reify (opp:=op) e1 lvar t1}
- : reify (opp:=op) (PEopp e1) lvar (op t1).
-Defined.
-
-Instance  reify_pow (R:Type) `{Ring R}
- e1 lvar t1 n 
- `{Ring (T:=R)}
- {_:reify e1 lvar t1}
- : reify (PEpow e1 n) lvar (pow_N t1 n)|1.
-Defined.
-
-Instance  reify_var (R:Type) t lvar i 
- `{nth R t lvar i}
- `{Rr: Ring (T:=R)}
- : reify (Rr:= Rr) (PEX Z (Pos.of_succ_nat i))lvar t
- | 100.
-Defined.
-
-Class reifylist (R:Type)`{Rr:Ring (T:=R)} (lexpr:list (PExpr Z)) (lvar:list R) 
-  (lterm:list R).
-
-Instance reify_nil (R:Type) lvar 
- `{Rr: Ring (T:=R)}
- : reifylist (Rr:= Rr) nil lvar (@nil R).
-Defined.
-
-Instance reify_cons (R:Type) e1 lvar t1 lexpr2 lterm2
- `{Rr: Ring (T:=R)}
- {_:reify (Rr:= Rr) e1 lvar t1}
- {_:reifylist (Rr:= Rr) lexpr2 lvar lterm2} 
- : reifylist (Rr:= Rr) (e1::lexpr2) lvar (t1::lterm2).
-Defined.
-
-Definition list_reifyl (R:Type) lexpr lvar lterm 
- `{Rr: Ring (T:=R)}
- {_:reifylist (Rr:= Rr) lexpr lvar lterm}
- `{closed (T:=R) lvar}  := (lvar,lexpr).
-
-Unset Implicit Arguments.
-
-Ltac lterm_goal g :=
-  match g with
-  | ?t1 == ?t2 => constr:(t1::t2::nil)
-  | ?t1 = ?t2 => constr:(t1::t2::nil)
-  | (_ ?t1 ?t2) => constr:(t1::t2::nil)
-  end.
-
-Lemma Zeqb_ok: forall x y : Z, Zeq_bool x y = true -> x == y.
- intros x y H. rewrite (Zeq_bool_eq x y H). reflexivity. Qed. 
-
-
-Ltac reify_goal lvar lexpr lterm:=
-  (*idtac lvar; idtac lexpr; idtac lterm;*)
-  match lexpr with
-     nil => idtac
-   | ?e1::?e2::_ =>  
-        match goal with
-          |- (?op ?u1 ?u2) =>
-           change (op 
-             (@PEeval Z _ _ _ _ _ _ _ _ _ (@gen_phiZ _ _ _ _ _ _ _ _ _) N
-                      (fun n:N => n) (@pow_N _ _ _ _ _ _ _ _ _)
-                      lvar e1)
-             (@PEeval Z _ _ _ _ _ _ _ _ _ (@gen_phiZ _ _ _ _ _ _ _ _ _) N
-                      (fun n:N => n) (@pow_N _ _ _ _ _ _ _ _ _)
-                      lvar e2))
-        end
-  end. 
-
-Lemma comm: forall (R:Type)`{Ring R}(c : Z) (x : R),
-  x * (gen_phiZ c) == (gen_phiZ c) * x.
-induction c. intros. simpl. gen_rewrite. simpl. intros.
-rewrite <- same_gen.
-induction p. simpl.  gen_rewrite. rewrite IHp. reflexivity.
-simpl.  gen_rewrite. rewrite IHp. reflexivity.
-simpl.  gen_rewrite. 
-simpl. intros. rewrite <- same_gen.
-induction p. simpl. generalize IHp. clear IHp.
-gen_rewrite. intro IHp.  rewrite IHp. reflexivity.
-simpl. generalize IHp. clear IHp.
-gen_rewrite. intro IHp.  rewrite IHp. reflexivity.
-simpl.  gen_rewrite. Qed.
-
-Ltac ring_gen :=
-   match goal with
-     |- ?g => let lterm := lterm_goal g in 
-       match eval red in (list_reifyl (lterm:=lterm)) with
-         | (?fv, ?lexpr) => 
-           (*idtac "variables:";idtac fv;
-           idtac "terms:"; idtac lterm;
-           idtac "reifications:"; idtac lexpr; *)
-           reify_goal fv lexpr lterm;
-           match goal with 
-             |- ?g => 
-               apply (@ring_correct Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-                       (@gen_phiZ _ _ _ _ _ _ _ _ _) _
-                 (@comm _ _ _ _ _ _ _ _ _ _) Zeq_bool Zeqb_ok N (fun n:N => n)
-                 (@pow_N _ _ _ _ _ _ _ _ _));
-               [apply mkpow_th; reflexivity
-                 |vm_compute; reflexivity]
-           end
-       end
-   end.
-
-Ltac non_commutative_ring:= 
-  intros;
-  ring_gen.
-
-(* simplification *)
-
-Ltac ring_simplify_aux lterm fv lexpr hyp :=
-    match lterm with
-      | ?t0::?lterm =>
-    match lexpr with
-      | ?e::?le => (* e:PExpr Z est la réification de t0:R *)
-        let t := constr:(@Ncring_polynom.norm_subst
-          Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (@eq Z) Zops Zeq_bool e) in
-        (* t:Pol Z *)
-        let te := 
-          constr:(@Ncring_polynom.Pphi Z 
-            _ 0 1 _+_ _*_ _-_ -_ _==_ _ Ncring_initial.gen_phiZ fv t) in
-        let eq1 := fresh "ring" in
-        let nft := eval vm_compute in t in
-        let t':= fresh "t" in
-        pose (t' := nft);
-        assert (eq1 : t = t');
-        [vm_cast_no_check (eq_refl t')|
-        let eq2 := fresh "ring" in
-        assert (eq2:(@Ncring_polynom.PEeval Z
-          _ 0 1 _+_ _*_ _-_ -_ _==_ _ Ncring_initial.gen_phiZ N (fun n:N => n) 
-          (@Ring_theory.pow_N _ 1 multiplication) fv e) == te);
-        [apply (@Ncring_polynom.norm_subst_ok
-          Z _ 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (@eq Z)
-          _ _ 0 1 _+_ _*_ _-_ -_ _==_ _ _ Ncring_initial.gen_phiZ _
-          (@comm _ 0 1 _+_ _*_ _-_ -_ _==_ _ _) _ Zeqb_ok);
-           apply mkpow_th; reflexivity
-          | match hyp with
-                | 1%nat => rewrite eq2
-                | ?H => try rewrite eq2 in H
-              end];
-        let P:= fresh "P" in
-        match hyp with
-          | 1%nat => idtac "ok";
-            rewrite eq1;
-            pattern (@Ncring_polynom.Pphi Z _ 0 1 _+_ _*_ _-_ -_ _==_
-              _ Ncring_initial.gen_phiZ fv t');
-            match goal with
-              |- (?p ?t) => set (P:=p)
-            end;
-              unfold t' in *; clear t' eq1 eq2; simpl
-          | ?H =>
-               rewrite eq1 in H;
-               pattern (@Ncring_polynom.Pphi Z _ 0 1 _+_ _*_ _-_ -_ _==_
-                  _ Ncring_initial.gen_phiZ fv t') in H; 
-               match type of H with
-                  | (?p ?t)  => set (P:=p) in H
-               end;
-               unfold t' in *; clear t' eq1 eq2; simpl in H
-        end; unfold P in *; clear P
-        ]; ring_simplify_aux lterm fv le hyp
-      | nil => idtac
-    end
-    | nil => idtac
-    end.
-
-Ltac set_variables fv :=
-  match fv with
-    | nil => idtac
-    | ?t::?fv =>
-        let v := fresh "X" in
-        set (v:=t) in *; set_variables fv
-  end.
-
-Ltac deset n:=
-   match n with
-    | 0%nat => idtac
-    | S ?n1 =>
-      match goal with
-        | h:= ?v : ?t |- ?g => unfold h in *; clear h; deset n1
-      end
-   end.
-
-(* a est soit un terme de l'anneau, soit une liste de termes.
-J'ai pas réussi à un décomposer les Vlists obtenues avec ne_constr_list
- dans Tactic Notation *)
-
-Ltac ring_simplify_gen a hyp :=
-  let lterm :=
-    match a with
-      | _::_ => a
-      | _ => constr:(a::nil)
-    end in
-    match eval red in (list_reifyl (lterm:=lterm)) with
-      | (?fv, ?lexpr) => idtac lterm; idtac fv; idtac lexpr;
-      let n := eval compute in (length fv) in
-      idtac n;
-      let lt:=fresh "lt" in
-      set (lt:= lterm);
-      let lv:=fresh "fv" in
-      set (lv:= fv);
-      (* les termes de fv sont remplacés par des variables 
-         pour pouvoir utiliser simpl ensuite sans risquer
-         des simplifications indésirables *)
-      set_variables fv;
-      let lterm1 := eval unfold lt in lt in
-      let lv1 := eval unfold lv in lv in
-        idtac lterm1; idtac lv1;
-      ring_simplify_aux lterm1 lv1 lexpr hyp;
-      clear lt lv;
-      (* on remet les termes de fv *)
-      deset n
-    end.
-
-Tactic Notation "non_commutative_ring_simplify" constr(lterm):=
- ring_simplify_gen lterm 1%nat.
-
-Tactic Notation "non_commutative_ring_simplify" constr(lterm) "in" ident(H):=
- ring_simplify_gen lterm H.
-
-
diff --git a/plugins/setoid_ring/RealField.v b/plugins/setoid_ring/RealField.v
deleted file mode 100644
index d83fcf3781..0000000000
--- a/plugins/setoid_ring/RealField.v
+++ /dev/null
@@ -1,158 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Import Nnat.
-Require Import ArithRing.
-Require Export Ring Field.
-Require Import Rdefinitions.
-Require Import Rpow_def.
-Require Import Raxioms.
-
-Local Open Scope R_scope.
-
-Lemma RTheory : ring_theory 0 1 Rplus Rmult Rminus Ropp (eq (A:=R)).
-Proof.
-constructor.
- intro; apply Rplus_0_l.
- exact Rplus_comm.
- symmetry ; apply Rplus_assoc.
- intro; apply Rmult_1_l.
- exact Rmult_comm.
- symmetry ; apply Rmult_assoc.
- intros m n p.
-   rewrite Rmult_comm.
-   rewrite (Rmult_comm n p).
-   rewrite (Rmult_comm m p).
-   apply Rmult_plus_distr_l.
- reflexivity.
- exact Rplus_opp_r.
-Qed.
-
-Lemma Rfield : field_theory 0 1 Rplus Rmult Rminus Ropp Rdiv Rinv (eq(A:=R)).
-Proof.
-constructor.
- exact RTheory.
- exact R1_neq_R0.
- reflexivity.
- exact Rinv_l.
-Qed.
-
-Lemma Rlt_n_Sn : forall x, x < x + 1.
-Proof.
-intro.
-elim archimed with x; intros.
-destruct H0.
- apply Rlt_trans with (IZR (up x)); trivial.
-    replace (IZR (up x)) with (x + (IZR (up x) - x))%R.
-  apply Rplus_lt_compat_l; trivial.
-  unfold Rminus.
-    rewrite (Rplus_comm (IZR (up x)) (- x)).
-    rewrite <- Rplus_assoc.
-    rewrite Rplus_opp_r.
-    apply Rplus_0_l.
- elim H0.
-   unfold Rminus.
-   rewrite (Rplus_comm (IZR (up x)) (- x)).
-   rewrite <- Rplus_assoc.
-   rewrite Rplus_opp_r.
-   rewrite Rplus_0_l; trivial.
-Qed.
-
-Notation Rset := (Eqsth R).
-Notation Rext := (Eq_ext Rplus Rmult Ropp).
-
-Lemma Rlt_0_2 : 0 < 2.
-Proof.
-apply Rlt_trans with (0 + 1).
- apply Rlt_n_Sn.
- rewrite Rplus_comm.
-   apply Rplus_lt_compat_l.
-    replace R1 with (0 + 1).
-  apply Rlt_n_Sn.
-  apply Rplus_0_l.
-Qed.
-
-Lemma Rgen_phiPOS : forall x, InitialRing.gen_phiPOS1 1 Rplus Rmult x > 0.
-unfold Rgt.
-induction x; simpl; intros.
- apply Rlt_trans with (1 + 0).
-  rewrite Rplus_comm.
-    apply Rlt_n_Sn.
-  apply Rplus_lt_compat_l.
-    rewrite <- (Rmul_0_l Rset Rext RTheory 2).
-    rewrite Rmult_comm.
-    apply Rmult_lt_compat_l.
-   apply Rlt_0_2.
-   trivial.
- rewrite <- (Rmul_0_l Rset Rext RTheory 2).
-   rewrite Rmult_comm.
-   apply Rmult_lt_compat_l.
-  apply Rlt_0_2.
-  trivial.
-  replace 1 with (0 + 1).
-  apply Rlt_n_Sn.
-  apply Rplus_0_l.
-Qed.
-
-
-Lemma Rgen_phiPOS_not_0 :
-  forall x, InitialRing.gen_phiPOS1 1 Rplus Rmult x <> 0.
-red; intros.
-specialize (Rgen_phiPOS x).
-rewrite H; intro.
-apply (Rlt_asym 0 0); trivial.
-Qed.
-
-Lemma Zeq_bool_complete : forall x y,
-  InitialRing.gen_phiZ 0%R 1%R Rplus Rmult Ropp x =
-  InitialRing.gen_phiZ 0%R 1%R Rplus Rmult Ropp y ->
-  Zeq_bool x y = true.
-Proof gen_phiZ_complete Rset Rext Rfield Rgen_phiPOS_not_0.
-
-Lemma Rdef_pow_add : forall (x:R) (n m:nat), pow x  (n + m) = pow x n * pow x m.
-Proof.
-  intros x n; elim n; simpl; auto with real.
-  intros n0 H' m; rewrite H'; auto with real.
-Qed.
-
-Lemma R_power_theory : power_theory 1%R Rmult (@eq R) N.to_nat pow.
-Proof.
- constructor. destruct n. reflexivity.
- simpl. induction p.
- - rewrite Pos2Nat.inj_xI. simpl. now rewrite plus_0_r, Rdef_pow_add, IHp.
- - rewrite Pos2Nat.inj_xO. simpl. now rewrite plus_0_r, Rdef_pow_add, IHp.
- - simpl. rewrite Rmult_comm;apply Rmult_1_l.
-Qed.
-
-Ltac Rpow_tac t :=
-  match isnatcst t with
-  | false => constr:(InitialRing.NotConstant)
-  | _ => constr:(N.of_nat t)
-  end.
-
-Ltac IZR_tac t :=
-  match t with
-  | R0 => constr:(0%Z)
-  | R1 => constr:(1%Z)
-  | IZR (Z.pow_pos 10 ?p) =>
-    match isPcst p with
-    | true => constr:(Z.pow_pos 10 p)
-    | _ => constr:(InitialRing.NotConstant)
-    end
-  | IZR ?u =>
-    match isZcst u with
-    | true => u
-    | _ => constr:(InitialRing.NotConstant)
-    end
-  | _ => constr:(InitialRing.NotConstant)
-  end.
-
-Add Field RField : Rfield
-   (completeness Zeq_bool_complete, constants [IZR_tac], power_tac R_power_theory [Rpow_tac]).
diff --git a/plugins/setoid_ring/Ring.v b/plugins/setoid_ring/Ring.v
deleted file mode 100644
index 35e308565f..0000000000
--- a/plugins/setoid_ring/Ring.v
+++ /dev/null
@@ -1,46 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Import Bool.
-Require Export Ring_theory.
-Require Export Ring_base.
-Require Export InitialRing.
-Require Export Ring_tac.
-
-Lemma BoolTheory :
-  ring_theory false true xorb andb xorb (fun b:bool => b) (eq(A:=bool)).
-split; simpl.
-destruct x; reflexivity.
-destruct x; destruct y; reflexivity.
-destruct x; destruct y; destruct z; reflexivity.
-reflexivity.
-destruct x; destruct y; reflexivity.
-destruct x; destruct y; reflexivity.
-destruct x; destruct y; destruct z; reflexivity.
-reflexivity.
-destruct x; reflexivity.
-Qed.
-
-Definition bool_eq (b1 b2:bool) :=
-  if b1 then b2 else negb b2.
-
-Lemma bool_eq_ok : forall b1 b2, bool_eq b1 b2 = true -> b1 = b2.
-destruct b1; destruct b2; auto.
-Qed.
-
-Ltac bool_cst t :=
-  let t := eval hnf in t in
-  match t with
-    true => constr:(true)
-  | false => constr:(false)
-  | _ => constr:(NotConstant)
-  end.
-
-Add Ring bool_ring : BoolTheory (decidable bool_eq_ok, constants [bool_cst]).
diff --git a/plugins/setoid_ring/Ring_base.v b/plugins/setoid_ring/Ring_base.v
deleted file mode 100644
index 36e7890fbb..0000000000
--- a/plugins/setoid_ring/Ring_base.v
+++ /dev/null
@@ -1,18 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-(* This module gathers the necessary base to build an instance of the
-   ring tactic. Abstract rings need more theory, depending on
-   ZArith_base. *)
-
-Declare ML Module "newring_plugin".
-Require Export Ring_theory.
-Require Export Ring_tac.
-Require Import InitialRing.
diff --git a/plugins/setoid_ring/Ring_polynom.v b/plugins/setoid_ring/Ring_polynom.v
deleted file mode 100644
index 092114ff0b..0000000000
--- a/plugins/setoid_ring/Ring_polynom.v
+++ /dev/null
@@ -1,1509 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-
-Set Implicit Arguments.
-Require Import Setoid Morphisms. 
-Require Import BinList BinPos BinNat BinInt.
-Require Export Ring_theory.
-Local Open Scope positive_scope.
-Import RingSyntax.
-(* Set Universe Polymorphism. *)
-
-Section MakeRingPol.
-
- (* Ring elements *)
- Variable R:Type.
- Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R->R).
- Variable req : R -> R -> Prop.
-
- (* Ring properties *)
- Variable Rsth : Equivalence req.
- Variable Reqe : ring_eq_ext radd rmul ropp req.
- Variable ARth : almost_ring_theory rO rI radd rmul rsub ropp req.
-
- (* Coefficients *)
- Variable C: Type.
- Variable (cO cI: C) (cadd cmul csub : C->C->C) (copp : C->C).
- Variable ceqb : C->C->bool.
- Variable phi : C -> R.
- Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req
-                                cO cI cadd cmul csub copp ceqb phi.
-
- (* Power coefficients *)
- Variable Cpow : Type.
- Variable Cp_phi : N -> Cpow.
- Variable rpow : R -> Cpow -> R.
- Variable pow_th : power_theory rI rmul req Cp_phi rpow.
-
- (* division is ok *)
- Variable cdiv: C -> C -> C * C.
- Variable div_th: div_theory req cadd cmul phi cdiv.
-
-
- (* R notations *)
- Notation "0" := rO. Notation "1" := rI.
- Infix "+" := radd. Infix "*" := rmul.
- Infix "-" := rsub. Notation "- x" := (ropp x).
- Infix "==" := req.
- Infix "^" := (pow_pos rmul).
-
- (* C notations *)
- Infix "+!" := cadd. Infix "*!" := cmul.
- Infix "-! " := csub. Notation "-! x" := (copp x).
- Infix "?=!" := ceqb. Notation "[ x ]" := (phi x).
-
- (* Useful tactics *)
- Add Morphism radd with signature (req ==> req ==> req) as radd_ext.
- Proof. exact (Radd_ext Reqe). Qed.
-
- Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext.
- Proof. exact (Rmul_ext Reqe). Qed.
-
- Add Morphism ropp with signature (req ==> req) as ropp_ext.
- Proof. exact (Ropp_ext Reqe). Qed.
-
- Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext.
- Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
-
- Ltac rsimpl := gen_srewrite Rsth Reqe ARth.
-
- Ltac add_push := gen_add_push radd Rsth Reqe ARth.
- Ltac mul_push := gen_mul_push rmul Rsth Reqe ARth.
-
- Ltac add_permut_rec t :=
-   match t with
-   | ?x + ?y => add_permut_rec y || add_permut_rec x
-   | _ => add_push t; apply (Radd_ext Reqe); [|reflexivity]
-   end.
-
- Ltac add_permut :=
-  repeat (reflexivity ||
-    match goal with |- ?t == _ => add_permut_rec t end).
-
- Ltac mul_permut_rec t :=
-   match t with
-   | ?x * ?y => mul_permut_rec y || mul_permut_rec x
-   | _ => mul_push t; apply (Rmul_ext Reqe); [|reflexivity]
-   end.
-
- Ltac mul_permut :=
-  repeat (reflexivity ||
-    match goal with |- ?t == _ => mul_permut_rec t end).
-
-
- (* Definition of multivariable polynomials with coefficients in C :
-    Type [Pol] represents [X1 ... Xn].
-    The representation is Horner's where a [n] variable polynomial
-    (C[X1..Xn]) is seen as a polynomial on [X1] which coefficients
-    are polynomials with [n-1] variables (C[X2..Xn]).
-    There are several optimisations to make the repr compacter:
-    - [Pc c] is the constant polynomial of value c
-       == c*X1^0*..*Xn^0
-    - [Pinj j Q] is a polynomial constant w.r.t the [j] first variables.
-        variable indices are shifted of j in Q.
-       == X1^0 *..* Xj^0 * Q{X1 <- Xj+1;..; Xn-j <- Xn}
-    - [PX P i Q] is an optimised Horner form of P*X^i + Q
-        with P not the null polynomial
-       == P * X1^i + Q{X1 <- X2; ..; Xn-1 <- Xn}
-
-    In addition:
-    - polynomials of the form (PX (PX P i (Pc 0)) j Q) are forbidden
-      since they can be represented by the simpler form (PX P (i+j) Q)
-    - (Pinj i (Pinj j P)) is (Pinj (i+j) P)
-    - (Pinj i (Pc c)) is (Pc c)
- *)
-
- Inductive Pol : Type :=
-  | Pc : C -> Pol
-  | Pinj : positive -> Pol -> Pol
-  | PX : Pol -> positive -> Pol -> Pol.
-
- Definition P0 := Pc cO.
- Definition P1 := Pc cI.
-
- Fixpoint Peq (P P' : Pol) {struct P'} : bool :=
-  match P, P' with
-  | Pc c, Pc c' => c ?=! c'
-  | Pinj j Q, Pinj j' Q' =>
-    match j ?= j' with
-    | Eq => Peq Q Q'
-    | _ => false
-    end
-  | PX P i Q, PX P' i' Q' =>
-    match i ?= i' with
-    | Eq => if Peq P P' then Peq Q Q' else false
-    | _ => false
-    end
-  | _, _ => false
-  end.
-
- Infix "?==" := Peq.
-
- Definition mkPinj j P :=
-  match P with
-  | Pc _ => P
-  | Pinj j' Q => Pinj (j + j') Q
-  | _ => Pinj j P
-  end.
-
- Definition mkPinj_pred j P:=
-  match j with
-  | xH => P
-  | xO j => Pinj (Pos.pred_double j) P
-  | xI j => Pinj (xO j) P
-  end.
-
- Definition mkPX P i Q :=
-  match P with
-  | Pc c => if c ?=! cO then mkPinj xH Q else PX P i Q
-  | Pinj _ _ => PX P i Q
-  | PX P' i' Q' => if Q' ?== P0 then PX P' (i' + i) Q else PX P i Q
-  end.
-
- Definition mkXi i := PX P1 i P0.
-
- Definition mkX := mkXi 1.
-
- (** Opposite of addition *)
-
- Fixpoint Popp (P:Pol) : Pol :=
-  match P with
-  | Pc c => Pc (-! c)
-  | Pinj j Q => Pinj j (Popp Q)
-  | PX P i Q => PX (Popp P) i (Popp Q)
-  end.
-
- Notation "-- P" := (Popp P).
-
- (** Addition et subtraction *)
-
- Fixpoint PaddC (P:Pol) (c:C) : Pol :=
-  match P with
-  | Pc c1 => Pc (c1 +! c)
-  | Pinj j Q => Pinj j (PaddC Q c)
-  | PX P i Q => PX P i (PaddC Q c)
-  end.
-
- Fixpoint PsubC (P:Pol) (c:C) : Pol :=
-  match P with
-  | Pc c1 => Pc (c1 -! c)
-  | Pinj j Q => Pinj j (PsubC Q c)
-  | PX P i Q => PX P i (PsubC Q c)
-  end.
-
- Section PopI.
-
-  Variable Pop : Pol -> Pol -> Pol.
-  Variable Q : Pol.
-
-  Fixpoint PaddI (j:positive) (P:Pol) : Pol :=
-   match P with
-   | Pc c => mkPinj j (PaddC Q c)
-   | Pinj j' Q' =>
-     match Z.pos_sub j' j with
-     | Zpos k =>  mkPinj j (Pop (Pinj k Q') Q)
-     | Z0 => mkPinj j (Pop Q' Q)
-     | Zneg k => mkPinj j' (PaddI k Q')
-     end
-   | PX P i Q' =>
-     match j with
-     | xH => PX P i (Pop Q' Q)
-     | xO j => PX P i (PaddI (Pos.pred_double j) Q')
-     | xI j => PX P i (PaddI (xO j) Q')
-     end
-   end.
-
-  Fixpoint PsubI (j:positive) (P:Pol) : Pol :=
-   match P with
-   | Pc c => mkPinj j (PaddC (--Q) c)
-   | Pinj j' Q' =>
-     match Z.pos_sub j' j with
-     | Zpos k =>  mkPinj j (Pop (Pinj k Q') Q)
-     | Z0 => mkPinj j (Pop Q' Q)
-     | Zneg k => mkPinj j' (PsubI k Q')
-     end
-   | PX P i Q' =>
-     match j with
-     | xH => PX P i (Pop Q' Q)
-     | xO j => PX P i (PsubI (Pos.pred_double j) Q')
-     | xI j => PX P i (PsubI (xO j) Q')
-     end
-   end.
-
- Variable P' : Pol.
-
- Fixpoint PaddX (i':positive) (P:Pol) : Pol :=
-  match P with
-  | Pc c => PX P' i' P
-  | Pinj j Q' =>
-    match j with
-    | xH =>  PX P' i' Q'
-    | xO j => PX P' i' (Pinj (Pos.pred_double j) Q')
-    | xI j => PX P' i' (Pinj (xO j) Q')
-    end
-  | PX P i Q' =>
-    match Z.pos_sub i i' with
-    | Zpos k => mkPX (Pop (PX P k P0) P') i' Q'
-    | Z0 => mkPX (Pop P P') i Q'
-    | Zneg k => mkPX (PaddX k P) i Q'
-    end
-  end.
-
- Fixpoint PsubX (i':positive) (P:Pol) : Pol :=
-  match P with
-  | Pc c => PX (--P') i' P
-  | Pinj j Q' =>
-    match j with
-    | xH =>  PX (--P') i' Q'
-    | xO j => PX (--P') i' (Pinj (Pos.pred_double j) Q')
-    | xI j => PX (--P') i' (Pinj (xO j) Q')
-    end
-  | PX P i Q' =>
-    match Z.pos_sub i i' with
-    | Zpos k => mkPX (Pop (PX P k P0) P') i' Q'
-    | Z0 => mkPX (Pop P P') i Q'
-    | Zneg k => mkPX (PsubX k P) i Q'
-    end
-  end.
-
-
- End PopI.
-
- Fixpoint Padd (P P': Pol) {struct P'} : Pol :=
-  match P' with
-  | Pc c' => PaddC P c'
-  | Pinj j' Q' => PaddI Padd Q' j' P
-  | PX P' i' Q' =>
-    match P with
-    | Pc c => PX P' i' (PaddC Q' c)
-    | Pinj j Q =>
-      match j with
-      | xH => PX P' i' (Padd Q Q')
-      | xO j => PX P' i' (Padd (Pinj (Pos.pred_double j) Q) Q')
-      | xI j => PX P' i' (Padd (Pinj (xO j) Q) Q')
-      end
-    | PX P i Q =>
-      match Z.pos_sub i i' with
-      | Zpos k => mkPX (Padd (PX P k P0) P') i' (Padd Q Q')
-      | Z0 => mkPX (Padd P P') i (Padd Q Q')
-      | Zneg k => mkPX (PaddX Padd P' k P) i (Padd Q Q')
-      end
-    end
-  end.
- Infix "++" := Padd.
-
- Fixpoint Psub (P P': Pol) {struct P'} : Pol :=
-  match P' with
-  | Pc c' => PsubC P c'
-  | Pinj j' Q' => PsubI Psub Q' j' P
-  | PX P' i' Q' =>
-    match P with
-    | Pc c => PX (--P') i' (*(--(PsubC Q' c))*) (PaddC (--Q') c)
-    | Pinj j Q =>
-      match j with
-      | xH => PX (--P') i' (Psub Q Q')
-      | xO j => PX (--P') i' (Psub (Pinj (Pos.pred_double j) Q) Q')
-      | xI j => PX (--P') i' (Psub (Pinj (xO j) Q) Q')
-      end
-    | PX P i Q =>
-      match Z.pos_sub i i' with
-      | Zpos k => mkPX (Psub (PX P k P0) P') i' (Psub Q Q')
-      | Z0 => mkPX (Psub P P') i (Psub Q Q')
-      | Zneg k => mkPX (PsubX Psub P' k P) i (Psub Q Q')
-      end
-    end
-  end.
- Infix "--" := Psub.
-
- (** Multiplication *)
-
- Fixpoint PmulC_aux (P:Pol) (c:C) : Pol :=
-  match P with
-  | Pc c' => Pc (c' *! c)
-  | Pinj j Q => mkPinj j (PmulC_aux Q c)
-  | PX P i Q => mkPX (PmulC_aux P c) i (PmulC_aux Q c)
-  end.
-
- Definition PmulC P c :=
-  if c ?=! cO then P0 else
-  if c ?=! cI then P else PmulC_aux P c.
-
- Section PmulI.
-  Variable Pmul : Pol -> Pol -> Pol.
-  Variable Q : Pol.
-  Fixpoint PmulI (j:positive) (P:Pol) : Pol :=
-   match P with
-   | Pc c => mkPinj j (PmulC Q c)
-   | Pinj j' Q' =>
-     match Z.pos_sub j' j with
-     | Zpos k => mkPinj j (Pmul (Pinj k Q') Q)
-     | Z0 => mkPinj j (Pmul Q' Q)
-     | Zneg k => mkPinj j' (PmulI k Q')
-     end
-   | PX P' i' Q' =>
-     match j with
-     | xH => mkPX (PmulI xH P') i' (Pmul Q' Q)
-     | xO j' => mkPX (PmulI j P') i' (PmulI (Pos.pred_double j') Q')
-     | xI j' => mkPX (PmulI j P') i' (PmulI (xO j') Q')
-     end
-   end.
-
- End PmulI.
-
- Fixpoint Pmul (P P'' : Pol) {struct P''} : Pol :=
-   match P'' with
-   | Pc c => PmulC P c
-   | Pinj j' Q' => PmulI Pmul Q' j' P
-   | PX P' i' Q' =>
-     match P with
-     | Pc c => PmulC P'' c
-     | Pinj j Q =>
-       let QQ' :=
-         match j with
-         | xH => Pmul Q Q'
-         | xO j => Pmul (Pinj (Pos.pred_double j) Q) Q'
-         | xI j => Pmul (Pinj (xO j) Q) Q'
-         end in
-       mkPX (Pmul P P') i' QQ'
-     | PX P i Q=>
-       let QQ' := Pmul Q Q' in
-       let PQ' := PmulI Pmul Q' xH P in
-       let QP' := Pmul (mkPinj xH Q) P' in
-       let PP' := Pmul P P' in
-       (mkPX (mkPX PP' i P0 ++ QP') i' P0) ++ mkPX PQ' i QQ'
-     end
-  end.
-
- Infix "**" := Pmul.
-
- (** Monomial **)
-
- (** A monomial is X1^k1...Xi^ki. Its representation
-     is a simplified version of the polynomial representation:
-
-     - [mon0] correspond to the polynom [P1].
-     - [(zmon j M)] corresponds to [(Pinj j ...)],
-       i.e. skip j variable indices.
-     - [(vmon i M)] is X^i*M with X the current variable,
-       its corresponds to (PX P1 i ...)]
- *)
-
-  Inductive Mon: Set :=
-  | mon0: Mon
-  | zmon: positive -> Mon -> Mon
-  | vmon: positive -> Mon -> Mon.
-
- Definition mkZmon j M :=
-   match M with mon0 => mon0 | _ => zmon j M end.
-
- Definition zmon_pred j M :=
-   match j with xH => M | _ => mkZmon (Pos.pred j) M end.
-
- Definition mkVmon i M :=
-   match M with
-   | mon0 => vmon i mon0
-   | zmon j m => vmon i (zmon_pred j m)
-   | vmon i' m => vmon (i+i') m
-   end.
-
- Fixpoint CFactor (P: Pol) (c: C) {struct P}: Pol * Pol :=
-   match P with
-   | Pc c1   => let (q,r) := cdiv c1 c in (Pc r, Pc q)
-   | Pinj j1 P1  =>
-     let (R,S) := CFactor P1 c in
-            (mkPinj j1 R, mkPinj j1 S)
-   | PX P1 i Q1 =>
-     let (R1, S1) := CFactor P1 c in
-     let (R2, S2) := CFactor Q1 c in
-        (mkPX R1 i R2, mkPX S1 i S2)
-   end.
-
- Fixpoint MFactor (P: Pol) (c: C) (M: Mon) {struct P}: Pol * Pol :=
-   match P, M with
-        _, mon0 => if (ceqb c cI) then (Pc cO, P) else CFactor P c
-   | Pc _, _    => (P, Pc cO)
-   | Pinj j1 P1, zmon j2 M1 =>
-      match j1 ?= j2 with
-        Eq => let (R,S) := MFactor P1 c M1 in
-                 (mkPinj j1 R, mkPinj j1 S)
-      | Lt => let (R,S) := MFactor P1 c (zmon (j2 - j1) M1) in
-                 (mkPinj j1 R, mkPinj j1 S)
-      | Gt => (P, Pc cO)
-      end
-  | Pinj _ _, vmon _ _ => (P, Pc cO)
-  | PX P1 i Q1, zmon j M1 =>
-             let M2 := zmon_pred j M1 in
-             let (R1, S1) := MFactor P1 c M in
-             let (R2, S2) := MFactor Q1 c M2 in
-               (mkPX R1 i R2, mkPX S1 i S2)
-  | PX P1 i Q1, vmon j M1 =>
-      match i ?= j with
-        Eq => let (R1,S1) := MFactor P1 c (mkZmon xH M1) in
-                 (mkPX R1 i Q1, S1)
-      | Lt => let (R1,S1) := MFactor P1 c (vmon (j - i) M1) in
-                 (mkPX R1 i Q1, S1)
-      | Gt => let (R1,S1) := MFactor P1 c (mkZmon xH M1) in
-                 (mkPX R1 i Q1, mkPX S1 (i-j) (Pc cO))
-      end
-   end.
-
-  Definition POneSubst (P1: Pol) (cM1: C * Mon) (P2: Pol): option Pol :=
-    let (c,M1) := cM1 in
-    let (Q1,R1) := MFactor P1 c M1 in
-    match R1 with
-     (Pc c) => if c ?=! cO then None
-               else Some (Padd Q1 (Pmul P2 R1))
-    | _ => Some (Padd Q1 (Pmul P2 R1))
-    end.
-
-  Fixpoint PNSubst1 (P1: Pol) (cM1: C * Mon) (P2: Pol) (n: nat) : Pol :=
-    match POneSubst P1 cM1 P2 with
-     Some P3 => match n with S n1 => PNSubst1 P3 cM1 P2 n1 | _ => P3 end
-    | _ => P1
-    end.
-
-  Definition PNSubst (P1: Pol) (cM1: C * Mon) (P2: Pol) (n: nat): option Pol :=
-    match POneSubst P1 cM1 P2 with
-     Some P3 => match n with S n1 => Some (PNSubst1 P3 cM1 P2 n1) | _ => None end
-    | _ => None
-    end.
-
-  Fixpoint PSubstL1 (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) : Pol :=
-    match LM1 with
-     cons (M1,P2) LM2 => PSubstL1 (PNSubst1 P1 M1 P2 n) LM2 n
-    | _ => P1
-    end.
-
-  Fixpoint PSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) : option Pol :=
-    match LM1 with
-     cons (M1,P2) LM2 =>
-      match PNSubst P1 M1 P2 n with
-        Some P3 => Some (PSubstL1 P3 LM2 n)
-     |  None => PSubstL P1 LM2 n
-     end
-    | _ => None
-    end.
-
-  Fixpoint PNSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (m n: nat) : Pol :=
-    match PSubstL P1 LM1 n with
-     Some P3 => match m with S m1 => PNSubstL P3 LM1 m1 n | _ => P3 end
-    | _ => P1
-    end.
-
- (** Evaluation of a polynomial towards R *)
-
- Local Notation hd := (List.hd 0).
-
- Fixpoint Pphi(l:list R) (P:Pol) : R :=
-  match P with
-  | Pc c => [c]
-  | Pinj j Q => Pphi (jump j l) Q
-  | PX P i Q => Pphi l P * (hd l) ^ i + Pphi (tail l) Q
-  end.
-
- Reserved Notation "P @ l " (at level 10, no associativity).
- Notation "P @ l " := (Pphi l P).
-
- Definition Pequiv (P Q : Pol) := forall l, P@l == Q@l.
- Infix "===" := Pequiv (at level 70, no associativity).
-
- Instance Pequiv_eq : Equivalence Pequiv.
- Proof.
-  unfold Pequiv; split; red; intros; [reflexivity|now symmetry|now etransitivity].
- Qed.
-
- Instance Pphi_ext : Proper (eq ==> Pequiv ==> req) Pphi.
- Proof.
-  now intros l l' <- P Q H.
- Qed.
-
- Instance Pinj_ext : Proper (eq ==> Pequiv ==> Pequiv) Pinj.
- Proof.
-  intros i j <- P P' HP l. simpl. now rewrite HP.
- Qed.
-
- Instance PX_ext : Proper (Pequiv ==> eq ==> Pequiv ==> Pequiv) PX.
- Proof.
-  intros P P' HP p p' <- Q Q' HQ l. simpl. now rewrite HP, HQ.
- Qed.
-
- (** Evaluation of a monomial towards R *)
-
- Fixpoint Mphi(l:list R) (M: Mon) : R :=
-  match M with
-  | mon0 => rI
-  | zmon j M1 => Mphi (jump j l) M1
-  | vmon i M1 => Mphi (tail l) M1 * (hd l) ^ i
-  end.
-
- Notation "M @@ l" := (Mphi l M) (at level 10, no associativity).
-
- (** Proofs *)
-
- Ltac destr_pos_sub :=
-  match goal with |- context [Z.pos_sub ?x ?y] =>
-   generalize (Z.pos_sub_discr x y); destruct (Z.pos_sub x y)
-  end.
-
- Lemma jump_add' i j (l:list R) : jump (i + j) l = jump j (jump i l).
- Proof. rewrite Pos.add_comm. apply jump_add. Qed.
-
- Lemma Peq_ok P P' : (P ?== P') = true -> P === P'.
- Proof.
-  unfold Pequiv.
-  revert P';induction P;destruct P';simpl; intros H l; try easy.
-  - now apply (morph_eq CRmorph).
-  - destruct (Pos.compare_spec p p0); [ subst | easy | easy ].
-    now rewrite IHP.
-  - specialize (IHP1 P'1); specialize (IHP2 P'2).
-    destruct (Pos.compare_spec p p0); [ subst | easy | easy ].
-    destruct (P2 ?== P'1); [|easy].
-    rewrite H in *.
-    now rewrite IHP1, IHP2.
- Qed.
-
- Lemma Peq_spec P P' : BoolSpec (P === P') True (P ?== P').
- Proof.
-  generalize (Peq_ok P P'). destruct (P ?== P'); auto.
- Qed.
-
- Lemma Pphi0 l : P0@l == 0.
- Proof.
-  simpl;apply (morph0 CRmorph).
- Qed.
-
- Lemma Pphi1 l : P1@l == 1.
- Proof.
-  simpl;apply (morph1 CRmorph).
- Qed.
-
- Lemma mkPinj_ok j l P : (mkPinj j P)@l == P@(jump j l).
- Proof.
-  destruct P;simpl;rsimpl.
-  now rewrite jump_add'.
- Qed.
-
- Instance mkPinj_ext : Proper (eq ==> Pequiv ==> Pequiv) mkPinj.
- Proof.
-  intros i j <- P Q H l. now rewrite !mkPinj_ok.
- Qed.
-
- Lemma pow_pos_add x i j : x^(j + i) == x^i * x^j.
- Proof.
-  rewrite Pos.add_comm.
-  apply (pow_pos_add Rsth (Rmul_ext Reqe) (ARmul_assoc ARth)).
- Qed.
-
- Lemma ceqb_spec c c' : BoolSpec ([c] == [c']) True (c ?=! c').
- Proof.
-  generalize (morph_eq CRmorph c c').
-  destruct (c ?=! c'); auto.
- Qed.
-
- Lemma mkPX_ok l P i Q :
-  (mkPX P i Q)@l == P@l * (hd l)^i + Q@(tail l).
- Proof.
-  unfold mkPX. destruct P.
-  - case ceqb_spec; intros H; simpl; try reflexivity.
-    rewrite H, (morph0 CRmorph), mkPinj_ok; rsimpl.
-  - reflexivity.
-  - case Peq_spec; intros H; simpl; try reflexivity.
-    rewrite H, Pphi0, Pos.add_comm, pow_pos_add; rsimpl.
- Qed.
-
- Instance mkPX_ext : Proper (Pequiv ==> eq ==> Pequiv ==> Pequiv) mkPX.
- Proof.
-  intros P P' HP i i' <- Q Q' HQ l. now rewrite !mkPX_ok, HP, HQ.
- Qed.
-
- Hint Rewrite
-  Pphi0
-  Pphi1
-  mkPinj_ok
-  mkPX_ok
-  (morph0 CRmorph)
-  (morph1 CRmorph)
-  (morph0 CRmorph)
-  (morph_add CRmorph)
-  (morph_mul CRmorph)
-  (morph_sub CRmorph)
-  (morph_opp CRmorph)
-  : Esimpl.
-
- (* Quicker than autorewrite with Esimpl :-) *)
- Ltac Esimpl := try rewrite_db Esimpl; rsimpl; simpl.
-
- Lemma PaddC_ok c P l : (PaddC P c)@l == P@l + [c].
- Proof.
-  revert l;induction P;simpl;intros;Esimpl;trivial.
-  rewrite IHP2;rsimpl.
- Qed.
-
- Lemma PsubC_ok c P l : (PsubC P c)@l == P@l - [c].
- Proof.
-  revert l;induction P;simpl;intros.
-  - Esimpl.
-  - rewrite IHP;rsimpl.
-  - rewrite IHP2;rsimpl.
- Qed.
-
- Lemma PmulC_aux_ok c P l : (PmulC_aux P c)@l == P@l * [c].
- Proof.
-  revert l;induction P;simpl;intros;Esimpl;trivial.
-  rewrite IHP1, IHP2;rsimpl. add_permut. mul_permut.
- Qed.
-
- Lemma PmulC_ok c P l : (PmulC P c)@l == P@l * [c].
- Proof.
-  unfold PmulC.
-  case ceqb_spec; intros H.
-  - rewrite H; Esimpl.
-  - case ceqb_spec; intros H'.
-    + rewrite H'; Esimpl.
-    + apply PmulC_aux_ok.
- Qed.
-
- Lemma Popp_ok P l : (--P)@l == - P@l.
- Proof.
-  revert l;induction P;simpl;intros.
-  - Esimpl.
-  - apply IHP.
-  - rewrite IHP1, IHP2;rsimpl.
- Qed.
-
- Hint Rewrite PaddC_ok PsubC_ok PmulC_ok Popp_ok : Esimpl.
-
- Lemma PaddX_ok P' P k l :
-  (forall P l, (P++P')@l == P@l + P'@l) ->
-  (PaddX Padd P' k P) @ l == P@l + P'@l * (hd l)^k.
- Proof.
-  intros IHP'.
-  revert k l. induction P;simpl;intros.
-  - add_permut.
-  - destruct p; simpl;
-    rewrite ?jump_pred_double; add_permut.
-  - destr_pos_sub; intros ->; Esimpl.
-    + rewrite IHP';rsimpl. add_permut.
-    + rewrite IHP', pow_pos_add;simpl;Esimpl. add_permut.
-    + rewrite IHP1, pow_pos_add;rsimpl. add_permut.
- Qed.
-
- Lemma Padd_ok P' P l : (P ++ P')@l == P@l + P'@l.
- Proof.
-  revert P l; induction P';simpl;intros;Esimpl.
-  - revert p l; induction P;simpl;intros.
-    + Esimpl; add_permut.
-    + destr_pos_sub; intros ->;Esimpl.
-      * now rewrite IHP'.
-      * rewrite IHP';Esimpl. now rewrite jump_add'.
-      * rewrite IHP. now rewrite jump_add'.
-    + destruct p0;simpl.
-      * rewrite IHP2;simpl. rsimpl.
-      * rewrite IHP2;simpl. rewrite jump_pred_double. rsimpl.
-      * rewrite IHP'. rsimpl.
-  - destruct P;simpl.
-    + Esimpl. add_permut.
-    + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl.
-      * rsimpl. add_permut.
-      * rewrite jump_pred_double. rsimpl. add_permut.
-      * rsimpl. add_permut.
-    + destr_pos_sub; intros ->; Esimpl.
-      * rewrite IHP'1, IHP'2;rsimpl. add_permut.
-      * rewrite IHP'1, IHP'2;simpl;Esimpl.
-        rewrite pow_pos_add;rsimpl. add_permut.
-      * rewrite PaddX_ok by trivial; rsimpl.
-        rewrite IHP'2, pow_pos_add; rsimpl. add_permut.
- Qed.
-
- Lemma Psub_opp P' P : P -- P' === P ++ (--P').
- Proof.
-  revert P; induction P'; simpl; intros.
-  - intro l; Esimpl.
-  - revert p; induction P; simpl; intros; try reflexivity.
-    + destr_pos_sub; intros ->; now apply mkPinj_ext.
-    + destruct p0; now apply PX_ext.
-  - destruct P; simpl; try reflexivity.
-    + destruct p0; now apply PX_ext.
-    + destr_pos_sub; intros ->; apply mkPX_ext; auto.
-      revert p1. induction P2; simpl; intros; try reflexivity.
-      destr_pos_sub; intros ->; now apply mkPX_ext.
- Qed.
-
- Lemma Psub_ok P' P l : (P -- P')@l == P@l - P'@l.
- Proof.
-  rewrite Psub_opp, Padd_ok, Popp_ok. rsimpl.
- Qed.
-
- Lemma PmulI_ok P' :
-   (forall P l, (Pmul P P') @ l == P @ l * P' @ l) ->
-   forall P p l, (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l).
- Proof.
-  intros IHP'.
-  induction P;simpl;intros.
-  - Esimpl; mul_permut.
-  - destr_pos_sub; intros ->;Esimpl.
-    + now rewrite IHP'.
-    + now rewrite IHP', jump_add'.
-    + now rewrite IHP, jump_add'.
-  - destruct p0;Esimpl; rewrite ?IHP1, ?IHP2; rsimpl.
-    + f_equiv. mul_permut.
-    + rewrite jump_pred_double. f_equiv. mul_permut.
-    + rewrite IHP'. f_equiv. mul_permut.
- Qed.
-
- Lemma Pmul_ok P P' l : (P**P')@l == P@l * P'@l.
- Proof.
-  revert P l;induction P';simpl;intros.
-  - apply PmulC_ok.
-  - apply PmulI_ok;trivial.
-  - destruct P.
-    + rewrite (ARmul_comm ARth). Esimpl.
-    + Esimpl. f_equiv. rewrite IHP'1; Esimpl.
-      destruct p0;rewrite IHP'2;Esimpl.
-      rewrite jump_pred_double; Esimpl.
-    + rewrite Padd_ok, !mkPX_ok, Padd_ok, !mkPX_ok,
-       !IHP'1, !IHP'2, PmulI_ok; trivial. simpl. Esimpl.
-      add_permut; f_equiv; mul_permut.
- Qed.
-
- Lemma mkZmon_ok M j l :
-   (mkZmon j M) @@ l == (zmon j M) @@ l.
- Proof.
- destruct M; simpl; rsimpl.
- Qed.
-
- Lemma zmon_pred_ok M j l :
-   (zmon_pred j M) @@ (tail l) == (zmon j M) @@ l.
- Proof.
-   destruct j; simpl; rewrite ?mkZmon_ok; simpl; rsimpl.
-   rewrite jump_pred_double; rsimpl.
- Qed.
-
- Lemma mkVmon_ok M i l :
-   (mkVmon i M)@@l == M@@l * (hd l)^i.
- Proof.
-  destruct M;simpl;intros;rsimpl.
-  - rewrite zmon_pred_ok;simpl;rsimpl.
-  - rewrite pow_pos_add;rsimpl.
- Qed.
-
- Ltac destr_factor := match goal with
-  | H : context [CFactor ?P _] |- context [CFactor ?P ?c] =>
-    destruct (CFactor P c); destr_factor; rewrite H; clear H
-  | H : context [MFactor ?P _ _] |- context [MFactor ?P ?c ?M] =>
-    specialize (H M); destruct (MFactor P c M); destr_factor; rewrite H; clear H
-  | _ => idtac
- end.
-
- Lemma Mcphi_ok P c l :
-   let (Q,R) := CFactor P c in
-     P@l == Q@l + [c] * R@l.
- Proof.
- revert l.
- induction P as [c0 | j P IH | P1 IH1 i P2 IH2]; intros l; Esimpl. 
- - assert (H := (div_eucl_th div_th) c0 c).
-   destruct cdiv as (q,r). rewrite H; Esimpl. add_permut. 
- - destr_factor. Esimpl.
- - destr_factor. Esimpl. add_permut.
- Qed.
-
- Lemma Mphi_ok P (cM: C * Mon) l :
-   let (c,M) := cM in
-   let (Q,R) := MFactor P c M in
-     P@l == Q@l + [c] * M@@l * R@l.
- Proof. 
- destruct cM as (c,M). revert M l.
- induction P; destruct M; intros l; simpl; auto; 
- try (case ceqb_spec; intro He);
-  try (case Pos.compare_spec; intros He);
-  rewrite ?He;
-   destr_factor; simpl; Esimpl.
- - assert (H := div_eucl_th div_th c0 c).
-   destruct cdiv as (q,r). rewrite H; Esimpl. add_permut.
- - assert (H := Mcphi_ok P c). destr_factor. Esimpl.
- - now rewrite <- jump_add, Pos.sub_add.
- - assert (H2 := Mcphi_ok P2 c). assert (H3 := Mcphi_ok P3 c).
-   destr_factor. Esimpl. add_permut.
- - rewrite zmon_pred_ok. simpl. add_permut.
- - rewrite mkZmon_ok. simpl. add_permut. mul_permut.
- - add_permut. mul_permut.
-   rewrite <- pow_pos_add, Pos.add_comm, Pos.sub_add by trivial; rsimpl.
- - rewrite mkZmon_ok. simpl. Esimpl. add_permut. mul_permut.
-   rewrite <- pow_pos_add, Pos.sub_add by trivial; rsimpl.
- Qed.
-
- Lemma POneSubst_ok P1 cM1 P2 P3 l :
-   POneSubst P1 cM1 P2 = Some P3 ->
-   [fst cM1] * (snd cM1)@@l == P2@l -> P1@l == P3@l.
- Proof.
- destruct cM1 as (cc,M1).
- unfold POneSubst.
- assert (H := Mphi_ok P1 (cc, M1) l). simpl in H.
- destruct MFactor as (R1,S1); simpl. rewrite H. clear H.
- intros EQ EQ'. replace P3 with (R1 ++ P2 ** S1).
- - rewrite EQ', Padd_ok, Pmul_ok; rsimpl.
- - revert EQ. destruct S1; try now injection 1.
-   case ceqb_spec; now inversion 2.
- Qed.
-
- Lemma PNSubst1_ok n P1 cM1 P2 l :
-   [fst cM1] * (snd cM1)@@l == P2@l ->
-   P1@l == (PNSubst1 P1 cM1 P2 n)@l.
- Proof.
- revert P1. induction n; simpl; intros P1;
- generalize (POneSubst_ok P1 cM1 P2); destruct POneSubst;
-   intros; rewrite <- ?IHn; auto; reflexivity.
- Qed.
-
- Lemma PNSubst_ok n P1 cM1 P2 l P3 :
-   PNSubst P1 cM1 P2 n = Some P3 ->
-   [fst cM1] * (snd cM1)@@l == P2@l -> P1@l == P3@l.
- Proof.
- unfold PNSubst.
- assert (H := POneSubst_ok P1 cM1 P2); destruct POneSubst; try discriminate.
- destruct n; inversion_clear 1.
- intros. rewrite <- PNSubst1_ok; auto.
- Qed.
-
- Fixpoint MPcond (LM1: list (C * Mon * Pol)) (l: list R) : Prop :=
-   match LM1 with
-   | (M1,P2) :: LM2 => ([fst M1] * (snd M1)@@l == P2@l) /\ MPcond LM2 l
-   | _ => True
-   end.
-
- Lemma PSubstL1_ok n LM1 P1 l :
-   MPcond LM1 l -> P1@l == (PSubstL1 P1 LM1 n)@l.
- Proof.
- revert P1; induction LM1 as [|(M2,P2) LM2 IH]; simpl; intros. 
- - reflexivity. 
- - rewrite <- IH by intuition; now apply PNSubst1_ok.
- Qed.
-
- Lemma PSubstL_ok n LM1 P1 P2 l :
-   PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l -> P1@l == P2@l.
- Proof.
- revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros.
- - discriminate.
- - assert (H':=PNSubst_ok n P3 M2 P2'). destruct PNSubst.
-   * injection H as [= <-]. rewrite <- PSubstL1_ok; intuition.
-   * now apply IH.
- Qed.
-
- Lemma PNSubstL_ok m n LM1 P1 l :
-    MPcond LM1 l -> P1@l == (PNSubstL P1 LM1 m n)@l.
- Proof.
- revert LM1 P1. induction m; simpl; intros;
- assert (H' := PSubstL_ok n LM1 P2); destruct PSubstL;
- auto; try reflexivity.
- rewrite <- IHm; auto.
- Qed.
-
- (** Definition of polynomial expressions *)
-
- Inductive PExpr : Type :=
-  | PEO : PExpr
-  | PEI : PExpr            
-  | PEc : C -> PExpr
-  | PEX : positive -> PExpr
-  | PEadd : PExpr -> PExpr -> PExpr
-  | PEsub : PExpr -> PExpr -> PExpr
-  | PEmul : PExpr -> PExpr -> PExpr
-  | PEopp : PExpr -> PExpr
-  | PEpow : PExpr -> N -> PExpr.
-
- Register PExpr as plugins.setoid_ring.pexpr.
- Register PEc as plugins.setoid_ring.const.
- Register PEX as plugins.setoid_ring.var.
- Register PEadd as plugins.setoid_ring.add.
- Register PEsub as plugins.setoid_ring.sub.
- Register PEmul as plugins.setoid_ring.mul.
- Register PEopp as plugins.setoid_ring.opp.
- Register PEpow as plugins.setoid_ring.pow.
-
- (** evaluation of polynomial expressions towards R *)
- Definition mk_X j := mkPinj_pred j mkX.
-
- (** evaluation of polynomial expressions towards R *)
-
- Fixpoint PEeval (l:list R) (pe:PExpr) {struct pe} : R :=
-   match pe with
-   | PEO => rO
-   | PEI => rI
-   | PEc c => phi c
-   | PEX j => nth 0 j l
-   | PEadd pe1 pe2 => (PEeval l pe1) + (PEeval l pe2)
-   | PEsub pe1 pe2 => (PEeval l pe1) - (PEeval l pe2)
-   | PEmul pe1 pe2 => (PEeval l pe1) * (PEeval l pe2)
-   | PEopp pe1 => - (PEeval l pe1)
-   | PEpow pe1 n => rpow (PEeval l pe1) (Cp_phi n)
-   end.
-
-Strategy expand [PEeval].
-
- (** Correctness proofs *)
-
- Lemma mkX_ok p l : nth 0 p l == (mk_X p) @ l.
- Proof.
-  destruct p;simpl;intros;Esimpl;trivial.
-  - now rewrite <-jump_tl, nth_jump.
-  - now rewrite <- nth_jump, nth_pred_double.
- Qed.
-
- Hint Rewrite Padd_ok Psub_ok : Esimpl.
-
-Section POWER.
-  Variable subst_l : Pol -> Pol.
-  Fixpoint Ppow_pos (res P:Pol) (p:positive) : Pol :=
-   match p with
-   | xH => subst_l (res ** P)
-   | xO p => Ppow_pos (Ppow_pos res P p) P p
-   | xI p => subst_l ((Ppow_pos (Ppow_pos res P p) P p) ** P)
-   end.
-
-  Definition Ppow_N P n :=
-   match n with
-   | N0 => P1
-   | Npos p => Ppow_pos P1 P p
-   end.
-
-  Lemma Ppow_pos_ok l :
-    (forall P, subst_l P@l == P@l) ->
-    forall res P p, (Ppow_pos res P p)@l == res@l * (pow_pos Pmul P p)@l.
-  Proof.
-   intros subst_l_ok res P p. revert res.
-   induction p;simpl;intros; rewrite ?subst_l_ok, ?Pmul_ok, ?IHp;
-    mul_permut.
-  Qed.
-
-  Lemma Ppow_N_ok l :
-    (forall P, subst_l P@l == P@l) ->
-    forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l.
-  Proof.
-  destruct n;simpl.
-  - reflexivity.
-  - rewrite Ppow_pos_ok by trivial. Esimpl.
-  Qed.
-
- End POWER.
-
- (** Normalization and rewriting *)
-
- Section NORM_SUBST_REC.
-  Variable n : nat.
-  Variable lmp:list (C*Mon*Pol).
-  Let subst_l P := PNSubstL P lmp n n.
-  Let Pmul_subst P1 P2 := subst_l (P1 ** P2).
-  Let Ppow_subst := Ppow_N subst_l.
-
-  Fixpoint norm_aux (pe:PExpr) : Pol :=
-   match pe with
-   | PEO => Pc cO
-   | PEI => Pc cI
-   | PEc c => Pc c
-   | PEX j => mk_X j
-   | PEadd (PEopp pe1) pe2 => (norm_aux pe2) -- (norm_aux pe1)
-   | PEadd pe1 (PEopp pe2) => (norm_aux pe1) -- (norm_aux pe2)
-   | PEadd pe1 pe2 => (norm_aux pe1) ++ (norm_aux pe2)
-   | PEsub pe1 pe2 => (norm_aux pe1) -- (norm_aux pe2)
-   | PEmul pe1 pe2 => (norm_aux pe1) ** (norm_aux pe2)
-   | PEopp pe1 => -- (norm_aux pe1)
-   | PEpow pe1 n => Ppow_N (fun p => p) (norm_aux pe1) n
-   end.
-
-  Definition norm_subst pe := subst_l (norm_aux pe).
-
-  (** Internally, [norm_aux] is expanded in a large number of cases.
-      To speed-up proofs, we use an alternative definition. *)
-
-  Definition get_PEopp pe :=
-   match pe with
-   | PEopp pe' => Some pe'
-   | _ => None
-   end.
-
-  Lemma norm_aux_PEadd pe1 pe2 :
-    norm_aux (PEadd pe1 pe2) =
-    match get_PEopp pe1, get_PEopp pe2 with
-    | Some pe1', _ => (norm_aux pe2) -- (norm_aux pe1')
-    | None, Some pe2' => (norm_aux pe1) -- (norm_aux pe2')
-    | None, None => (norm_aux pe1) ++ (norm_aux pe2)
-    end.
-  Proof.
-  simpl (norm_aux (PEadd _ _)).
-  destruct pe1; [ | | | | | | | reflexivity | ];
-   destruct pe2; simpl get_PEopp; reflexivity.
-  Qed.
-
-  Lemma norm_aux_PEopp pe :
-    match get_PEopp pe with
-    | Some pe' => norm_aux pe = -- (norm_aux pe')
-    | None => True
-    end.
-  Proof.
-  now destruct pe.
-  Qed.
-
-  Arguments norm_aux !pe : simpl nomatch.
-
-  Lemma norm_aux_spec l pe :
-    PEeval l pe == (norm_aux pe)@l.
-  Proof.
-   intros.
-   induction pe; cbn.
-   - now rewrite (morph0 CRmorph). 
-   - now rewrite (morph1 CRmorph).
-   - reflexivity.
-   - apply mkX_ok.
-   - rewrite IHpe1, IHpe2.
-     assert (H1 := norm_aux_PEopp pe1).
-     assert (H2 := norm_aux_PEopp pe2).
-     rewrite norm_aux_PEadd.
-     do 2 destruct get_PEopp; rewrite ?H1, ?H2; Esimpl; add_permut.
-   - rewrite IHpe1, IHpe2. Esimpl.
-   - rewrite IHpe1, IHpe2. now rewrite Pmul_ok.
-   - rewrite IHpe. Esimpl.
-   - rewrite Ppow_N_ok by reflexivity.
-     rewrite (rpow_pow_N pow_th). destruct n0; simpl; Esimpl.
-     induction p;simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok.
-  Qed.
-
- Lemma norm_subst_spec :
-     forall l pe, MPcond lmp l ->
-       PEeval l pe == (norm_subst pe)@l.
- Proof.
-  intros;unfold norm_subst.
-  unfold subst_l;rewrite <- PNSubstL_ok;trivial. apply norm_aux_spec.
- Qed.
-
- End NORM_SUBST_REC.
-
- Fixpoint interp_PElist (l:list R) (lpe:list (PExpr*PExpr)) {struct lpe} : Prop :=
-   match lpe with
-   | nil => True
-   | (me,pe)::lpe =>
-     match lpe with
-     | nil => PEeval l me == PEeval l pe
-     | _ => PEeval l me == PEeval l pe /\ interp_PElist l lpe
-     end
-  end.
-
-  Fixpoint mon_of_pol (P:Pol) : option (C * Mon) :=
-  match P with
-  | Pc c => if (c ?=! cO) then None else Some (c, mon0)
-  | Pinj j P =>
-    match mon_of_pol P with
-    | None => None
-    | Some (c,m) =>  Some (c, mkZmon j m)
-    end
-  | PX P i Q =>
-    if Peq Q P0 then
-      match mon_of_pol P with
-      | None => None
-      | Some (c,m) => Some (c, mkVmon i m)
-      end
-    else None
-  end.
-
- Fixpoint mk_monpol_list (lpe:list (PExpr * PExpr)) : list (C*Mon*Pol) :=
-  match lpe with
-  | nil => nil
-  | (me,pe)::lpe =>
-    match mon_of_pol (norm_subst 0 nil me) with
-    | None => mk_monpol_list lpe
-    | Some m => (m,norm_subst 0 nil pe):: mk_monpol_list lpe
-    end
-  end.
-
-  Lemma mon_of_pol_ok : forall P m, mon_of_pol P = Some m ->
-              forall l, [fst m] * Mphi l (snd m) == P@l.
-  Proof.
-    induction P;simpl;intros;Esimpl.
-    assert (H1 := (morph_eq CRmorph) c cO).
-    destruct (c ?=! cO).
-    discriminate.
-    inversion H;trivial;Esimpl.
-    generalize H;clear H;case_eq (mon_of_pol P).
-    intros (c1,P2) H0 H1; inversion H1; Esimpl.
-      generalize (IHP (c1, P2) H0 (jump p l)).
-      rewrite mkZmon_ok;simpl;auto.
-    intros; discriminate.
-    generalize H;clear H;change match P3 with
-        | Pc c => c ?=! cO
-        | Pinj _ _ => false
-        | PX _ _ _ => false
-        end with (P3 ?== P0).
-    assert (H := Peq_ok P3 P0).
-    destruct (P3 ?== P0).
-    case_eq (mon_of_pol P2);try intros (cc, pp); intros.
-    inversion H1.
-    simpl.
-    rewrite mkVmon_ok;simpl.
-    rewrite H;trivial;Esimpl.
-     generalize (IHP1 _ H0); simpl; intros HH; rewrite HH; rsimpl.
-    discriminate.
-    intros;discriminate.
-   Qed.
-
- Lemma interp_PElist_ok : forall l lpe,
-         interp_PElist l lpe -> MPcond (mk_monpol_list lpe) l.
- Proof.
-   induction lpe;simpl. trivial.
-   destruct a;simpl;intros.
-   assert (HH:=mon_of_pol_ok (norm_subst 0 nil  p));
-     destruct  (mon_of_pol (norm_subst 0 nil p)).
-   split.
-   rewrite <- norm_subst_spec by exact I.
-   destruct lpe;try destruct H;rewrite <- H;
-   rewrite (norm_subst_spec 0 nil); try exact I;apply HH;trivial.
-   apply IHlpe. destruct lpe;simpl;trivial. destruct H. exact H0.
-   apply IHlpe. destruct lpe;simpl;trivial. destruct H. exact H0.
- Qed.
-
- Lemma norm_subst_ok : forall n l lpe pe,
-   interp_PElist l lpe ->
-   PEeval l pe == (norm_subst n (mk_monpol_list lpe) pe)@l.
- Proof.
-   intros;apply norm_subst_spec. apply interp_PElist_ok;trivial.
-  Qed.
-
- Lemma ring_correct : forall n l lpe pe1 pe2,
-   interp_PElist l lpe ->
-   (let lmp := mk_monpol_list lpe in
-   norm_subst n lmp pe1 ?== norm_subst n lmp pe2) = true ->
-   PEeval l pe1 == PEeval l pe2.
- Proof.
-  simpl;intros.
-  do 2 (rewrite (norm_subst_ok n l lpe);trivial).
-  apply Peq_ok;trivial.
- Qed.
-
-
-
-  (** 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.
-
- Lemma mkmult_rec_ok : forall lm r, mkmult_rec r lm == r * r_list_pow lm.
- Proof.
-   induction lm;intros;simpl;Esimpl.
-   destruct a as (x,p);Esimpl.
-   rewrite IHlm. rewrite mkmult_pow_spec. Esimpl.
-  Qed.
-
- Lemma mkmult1_ok : forall lm, mkmult1 lm == r_list_pow lm.
- Proof.
-   destruct lm;simpl;Esimpl.
-   destruct p. rewrite mkmult_rec_ok;rewrite mkpow_spec;Esimpl.
- Qed.
-
- Lemma mkmultm1_ok : forall lm, mkmultm1 lm == - r_list_pow lm.
- Proof.
-  destruct lm;simpl;Esimpl.
-  destruct p;rewrite mkmult_rec_ok. rewrite mkopp_pow_spec;Esimpl.
- Qed.
-
- Lemma r_list_pow_rev :  forall l, r_list_pow (rev' l) == r_list_pow l.
- Proof.
-   assert
-    (forall l lr : list (R * positive), r_list_pow (rev_append l lr) == r_list_pow lr * r_list_pow l).
-   induction l;intros;simpl;Esimpl.
-   destruct a;rewrite IHl;Esimpl.
-   rewrite (ARmul_comm ARth (pow_pos rmul r p)). reflexivity.
-  intros;unfold rev'. rewrite H;simpl;Esimpl.
-  Qed.
-
- Lemma mkmult_c_pos_ok : forall c lm, mkmult_c_pos c lm == [c]* r_list_pow lm.
- Proof.
-  intros;unfold mkmult_c_pos;simpl.
-   assert (H := (morph_eq CRmorph) c cI).
-   rewrite <- r_list_pow_rev; destruct (c ?=! cI).
-  rewrite H;trivial;Esimpl.
-  apply mkmult1_ok.  apply mkmult_rec_ok.
- Qed.
-
- Lemma mkmult_c_ok : forall c lm, mkmult_c c lm == [c] * r_list_pow lm.
- Proof.
-  intros;unfold mkmult_c;simpl.
-  case_eq (get_sign c);intros.
-  assert (H1 := (morph_eq CRmorph) c0  cI).
-  destruct (c0 ?=! cI).
-   rewrite (morph_eq CRmorph _ _ (sign_spec get_sign_spec _ H)). Esimpl. rewrite H1;trivial.
-   rewrite <- r_list_pow_rev;trivial;Esimpl.
-  apply mkmultm1_ok.
- rewrite <- r_list_pow_rev; apply mkmult_rec_ok.
- apply mkmult_c_pos_ok.
-Qed.
-
- Lemma mkadd_mult_ok : forall rP c lm, mkadd_mult rP c lm == rP + [c]*r_list_pow lm.
- Proof.
-  intros;unfold mkadd_mult.
-  case_eq (get_sign c);intros.
-  rewrite (morph_eq CRmorph _ _ (sign_spec get_sign_spec _ H));Esimpl.
-  rewrite mkmult_c_pos_ok;Esimpl.
-  rewrite mkmult_c_pos_ok;Esimpl.
- Qed.
-
- 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.
- Proof.
-   destruct n;simpl;intros;Esimpl.
- Qed.
-
- 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.
-  Proof.
-    induction P;simpl;intros.
-    rewrite mkadd_mult_ok. rewrite add_pow_list_ok; Esimpl.
-    rewrite IHP. simpl. rewrite add_pow_list_ok; Esimpl.
-    change (match P3 with
-       | Pc c => c ?=! cO
-       | Pinj _ _ => false
-       | PX _ _ _ => false
-       end) with (Peq P3 P0).
-   change match n with
-    | N0 => Npos p
-    | Npos q => Npos (p + q)
-    end with (N.add (Npos p) n);trivial.
-   assert (H := Peq_ok P3 P0).
-    destruct (P3 ?== P0).
-    rewrite (H eq_refl).
-   rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl.
-   add_permut. mul_permut.
-   rewrite IHP2.
-   rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl.
-   add_permut. mul_permut.
- Qed.
-
- 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.
- Proof.
-   induction P;simpl;intros;Esimpl.
-   rewrite mkmult_c_ok;rewrite add_pow_list_ok;Esimpl.
-   rewrite IHP. simpl;rewrite add_pow_list_ok;Esimpl.
-  change (match P3 with
-       | Pc c => c ?=! cO
-       | Pinj _ _ => false
-       | PX _ _ _ => false
-       end) with (Peq P3 P0).
-   change match n with
-    | N0 => Npos p
-    | Npos q => Npos (p + q)
-    end with (N.add (Npos p) n);trivial.
-   assert (H := Peq_ok P3 P0).
-    destruct (P3 ?== P0).
-    rewrite (H eq_refl).
-   rewrite  IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl.
-   mul_permut.
-   rewrite add_mult_dev_ok. rewrite IHP1; rewrite add_pow_list_ok.
-   destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl.
-   add_permut; mul_permut.
-  Qed.
-
- Lemma Pphi_avoid_ok : forall P fv, Pphi_avoid fv P  == P@fv.
- Proof.
-   unfold Pphi_avoid;intros;rewrite mult_dev_ok;simpl;Esimpl.
- Qed.
-
- End EVALUATION.
-
-  Definition Pphi_pow :=
-   let mkpow x p :=
-      match p with xH => x | _ => rpow x (Cp_phi (Npos p)) end in
-   let mkopp_pow x p := ropp (mkpow x p)  in
-   let mkmult_pow r x p := rmul r (mkpow x p) in
-    Pphi_avoid mkpow mkopp_pow mkmult_pow.
-
- Lemma local_mkpow_ok r p :
-    match p with
-    | xI _ => rpow r (Cp_phi (Npos p))
-    | xO _ => rpow r (Cp_phi (Npos p))
-    | 1 => r
-    end == pow_pos rmul r p.
- Proof. destruct p; now rewrite ?(rpow_pow_N pow_th). Qed.
-
- Lemma Pphi_pow_ok : forall P fv, Pphi_pow fv P  == P@fv.
- Proof.
-  unfold Pphi_pow;intros;apply Pphi_avoid_ok;intros;
-   now rewrite ?local_mkpow_ok.
- Qed.
-
- Lemma ring_rw_pow_correct : forall n lH l,
-      interp_PElist l lH ->
-      forall lmp, mk_monpol_list lH = lmp ->
-      forall pe npe, norm_subst n lmp pe = npe ->
-      PEeval l pe == Pphi_pow l npe.
- Proof.
-  intros n lH l H1 lmp Heq1 pe npe Heq2.
-  rewrite Pphi_pow_ok, <- Heq2, <- Heq1.
-  apply norm_subst_ok. trivial.
- Qed.
-
- Fixpoint mkmult_pow (r x:R) (p: positive) {struct p} : R :=
-   match p with
-   | xH => r*x
-   | xO p => mkmult_pow (mkmult_pow r x p) x p
-   | xI p => mkmult_pow (mkmult_pow (r*x) x p) x p
-   end.
-
-  Definition mkpow x p :=
-    match p with
-    | xH => x
-    | xO p => mkmult_pow x x (Pos.pred_double p)
-    | xI p => mkmult_pow x x (xO p)
-    end.
-
-  Definition mkopp_pow x p :=
-    match p with
-    | xH => -x
-    | xO p => mkmult_pow (-x) x (Pos.pred_double p)
-    | xI p => mkmult_pow (-x) x (xO p)
-    end.
-
-  Definition Pphi_dev := Pphi_avoid mkpow mkopp_pow mkmult_pow.
-
-  Lemma mkmult_pow_ok p r x : mkmult_pow r x p == r * x^p.
-  Proof.
-    revert r; induction p;intros;simpl;Esimpl;rewrite !IHp;Esimpl.
-  Qed.
-
- Lemma mkpow_ok p x : mkpow x p == x^p.
-  Proof.
-    destruct p;simpl;intros;Esimpl.
-    - rewrite !mkmult_pow_ok;Esimpl.
-    - rewrite mkmult_pow_ok;Esimpl.
-      change x with (x^1) at 1.
-      now rewrite <- pow_pos_add, Pos.add_1_r, Pos.succ_pred_double.
-  Qed.
-
-  Lemma mkopp_pow_ok p x : mkopp_pow x p == - x^p.
-  Proof.
-    destruct p;simpl;intros;Esimpl.
-    - rewrite !mkmult_pow_ok;Esimpl.
-    - rewrite mkmult_pow_ok;Esimpl.
-      change x with (x^1) at 1.
-      now rewrite <- pow_pos_add, Pos.add_1_r, Pos.succ_pred_double.
-  Qed.
-
- Lemma Pphi_dev_ok : forall P fv, Pphi_dev fv P == P@fv.
-  Proof.
-   unfold Pphi_dev;intros;apply Pphi_avoid_ok.
-   - intros;apply mkpow_ok.
-   - intros;apply mkopp_pow_ok.
-   - intros;apply mkmult_pow_ok.
-  Qed.
-
- Lemma ring_rw_correct : forall n lH l,
-      interp_PElist l lH ->
-      forall lmp, mk_monpol_list lH = lmp ->
-      forall pe npe, norm_subst n lmp pe = npe ->
-      PEeval l pe == Pphi_dev l npe.
- Proof.
-  intros n lH l H1 lmp Heq1 pe npe Heq2.
-  rewrite  Pphi_dev_ok. rewrite <- Heq2;rewrite <- Heq1.
-  apply norm_subst_ok. trivial.
- Qed.
-
-End MakeRingPol.
-
-Arguments PEO {C}.
-Arguments PEI {C}.
diff --git a/plugins/setoid_ring/Ring_tac.v b/plugins/setoid_ring/Ring_tac.v
deleted file mode 100644
index 0a14c0ee5c..0000000000
--- a/plugins/setoid_ring/Ring_tac.v
+++ /dev/null
@@ -1,472 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Set Implicit Arguments.
-Require Import Setoid.
-Require Import BinPos.
-Require Import Ring_polynom.
-Require Import BinList.
-Require Export ListTactics.
-Require Import InitialRing.
-Declare ML Module "newring_plugin".
-
-
-(* adds a definition t' on the normal form of t and an hypothesis id
-   stating that t = t' (tries to produces a proof as small as possible) *)
-Ltac compute_assertion eqn t' t :=
-  let nft := eval vm_compute in t in
-  pose (t' := nft);
-  assert (eqn : t = t');
-  [vm_cast_no_check (eq_refl t')|idtac].
-
-Ltac relation_carrier req :=
-  let ty := type of req in
-  match eval hnf in ty with
-   ?R -> _ => R
-  | _ => fail 1000 "Equality has no relation type"
-  end.
-
-Ltac Get_goal := match goal with [|- ?G] => G end.
-
-(********************************************************************)
-(* Tacticals to build reflexive tactics *)
-
-Ltac OnEquation req :=
-  match goal with
-  | |- req ?lhs ?rhs => (fun f => f lhs rhs)
-  | _ => (fun _ => fail "Goal is not an equation (of expected equality)")
-  end.
-
-Ltac OnEquationHyp req h :=
-  match type of h with
-  | req ?lhs ?rhs => fun f => f lhs rhs
-  | _ => (fun _ => fail "Hypothesis is not an equation (of expected equality)")
-  end.
-
-(* Note: auxiliary subgoals in reverse order *)
-Ltac OnMainSubgoal H ty :=
-  match ty with
-  | _ -> ?ty' =>
-     let subtac := OnMainSubgoal H ty' in
-     fun kont => lapply H; [clear H; intro H; subtac kont | idtac]
-  | _ => (fun kont => kont())
-  end.
-
-(* A generic pattern to have reflexive tactics do some computation:
-   lemmas of the form [forall x', x=x' -> P(x')] are understood as:
-   compute the normal form of x, instantiate x' with it, prove
-   hypothesis x=x' with vm_compute and reflexivity, and pass the
-   instantiated lemma to the continuation.
- *)
-Ltac ProveLemmaHyp lemma :=
-  match type of lemma with
-    forall x', ?x = x' -> _ =>
-      (fun kont =>
-        let x' := fresh "res" in
-        let H := fresh "res_eq" in
-        compute_assertion H x' x;
-        let lemma' := constr:(lemma x' H) in
-        kont lemma';
-        (clear H||idtac"ProveLemmaHyp: cleanup failed");
-        subst x')
-  | _ => (fun _ => fail "ProveLemmaHyp: lemma not of the expected form")
-  end.
-
-Ltac ProveLemmaHyps lemma :=
-  match type of lemma with
-    forall x', ?x = x' -> _ =>
-      (fun kont =>
-        let x' := fresh "res" in
-        let H := fresh "res_eq" in
-        compute_assertion H x' x;
-        let lemma' := constr:(lemma x' H) in
-        ProveLemmaHyps lemma' kont;
-        (clear H||idtac"ProveLemmaHyps: cleanup failed");
-        subst x')
-  | _ => (fun kont => kont lemma)
-  end.
-
-(*
-Ltac ProveLemmaHyps lemma := (* expects a continuation *)
-  let try_step := ProveLemmaHyp lemma in
-  (fun kont =>
-    try_step ltac:(fun lemma' => ProveLemmaHyps lemma' kont) ||
-    kont lemma).
-*)
-Ltac ApplyLemmaThen lemma expr kont :=
-  let lem := constr:(lemma expr) in
-  ProveLemmaHyp lem ltac:(fun lem' =>
-    let Heq := fresh "thm" in
-    assert (Heq:=lem');
-    OnMainSubgoal Heq ltac:(type of Heq) ltac:(fun _ => kont Heq);
-    (clear Heq||idtac"ApplyLemmaThen: cleanup failed")).
-(*
-Ltac ApplyLemmaThenAndCont lemma expr tac CONT_tac cont_arg :=
-  let pe :=
-    match type of (lemma expr) with
-      forall pe', ?pe = pe' -> _ => pe
-    | _ => fail 1 "ApplyLemmaThenAndCont: cannot find norm expression"
-    end in
-  let pe' := fresh "expr_nf" in
-  let nf_pe := fresh "pe_eq" in
-  compute_assertion nf_pe pe' pe;
-  let Heq := fresh "thm" in
-  (assert (Heq:=lemma pe pe' H) || fail "anomaly: failed to apply lemma");
-  clear nf_pe;
-  OnMainSubgoal Heq ltac:(type of Heq)
-    ltac:(try tac Heq; clear Heq pe';CONT_tac cont_arg)).
-*)
-Ltac ApplyLemmaThenAndCont lemma expr tac CONT_tac :=
-  ApplyLemmaThen lemma expr
-    ltac:(fun lemma' => try tac lemma'; CONT_tac()).
-
-(* General scheme of reflexive tactics using of correctness lemma
-   that involves normalisation of one expression
-   - [FV_tac term fv] is a tactic that adds the atomic expressions
-       of [term] into [fv]
-   - [SYN_tac term fv] reifies [term] given the list of atomic expressions
-   - [LEMMA_tac fv kont] computes the correctness lemma and passes it to
-       continuation kont
-   - [MAIN_tac H] process H which is the conclusion of the correctness lemma
-       instantiated with each reified term
-   - [fv] is the initial value of atomic expressions (to be completed by
-       the reification of the terms
-   - [terms] the list (a constr of type list) of terms to reify and process.
- *)
-Ltac ReflexiveRewriteTactic
-     FV_tac SYN_tac LEMMA_tac MAIN_tac fv terms :=
-  (* extend the atom list *)
-  let fv := list_fold_left FV_tac fv terms in
-  let RW_tac lemma :=
-     let fcons term CONT_tac :=
-      let expr := SYN_tac term fv in
-      let main H :=
-        match type of H with
-        | (?req _ ?rhs) => change (req term rhs) in H
-        end;
-        MAIN_tac H in
-      (ApplyLemmaThenAndCont lemma expr main CONT_tac) in
-     (* rewrite steps *)
-     lazy_list_fold_right fcons ltac:(fun _=>idtac) terms in
-  LEMMA_tac fv RW_tac.
-
-(********************************************************)
-
-Ltac FV_hypo_tac mkFV req lH :=
-  let R := relation_carrier req in
-  let FV_hypo_l_tac h :=
-    match h with @mkhypo (req ?pe _) _ => mkFV pe end in
-  let FV_hypo_r_tac h :=
-    match h with @mkhypo (req _ ?pe) _ => mkFV pe end in
-  let fv := list_fold_right FV_hypo_l_tac (@nil R) lH in
-  list_fold_right FV_hypo_r_tac fv lH.
-
-Ltac mkHyp_tac C req Reify lH :=
-  let mkHyp h res :=
-   match h with
-   | @mkhypo (req ?r1 ?r2) _ =>
-     let pe1 := Reify r1 in
-     let pe2 := Reify r2 in
-     constr:(cons (pe1,pe2) res)
-   | _ => fail 1 "hypothesis is not a ring equality"
-   end in
-  list_fold_right mkHyp (@nil (PExpr C * PExpr C)) lH.
-
-Ltac proofHyp_tac lH :=
-  let get_proof h :=
-    match h with
-    | @mkhypo _ ?p => p
-    end in
-  let rec bh l :=
-    match l with
-    | nil => constr:(I)
-    | cons ?h nil => get_proof h
-    | cons ?h ?tl =>
-      let l := get_proof h in
-      let r := bh tl in
-      constr:(conj l r)
-    end in
-  bh lH.
-
-Ltac get_MonPol lemma :=
-  match type of lemma with
-  | context [(mk_monpol_list ?cO ?cI ?cadd ?cmul ?csub ?copp ?cdiv ?ceqb _)] =>
-      constr:(mk_monpol_list cO cI cadd cmul csub copp cdiv ceqb)
-  | _ => fail 1 "ring/field anomaly: bad correctness lemma (get_MonPol)"
-  end.
-
-(********************************************************)
-
-(* Building the atom list of a ring expression *)
-(* We do not assume that Cst recognizes the rO and rI terms as constants, as *)
-(* the tactic could be used to discriminate occurrences of an opaque *)
-(* constant phi, with (phi 0) not convertible to 0 for instance *)
-Ltac FV Cst CstPow rO rI add mul sub opp pow t fv :=
- let rec TFV t fv :=
-  let f :=
-  match Cst t with
-  | NotConstant =>
-      match t with
-      | rO =>  fun _ => fv
-      | rI =>  fun _ => fv
-      | (add ?t1 ?t2) => fun _ => TFV t2 ltac:(TFV t1 fv)
-      | (mul ?t1 ?t2) => fun _ => TFV t2 ltac:(TFV t1 fv)
-      | (sub ?t1 ?t2) => fun _ => TFV t2 ltac:(TFV t1 fv)
-      | (opp ?t1) => fun _ => TFV t1 fv
-      | (pow ?t1 ?n) =>
-        match CstPow n with
-        | InitialRing.NotConstant => fun _ => AddFvTail t fv
-        | _ => fun _ => TFV t1 fv
-        end
-      | _ => fun _ => AddFvTail t fv
-      end
-  | _ => fun _ => fv
-  end in
-  f()
- in TFV t fv.
-
- (* syntaxification of ring expressions *)
- (* We do not assume that Cst recognizes the rO and rI terms as constants, as *)
- (* the tactic could be used to discriminate occurrences of an opaque *)
- (* constant phi, with (phi 0) not convertible to 0 for instance *)
-Ltac mkPolexpr C Cst CstPow rO rI radd rmul rsub ropp rpow t fv :=
- let rec mkP t :=
-    let f :=
-    match Cst t with
-    | InitialRing.NotConstant =>
-        match t with
-        | rO => 
-          fun _ => constr:(@PEO C)
-        | rI => 
-          fun _ => constr:(@PEI C)
-        | (radd ?t1 ?t2) =>
-          fun _ =>
-          let e1 := mkP t1 in
-          let e2 := mkP t2 in constr:(@PEadd C e1 e2)
-        | (rmul ?t1 ?t2) =>
-          fun _ =>
-          let e1 := mkP t1 in
-          let e2 := mkP t2 in constr:(@PEmul C e1 e2)
-        | (rsub ?t1 ?t2) =>
-          fun _ =>
-          let e1 := mkP t1 in
-          let e2 := mkP t2 in constr:(@PEsub C e1 e2)
-        | (ropp ?t1) =>
-          fun _ =>
-          let e1 := mkP t1 in constr:(@PEopp C e1)
-        | (rpow ?t1 ?n) =>
-          match CstPow n with
-          | InitialRing.NotConstant =>
-            fun _ => let p := Find_at t fv in constr:(PEX C p)
-          | ?c => fun _ => let e1 := mkP t1 in constr:(@PEpow C e1 c)
-          end
-        | _ =>
-          fun _ => let p := Find_at t fv in constr:(PEX C p)
-        end
-    | ?c => fun _ => constr:(@PEc C c)
-    end in
-    f ()
- in mkP t.
-
-(* packaging the ring structure *)
-
-Ltac PackRing F req sth ext morph arth cst_tac pow_tac lemma1 lemma2 pre post :=
-  let RNG :=
-    match type of lemma1 with
-    | context
-       [@PEeval ?R ?r0 ?r1 ?add ?mul ?sub ?opp ?C ?phi ?Cpow ?powphi ?pow _ _] =>
-        (fun proj => proj
-             cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2)
-    | _ => fail 1 "field anomaly: bad correctness lemma (parse)"
-    end in
-  F RNG.
-
-Ltac get_Carrier RNG :=
-  RNG ltac:(fun cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 =>
-            R).
-
-Ltac get_Eq RNG :=
-  RNG ltac:(fun cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 =>
-            req).
-
-Ltac get_Pre RNG :=
-  RNG ltac:(fun cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 =>
-            pre).
-
-Ltac get_Post RNG :=
-  RNG ltac:(fun cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 =>
-            post).
-
-Ltac get_NormLemma RNG :=
-  RNG ltac:(fun cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 =>
-            lemma1).
-
-Ltac get_SimplifyLemma RNG :=
-  RNG ltac:(fun cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 =>
-            lemma2).
-
-Ltac get_RingFV RNG :=
-  RNG ltac:(fun cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 =>
-            FV cst_tac pow_tac r0 r1 add mul sub opp pow).
-
-Ltac get_RingMeta RNG :=
-  RNG ltac:(fun cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 =>
-            mkPolexpr C cst_tac pow_tac r0 r1 add mul sub opp pow).
-
-Ltac get_RingHypTac RNG :=
-  RNG ltac:(fun cst_tac pow_tac pre post
-             R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 =>
-       let mkPol := mkPolexpr C cst_tac pow_tac r0 r1 add mul sub opp pow in
-       fun fv lH => mkHyp_tac C req ltac:(fun t => mkPol t fv) lH).
-
-(* ring tactics *)
-
-Definition ring_subst_niter := (10*10*10)%nat.
-
-Ltac Ring RNG lemma lH :=
-  let req := get_Eq RNG in
-  OnEquation req ltac:(fun lhs rhs =>
-    let mkFV := get_RingFV RNG in
-    let mkPol := get_RingMeta RNG in
-    let mkHyp := get_RingHypTac RNG in
-    let fv := FV_hypo_tac mkFV ltac:(get_Eq RNG) lH in
-    let fv := mkFV lhs fv in
-    let fv := mkFV rhs fv in
-    check_fv fv;
-    let pe1 := mkPol lhs fv in
-    let pe2 := mkPol rhs fv in
-    let lpe := mkHyp fv lH in
-    let vlpe := fresh "hyp_list" in
-    let vfv := fresh "fv_list" in
-    pose (vlpe := lpe);
-    pose (vfv := fv);
-    (apply (lemma vfv vlpe pe1 pe2)
-      || fail "typing error while applying ring");
-    [ ((let prh := proofHyp_tac lH in exact prh)
-        || idtac "can not automatically prove hypothesis :";
-           [> idtac " maybe a left member of a hypothesis is not a monomial"..])
-    | vm_compute;
-      (exact (eq_refl true) || fail "not a valid ring equation")]).
-
-Ltac Ring_norm_gen f RNG lemma lH rl :=
-  let mkFV := get_RingFV RNG in
-  let mkPol := get_RingMeta RNG in
-  let mkHyp := get_RingHypTac RNG in
-  let mk_monpol := get_MonPol lemma in
-  let fv := FV_hypo_tac mkFV ltac:(get_Eq RNG) lH in
-  let lemma_tac fv kont :=
-    let lpe := mkHyp fv lH in
-    let vlpe := fresh "list_hyp" in
-    let vlmp := fresh "list_hyp_norm" in
-    let vlmp_eq := fresh "list_hyp_norm_eq" in
-    let prh := proofHyp_tac lH in
-    pose (vlpe := lpe);
-    compute_assertion vlmp_eq vlmp (mk_monpol vlpe);
-    let H := fresh "ring_lemma" in
-    (assert (H := lemma vlpe fv prh vlmp vlmp_eq)
-      || fail "type error when build the rewriting lemma");
-    clear vlmp_eq;
-    kont H;
-    (clear H||idtac"Ring_norm_gen: cleanup failed");
-    subst vlpe vlmp in
-  let simpl_ring H := (protect_fv "ring" in H; f H) in
-  ReflexiveRewriteTactic mkFV mkPol lemma_tac simpl_ring fv rl.
-
-Ltac Ring_gen RNG lH rl :=
-  let lemma := get_NormLemma RNG in
-  get_Pre RNG ();
-  Ring RNG (lemma ring_subst_niter) lH.
-
-Tactic Notation (at level 0) "ring" :=
-  let G := Get_goal in
-  ring_lookup (PackRing Ring_gen) [] G.
-
-Tactic Notation (at level 0) "ring" "[" constr_list(lH) "]" :=
-  let G := Get_goal in
-  ring_lookup (PackRing Ring_gen) [lH] G.
-
-(* Simplification *)
-
-Ltac Ring_simplify_gen f RNG lH rl :=
-  let lemma := get_SimplifyLemma RNG in
-  let l := fresh "to_rewrite" in
-  pose (l:= rl);
-  generalize (eq_refl l);
-  unfold l at 2;
-  get_Pre RNG ();
-  let rl :=
-    match goal with
-    | [|- l = ?RL -> _ ] => RL
-    | _ => fail 1 "ring_simplify anomaly: bad goal after pre"
-    end in
-  let Heq := fresh "Heq" in
-  intros Heq;clear Heq l;
-  Ring_norm_gen f RNG (lemma ring_subst_niter) lH rl;
-  get_Post RNG ().
-
-Ltac Ring_simplify := Ring_simplify_gen ltac:(fun H => rewrite H).
-
-Tactic Notation (at level 0) "ring_simplify" constr_list(rl) :=
-  let G := Get_goal in
-  ring_lookup (PackRing Ring_simplify) [] rl G.
-
-Tactic Notation (at level 0)
-  "ring_simplify" "[" constr_list(lH) "]" constr_list(rl) :=
-  let G := Get_goal in
-  ring_lookup (PackRing Ring_simplify) [lH] rl G.
-
-Tactic Notation "ring_simplify" constr_list(rl) "in" hyp(H):=
-  let G := Get_goal in
-  let t := type of H in
-  let g := fresh "goal" in
-  set (g:= G);
-  generalize H;
-  ring_lookup (PackRing Ring_simplify) [] rl t;
-  (* 
-     Correction of bug 1859:
-     we want to leave H at its initial position
-     this is obtained by adding a copy of H (H'), 
-     move it just after H, remove H and finally 
-     rename H into H'
-   *)
-  let H' := fresh "H" in
-  intro H';
-  move H' after H;
-  clear H;rename H' into H;
-  unfold g;clear g.
-
-Tactic Notation "ring_simplify" "["constr_list(lH)"]" constr_list(rl) "in" hyp(H):=
-  let G := Get_goal in
-  let t := type of H in
-  let g := fresh "goal" in
-  set (g:= G);
-  generalize H;
-  ring_lookup (PackRing Ring_simplify) [lH] rl t;
-  (* 
-     Correction of bug 1859:
-     we want to leave H at its initial position
-     this is obtained by adding a copy of H (H'), 
-     move it just after H, remove H and finally 
-     rename H into H'
-   *)
-  let H' := fresh "H" in
-  intro H';
-  move H' after H;
-  clear H;rename H' into H;
-  unfold g;clear g.
diff --git a/plugins/setoid_ring/Ring_theory.v b/plugins/setoid_ring/Ring_theory.v
deleted file mode 100644
index dc45853458..0000000000
--- a/plugins/setoid_ring/Ring_theory.v
+++ /dev/null
@@ -1,619 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Import Setoid Morphisms BinPos BinNat.
-
-Set Implicit Arguments.
-
-Module RingSyntax.
-Reserved Notation "x ?=! y" (at level 70, no associativity).
-Reserved Notation "x +! y " (at level 50, left associativity).
-Reserved Notation "x -! y" (at level 50, left associativity).
-Reserved Notation "x *! y" (at level 40, left associativity).
-Reserved Notation "-! x" (at level 35, right associativity).
-
-Reserved Notation "[ x ]" (at level 0).
-
-Reserved Notation "x ?== y" (at level 70, no associativity).
-Reserved Notation "x -- y" (at level 50, left associativity).
-Reserved Notation "x ** y" (at level 40, left associativity).
-Reserved Notation "-- x" (at level 35, right associativity).
-
-Reserved Notation "x == y" (at level 70, no associativity).
-End RingSyntax.
-Import RingSyntax.
-
-(* Set Universe Polymorphism. *)
-
-Section Power.
- Variable R:Type.
- Variable rI : R.
- Variable rmul : R -> R -> R.
- Variable req : R -> R -> Prop.
- Variable Rsth : Equivalence req.
- Infix "*" := rmul.
- Infix "==" := req.
-
- Hypothesis mul_ext : Proper (req ==> req ==> req) rmul.
- Hypothesis mul_assoc  : forall x y z, x * (y * z) == (x * y) * z.
-
- Fixpoint pow_pos (x:R) (i:positive) : R :=
-  match i with
-  | xH => x
-  | xO i => let p := pow_pos x i in p * p
-  | xI i => let p := pow_pos x i in x * (p * p)
-  end.
-
- Lemma pow_pos_swap x j : pow_pos x j * x == x * pow_pos x j.
- Proof.
-  induction j; simpl; rewrite <- ?mul_assoc.
-  - f_equiv. now do 2 (rewrite IHj, mul_assoc).
-  - now do 2 (rewrite IHj, mul_assoc).
-  - reflexivity.
- Qed.
-
- Lemma pow_pos_succ x j :
-   pow_pos x (Pos.succ j) == x * pow_pos x j.
- Proof.
-  induction j; simpl; try reflexivity.
-  rewrite IHj, <- mul_assoc; f_equiv.
-  now rewrite mul_assoc, pow_pos_swap, mul_assoc.
- Qed.
-
- Lemma pow_pos_add x i j :
-   pow_pos x (i + j) == pow_pos x i * pow_pos x j.
- Proof.
-  induction i using Pos.peano_ind.
-  - now rewrite Pos.add_1_l, pow_pos_succ.
-  - now rewrite Pos.add_succ_l, !pow_pos_succ, IHi, mul_assoc.
- Qed.
-
- Definition pow_N (x:R) (p:N) :=
-  match p with
-  | N0 => rI
-  | Npos p => pow_pos x p
-  end.
-
- Definition id_phi_N (x:N) : N := x.
-
- Lemma pow_N_pow_N x n : pow_N x (id_phi_N n) == pow_N x n.
- Proof.
-  reflexivity.
- Qed.
-
-End Power.
-
-Section DEFINITIONS.
- 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.
- Infix "==" := req. Infix "+" := radd. Infix "*" := rmul.
- Infix "-" := rsub. Notation "- x" := (ropp x).
-
- (** Semi Ring *)
- Record semi_ring_theory : Prop := mk_srt {
-    SRadd_0_l   : forall n, 0 + n == n;
-    SRadd_comm  : forall n m, n + m == m + n ;
-    SRadd_assoc : forall n m p, n + (m + p) == (n + m) + p;
-    SRmul_1_l   : forall n, 1*n == n;
-    SRmul_0_l   : forall n, 0*n == 0;
-    SRmul_comm  : forall n m, n*m == m*n;
-    SRmul_assoc : forall n m p, n*(m*p) == (n*m)*p;
-    SRdistr_l   : forall n m p, (n + m)*p == n*p + m*p
-  }.
-
- (** Almost Ring *)
-(*Almost ring are no ring : Ropp_def is missing **)
- Record almost_ring_theory : Prop := mk_art {
-    ARadd_0_l   : forall x, 0 + x == x;
-    ARadd_comm  : forall x y, x + y == y + x;
-    ARadd_assoc : forall x y z, x + (y + z) == (x + y) + z;
-    ARmul_1_l   : forall x, 1 * x == x;
-    ARmul_0_l   : forall x, 0 * x == 0;
-    ARmul_comm  : forall x y, x * y == y * x;
-    ARmul_assoc : forall x y z, x * (y * z) == (x * y) * z;
-    ARdistr_l   : forall x y z, (x + y) * z == (x * z) + (y * z);
-    ARopp_mul_l : forall x y, -(x * y) == -x * y;
-    ARopp_add   : forall x y, -(x + y) == -x + -y;
-    ARsub_def   : forall x y, x - y == x + -y
-  }.
-
- (** Ring *)
- Record ring_theory : Prop := mk_rt {
-    Radd_0_l    : forall x, 0 + x == x;
-    Radd_comm   : forall x y, x + y == y + x;
-    Radd_assoc  : forall x y z, x + (y + z) == (x + y) + z;
-    Rmul_1_l    : forall x, 1 * x == x;
-    Rmul_comm   : forall x y, x * y == y * x;
-    Rmul_assoc  : forall x y z, x * (y * z) == (x * y) * z;
-    Rdistr_l    : forall x y z, (x + y) * z == (x * z) + (y * z);
-    Rsub_def    : forall x y, x - y == x + -y;
-    Ropp_def    : forall x, x + (- x) == 0
- }.
-
- (** Equality is extensional *)
-
- Record sring_eq_ext : Prop := mk_seqe {
-    (* SRing operators are compatible with equality *)
-    SRadd_ext : Proper (req ==> req ==> req) radd;
-    SRmul_ext : Proper (req ==> req ==> req) rmul
-  }.
-
- Record ring_eq_ext : Prop := mk_reqe {
-    (* Ring operators are compatible with equality *)
-    Radd_ext : Proper (req ==> req ==> req) radd;
-    Rmul_ext : Proper (req ==> req ==> req) rmul;
-    Ropp_ext : Proper (req ==> req) ropp
-  }.
-
- (** Interpretation morphisms definition*)
- Section MORPHISM.
- Variable C:Type.
- Variable (cO cI : C) (cadd cmul csub : C->C->C) (copp : C->C).
- Variable ceqb : C->C->bool.
- (* [phi] est un morphisme de [C] dans [R] *)
- Variable phi : C -> R.
- Infix "+!" := cadd. Infix "-!" := csub.
- Infix "*!" := cmul. Notation "-! x" := (copp x).
- Infix "?=!" := ceqb. Notation "[ x ]" := (phi x).
-
-(*for semi rings*)
- Record semi_morph : Prop := mkRmorph {
-    Smorph0 : [cO] == 0;
-    Smorph1 : [cI] == 1;
-    Smorph_add : forall x y, [x +! y] == [x]+[y];
-    Smorph_mul : forall x y, [x *! y] == [x]*[y];
-    Smorph_eq  : forall x y, x?=!y = true -> [x] == [y]
-  }.
-
-(* for rings*)
- Record ring_morph : Prop := mkmorph {
-    morph0    : [cO] == 0;
-    morph1    : [cI] == 1;
-    morph_add : forall x y, [x +! y] == [x]+[y];
-    morph_sub : forall x y, [x -! y] == [x]-[y];
-    morph_mul : forall x y, [x *! y] == [x]*[y];
-    morph_opp : forall x, [-!x] == -[x];
-    morph_eq  : forall x y, x?=!y = true -> [x] == [y]
-  }.
-
- Section SIGN.
-  Variable get_sign : C -> option C.
-  Record sign_theory : Prop := mksign_th {
-    sign_spec : forall c c', get_sign c = Some c' -> c ?=! -! c' = true
-  }.
- End SIGN.
-
- Definition get_sign_None (c:C) := @None C.
-
- Lemma get_sign_None_th : sign_theory get_sign_None.
- Proof. constructor;intros;discriminate. Qed.
-
- Section DIV.
-  Variable cdiv: C -> C -> C*C.
-  Record div_theory : Prop := mkdiv_th {
-    div_eucl_th : forall a b, let (q,r) := cdiv a b in [a] == [b *! q +! r]
-  }.
- End DIV.
-
- End MORPHISM.
-
- (** Identity is a morphism *)
- Variable Rsth : Equivalence req.
- Variable reqb : R->R->bool.
- Hypothesis morph_req : forall x y, (reqb x y) = true -> x == y.
- Definition IDphi (x:R) := x.
- Lemma IDmorph : ring_morph rO rI radd rmul rsub ropp reqb IDphi.
- Proof.
-  now apply (mkmorph rO rI radd rmul rsub ropp reqb IDphi).
- Qed.
-
- (** Specification of the power function *)
- Section POWER.
-  Variable Cpow : Type.
-  Variable Cp_phi : N -> Cpow.
-  Variable rpow : R -> Cpow -> R.
-
-  Record power_theory : Prop := mkpow_th {
-    rpow_pow_N : forall r n, req (rpow r (Cp_phi n)) (pow_N rI rmul r n)
-  }.
-
- End POWER.
-
- Definition pow_N_th :=
-   mkpow_th id_phi_N (pow_N rI rmul) (pow_N_pow_N rI rmul Rsth).
-
-
-End DEFINITIONS.
-
-Section ALMOST_RING.
- 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.
- Infix "==" := req. Infix "+" := radd.  Infix "* " := rmul.
-
- (** Leibniz equality leads to a setoid theory and is extensional*)
- Lemma Eqsth : Equivalence (@eq R).
- Proof. exact eq_equivalence. Qed.
-
- Lemma Eq_s_ext : sring_eq_ext radd rmul (@eq R).
- Proof. constructor;solve_proper. Qed.
-
- Lemma Eq_ext : ring_eq_ext radd rmul ropp (@eq R).
- Proof. constructor;solve_proper. Qed.
-
- Variable Rsth : Equivalence req.
-
- Section SEMI_RING.
- Variable SReqe : sring_eq_ext radd rmul req.
-
-   Add Morphism radd with signature (req ==> req ==> req) as radd_ext1.
-   Proof. exact (SRadd_ext SReqe). Qed.
-
-   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext1.
-   Proof. exact (SRmul_ext SReqe). Qed.
-
- Variable SRth : semi_ring_theory 0 1 radd rmul req.
-
- (** Every semi ring can be seen as an almost ring, by taking :
-        [-x = x] and [x - y = x + y] *)
- Definition SRopp (x:R) := x. Notation "- x" := (SRopp x).
-
- Definition SRsub x y := x + -y. Infix "-" := SRsub.
-
- Lemma SRopp_ext : forall x y, x == y -> -x == -y.
- Proof. intros x y H; exact H. Qed.
-
- Lemma SReqe_Reqe : ring_eq_ext radd rmul SRopp req.
- Proof.
-  constructor.
-  - exact (SRadd_ext SReqe).
-  - exact (SRmul_ext SReqe).
-  - exact SRopp_ext.
- Qed.
-
- Lemma SRopp_mul_l : forall x y, -(x * y) == -x * y.
- Proof. reflexivity. Qed.
-
- Lemma SRopp_add : forall x y, -(x + y) == -x + -y.
- Proof. reflexivity. Qed.
-
- Lemma SRsub_def   : forall x y, x - y == x + -y.
- Proof. reflexivity. Qed.
-
- Lemma SRth_ARth : almost_ring_theory 0 1 radd rmul SRsub SRopp req.
- Proof (mk_art 0 1 radd rmul SRsub SRopp req
-    (SRadd_0_l SRth) (SRadd_comm SRth) (SRadd_assoc SRth)
-    (SRmul_1_l SRth) (SRmul_0_l SRth)
-    (SRmul_comm SRth) (SRmul_assoc SRth) (SRdistr_l SRth)
-    SRopp_mul_l SRopp_add SRsub_def).
-
- (** Identity morphism for semi-ring equipped with their almost-ring structure*)
- Variable reqb : R->R->bool.
-
- Hypothesis morph_req : forall x y, (reqb x y) = true -> x == y.
-
- Definition SRIDmorph : ring_morph 0 1 radd rmul SRsub SRopp req
-                            0 1 radd rmul SRsub SRopp reqb (@IDphi R).
- Proof.
-  now apply mkmorph.
- Qed.
-
- (* a semi_morph can be extended to a ring_morph for the almost_ring derived
-    from a semi_ring, provided the ring is a setoid (we only need
-    reflexivity) *)
- Variable C : Type.
- Variable (cO cI : C) (cadd cmul: C->C->C).
- Variable (ceqb : C -> C -> bool).
- Variable phi : C -> R.
- Variable Smorph : semi_morph rO rI radd rmul req cO cI cadd cmul ceqb phi.
-
- Lemma SRmorph_Rmorph :
-   ring_morph rO rI radd rmul SRsub SRopp req
-              cO cI cadd cmul cadd (fun x => x) ceqb phi.
- Proof.
- case Smorph; now constructor.
- Qed.
-
- End  SEMI_RING.
- Infix "-" := rsub.
- Notation "- x" := (ropp x).
-
- Variable Reqe : ring_eq_ext radd rmul ropp req.
-
-   Add Morphism radd with signature (req ==> req ==> req) as radd_ext2.
-   Proof. exact (Radd_ext Reqe). Qed.
-
-   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext2.
-   Proof. exact (Rmul_ext Reqe). Qed.
-
-   Add Morphism ropp with signature (req ==> req) as ropp_ext2.
-   Proof. exact (Ropp_ext Reqe). Qed.
-
- Section RING.
- Variable Rth : ring_theory 0 1 radd rmul rsub ropp req.
-
- (** Rings are almost rings*)
- Lemma Rmul_0_l x : 0 * x == 0.
- Proof.
-  setoid_replace (0*x) with ((0+1)*x + -x).
-  now rewrite (Radd_0_l Rth), (Rmul_1_l Rth), (Ropp_def Rth).
-
-  rewrite (Rdistr_l Rth), (Rmul_1_l Rth).
-  rewrite <- (Radd_assoc Rth), (Ropp_def Rth).
-  now rewrite (Radd_comm Rth), (Radd_0_l Rth).
- Qed.
-
- Lemma Ropp_mul_l x y : -(x * y) == -x * y.
- Proof.
-  rewrite <-(Radd_0_l Rth (- x * y)).
-  rewrite (Radd_comm Rth), <-(Ropp_def Rth (x*y)).
-  rewrite (Radd_assoc Rth), <- (Rdistr_l Rth).
-  rewrite (Radd_comm Rth (-x)), (Ropp_def Rth).
-  now rewrite Rmul_0_l, (Radd_0_l Rth).
- Qed.
-
- Lemma Ropp_add x y : -(x + y) == -x + -y.
- Proof.
-  rewrite <- ((Radd_0_l Rth) (-(x+y))).
-  rewrite <- ((Ropp_def Rth) x).
-  rewrite <- ((Radd_0_l Rth) (x + - x + - (x + y))).
-  rewrite <- ((Ropp_def Rth) y).
-  rewrite ((Radd_comm Rth) x).
-  rewrite ((Radd_comm Rth) y).
-  rewrite <- ((Radd_assoc Rth) (-y)).
-  rewrite <- ((Radd_assoc Rth) (- x)).
-  rewrite ((Radd_assoc Rth)  y).
-  rewrite ((Radd_comm Rth) y).
-  rewrite <- ((Radd_assoc Rth)  (- x)).
-  rewrite ((Radd_assoc Rth) y).
-  rewrite ((Radd_comm Rth) y), (Ropp_def Rth).
-  rewrite ((Radd_comm Rth) (-x) 0), (Radd_0_l Rth).
-  now apply (Radd_comm Rth).
- Qed.
-
- Lemma Ropp_opp x : - -x == x.
- Proof.
-  rewrite <- (Radd_0_l Rth (- -x)).
-  rewrite <- (Ropp_def Rth x).
-  rewrite <- (Radd_assoc Rth), (Ropp_def Rth).
-  rewrite ((Radd_comm Rth) x); now apply (Radd_0_l Rth).
- Qed.
-
- Lemma  Rth_ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
- Proof
-  (mk_art 0 1 radd rmul rsub ropp req (Radd_0_l Rth) (Radd_comm Rth) (Radd_assoc Rth)
-    (Rmul_1_l Rth) Rmul_0_l (Rmul_comm Rth) (Rmul_assoc Rth) (Rdistr_l Rth)
-    Ropp_mul_l Ropp_add (Rsub_def Rth)).
-
- (** Every semi morphism between two rings is a morphism*)
- Variable C : Type.
- Variable (cO cI : C) (cadd cmul csub: C->C->C) (copp : C -> C).
- Variable (ceq : C -> C -> Prop) (ceqb : C -> C -> bool).
- Variable phi : C -> R.
-  Infix "+!" := cadd. Infix "*!" := cmul.
-  Infix "-!" := csub. Notation "-! x" := (copp x).
-  Notation "?=!" := ceqb. Notation "[ x ]" := (phi x).
- Variable Csth : Equivalence ceq.
- Variable Ceqe : ring_eq_ext cadd cmul copp ceq.
-
-   Add Parametric Relation : C ceq
-     reflexivity  proved by (@Equivalence_Reflexive _ _ Csth)
-     symmetry     proved by (@Equivalence_Symmetric _ _ Csth)
-     transitivity proved by (@Equivalence_Transitive _ _ Csth)
-    as C_setoid.
-
-   Add Morphism cadd with signature (ceq ==> ceq ==> ceq) as cadd_ext.
-   Proof. exact (Radd_ext Ceqe). Qed.
-
-   Add Morphism cmul with signature (ceq ==> ceq ==> ceq) as cmul_ext.
-   Proof. exact (Rmul_ext Ceqe). Qed.
-
-   Add Morphism copp with signature (ceq ==> ceq) as copp_ext.
-   Proof. exact (Ropp_ext Ceqe). Qed.
-
- Variable Cth : ring_theory cO cI cadd cmul csub copp ceq.
- Variable Smorph : semi_morph 0 1 radd rmul req cO cI cadd cmul ceqb phi.
- Variable phi_ext : forall x y, ceq x y -> [x] == [y].
-
-   Add Morphism phi with signature (ceq ==> req) as phi_ext1.
-   Proof. exact phi_ext. Qed.
-
- Lemma Smorph_opp x : [-!x] == -[x].
- Proof.
-  rewrite <-  (Radd_0_l Rth [-!x]).
-  rewrite <- ((Ropp_def Rth) [x]).
-  rewrite ((Radd_comm Rth) [x]).
-  rewrite <- (Radd_assoc Rth).
-  rewrite <- (Smorph_add Smorph).
-  rewrite (Ropp_def Cth).
-  rewrite (Smorph0 Smorph).
-  rewrite (Radd_comm Rth (-[x])).
-  now apply (Radd_0_l Rth).
- Qed.
-
- Lemma Smorph_sub x y : [x -! y] == [x] - [y].
- Proof.
-  rewrite (Rsub_def Cth), (Rsub_def Rth).
-  now rewrite (Smorph_add Smorph), Smorph_opp.
- Qed.
-
- Lemma Smorph_morph :
-   ring_morph 0 1 radd rmul rsub ropp req
-     cO cI cadd cmul csub copp ceqb phi.
- Proof
-  (mkmorph 0 1 radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi
-        (Smorph0 Smorph) (Smorph1 Smorph)
-         (Smorph_add Smorph) Smorph_sub (Smorph_mul Smorph) Smorph_opp
-         (Smorph_eq Smorph)).
-
- End RING.
-
- (** Useful lemmas on almost ring *)
- Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
-
- Lemma ARth_SRth : semi_ring_theory 0 1 radd rmul req.
-Proof.
-elim ARth; intros.
-constructor; trivial.
-Qed.
-
- Instance ARsub_ext : Proper (req ==> req ==> req) rsub.
- Proof.
-  intros x1 x2 Ex y1 y2 Ey.
-  now rewrite !(ARsub_def ARth), Ex, Ey.
- Qed.
-
- Ltac mrewrite :=
-   repeat first
-     [ rewrite (ARadd_0_l ARth)
-     | rewrite <- ((ARadd_comm ARth) 0)
-     | rewrite (ARmul_1_l ARth)
-     | rewrite <- ((ARmul_comm ARth) 1)
-     | rewrite (ARmul_0_l ARth)
-     | rewrite <- ((ARmul_comm ARth) 0)
-     | rewrite (ARdistr_l ARth)
-     | reflexivity
-     | match goal with
-       | |- context [?z * (?x + ?y)] => rewrite ((ARmul_comm ARth) z (x+y))
-       end].
-
- Lemma ARadd_0_r x : x + 0 == x.
- Proof. mrewrite. Qed.
-
- Lemma ARmul_1_r x : x * 1 == x.
- Proof. mrewrite. Qed.
-
- Lemma ARmul_0_r x : x * 0 == 0.
- Proof. mrewrite. Qed.
-
- Lemma ARdistr_r x y z : z * (x + y) == z*x + z*y.
- Proof.
-  mrewrite. now rewrite !(ARmul_comm ARth z).
- Qed.
-
- Lemma ARadd_assoc1 x y z : (x + y) + z == (y + z) + x.
- Proof.
-  now rewrite <-(ARadd_assoc ARth x), (ARadd_comm ARth x).
- Qed.
-
- Lemma ARadd_assoc2 x y z : (y + x) + z == (y + z) + x.
- Proof.
-  now rewrite <- !(ARadd_assoc ARth), ((ARadd_comm ARth) x).
- Qed.
-
- Lemma ARmul_assoc1 x y z : (x * y) * z == (y * z) * x.
- Proof.
-  now rewrite <- ((ARmul_assoc ARth) x), ((ARmul_comm ARth) x).
- Qed.
-
- Lemma ARmul_assoc2 x y z : (y * x) * z == (y * z) * x.
- Proof.
-  now rewrite <- !(ARmul_assoc ARth), ((ARmul_comm ARth) x).
- Qed.
-
- Lemma ARopp_mul_r x y : - (x * y) == x * -y.
- Proof.
-  rewrite ((ARmul_comm ARth) x y), (ARopp_mul_l ARth).
-  now apply (ARmul_comm ARth).
- Qed.
-
- Lemma ARopp_zero : -0 == 0.
- Proof.
-  now rewrite <- (ARmul_0_r 0), (ARopp_mul_l ARth), !ARmul_0_r.
- Qed.
-
-End ALMOST_RING.
-
-Section AddRing.
-
-(* Variable R : Type.
- Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
- Variable req : R -> R -> Prop. *)
-
-Inductive ring_kind : Type :=
-| Abstract
-| Computational
-    (R:Type)
-    (req : R -> R -> Prop)
-    (reqb : R -> R -> bool)
-    (_ : forall x y, (reqb x y) = true -> req x y)
-| Morphism
-    (R : Type)
-    (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R)
-    (req : R -> R -> Prop)
-    (C : Type)
-    (cO cI : C) (cadd cmul csub : C->C->C) (copp : C->C)
-    (ceqb : C->C->bool)
-    phi
-    (_ : ring_morph rO rI radd rmul rsub ropp req
-                    cO cI cadd cmul csub copp ceqb phi).
-
-End AddRing.
-
-
-(** Some simplification tactics*)
-Ltac gen_reflexivity Rsth := apply (Seq_refl _ _ Rsth).
-
-Ltac gen_srewrite Rsth Reqe ARth :=
-  repeat first
-     [ gen_reflexivity Rsth
-     | progress rewrite (ARopp_zero Rsth Reqe ARth)
-     | rewrite (ARadd_0_l ARth)
-     | rewrite (ARadd_0_r Rsth ARth)
-     | rewrite (ARmul_1_l ARth)
-     | rewrite (ARmul_1_r Rsth ARth)
-     | rewrite (ARmul_0_l ARth)
-     | rewrite (ARmul_0_r Rsth ARth)
-     | rewrite (ARdistr_l ARth)
-     | rewrite (ARdistr_r Rsth Reqe ARth)
-     | rewrite (ARadd_assoc ARth)
-     | rewrite (ARmul_assoc ARth)
-     | progress rewrite (ARopp_add ARth)
-     | progress rewrite (ARsub_def ARth)
-     | progress rewrite <- (ARopp_mul_l ARth)
-     | progress rewrite <- (ARopp_mul_r Rsth Reqe ARth) ].
-
-Ltac gen_srewrite_sr Rsth Reqe ARth :=
-  repeat first
-     [ gen_reflexivity Rsth
-     | progress rewrite (ARopp_zero Rsth Reqe ARth)
-     | rewrite (ARadd_0_l ARth)
-     | rewrite (ARadd_0_r Rsth ARth)
-     | rewrite (ARmul_1_l ARth)
-     | rewrite (ARmul_1_r Rsth ARth)
-     | rewrite (ARmul_0_l ARth)
-     | rewrite (ARmul_0_r Rsth ARth)
-     | rewrite (ARdistr_l ARth)
-     | rewrite (ARdistr_r Rsth Reqe ARth)
-     | rewrite (ARadd_assoc ARth)
-     | rewrite (ARmul_assoc ARth) ].
-
-Ltac gen_add_push add Rsth Reqe ARth x :=
-  repeat (match goal with
-  | |- context [add (add ?y x) ?z] =>
-     progress rewrite (ARadd_assoc2 Rsth Reqe ARth x y z)
-  | |- context [add (add x ?y) ?z] =>
-     progress rewrite (ARadd_assoc1 Rsth ARth x y z)
-  | |- context [(add x ?y)] =>
-     progress rewrite (ARadd_comm ARth x y)
-  end).
-
-Ltac gen_mul_push mul Rsth Reqe ARth x :=
-  repeat (match goal with
-  | |- context [mul (mul ?y x) ?z] =>
-     progress rewrite (ARmul_assoc2 Rsth Reqe ARth x y z)
-  | |- context [mul (mul x ?y) ?z] =>
-     progress rewrite (ARmul_assoc1 Rsth ARth x y z)
-  | |- context [(mul x ?y)] =>
-     progress rewrite (ARmul_comm ARth x y)
-  end).
diff --git a/plugins/setoid_ring/Rings_Q.v b/plugins/setoid_ring/Rings_Q.v
deleted file mode 100644
index b3ed0be916..0000000000
--- a/plugins/setoid_ring/Rings_Q.v
+++ /dev/null
@@ -1,41 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Export Cring.
-Require Export Integral_domain.
-
-(* Rational numbers *)
-Require Import QArith.
-
-Instance Qops: (@Ring_ops Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq).
-Defined.
-
-Instance Qri : (Ring (Ro:=Qops)).
-constructor.
-try apply Q_Setoid. 
-apply Qplus_comp. 
-apply Qmult_comp. 
-apply Qminus_comp. 
-apply Qopp_comp.
- exact Qplus_0_l. exact Qplus_comm. apply Qplus_assoc.
- exact Qmult_1_l.  exact Qmult_1_r. apply Qmult_assoc.
- apply Qmult_plus_distr_l.  intros. apply Qmult_plus_distr_r. 
-reflexivity. exact Qplus_opp_r.
-Defined.
-
-Instance Qcri: (Cring (Rr:=Qri)).
-red. exact Qmult_comm. Defined.
-
-Lemma Q_one_zero: not (Qeq 1%Q 0%Q).
-unfold Qeq. simpl. auto with *. Qed.
-
-Instance Qdi : (Integral_domain (Rcr:=Qcri)). 
-constructor. 
-exact Qmult_integral. exact Q_one_zero. Defined.
diff --git a/plugins/setoid_ring/Rings_R.v b/plugins/setoid_ring/Rings_R.v
deleted file mode 100644
index ec91fa9e97..0000000000
--- a/plugins/setoid_ring/Rings_R.v
+++ /dev/null
@@ -1,45 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Export Cring.
-Require Export Integral_domain.
-
-(* Real numbers *)
-Require Import Reals.
-Require Import RealField.
-
-Lemma Rsth : Setoid_Theory R (@eq R).
-constructor;red;intros;subst;trivial.
-Qed.
-
-Instance Rops: (@Ring_ops R 0%R 1%R Rplus Rmult Rminus Ropp (@eq R)).
-Defined.
-
-Instance Rri : (Ring (Ro:=Rops)).
-constructor;
-try (try apply Rsth;
-   try (unfold respectful, Proper; unfold equality; unfold eq_notation in *;
-  intros; try rewrite H; try rewrite H0; reflexivity)).
- exact Rplus_0_l. exact Rplus_comm. symmetry. apply Rplus_assoc.
- exact Rmult_1_l.  exact Rmult_1_r. symmetry. apply Rmult_assoc.
- exact Rmult_plus_distr_r. intros; apply Rmult_plus_distr_l. 
-exact Rplus_opp_r.
-Defined.
-
-Instance Rcri: (Cring (Rr:=Rri)).
-red. exact Rmult_comm. Defined.
-
-Lemma R_one_zero: 1%R <> 0%R.
-discrR.
-Qed.
-
-Instance Rdi : (Integral_domain (Rcr:=Rcri)). 
-constructor. 
-exact Rmult_integral. exact R_one_zero. Defined.
diff --git a/plugins/setoid_ring/Rings_Z.v b/plugins/setoid_ring/Rings_Z.v
deleted file mode 100644
index 8a51bcea02..0000000000
--- a/plugins/setoid_ring/Rings_Z.v
+++ /dev/null
@@ -1,24 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Export Cring.
-Require Export Integral_domain.
-Require Export Ncring_initial.
-Require Export Omega.
-
-Instance Zcri: (Cring (Rr:=Zr)).
-red. exact Z.mul_comm. Defined.
-
-Lemma Z_one_zero: 1%Z <> 0%Z.
-Proof. discriminate. Qed.
-
-Instance Zdi : (Integral_domain (Rcr:=Zcri)). 
-constructor. 
-exact Zmult_integral. exact Z_one_zero. Defined.
diff --git a/plugins/setoid_ring/ZArithRing.v b/plugins/setoid_ring/ZArithRing.v
deleted file mode 100644
index 833e19a698..0000000000
--- a/plugins/setoid_ring/ZArithRing.v
+++ /dev/null
@@ -1,58 +0,0 @@
-(************************************************************************)
-(*         *   The Coq Proof Assistant / The Coq Development Team       *)
-(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2019       *)
-(* <O___,, *       (see CREDITS file for the list of authors)           *)
-(*   \VV/  **************************************************************)
-(*    //   *    This file is distributed under the terms of the         *)
-(*         *     GNU Lesser General Public License Version 2.1          *)
-(*         *     (see LICENSE file for the text of the license)         *)
-(************************************************************************)
-
-Require Export Ring.
-Require Import ZArith_base.
-Require Import Zpow_def.
-
-Import InitialRing.
-
-Set Implicit Arguments.
-
-Ltac Zcst t :=
-  match isZcst t with
-    true => t
-  | _ => constr:(NotConstant)
-  end.
-
-Ltac isZpow_coef t :=
-  match t with
-  | Zpos ?p => isPcst p
-  | Z0 => constr:(true)
-  | _ => constr:(false)
-  end.
-
-Notation N_of_Z := Z.to_N (only parsing).
-
-Ltac Zpow_tac t :=
- match isZpow_coef t with
- | true => constr:(N_of_Z t)
- | _ => constr:(NotConstant)
- end.
-
-Ltac Zpower_neg :=
-  repeat match goal with
-  | [|- ?G] =>
-    match G with
-    | context c [Z.pow _ (Zneg _)] =>
-      let t := context c [Z0] in
-      change t
-    end
-  end.
-
-Add Ring Zr : Zth
-  (decidable Zeq_bool_eq, constants [Zcst], preprocess [Zpower_neg;unfold Z.succ],
-   power_tac Zpower_theory [Zpow_tac],
-    (* The following two options are not needed; they are the default choice
-       when the set of coefficient is the usual ring Z *)
-    div (InitialRing.Ztriv_div_th (@Eqsth Z) (@IDphi Z)),
-   sign get_signZ_th).
-
-