Imported Upstream snapshot 8.3~beta0+13298

26 files changed, 0 insertions, 12878 deletions

diff --git a/contrib/micromega/CheckerMaker.v b/contrib/micromega/CheckerMaker.v
deleted file mode 100644
index 93b4d213..00000000
--- a/contrib/micromega/CheckerMaker.v
+++ /dev/null
@@ -1,129 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-Require Import Setoid.
-Require Import Decidable.
-Require Import List.
-Require Import Refl.
-
-Set Implicit Arguments.
-
-Section CheckerMaker.
-
-(* 'Formula' is a syntactic representation of a certain kind of propositions. *)
-Variable Formula : Type.
-
-Variable Env : Type.
-
-Variable eval : Env -> Formula -> Prop.
-
-Variable Formula' : Type.
-
-Variable eval' : Env -> Formula' -> Prop.
-
-Variable normalise : Formula -> Formula'.
-
-Variable negate : Formula -> Formula'.
-
-Hypothesis normalise_sound :
-  forall (env : Env) (t : Formula), eval env t -> eval' env (normalise t).
-
-Hypothesis negate_correct :
-  forall (env : Env) (t : Formula), eval env t <-> ~ (eval' env (negate t)).
-
-Variable Witness : Type.
-
-Variable check_formulas' : list Formula' -> Witness -> bool.
-
-Hypothesis check_formulas'_sound :
-  forall (l : list Formula') (w : Witness),
-    check_formulas' l w = true ->
-      forall env : Env, make_impl (eval' env) l False.
-
-Definition normalise_list : list Formula -> list Formula' := map normalise.
-Definition negate_list : list Formula -> list Formula' := map negate.
-
-Definition check_formulas (l : list Formula) (w : Witness) : bool :=
-  check_formulas' (map normalise l) w.
-
-(* Contraposition of normalise_sound for lists *)
-Lemma normalise_sound_contr : forall (env : Env) (l : list Formula),
-  make_impl (eval' env) (map normalise l) False -> make_impl (eval env) l False.
-Proof.
-intros env l; induction l as [| t l IH]; simpl in *.
-trivial.
-intros H1 H2. apply IH. apply H1. now apply normalise_sound.
-Qed.
-
-Theorem check_formulas_sound :
-  forall (l : list Formula) (w : Witness),
-    check_formulas l w = true -> forall env : Env, make_impl (eval env) l False.
-Proof.
-unfold check_formulas; intros l w H env. destruct l as [| t l]; simpl in *.
-pose proof (check_formulas'_sound H env) as H1; now simpl in H1.
-intro H1. apply normalise_sound in H1.
-pose proof (check_formulas'_sound H env) as H2; simpl in H2.
-apply H2 in H1. now apply normalise_sound_contr.
-Qed.
-
-(* In check_conj_formulas', t2 is supposed to be a list of negations of
-formulas. If, for example, t1 = [A1, A2] and t2 = [~ B1, ~ B2], then
-check_conj_formulas' checks that each of [~ B1, A1, A2] and [~ B2, A1, A2] is
-inconsistent. This means that A1 /\ A2 -> B1 and A1 /\ A2 -> B1, i.e., that
-A1 /\ A2 -> B1 /\ B2. *)
-
-Fixpoint check_conj_formulas'
-  (t1 : list Formula') (wits : list Witness) (t2 : list Formula') {struct wits} : bool :=
-match t2 with
-| nil => true
-| t':: rt2 =>
-  match wits with
-  | nil => false
-  | w :: rwits =>
-    match check_formulas' (t':: t1) w with
-    | true => check_conj_formulas' t1 rwits rt2
-    | false => false
-    end
-  end
-end.
-
-(* checks whether the conjunction of t1 implies the conjunction of t2 *)
-
-Definition check_conj_formulas
-  (t1 : list Formula) (wits : list Witness) (t2 : list Formula) : bool :=
-    check_conj_formulas' (normalise_list t1) wits (negate_list t2).
-
-Theorem check_conj_formulas_sound :
-  forall (t1 : list Formula) (t2 : list Formula) (wits : list Witness),
-    check_conj_formulas t1 wits t2 = true ->
-      forall env : Env, make_impl (eval env) t1 (make_conj (eval env) t2).
-Proof.
-intro t1; induction t2 as [| a2 t2' IH].
-intros; apply make_impl_true.
-intros wits H env.
-unfold check_conj_formulas in H; simpl in H.
-destruct wits as [| w ws]; simpl in H. discriminate.
-case_eq (check_formulas' (negate a2 :: normalise_list t1) w);
-intro H1; rewrite H1 in H; [| discriminate].
-assert (H2 : make_impl (eval' env) (negate a2 :: normalise_list t1) False) by
-now apply check_formulas'_sound with (w := w). clear H1.
-pose proof (IH ws H env) as H1. simpl in H2.
-assert (H3 : eval' env (negate a2) -> make_impl (eval env) t1 False)
-by auto using normalise_sound_contr. clear H2.
-rewrite <- make_conj_impl in *.
-rewrite make_conj_cons. intro H2. split.
-apply <- negate_correct. intro; now elim H3. exact (H1 H2).
-Qed.
-
-End CheckerMaker.
diff --git a/contrib/micromega/Env.v b/contrib/micromega/Env.v
deleted file mode 100644
index 40db9e46..00000000
--- a/contrib/micromega/Env.v
+++ /dev/null
@@ -1,182 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-Require Import ZArith.
-Require Import Coq.Arith.Max.
-Require Import List.
-Set Implicit Arguments.
-
-(* I have addded a Leaf constructor to the varmap data structure (/contrib/ring/Quote.v) 
-   -- this is harmless and spares a lot of Empty.
-   This means smaller proof-terms. 
-   BTW, by dropping the  polymorphism, I get small (yet noticeable) speed-up.
-*)
-
-Section S.
-
-  Variable D :Type.
-
-  Definition Env := positive -> D.
-
-  Definition jump  (j:positive) (e:Env) := fun x => e (Pplus x j).
-
-  Definition nth  (n:positive) (e : Env ) := e n.
-
-  Definition hd (x:D)  (e: Env)  := nth xH e.
-
-  Definition tail (e: Env) := jump xH e.
-
-  Lemma psucc : forall p,  (match p with
-                              | xI y' => xO (Psucc y')
-                              | xO y' => xI y'
-                              | 1%positive => 2%positive 
-                            end) = (p+1)%positive.
-  Proof.
-    destruct p.
-    auto with zarith.
-    rewrite xI_succ_xO.
-    auto with zarith.
-    reflexivity.
-  Qed.
-
-  Lemma jump_Pplus : forall i j l, 
-    forall x, jump (i + j) l x = jump i (jump j l) x.
-  Proof.
-    unfold jump.
-    intros.
-    rewrite Pplus_assoc.
-    reflexivity.
-  Qed.
-
-  Lemma jump_simpl : forall p l,
-    forall x, jump p l x = 
-    match p with
-      | xH => tail l x
-      | xO p => jump p (jump p l) x
-      | xI p  => jump p (jump p (tail l)) x
-    end.
-  Proof.
-    destruct p ; unfold tail ; intros ;  repeat rewrite <- jump_Pplus.
-    (* xI p = p + p + 1 *)
-    rewrite xI_succ_xO.
-    rewrite Pplus_diag.
-    rewrite <- Pplus_one_succ_r.
-    reflexivity.
-    (* xO p = p + p *)
-    rewrite Pplus_diag.
-    reflexivity.
-    reflexivity.
-  Qed.
-
-  Ltac jump_s :=
-    repeat 
-      match goal with
-        | |- context [jump xH ?e] => rewrite (jump_simpl xH)
-        | |- context [jump (xO ?p) ?e] => rewrite (jump_simpl (xO p))
-        | |- context [jump (xI ?p) ?e] => rewrite (jump_simpl (xI p))
-      end.
-    
-  Lemma jump_tl : forall j l, forall x, tail (jump j l) x = jump j (tail l) x.
-  Proof. 
-    unfold tail.
-    intros.
-    repeat rewrite <- jump_Pplus.
-    rewrite Pplus_comm.
-    reflexivity.
-  Qed.
-
-  Lemma jump_Psucc : forall j l, 
-    forall x, (jump (Psucc j) l x) = (jump 1 (jump j l) x).
-  Proof.
-    intros.
-    rewrite <- jump_Pplus.
-    rewrite Pplus_one_succ_r.
-    rewrite Pplus_comm.
-    reflexivity.
-  Qed.
-
-  Lemma jump_Pdouble_minus_one : forall i l,
-    forall x, (jump (Pdouble_minus_one i) (tail l)) x = (jump i (jump i l)) x.
-  Proof.
-    unfold tail.
-    intros.
-    repeat rewrite <- jump_Pplus.
-    rewrite <- Pplus_one_succ_r.
-    rewrite Psucc_o_double_minus_one_eq_xO.
-    rewrite Pplus_diag.
-    reflexivity.
-  Qed.
-
-  Lemma jump_x0_tail : forall p l, forall x, jump (xO p) (tail l) x = jump (xI p) l x.
-  Proof.
-    intros.
-    unfold jump.
-    unfold tail.
-    unfold jump.
-    rewrite <- Pplus_assoc.
-    simpl.
-    reflexivity.
-  Qed.
-
-  Lemma nth_spec : forall p l x, 
-    nth p l = 
-    match p with
-      | xH => hd x l
-      | xO p => nth p (jump p l)
-      | xI p => nth p (jump p (tail l))
-    end. 
-  Proof.
-    unfold nth.
-    destruct p.
-    intros.
-    unfold jump, tail.
-    unfold jump.
-    rewrite Pplus_diag.
-    rewrite xI_succ_xO.
-    simpl.
-    reflexivity.
-    unfold jump.
-    rewrite Pplus_diag.
-    reflexivity.
-    unfold hd.
-    unfold nth.
-    reflexivity.
-  Qed.
-
-
-  Lemma nth_jump : forall p l x, nth p (tail l) = hd x (jump p l).
-  Proof.
-    unfold tail.
-    unfold hd.
-    unfold jump.
-    unfold nth.
-    intros.
-    rewrite Pplus_comm.
-    reflexivity.
-  Qed.
-
-  Lemma nth_Pdouble_minus_one :
-    forall p l, nth (Pdouble_minus_one p) (tail l) = nth p (jump p l).
-  Proof.
-    intros.
-    unfold tail.
-    unfold nth, jump.
-    rewrite Pplus_diag.
-    rewrite <- Psucc_o_double_minus_one_eq_xO.
-    rewrite Pplus_one_succ_r.
-    reflexivity.
-  Qed.
-
-End S.
-
diff --git a/contrib/micromega/EnvRing.v b/contrib/micromega/EnvRing.v
deleted file mode 100644
index 04e68272..00000000
--- a/contrib/micromega/EnvRing.v
+++ /dev/null
@@ -1,1403 +0,0 @@
-(************************************************************************)
-(*  V      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(* F. Besson: to evaluate polynomials, the original code is using a list.
-   For big polynomials, this is inefficient -- linear access.
-   I have modified the code to use binary trees -- logarithmic access.  *)
-
-
-Set Implicit Arguments.
-Require Import Setoid.
-Require Import BinList.
-Require Import Env.
-Require Import BinPos.
-Require Import BinNat.
-Require Import BinInt.
-Require Export Ring_theory.
-
-Open Local Scope positive_scope.
-Import RingSyntax.
-
-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 : 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.
-
- (* 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 : Set.
- Variable Cp_phi : N -> Cpow.
- Variable rpow : R -> Cpow -> R.
- Variable pow_th : power_theory rI rmul req Cp_phi rpow.
-
-
- (* R notations *)
- 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).
-
- (* C notations *)		
- Notation "x +! y" := (cadd x y). Notation "x *! y " := (cmul x y).
- Notation "x -! y " := (csub x y). Notation "-! x" := (copp x).
- Notation " x ?=! y" := (ceqb x y). Notation "[ x ]" := (phi x).
-
- (* Usefull tactics *)		
-  Add Setoid R req Rsth as R_set1.
- Ltac rrefl := gen_reflexivity Rsth.
-  Add Morphism radd : radd_ext.  exact (Radd_ext Reqe). Qed.
-  Add Morphism rmul : rmul_ext.  exact (Rmul_ext Reqe). Qed.
-  Add Morphism ropp : ropp_ext.  exact (Ropp_ext Reqe). Qed.
-  Add Morphism rsub : rsub_ext. 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.
-
- (* 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 Pcompare j j' Eq with
-    | Eq => Peq Q Q'
-    | _ => false
-    end
-  | PX P i Q, PX P' i' Q' =>
-    match Pcompare i i' Eq with
-    | Eq => if Peq P P' then Peq Q Q' else false
-    | _ => false
-    end
-  | _, _ => false
-  end.
-
- Notation " P ?== P' " := (Peq P P').
-
- Definition mkPinj j P :=
-  match P with
-  | Pc _ => P
-  | Pinj j' Q => Pinj ((j + j'):positive) Q
-  | _ => Pinj j P
-  end.
-
- Definition mkPinj_pred j P:=
-  match j with
-  | xH => P
-  | xO j => Pinj (Pdouble_minus_one 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) {struct P} : 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) {struct P} : 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){struct P} : Pol :=
-   match P with
-   | Pc c => mkPinj j (PaddC Q c)
-   | Pinj j' Q' =>
-     match ZPminus 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 (Pdouble_minus_one j) Q')
-     | xI j => PX P i (PaddI (xO j) Q')
-     end
-   end.
-
-  Fixpoint PsubI (j:positive) (P:Pol){struct P} : Pol :=
-   match P with
-   | Pc c => mkPinj j (PaddC (--Q) c)
-   | Pinj j' Q' =>
-     match ZPminus 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 (Pdouble_minus_one j) Q')
-     | xI j => PX P i (PsubI (xO j) Q')
-     end
-   end.
-
- Variable P' : Pol.
-
- Fixpoint PaddX (i':positive) (P:Pol) {struct P} : 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 (Pdouble_minus_one j) Q')
-    | xI j => PX P' i' (Pinj (xO j) Q')
-    end
-  | PX P i Q' =>
-    match ZPminus 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) {struct P} : 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 (Pdouble_minus_one j) Q')
-    | xI j => PX (--P') i' (Pinj (xO j) Q')
-    end
-  | PX P i Q' =>
-    match ZPminus 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 (Pdouble_minus_one j) Q) Q')
-      | xI j => PX P' i' (Padd (Pinj (xO j) Q) Q')
-      end
-    | PX P i Q =>
-      match ZPminus 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.
- Notation "P ++ P'" := (Padd P P').
-
- 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 (Pdouble_minus_one j) Q) Q')
-      | xI j => PX (--P') i' (Psub (Pinj (xO j) Q) Q')
-      end
-    | PX P i Q =>
-      match ZPminus 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.
- Notation "P -- P'" := (Psub P P').
-
- (** Multiplication *)
-
- Fixpoint PmulC_aux (P:Pol) (c:C) {struct P} : 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) {struct P} : Pol :=
-   match P with
-   | Pc c => mkPinj j (PmulC Q c)
-   | Pinj j' Q' =>
-     match ZPminus 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 (Pdouble_minus_one j') Q')
-     | xI j' => mkPX (PmulI j P') i' (PmulI (xO j') Q')
-     end
-   end.
-
- End PmulI.
-(* A symmetric version of the multiplication *)
-
- 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 (Pdouble_minus_one 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.
-
-(* Non symmetric *)
-(*
- Fixpoint Pmul_aux (P P' : Pol) {struct P'} : Pol :=
-  match P' with
-  | Pc c' => PmulC P c'
-  | Pinj j' Q' => PmulI Pmul_aux Q' j' P
-  | PX P' i' Q' =>
-     (mkPX (Pmul_aux P P') i' P0) ++ (PmulI Pmul_aux Q' xH P)
-  end.
-
- Definition Pmul P P' :=
-  match P with
-  | Pc c => PmulC P' c
-  | Pinj j Q => PmulI Pmul_aux Q j P'
-  | PX P i Q =>
-    (mkPX (Pmul_aux P P') i P0) ++ (PmulI Pmul_aux Q xH P')
-  end.
-*)
- Notation "P ** P'" := (Pmul P P').
-
- Fixpoint Psquare (P:Pol) : Pol :=
-   match P with
-   | Pc c => Pc (c *! c)
-   | Pinj j Q => Pinj j (Psquare Q)
-   | PX P i Q =>
-     let twoPQ := Pmul P (mkPinj xH (PmulC Q (cI +! cI))) in
-     let Q2 := Psquare Q in
-     let P2 := Psquare P in
-     mkPX (mkPX P2 i P0 ++ twoPQ) i Q2
-   end.
-
- (** Monomial **)
-
-  Inductive Mon: Set :=
-    mon0: Mon
-  | zmon: positive -> Mon -> Mon
-  | vmon: positive -> Mon -> Mon.
-
- Fixpoint Mphi(l:Env R) (M: Mon) {struct M} : R :=
-  match M with
-     mon0 => rI
-  | zmon j M1  => Mphi (jump j l) M1
-  | vmon i M1 =>
-     let x := hd 0 l in
-     let xi := pow_pos rmul x i in
-    (Mphi (tail l) M1) * xi
-  end.
-
- Definition mkZmon j M :=
-   match M with mon0 => mon0 | _ => zmon j M end.
-
- Definition zmon_pred j M :=
-   match j with xH => M | _ => mkZmon (Ppred 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 MFactor (P: Pol) (M: Mon) {struct P}: Pol * Pol :=
-   match P, M with
-        _, mon0 => (Pc cO, P)
-   | Pc _, _    => (P, Pc cO)
-   | Pinj j1 P1, zmon j2 M1 =>
-      match (j1 ?= j2) Eq with
-        Eq => let (R,S) := MFactor P1 M1 in
-                 (mkPinj j1 R, mkPinj j1 S)
-      | Lt => let (R,S) := MFactor P1 (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 M in
-             let (R2, S2) := MFactor Q1 M2 in
-               (mkPX R1 i R2, mkPX S1 i S2)
-  | PX P1 i Q1, vmon j M1 =>
-      match (i ?= j) Eq with
-        Eq => let (R1,S1) := MFactor P1 (mkZmon xH M1) in
-                 (mkPX R1 i Q1, S1)
-      | Lt => let (R1,S1) := MFactor P1 (vmon (j - i) M1) in
-                 (mkPX R1 i Q1, S1)
-      | Gt => let (R1,S1) := MFactor P1 (mkZmon xH M1) in
-                 (mkPX R1 i Q1, mkPX S1 (i-j) (Pc cO))
-      end
-   end.
-
-  Definition POneSubst (P1: Pol) (M1: Mon) (P2: Pol): option Pol :=
-    let (Q1,R1) := MFactor P1 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) (M1: Mon) (P2: Pol) (n: nat) {struct n}: Pol :=
-    match POneSubst P1 M1 P2 with
-     Some P3 => match n with S n1 => PNSubst1 P3 M1 P2 n1 | _ => P3 end
-    | _ => P1
-    end.
-
-  Definition PNSubst (P1: Pol) (M1: Mon) (P2: Pol) (n: nat): option Pol :=
-    match POneSubst P1 M1 P2 with
-     Some P3 => match n with S n1 => Some (PNSubst1 P3 M1 P2 n1) | _ => None end
-    | _ => None
-    end.
-
-  Fixpoint PSubstL1 (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) {struct LM1}:
-     Pol :=
-    match LM1 with
-     cons (M1,P2) LM2 => PSubstL1 (PNSubst1 P1 M1 P2 n) LM2 n
-    | _ => P1
-    end.
-
-  Fixpoint PSubstL (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) {struct LM1}: 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 (Mon * Pol)) (m n: nat) {struct m}: 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 *)
-
- Fixpoint Pphi(l:Env R) (P:Pol) {struct P} : R :=
-  match P with
-  | Pc c => [c]
-  | Pinj j Q => Pphi (jump j l) Q
-  | PX P i Q =>
-     let x := hd 0 l in
-     let xi := pow_pos rmul x i in
-    (Pphi l P) * xi + (Pphi (tail l) Q)
-  end.
-
- Reserved Notation "P @ l " (at level 10, no associativity).
- Notation "P @ l " := (Pphi l P).
- (** Proofs *)
- Lemma ZPminus_spec : forall x y,
-  match ZPminus x y with
-  | Z0 => x = y
-  | Zpos k => x = (y + k)%positive
-  | Zneg k => y = (x + k)%positive
-  end.
- Proof.
-  induction x;destruct y.
-  replace (ZPminus (xI x) (xI y)) with (Zdouble (ZPminus x y));trivial.
-  assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble;rewrite H;trivial.
-  replace (ZPminus (xI x) (xO y)) with (Zdouble_plus_one (ZPminus x y));trivial.
-  assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble_plus_one;rewrite H;trivial.
-  apply Pplus_xI_double_minus_one.
-  simpl;trivial.
-  replace (ZPminus (xO x) (xI y)) with (Zdouble_minus_one (ZPminus x y));trivial.
-  assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble_minus_one;rewrite H;trivial.
-  apply Pplus_xI_double_minus_one.
-  replace (ZPminus (xO x) (xO y)) with (Zdouble (ZPminus x y));trivial.
-  assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble;rewrite H;trivial.
-  replace (ZPminus (xO x) xH) with (Zpos (Pdouble_minus_one x));trivial.
-  rewrite <- Pplus_one_succ_l.
-  rewrite Psucc_o_double_minus_one_eq_xO;trivial.
-  replace (ZPminus xH (xI y)) with (Zneg (xO y));trivial.
-  replace (ZPminus xH (xO y)) with (Zneg (Pdouble_minus_one y));trivial.
-  rewrite <- Pplus_one_succ_l.
-  rewrite Psucc_o_double_minus_one_eq_xO;trivial.
-  simpl;trivial.
- Qed.
-
- Lemma Peq_ok : forall P P',
-    (P ?== P') = true -> forall l, P@l == P'@ l.
- Proof.
-  induction P;destruct P';simpl;intros;try discriminate;trivial.
-  apply (morph_eq CRmorph);trivial.
-  assert (H1 := Pcompare_Eq_eq p p0); destruct ((p ?= p0)%positive Eq);
-   try discriminate H.
-  rewrite (IHP P' H); rewrite H1;trivial;rrefl.
-  assert (H1 := Pcompare_Eq_eq p p0); destruct ((p ?= p0)%positive Eq);
-   try discriminate H.
-  rewrite H1;trivial. clear H1.
-  assert (H1 := IHP1 P'1);assert (H2 := IHP2 P'2);
-   destruct (P2 ?== P'1);[destruct (P3 ?== P'2); [idtac|discriminate H]
-                         |discriminate H].
-  rewrite (H1 H);rewrite (H2 H);rrefl.
- Qed.
-
- Lemma Pphi0 : forall l, P0@l == 0.
- Proof.
-  intros;simpl;apply (morph0 CRmorph).
- Qed.
-
-Lemma env_morph : forall p e1 e2, (forall x, e1 x = e2 x) -> 
- p @ e1 = p @ e2.
-Proof.
-  induction p ; simpl.
-  reflexivity.
-  intros.
-  apply IHp.
-  intros.
-  unfold jump.
-  apply H.
-  intros.
-  rewrite (IHp1 e1 e2) ; auto.
-  rewrite (IHp2 (tail e1) (tail e2)) ; auto.
-  unfold hd. unfold nth.  rewrite H.  reflexivity.
-  unfold tail.  unfold jump. intros ; apply H.
-Qed.
-
-Lemma Pjump_Pplus : forall P i j l, P @ (jump (i + j) l ) = P @ (jump j (jump i l)).
-Proof.
-  intros. apply env_morph. intros. rewrite <- jump_Pplus.
-  rewrite Pplus_comm.
-  reflexivity.
-Qed.
-
-Lemma Pjump_xO_tail : forall P p l, 
-  P @ (jump (xO p) (tail l)) = P @ (jump (xI p) l).
-Proof.
-  intros.
-  apply env_morph.
-  intros.
-  rewrite (@jump_simpl R (xI p)).
-  rewrite (@jump_simpl R (xO p)).
-  reflexivity.
-Qed.
-
-Lemma Pjump_Pdouble_minus_one : forall P p l,
-  P @ (jump (Pdouble_minus_one p) (tail l)) = P @ (jump (xO p) l).
-Proof.
-  intros.
-  apply env_morph.
-  intros.
-  rewrite jump_Pdouble_minus_one.
-  rewrite (@jump_simpl R (xO p)).
-  reflexivity.
-Qed.
-
-
-
- Lemma Pphi1 : forall l,  P1@l == 1.
- Proof.
-  intros;simpl;apply (morph1 CRmorph).
- Qed.
-
- Lemma mkPinj_ok : forall j l P, (mkPinj j P)@l == P@(jump j l).
- Proof.
-  intros j l p;destruct p;simpl;rsimpl.
-  rewrite Pjump_Pplus.
-  reflexivity.
- Qed.
-
- Let pow_pos_Pplus :=
-    pow_pos_Pplus rmul Rsth Reqe.(Rmul_ext) ARth.(ARmul_comm) ARth.(ARmul_assoc).
-
- Lemma mkPX_ok : forall l P i Q,
-  (mkPX P i Q)@l == P@l*(pow_pos rmul (hd 0 l) i) + Q@(tail l).
- Proof.
-  intros l P i Q;unfold mkPX.
-  destruct P;try (simpl;rrefl).
-  assert (H := morph_eq CRmorph c cO);destruct (c ?=! cO);simpl;try rrefl.
-  rewrite (H (refl_equal true));rewrite (morph0 CRmorph).
-  rewrite mkPinj_ok;rsimpl;simpl;rrefl.
-  assert (H := @Peq_ok P3 P0);destruct (P3 ?== P0);simpl;try rrefl.
-  rewrite (H (refl_equal true));trivial.
-  rewrite Pphi0.  rewrite pow_pos_Pplus;rsimpl.
- Qed.
-
-
- Ltac Esimpl :=
-  repeat (progress (
-   match goal with
-   | |- context [P0@?l] => rewrite (Pphi0 l)
-   | |- context [P1@?l] => rewrite (Pphi1 l)
-   | |- context [(mkPinj ?j ?P)@?l] => rewrite (mkPinj_ok j l P)
-   | |- context [(mkPX ?P ?i ?Q)@?l] => rewrite (mkPX_ok l P i Q)
-   | |- context [[cO]] => rewrite (morph0 CRmorph)
-   | |- context [[cI]] => rewrite (morph1 CRmorph)
-   | |- context [[?x +! ?y]] => rewrite ((morph_add CRmorph) x y)
-   | |- context [[?x *! ?y]] => rewrite ((morph_mul CRmorph) x y)
-   | |- context [[?x -! ?y]] => rewrite ((morph_sub CRmorph) x y)
-   | |- context [[-! ?x]] => rewrite ((morph_opp CRmorph) x)
-   end));
-  rsimpl; simpl.
-
- Lemma PaddC_ok : forall c P l, (PaddC P c)@l == P@l + [c].
- Proof.
-  induction P;simpl;intros;Esimpl;trivial.
-  rewrite IHP2;rsimpl.
- Qed.
-
- Lemma PsubC_ok : forall c P l, (PsubC P c)@l == P@l - [c].
- Proof.
-  induction P;simpl;intros.
-  Esimpl.
-  rewrite IHP;rsimpl.
-  rewrite IHP2;rsimpl.
- Qed.
-
- Lemma PmulC_aux_ok : forall c P l, (PmulC_aux P c)@l == P@l * [c].
- Proof.
-  induction P;simpl;intros;Esimpl;trivial.
-  rewrite IHP1;rewrite IHP2;rsimpl.
-  mul_push ([c]);rrefl.
- Qed.
-
- Lemma PmulC_ok : forall c P l, (PmulC P c)@l == P@l * [c].
- Proof.
-  intros c P l; unfold PmulC.
-  assert (H:= morph_eq CRmorph c cO);destruct (c ?=! cO).
-  rewrite (H (refl_equal true));Esimpl.
-  assert (H1:= morph_eq CRmorph c cI);destruct (c ?=! cI).
-  rewrite (H1 (refl_equal true));Esimpl.
-  apply PmulC_aux_ok.
- Qed.
-
- Lemma Popp_ok : forall P l, (--P)@l == - P@l.
- Proof.
-  induction P;simpl;intros.
-  Esimpl.
-  apply IHP.
-  rewrite IHP1;rewrite IHP2;rsimpl.
- Qed.
-
- Ltac Esimpl2 :=
-  Esimpl;
-  repeat (progress (
-   match goal with
-   | |- context [(PaddC ?P ?c)@?l] => rewrite (PaddC_ok c P l)
-   | |- context [(PsubC ?P ?c)@?l] => rewrite (PsubC_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 Padd_ok : forall P' P l, (P ++ P')@l == P@l + P'@l.
- Proof.
-  induction P';simpl;intros;Esimpl2.
-  generalize P p l;clear P p l.
-  induction P;simpl;intros.
-  Esimpl2;apply (ARadd_comm ARth).
-  assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
-  rewrite H;Esimpl. rewrite IHP';rrefl.
-  rewrite H;Esimpl. rewrite IHP';Esimpl.
-  rewrite Pjump_Pplus. rrefl.
-  rewrite H;Esimpl. rewrite IHP.
-  rewrite Pjump_Pplus. rrefl.
-  destruct p0;simpl.
-  rewrite IHP2;simpl. rsimpl.
-  rewrite Pjump_xO_tail. Esimpl.
-  rewrite IHP2;simpl.
-  rewrite Pjump_Pdouble_minus_one.
-  rsimpl.
-  rewrite IHP'.
-  rsimpl.
-  destruct P;simpl.
-  Esimpl2;add_push [c];rrefl.
-  destruct p0;simpl;Esimpl2.
-  rewrite IHP'2;simpl.
-  rewrite Pjump_xO_tail.
-  rsimpl;add_push (P'1@l * (pow_pos rmul (hd 0 l) p));rrefl.
-  rewrite IHP'2;simpl.
-  rewrite Pjump_Pdouble_minus_one. rsimpl.
-  add_push (P'1@l * (pow_pos rmul (hd 0 l) p));rrefl.
-  rewrite IHP'2;rsimpl.
-  unfold tail.
-  add_push (P @ (jump 1 l));rrefl.
-  assert (H := ZPminus_spec p0 p);destruct (ZPminus p0 p);Esimpl2.
-  rewrite IHP'1;rewrite IHP'2;rsimpl.
-  add_push (P3 @ (tail l));rewrite H;rrefl.
-  rewrite IHP'1;rewrite IHP'2;simpl;Esimpl.
-  rewrite H;rewrite Pplus_comm.
-  rewrite pow_pos_Pplus;rsimpl.
-  add_push (P3 @ (tail l));rrefl.
-  assert (forall P k l,
-           (PaddX Padd P'1 k P) @ l == P@l + P'1@l * pow_pos rmul (hd 0 l) k).
-   induction P;simpl;intros;try apply (ARadd_comm ARth).
-   destruct p2; simpl; try apply (ARadd_comm ARth).
-   rewrite Pjump_xO_tail.
-   apply (ARadd_comm ARth).   
-   rewrite Pjump_Pdouble_minus_one.
-   apply (ARadd_comm ARth).   
-    assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2.
-    rewrite IHP'1;rsimpl; rewrite H1;add_push (P5 @ (tail l0));rrefl.
-    rewrite IHP'1;simpl;Esimpl.
-    rewrite H1;rewrite Pplus_comm.
-    rewrite pow_pos_Pplus;simpl;Esimpl.
-    add_push (P5 @ (tail l0));rrefl.
-    rewrite IHP1;rewrite H1;rewrite Pplus_comm.
-    rewrite pow_pos_Pplus;simpl;rsimpl.
-    add_push (P5 @ (tail l0));rrefl.
-  rewrite H0;rsimpl.
-  add_push (P3 @ (tail l)).
-  rewrite H;rewrite Pplus_comm.
-  rewrite IHP'2;rewrite pow_pos_Pplus;rsimpl.
-  add_push (P3 @ (tail l));rrefl.
- Qed.
-
- Lemma Psub_ok : forall P' P l, (P -- P')@l == P@l - P'@l.
- Proof.
-  induction P';simpl;intros;Esimpl2;trivial.
-  generalize P p l;clear P p l.
-  induction P;simpl;intros.
-  Esimpl2;apply (ARadd_comm ARth).
-  assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
-  rewrite H;Esimpl. rewrite IHP';rsimpl.
-  rewrite H;Esimpl. rewrite IHP';Esimpl.
-  rewrite <- Pjump_Pplus;rewrite Pplus_comm;rrefl.
-  rewrite H;Esimpl. rewrite IHP.
-  rewrite <- Pjump_Pplus;rewrite Pplus_comm;rrefl.
-  destruct p0;simpl.
-  rewrite IHP2;simpl; try   rewrite Pjump_xO_tail ; rsimpl.
-  rewrite IHP2;simpl.
-  rewrite Pjump_Pdouble_minus_one;rsimpl.
-  unfold tail ; rsimpl.
-  rewrite IHP';rsimpl.
-  destruct P;simpl.
-  repeat rewrite Popp_ok;Esimpl2;rsimpl;add_push [c];try rrefl.
-  destruct p0;simpl;Esimpl2.
-  rewrite IHP'2;simpl;rsimpl;add_push (P'1@l * (pow_pos rmul (hd 0 l) p));trivial.
-  rewrite Pjump_xO_tail.
-  add_push (P @ ((jump (xI p0) l)));rrefl.  
-  rewrite IHP'2;simpl;rewrite Pjump_Pdouble_minus_one;rsimpl.
-  add_push (- (P'1 @ l * pow_pos  rmul (hd 0 l) p));rrefl.
-  unfold tail.
-  rewrite IHP'2;rsimpl;add_push (P @ (jump 1 l));rrefl.
-  assert (H := ZPminus_spec p0 p);destruct (ZPminus p0 p);Esimpl2.
-  rewrite IHP'1; rewrite IHP'2;rsimpl.
-  add_push (P3 @ (tail l));rewrite H;rrefl.
-   rewrite IHP'1; rewrite IHP'2;rsimpl;simpl;Esimpl.
-  rewrite H;rewrite Pplus_comm.
-  rewrite pow_pos_Pplus;rsimpl.
-  add_push (P3 @ (tail l));rrefl.
-  assert (forall P k l,
-           (PsubX Psub P'1 k P) @ l == P@l + - P'1@l * pow_pos rmul (hd 0 l) k).
-   induction P;simpl;intros.
-   rewrite Popp_ok;rsimpl;apply (ARadd_comm ARth);trivial.
-   destruct p2;simpl; rewrite Popp_ok;rsimpl.
-   rewrite Pjump_xO_tail.
-   apply (ARadd_comm ARth);trivial.
-   rewrite Pjump_Pdouble_minus_one.
-   apply (ARadd_comm ARth);trivial.
-   apply (ARadd_comm ARth);trivial.
-    assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2;rsimpl.
-    rewrite IHP'1;rsimpl;add_push (P5 @ (tail l0));rewrite H1;rrefl.
-    rewrite IHP'1;rewrite H1;rewrite Pplus_comm.
-    rewrite pow_pos_Pplus;simpl;Esimpl.
-    add_push (P5 @ (tail l0));rrefl.
-    rewrite IHP1;rewrite H1;rewrite Pplus_comm.
-    rewrite pow_pos_Pplus;simpl;rsimpl.
-    add_push (P5 @ (tail l0));rrefl.
-  rewrite H0;rsimpl.
-  rewrite IHP'2;rsimpl;add_push (P3 @ (tail l)).
-  rewrite H;rewrite Pplus_comm.
-  rewrite pow_pos_Pplus;rsimpl.
- Qed.
-(* Proof for the symmetric version *)
-
- Lemma PmulI_ok :
-  forall P',
-   (forall (P : Pol) (l : Env  R), (Pmul P P') @ l == P @ l * P' @ l) ->
-   forall (P : Pol) (p : positive) (l : Env R),
-    (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l).
- Proof.
-  induction P;simpl;intros.
-  Esimpl2;apply (ARmul_comm ARth).
-  assert (H1 := ZPminus_spec p p0);destruct (ZPminus p p0);Esimpl2.
-  rewrite H1; rewrite H;rrefl.
-  rewrite H1; rewrite H.
-  rewrite Pjump_Pplus;simpl;rrefl.
-  rewrite H1.
-  rewrite Pjump_Pplus;rewrite IHP;rrefl.
-  destruct p0;Esimpl2.
-  rewrite IHP1;rewrite IHP2;rsimpl.
-  rewrite Pjump_xO_tail.
-  mul_push (pow_pos rmul (hd 0 l) p);rrefl.
-  rewrite IHP1;rewrite IHP2;simpl;rsimpl.
-  mul_push (pow_pos rmul (hd 0 l) p); rewrite Pjump_Pdouble_minus_one.
-  rrefl.
-  rewrite IHP1;simpl;rsimpl.
-  mul_push (pow_pos rmul (hd 0 l) p).
-  rewrite H;rrefl.
- Qed.
-
-(*
- Lemma PmulI_ok :
-  forall P',
-   (forall (P : Pol) (l : list R), (Pmul_aux P P') @ l == P @ l * P' @ l) ->
-   forall (P : Pol) (p : positive) (l : list R),
-    (PmulI Pmul_aux P' p P) @ l == P @ l * P' @ (jump p l).
- Proof.
-  induction P;simpl;intros.
-  Esimpl2;apply (ARmul_comm ARth).
-  assert (H1 := ZPminus_spec p p0);destruct (ZPminus p p0);Esimpl2.
-  rewrite H1; rewrite H;rrefl.
-  rewrite H1; rewrite H.
-  rewrite Pplus_comm.
-  rewrite jump_Pplus;simpl;rrefl.
-  rewrite H1;rewrite Pplus_comm.
-  rewrite jump_Pplus;rewrite IHP;rrefl.
-  destruct p0;Esimpl2.
-  rewrite IHP1;rewrite IHP2;simpl;rsimpl.
-  mul_push (pow_pos rmul (hd 0 l) p);rrefl.
-  rewrite IHP1;rewrite IHP2;simpl;rsimpl.
-  mul_push (pow_pos rmul (hd 0 l) p); rewrite jump_Pdouble_minus_one;rrefl.
-  rewrite IHP1;simpl;rsimpl.
-  mul_push (pow_pos rmul (hd 0 l) p).
-  rewrite H;rrefl.
- Qed.
-
- Lemma Pmul_aux_ok : forall P' P l,(Pmul_aux P P')@l == P@l * P'@l.
- Proof.
-  induction P';simpl;intros.
-  Esimpl2;trivial.
-  apply PmulI_ok;trivial.
-  rewrite Padd_ok;Esimpl2.
-  rewrite (PmulI_ok P'2 IHP'2). rewrite IHP'1. rrefl.
- Qed.
-*)
-
-(* Proof for the symmetric version *)
- Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
- Proof.
-  intros P P';generalize P;clear P;induction P';simpl;intros.
-  apply PmulC_ok. apply PmulI_ok;trivial.
-  destruct P.
-  rewrite (ARmul_comm ARth);Esimpl2;Esimpl2.
-  Esimpl2. rewrite IHP'1;Esimpl2.
-   assert (match p0 with
-           | xI j => Pinj (xO j) P ** P'2
-           | xO j => Pinj (Pdouble_minus_one j) P ** P'2
-           | 1 => P ** P'2
-           end @ (tail l) == P @ (jump p0 l) * P'2 @ (tail l)).
-   destruct p0;rewrite IHP'2;Esimpl.
-   rewrite Pjump_xO_tail. reflexivity.
-   rewrite Pjump_Pdouble_minus_one;Esimpl.
-   rewrite H;Esimpl.
-   rewrite Padd_ok; Esimpl2. rewrite Padd_ok; Esimpl2.
-   repeat (rewrite IHP'1 || rewrite IHP'2);simpl.
-   rewrite PmulI_ok;trivial.
-   unfold tail.
-   mul_push (P'1@l). simpl. mul_push (P'2 @ (jump 1 l)). Esimpl.
- Qed.
-
-(*
-Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
- Proof.
-  destruct P;simpl;intros.
-  Esimpl2;apply (ARmul_comm ARth).
-  rewrite (PmulI_ok P (Pmul_aux_ok P)).
-  apply (ARmul_comm ARth).
-  rewrite Padd_ok; Esimpl2.
-  rewrite (PmulI_ok P3 (Pmul_aux_ok P3));trivial.
-  rewrite Pmul_aux_ok;mul_push (P' @ l).
-  rewrite (ARmul_comm ARth (P' @ l));rrefl.
- Qed.
-*)
-
- Lemma Psquare_ok : forall P l, (Psquare P)@l == P@l * P@l.
- Proof.
-  induction P;simpl;intros;Esimpl2.
-  apply IHP. rewrite Padd_ok. rewrite Pmul_ok;Esimpl2.
-  rewrite IHP1;rewrite IHP2.
-  mul_push (pow_pos rmul (hd 0 l) p). mul_push (P2@l).
-  rrefl.
- Qed.
-
- Lemma Mphi_morph : forall P env env', (forall x, env x = env' x ) -> 
-   Mphi env P = Mphi env' P.
- Proof.
-   induction P ; simpl.
-   reflexivity.
-   intros.
-   apply IHP.
-   intros.
-   unfold jump.
-   apply H.
-   (**)
-   intros.
-   replace (Mphi (tail env) P) with (Mphi (tail env') P).
-   unfold hd. unfold nth.
-   rewrite H.
-   reflexivity.
-   apply IHP.
-   unfold tail,jump.
-   intros. symmetry. apply H.
- Qed.
-
-Lemma Mjump_xO_tail : forall M p l, 
-  Mphi  (jump (xO p) (tail l)) M = Mphi (jump (xI p) l) M.
-Proof.
-  intros.
-  apply Mphi_morph.
-  intros.
-  rewrite (@jump_simpl R (xI p)).
-  rewrite (@jump_simpl R (xO p)).
-  reflexivity.
-Qed.
-
-Lemma Mjump_Pdouble_minus_one : forall M p l,
-  Mphi (jump (Pdouble_minus_one p) (tail l)) M = Mphi (jump (xO p) l) M.
-Proof.
-  intros.
-  apply Mphi_morph.
-  intros.
-  rewrite jump_Pdouble_minus_one.
-  rewrite (@jump_simpl R (xO p)).
-  reflexivity.
-Qed.
-
-Lemma Mjump_Pplus : forall M i j l, Mphi (jump (i + j) l ) M = Mphi (jump j (jump i l)) M.
-Proof.
-  intros. apply Mphi_morph. intros. rewrite <- jump_Pplus.
-  rewrite Pplus_comm.
-  reflexivity.
-Qed.
-
-
-
- Lemma mkZmon_ok: forall M j l,
-   Mphi l (mkZmon j M) == Mphi l (zmon j M).
- intros M j l; case M; simpl; intros; rsimpl.
- Qed.
-
- Lemma zmon_pred_ok : forall M j l,
-    Mphi (tail l) (zmon_pred j M) == Mphi l (zmon j M).
- Proof.
-   destruct j; simpl;intros l; rsimpl.
-   rewrite mkZmon_ok;rsimpl.
-   simpl.
-   rewrite Mjump_xO_tail.
-   reflexivity.
-   rewrite mkZmon_ok;simpl.
-   rewrite Mjump_Pdouble_minus_one; rsimpl.
- Qed.
-
- Lemma mkVmon_ok : forall M i l, Mphi l (mkVmon i M) == Mphi l M*pow_pos rmul (hd 0 l) i.
- Proof.
-  destruct M;simpl;intros;rsimpl.
-   rewrite zmon_pred_ok;simpl;rsimpl.
-  rewrite Pplus_comm;rewrite pow_pos_Pplus;rsimpl.
- Qed.
-
-
- Lemma Mphi_ok: forall P M l,
-    let (Q,R) := MFactor P M in
-      P@l == Q@l + (Mphi l M) * (R@l).
- Proof.
- intros P; elim P; simpl; auto; clear P.
-   intros c M l; case M; simpl; auto; try intro p; try intro m;
-   try rewrite (morph0 CRmorph); rsimpl.
-
-   intros i P Hrec M l; case M; simpl; clear M.
-     rewrite (morph0 CRmorph); rsimpl.
-     intros j M.
-     case_eq ((i ?= j) Eq); intros He; simpl.
-       rewrite (Pcompare_Eq_eq _ _ He).
-       generalize (Hrec M (jump j l)); case (MFactor P M);
-        simpl; intros P2 Q2 H; repeat rewrite mkPinj_ok; auto.
-       generalize (Hrec (zmon (j -i) M) (jump i l));
-       case (MFactor P (zmon (j -i) M)); simpl.
-       intros P2 Q2 H; repeat rewrite mkPinj_ok; auto.
-       rewrite  <- (Pplus_minus _ _ (ZC2 _ _ He)).
-       rewrite Mjump_Pplus; auto.
-       rewrite (morph0 CRmorph); rsimpl.
-       intros P2 m; rewrite (morph0 CRmorph); rsimpl.
-
-   intros P2 Hrec1 i Q2 Hrec2 M l; case M; simpl; auto.
-   rewrite (morph0 CRmorph); rsimpl.
-   intros j M1.
-     generalize (Hrec1 (zmon j M1) l);
-     case (MFactor P2 (zmon j M1)).
-     intros R1 S1 H1.
-     generalize (Hrec2 (zmon_pred j M1) (tail l));
-     case (MFactor Q2 (zmon_pred j M1)); simpl.
-     intros R2 S2 H2; rewrite H1; rewrite H2.
-     repeat rewrite mkPX_ok; simpl.
-     rsimpl.
-     apply radd_ext; rsimpl.
-     rewrite (ARadd_comm ARth); rsimpl.
-     apply radd_ext; rsimpl.
-     rewrite (ARadd_comm ARth); rsimpl.
-     rewrite zmon_pred_ok;rsimpl.
-   intros j M1.
-     case_eq ((i ?= j) Eq); intros He; simpl.
-       rewrite (Pcompare_Eq_eq _ _ He).
-       generalize (Hrec1 (mkZmon xH M1) l); case (MFactor P2 (mkZmon xH M1));
-        simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
-       rewrite H; rewrite mkPX_ok; rsimpl.
-       repeat (rewrite <-(ARadd_assoc ARth)).
-       apply radd_ext; rsimpl.
-       rewrite (ARadd_comm ARth); rsimpl.
-       apply radd_ext; rsimpl.
-       repeat (rewrite <-(ARmul_assoc ARth)).
-       rewrite mkZmon_ok.
-       apply rmul_ext; rsimpl.
-       rewrite (ARmul_comm ARth); rsimpl.
-       generalize (Hrec1 (vmon (j - i) M1) l);
-             case (MFactor P2 (vmon (j - i) M1));
-        simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
-       rewrite H; rsimpl; repeat rewrite mkPinj_ok; auto.
-       rewrite mkPX_ok; rsimpl.
-       repeat (rewrite <-(ARadd_assoc ARth)).
-       apply radd_ext; rsimpl.
-       rewrite (ARadd_comm ARth); rsimpl.
-       apply radd_ext; rsimpl.
-       repeat (rewrite <-(ARmul_assoc ARth)).
-       apply rmul_ext; rsimpl.
-       rewrite (ARmul_comm ARth); rsimpl.
-       apply rmul_ext; rsimpl.
-       rewrite <- pow_pos_Pplus.
-       rewrite (Pplus_minus _ _ (ZC2 _ _ He)); rsimpl.
-       generalize (Hrec1 (mkZmon 1 M1) l);
-             case (MFactor P2 (mkZmon 1 M1));
-        simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
-       rewrite H; rsimpl.
-       rewrite mkPX_ok; rsimpl.
-       repeat (rewrite <-(ARadd_assoc ARth)).
-       apply radd_ext; rsimpl.
-       rewrite (ARadd_comm ARth); rsimpl.
-       apply radd_ext; rsimpl.
-       rewrite mkZmon_ok.
-       repeat (rewrite <-(ARmul_assoc ARth)).
-       apply rmul_ext; rsimpl.
-       rewrite (ARmul_comm ARth); rsimpl.
-       rewrite mkPX_ok; simpl; rsimpl.
-       rewrite (morph0 CRmorph); rsimpl.
-       repeat (rewrite <-(ARmul_assoc ARth)).
-       rewrite (ARmul_comm ARth (Q3@l)); rsimpl.
-       apply rmul_ext; rsimpl.
-       rewrite <- pow_pos_Pplus.
-       rewrite (Pplus_minus _ _ He); rsimpl.
- Qed.
-
-(* Proof for the symmetric version *)
-
- Lemma POneSubst_ok: forall P1 M1 P2 P3 l,
-    POneSubst P1 M1 P2 = Some P3 -> Mphi l M1 == P2@l -> P1@l == P3@l.
- Proof.
- intros P2 M1 P3 P4 l; unfold POneSubst.
- generalize (Mphi_ok P2 M1 l); case (MFactor P2 M1); simpl; auto.
- intros Q1 R1; case R1.
-   intros c H; rewrite H.
-   generalize (morph_eq CRmorph c cO);
-        case (c ?=! cO); simpl; auto.
-   intros H1 H2; rewrite H1; auto; rsimpl.
-   discriminate.
-   intros _ H1 H2; injection H1; intros; subst.
-   rewrite H2; rsimpl.
- (* new version *)
-   rewrite Padd_ok; rewrite PmulC_ok; rsimpl.
- intros i P5 H; rewrite H.
-   intros HH H1; injection HH; intros; subst; rsimpl.
-   rewrite Padd_ok; rewrite PmulI_ok by (intros;apply Pmul_ok). rewrite H1; rsimpl. 
- intros i P5 P6 H1 H2 H3; rewrite H1; rewrite H3.
-   assert (P4 = Q1 ++ P3 ** PX i P5 P6).
-   injection H2; intros; subst;trivial.
-  rewrite H;rewrite Padd_ok;rewrite Pmul_ok;rsimpl.
-Qed.
-(*
-  Lemma POneSubst_ok: forall P1 M1 P2 P3 l,
-    POneSubst P1 M1 P2 = Some P3 -> Mphi l M1 == P2@l -> P1@l == P3@l.
-Proof.
- intros P2 M1 P3 P4 l; unfold POneSubst.
- generalize (Mphi_ok P2 M1 l); case (MFactor P2 M1); simpl; auto.
- intros Q1 R1; case R1.
-   intros c H; rewrite H.
-   generalize (morph_eq CRmorph c cO);
-        case (c ?=! cO); simpl; auto.
-   intros H1 H2; rewrite H1; auto; rsimpl.
-   discriminate.
-   intros _ H1 H2; injection H1; intros; subst.
-   rewrite H2; rsimpl.
-  rewrite Padd_ok; rewrite Pmul_ok; rsimpl.
-  intros i P5 H; rewrite H.
-   intros HH H1; injection HH; intros; subst; rsimpl.
-   rewrite Padd_ok; rewrite Pmul_ok. rewrite H1; rsimpl.
-   intros i P5 P6 H1 H2 H3; rewrite H1; rewrite H3.
-   injection H2; intros; subst; rsimpl.
-   rewrite Padd_ok.
-   rewrite Pmul_ok; rsimpl.
- Qed.
-*)
- Lemma PNSubst1_ok: forall n P1 M1 P2 l,
-    Mphi l M1 == P2@l -> P1@l == (PNSubst1 P1 M1 P2 n)@l.
- Proof.
- intros n; elim n; simpl; auto.
-   intros P2 M1 P3 l H.
-   generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l);
-   case (POneSubst P2 M1 P3); [idtac | intros; rsimpl].
-   intros P4 Hrec; rewrite (Hrec P4); auto; rsimpl.
- intros n1 Hrec P2 M1 P3 l H.
-   generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l);
-   case (POneSubst P2 M1 P3); [idtac | intros; rsimpl].
-   intros P4 Hrec1; rewrite (Hrec1 P4); auto; rsimpl.
- Qed.
-
- Lemma PNSubst_ok: forall n P1 M1 P2 l P3,
-    PNSubst P1 M1 P2 n = Some P3 -> Mphi l M1 == P2@l -> P1@l == P3@l.
- Proof.
- intros n P2 M1 P3 l P4; unfold PNSubst.
- generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l);
- case (POneSubst P2 M1 P3); [idtac | intros; discriminate].
- intros P5 H1; case n; try (intros; discriminate).
- intros n1 H2; injection H2; intros; subst.
- rewrite <- PNSubst1_ok; auto.
- Qed.
-
- Fixpoint MPcond (LM1: list (Mon * Pol)) (l: Env R) {struct LM1} : Prop :=
-    match LM1 with
-     cons (M1,P2) LM2 =>  (Mphi l M1 == P2@l) /\ (MPcond LM2 l)
-    | _ => True
-    end.
-
- Lemma PSubstL1_ok: forall n LM1 P1 l,
-    MPcond LM1 l ->  P1@l == (PSubstL1 P1 LM1 n)@l.
- Proof.
- intros n LM1; elim LM1; simpl; auto.
-   intros; rsimpl.
- intros (M2,P2) LM2 Hrec P3 l [H H1].
- rewrite <- Hrec; auto.
- apply PNSubst1_ok; auto.
- Qed.
-
- Lemma PSubstL_ok: forall n LM1 P1 P2 l,
-   PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l ->  P1@l == P2@l.
- Proof.
- intros n LM1; elim LM1; simpl; auto.
-   intros; discriminate.
- intros (M2,P2) LM2 Hrec P3 P4 l.
- generalize (PNSubst_ok n P3 M2 P2); case (PNSubst P3 M2 P2 n).
-   intros P5 H0 H1 [H2 H3]; injection H1; intros; subst.
-   rewrite <- PSubstL1_ok; auto.
- intros l1 H [H1 H2]; auto.
- Qed.
-
- Lemma PNSubstL_ok: forall m n LM1 P1 l,
-    MPcond LM1 l ->  P1@l == (PNSubstL P1 LM1 m n)@l.
- Proof.
- intros m; elim m; simpl; auto.
-   intros n LM1 P2 l H; generalize (fun P3 => @PSubstL_ok n LM1 P2 P3 l);
-     case (PSubstL P2 LM1 n); intros; rsimpl; auto.
- intros m1 Hrec n LM1 P2 l H.
- generalize (fun P3 => @PSubstL_ok n LM1 P2 P3 l);
-     case (PSubstL P2 LM1 n); intros; rsimpl; auto.
- rewrite <- Hrec; auto.
- 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.
-
- (** evaluation of polynomial expressions towards R *)
- Definition mk_X j := mkPinj_pred j mkX.
-
- (** evaluation of polynomial expressions towards R *)
-
- Fixpoint PEeval (l:Env R) (pe:PExpr) {struct pe} : R :=
-   match pe with
-   | PEc c => phi c
-   | PEX j => nth 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.
-
- (** Correctness proofs *)
-
- Lemma mkX_ok : forall p l, nth  p l == (mk_X p) @ l.
- Proof.
-  destruct p;simpl;intros;Esimpl;trivial.
-  rewrite nth_spec ; auto.
-  unfold hd.
-  rewrite <- nth_Pdouble_minus_one.
-  rewrite (nth_jump (Pdouble_minus_one p) l 1).
-  reflexivity.
- Qed.
-
- Ltac Esimpl3 :=
-  repeat match goal with
-  | |- context [(?P1 ++ ?P2)@?l] => rewrite (Padd_ok P2 P1 l)
-  | |- context [(?P1 -- ?P2)@?l] => rewrite (Psub_ok P2 P1 l)
-  end;Esimpl2;try rrefl;try apply (ARadd_comm ARth).
-
-(* Power using the chinise algorithm *)
-(*Section POWER.
-  Variable subst_l : Pol -> Pol.
-  Fixpoint Ppow_pos (P:Pol) (p:positive){struct p} : Pol :=
-   match p with
-   | xH => P
-   | xO p => subst_l (Psquare (Ppow_pos P p))
-   | xI p => subst_l (Pmul P (Psquare (Ppow_pos P p)))
-   end.
-
-  Definition Ppow_N P n :=
-   match n with
-   | N0 => P1
-   | Npos p => Ppow_pos P p
-   end.
-
-  Lemma Ppow_pos_ok : forall l, (forall P, subst_l P@l == P@l) ->
-         forall P p, (Ppow_pos P p)@l == (pow_pos Pmul P p)@l.
-  Proof.
-   intros l subst_l_ok P.
-   induction p;simpl;intros;try rrefl;try rewrite subst_l_ok.
-   repeat rewrite Pmul_ok;rewrite Psquare_ok;rewrite IHp;rrefl.
-   repeat rewrite Pmul_ok;rewrite Psquare_ok;rewrite IHp;rrefl.
-  Qed.
-
-  Lemma Ppow_N_ok : forall 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. rrefl. apply Ppow_pos_ok. trivial.  Qed.
-
- End POWER. *)
-
-Section POWER.
-  Variable subst_l : Pol -> Pol.
-  Fixpoint Ppow_pos (res P:Pol) (p:positive){struct p} : Pol :=
-   match p with
-   | xH => subst_l (Pmul res P)
-   | xO p => Ppow_pos (Ppow_pos res P p) P p
-   | xI p => subst_l (Pmul  (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 : forall 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 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. mul_push (P@l);rsimpl. rsimpl. rrefl.
-  Qed.
-
-  Lemma Ppow_N_ok : forall 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. rrefl. rewrite Ppow_pos_ok. trivial. Esimpl.  auto. Qed.
-
- End POWER.
-
- (** Normalization and rewriting *)
-
- Section NORM_SUBST_REC.
-  Variable n : nat.
-  Variable lmp:list (Mon*Pol).
-  Let subst_l P := PNSubstL P lmp n n.
-  Let Pmul_subst P1 P2 := subst_l (Pmul P1 P2).
-  Let Ppow_subst := Ppow_N subst_l.
-
-  Fixpoint norm_aux (pe:PExpr) : Pol :=
-   match pe with
-   | PEc c => Pc c
-   | PEX j => mk_X j
-   | PEadd (PEopp pe1) pe2 => Psub (norm_aux pe2) (norm_aux pe1)
-   | 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).
-
- (*
-  Fixpoint norm_subst (pe:PExpr) : Pol :=
-   match pe with
-   | PEc c => Pc c
-   | PEX j => subst_l (mk_X j)
-   | PEadd (PEopp pe1) pe2 => Psub (norm_subst pe2) (norm_subst pe1)
-   | PEadd pe1 (PEopp pe2) =>
-     Psub (norm_subst pe1) (norm_subst pe2)
-   | PEadd pe1 pe2 => Padd (norm_subst  pe1) (norm_subst pe2)
-   | PEsub pe1 pe2 => Psub (norm_subst pe1) (norm_subst pe2)
-   | PEmul pe1 pe2 => Pmul_subst (norm_subst pe1) (norm_subst pe2)
-   | PEopp pe1 => Popp (norm_subst pe1)
-   | PEpow pe1 n => Ppow_subst (norm_subst pe1) n
-   end.
-
-  Lemma norm_subst_spec :
-     forall l pe, MPcond lmp l ->
-       PEeval l pe == (norm_subst pe)@l.
-  Proof.
-   intros;assert (subst_l_ok:forall P, (subst_l P)@l == P@l).
-      unfold subst_l;intros.
-      rewrite <- PNSubstL_ok;trivial. rrefl.
-   assert (Pms_ok:forall P1 P2, (Pmul_subst P1 P2)@l == P1@l*P2@l).
-    intros;unfold Pmul_subst;rewrite subst_l_ok;rewrite Pmul_ok;rrefl.
-   induction pe;simpl;Esimpl3.
-   rewrite subst_l_ok;apply mkX_ok.
-   rewrite IHpe1;rewrite IHpe2;destruct pe1;destruct pe2;Esimpl3.
-   rewrite IHpe1;rewrite IHpe2;rrefl.
-   rewrite Pms_ok;rewrite IHpe1;rewrite IHpe2;rrefl.
-   rewrite IHpe;rrefl.
-   unfold Ppow_subst. rewrite Ppow_N_ok. trivial.
-   rewrite pow_th.(rpow_pow_N). destruct n0;Esimpl3.
-   induction p;simpl;try rewrite IHp;try rewrite IHpe;repeat rewrite Pms_ok;
-      repeat rewrite Pmul_ok;rrefl.
-  Qed.
-*)
- Lemma norm_aux_spec :
-     forall l pe, (*MPcond lmp l ->*)
-       PEeval l pe == (norm_aux pe)@l.
-  Proof.
-   intros.
-   induction pe;simpl;Esimpl3.
-   apply mkX_ok.
-   rewrite IHpe1;rewrite IHpe2;destruct pe1;destruct pe2;Esimpl3. 
-   rewrite IHpe1;rewrite IHpe2;rrefl.
-   rewrite IHpe1;rewrite IHpe2. rewrite Pmul_ok. rrefl.
-   rewrite IHpe;rrefl.
-   rewrite Ppow_N_ok by reflexivity. 
-   rewrite pow_th.(rpow_pow_N). destruct n0;Esimpl3.
-   induction p;simpl;try rewrite IHp;try rewrite IHpe;repeat rewrite Pms_ok; 
-      repeat rewrite Pmul_ok;rrefl.
-  Qed.
-
-
- End NORM_SUBST_REC.
-
-
-End MakeRingPol.
-
diff --git a/contrib/micromega/LICENSE.sos b/contrib/micromega/LICENSE.sos
deleted file mode 100644
index 5aadfa2a..00000000
--- a/contrib/micromega/LICENSE.sos
+++ /dev/null
@@ -1,29 +0,0 @@
-            HOL Light copyright notice, licence and disclaimer
-
-                     (c) University of Cambridge 1998
-                  (c) Copyright, John Harrison 1998-2006
-
-HOL Light version 2.20, hereinafter referred to as "the software", is a
-computer theorem proving system written by John Harrison. Much of the
-software was developed at the University of Cambridge Computer Laboratory,
-New Museums Site, Pembroke Street, Cambridge, CB2 3QG, England. The
-software is copyright, University of Cambridge 1998 and John Harrison
-1998-2006.
-
-Permission to use, copy, modify, and distribute the software and its
-documentation for any purpose and without fee is hereby granted. In the
-case of further distribution of the software the present text, including
-copyright notice, licence and disclaimer of warranty, must be included in
-full and unmodified form in any release. Distribution of derivative
-software obtained by modifying the software, or incorporating it into
-other software, is permitted, provided the inclusion of the software is
-acknowledged and that any changes made to the software are clearly
-documented.
-
-John Harrison and the University of Cambridge disclaim all warranties
-with regard to the software, including all implied warranties of
-merchantability and fitness. In no event shall John Harrison or the
-University of Cambridge be liable for any special, indirect,
-incidental or consequential damages or any damages whatsoever,
-including, but not limited to, those arising from computer failure or
-malfunction, work stoppage, loss of profit or loss of contracts.
diff --git a/contrib/micromega/MExtraction.v b/contrib/micromega/MExtraction.v
deleted file mode 100644
index a5ac92db..00000000
--- a/contrib/micromega/MExtraction.v
+++ /dev/null
@@ -1,23 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-(* Used to generate micromega.ml *)
-
-Require Import ZMicromega.
-Require Import QMicromega.
-Require Import VarMap.
-Require Import RingMicromega.
-Require Import NArith.
-
-Extraction "micromega.ml"  List.map simpl_cone map_cone indexes  n_of_Z Nnat.N_of_nat ZTautoChecker QTautoChecker find.
diff --git a/contrib/micromega/OrderedRing.v b/contrib/micromega/OrderedRing.v
deleted file mode 100644
index 149b7731..00000000
--- a/contrib/micromega/OrderedRing.v
+++ /dev/null
@@ -1,458 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                      Evgeny Makarov, INRIA, 2007                     *)
-(************************************************************************)
-
-Require Import Setoid.
-Require Import Ring.
-
-(** Generic properties of ordered rings on a setoid equality *)
-
-Set Implicit Arguments.
-
-Module Import OrderedRingSyntax.
-Export RingSyntax.
-
-Reserved Notation "x ~= y" (at level 70, no associativity).
-Reserved Notation "x [=] y" (at level 70, no associativity).
-Reserved Notation "x [~=] y" (at level 70, no associativity).
-Reserved Notation "x [<] y" (at level 70, no associativity).
-Reserved Notation "x [<=] y" (at level 70, no associativity).
-End OrderedRingSyntax.
-
-Section DEFINITIONS.
-
-Variable R : Type.
-Variable (rO rI : R) (rplus rtimes rminus: R -> R -> R) (ropp : R -> R).
-Variable req rle rlt : R -> R -> Prop.
-Notation "0" := rO.
-Notation "1" := rI.
-Notation "x + y" := (rplus x y).
-Notation "x * y " := (rtimes x y).
-Notation "x - y " := (rminus x y).
-Notation "- x" := (ropp x).
-Notation "x == y" := (req x y).
-Notation "x ~= y" := (~ req x y).
-Notation "x <= y" := (rle x y).
-Notation "x < y" := (rlt x y).
-
-Record SOR : Type := mk_SOR_theory {
-  SORsetoid : Setoid_Theory R req;
-  SORplus_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 + y1 == x2 + y2;
-  SORtimes_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 * y1 == x2 * y2;
-  SORopp_wd : forall x1 x2, x1 == x2 ->  -x1 == -x2;
-  SORle_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> (x1 <= y1 <-> x2 <= y2);
-  SORlt_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> (x1 < y1 <-> x2 < y2);
-  SORrt : ring_theory rO rI rplus rtimes rminus ropp req;
-  SORle_refl : forall n : R, n <= n;
-  SORle_antisymm : forall n m : R, n <= m -> m <= n -> n == m;
-  SORle_trans : forall n m p : R, n <= m -> m <= p -> n <= p;
-  SORlt_le_neq : forall n m : R, n < m <-> n <= m /\ n ~= m;
-  SORlt_trichotomy : forall n m : R,  n < m \/ n == m \/ m < n;
-  SORplus_le_mono_l : forall n m p : R, n <= m -> p + n <= p + m;
-  SORtimes_pos_pos : forall n m : R, 0 < n -> 0 < m -> 0 < n * m;
-  SORneq_0_1 : 0 ~= 1
-}.
-
-(* We cannot use Relation_Definitions.order.ord_antisym and
-Relations_1.Antisymmetric because they refer to Leibniz equality *)
-
-End DEFINITIONS.
-
-Section STRICT_ORDERED_RING.
-
-Variable R : Type.
-Variable (rO rI : R) (rplus rtimes rminus: R -> R -> R) (ropp : R -> R).
-Variable req rle rlt : R -> R -> Prop.
-
-Variable sor : SOR rO rI rplus rtimes rminus ropp req rle rlt.
-
-Notation "0" := rO.
-Notation "1" := rI.
-Notation "x + y" := (rplus x y).
-Notation "x * y " := (rtimes x y).
-Notation "x - y " := (rminus x y).
-Notation "- x" := (ropp x).
-Notation "x == y" := (req x y).
-Notation "x ~= y" := (~ req x y).
-Notation "x <= y" := (rle x y).
-Notation "x < y" := (rlt x y).
-
-
-Add Relation R req
-  reflexivity proved by sor.(SORsetoid).(@Equivalence_Reflexive _ _ )
-  symmetry proved by sor.(SORsetoid).(@Equivalence_Symmetric _ _ )
-  transitivity proved by sor.(SORsetoid).(@Equivalence_Transitive _ _ )
-as sor_setoid.
-
-
-Add Morphism rplus with signature req ==> req ==> req as rplus_morph.
-Proof.
-exact sor.(SORplus_wd).
-Qed.
-Add Morphism rtimes with signature req ==> req ==> req as rtimes_morph.
-Proof.
-exact sor.(SORtimes_wd).
-Qed.
-Add Morphism ropp with signature req ==> req as ropp_morph.
-Proof.
-exact sor.(SORopp_wd).
-Qed.
-Add Morphism rle with signature req ==> req ==> iff as rle_morph.
-Proof.
-exact sor.(SORle_wd).
-Qed.
-Add Morphism rlt with signature req ==> req ==> iff as rlt_morph.
-Proof.
-exact sor.(SORlt_wd).
-Qed.
-
-Add Ring SOR : sor.(SORrt).
-
-Add Morphism rminus with signature req ==> req ==> req as rminus_morph.
-Proof.
-intros x1 x2 H1 y1 y2 H2.
-rewrite (sor.(SORrt).(Rsub_def) x1 y1).
-rewrite (sor.(SORrt).(Rsub_def) x2 y2).
-rewrite H1; now rewrite H2.
-Qed.
-
-Theorem Rneq_symm : forall n m : R, n ~= m -> m ~= n.
-Proof.
-intros n m H1 H2; rewrite H2 in H1; now apply H1.
-Qed.
-
-(* Propeties of plus, minus and opp *)
-
-Theorem Rplus_0_l : forall n : R, 0 + n == n.
-Proof.
-intro; ring.
-Qed.
-
-Theorem Rplus_0_r : forall n : R, n + 0 == n.
-Proof.
-intro; ring.
-Qed.
-
-Theorem Rtimes_0_r : forall n : R, n * 0 == 0.
-Proof.
-intro; ring.
-Qed.
-
-Theorem Rplus_comm : forall n m : R, n + m == m + n.
-Proof.
-intros; ring.
-Qed.
-
-Theorem Rtimes_0_l : forall n : R, 0 * n == 0.
-Proof.
-intro; ring.
-Qed.
-
-Theorem Rtimes_comm : forall n m : R, n * m == m * n.
-Proof.
-intros; ring.
-Qed.
-
-Theorem Rminus_eq_0 : forall n m : R, n - m == 0 <-> n == m.
-Proof.
-intros n m.
-split; intro H. setoid_replace n with ((n - m) + m) by ring. rewrite H. 
-now rewrite Rplus_0_l.
-rewrite H; ring.
-Qed.
-
-Theorem Rplus_cancel_l : forall n m p : R, p + n == p + m <-> n == m.
-Proof.
-intros n m p; split; intro H.
-setoid_replace n with (- p + (p + n)) by ring.
-setoid_replace m with (- p + (p + m)) by ring. now rewrite H.
-now rewrite H.
-Qed.
-
-(* Relations *)
-
-Theorem Rle_refl : forall n : R, n <= n.
-Proof sor.(SORle_refl).
-
-Theorem Rle_antisymm : forall n m : R, n <= m -> m <= n -> n == m.
-Proof sor.(SORle_antisymm).
-
-Theorem Rle_trans : forall n m p : R, n <= m -> m <= p -> n <= p.
-Proof sor.(SORle_trans).
-
-Theorem Rlt_trichotomy : forall n m : R,  n < m \/ n == m \/ m < n.
-Proof sor.(SORlt_trichotomy).
-
-Theorem Rlt_le_neq : forall n m : R, n < m <-> n <= m /\ n ~= m.
-Proof sor.(SORlt_le_neq).
-
-Theorem Rneq_0_1 : 0 ~= 1.
-Proof sor.(SORneq_0_1).
-
-Theorem Req_em : forall n m : R, n == m \/ n ~= m.
-Proof.
-intros n m. destruct (Rlt_trichotomy n m) as [H | [H | H]]; try rewrite Rlt_le_neq in H.
-right; now destruct H.
-now left.
-right; apply Rneq_symm; now destruct H.
-Qed.
-
-Theorem Req_dne : forall n m : R, ~ ~ n == m <-> n == m.
-Proof.
-intros n m; destruct (Req_em n m) as [H | H].
-split; auto.
-split. intro H1; false_hyp H H1. auto.
-Qed.
-
-Theorem Rle_lt_eq : forall n m : R, n <= m <-> n < m \/ n == m.
-Proof.
-intros n m; rewrite Rlt_le_neq.
-split; [intro H | intros [[H1 H2] | H]].
-destruct (Req_em n m) as [H1 | H1]. now right. left; now split.
-assumption.
-rewrite H; apply Rle_refl.
-Qed.
-
-Ltac le_less := rewrite Rle_lt_eq; left; try assumption.
-Ltac le_equal := rewrite Rle_lt_eq; right; try reflexivity; try assumption.
-Ltac le_elim H := rewrite Rle_lt_eq in H; destruct H as [H | H].
-
-Theorem Rlt_trans : forall n m p : R, n < m -> m < p -> n < p.
-Proof.
-intros n m p; repeat rewrite Rlt_le_neq; intros [H1 H2] [H3 H4]; split.
-now apply Rle_trans with m.
-intro H. rewrite H in H1. pose proof (Rle_antisymm H3 H1). now apply H4.
-Qed.
-
-Theorem Rle_lt_trans : forall n m p : R, n <= m -> m < p -> n < p.
-Proof.
-intros n m p H1 H2; le_elim H1.
-now apply Rlt_trans with (m := m). now rewrite H1.
-Qed.
-
-Theorem Rlt_le_trans : forall n m p : R, n < m -> m <= p -> n < p.
-Proof.
-intros n m p H1 H2; le_elim H2.
-now apply Rlt_trans with (m := m). now rewrite <- H2.
-Qed.
-
-Theorem Rle_gt_cases : forall n m : R, n <= m \/ m < n.
-Proof.
-intros n m; destruct (Rlt_trichotomy n m) as [H | [H | H]].
-left; now le_less. left; now le_equal. now right.
-Qed.
-
-Theorem Rlt_neq : forall n m : R, n < m -> n ~= m.
-Proof.
-intros n m; rewrite Rlt_le_neq; now intros [_ H].
-Qed.
-
-Theorem Rle_ngt : forall n m : R, n <= m <-> ~ m < n.
-Proof.
-intros n m; split.
-intros H H1; assert (H2 : n < n) by now apply Rle_lt_trans with m. now apply (Rlt_neq H2).
-intro H. destruct (Rle_gt_cases n m) as [H1 | H1]. assumption. false_hyp H1 H.
-Qed.
-
-Theorem Rlt_nge : forall n m : R, n < m <-> ~ m <= n.
-Proof.
-intros n m; split.
-intros H H1; assert (H2 : n < n) by now apply Rlt_le_trans with m. now apply (Rlt_neq H2).
-intro H. destruct (Rle_gt_cases m n) as [H1 | H1]. false_hyp H1 H. assumption.
-Qed.
-
-(* Plus, minus and order *)
-
-Theorem Rplus_le_mono_l : forall n m p : R, n <= m <-> p + n <= p + m.
-Proof.
-intros n m p; split.
-apply sor.(SORplus_le_mono_l).
-intro H. apply (sor.(SORplus_le_mono_l) (p + n) (p + m) (- p)) in H.
-setoid_replace (- p + (p + n)) with n in H by ring.
-setoid_replace (- p + (p + m)) with m in H by ring. assumption.
-Qed.
-
-Theorem Rplus_le_mono_r : forall n m p : R, n <= m <-> n + p <= m + p.
-Proof.
-intros n m p; rewrite (Rplus_comm n p); rewrite (Rplus_comm m p).
-apply Rplus_le_mono_l.
-Qed.
-
-Theorem Rplus_lt_mono_l : forall n m p : R, n < m <-> p + n < p + m.
-Proof.
-intros n m p; do 2 rewrite Rlt_le_neq. rewrite Rplus_cancel_l.
-now rewrite <- Rplus_le_mono_l.
-Qed.
-
-Theorem Rplus_lt_mono_r : forall n m p : R, n < m <-> n + p < m + p.
-Proof.
-intros n m p.
-rewrite (Rplus_comm n p); rewrite (Rplus_comm m p); apply Rplus_lt_mono_l.
-Qed.
-
-Theorem Rplus_lt_mono : forall n m p q : R, n < m -> p < q -> n + p < m + q.
-Proof.
-intros n m p q H1 H2.
-apply Rlt_trans with (m + p); [now apply -> Rplus_lt_mono_r | now apply -> Rplus_lt_mono_l].
-Qed.
-
-Theorem Rplus_le_mono : forall n m p q : R, n <= m -> p <= q -> n + p <= m + q.
-Proof.
-intros n m p q H1 H2.
-apply Rle_trans with (m + p); [now apply -> Rplus_le_mono_r | now apply -> Rplus_le_mono_l].
-Qed.
-
-Theorem Rplus_lt_le_mono : forall n m p q : R, n < m -> p <= q -> n + p < m + q.
-Proof.
-intros n m p q H1 H2.
-apply Rlt_le_trans with (m + p); [now apply -> Rplus_lt_mono_r | now apply -> Rplus_le_mono_l].
-Qed.
-
-Theorem Rplus_le_lt_mono : forall n m p q : R, n <= m -> p < q -> n + p < m + q.
-Proof.
-intros n m p q H1 H2.
-apply Rle_lt_trans with (m + p); [now apply -> Rplus_le_mono_r | now apply -> Rplus_lt_mono_l].
-Qed.
-
-Theorem Rplus_pos_pos : forall n m : R, 0 < n -> 0 < m -> 0 < n + m.
-Proof.
-intros n m H1 H2. rewrite <- (Rplus_0_l 0). now apply Rplus_lt_mono.
-Qed.
-
-Theorem Rplus_pos_nonneg : forall n m : R, 0 < n -> 0 <= m -> 0 < n + m.
-Proof.
-intros n m H1 H2. rewrite <- (Rplus_0_l 0). now apply Rplus_lt_le_mono.
-Qed.
-
-Theorem Rplus_nonneg_pos : forall n m : R, 0 <= n -> 0 < m -> 0 < n + m.
-Proof.
-intros n m H1 H2. rewrite <- (Rplus_0_l 0). now apply Rplus_le_lt_mono.
-Qed.
-
-Theorem Rplus_nonneg_nonneg : forall n m : R, 0 <= n -> 0 <= m -> 0 <= n + m.
-Proof.
-intros n m H1 H2. rewrite <- (Rplus_0_l 0). now apply Rplus_le_mono.
-Qed.
-
-Theorem Rle_le_minus : forall n m : R, n <= m <-> 0 <= m - n.
-Proof.
-intros n m. rewrite (@Rplus_le_mono_r n m (- n)).
-setoid_replace (n + - n) with 0 by ring.
-now setoid_replace (m + - n) with (m - n) by ring.
-Qed.
-
-Theorem Rlt_lt_minus : forall n m : R, n < m <-> 0 < m - n.
-Proof.
-intros n m. rewrite (@Rplus_lt_mono_r n m (- n)).
-setoid_replace (n + - n) with 0 by ring.
-now setoid_replace (m + - n) with (m - n) by ring.
-Qed.
-
-Theorem Ropp_lt_mono : forall n m : R, n < m <-> - m < - n.
-Proof.
-intros n m. split; intro H.
-apply -> (@Rplus_lt_mono_l n m (- n - m)) in H.
-setoid_replace (- n - m + n) with (- m) in H by ring.
-now setoid_replace (- n - m + m) with (- n) in H by ring.
-apply -> (@Rplus_lt_mono_l (- m) (- n) (n + m)) in H.
-setoid_replace (n + m + - m) with n in H by ring.
-now setoid_replace (n + m + - n) with m in H by ring.
-Qed.
-
-Theorem Ropp_pos_neg : forall n : R, 0 < - n <-> n < 0.
-Proof.
-intro n; rewrite (Ropp_lt_mono n 0). now setoid_replace (- 0) with 0 by ring.
-Qed.
-
-(* Times and order *)
-
-Theorem Rtimes_pos_pos : forall n m : R, 0 < n -> 0 < m -> 0 < n * m.
-Proof sor.(SORtimes_pos_pos).
-
-Theorem Rtimes_nonneg_nonneg : forall n m : R, 0 <= n -> 0 <= m -> 0 <= n * m.
-Proof.
-intros n m H1 H2.
-le_elim H1. le_elim H2.
-le_less; now apply Rtimes_pos_pos.
-rewrite <- H2; rewrite Rtimes_0_r; le_equal.
-rewrite <- H1; rewrite Rtimes_0_l; le_equal.
-Qed.
-
-Theorem Rtimes_pos_neg : forall n m : R, 0 < n -> m < 0 -> n * m < 0.
-Proof.
-intros n m H1 H2. apply -> Ropp_pos_neg.
-setoid_replace (- (n * m)) with (n * (- m)) by ring.
-apply Rtimes_pos_pos. assumption. now apply <- Ropp_pos_neg.
-Qed.
-
-Theorem Rtimes_neg_neg : forall n m : R, n < 0 -> m < 0 -> 0 < n * m.
-Proof.
-intros n m H1 H2.
-setoid_replace (n * m) with ((- n) * (- m)) by ring.
-apply Rtimes_pos_pos; now apply <- Ropp_pos_neg.
-Qed.
-
-Theorem Rtimes_square_nonneg : forall n : R, 0 <= n * n.
-Proof.
-intro n; destruct (Rlt_trichotomy 0 n) as [H | [H | H]].
-le_less; now apply Rtimes_pos_pos.
-rewrite <- H, Rtimes_0_l; le_equal.
-le_less; now apply Rtimes_neg_neg.
-Qed.
-
-Theorem Rtimes_neq_0 : forall n m : R, n ~= 0 /\ m ~= 0 -> n * m ~= 0.
-Proof.
-intros n m [H1 H2].
-destruct (Rlt_trichotomy n 0) as [H3 | [H3 | H3]];
-destruct (Rlt_trichotomy m 0) as [H4 | [H4 | H4]];
-try (false_hyp H3 H1); try (false_hyp H4 H2).
-apply Rneq_symm. apply Rlt_neq. now apply Rtimes_neg_neg.
-apply Rlt_neq. rewrite Rtimes_comm. now apply Rtimes_pos_neg.
-apply Rlt_neq. now apply Rtimes_pos_neg.
-apply Rneq_symm. apply Rlt_neq. now apply Rtimes_pos_pos.
-Qed.
-
-(* The following theorems are used to build a morphism from Z to R and
-prove its properties in ZCoeff.v. They are not used in RingMicromega.v. *)
-
-(* Surprisingly, multilication is needed to prove the following theorem *)
-
-Theorem Ropp_neg_pos : forall n : R, - n < 0 <-> 0 < n.
-Proof.
-intro n; setoid_replace n with (- - n) by ring. rewrite Ropp_pos_neg.
-now setoid_replace (- - n) with n by ring.
-Qed.
-
-Theorem Rlt_0_1 : 0 < 1.
-Proof.
-apply <- Rlt_le_neq. split.
-setoid_replace 1 with (1 * 1) by ring. apply Rtimes_square_nonneg.
-apply Rneq_0_1.
-Qed.
-
-Theorem Rlt_succ_r : forall n : R, n < 1 + n.
-Proof.
-intro n. rewrite <- (Rplus_0_l n); setoid_replace (1 + (0 + n)) with (1 + n) by ring.
-apply -> Rplus_lt_mono_r. apply Rlt_0_1.
-Qed.
-
-Theorem Rlt_lt_succ : forall n m : R, n < m -> n < 1 + m.
-Proof.
-intros n m H; apply Rlt_trans with m. assumption. apply Rlt_succ_r.
-Qed.
-
-(*Theorem Rtimes_lt_mono_pos_l : forall n m p : R, 0 < p -> n < m -> p * n < p * m.
-Proof.
-intros n m p H1 H2. apply <- Rlt_lt_minus.
-setoid_replace (p * m - p * n) with (p * (m - n)) by ring.
-apply Rtimes_pos_pos. assumption. now apply -> Rlt_lt_minus.
-Qed.*)
-
-End STRICT_ORDERED_RING.
-
diff --git a/contrib/micromega/Psatz.v b/contrib/micromega/Psatz.v
deleted file mode 100644
index b2dd9910..00000000
--- a/contrib/micromega/Psatz.v
+++ /dev/null
@@ -1,75 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-Require Import ZMicromega.
-Require Import QMicromega.
-Require Import RMicromega.
-Require Import QArith.
-Require Export Ring_normalize.
-Require Import ZArith.
-Require Import Raxioms.
-Require Export RingMicromega.
-Require Import VarMap.
-Require Tauto.
-
-Ltac xpsatz dom d :=
-  let tac := lazymatch dom with
-  | Z => 
-    (sos_Z || psatz_Z d) ;
-    intros __wit __varmap __ff ; 
-    change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ; 
-    apply (ZTautoChecker_sound __ff __wit); vm_compute ; reflexivity
-  | R =>
-    (sos_R || psatz_R d) ;
-    intros __wit __varmap __ff ; 
-    change (Tauto.eval_f (Reval_formula (@find R 0%R __varmap)) __ff) ; 
-    apply (RTautoChecker_sound __ff __wit); vm_compute ; reflexivity
-  | Q =>
-      (sos_Q || psatz_Q d) ;
-    intros __wit __varmap __ff ; 
-    change (Tauto.eval_f (Qeval_formula (@find Q 0%Q __varmap)) __ff) ; 
-    apply (QTautoChecker_sound __ff __wit); vm_compute ; reflexivity
-  | _ => fail "Unsupported domain"
-  end in tac.
-
-Tactic Notation "psatz" constr(dom) int_or_var(n) := xpsatz dom n.
-Tactic Notation "psatz" constr(dom) := xpsatz dom ltac:-1.
-
-Ltac psatzl dom :=
-  let tac := lazymatch dom with
-  | Z =>
-    psatzl_Z ;
-    intros __wit __varmap __ff ;
-    change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ; 
-    apply (ZTautoChecker_sound __ff __wit); vm_compute ; reflexivity
-  | Q =>
-    psatzl_Q ; 
-    intros __wit __varmap __ff ; 
-    change (Tauto.eval_f (Qeval_formula (@find Q 0%Q __varmap)) __ff) ; 
-    apply (QTautoChecker_sound __ff __wit); vm_compute ; reflexivity
-  | R => 
-    psatzl_R ;
-    intros __wit __varmap __ff ;
-    change (Tauto.eval_f (Reval_formula (@find R 0%R __varmap)) __ff) ; 
-    apply (RTautoChecker_sound __ff __wit); vm_compute ; reflexivity
-  | _ => fail "Unsupported domain"
-  end in tac.
-
-
-
-Ltac lia := 
-  xlia ;
-  intros __wit __varmap __ff ;
-    change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ; 
-      apply (ZTautoChecker_sound __ff __wit); vm_compute ; reflexivity.
diff --git a/contrib/micromega/QMicromega.v b/contrib/micromega/QMicromega.v
deleted file mode 100644
index c054f218..00000000
--- a/contrib/micromega/QMicromega.v
+++ /dev/null
@@ -1,199 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-Require Import OrderedRing.
-Require Import RingMicromega.
-Require Import Refl.
-Require Import QArith.
-Require Import Qfield.
-
-Lemma Qsor : SOR 0 1 Qplus Qmult Qminus Qopp Qeq  Qle Qlt.
-Proof.
-  constructor; intros ; subst ; try (intuition (subst; auto with qarith)).
-  apply Q_Setoid.
-  rewrite H ; rewrite H0 ; reflexivity.
-  rewrite H ; rewrite H0 ; reflexivity.
-  rewrite H ; auto ; reflexivity.
-  rewrite <- H ; rewrite <- H0 ; auto.
-  rewrite H ; rewrite H0 ; auto.
-  rewrite <- H ; rewrite <- H0 ; auto.
-  rewrite H ; rewrite  H0 ; auto.
-  apply Qsrt.
-  apply Qle_refl.
-  apply Qle_antisym ; auto.
-  eapply Qle_trans ; eauto.
-  apply Qlt_le_weak ; auto.
-  apply (Qlt_not_eq n m H H0) ; auto.
-  destruct (Qle_lt_or_eq _ _ H0) ; auto.
-  tauto.
-  destruct(Q_dec n m) as [[H1 |H1] | H1 ] ; tauto.
-  apply (Qplus_le_compat  p p n m  (Qle_refl p) H).
-  generalize (Qmult_lt_compat_r 0 n m H0 H).
-  rewrite Qmult_0_l.
-  auto.
-  compute in H.
-  discriminate.
-Qed.
-
-
-Lemma QSORaddon :
-  SORaddon 0 1 Qplus Qmult Qminus Qopp  Qeq  Qle (* ring elements *)
-  0 1 Qplus Qmult Qminus Qopp (* coefficients *)
-  Qeq_bool Qle_bool
-  (fun x => x) (fun x => x) (pow_N 1 Qmult).
-Proof.
-  constructor.
-  constructor ; intros ; try reflexivity.
-  apply Qeq_bool_eq; auto.
-  constructor.
-  reflexivity.
-  intros x y.
-  apply Qeq_bool_neq ; auto.
-  apply Qle_bool_imp_le.
-Qed.
-
-
-(*Definition Zeval_expr :=  eval_pexpr 0 Zplus Zmult Zminus Zopp  (fun x => x) (fun x => Z_of_N x) (Zpower).*)
-Require Import EnvRing.
-
-Fixpoint Qeval_expr (env: PolEnv Q) (e: PExpr Q) : Q :=
-  match e with
-    | PEc c =>  c
-    | PEX j =>  env j
-    | PEadd pe1 pe2 => (Qeval_expr env pe1) + (Qeval_expr env pe2)
-    | PEsub pe1 pe2 => (Qeval_expr env pe1) - (Qeval_expr env pe2)
-    | PEmul pe1 pe2 => (Qeval_expr env pe1) * (Qeval_expr env pe2)
-    | PEopp pe1 => - (Qeval_expr env pe1)
-    | PEpow pe1 n => Qpower (Qeval_expr env pe1)  (Z_of_N n)
-  end.
-
-Lemma Qeval_expr_simpl : forall env e,
-  Qeval_expr env e = 
-  match e with
-    | PEc c =>  c
-    | PEX j =>  env j
-    | PEadd pe1 pe2 => (Qeval_expr env pe1) + (Qeval_expr env pe2)
-    | PEsub pe1 pe2 => (Qeval_expr env pe1) - (Qeval_expr env pe2)
-    | PEmul pe1 pe2 => (Qeval_expr env pe1) * (Qeval_expr env pe2)
-    | PEopp pe1 => - (Qeval_expr env pe1)
-    | PEpow pe1 n => Qpower (Qeval_expr env pe1)  (Z_of_N n)
-  end.
-Proof.
-  destruct e ; reflexivity.
-Qed.
-
-Definition Qeval_expr' := eval_pexpr  Qplus Qmult Qminus Qopp (fun x => x) (fun x => x) (pow_N 1 Qmult).
-
-Lemma QNpower : forall r n, r ^ Z_of_N n = pow_N 1 Qmult r n.
-Proof.
-  destruct n ; reflexivity.
-Qed.
-
-
-Lemma Qeval_expr_compat : forall env e, Qeval_expr env e = Qeval_expr' env e.
-Proof.
-  induction e ; simpl ; subst ; try congruence.
-  rewrite IHe.
-  apply QNpower.
-Qed.
-
-Definition Qeval_op2 (o : Op2) : Q -> Q -> Prop :=
-match o with
-| OpEq =>  Qeq
-| OpNEq => fun x y  => ~ x == y
-| OpLe => Qle
-| OpGe => fun x y => Qle y x
-| OpLt => Qlt
-| OpGt => fun x y => Qlt y x
-end.
-
-Definition Qeval_formula (e:PolEnv Q) (ff : Formula Q) :=
-  let (lhs,o,rhs) := ff in Qeval_op2 o (Qeval_expr e lhs) (Qeval_expr e rhs).
-
-Definition Qeval_formula' :=
-  eval_formula  Qplus Qmult Qminus Qopp Qeq Qle Qlt (fun x => x) (fun x => x) (pow_N 1 Qmult).
-
-Lemma Qeval_formula_compat : forall env f, Qeval_formula env f <-> Qeval_formula' env f.
-Proof.
-  intros.
-  unfold Qeval_formula.
-  destruct f.
-  repeat rewrite Qeval_expr_compat.
-  unfold Qeval_formula'.
-  unfold Qeval_expr'.
-  split ; destruct Fop ; simpl; auto.
-Qed.
-
-
-
-Definition Qeval_nformula :=
-  eval_nformula 0 Qplus Qmult Qminus Qopp Qeq Qle Qlt (fun x => x) (fun x => x) (pow_N 1 Qmult).
-
-Definition Qeval_op1 (o : Op1) : Q -> Prop :=
-match o with
-| Equal => fun x : Q => x == 0
-| NonEqual => fun x : Q => ~ x == 0
-| Strict => fun x : Q => 0 < x
-| NonStrict => fun x : Q => 0 <= x
-end.
-
-Lemma Qeval_nformula_simpl : forall env f, Qeval_nformula env f = (let (p, op) := f in Qeval_op1 op (Qeval_expr env p)).
-Proof.
-  intros.
-  destruct f.
-  rewrite Qeval_expr_compat.
-  reflexivity.
-Qed.
-  
-Lemma Qeval_nformula_dec : forall env d, (Qeval_nformula env d) \/ ~ (Qeval_nformula env d).
-Proof.
-  exact (fun env d =>eval_nformula_dec Qsor (fun x => x) (fun x => x) (pow_N 1 Qmult) env d).
-Qed.
-
-Definition QWitness := ConeMember Q.
-
-Definition QWeakChecker := check_normalised_formulas 0 1 Qplus Qmult Qminus Qopp Qeq_bool Qle_bool.
-
-Require Import List.
-
-Lemma QWeakChecker_sound :   forall (l : list (NFormula Q)) (cm : QWitness),
-  QWeakChecker l cm = true ->
-  forall env, make_impl (Qeval_nformula env) l False.
-Proof.
-  intros l cm H.
-  intro.
-  unfold Qeval_nformula.
-  apply (checker_nf_sound Qsor QSORaddon l cm).
-  unfold QWeakChecker in H.
-  exact H.
-Qed.
-
-Require Import Tauto.
-
-Definition QTautoChecker (f : BFormula (Formula Q)) (w: list QWitness)  : bool :=
-  @tauto_checker (Formula Q) (NFormula Q) (@cnf_normalise Q) (@cnf_negate Q)  QWitness QWeakChecker f w.
-
-Lemma QTautoChecker_sound : forall f w, QTautoChecker f w = true -> forall env, eval_f  (Qeval_formula env)  f.
-Proof.
-  intros f w.
-  unfold QTautoChecker.
-  apply (tauto_checker_sound  Qeval_formula Qeval_nformula).
-  apply Qeval_nformula_dec.
-  intros. rewrite Qeval_formula_compat. unfold Qeval_formula'. now apply (cnf_normalise_correct Qsor).
-  intros. rewrite Qeval_formula_compat. unfold Qeval_formula'. now apply (cnf_negate_correct Qsor).
-  intros t w0.
-  apply QWeakChecker_sound.
-Qed.
-
-
diff --git a/contrib/micromega/RMicromega.v b/contrib/micromega/RMicromega.v
deleted file mode 100644
index 7c6969c2..00000000
--- a/contrib/micromega/RMicromega.v
+++ /dev/null
@@ -1,174 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-Require Import OrderedRing.
-Require Import RingMicromega.
-Require Import Refl.
-Require Import Raxioms RIneq Rpow_def DiscrR.
-Require Setoid.
-
-Definition Rsrt : ring_theory R0 R1 Rplus Rmult Rminus Ropp (@eq R).
-Proof.
-  constructor.
-  exact Rplus_0_l.
-  exact Rplus_comm.
-  intros. rewrite Rplus_assoc. auto.
-  exact Rmult_1_l.
-  exact Rmult_comm.
-  intros ; rewrite Rmult_assoc ; auto.
-  intros. rewrite Rmult_comm. rewrite Rmult_plus_distr_l.
-   rewrite (Rmult_comm z).    rewrite (Rmult_comm z). auto.
-  reflexivity.
-  exact Rplus_opp_r.
-Qed.
-
-Add Ring Rring : Rsrt.
-Open Scope R_scope.
-
-Lemma Rmult_neutral : forall x:R , 0 * x = 0.
-Proof.
-  intro ; ring.
-Qed.
-
-
-Lemma Rsor : SOR R0 R1 Rplus Rmult Rminus Ropp (@eq R)  Rle Rlt.
-Proof.
-  constructor; intros ; subst ; try (intuition (subst; try ring ; auto with real)).
-  constructor.
-  constructor.
-  unfold RelationClasses.Symmetric. auto.
-  unfold RelationClasses.Transitive. intros. subst. reflexivity.
-  apply Rsrt.
-  eapply Rle_trans ; eauto.
-  apply (Rlt_irrefl m) ; auto.
-  apply Rnot_le_lt. auto with real.
-  destruct (total_order_T n m) as [ [H1 | H1] | H1] ; auto.
-  intros.
-  rewrite <- (Rmult_neutral m).
-  apply (Rmult_lt_compat_r) ; auto.
-Qed.
-
-Require ZMicromega.
-
-(* R with coeffs in Z *)
-
-Lemma RZSORaddon :
-  SORaddon R0 R1 Rplus Rmult Rminus Ropp  (@eq R)  Rle (* ring elements *)
-  0%Z 1%Z Zplus Zmult Zminus Zopp (* coefficients *)
-  Zeq_bool Zle_bool
-  IZR Nnat.nat_of_N pow.
-Proof.
-  constructor.
-  constructor ; intros ; try reflexivity.
-  apply plus_IZR.
-  symmetry. apply Z_R_minus.
-  apply mult_IZR.
-  apply Ropp_Ropp_IZR.
-  apply IZR_eq.
-  apply Zeq_bool_eq ; auto.
-  apply R_power_theory.
-  intros x y.
-  intro.
-  apply IZR_neq.
-  apply Zeq_bool_neq ; auto.
-  intros. apply IZR_le.  apply Zle_bool_imp_le. auto.
-Qed.
-
-
-Require Import EnvRing.
-
-Definition INZ (n:N) : R :=
-  match n with
-    | N0 => IZR 0%Z
-    | Npos p => IZR (Zpos p)
-  end.
-
-Definition Reval_expr := eval_pexpr  Rplus Rmult Rminus Ropp IZR Nnat.nat_of_N pow.
-
-
-Definition Reval_op2 (o:Op2) : R -> R -> Prop :=
-    match o with
-      | OpEq =>  @eq R
-      | OpNEq => fun x y  => ~ x = y
-      | OpLe => Rle
-      | OpGe => Rge
-      | OpLt => Rlt
-      | OpGt => Rgt
-    end.
-
-
-Definition Reval_formula (e: PolEnv R) (ff : Formula Z) :=
-  let (lhs,o,rhs) := ff in Reval_op2 o (Reval_expr e lhs) (Reval_expr e rhs).
-
-Definition Reval_formula' :=
-  eval_formula  Rplus Rmult Rminus Ropp (@eq R) Rle Rlt IZR Nnat.nat_of_N pow.
-
-Lemma Reval_formula_compat : forall env f, Reval_formula env f <-> Reval_formula' env f.
-Proof.
-  intros.
-  unfold Reval_formula.
-  destruct f.
-  unfold Reval_formula'.
-  unfold Reval_expr.
-  split ; destruct Fop ; simpl ; auto.
-  apply Rge_le.
-  apply Rle_ge.
-Qed.
-
-Definition Reval_nformula :=
-  eval_nformula 0 Rplus Rmult Rminus Ropp (@eq R) Rle Rlt IZR Nnat.nat_of_N pow.
-
-
-Lemma Reval_nformula_dec : forall env d, (Reval_nformula env d) \/ ~ (Reval_nformula env d).
-Proof.
-  exact (fun env d =>eval_nformula_dec Rsor IZR Nnat.nat_of_N pow env d).
-Qed.
-
-Definition RWitness := ConeMember Z.
-
-Definition RWeakChecker := check_normalised_formulas 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool Zle_bool.
-
-Require Import List.
-
-Lemma RWeakChecker_sound :   forall (l : list (NFormula Z)) (cm : RWitness),
-  RWeakChecker l cm = true ->
-  forall env, make_impl (Reval_nformula env) l False.
-Proof.
-  intros l cm H.
-  intro.
-  unfold Reval_nformula.
-  apply (checker_nf_sound Rsor RZSORaddon l cm).
-  unfold RWeakChecker in H.
-  exact H.
-Qed.
-
-Require Import Tauto.
-
-Definition RTautoChecker (f : BFormula (Formula Z)) (w: list RWitness)  : bool :=
-  @tauto_checker (Formula Z) (NFormula Z) (@cnf_normalise Z) (@cnf_negate Z)  RWitness RWeakChecker f w.
-
-Lemma RTautoChecker_sound : forall f w, RTautoChecker f w = true -> forall env, eval_f  (Reval_formula env)  f.
-Proof.
-  intros f w.
-  unfold RTautoChecker.
-  apply (tauto_checker_sound  Reval_formula Reval_nformula).
-  apply Reval_nformula_dec.
-  intros. rewrite Reval_formula_compat.
-  unfold Reval_formula'. now apply (cnf_normalise_correct Rsor).
-  intros. rewrite Reval_formula_compat. unfold Reval_formula. now apply (cnf_negate_correct Rsor).
-  intros t w0.
-  apply RWeakChecker_sound.
-Qed.
-
-
diff --git a/contrib/micromega/Refl.v b/contrib/micromega/Refl.v
deleted file mode 100644
index 801d8b21..00000000
--- a/contrib/micromega/Refl.v
+++ /dev/null
@@ -1,129 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-Require Import List.
-Require Setoid.
-
-Set Implicit Arguments.
-
-(* Refl of '->' '/\': basic properties *)
-
-Fixpoint make_impl (A : Type) (eval : A -> Prop) (l : list A) (goal : Prop) {struct l} : Prop :=
-  match l with
-    | nil => goal
-    | cons e l => (eval e) -> (make_impl eval l goal)
-  end.
-
-Theorem make_impl_true :
-  forall (A : Type) (eval : A -> Prop) (l : list A), make_impl eval l True.
-Proof.
-induction l as [| a l IH]; simpl.
-trivial.
-intro; apply IH.
-Qed.
-
-Fixpoint make_conj (A : Type) (eval : A -> Prop) (l : list A) {struct l} : Prop :=
-  match l with
-    | nil => True
-    | cons e nil => (eval e)
-    | cons e l2 => ((eval e) /\ (make_conj eval l2))
-  end.
-
-Theorem make_conj_cons : forall (A : Type) (eval : A -> Prop) (a : A) (l : list A),
-  make_conj eval (a :: l) <-> eval a /\ make_conj eval l.
-Proof.
-intros; destruct l; simpl; tauto.
-Qed.
-
-
-Lemma make_conj_impl : forall (A : Type) (eval : A -> Prop) (l : list A) (g : Prop),
-  (make_conj eval l -> g) <-> make_impl eval l g.
-Proof.
-  induction l.
-  simpl.
-  tauto.
-  simpl.
-  intros.
-  destruct l.
-  simpl.
-  tauto.
-  generalize (IHl g).
-  tauto.
-Qed.
-
-Lemma make_conj_in : forall (A : Type) (eval : A -> Prop) (l : list A),
-  make_conj eval l -> (forall p, In p l -> eval p).
-Proof.
-  induction l.
-  simpl.
-  tauto.
-  simpl.
-  intros.
-  destruct l.
-  simpl in H0.
-  destruct H0.
-  subst; auto.
-  tauto.
-  destruct H.
-  destruct H0.
-  subst;auto.
-  apply IHl; auto.
-Qed.
-
-
-
-Lemma make_conj_app : forall  A eval l1 l2, @make_conj A eval (l1 ++ l2) <-> @make_conj A eval l1 /\ @make_conj A eval l2.
-Proof.
-  induction l1.
-  simpl.
-  tauto.
-  intros.
-  change ((a::l1) ++ l2) with (a :: (l1 ++ l2)).
-  rewrite make_conj_cons.
-  rewrite IHl1.
-  rewrite make_conj_cons.
-  tauto.
-Qed.
-
-Lemma not_make_conj_cons : forall (A:Type) (t:A) a eval  (no_middle_eval : (eval t) \/ ~ (eval  t)),
-  ~ make_conj  eval (t ::a) -> ~  (eval t) \/ (~ make_conj  eval a).
-Proof.
-  intros.
-  simpl in H.
-  destruct a.
-  tauto.
-  tauto.
-Qed.
-
-Lemma not_make_conj_app : forall (A:Type) (t:list A) a eval
-  (no_middle_eval : forall d, eval d \/ ~ eval d) , 
-  ~ make_conj  eval (t ++ a) -> (~ make_conj  eval t) \/ (~ make_conj eval a).
-Proof.
-  induction t.
-  simpl.
-  tauto.
-  intros.
-  simpl ((a::t)++a0)in H.
-  destruct (@not_make_conj_cons _ _ _ _  (no_middle_eval a) H).
-  left ; red ; intros.
-  apply H0.
-  rewrite  make_conj_cons in H1.
-  tauto.
-  destruct (IHt _ _ no_middle_eval H0).
-  left ; red ; intros.
-  apply H1.
-  rewrite make_conj_cons in H2.
-  tauto.
-  right ; auto.
-Qed.
diff --git a/contrib/micromega/RingMicromega.v b/contrib/micromega/RingMicromega.v
deleted file mode 100644
index 6885b82c..00000000
--- a/contrib/micromega/RingMicromega.v
+++ /dev/null
@@ -1,779 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                      Evgeny Makarov, INRIA, 2007                     *)
-(************************************************************************)
-
-Require Import NArith.
-Require Import Relation_Definitions.
-Require Import Setoid.
-(*****)
-Require Import Env.
-Require Import EnvRing.
-(*****)
-Require Import List.
-Require Import Bool.
-Require Import OrderedRing.
-Require Import Refl.
-
-
-Set Implicit Arguments.
-
-Import OrderedRingSyntax.
-
-Section Micromega.
-
-(* Assume we have a strict(ly?) ordered ring *)
-
-Variable R : Type.
-Variables rO rI : R.
-Variables rplus rtimes rminus: R -> R -> R.
-Variable ropp : R -> R.
-Variables req rle rlt : R -> R -> Prop.
-
-Variable sor : SOR rO rI rplus rtimes rminus ropp req rle rlt.
-
-Notation "0" := rO.
-Notation "1" := rI.
-Notation "x + y" := (rplus x y).
-Notation "x * y " := (rtimes x y).
-Notation "x - y " := (rminus x y).
-Notation "- x" := (ropp x).
-Notation "x == y" := (req x y).
-Notation "x ~= y" := (~ req x y).
-Notation "x <= y" := (rle x y).
-Notation "x < y" := (rlt x y).
-
-(* Assume we have a type of coefficients C and a morphism from C to R *)
-
-Variable C : Type.
-Variables cO cI : C.
-Variables cplus ctimes cminus: C -> C -> C.
-Variable copp : C -> C.
-Variables ceqb cleb : C -> C -> bool.
-Variable phi : C -> R.
-
-(* Power coefficients *)
-Variable E : Set. (* the type of exponents *)
-Variable pow_phi : N -> E.
-Variable rpow : R -> E -> R.
-
-Notation "[ x ]" := (phi x).
-Notation "x [=] y" := (ceqb x y).
-Notation "x [<=] y" := (cleb x y).
-
-(* Let's collect all hypotheses in addition to the ordered ring axioms into
-one structure *)
-
-Record SORaddon := mk_SOR_addon {
-  SORrm : ring_morph 0 1 rplus rtimes rminus ropp req cO cI cplus ctimes cminus copp ceqb phi;
-  SORpower : power_theory rI rtimes req pow_phi rpow;
-  SORcneqb_morph : forall x y : C, x [=] y = false -> [x] ~= [y];
-  SORcleb_morph : forall x y : C, x [<=] y = true -> [x] <= [y]
-}.
-
-Variable addon : SORaddon.
-
-Add Relation R req
-  reflexivity proved by sor.(SORsetoid).(@Equivalence_Reflexive _ _ )
-  symmetry proved by sor.(SORsetoid).(@Equivalence_Symmetric _ _ )
-  transitivity proved by sor.(SORsetoid).(@Equivalence_Transitive _ _ )
-as micomega_sor_setoid.
-
-Add Morphism rplus with signature req ==> req ==> req as rplus_morph.
-Proof.
-exact sor.(SORplus_wd).
-Qed.
-Add Morphism rtimes with signature req ==> req ==> req as rtimes_morph.
-Proof.
-exact sor.(SORtimes_wd).
-Qed.
-Add Morphism ropp with signature req ==> req as ropp_morph.
-Proof.
-exact sor.(SORopp_wd).
-Qed.
-Add Morphism rle with signature req ==> req ==> iff as rle_morph.
-Proof.
-  exact sor.(SORle_wd).
-Qed.
-Add Morphism rlt with signature req ==> req ==> iff as rlt_morph.
-Proof.
-  exact sor.(SORlt_wd).
-Qed.
-
-Add Morphism rminus with signature req ==> req ==> req as rminus_morph.
-Proof.
-  exact (rminus_morph sor). (* We already proved that minus is a morphism in OrderedRing.v *)
-Qed.
-
-Definition cneqb (x y : C) := negb (ceqb x y).
-Definition cltb (x y : C) := (cleb x y) && (cneqb x y).
-
-Notation "x [~=] y" := (cneqb x y).
-Notation "x [<] y" := (cltb x y).
-
-Ltac le_less := rewrite (Rle_lt_eq sor); left; try assumption.
-Ltac le_equal := rewrite (Rle_lt_eq sor); right; try reflexivity; try assumption.
-Ltac le_elim H := rewrite (Rle_lt_eq sor) in H; destruct H as [H | H].
-
-Lemma cleb_sound : forall x y : C, x [<=] y = true -> [x] <= [y].
-Proof.
-  exact addon.(SORcleb_morph).
-Qed.
-
-Lemma cneqb_sound : forall x y : C, x [~=] y = true -> [x] ~= [y].
-Proof.
-intros x y H1. apply addon.(SORcneqb_morph). unfold cneqb, negb in H1.
-destruct (ceqb x y); now try discriminate.
-Qed.
-
-Lemma cltb_sound : forall x y : C, x [<] y = true -> [x] < [y].
-Proof.
-intros x y H. unfold cltb in H. apply andb_prop in H. destruct H as [H1 H2].
-apply cleb_sound in H1. apply cneqb_sound in H2. apply <- (Rlt_le_neq sor). now split.
-Qed.
-
-(* Begin Micromega *)
-
-Definition PExprC := PExpr C. (* arbitrary expressions built from +, *, - *)
-Definition PolC := Pol C. (* polynomials in generalized Horner form, defined in Ring_polynom or EnvRing *)
-(*****)
-(*Definition Env := Env R. (* For interpreting PExprC *)*)
-Definition PolEnv := Env R. (* For interpreting PolC *)
-(*****)
-(*Definition Env := list R.
-Definition PolEnv := list R.*)
-(*****)
-
-(* What benefit do we get, in the case of EnvRing, from defining eval_pexpr
-explicitely below and not through PEeval, as the following lemma says? The
-function eval_pexpr seems to be a straightforward special case of PEeval
-when the environment (i.e., the second last argument of PEeval) of type
-off_map (which is (option positive * t)) is (None, env). *)
-
-(*****)
-Fixpoint eval_pexpr (l : PolEnv) (pe : PExprC) {struct pe} : R :=
-match pe with
-| PEc c => phi c
-| PEX j =>  l j
-| PEadd pe1 pe2 => (eval_pexpr l pe1) + (eval_pexpr l pe2)
-| PEsub pe1 pe2 => (eval_pexpr l pe1) - (eval_pexpr l pe2)
-| PEmul pe1 pe2 => (eval_pexpr l pe1) * (eval_pexpr l pe2)
-| PEopp pe1 => - (eval_pexpr l pe1)
-| PEpow pe1 n => rpow (eval_pexpr l pe1) (pow_phi n)
-end.
-
-
-Lemma eval_pexpr_simpl : forall  (l : PolEnv) (pe : PExprC),
-  eval_pexpr l pe = 
-  match pe with
-    | PEc c => phi c
-    | PEX j => l j
-    | PEadd pe1 pe2 => (eval_pexpr l pe1) + (eval_pexpr l pe2)
-    | PEsub pe1 pe2 => (eval_pexpr l pe1) - (eval_pexpr l pe2)
-    | PEmul pe1 pe2 => (eval_pexpr l pe1) * (eval_pexpr l pe2)
-    | PEopp pe1 => - (eval_pexpr l pe1)
-    | PEpow pe1 n => rpow (eval_pexpr l pe1) (pow_phi n)
-  end.
-Proof.
-  intros ; destruct pe ; reflexivity.
-Qed.
-
-
-
-Lemma eval_pexpr_PEeval : forall (env : PolEnv) (pe : PExprC),
-  eval_pexpr env pe =
-  PEeval rplus rtimes rminus ropp phi pow_phi rpow env pe.
-Proof.
-induction pe; simpl; intros.
-reflexivity.
-reflexivity.
-rewrite <- IHpe1; rewrite <- IHpe2; reflexivity.
-rewrite <- IHpe1; rewrite <- IHpe2; reflexivity.
-rewrite <- IHpe1; rewrite <- IHpe2; reflexivity.
-rewrite <- IHpe; reflexivity.
-rewrite <- IHpe; reflexivity.
-Qed.
-(*****)
-(*Definition eval_pexpr : Env -> PExprC -> R :=
-  PEeval 0 rplus rtimes rminus ropp phi pow_phi rpow.*)
-(*****)
-
-Inductive Op1 : Set := (* relations with 0 *)
-| Equal (* == 0 *)
-| NonEqual (* ~= 0 *)
-| Strict (* > 0 *)
-| NonStrict (* >= 0 *).
-
-Definition NFormula := (PExprC * Op1)%type. (* normalized formula *)
-
-Definition eval_op1 (o : Op1) : R -> Prop :=
-match o with
-| Equal => fun x => x == 0
-| NonEqual => fun x : R => x ~= 0
-| Strict => fun x : R => 0 < x
-| NonStrict => fun x : R => 0 <= x
-end.
-
-Definition eval_nformula (env : PolEnv) (f : NFormula) : Prop :=
-let (p, op) := f in eval_op1 op (eval_pexpr env p).
-
-
-Definition OpMult (o o' : Op1) : Op1 :=
-match o with
-| Equal => Equal
-| NonStrict => NonStrict (* (OpMult NonStrict Equal) could be defined as Equal *)
-| Strict => o'
-| NonEqual => NonEqual (* does not matter what we return here; see the following lemmas *)
-end.
-
-Definition OpAdd (o o': Op1) : Op1 :=
-match o with
-| Equal => o'
-| NonStrict =>
-  match o' with
-  | Strict => Strict
-  | _ => NonStrict
-  end
-| Strict => Strict
-| NonEqual => NonEqual (* does not matter what we return here *)
-end.
-
-Lemma OpMultNonEqual :
-  forall o o' : Op1, o <> NonEqual -> o' <> NonEqual -> OpMult o o' <> NonEqual.
-Proof.
-intros o o' H1 H2; destruct o; destruct o'; simpl; try discriminate;
-try (intro H; apply H1; reflexivity);
-try (intro H; apply H2; reflexivity).
-Qed.
-
-Lemma OpAdd_NonEqual :
-  forall o o' : Op1, o <> NonEqual -> o' <> NonEqual -> OpAdd o o' <> NonEqual.
-Proof.
-intros o o' H1 H2; destruct o; destruct o'; simpl; try discriminate;
-try (intro H; apply H1; reflexivity);
-try (intro H; apply H2; reflexivity).
-Qed.
-
-Lemma OpMult_sound :
-  forall (o o' : Op1) (x y : R), o <> NonEqual -> o' <> NonEqual ->
-    eval_op1 o x -> eval_op1 o' y -> eval_op1 (OpMult o o') (x * y).
-Proof.
-unfold eval_op1; destruct o; simpl; intros o' x y H1 H2 H3 H4.
-rewrite H3; now rewrite (Rtimes_0_l sor).
-elimtype False; now apply H1.
-destruct o'.
-rewrite H4; now rewrite (Rtimes_0_r sor).
-elimtype False; now apply H2.
-now apply (Rtimes_pos_pos sor).
-apply (Rtimes_nonneg_nonneg sor); [le_less | assumption].
-destruct o'.
-rewrite H4, (Rtimes_0_r sor); le_equal.
-elimtype False; now apply H2.
-apply (Rtimes_nonneg_nonneg sor); [assumption | le_less].
-now apply (Rtimes_nonneg_nonneg sor).
-Qed.
-
-Lemma OpAdd_sound :
-  forall (o o' : Op1) (e e' : R), o <> NonEqual -> o' <> NonEqual ->
-    eval_op1 o e -> eval_op1 o' e' -> eval_op1 (OpAdd o o') (e + e').
-Proof.
-unfold eval_op1; destruct o; simpl; intros o' e e' H1 H2 H3 H4.
-destruct o'.
-now rewrite H3, H4, (Rplus_0_l sor).
-elimtype False; now apply H2.
-now rewrite H3, (Rplus_0_l sor).
-now rewrite H3, (Rplus_0_l sor).
-elimtype False; now apply H1.
-destruct o'.
-now rewrite H4, (Rplus_0_r sor).
-elimtype False; now apply H2.
-now apply (Rplus_pos_pos sor).
-now apply (Rplus_pos_nonneg sor).
-destruct o'.
-now rewrite H4, (Rplus_0_r sor).
-elimtype False; now apply H2.
-now apply (Rplus_nonneg_pos sor).
-now apply (Rplus_nonneg_nonneg sor).
-Qed.
-
-(* We consider a monoid whose generators are polynomials from the
-hypotheses of the form (p ~= 0). Thus it follows from the hypotheses that
-every element of the monoid (i.e., arbitrary product of generators) is ~=
-0. Therefore, the square of every element is > 0. *)
-
-Inductive Monoid (l : list NFormula) : PExprC -> Prop :=
-| M_One : Monoid l (PEc cI)
-| M_In : forall p : PExprC, In (p, NonEqual) l -> Monoid l p
-| M_Mult : forall (e1 e2 : PExprC), Monoid l e1 -> Monoid l e2 -> Monoid l (PEmul e1 e2).
-
-(* Do we really need to rely on the intermediate definition of monoid ?
-   InC why the restriction NonEqual ?
-   Could not we consider the IsIdeal as a IsMult ?
-   The same for IsSquare ?
-*)
-
-Inductive Cone (l : list (NFormula)) : PExprC -> Op1 -> Prop :=
-| InC : forall p op, In (p, op) l -> op <> NonEqual -> Cone l p op
-| IsIdeal : forall p, Cone l p Equal -> forall p', Cone l (PEmul p p') Equal
-| IsSquare : forall p, Cone l (PEmul p p) NonStrict
-| IsMonoid : forall p, Monoid l p -> Cone l (PEmul p p) Strict
-| IsMult : forall p op q oq, Cone l p op -> Cone l q oq -> Cone l (PEmul p q) (OpMult op oq)
-| IsAdd : forall p op q oq, Cone l p op -> Cone l q oq -> Cone l (PEadd p q) (OpAdd op oq)
-| IsPos : forall c : C, cltb cO c = true -> Cone l (PEc c) Strict
-| IsZ : Cone l (PEc cO) Equal.
-
-(* As promised, if all hypotheses are true in some environment, then every
-member of the monoid is nonzero in this environment *)
-
-Lemma monoid_nonzero : forall (l : list NFormula) (env : PolEnv),
-  (forall f : NFormula, In f l -> eval_nformula env f) ->
-    forall p : PExprC, Monoid l p -> eval_pexpr env p ~= 0.
-Proof.
-intros l env H1 p H2. induction H2 as [| f H | e1 e2 H3 IH1 H4 IH2]; simpl.
-rewrite addon.(SORrm).(morph1). apply (Rneq_symm sor). apply (Rneq_0_1 sor).
-apply H1 in H. now simpl in H.
-simpl in IH1, IH2. apply (Rtimes_neq_0 sor). now split.
-Qed.
-
-(* If all members of a cone base are true in some environment, then every
-member of the cone is true as well *)
-
-Lemma cone_true :
-  forall (l : list NFormula) (env : PolEnv),
-    (forall (f : NFormula), In f l -> eval_nformula env f) ->
-      forall (p : PExprC) (op : Op1), Cone l p op ->
-        op <> NonEqual /\ eval_nformula env (p, op).
-Proof.
-intros l env H1 p op H2. induction H2; simpl in *.
-split. assumption. apply H1 in H. now unfold eval_nformula in H.
-split. discriminate. destruct IHCone as [_ H3]. rewrite H3. now rewrite (Rtimes_0_l sor).
-split. discriminate. apply (Rtimes_square_nonneg sor).
-split. discriminate. apply <- (Rlt_le_neq sor). split. apply (Rtimes_square_nonneg sor).
-apply (Rneq_symm sor). apply (Rtimes_neq_0 sor). split; now apply monoid_nonzero with l.
-destruct IHCone1 as [IH1 IH2]; destruct IHCone2 as [IH3 IH4].
-split. now apply OpMultNonEqual. now apply OpMult_sound.
-destruct IHCone1 as [IH1 IH2]; destruct IHCone2 as [IH3 IH4].
-split. now apply OpAdd_NonEqual. now apply OpAdd_sound.
-split. discriminate. rewrite <- addon.(SORrm).(morph0). now apply cltb_sound.
-split. discriminate. apply addon.(SORrm).(morph0).
-Qed.
-
-(* Every element of a monoid is a product of some generators; therefore,
-to determine an element we can give a list of generators' indices *)
-
-Definition MonoidMember : Set := list nat.
-
-Inductive ConeMember : Type :=
-| S_In : nat -> ConeMember
-| S_Ideal : PExprC -> ConeMember -> ConeMember
-| S_Square : PExprC -> ConeMember
-| S_Monoid : MonoidMember -> ConeMember
-| S_Mult : ConeMember -> ConeMember -> ConeMember
-| S_Add : ConeMember -> ConeMember -> ConeMember
-| S_Pos : C -> ConeMember 
-| S_Z : ConeMember.
-
-Definition nformula_times (f f' : NFormula) : NFormula :=
-let (p, op) := f in
-  let (p', op') := f' in
-    (PEmul p p', OpMult op op').
-
-Definition nformula_plus (f f' : NFormula) : NFormula :=
-let (p, op) := f in
-  let (p', op') := f' in
-    (PEadd p p', OpAdd op op').
-
-Definition nformula_times_0 (p : PExprC) (f : NFormula) : NFormula :=
-let (q, op) := f in
-  match op with
-  | Equal => (PEmul q p, Equal)
-  | _ => f
-  end.
-
-Fixpoint eval_monoid (l : list NFormula) (ns : MonoidMember) {struct ns} : PExprC :=
-match ns with
-| nil => PEc cI
-| n :: ns =>
-  let p := match nth n l (PEc cI, NonEqual) with
-           | (q, NonEqual) => q
-           | _ => PEc cI
-           end in
-    PEmul p (eval_monoid l ns)
-end.
-
-Theorem eval_monoid_in_monoid :
-  forall (l : list NFormula) (ns : MonoidMember), Monoid l (eval_monoid l ns).
-Proof.
-intro l; induction ns; simpl in *.
-constructor.
-apply M_Mult; [| assumption].
-destruct (nth_in_or_default a l (PEc cI, NonEqual)).
-destruct (nth a l (PEc cI, NonEqual)). destruct o; try constructor. assumption.
-rewrite e; simpl. constructor.
-Qed.
-
-(* Provides the cone member from the witness, i.e., ConeMember *)
-Fixpoint eval_cone (l : list NFormula) (cm : ConeMember) {struct cm} : NFormula :=
-match cm with
-| S_In n => match nth n l (PEc cO, Equal) with
-            | (_, NonEqual) => (PEc cO, Equal)
-            | f => f
-            end
-| S_Ideal p cm' => nformula_times_0 p (eval_cone l cm')
-| S_Square p => (PEmul p p, NonStrict)
-| S_Monoid m => let p := eval_monoid l m in (PEmul p p, Strict)
-| S_Mult p q => nformula_times (eval_cone l p) (eval_cone l q)
-| S_Add p q => nformula_plus (eval_cone l p) (eval_cone l q)
-| S_Pos c  => if cltb cO c then (PEc c, Strict) else (PEc cO, Equal)
-| S_Z => (PEc cO, Equal)
-end.
-
-Theorem eval_cone_in_cone :
-  forall (l : list NFormula) (cm : ConeMember),
-    let (p, op) := eval_cone l cm in Cone l p op.
-Proof.
-intros l cm; induction cm; simpl.
-destruct (nth_in_or_default n l (PEc cO, Equal)).
-destruct (nth n l (PEc cO, Equal)). destruct o; try (now apply InC). apply IsZ.
-rewrite e. apply IsZ.
-destruct (eval_cone l cm). destruct o; simpl; try assumption. now apply IsIdeal.
-apply IsSquare.
-apply IsMonoid. apply eval_monoid_in_monoid.
-destruct (eval_cone l cm1). destruct (eval_cone l cm2). unfold nformula_times. now apply IsMult.
-destruct (eval_cone l cm1). destruct (eval_cone l cm2). unfold nformula_plus. now apply IsAdd.
-case_eq (cO [<] c) ; intros ; [apply IsPos ; auto| apply IsZ].
-apply IsZ.
-Qed.
-
-(* (inconsistent_cone_member l p) means (p, op) is in the cone for some op
-(> 0, >= 0, == 0, or ~= 0) and this formula is inconsistent. This fact
-implies that l is inconsistent, as shown by the next lemma. Inconsistency
-of a formula (p, op) can be established by normalizing p and showing that
-it is a constant c for which (c, op) is false. (This is only a sufficient,
-not necessary, condition, of course.) Membership in the cone can be
-verified if we have a certificate. *)
-
-Definition inconsistent_cone_member (l : list NFormula) (p : PExprC) :=
-  exists op : Op1, Cone l p op /\
-    forall env : PolEnv, ~ eval_op1 op (eval_pexpr env p).
-
-(* If some element of a cone is inconsistent, then the base of the cone
-is also inconsistent *)
-
-Lemma prove_inconsistent :
-  forall (l : list NFormula) (p : PExprC),
-    inconsistent_cone_member l p -> forall env, make_impl (eval_nformula env) l False.
-Proof.
-intros l p H env.
-destruct H as [o [wit H]].
-apply -> make_conj_impl.
-intro H1. apply H with env.
-pose proof (@cone_true l env) as H2.
-cut (forall f : NFormula, In f l -> eval_nformula env f). intro H3.
-apply (proj2 (H2 H3 p o wit)). intro. now apply make_conj_in.
-Qed.
-
-Definition normalise_pexpr : PExprC -> PolC :=
-  norm_aux cO cI cplus ctimes cminus copp ceqb.
-
-(* The following definition we don't really need, hence it is commented *)
-(*Definition eval_pol : PolEnv -> PolC -> R := Pphi 0 rplus rtimes phi.*)
-
-(* roughly speaking, normalise_pexpr_correct is a proof of
-  forall env p, eval_pexpr env p == eval_pol env (normalise_pexpr p) *)
-
-(*****)
-Definition normalise_pexpr_correct :=
-let Rops_wd := mk_reqe rplus rtimes ropp req
-                       sor.(SORplus_wd)
-                       sor.(SORtimes_wd)
-                       sor.(SORopp_wd) in
-  norm_aux_spec sor.(SORsetoid) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd sor.(SORrt))
-                addon.(SORrm) addon.(SORpower).
-(*****)
-(*Definition normalise_pexpr_correct :=
-let Rops_wd := mk_reqe rplus rtimes ropp req
-                       sor.(SORplus_wd)
-                       sor.(SORtimes_wd)
-                       sor.(SORopp_wd) in
-  norm_aux_spec sor.(SORsetoid) Rops_wd (Rth_ARth sor.(SORsetoid) Rops_wd sor.(SORrt))
-                addon.(SORrm) addon.(SORpower) nil.*)
-(*****)
-
-(* Check that a formula f is inconsistent by normalizing and comparing the
-resulting constant with 0 *)
-
-Definition check_inconsistent (f : NFormula) : bool :=
-let (e, op) := f in
-  match normalise_pexpr e with
-  | Pc c =>
-    match op with
-    | Equal => cneqb c cO
-    | NonStrict => c [<] cO
-    | Strict => c [<=] cO
-    | NonEqual => false (* eval_cone never returns (p, NonEqual) *)
-    end
-  | _ => false (* not a constant *)
-  end.
-
-Lemma check_inconsistent_sound :
-  forall (p : PExprC) (op : Op1),
-    check_inconsistent (p, op) = true -> forall env, ~ eval_op1 op (eval_pexpr env p).
-Proof.
-intros p op H1 env. unfold check_inconsistent, normalise_pexpr in H1.
-destruct op; simpl;
-(*****)
-rewrite eval_pexpr_PEeval;
-(*****)
-(*unfold eval_pexpr;*)
-(*****)
-rewrite normalise_pexpr_correct;
-destruct (norm_aux cO cI cplus ctimes cminus copp ceqb p); simpl; try discriminate H1;
-try rewrite <- addon.(SORrm).(morph0); trivial.
-now apply cneqb_sound.
-apply cleb_sound in H1. now apply -> (Rle_ngt sor).
-apply cltb_sound in H1. now apply -> (Rlt_nge sor).
-Qed.
-
-Definition check_normalised_formulas : list NFormula -> ConeMember -> bool :=
-  fun l cm => check_inconsistent (eval_cone l cm).
-
-Lemma checker_nf_sound :
-  forall (l : list NFormula) (cm : ConeMember),
-    check_normalised_formulas l cm = true ->
-      forall env : PolEnv, make_impl (eval_nformula env) l False.
-Proof.
-intros l cm H env.
-unfold check_normalised_formulas in H.
-case_eq (eval_cone l cm). intros p op H1.
-apply prove_inconsistent with p. unfold inconsistent_cone_member. exists op. split.
-pose proof (eval_cone_in_cone l cm) as H2. now rewrite H1 in H2.
-apply check_inconsistent_sound. now rewrite <- H1.
-Qed.
-
-(** Normalisation of formulae **)
-
-Inductive Op2 : Set := (* binary relations *)
-| OpEq
-| OpNEq
-| OpLe
-| OpGe
-| OpLt
-| OpGt.
-
-Definition eval_op2 (o : Op2) : R -> R -> Prop :=
-match o with
-| OpEq => req
-| OpNEq => fun x y : R => x ~= y
-| OpLe => rle
-| OpGe => fun x y : R => y <= x
-| OpLt => fun x y : R => x < y
-| OpGt => fun x y : R => y < x
-end.
-
-Record Formula : Type := {
-  Flhs : PExprC;
-  Fop : Op2;
-  Frhs : PExprC
-}.
-
-Definition eval_formula (env : PolEnv) (f : Formula) : Prop :=
-  let (lhs, op, rhs) := f in
-    (eval_op2 op) (eval_pexpr env lhs) (eval_pexpr env rhs).
-
-(* We normalize Formulas by moving terms to one side *)
-
-Definition normalise (f : Formula) : NFormula :=
-let (lhs, op, rhs) := f in
-  match op with
-  | OpEq => (PEsub lhs rhs, Equal)
-  | OpNEq => (PEsub lhs rhs, NonEqual)
-  | OpLe => (PEsub rhs lhs, NonStrict)
-  | OpGe => (PEsub lhs rhs, NonStrict)
-  | OpGt => (PEsub lhs rhs, Strict)
-  | OpLt => (PEsub rhs lhs, Strict)
-  end.
-
-Definition negate (f : Formula) : NFormula :=
-let (lhs, op, rhs) := f in
-  match op with
-  | OpEq => (PEsub rhs lhs, NonEqual)
-  | OpNEq => (PEsub rhs lhs, Equal)
-  | OpLe => (PEsub lhs rhs, Strict) (* e <= e' == ~ e > e' *)
-  | OpGe => (PEsub rhs lhs, Strict)
-  | OpGt => (PEsub rhs lhs, NonStrict)
-  | OpLt => (PEsub lhs rhs, NonStrict)
-end.
-
-Theorem normalise_sound :
-  forall (env : PolEnv) (f : Formula),
-    eval_formula env f -> eval_nformula env (normalise f).
-Proof.
-intros env f H; destruct f as [lhs op rhs]; simpl in *.
-destruct op; simpl in *.
-now apply <- (Rminus_eq_0 sor).
-intros H1. apply -> (Rminus_eq_0 sor) in H1. now apply H.
-now apply -> (Rle_le_minus sor).
-now apply -> (Rle_le_minus sor).
-now apply -> (Rlt_lt_minus sor).
-now apply -> (Rlt_lt_minus sor).
-Qed.
-
-Theorem negate_correct :
-  forall (env : PolEnv) (f : Formula),
-    eval_formula env f <-> ~ (eval_nformula env (negate f)).
-Proof.
-intros env f; destruct f as [lhs op rhs]; simpl.
-destruct op; simpl.
-symmetry. rewrite (Rminus_eq_0 sor).
-split; intro H; [symmetry; now apply -> (Req_dne sor) | symmetry in H; now apply <- (Req_dne sor)].
-rewrite (Rminus_eq_0 sor). split; intro; now apply (Rneq_symm sor).
-rewrite <- (Rlt_lt_minus sor). now rewrite <- (Rle_ngt sor).
-rewrite <- (Rlt_lt_minus sor). now rewrite <- (Rle_ngt sor).
-rewrite <- (Rle_le_minus sor). now rewrite <- (Rlt_nge sor).
-rewrite <- (Rle_le_minus sor). now rewrite <- (Rlt_nge sor).
-Qed.
-
-(** Another normalistion - this is used for cnf conversion **)
-
-Definition xnormalise (t:Formula) : list (NFormula)  :=
-  let (lhs,o,rhs) := t in
-    match o with
-      | OpEq => 
-        (PEsub lhs  rhs, Strict)::(PEsub rhs lhs , Strict)::nil
-      | OpNEq => (PEsub lhs rhs,Equal) :: nil
-      | OpGt   => (PEsub rhs lhs,NonStrict) :: nil
-      | OpLt => (PEsub lhs rhs,NonStrict) :: nil
-      | OpGe => (PEsub rhs lhs , Strict) :: nil
-      | OpLe => (PEsub lhs rhs ,Strict) :: nil
-    end.
-
-Require Import Tauto.
-
-Definition cnf_normalise (t:Formula) : cnf (NFormula) :=
-  List.map  (fun x => x::nil) (xnormalise t).
-
-
-Add Ring SORRing : sor.(SORrt).
-
-Lemma cnf_normalise_correct : forall env t, eval_cnf (eval_nformula env) (cnf_normalise t) -> eval_formula env t.
-Proof.
-  unfold cnf_normalise, xnormalise ; simpl ; intros env t.
-  unfold eval_cnf.
-  destruct t as [lhs o rhs]; case_eq o ; simpl;    
-    generalize (eval_pexpr  env lhs);
-      generalize (eval_pexpr  env rhs) ; intros z1 z2 ; intros.
-  (**)
-  apply sor.(SORle_antisymm).
-  rewrite  (Rle_ngt sor). rewrite (Rlt_lt_minus sor). tauto.
-  rewrite  (Rle_ngt sor). rewrite (Rlt_lt_minus sor). tauto.
-  now rewrite <- (Rminus_eq_0 sor).
-  rewrite (Rle_ngt sor).  rewrite (Rlt_lt_minus sor). auto.
-  rewrite (Rle_ngt sor).  rewrite (Rlt_lt_minus sor). auto.
-  rewrite (Rlt_nge sor).  rewrite (Rle_le_minus sor). auto.
-  rewrite (Rlt_nge sor).  rewrite (Rle_le_minus sor). auto.
-Qed.
-
-Definition xnegate (t:Formula) : list (NFormula)  :=
-  let (lhs,o,rhs) := t in
-    match o with
-      | OpEq  => (PEsub lhs rhs,Equal) :: nil
-      | OpNEq => (PEsub lhs  rhs ,Strict)::(PEsub rhs lhs,Strict)::nil
-      | OpGt  => (PEsub lhs  rhs,Strict) :: nil
-      | OpLt  => (PEsub rhs lhs,Strict) :: nil
-      | OpGe  => (PEsub lhs rhs,NonStrict) :: nil
-      | OpLe  => (PEsub rhs lhs,NonStrict) :: nil
-    end.
-
-Definition cnf_negate (t:Formula) : cnf (NFormula) :=
-  List.map  (fun x => x::nil) (xnegate t).
-
-Lemma cnf_negate_correct : forall env t, eval_cnf (eval_nformula env) (cnf_negate t) -> ~ eval_formula env t.
-Proof.
-  unfold cnf_negate, xnegate ; simpl ; intros env t.
-  unfold eval_cnf.
-  destruct t as [lhs o rhs]; case_eq o ; simpl ;
-    generalize (eval_pexpr env lhs);
-    generalize (eval_pexpr env rhs) ; intros z1 z2 ; intros ; 
-    intuition.
-  (**)
-  apply H0.
-  rewrite H1 ; ring.
-  (**)
-  apply H1.
-  apply sor.(SORle_antisymm).
-  rewrite  (Rle_ngt sor). rewrite (Rlt_lt_minus sor). tauto.
-  rewrite  (Rle_ngt sor). rewrite (Rlt_lt_minus sor). tauto.
-  (**)
-  apply H0. now rewrite  (Rle_le_minus sor) in H1.
-  apply H0. now rewrite (Rle_le_minus sor) in H1.
-  apply H0. now rewrite (Rlt_lt_minus sor) in H1.
-  apply H0. now rewrite (Rlt_lt_minus sor) in H1.
-Qed.
-
-
-Lemma eval_nformula_dec : forall env d, (eval_nformula env d) \/ ~ (eval_nformula env d).
-Proof.
-  intros.
-  destruct d ; simpl.
-  generalize (eval_pexpr env p); intros.
-  destruct o ; simpl. 
-  apply (Req_em sor r 0).
-  destruct (Req_em sor r 0) ; tauto.
-  rewrite <- (Rle_ngt sor r 0). generalize (Rle_gt_cases sor r 0). tauto.
-  rewrite <- (Rlt_nge sor r 0). generalize (Rle_gt_cases sor 0 r). tauto.
-Qed.
-
-(** Some syntactic simplifications of expressions and cone elements *)
-
-
-Fixpoint simpl_expr (e:PExprC) : PExprC :=
-  match e with
-    | PEmul y z => let y' := simpl_expr y in let z' := simpl_expr z in
-      match y' , z' with
-        | PEc c , z' => if ceqb c cI then z' else PEmul y' z'
-        |     _     , _   => PEmul y' z'
-      end
-    | PEadd x  y => PEadd (simpl_expr x) (simpl_expr y)
-    |   _    => e
-  end.
-
-
-Definition simpl_cone (e:ConeMember) : ConeMember :=
-  match e with
-    | S_Square t => match simpl_expr t with
-                      | PEc c   => if ceqb cO c then S_Z else S_Pos (ctimes c c)
-                      |       x     => S_Square x
-                    end
-    | S_Mult t1 t2 => 
-      match t1 , t2 with
-        | S_Z      , x        => S_Z 
-        |    x     , S_Z      => S_Z 
-        | S_Pos c ,  S_Pos c' => S_Pos (ctimes c c')
-        | S_Pos p1 , S_Mult (S_Pos p2)  x => S_Mult (S_Pos (ctimes p1 p2)) x
-        | S_Pos p1 , S_Mult x (S_Pos p2)  => S_Mult (S_Pos (ctimes p1 p2)) x
-        | S_Mult (S_Pos p2)  x  , S_Pos p1   => S_Mult (S_Pos (ctimes p1 p2)) x
-        | S_Mult x (S_Pos p2)   , S_Pos p1   => S_Mult (S_Pos (ctimes p1 p2)) x
-        | S_Pos x   , S_Add y z   => S_Add (S_Mult (S_Pos x) y) (S_Mult (S_Pos x) z)
-        | S_Pos c ,  _        => if ceqb cI c then t2 else S_Mult t1 t2
-        | _ ,  S_Pos c        => if ceqb cI c then t1 else S_Mult t1 t2
-        |     _     , _   => e
-      end
-    | S_Add t1 t2 => 
-      match t1 ,  t2 with
-        | S_Z     , x => x
-        |   x     , S_Z => x
-        |   x     , y   => S_Add x y
-      end
-    |   _     => e
-  end.
-
-
-
-End Micromega.
-
diff --git a/contrib/micromega/Tauto.v b/contrib/micromega/Tauto.v
deleted file mode 100644
index ef48efa6..00000000
--- a/contrib/micromega/Tauto.v
+++ /dev/null
@@ -1,324 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-Require Import List.
-Require Import Refl.
-Require Import Bool.
-
-Set Implicit Arguments.
-
-
-  Inductive BFormula (A:Type) : Type :=
-  | TT   : BFormula A 
-  | FF   : BFormula A
-  | X : Prop -> BFormula A
-  | A : A -> BFormula A 
-  | Cj  : BFormula A -> BFormula A -> BFormula A
-  | D   : BFormula A-> BFormula A -> BFormula A
-  | N  : BFormula A -> BFormula A
-  | I : BFormula A-> BFormula A-> BFormula A. 
-
-  Fixpoint eval_f (A:Type)  (ev:A -> Prop ) (f:BFormula A) {struct f}: Prop :=
-    match f with
-      | TT => True
-      | FF => False
-      | A a =>  ev a
-      | X p => p
-      | Cj e1 e2 => (eval_f  ev e1) /\ (eval_f ev e2)
-      | D e1 e2  => (eval_f  ev e1) \/ (eval_f  ev e2)
-      | N e     => ~ (eval_f  ev e)
-      | I f1 f2 => (eval_f  ev f1) -> (eval_f  ev f2)
-    end.
-
-
-  Lemma map_simpl : forall A B f l, @map A B f l = match l with 
-                                                 | nil => nil
-                                                 | a :: l=> (f a) :: (@map A B f l)
-                                               end.
-  Proof.
-    destruct l ; reflexivity.
-  Qed.
-
-
-
-  Section S.
-
-    Variable Env   : Type.
-    Variable Term  : Type.
-    Variable eval  : Env -> Term -> Prop.
-    Variable Term' : Type.  
-    Variable eval'  : Env -> Term' -> Prop.
-
-
-
-    Variable no_middle_eval' : forall env d, (eval' env d) \/ ~ (eval' env d).
-
-
-    Definition clause := list  Term'.
-    Definition cnf := list clause.
-
-    Variable normalise : Term -> cnf.
-    Variable negate : Term -> cnf.
-
-
-    Definition tt : cnf := @nil clause.
-    Definition ff : cnf :=  cons (@nil Term') nil.
-
-
-    Definition or_clause_cnf (t:clause) (f:cnf) : cnf :=
-      List.map (fun x => (t++x)) f.
-    
-    Fixpoint or_cnf (f : cnf) (f' : cnf) {struct f}: cnf :=
-      match f with
-        | nil => tt
-        | e :: rst => (or_cnf rst f') ++ (or_clause_cnf e f')
-      end.
-    
-
-    Definition and_cnf (f1 : cnf) (f2 : cnf) : cnf :=
-      f1 ++ f2.
-    
-    Fixpoint xcnf (pol : bool) (f : BFormula Term)  {struct f}: cnf :=
-      match f with
-        | TT => if pol then tt else ff
-        | FF => if pol then ff else tt
-        | X p => if pol then ff else ff (* This is not complete - cannot negate any proposition *)
-        | A x => if pol then normalise x else negate x
-        | N e  => xcnf (negb pol) e
-        | Cj e1 e2 => 
-          (if pol then and_cnf else or_cnf) (xcnf pol e1) (xcnf pol e2)
-        | D e1 e2  => (if pol then or_cnf else and_cnf) (xcnf pol e1) (xcnf pol e2)
-        | I e1 e2 => (if pol then or_cnf else and_cnf) (xcnf (negb pol) e1) (xcnf pol e2)
-      end.
-
-  Definition eval_cnf (env : Term' -> Prop) (f:cnf) := make_conj  (fun cl => ~ make_conj  env cl) f.
-  
-
-  Lemma eval_cnf_app : forall env x y, eval_cnf (eval' env) (x++y) -> eval_cnf (eval' env) x /\ eval_cnf (eval' env) y.
-  Proof.
-    unfold eval_cnf.
-    intros.
-    rewrite make_conj_app in H ; auto.
-  Qed.
-    
-
-  Lemma or_clause_correct : forall env t f, eval_cnf (eval' env) (or_clause_cnf t f) -> (~ make_conj  (eval' env) t) \/ (eval_cnf (eval' env) f).
-  Proof.
-    unfold eval_cnf.
-    unfold or_clause_cnf.
-    induction f.
-    simpl.
-    intros ; right;auto.
-    (**)
-    rewrite map_simpl.
-    intros.
-    rewrite make_conj_cons in H.
-    destruct H as [HH1 HH2].
-    generalize (IHf HH2) ; clear IHf ; intro.
-    destruct H.
-    left ; auto.
-    rewrite make_conj_cons.
-    destruct (not_make_conj_app _ _ _ (no_middle_eval' env) HH1).
-    tauto.
-    tauto.
-  Qed.
-
- Lemma eval_cnf_cons : forall env a f,  (~ make_conj  (eval' env) a) -> eval_cnf (eval' env) f -> eval_cnf (eval' env) (a::f).
- Proof.
-   intros.
-   unfold eval_cnf in *.
-   rewrite make_conj_cons ; eauto.
- Qed.
-
-  Lemma or_cnf_correct : forall env f f', eval_cnf (eval' env) (or_cnf f f') -> (eval_cnf (eval' env)  f) \/ (eval_cnf (eval' env) f').
-  Proof.
-    induction f.
-    unfold eval_cnf.
-    simpl.
-    tauto.
-    (**)
-    intros.
-    simpl in H.
-    destruct (eval_cnf_app _ _ _ H).
-    clear H.
-    destruct (IHf _ H0).
-    destruct (or_clause_correct _ _ _ H1).
-    left.
-    apply eval_cnf_cons ; auto.
-    right ; auto.
-    right ; auto.
-  Qed.
-
-  Variable normalise_correct : forall env t, eval_cnf (eval' env) (normalise t) -> eval env t.
-
-  Variable negate_correct : forall env t, eval_cnf  (eval' env) (negate t) -> ~ eval env t.
-
-
-  Lemma xcnf_correct : forall f pol env, eval_cnf (eval' env) (xcnf pol f) -> eval_f (eval env) (if pol then f else N f).
-  Proof.
-    induction f.
-    (* TT *)
-    unfold eval_cnf.
-    simpl.
-    destruct pol ; simpl ; auto.
-    (* FF *)
-    unfold eval_cnf.
-    destruct pol; simpl ; auto.
-    (* P *)
-    simpl.
-    destruct pol ; intros ;simpl.
-    unfold eval_cnf in H.
-    (* Here I have to drop the proposition *)
-    simpl in H.
-    tauto.
-    (* Here, I could store P in the clause *)
-    unfold eval_cnf in H;simpl in H.
-    tauto.
-    (* A *)
-    simpl.
-    destruct pol ; simpl.
-    intros.
-    apply normalise_correct  ; auto.
-    (* A 2 *)
-    intros.
-    apply  negate_correct ; auto.
-    auto.
-    (* Cj *)
-    destruct pol ; simpl.
-    (* pol = true *)
-    intros.
-    unfold and_cnf in H.
-    destruct (eval_cnf_app  _ _ _ H).
-    clear H.
-    split.
-    apply (IHf1 _ _ H0).
-    apply (IHf2 _ _ H1).
-    (* pol = false *)
-    intros.
-    destruct (or_cnf_correct _ _ _ H).
-    generalize (IHf1 false  env H0).
-    simpl.
-    tauto.
-    generalize (IHf2 false  env H0).
-    simpl.
-    tauto.
-    (* D *)
-    simpl.
-    destruct pol.
-    (* pol = true *)
-    intros.
-    destruct (or_cnf_correct _ _ _ H).
-    generalize (IHf1 _  env H0).
-    simpl.
-    tauto.
-    generalize (IHf2 _  env H0).
-    simpl.
-    tauto.
-    (* pol = true *)
-    unfold and_cnf.
-    intros.
-    destruct (eval_cnf_app  _ _ _ H).
-    clear H.
-    simpl.
-    generalize (IHf1 _ _ H0).
-    generalize (IHf2 _ _ H1).
-    simpl.
-    tauto.
-    (**)
-    simpl.
-    destruct pol ; simpl.
-    intros.
-    apply (IHf false) ; auto.
-    intros.
-    generalize (IHf _ _ H).
-    tauto.
-    (* I *)
-    simpl; intros.
-    destruct pol.
-    simpl.
-    intro.
-    destruct (or_cnf_correct _ _ _ H).
-    generalize (IHf1 _ _ H1).
-    simpl in *.
-    tauto.
-    generalize (IHf2 _ _ H1).
-    auto.
-    (* pol = false *)
-    unfold and_cnf in H.
-    simpl in H.
-    destruct (eval_cnf_app _ _ _ H).
-    generalize (IHf1 _ _ H0).    
-    generalize (IHf2 _ _ H1).    
-    simpl.
-    tauto.
-  Qed.
-
-
-  Variable Witness : Type.
-  Variable checker : list Term' -> Witness -> bool.
-  
-  Variable checker_sound : forall t  w, checker t w = true -> forall env, make_impl (eval' env)  t False.
-
-  Fixpoint cnf_checker (f : cnf) (l : list Witness)  {struct f}: bool :=
-    match f with
-      | nil => true
-      | e::f => match l with 
-                  | nil => false
-                  | c::l => match checker e c with
-                              | true => cnf_checker f l
-                              |   _  => false
-                            end
-                end
-      end.
-
-  Lemma cnf_checker_sound : forall t  w, cnf_checker t w = true -> forall env, eval_cnf  (eval' env)  t.
-  Proof.
-    unfold eval_cnf.
-    induction t.
-    (* bc *)
-    simpl.
-    auto.
-    (* ic *)
-    simpl.
-    destruct w.
-    intros ; discriminate.
-    case_eq (checker a w) ; intros ; try discriminate.
-    generalize (@checker_sound _ _ H env).
-    generalize (IHt _ H0 env) ; intros.
-    destruct t.
-    red ; intro.
-    rewrite <- make_conj_impl in H2.
-    tauto.
-    rewrite <- make_conj_impl in H2.
-    tauto.
-  Qed.
-
-
-  Definition tauto_checker (f:BFormula Term) (w:list Witness) : bool :=
-    cnf_checker (xcnf true f) w.
-
-  Lemma tauto_checker_sound : forall t  w, tauto_checker t w = true -> forall env, eval_f  (eval env)  t.
-  Proof.
-    unfold tauto_checker.
-    intros.
-    change (eval_f (eval env) t) with (eval_f (eval env) (if true then t else TT Term)).
-    apply (xcnf_correct t true).
-    eapply cnf_checker_sound ; eauto.
-  Qed.
-
-
-
-
-End S.
-
diff --git a/contrib/micromega/VarMap.v b/contrib/micromega/VarMap.v
deleted file mode 100644
index 240c0fb7..00000000
--- a/contrib/micromega/VarMap.v
+++ /dev/null
@@ -1,258 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-Require Import ZArith.
-Require Import Coq.Arith.Max.
-Require Import List.
-Set Implicit Arguments.
-
-(* I have addded a Leaf constructor to the varmap data structure (/contrib/ring/Quote.v) 
-   -- this is harmless and spares a lot of Empty.
-   This means smaller proof-terms. 
-   BTW, by dropping the  polymorphism, I get small (yet noticeable) speed-up.
-*)
-
-Section MakeVarMap.
-  Variable A : Type.
-  Variable default : A.
-  
-  Inductive t  : Type :=
-  | Empty : t 
-  | Leaf : A -> t 
-  | Node : t  -> A -> t  -> t .
-  
-  Fixpoint find   (vm : t ) (p:positive) {struct vm} : A :=
-    match vm with
-      | Empty => default
-      | Leaf i => i
-      | Node l e r => match p with
-                        | xH => e
-                        | xO p => find l p
-                        | xI p => find r p
-                      end
-    end.
-
- (* an off_map (a map with offset) offers the same functionalites  as /contrib/setoid_ring/BinList.v - it is used in EnvRing.v *)
-(*
-  Definition off_map  :=  (option positive *t )%type.
-
-
-
-  Definition jump  (j:positive) (l:off_map ) := 
-    let (o,m) := l in
-      match o with
-        | None => (Some j,m)
-        | Some j0 => (Some (j+j0)%positive,m)
-      end.
-
-  Definition nth  (n:positive) (l: off_map ) :=
-    let (o,m) := l in
-      let idx  := match o with
-                    | None => n
-                    | Some i => i + n
-                  end%positive in
-      find  idx m.
-
-
-  Definition hd  (l:off_map) := nth  xH l.
-
-
-  Definition tail (l:off_map ) := jump xH l.
-
-
-  Lemma psucc : forall p,  (match p with
-                              | xI y' => xO (Psucc y')
-                              | xO y' => xI y'
-                              | 1%positive => 2%positive 
-                            end) = (p+1)%positive.
-  Proof.
-    destruct p.
-    auto with zarith.
-    rewrite xI_succ_xO.
-    auto with zarith.
-    reflexivity.
-  Qed.
-
-  Lemma jump_Pplus : forall i j l, 
-    (jump (i + j) l) = (jump i (jump j l)).
-  Proof.
-    unfold jump.
-    destruct l.
-    destruct o.
-    rewrite Pplus_assoc.
-    reflexivity.
-    reflexivity.
-  Qed.
-
-  Lemma jump_simpl : forall p l,
-    jump p l = 
-    match p with
-      | xH => tail l
-      | xO p => jump p (jump p l)
-      | xI p  => jump p (jump p (tail l))
-    end.
-  Proof.
-    destruct p ; unfold tail ; intros ;  repeat rewrite <- jump_Pplus.
-    (* xI p = p + p + 1 *)
-    rewrite xI_succ_xO.
-    rewrite Pplus_diag.
-    rewrite <- Pplus_one_succ_r.
-    reflexivity.
-    (* xO p = p + p *)
-    rewrite Pplus_diag.
-    reflexivity.
-    reflexivity.
-  Qed.
-
-  Ltac jump_s :=
-    repeat 
-      match goal with
-        | |- context [jump xH ?e] => rewrite (jump_simpl xH)
-        | |- context [jump (xO ?p) ?e] => rewrite (jump_simpl (xO p))
-        | |- context [jump (xI ?p) ?e] => rewrite (jump_simpl (xI p))
-      end.
-    
-  Lemma jump_tl : forall j l, tail (jump j l) = jump j (tail l).
-  Proof. 
-    unfold tail.
-    intros.
-    repeat rewrite <- jump_Pplus.
-    rewrite Pplus_comm.
-    reflexivity.
-  Qed.
-
-  Lemma jump_Psucc : forall j l, 
-    (jump (Psucc j) l) = (jump 1 (jump j l)).
-  Proof.
-    intros.
-    rewrite <- jump_Pplus.
-    rewrite Pplus_one_succ_r.
-    rewrite Pplus_comm.
-    reflexivity.
-  Qed.
-
-  Lemma jump_Pdouble_minus_one : forall i l,
-    (jump (Pdouble_minus_one i) (tail l)) = (jump i (jump i l)).
-  Proof.
-    unfold tail.
-    intros.
-    repeat rewrite <- jump_Pplus.
-    rewrite <- Pplus_one_succ_r.
-    rewrite Psucc_o_double_minus_one_eq_xO.
-    rewrite Pplus_diag.
-    reflexivity.
-  Qed.
-
-  Lemma jump_x0_tail : forall p l, jump (xO p) (tail l) = jump (xI p) l.
-  Proof.
-    intros.
-    jump_s.
-    repeat rewrite <- jump_Pplus.
-    reflexivity.
-  Qed.
-
-  
-  Lemma nth_spec : forall p l, 
-    nth p l = 
-    match p with
-      | xH => hd  l
-      | xO p => nth p (jump p l)
-      | xI p => nth p (jump p (tail l))
-    end. 
-  Proof.
-    unfold nth.
-    destruct l.
-    destruct o.
-    simpl.
-    rewrite psucc.
-    destruct p.
-    replace (p0 + xI p)%positive with ((p + (p0 + 1) + p))%positive.
-    reflexivity.
-    rewrite xI_succ_xO.
-    rewrite Pplus_one_succ_r.
-    rewrite <- Pplus_diag.
-    rewrite Pplus_comm.
-    symmetry.
-    rewrite (Pplus_comm p0).
-    rewrite <- Pplus_assoc.
-    rewrite (Pplus_comm 1)%positive.
-    rewrite <- Pplus_assoc.
-    reflexivity.
-  (**)
-    replace ((p0 + xO p))%positive with (p + p0 + p)%positive.
-    reflexivity.
-    rewrite <- Pplus_diag.
-    rewrite <- Pplus_assoc.
-    rewrite Pplus_comm.
-    rewrite Pplus_assoc.
-    reflexivity.
-    reflexivity.
-    simpl.
-    destruct p.
-    rewrite xI_succ_xO.
-    rewrite Pplus_one_succ_r.
-    rewrite <- Pplus_diag.
-    symmetry.
-    rewrite Pplus_comm.
-    rewrite Pplus_assoc.
-    reflexivity.
-    rewrite Pplus_diag.
-    reflexivity.
-    reflexivity.
-  Qed.
-
-
-  Lemma nth_jump : forall p l, nth p (tail l) = hd (jump p l).
-  Proof.
-    destruct l.
-    unfold tail.
-    unfold hd.
-    unfold jump.
-    unfold nth.
-    destruct o.
-    symmetry.
-    rewrite Pplus_comm.
-    rewrite <- Pplus_assoc.
-    rewrite (Pplus_comm p0).
-    reflexivity.
-    rewrite Pplus_comm.
-    reflexivity.
-  Qed.
-
-  Lemma nth_Pdouble_minus_one :
-    forall p l, nth (Pdouble_minus_one p) (tail l) = nth p (jump p l).
-  Proof.
-    destruct l.
-    unfold tail.
-    unfold nth, jump.
-    destruct o.
-    rewrite ((Pplus_comm p)).
-    rewrite <- (Pplus_assoc p0).
-    rewrite Pplus_diag.
-    rewrite <- Psucc_o_double_minus_one_eq_xO.
-    rewrite Pplus_one_succ_r.
-    rewrite (Pplus_comm (Pdouble_minus_one p)).
-    rewrite Pplus_assoc.
-    rewrite (Pplus_comm p0).
-    reflexivity.
-    rewrite <- Pplus_one_succ_l.
-    rewrite Psucc_o_double_minus_one_eq_xO.
-    rewrite Pplus_diag.
-    reflexivity.
-  Qed.
-
-*)
-
-End MakeVarMap.
-
diff --git a/contrib/micromega/ZCoeff.v b/contrib/micromega/ZCoeff.v
deleted file mode 100644
index ced67e39..00000000
--- a/contrib/micromega/ZCoeff.v
+++ /dev/null
@@ -1,173 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                      Evgeny Makarov, INRIA, 2007                     *)
-(************************************************************************)
-
-Require Import OrderedRing.
-Require Import RingMicromega.
-Require Import ZArith.
-Require Import InitialRing.
-Require Import Setoid.
-
-Import OrderedRingSyntax.
-
-Set Implicit Arguments.
-
-Section InitialMorphism.
-
-Variable R : Type.
-Variables rO rI : R.
-Variables rplus rtimes rminus: R -> R -> R.
-Variable ropp : R -> R.
-Variables req rle rlt : R -> R -> Prop.
-
-Variable sor : SOR rO rI rplus rtimes rminus ropp req rle rlt.
-
-Notation "0" := rO.
-Notation "1" := rI.
-Notation "x + y" := (rplus x y).
-Notation "x * y " := (rtimes x y).
-Notation "x - y " := (rminus x y).
-Notation "- x" := (ropp x).
-Notation "x == y" := (req x y).
-Notation "x ~= y" := (~ req x y).
-Notation "x <= y" := (rle x y).
-Notation "x < y" := (rlt x y).
-
-Lemma req_refl : forall x, req x x.
-Proof.
-  destruct sor.(SORsetoid).
-  apply Equivalence_Reflexive.
-Qed.
-
-Lemma req_sym : forall x y, req x y -> req y x.
-Proof.
-  destruct sor.(SORsetoid).
-  apply Equivalence_Symmetric.
-Qed.
-
-Lemma req_trans : forall x y z, req x y -> req y z -> req x z.
-Proof.
-  destruct sor.(SORsetoid).
-  apply Equivalence_Transitive.
-Qed.
-  
-
-Add Relation R req
-  reflexivity proved by sor.(SORsetoid).(@Equivalence_Reflexive _ _)
-  symmetry proved by sor.(SORsetoid).(@Equivalence_Symmetric _ _)
-  transitivity proved by sor.(SORsetoid).(@Equivalence_Transitive _ _)
-as sor_setoid.
-
-Add Morphism rplus with signature req ==> req ==> req as rplus_morph.
-Proof.
-exact sor.(SORplus_wd).
-Qed.
-Add Morphism rtimes with signature req ==> req ==> req as rtimes_morph.
-Proof.
-exact sor.(SORtimes_wd).
-Qed.
-Add Morphism ropp with signature req ==> req as ropp_morph.
-Proof.
-exact sor.(SORopp_wd).
-Qed.
-Add Morphism rle with signature req ==> req ==> iff as rle_morph.
-Proof.
-exact sor.(SORle_wd).
-Qed.
-Add Morphism rlt with signature req ==> req ==> iff as rlt_morph.
-Proof.
-exact sor.(SORlt_wd).
-Qed.
-Add Morphism rminus with signature req ==> req ==> req as rminus_morph.
-Proof.
-  exact (rminus_morph sor).
-Qed.
-
-Ltac le_less := rewrite (Rle_lt_eq sor); left; try assumption.
-Ltac le_equal := rewrite (Rle_lt_eq sor); right; try reflexivity; try assumption.
-
-Definition gen_order_phi_Z : Z -> R := gen_phiZ 0 1 rplus rtimes ropp.
-
-Notation phi_pos := (gen_phiPOS 1 rplus rtimes).
-Notation phi_pos1 := (gen_phiPOS1 1 rplus rtimes).
-
-Notation "[ x ]" := (gen_order_phi_Z x).
-
-Lemma ring_ops_wd : ring_eq_ext rplus rtimes ropp req.
-Proof.
-constructor.
-exact rplus_morph.
-exact rtimes_morph.
-exact ropp_morph.
-Qed.
-
-Lemma Zring_morph :
-  ring_morph 0 1 rplus rtimes rminus ropp req
-             0%Z 1%Z Zplus Zmult Zminus Zopp
-             Zeq_bool gen_order_phi_Z.
-Proof.
-exact (gen_phiZ_morph sor.(SORsetoid) ring_ops_wd sor.(SORrt)).
-Qed.
-
-Lemma phi_pos1_pos : forall x : positive, 0 < phi_pos1 x.
-Proof.
-induction x as [x IH | x IH |]; simpl;
-try apply (Rplus_pos_pos sor); try apply (Rtimes_pos_pos sor); try apply (Rplus_pos_pos sor);
-try apply (Rlt_0_1 sor); assumption.
-Qed.
-
-Lemma phi_pos1_succ : forall x : positive, phi_pos1 (Psucc x) == 1 + phi_pos1 x.
-Proof.
-exact (ARgen_phiPOS_Psucc sor.(SORsetoid) ring_ops_wd
-        (Rth_ARth sor.(SORsetoid) ring_ops_wd sor.(SORrt))).
-Qed.
-
-Lemma clt_pos_morph : forall x y : positive, (x < y)%positive -> phi_pos1 x < phi_pos1 y.
-Proof.
-intros x y H. pattern y; apply Plt_ind with x.
-rewrite phi_pos1_succ; apply (Rlt_succ_r sor).
-clear y H; intros y _ H. rewrite phi_pos1_succ. now apply (Rlt_lt_succ sor).
-assumption.
-Qed.
-
-Lemma clt_morph : forall x y : Z, (x < y)%Z -> [x] < [y].
-Proof.
-unfold Zlt; intros x y H;
-do 2 rewrite (same_genZ sor.(SORsetoid) ring_ops_wd sor.(SORrt));
-destruct x; destruct y; simpl in *; try discriminate.
-apply phi_pos1_pos.
-now apply clt_pos_morph.
-apply <- (Ropp_neg_pos sor); apply phi_pos1_pos.
-apply (Rlt_trans sor) with 0. apply <- (Ropp_neg_pos sor); apply phi_pos1_pos.
-apply phi_pos1_pos.
-rewrite Pcompare_antisym in H; simpl in H. apply -> (Ropp_lt_mono sor).
-now apply clt_pos_morph.
-Qed.
-
-Lemma Zcleb_morph : forall x y : Z, Zle_bool x y = true -> [x] <= [y].
-Proof.
-unfold Zle_bool; intros x y H.
-case_eq (x ?= y)%Z; intro H1; rewrite H1 in H.
-le_equal. apply Zring_morph.(morph_eq). unfold Zeq_bool; now rewrite H1.
-le_less. now apply clt_morph.
-discriminate.
-Qed.
-
-Lemma Zcneqb_morph : forall x y : Z, Zeq_bool x y = false -> [x] ~= [y].
-Proof.
-intros x y H. unfold Zeq_bool in H.
-case_eq (Zcompare x y); intro H1; rewrite H1 in *; (discriminate || clear H).
-apply (Rlt_neq sor). now apply clt_morph.
-fold (x > y)%Z in H1. rewrite Zgt_iff_lt in H1.
-apply (Rneq_symm sor). apply (Rlt_neq sor). now apply clt_morph.
-Qed.
-
-End InitialMorphism.
-
-
diff --git a/contrib/micromega/ZMicromega.v b/contrib/micromega/ZMicromega.v
deleted file mode 100644
index 0855925a..00000000
--- a/contrib/micromega/ZMicromega.v
+++ /dev/null
@@ -1,705 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-Require Import OrderedRing.
-Require Import RingMicromega.
-Require Import ZCoeff.
-Require Import Refl.
-Require Import ZArith.
-Require Import List.
-Require Import Bool.
-
-Ltac flatten_bool :=
-  repeat match goal with
-           [ id : (_ && _)%bool = true |- _ ] =>  destruct (andb_prop _ _ id); clear id
-           |  [ id : (_ || _)%bool = true |- _ ] =>  destruct (orb_prop _ _ id); clear id
-         end.
-
-Require Import EnvRing.
-
-Open Scope Z_scope.
-  
-Lemma Zsor : SOR 0 1 Zplus Zmult Zminus Zopp (@eq Z) Zle Zlt.
-Proof.
-  constructor ; intros ; subst ; try (intuition (auto  with zarith)).
-  apply Zsth.
-  apply Zth.
-  destruct (Ztrichotomy n m) ; intuition (auto with zarith).
-  apply Zmult_lt_0_compat ; auto.
-Qed.
-
-Lemma ZSORaddon :
-  SORaddon 0 1 Zplus Zmult Zminus Zopp  (@eq Z) Zle (* ring elements *)
-  0%Z 1%Z Zplus Zmult Zminus Zopp (* coefficients *)
-  Zeq_bool Zle_bool
-  (fun x => x) (fun x => x) (pow_N 1 Zmult).
-Proof.
-  constructor.
-  constructor ; intros ; try reflexivity.
-  apply Zeq_bool_eq ; auto.
-  constructor.
-  reflexivity.
-  intros x y.
-  apply Zeq_bool_neq ; auto.
-  apply Zle_bool_imp_le.
-Qed.
-
-
-(*Definition Zeval_expr :=  eval_pexpr 0 Zplus Zmult Zminus Zopp  (fun x => x) (fun x => Z_of_N x) (Zpower).*)
-
-Fixpoint Zeval_expr (env: PolEnv Z) (e: PExpr Z) : Z :=
-  match e with
-    | PEc c =>  c
-    | PEX j =>  env j
-    | PEadd pe1 pe2 => (Zeval_expr env pe1) + (Zeval_expr env pe2)
-    | PEsub pe1 pe2 => (Zeval_expr env pe1) - (Zeval_expr env pe2)
-    | PEmul pe1 pe2 => (Zeval_expr env pe1) * (Zeval_expr env pe2)
-    | PEopp pe1 => - (Zeval_expr env pe1)
-    | PEpow pe1 n => Zpower (Zeval_expr env pe1)  (Z_of_N n)
-  end.
-
-Lemma Zeval_expr_simpl : forall env e,
-  Zeval_expr env e = 
-  match e with
-    | PEc c =>  c
-    | PEX j =>  env j
-    | PEadd pe1 pe2 => (Zeval_expr env pe1) + (Zeval_expr env pe2)
-    | PEsub pe1 pe2 => (Zeval_expr env pe1) - (Zeval_expr env pe2)
-    | PEmul pe1 pe2 => (Zeval_expr env pe1) * (Zeval_expr env pe2)
-    | PEopp pe1 => - (Zeval_expr env pe1)
-    | PEpow pe1 n => Zpower (Zeval_expr env pe1)  (Z_of_N n)
-  end.
-Proof.
-  destruct e ; reflexivity.
-Qed.
-
-
-Definition Zeval_expr' := eval_pexpr  Zplus Zmult Zminus Zopp (fun x => x) (fun x => x) (pow_N 1 Zmult).
-
-Lemma ZNpower : forall r n, r ^ Z_of_N n = pow_N 1 Zmult r n.
-Proof.
-  destruct n.
-  reflexivity.
-  simpl.
-  unfold Zpower_pos.
-  replace (pow_pos Zmult r p) with (1 * (pow_pos Zmult r p)) by ring.
-  generalize 1.
-  induction p; simpl ; intros ; repeat rewrite IHp ; ring.
-Qed.
-
-
-
-Lemma Zeval_expr_compat : forall env e, Zeval_expr env e = Zeval_expr' env e.
-Proof.
-  induction e ; simpl ; subst ; try congruence.
-  rewrite IHe.
-  apply ZNpower.
-Qed.
-
-Definition Zeval_op2 (o : Op2) : Z -> Z -> Prop :=
-match o with
-| OpEq =>  @eq Z
-| OpNEq => fun x y  => ~ x = y
-| OpLe => Zle
-| OpGe => Zge
-| OpLt => Zlt
-| OpGt => Zgt
-end.
-
-Definition Zeval_formula (e: PolEnv Z) (ff : Formula Z) :=
-  let (lhs,o,rhs) := ff in Zeval_op2 o (Zeval_expr e lhs) (Zeval_expr e rhs).
-
-Definition Zeval_formula' :=
-  eval_formula  Zplus Zmult Zminus Zopp (@eq Z) Zle Zlt (fun x => x) (fun x => x) (pow_N 1 Zmult).
-
-Lemma Zeval_formula_compat : forall env f, Zeval_formula env f <-> Zeval_formula' env f.
-Proof.
-  intros.
-  unfold Zeval_formula.
-  destruct f.
-  repeat rewrite Zeval_expr_compat.
-  unfold Zeval_formula'.
-  unfold Zeval_expr'.
-  split ; destruct Fop ; simpl; auto with zarith.
-Qed.
-
-
-
-Definition Zeval_nformula :=
-  eval_nformula 0 Zplus Zmult Zminus Zopp (@eq Z) Zle Zlt (fun x => x) (fun x => x) (pow_N 1 Zmult).
-
-Definition Zeval_op1 (o : Op1) : Z -> Prop :=
-match o with
-| Equal => fun x : Z => x = 0
-| NonEqual => fun x : Z => x <> 0
-| Strict => fun x : Z => 0 < x
-| NonStrict => fun x : Z => 0 <= x
-end.
-
-Lemma Zeval_nformula_simpl : forall env f, Zeval_nformula env f = (let (p, op) := f in Zeval_op1 op (Zeval_expr env p)).
-Proof.
-  intros.
-  destruct f.
-  rewrite Zeval_expr_compat.
-  reflexivity.
-Qed.
-  
-Lemma Zeval_nformula_dec : forall env d, (Zeval_nformula env d) \/ ~ (Zeval_nformula env d).
-Proof.
-  exact (fun env d =>eval_nformula_dec Zsor (fun x => x) (fun x => x) (pow_N 1%Z Zmult) env d).
-Qed.
-
-Definition ZWitness := ConeMember Z.
-
-Definition ZWeakChecker := check_normalised_formulas 0 1 Zplus Zmult Zminus Zopp Zeq_bool Zle_bool.
-
-Lemma ZWeakChecker_sound :   forall (l : list (NFormula Z)) (cm : ZWitness),
-  ZWeakChecker l cm = true ->
-  forall env, make_impl (Zeval_nformula env) l False.
-Proof.
-  intros l cm H.
-  intro.
-  unfold Zeval_nformula.
-  apply (checker_nf_sound Zsor ZSORaddon l cm).
-  unfold ZWeakChecker in H.
-  exact H.
-Qed.
-
-Definition xnormalise (t:Formula Z) : list (NFormula Z)  :=
-  let (lhs,o,rhs) := t in
-    match o with
-      | OpEq => 
-        ((PEsub lhs (PEadd rhs (PEc 1))),NonStrict)::((PEsub rhs (PEadd lhs (PEc 1))),NonStrict)::nil
-      | OpNEq => (PEsub lhs rhs,Equal) :: nil
-      | OpGt   => (PEsub rhs lhs,NonStrict) :: nil
-      | OpLt => (PEsub lhs rhs,NonStrict) :: nil
-      | OpGe => (PEsub rhs (PEadd lhs (PEc 1)),NonStrict) :: nil
-      | OpLe => (PEsub lhs (PEadd rhs (PEc 1)),NonStrict) :: nil
-    end.
-
-Require Import Tauto.
-
-Definition normalise (t:Formula Z) : cnf (NFormula Z) :=
-  List.map  (fun x => x::nil) (xnormalise t).
-
-
-Lemma normalise_correct : forall env t, eval_cnf (Zeval_nformula env) (normalise t) <-> Zeval_formula env t.
-Proof.
-  unfold normalise, xnormalise ; simpl ; intros env t.
-  rewrite Zeval_formula_compat.
-  unfold eval_cnf.
-  destruct t as [lhs o rhs]; case_eq o ; simpl;
-    generalize (   eval_pexpr  Zplus Zmult Zminus Zopp (fun x : Z => x)
-      (fun x : BinNat.N => x) (pow_N 1 Zmult) env lhs);
-    generalize (eval_pexpr  Zplus Zmult Zminus Zopp (fun x : Z => x)
-      (fun x : BinNat.N => x) (pow_N 1 Zmult) env rhs) ; intros z1 z2 ; intros ; subst;
-    intuition (auto with zarith).
-Qed.
-  
-Definition xnegate (t:RingMicromega.Formula Z) : list (NFormula Z)  :=
-  let (lhs,o,rhs) := t in
-    match o with
-      | OpEq  => (PEsub lhs rhs,Equal) :: nil
-      | OpNEq => ((PEsub lhs (PEadd rhs (PEc 1))),NonStrict)::((PEsub rhs (PEadd lhs (PEc 1))),NonStrict)::nil
-      | OpGt  => (PEsub lhs (PEadd rhs (PEc 1)),NonStrict) :: nil
-      | OpLt  => (PEsub rhs (PEadd lhs (PEc 1)),NonStrict) :: nil
-      | OpGe  => (PEsub lhs rhs,NonStrict) :: nil
-      | OpLe  => (PEsub rhs lhs,NonStrict) :: nil
-    end.
-
-Definition negate (t:RingMicromega.Formula Z) : cnf (NFormula Z) :=
-  List.map  (fun x => x::nil) (xnegate t).
-
-Lemma negate_correct : forall env t, eval_cnf (Zeval_nformula env) (negate t) <-> ~ Zeval_formula env t.
-Proof.
-  unfold negate, xnegate ; simpl ; intros env t.
-  rewrite Zeval_formula_compat.
-  unfold eval_cnf.
-  destruct t as [lhs o rhs]; case_eq o ; simpl ;
-    generalize (   eval_pexpr  Zplus Zmult Zminus Zopp (fun x : Z => x)
-      (fun x : BinNat.N => x) (pow_N 1 Zmult) env lhs);
-    generalize (eval_pexpr  Zplus Zmult Zminus Zopp (fun x : Z => x)
-      (fun x : BinNat.N => x) (pow_N 1 Zmult) env rhs) ; intros z1 z2 ; intros ; 
-    intuition (auto with zarith).
-Qed.
-
-
-Definition ZweakTautoChecker (w: list ZWitness) (f : BFormula (Formula Z)) : bool :=
-  @tauto_checker (Formula Z) (NFormula Z) normalise negate  ZWitness ZWeakChecker f w.
-
-(* To get a complete checker, the proof format has to be enriched *)
-
-Require Import Zdiv.
-Open Scope Z_scope.
-
-Definition ceiling (a b:Z) : Z :=
-  let (q,r) := Zdiv_eucl a b in
-    match r with
-      | Z0 => q
-      | _  => q + 1
-    end.
-
-Lemma narrow_interval_lower_bound : forall a b x, a > 0 -> a * x  >= b -> x >= ceiling b a.
-Proof.
-  unfold ceiling.
-  intros.
-  generalize (Z_div_mod b a H).
-  destruct (Zdiv_eucl b a).
-  intros.
-  destruct H1.
-  destruct H2.
-  subst.
-  destruct (Ztrichotomy z0 0) as [ HH1 | [HH2 | HH3]]; destruct z0 ; try auto with zarith ; try discriminate.
-  assert (HH :x >= z \/ x < z) by (destruct (Ztrichotomy x z) ; auto with zarith).
-  destruct HH ;auto.
-  generalize (Zmult_lt_compat_l _ _ _ H3 H1).
-  auto with zarith.
-  clear H2.
-  assert (HH :x >= z +1 \/ x <= z) by (destruct (Ztrichotomy x z) ; intuition (auto with zarith)).
-  destruct HH ;auto.
-  assert (0 < a) by auto with zarith.
-  generalize (Zmult_lt_0_le_compat_r _ _ _ H2 H1).
-  intros.
-  rewrite Zmult_comm  in H4.
-  rewrite (Zmult_comm z)  in H4.
-  auto with zarith.
-Qed.
-
-Lemma narrow_interval_upper_bound : forall a b x, a > 0 -> a * x  <= b -> x <= Zdiv b a.
-Proof.
-  unfold Zdiv.
-  intros.
-  generalize (Z_div_mod b a H).
-  destruct (Zdiv_eucl b a).
-  intros.
-  destruct H1.
-  destruct H2.
-  subst.
-  assert (HH :x <= z \/ z <= x -1) by (destruct (Ztrichotomy x z) ; intuition (auto with zarith)).
-  destruct HH ;auto.
-  assert (0 < a) by auto with zarith.
-  generalize (Zmult_lt_0_le_compat_r _ _ _ H4 H1).
-  intros.
-  ring_simplify in H5.
-  rewrite Zmult_comm in H5.
-  auto with zarith.
-Qed.
-
-
-(* In this case, a certificate is made of a pair of inequations, in 1 variable,
-   that do not have an integer solution.
-   => modify the fourier elimination
-   *)
-Require Import QArith.
-
-
-Inductive ProofTerm : Type :=
-| RatProof : ZWitness -> ProofTerm
-| CutProof : PExprC Z -> Q -> ZWitness -> ProofTerm -> ProofTerm
-| EnumProof : Q ->  PExprC Z ->  Q -> ZWitness -> ZWitness -> list ProofTerm -> ProofTerm.
-
-(* n/d <= x  -> d*x - n >= 0 *)
-
-Definition makeLb (v:PExpr Z) (q:Q) : NFormula Z :=
-  let (n,d) := q in (PEsub (PEmul (PEc (Zpos d)) v) (PEc  n),NonStrict).
-
-(* x <= n/d  -> d * x <= d  *)
-Definition makeUb (v:PExpr Z) (q:Q) : NFormula Z :=
-  let (n,d) := q in
-    (PEsub (PEc n) (PEmul (PEc (Zpos d)) v), NonStrict).
-
-Definition qceiling (q:Q) : Z :=
-  let (n,d) := q in ceiling n (Zpos d).
-
-Definition qfloor (q:Q) : Z :=
-  let (n,d) := q in Zdiv n (Zpos d).
-
-Definition makeLbCut (v:PExprC Z) (q:Q) : NFormula Z :=
-  (PEsub v  (PEc (qceiling  q)), NonStrict).
-
-Definition neg_nformula (f : NFormula Z) :=
-  let (e,o) := f in
-    (PEopp (PEadd e (PEc 1%Z)), o).
-    
-Lemma neg_nformula_sound : forall env f, snd f = NonStrict ->( ~ (Zeval_nformula env (neg_nformula f)) <-> Zeval_nformula env f).
-Proof.
-  unfold neg_nformula.
-  destruct f. 
-  simpl.
-  intros ; subst ; simpl in *.
-  split;  auto with zarith.
-Qed.
- 
-
-Definition cutChecker (l:list (NFormula Z)) (e: PExpr Z) (lb:Q) (pf : ZWitness) : option (NFormula Z) :=
-    let (lb,lc) :=  (makeLb e lb,makeLbCut e lb) in
-      if ZWeakChecker (neg_nformula lb::l) pf then Some lc else None.
-
-
-Fixpoint ZChecker (l:list (NFormula Z)) (pf : ProofTerm)  {struct pf} : bool :=
-  match pf with
-    | RatProof pf => ZWeakChecker l pf
-    | CutProof e q pf rst => 
-      match cutChecker l e q pf with
-        | None => false
-        | Some c => ZChecker  (c::l) rst
-      end
-    | EnumProof lb e ub  pf1 pf2 rst => 
-      match cutChecker l e lb  pf1 , cutChecker l (PEopp e) (Qopp ub) pf2 with
-        | None ,  _  | _ , None => false
-        | Some _  , Some _ => let (lb',ub') := (qceiling lb, Zopp (qceiling (- ub))) in
-          (fix label (pfs:list ProofTerm) :=
-            fun lb ub => 
-              match pfs with
-                | nil => if Z_gt_dec lb ub then true else false
-                | pf::rsr => andb (ZChecker  ((PEsub e (PEc lb), Equal) :: l) pf) (label rsr (Zplus lb 1%Z) ub) 
-              end)
-               rst lb' ub'
-      end
-  end.
-
-
-Lemma ZChecker_simpl : forall (pf : ProofTerm) (l:list (NFormula Z)),
-  ZChecker  l pf = 
-  match pf with
-    | RatProof pf => ZWeakChecker l pf
-    | CutProof e q pf rst => 
-      match cutChecker l e q pf with
-        | None => false
-        | Some c => ZChecker  (c::l) rst
-      end
-    | EnumProof lb e ub  pf1 pf2 rst => 
-      match cutChecker l e lb  pf1 , cutChecker l (PEopp e) (Qopp ub) pf2 with
-        | None ,  _  | _ , None => false
-        | Some _  , Some _ => let (lb',ub') := (qceiling lb, Zopp (qceiling (- ub))) in
-          (fix label (pfs:list ProofTerm) :=
-            fun lb ub => 
-              match pfs with
-                | nil => if Z_gt_dec lb ub then true else false
-                | pf::rsr => andb (ZChecker  ((PEsub e (PEc lb), Equal) :: l) pf) (label rsr (Zplus lb 1%Z) ub) 
-              end)
-               rst lb' ub'
-      end
-  end.
-Proof.
-  destruct pf ; reflexivity.
-Qed.
-
-(*
-Fixpoint depth (n:nat) : ProofTerm -> option nat :=
-  match n with
-    | O => fun pf => None
-    | S n => 
-      fun pf => 
-        match pf with
-          | RatProof _ => Some O
-          | CutProof _ _ _ p =>  option_map S  (depth n p)
-          | EnumProof  _ _ _ _ _ l => 
-            let f := fun pf x => 
-              match x , depth n pf with
-                | None ,  _ | _ , None => None
-                | Some n1 , Some n2 => Some (Max.max n1 n2)
-              end in
-            List.fold_right f  (Some O) l
-        end
-  end.
-*)
-Fixpoint bdepth (pf : ProofTerm) : nat :=
-  match pf with
-    | RatProof _ =>  O
-    | CutProof _ _ _ p =>   S  (bdepth p)
-    | EnumProof _ _ _ _ _ l => S (List.fold_right (fun pf x => Max.max (bdepth pf) x)   O l)
-  end.
-
-Require Import Wf_nat.
-
-Lemma in_bdepth : forall l a b p c c0  y, In y l ->  ltof ProofTerm bdepth y (EnumProof a b p c c0 l).
-Proof.
-  induction l.
-  simpl.
-  tauto.
-  simpl.
-  intros.
-  destruct H.
-  subst.
-  unfold ltof.
-  simpl.
-  generalize (         (fold_right
-            (fun (pf : ProofTerm) (x : nat) => Max.max (bdepth pf) x) 0%nat l)).
-  intros.
-  generalize (bdepth y) ; intros.
-  generalize (Max.max_l n0 n) (Max.max_r n0 n).
-  omega.
-  generalize (IHl a0 b p c c0 y  H).
-  unfold ltof.
-  simpl.
-  generalize (      (fold_right (fun (pf : ProofTerm) (x : nat) => Max.max (bdepth pf) x) 0%nat
-         l)).
-  intros.
-  generalize (Max.max_l (bdepth a) n) (Max.max_r (bdepth a) n).
-  omega.
-Qed.
-
-Lemma lb_lbcut : forall env e q,  Zeval_nformula env (makeLb e q) -> Zeval_nformula env (makeLbCut e q).
-Proof.
-  unfold makeLb, makeLbCut.
-  destruct q.
-  rewrite Zeval_nformula_simpl.
-  rewrite Zeval_nformula_simpl.
-  unfold Zeval_op1.
-  rewrite Zeval_expr_simpl.
-  rewrite Zeval_expr_simpl.
-  rewrite Zeval_expr_simpl.
-  intro.
-  rewrite Zeval_expr_simpl.
-  revert H.
-  generalize (Zeval_expr env e).
-  rewrite Zeval_expr_simpl.
-  rewrite Zeval_expr_simpl.
-  unfold qceiling.
-  intros.
-  assert ( z >= ceiling Qnum (' Qden))%Z.
-  apply narrow_interval_lower_bound.
-  compute.
-  reflexivity.
-  destruct z ; auto with zarith.
-  auto with zarith.
-Qed.
-
-Lemma cutChecker_sound : forall e lb pf l res, cutChecker l e lb pf = Some res -> 
-  forall env, make_impl  (Zeval_nformula env) l (Zeval_nformula env res).
-Proof.
-  unfold cutChecker.
-  intros.
-  revert H.
-  case_eq (ZWeakChecker (neg_nformula (makeLb e lb) :: l) pf); intros ; [idtac | discriminate].
-  generalize (ZWeakChecker_sound _ _  H env).
-  intros.
-  inversion H0 ; subst ; clear H0.
-  apply -> make_conj_impl.
-  simpl in H1.
-  rewrite <- make_conj_impl in H1.
-  intros.
-  apply -> neg_nformula_sound ; auto.
-  red ; intros.
-  apply H1 ; auto.
-  clear H H1 H0.
-  generalize (lb_lbcut env e lb).
-  intros.
-  destruct (Zeval_nformula_dec  env ((neg_nformula (makeLb e lb)))).
-  auto.
-  rewrite -> neg_nformula_sound in H0.
-  assert (HH := H H0).
-  rewrite <- neg_nformula_sound in HH.
-  tauto.
-  reflexivity.
-  unfold makeLb.
-  destruct lb.
-  reflexivity.
-Qed.
-
-
-Lemma cutChecker_sound_bound : forall e lb pf l res, cutChecker l e lb pf = Some res -> 
-  forall env,  make_conj  (Zeval_nformula env) l  -> (Zeval_expr env e >= qceiling lb)%Z.
-Proof.
-  intros.
-  generalize (cutChecker_sound _ _ _ _ _ H env).
-  intros.
-  rewrite  <- (make_conj_impl) in H1. 
-  generalize (H1 H0).
-  unfold cutChecker in H.
-  destruct (ZWeakChecker (neg_nformula (makeLb e lb) :: l) pf).
-  unfold makeLbCut in H.
-  inversion H ; subst.
-  clear H.
-  simpl.
-  rewrite Zeval_expr_compat.
-  unfold Zeval_expr'.
-  auto with zarith.
-  discriminate.
-Qed.
-
-
-Lemma ZChecker_sound : forall w l, ZChecker l w = true -> forall env, make_impl  (Zeval_nformula env)  l False.
-Proof.
-  induction w    using (well_founded_ind (well_founded_ltof _ bdepth)).
-  destruct w.
-  (* RatProof *)
-  simpl.
-  intros.
-  eapply ZWeakChecker_sound.
-  apply H0.
-  (* CutProof *)
-  simpl.
-  intro.
-  case_eq (cutChecker l p q z) ; intros.
-  generalize (cutChecker_sound _ _ _ _ _ H0 env).
-  intro.
-  assert (make_impl  (Zeval_nformula env) (n::l) False).
-  eapply (H w) ; auto.
-  unfold ltof.
-  simpl.
-  auto with arith.
-  simpl in H3.
-  rewrite <- make_conj_impl in H2.
-  rewrite <- make_conj_impl in H3.
-  rewrite <- make_conj_impl.
-  tauto.
-  discriminate.
-  (* EnumProof *)
-  intro.
-  rewrite ZChecker_simpl.
-  case_eq (cutChecker l0 p q z).
-  rename q into llb.
-  case_eq (cutChecker l0 (PEopp p) (- q0) z0).
-  intros.
-  rename q0 into uub.
-  (* get the bounds of the enum *)
-  rewrite <- make_conj_impl.
-  intro.
-  assert (qceiling llb <= Zeval_expr env p <= - qceiling ( - uub))%Z.
-  generalize (cutChecker_sound_bound _ _ _ _ _ H0 env H3).
-  generalize (cutChecker_sound_bound _ _ _ _ _ H1 env H3).
-  intros.
-  rewrite Zeval_expr_simpl in H5.
-  auto with zarith.
-  clear H0 H1.
-  revert H2 H3 H4.
-  generalize (qceiling llb) (- qceiling (- uub))%Z.
-  set (FF := (fix label (pfs : list ProofTerm) (lb ub : Z) {struct pfs} : bool :=
-    match pfs with
-      | nil => if Z_gt_dec lb ub then true else false
-      | pf :: rsr =>
-        (ZChecker ((PEsub p (PEc lb), Equal) :: l0) pf &&
-          label rsr (lb + 1)%Z ub)%bool
-    end)).
-  intros z1 z2.
-  intros.
-  assert (forall x, z1 <= x <= z2 -> exists pr, 
-    (In pr l /\
-      ZChecker  ((PEsub p (PEc x),Equal) :: l0) pr = true))%Z.
-  clear H.
-  revert H2.
-  clear H4.
-  revert z1 z2.
-  induction l;simpl ;intros.
-  destruct (Z_gt_dec z1 z2).
-  intros.
-  apply False_ind ; omega.
-  discriminate.
-  intros.
-  simpl in H2.
-  flatten_bool.
-  assert (HH:(x = z1 \/ z1 +1 <=x)%Z) by omega.
-  destruct HH.
-  subst.
-  exists a ; auto.
-  assert (z1 + 1 <= x <= z2)%Z by omega.
-  destruct (IHl _ _ H1 _ H4).
-  destruct H5.
-  exists x0 ; split;auto.
-  (*/asser *)
-  destruct (H0 _ H4) as [pr [Hin Hcheker]].
-  assert (make_impl (Zeval_nformula env) ((PEsub p (PEc (Zeval_expr env p)),Equal) :: l0) False).
-  apply (H pr);auto.
-  apply in_bdepth ; auto.
-  rewrite <- make_conj_impl in H1.
-  apply H1.
-  rewrite  make_conj_cons.
-  split ;auto.
-  rewrite Zeval_nformula_simpl;
-    unfold Zeval_op1;
-      rewrite Zeval_expr_simpl.
-  generalize (Zeval_expr env p).
-  intros.
-  rewrite Zeval_expr_simpl.
-  auto with zarith.
-  intros ; discriminate.
-  intros ; discriminate.
-Qed.
-
-Definition ZTautoChecker  (f : BFormula (Formula Z)) (w: list ProofTerm): bool :=
-  @tauto_checker (Formula Z) (NFormula Z) normalise negate  ProofTerm ZChecker f w.
-
-Lemma ZTautoChecker_sound : forall f w, ZTautoChecker f w = true -> forall env, eval_f  (Zeval_formula env)  f.
-Proof.
-  intros f w.
-  unfold ZTautoChecker.
-  apply (tauto_checker_sound  Zeval_formula Zeval_nformula).
-  apply Zeval_nformula_dec.
-  intros env t.
-  rewrite normalise_correct ; auto.
-  intros env t.
-  rewrite negate_correct ; auto.
-  intros t w0.
-  apply ZChecker_sound.
-Qed.
-
-
-Open Scope Z_scope.
-
-
-Fixpoint map_cone (f: nat -> nat) (e:ZWitness) : ZWitness :=
-  match e with
-    | S_In n         => S_In _ (f n)
-    | S_Ideal e cm   => S_Ideal e (map_cone f cm)
-    | S_Square _     => e
-    | S_Monoid l     => S_Monoid _ (List.map f l)
-    | S_Mult cm1 cm2 => S_Mult (map_cone f cm1) (map_cone f cm2)
-    | S_Add cm1 cm2  => S_Add (map_cone f cm1) (map_cone f cm2)
-    |  _             => e
-  end.
-
-Fixpoint indexes (e:ZWitness) : list nat :=
-  match e with
-    | S_In n         => n::nil
-    | S_Ideal e cm   => indexes cm
-    | S_Square e     => nil
-    | S_Monoid l     => l
-    | S_Mult cm1 cm2 => (indexes cm1)++ (indexes cm2)
-    | S_Add cm1 cm2  => (indexes cm1)++ (indexes cm2)
-    |  _             => nil
-  end.
-  
-(** To ease bindings from ml code **)
-(*Definition varmap := Quote.varmap.*)
-Definition make_impl := Refl.make_impl.
-Definition make_conj := Refl.make_conj.
-
-Require VarMap.
-
-(*Definition varmap_type := VarMap.t Z. *)
-Definition env := PolEnv Z.
-Definition node := @VarMap.Node Z.
-Definition empty := @VarMap.Empty Z.
-Definition leaf := @VarMap.Leaf Z.
-
-Definition coneMember := ZWitness.
-
-Definition eval := Zeval_formula.
-
-Definition prod_pos_nat := prod positive nat.
-
-Require Import Int.
-
-
-Definition n_of_Z (z:Z) : BinNat.N :=
-  match z with
-    | Z0 => N0
-    | Zpos p => Npos p
-    | Zneg p => N0
-  end.
-
-
-
diff --git a/contrib/micromega/certificate.ml b/contrib/micromega/certificate.ml
deleted file mode 100644
index f4efcd08..00000000
--- a/contrib/micromega/certificate.ml
+++ /dev/null
@@ -1,740 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-(* We take as input a list of polynomials [p1...pn] and return an unfeasibility
-   certificate polynomial. *)
-
-(*open Micromega.Polynomial*)
-open Big_int
-open Num
-
-module Mc = Micromega
-module Ml2C = Mutils.CamlToCoq
-module C2Ml = Mutils.CoqToCaml
-
-let (<+>) = add_num
-let (<->) = minus_num
-let (<*>) = mult_num
-
-type var = Mc.positive
-
-module Monomial :
-sig
- type t
- val const : t
- val var : var -> t
- val find : var -> t -> int
- val mult : var -> t -> t
- val prod : t -> t -> t
- val compare : t -> t -> int
- val pp : out_channel -> t -> unit
- val fold : (var -> int -> 'a -> 'a) -> t -> 'a -> 'a
-end
- =
-struct
- (* A monomial is represented by a multiset of variables  *)
- module Map = Map.Make(struct type t = var let compare = Pervasives.compare end)
- open Map
- 
- type t = int Map.t
-
- (* The monomial that corresponds to a constant *)
- let const = Map.empty
-  
- (* The monomial 'x' *)
- let var x = Map.add x 1 Map.empty
-
- (* Get the degre of a variable in a monomial *)
- let find x m = try find x m with Not_found -> 0
-  
- (* Multiply a monomial by a variable *)
- let mult x m = add x (  (find x m) + 1) m
-  
- (* Product of monomials *)
- let prod m1 m2 = Map.fold (fun k d m -> add k ((find k m) + d) m) m1 m2
-  
- (* Total ordering of monomials *)
- let compare m1 m2 = Map.compare Pervasives.compare m1 m2
-
- let pp o m = Map.iter (fun k v -> 
-  if v = 1 then Printf.fprintf o "x%i." (C2Ml.index k)
-  else     Printf.fprintf o "x%i^%i." (C2Ml.index k) v) m
-
- let fold = fold
-
-end
-
-
-module  Poly :
- (* A polynomial is a map of monomials *)
- (* 
-    This is probably a naive implementation 
-    (expected to be fast enough - Coq is probably the bottleneck)
-    *The new ring contribution is using a sparse Horner representation.
- *)
-sig
- type t
- val get : Monomial.t -> t -> num
- val variable : var -> t
- val add : Monomial.t -> num -> t -> t
- val constant : num -> t
- val mult : Monomial.t -> num -> t -> t
- val product : t -> t -> t
- val addition : t -> t -> t
- val uminus : t -> t
- val fold : (Monomial.t -> num -> 'a -> 'a) -> t -> 'a -> 'a
- val pp : out_channel -> t -> unit
- val compare : t -> t -> int
-end =
-struct
- (*normalisation bug : 0*x ... *)
- module P = Map.Make(Monomial)
- open P
-
- type t = num P.t
-
- let pp o p = P.iter (fun k v -> 
-  if compare_num v (Int 0) <> 0
-  then 
-   if Monomial.compare Monomial.const k = 0
-   then         Printf.fprintf o "%s " (string_of_num v)
-   else Printf.fprintf o "%s*%a " (string_of_num v) Monomial.pp k) p  
-
- (* Get the coefficient of monomial mn *)
- let get : Monomial.t -> t -> num = 
-  fun mn p -> try find mn p with Not_found -> (Int 0)
-
-
- (* The polynomial 1.x *)
- let variable : var -> t =
-  fun  x ->  add (Monomial.var x) (Int 1) empty
-   
- (*The constant polynomial *)
- let constant : num -> t =
-  fun c -> add (Monomial.const) c empty
-
- (* The addition of a monomial *)
-
- let add : Monomial.t -> num -> t -> t =
-  fun mn v p -> 
-   let vl = (get mn p) <+> v in
-    add mn vl p
-
-
- (** Design choice: empty is not a polynomial 
-     I do not remember why .... 
- **)
-
- (* The product by a monomial *)
- let mult : Monomial.t -> num -> t -> t =
-  fun mn v p -> 
-   fold (fun mn' v' res -> P.add (Monomial.prod mn mn') (v<*>v') res) p empty
-
-
- let  addition : t -> t -> t =
-  fun p1 p2 -> fold (fun mn v p -> add mn v p) p1 p2
-   
-
- let product : t -> t -> t =
-  fun p1 p2 -> 
-   fold (fun mn v res -> addition (mult mn v p2) res ) p1 empty
-
-
- let uminus : t -> t =
-  fun p -> map (fun v -> minus_num v) p
-
- let fold = P.fold
-
- let compare = compare compare_num
-end
-
-open Mutils
-type 'a number_spec = {
- bigint_to_number : big_int -> 'a;
- number_to_num : 'a  -> num;
- zero : 'a;
- unit : 'a;
- mult : 'a -> 'a -> 'a;
- eqb  : 'a -> 'a -> Mc.bool
-}
-
-let z_spec = {
- bigint_to_number = Ml2C.bigint ;
- number_to_num = (fun x -> Big_int (C2Ml.z_big_int x));
- zero = Mc.Z0;
- unit = Mc.Zpos Mc.XH;
- mult = Mc.zmult;
- eqb  = Mc.zeq_bool
-}
- 
-
-let q_spec = {
- bigint_to_number = (fun x -> {Mc.qnum = Ml2C.bigint x; Mc.qden = Mc.XH});
- number_to_num = C2Ml.q_to_num;
- zero = {Mc.qnum = Mc.Z0;Mc.qden = Mc.XH};
- unit = {Mc.qnum =  (Mc.Zpos Mc.XH) ; Mc.qden = Mc.XH};
- mult = Mc.qmult;
- eqb  = Mc.qeq_bool
-}
-
-let r_spec = z_spec
-
-
-
-
-let dev_form n_spec  p =
- let rec dev_form p = 
-  match p with
-   | Mc.PEc z ->  Poly.constant (n_spec.number_to_num z)
-   | Mc.PEX v ->  Poly.variable v
-   | Mc.PEmul(p1,p2) -> 
-      let p1 = dev_form p1 in
-      let p2 = dev_form p2 in
-       Poly.product p1 p2 
-   | Mc.PEadd(p1,p2) -> Poly.addition (dev_form p1) (dev_form p2)
-   | Mc.PEopp p ->  Poly.uminus (dev_form p)
-   | Mc.PEsub(p1,p2) ->  Poly.addition (dev_form p1) (Poly.uminus (dev_form p2))
-   | Mc.PEpow(p,n)   ->  
-      let p = dev_form p in
-      let n = C2Ml.n n in
-      let rec pow n = 
-       if n = 0 
-       then Poly.constant (n_spec.number_to_num n_spec.unit)
-       else Poly.product p (pow (n-1)) in
-       pow n in
-  dev_form p
-
-
-let monomial_to_polynomial mn = 
- Monomial.fold 
-  (fun v i acc -> 
-   let mn = if i = 1 then Mc.PEX v else Mc.PEpow (Mc.PEX v ,Ml2C.n i) in
-    if acc = Mc.PEc (Mc.Zpos Mc.XH)
-    then mn 
-    else Mc.PEmul(mn,acc))
-  mn 
-  (Mc.PEc (Mc.Zpos Mc.XH))
-  
-let list_to_polynomial vars l = 
- assert (List.for_all (fun x -> ceiling_num x =/ x) l);
- let var x = monomial_to_polynomial (List.nth vars x)  in 
- let rec xtopoly p i = function
-  | [] -> p
-  | c::l -> if c =/  (Int 0) then xtopoly p (i+1) l 
-    else let c = Mc.PEc (Ml2C.bigint (numerator c)) in
-    let mn = 
-     if c =  Mc.PEc (Mc.Zpos Mc.XH)
-     then var i
-     else Mc.PEmul (c,var i) in
-    let p' = if p = Mc.PEc Mc.Z0 then mn else
-      Mc.PEadd (mn, p) in
-     xtopoly p' (i+1) l in
-  
-  xtopoly (Mc.PEc Mc.Z0) 0 l
-
-let rec fixpoint f x =
- let y' = f x in
-  if y' = x then y'
-  else fixpoint f y'
-
-
-
-
-
-
-
-
-let  rec_simpl_cone n_spec e = 
- let simpl_cone = 
-  Mc.simpl_cone n_spec.zero n_spec.unit n_spec.mult n_spec.eqb in
-
- let rec rec_simpl_cone  = function
- | Mc.S_Mult(t1, t2) -> 
-    simpl_cone  (Mc.S_Mult (rec_simpl_cone t1, rec_simpl_cone t2))
- | Mc.S_Add(t1,t2)  -> 
-    simpl_cone (Mc.S_Add (rec_simpl_cone t1, rec_simpl_cone t2))
- |  x           -> simpl_cone x in
-  rec_simpl_cone e
-   
-   
-let simplify_cone n_spec c = fixpoint (rec_simpl_cone n_spec) c
- 
-type cone_prod = 
-  Const of cone 
-  | Ideal of cone *cone 
-  | Mult of cone * cone 
-  | Other of cone
-and cone =   Mc.zWitness
-
-
-
-let factorise_linear_cone c =
- 
- let rec cone_list  c l = 
-  match c with
-   | Mc.S_Add (x,r) -> cone_list  r (x::l)
-   |  _        ->  c :: l in
-  
- let factorise c1 c2 =
-  match c1 , c2 with
-   | Mc.S_Ideal(x,y) , Mc.S_Ideal(x',y') -> 
-      if x = x' then Some (Mc.S_Ideal(x, Mc.S_Add(y,y'))) else None
-   | Mc.S_Mult(x,y) , Mc.S_Mult(x',y') -> 
-      if x = x' then Some (Mc.S_Mult(x, Mc.S_Add(y,y'))) else None
-   |  _     -> None in
-  
- let rec rebuild_cone l pending  =
-  match l with
-   | [] -> (match pending with
-      | None -> Mc.S_Z
-      | Some p -> p
-     )
-   | e::l -> 
-      (match pending with
-       | None -> rebuild_cone l (Some e) 
-       | Some p -> (match factorise p e with
-          | None -> Mc.S_Add(p, rebuild_cone l (Some e))
-          | Some f -> rebuild_cone l (Some f) )
-      ) in
-
-  (rebuild_cone (List.sort Pervasives.compare (cone_list c [])) None)
-
-
-
-(* The binding with Fourier might be a bit obsolete 
-   -- how does it handle equalities ? *)
-
-(* Certificates are elements of the cone such that P = 0  *)
-
-(* To begin with, we search for certificates of the form:
-   a1.p1 + ... an.pn + b1.q1 +... + bn.qn + c = 0   
-   where pi >= 0 qi > 0
-   ai >= 0 
-   bi >= 0
-   Sum bi + c >= 1
-   This is a linear problem: each monomial is considered as a variable.
-   Hence, we can use fourier.
-
-   The variable c is at index 0
-*)
-
-open Mfourier
-   (*module Fourier = Fourier(Vector.VList)(SysSet(Vector.VList))*)
-   (*module Fourier = Fourier(Vector.VSparse)(SysSetAlt(Vector.VSparse))*)
-module Fourier = Mfourier.Fourier(Vector.VSparse)(*(SysSetAlt(Vector.VMap))*)
-
-module Vect = Fourier.Vect
-open Fourier.Cstr
-
-(* fold_left followed by a rev ! *)
-
-let constrain_monomial mn l  = 
- let coeffs = List.fold_left (fun acc p -> (Poly.get mn p)::acc) [] l in
-  if mn = Monomial.const
-  then  
-   { coeffs = Vect.from_list ((Big_int unit_big_int):: (List.rev coeffs)) ; 
-     op = Eq ; 
-     cst = Big_int zero_big_int  }
-  else
-   { coeffs = Vect.from_list ((Big_int zero_big_int):: (List.rev coeffs)) ; 
-     op = Eq ; 
-     cst = Big_int zero_big_int  }
-
-    
-let positivity l = 
- let rec xpositivity i l = 
-  match l with
-   | [] -> []
-   | (_,Mc.Equal)::l -> xpositivity (i+1) l
-   | (_,_)::l -> 
-      {coeffs = Vect.update (i+1) (fun _ -> Int 1) Vect.null ; 
-       op = Ge ; 
-       cst = Int 0 }  :: (xpositivity (i+1) l)
- in
-  xpositivity 0 l
-
-
-let string_of_op = function
- | Mc.Strict -> "> 0" 
- | Mc.NonStrict -> ">= 0" 
- | Mc.Equal -> "= 0"
- | Mc.NonEqual -> "<> 0"
-
-
-
-(* If the certificate includes at least one strict inequality, 
-   the obtained polynomial can also be 0 *)
-let build_linear_system l =
-
- (* Gather the monomials:  HINT add up of the polynomials *)
- let l' = List.map fst l in
- let monomials = 
-  List.fold_left (fun acc p -> Poly.addition p acc) (Poly.constant (Int 0)) l'
- in  (* For each monomial, compute a constraint *)
- let s0 = 
-  Poly.fold (fun mn _ res -> (constrain_monomial mn l')::res) monomials [] in
-  (* I need at least something strictly positive *)
- let strict = {
-  coeffs = Vect.from_list ((Big_int unit_big_int)::
-                            (List.map (fun (x,y) -> 
-                             match y with Mc.Strict -> 
-                              Big_int unit_big_int 
-                              | _ -> Big_int zero_big_int) l));
-  op = Ge ; cst = Big_int unit_big_int } in
-  (* Add the positivity constraint *)
-  {coeffs = Vect.from_list ([Big_int unit_big_int]) ; 
-   op = Ge ; 
-   cst = Big_int zero_big_int}::(strict::(positivity l)@s0)
-
-
-let big_int_to_z = Ml2C.bigint
- 
-(* For Q, this is a pity that the certificate has been scaled 
-   -- at a lower layer, certificates are using nums... *)
-let make_certificate n_spec cert li = 
- let bint_to_cst = n_spec.bigint_to_number in
-  match cert with
-   | [] -> None
-   | e::cert' -> 
-      let cst = match compare_big_int e zero_big_int with
-       | 0 -> Mc.S_Z
-       | 1 ->  Mc.S_Pos (bint_to_cst e) 
-       | _ -> failwith "positivity error" 
-      in
-      let rec scalar_product cert l =
-       match cert with
-        | [] -> Mc.S_Z
-        | c::cert -> match l with
-           | [] -> failwith "make_certificate(1)"
-           | i::l ->  
-              let r = scalar_product cert l in
-               match compare_big_int c  zero_big_int with
-                | -1 -> Mc.S_Add (
-                   Mc.S_Ideal (Mc.PEc ( bint_to_cst c), Mc.S_In (Ml2C.nat i)), 
-                   r)
-                | 0  -> r
-                | _ ->  Mc.S_Add (
-                   Mc.S_Mult (Mc.S_Pos (bint_to_cst c), Mc.S_In (Ml2C.nat i)),
-                   r) in
-       
-      Some ((factorise_linear_cone 
-              (simplify_cone n_spec (Mc.S_Add (cst, scalar_product cert' li)))))
-
-
-exception Found of Monomial.t
- 
-let raw_certificate l = 
- let sys = build_linear_system l in
-  try 
-   match Fourier.find_point sys with
-    | None -> None
-    | Some cert ->  Some (rats_to_ints (Vect.to_list cert)) 
-       (* should not use rats_to_ints *)
-  with x -> 
-   if debug 
-   then (Printf.printf "raw certificate %s" (Printexc.to_string x);   
-         flush stdout) ;
-   None
-
-
-let simple_linear_prover to_constant l =
- let (lc,li) = List.split l in
-  match raw_certificate lc with
-   |  None -> None (* No certificate *)
-   | Some cert -> make_certificate to_constant cert li
-      
-      
-
-let linear_prover n_spec l  =
- let li = List.combine l (interval 0 (List.length l -1)) in
- let (l1,l') = List.partition 
-  (fun (x,_) -> if snd' x = Mc.NonEqual then true else false) li in
- let l' = List.map 
-  (fun (c,i) -> let (Mc.Pair(x,y)) = c in 
-                 match y with 
-                   Mc.NonEqual -> failwith "cannot happen" 
-                  |  y -> ((dev_form n_spec x, y),i)) l' in
-  
-  simple_linear_prover n_spec l' 
-
-
-let linear_prover n_spec l  =
- try linear_prover n_spec l with
-   x -> (print_string (Printexc.to_string x); None)
-
-(* zprover.... *)
-
-(* I need to gather the set of variables --->
-   Then go for fold 
-   Once I have an interval, I need a certificate : 2 other fourier elims.
-   (I could probably get the certificate directly 
-   as it is done in the fourier contrib.)
-*)
-
-let make_linear_system l =
- let l' = List.map fst l in
- let monomials = List.fold_left (fun acc p -> Poly.addition p acc) 
-  (Poly.constant (Int 0)) l' in
- let monomials = Poly.fold 
-  (fun mn _ l -> if mn = Monomial.const then l else mn::l) monomials [] in
-  (List.map (fun (c,op) -> 
-   {coeffs = Vect.from_list (List.map (fun mn ->  (Poly.get mn c)) monomials) ; 
-    op = op ; 
-    cst = minus_num ( (Poly.get Monomial.const c))}) l
-    ,monomials)
-
-
-open Interval 
-let pplus x y = Mc.PEadd(x,y)
-let pmult x y = Mc.PEmul(x,y)
-let pconst x = Mc.PEc x
-let popp x = Mc.PEopp x
- 
-let debug = false
- 
-(* keep track of enumerated vectors *)
-let rec mem p x  l = 
- match l with  [] -> false | e::l -> if p x e then true else mem p x l
-
-let rec remove_assoc p x l = 
- match l with [] -> [] | e::l -> if p x (fst e) then
-  remove_assoc p x l else e::(remove_assoc p x l) 
-
-let eq x y = Vect.compare x y = 0
-
-let  remove e  l  = List.fold_left (fun l x -> if eq x e then l else x::l) [] l
-
-
-(* The prover is (probably) incomplete --
-   only searching for naive cutting planes *)
-
-let candidates sys = 
- let ll = List.fold_right (
-  fun (Mc.Pair(e,k)) r -> 
-   match k with 
-    | Mc.NonStrict -> (dev_form z_spec e , Ge)::r
-    | Mc.Equal     ->  (dev_form z_spec e , Eq)::r 
-       (* we already know the bound -- don't compute it again *)
-    | _     -> failwith "Cannot happen candidates") sys [] in
-
- let (sys,var_mn) = make_linear_system ll in
- let vars = mapi (fun _ i -> Vect.set i (Int 1) Vect.null) var_mn in
-  (List.fold_left (fun l cstr ->   
-   let gcd = Big_int (Vect.gcd cstr.coeffs) in
-    if gcd =/ (Int 1) && cstr.op = Eq 
-    then l 
-    else  (Vect.mul (Int 1 // gcd) cstr.coeffs)::l) [] sys) @ vars
-
-
-let rec xzlinear_prover planes sys = 
- match linear_prover z_spec sys with
-  | Some prf -> Some (Mc.RatProof prf)
-  | None     -> (* find the candidate with the smallest range *)
-     (* Grrr - linear_prover is also calling 'make_linear_system' *)
-     let ll = List.fold_right (fun (Mc.Pair(e,k)) r -> match k with 
-       Mc.NonEqual -> r  
-      | k -> (dev_form z_spec e , 
-             match k with
-               Mc.NonStrict -> Ge 
-              | Mc.Equal              -> Eq
-              | Mc.Strict | Mc.NonEqual -> failwith "Cannot happen") :: r) sys [] in
-     let (ll,var) = make_linear_system ll in
-     let candidates = List.fold_left (fun  acc vect -> 
-      match Fourier.optimise vect ll with
-       | None -> acc
-       | Some i -> 
-(*	  Printf.printf "%s in %s\n" (Vect.string vect) (string_of_intrvl i) ; *)
-	  flush stdout ; 
-	  (vect,i) ::acc)  [] planes in
-
-     let smallest_interval = 
-      match List.fold_left (fun (x1,i1) (x2,i2) -> 
-       if smaller_itv i1 i2 
-       then (x1,i1) else (x2,i2)) (Vect.null,Itv(None,None)) candidates 
-      with
-       | (x,Itv(Some i, Some j))  -> Some(i,x,j)
-       | (x,Point n) ->  Some(n,x,n)
-       |   x        ->   None (* This might be a cutting plane *)
-      in
-      match smallest_interval with
-       | Some (lb,e,ub) -> 
-          let (lbn,lbd) = 
-           (Ml2C.bigint (sub_big_int (numerator lb)  unit_big_int),
-           Ml2C.bigint (denominator lb)) in
-          let (ubn,ubd) = 
-           (Ml2C.bigint (add_big_int unit_big_int (numerator ub)) , 
-           Ml2C.bigint (denominator ub)) in
-          let expr = list_to_polynomial var (Vect.to_list e) in
-           (match 
-             (*x <= ub ->  x  > ub *)
-             linear_prover  z_spec 
-              (Mc.Pair(pplus (pmult (pconst ubd) expr) (popp (pconst  ubn)),
-                      Mc.NonStrict) :: sys),
-            (* lb <= x  -> lb > x *)
-            linear_prover z_spec 
-             (Mc.Pair( pplus  (popp (pmult  (pconst lbd) expr)) (pconst lbn) ,  
-                     Mc.NonStrict)::sys) 
-            with
-             | Some cub , Some clb  ->   
-                (match zlinear_enum  (remove e planes)   expr 
-                  (ceiling_num lb)  (floor_num ub) sys 
-                 with
-                  | None -> None
-                  | Some prf -> 
-                     Some (Mc.EnumProof(Ml2C.q lb,expr,Ml2C.q ub,clb,cub,prf)))
-             | _ -> None
-           )
-       |  _ -> None
-and zlinear_enum  planes expr clb cub l = 
- if clb >/  cub
- then Some Mc.Nil
- else 
-  let pexpr = pplus (popp (pconst (Ml2C.bigint (numerator clb)))) expr in
-  let sys' = (Mc.Pair(pexpr, Mc.Equal))::l in
-   (*let enum =  *)
-   match xzlinear_prover planes sys' with
-    | None -> if debug then print_string "zlp?"; None
-    | Some prf -> if debug then print_string "zlp!";
-    match zlinear_enum planes expr (clb +/ (Int 1)) cub l with
-     | None -> None
-     | Some prfl -> Some (Mc.Cons(prf,prfl))
-
-let zlinear_prover sys =  
- let candidates = candidates sys in
- (*  Printf.printf "candidates %d" (List.length candidates) ; *) 
- xzlinear_prover candidates sys
-
-open Sos
-
-let rec scale_term t = 
- match t with
-  | Zero    -> unit_big_int , Zero
-  | Const n ->  (denominator n) , Const (Big_int (numerator n))
-  | Var n   -> unit_big_int , Var n
-  | Inv _   -> failwith "scale_term : not implemented"
-  | Opp t   -> let s, t = scale_term t in s, Opp t
-  | Add(t1,t2) -> let s1,y1 = scale_term t1 and s2,y2 = scale_term t2 in
-    let g = gcd_big_int s1 s2 in
-    let s1' = div_big_int s1 g in
-    let s2' = div_big_int s2 g in
-    let e = mult_big_int g (mult_big_int s1' s2') in
-     if (compare_big_int e unit_big_int) = 0
-     then (unit_big_int, Add (y1,y2))
-     else 	e, Add (Mul(Const (Big_int s2'), y1),
-		       Mul (Const (Big_int s1'), y2))
-  | Sub _ -> failwith "scale term: not implemented"
-  | Mul(y,z) ->       let s1,y1 = scale_term y and s2,y2 = scale_term z in
-		       mult_big_int s1 s2 , Mul (y1, y2)
-  |  Pow(t,n) -> let s,t = scale_term t in
-		  power_big_int_positive_int s  n , Pow(t,n)
-  |   _ -> failwith "scale_term : not implemented"
-
-let scale_term t =
- let (s,t') = scale_term t in
-  s,t'
-
-
-let get_index_of_ith_match f i l  =
- let rec get j res l =
-  match l with
-   | [] -> failwith "bad index"
-   | e::l -> if f e
-     then 
-       (if j = i then res else get (j+1) (res+1) l )
-     else get j (res+1) l in
-  get 0 0 l
-
-
-let rec scale_certificate pos = match pos with
- | Axiom_eq i ->  unit_big_int , Axiom_eq i
- | Axiom_le i ->  unit_big_int , Axiom_le i
- | Axiom_lt i ->   unit_big_int , Axiom_lt i
- | Monoid l   -> unit_big_int , Monoid l
- | Rational_eq n ->  (denominator n) , Rational_eq (Big_int (numerator n))
- | Rational_le n ->  (denominator n) , Rational_le (Big_int (numerator n))
- | Rational_lt n ->  (denominator n) , Rational_lt (Big_int (numerator n))
- | Square t -> let s,t' =  scale_term t in 
-		mult_big_int s s , Square t'
- | Eqmul (t, y) -> let s1,y1 = scale_term t and s2,y2 = scale_certificate y in
-		    mult_big_int s1 s2 , Eqmul (y1,y2)
- | Sum (y, z) -> let s1,y1 = scale_certificate y 
-   and s2,y2 = scale_certificate z in
-   let g = gcd_big_int s1 s2 in
-   let s1' = div_big_int s1 g in
-   let s2' = div_big_int s2 g in
-    mult_big_int g (mult_big_int s1' s2'), 
-    Sum (Product(Rational_le (Big_int s2'), y1),
-	Product (Rational_le (Big_int s1'), y2))
- | Product (y, z) -> 
-    let s1,y1 = scale_certificate y and s2,y2 = scale_certificate z in
-     mult_big_int s1 s2 , Product (y1,y2)
-
-
-open Micromega
- let rec term_to_q_expr = function
-  | Const n ->  PEc (Ml2C.q n)
-  | Zero   ->  PEc ( Ml2C.q (Int 0))
-  | Var s   ->  PEX (Ml2C.index 
-		      (int_of_string (String.sub s 1 (String.length s - 1))))
-  | Mul(p1,p2) ->  PEmul(term_to_q_expr p1, term_to_q_expr p2)
-  | Add(p1,p2) ->   PEadd(term_to_q_expr p1, term_to_q_expr p2)
-  | Opp p ->   PEopp (term_to_q_expr p)
-  | Pow(t,n) ->  PEpow (term_to_q_expr t,Ml2C.n n)
-  | Sub(t1,t2) ->  PEsub (term_to_q_expr t1,  term_to_q_expr t2)
-  | _ -> failwith "term_to_q_expr: not implemented"
-
-let  q_cert_of_pos  pos = 
- let rec _cert_of_pos = function
-   Axiom_eq i ->  Mc.S_In (Ml2C.nat i)
-  | Axiom_le i ->  Mc.S_In (Ml2C.nat i)
-  | Axiom_lt i ->  Mc.S_In (Ml2C.nat i)
-  | Monoid l  -> Mc.S_Monoid (Ml2C.list Ml2C.nat l)
-  | Rational_eq n | Rational_le n | Rational_lt n -> 
-     if compare_num n (Int 0) = 0 then Mc.S_Z else
-      Mc.S_Pos (Ml2C.q   n)
-  | Square t -> Mc.S_Square (term_to_q_expr  t)
-  | Eqmul (t, y) -> Mc.S_Ideal(term_to_q_expr t, _cert_of_pos y)
-  | Sum (y, z) -> Mc.S_Add  (_cert_of_pos y, _cert_of_pos z)
-  | Product (y, z) -> Mc.S_Mult (_cert_of_pos y, _cert_of_pos z) in
-  simplify_cone q_spec (_cert_of_pos pos)
-
-
- let rec term_to_z_expr = function
-  | Const n ->  PEc (Ml2C.bigint (big_int_of_num n))
-  | Zero   ->  PEc ( Z0)
-  | Var s   ->  PEX (Ml2C.index 
-		      (int_of_string (String.sub s 1 (String.length s - 1))))
-  | Mul(p1,p2) ->  PEmul(term_to_z_expr p1, term_to_z_expr p2)
-  | Add(p1,p2) ->   PEadd(term_to_z_expr p1, term_to_z_expr p2)
-  | Opp p ->   PEopp (term_to_z_expr p)
-  | Pow(t,n) ->  PEpow (term_to_z_expr t,Ml2C.n n)
-  | Sub(t1,t2) ->  PEsub (term_to_z_expr t1,  term_to_z_expr t2)
-  | _ -> failwith "term_to_z_expr: not implemented"
-
-let  z_cert_of_pos  pos = 
- let s,pos = (scale_certificate pos) in
- let rec _cert_of_pos = function
-   Axiom_eq i ->  Mc.S_In (Ml2C.nat i)
-  | Axiom_le i ->  Mc.S_In (Ml2C.nat i)
-  | Axiom_lt i ->  Mc.S_In (Ml2C.nat i)
-  | Monoid l  -> Mc.S_Monoid (Ml2C.list Ml2C.nat l)
-  | Rational_eq n | Rational_le n | Rational_lt n -> 
-     if compare_num n (Int 0) = 0 then Mc.S_Z else
-      Mc.S_Pos (Ml2C.bigint (big_int_of_num  n))
-  | Square t -> Mc.S_Square (term_to_z_expr  t)
-  | Eqmul (t, y) -> Mc.S_Ideal(term_to_z_expr t, _cert_of_pos y)
-  | Sum (y, z) -> Mc.S_Add  (_cert_of_pos y, _cert_of_pos z)
-  | Product (y, z) -> Mc.S_Mult (_cert_of_pos y, _cert_of_pos z) in
-  simplify_cone z_spec (_cert_of_pos pos)
-
diff --git a/contrib/micromega/coq_micromega.ml b/contrib/micromega/coq_micromega.ml
deleted file mode 100644
index b4863ffc..00000000
--- a/contrib/micromega/coq_micromega.ml
+++ /dev/null
@@ -1,1286 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-open Mutils
-let debug = false
-
-let time str f x = 
- let t0 = (Unix.times()).Unix.tms_utime in
- let res = f x in 
- let t1 = (Unix.times()).Unix.tms_utime in 
-  (*if debug then*) (Printf.printf "time %s %f\n" str (t1 -. t0) ; 
-		     flush stdout); 
-  res
-
-type ('a,'b) formula =
-  | TT 
-  | FF 
-  | X of 'b 
-  | A of 'a * Names.name
-  | C of ('a,'b) formula * ('a,'b) formula * Names.name
-  | D of ('a,'b) formula * ('a,'b) formula * Names.name
-  | N of ('a,'b) formula * Names.name
-  | I of ('a,'b) formula * ('a,'b) formula * Names.name
-
-let none = Names.Anonymous
-
-let tag_formula t f = 
- match f with
-  | A(x,_) -> A(x,t)
-  | C(x,y,_) -> C(x,y,t)
-  | D(x,y,_) -> D(x,y,t)
-  | N(x,_) -> N(x,t)
-  | I(x,y,_) -> I(x,y,t)
-  |   _      -> f
-
-let tt = []
-let ff = [ [] ]
-
-
-type ('constant,'contr) sentence =  
-  ('constant Micromega.formula, 'contr) formula
-
-let cnf negate normalise f = 
- let negate a = 
-  CoqToCaml.list (fun cl -> CoqToCaml.list (fun x -> x) cl) (negate a) in
-
- let normalise a = 
-  CoqToCaml.list (fun cl -> CoqToCaml.list (fun x -> x) cl) (normalise a) in
-
- let and_cnf x y = x @ y in
- let or_clause_cnf t f =  List.map (fun x -> t@x ) f in
-  
- let rec or_cnf f f'  =
-  match f with
-   | [] -> tt
-   | e :: rst -> (or_cnf rst f') @ (or_clause_cnf e f') in
-  
- let rec xcnf  (pol : bool) f    =
-  match f with
-   | TT -> if pol then tt else ff (* ?? *)
-   | FF  -> if pol then ff else tt (* ?? *)
-   | X p -> if pol then ff else ff (* ?? *)
-   | A(x,t) -> if pol then normalise  x else negate x
-   | N(e,t)  -> xcnf  (not pol) e
-   | C(e1,e2,t) -> 
-      (if pol then and_cnf else or_cnf) (xcnf  pol e1) (xcnf  pol e2)
-   | D(e1,e2,t)  -> 
-      (if pol then or_cnf else and_cnf) (xcnf  pol e1) (xcnf  pol e2)
-   | I(e1,e2,t) -> 
-      (if pol then or_cnf else and_cnf) (xcnf  (not pol) e1) (xcnf  pol e2) in
-
-  xcnf  true f
-
-
-
-module M =
-struct
- open Coqlib
- open Term
-  (*    let constant = gen_constant_in_modules "Omicron" coq_modules*)
-  
-  
- let logic_dir = ["Coq";"Logic";"Decidable"]
- let coq_modules =
-  init_modules @ 
-   [logic_dir] @ arith_modules @ zarith_base_modules @ 
-   [ ["Coq";"Lists";"List"];
-     ["ZMicromega"];
-     ["Tauto"];
-     ["RingMicromega"];
-     ["EnvRing"];
-     ["Coq"; "micromega"; "ZMicromega"];
-     ["Coq" ; "micromega" ; "Tauto"];
-     ["Coq" ; "micromega" ; "RingMicromega"];
-     ["Coq" ; "micromega" ; "EnvRing"];
-     ["Coq";"QArith"; "QArith_base"];
-     ["Coq";"Reals" ; "Rdefinitions"];
-     ["Coq";"Reals" ; "Rpow_def"];
-     ["LRing_normalise"]]
-   
- let constant = gen_constant_in_modules "ZMicromega" coq_modules
-
- let coq_and = lazy (constant "and")
- let coq_or = lazy (constant "or")
- let coq_not = lazy (constant "not")
- let coq_iff = lazy (constant "iff")
- let coq_True = lazy (constant "True")
- let coq_False = lazy (constant "False")
-  
- let coq_cons = lazy (constant "cons")
- let coq_nil = lazy (constant "nil")
- let coq_list = lazy (constant "list")
-
- let coq_O = lazy (constant "O")
- let coq_S = lazy (constant "S")
- let coq_nat = lazy (constant "nat")
-
- let coq_NO = lazy 
-  (gen_constant_in_modules "N" [ ["Coq";"NArith";"BinNat" ]]  "N0")
- let coq_Npos = lazy 
-  (gen_constant_in_modules "N" [ ["Coq";"NArith"; "BinNat"]]  "Npos")
-  (* let coq_n = lazy (constant "N")*)
-
- let coq_pair = lazy (constant "pair")
- let coq_None = lazy (constant "None")
- let coq_option = lazy (constant "option")
- let coq_positive = lazy (constant "positive")
- let coq_xH = lazy (constant "xH")
- let coq_xO = lazy (constant "xO")
- let coq_xI = lazy (constant "xI")
-  
- let coq_N0 = lazy (constant "N0")
- let coq_N0 = lazy (constant "Npos")
-
-
- let coq_Z = lazy (constant "Z")
- let coq_Q = lazy (constant "Q")
- let coq_R = lazy (constant "R")
-
- let coq_ZERO = lazy (constant  "Z0")
- let coq_POS = lazy (constant  "Zpos")
- let coq_NEG = lazy (constant  "Zneg")
-
- let coq_QWitness = lazy 
-  (gen_constant_in_modules "QMicromega" 
-    [["Coq"; "micromega"; "QMicromega"]] "QWitness")
- let coq_ZWitness = lazy 
-  (gen_constant_in_modules "QMicromega" 
-    [["Coq"; "micromega"; "ZMicromega"]] "ZWitness")
-
-
- let coq_Build_Witness = lazy (constant "Build_Witness")
-
-
- let coq_Qmake = lazy (constant "Qmake")
- let coq_R0    = lazy (constant "R0")
- let coq_R1    = lazy (constant "R1")
-
-
- let coq_proofTerm = lazy (constant "ProofTerm")
- let coq_ratProof = lazy (constant "RatProof")
- let coq_cutProof = lazy (constant "CutProof")
- let coq_enumProof = lazy (constant "EnumProof")
-
- let coq_Zgt = lazy (constant "Zgt")
- let coq_Zge = lazy (constant "Zge")
- let coq_Zle = lazy (constant "Zle")
- let coq_Zlt = lazy (constant "Zlt")
- let coq_Eq  = lazy (constant "eq")
-
- let coq_Zplus = lazy (constant "Zplus")
- let coq_Zminus = lazy (constant "Zminus")
- let coq_Zopp = lazy (constant "Zopp")
- let coq_Zmult = lazy (constant "Zmult")
- let coq_Zpower = lazy (constant "Zpower")
- let coq_N_of_Z = lazy 
-  (gen_constant_in_modules "ZArithRing" 
-    [["Coq";"setoid_ring";"ZArithRing"]] "N_of_Z")
-
- let coq_Qgt = lazy (constant "Qgt")
- let coq_Qge = lazy (constant "Qge")
- let coq_Qle = lazy (constant "Qle")
- let coq_Qlt = lazy (constant "Qlt")
- let coq_Qeq = lazy (constant "Qeq")
-
-
- let coq_Qplus = lazy (constant "Qplus")
- let coq_Qminus = lazy (constant "Qminus")
- let coq_Qopp = lazy (constant "Qopp")
- let coq_Qmult = lazy (constant "Qmult")
- let coq_Qpower = lazy (constant "Qpower")
-
-
- let coq_Rgt = lazy (constant "Rgt")
- let coq_Rge = lazy (constant "Rge")
- let coq_Rle = lazy (constant "Rle")
- let coq_Rlt = lazy (constant "Rlt")
-
- let coq_Rplus = lazy (constant "Rplus")
- let coq_Rminus = lazy (constant "Rminus")
- let coq_Ropp = lazy (constant "Ropp")
- let coq_Rmult = lazy (constant "Rmult")
- let coq_Rpower = lazy (constant "pow")
-
-
- let coq_PEX = lazy (constant "PEX" )
- let coq_PEc = lazy (constant"PEc")
- let coq_PEadd = lazy (constant "PEadd")
- let coq_PEopp = lazy (constant "PEopp")
- let coq_PEmul = lazy (constant "PEmul")
- let coq_PEsub = lazy (constant "PEsub")
- let coq_PEpow = lazy (constant "PEpow")
-
-
- let coq_OpEq = lazy (constant "OpEq")
- let coq_OpNEq = lazy (constant "OpNEq")
- let coq_OpLe = lazy (constant "OpLe")
- let coq_OpLt = lazy (constant  "OpLt")
- let coq_OpGe = lazy (constant "OpGe")
- let coq_OpGt = lazy (constant  "OpGt")
-
-
- let coq_S_In = lazy (constant "S_In")
- let coq_S_Square = lazy (constant "S_Square")
- let coq_S_Monoid = lazy (constant "S_Monoid")
- let coq_S_Ideal = lazy (constant "S_Ideal")
- let coq_S_Mult = lazy (constant "S_Mult")
- let coq_S_Add  = lazy (constant "S_Add")
- let coq_S_Pos  = lazy (constant "S_Pos")
- let coq_S_Z    = lazy (constant "S_Z")
- let coq_coneMember    = lazy (constant "coneMember")
-  
-
- let coq_make_impl = lazy 
-  (gen_constant_in_modules "Zmicromega" [["Refl"]] "make_impl")
- let coq_make_conj = lazy 
-  (gen_constant_in_modules "Zmicromega" [["Refl"]] "make_conj")
-
- let coq_Build = lazy 
-  (gen_constant_in_modules "RingMicromega" 
-    [["Coq" ; "micromega" ; "RingMicromega"] ; ["RingMicromega"] ] 
-    "Build_Formula")
- let coq_Cstr = lazy 
-  (gen_constant_in_modules "RingMicromega" 
-    [["Coq" ; "micromega" ; "RingMicromega"] ; ["RingMicromega"] ] "Formula")
-
-
- type parse_error  = 
-   | Ukn 
-   | BadStr of string 
-   | BadNum of int 
-   | BadTerm of Term.constr 
-   | Msg   of string
-   | Goal of (Term.constr list ) * Term.constr * parse_error
-
- let string_of_error = function
-  | Ukn -> "ukn"
-  | BadStr s -> s
-  | BadNum i -> string_of_int i
-  | BadTerm _ -> "BadTerm"
-  | Msg  s    -> s
-  | Goal _    -> "Goal"
-
-
- exception ParseError 
-
-
-
-
- let get_left_construct term = 
-  match Term.kind_of_term term with
-   | Term.Construct(_,i) -> (i,[| |])
-   | Term.App(l,rst) -> 
-      (match Term.kind_of_term l with
-       | Term.Construct(_,i) -> (i,rst)
-       |   _     -> raise ParseError
-      )
-   | _ ->   raise ParseError
-      
- module Mc = Micromega
-      
- let rec parse_nat term = 
-  let (i,c) = get_left_construct term in
-   match i with
-    | 1 -> Mc.O
-    | 2 -> Mc.S (parse_nat (c.(0)))
-    | i -> raise ParseError
-       
-
- let pp_nat o n = Printf.fprintf o "%i" (CoqToCaml.nat n)
-
-
- let rec dump_nat x = 
-  match x with
-   | Mc.O -> Lazy.force coq_O
-   | Mc.S p -> Term.mkApp(Lazy.force coq_S,[| dump_nat p |])
-
-
- let rec parse_positive term = 
-  let (i,c) = get_left_construct term in
-   match i with
-    | 1 -> Mc.XI (parse_positive c.(0))
-    | 2 -> Mc.XO (parse_positive c.(0))
-    | 3 -> Mc.XH
-    | i -> raise ParseError
-       
-
- let rec dump_positive x = 
-  match x with
-   | Mc.XH -> Lazy.force coq_xH
-   | Mc.XO p -> Term.mkApp(Lazy.force coq_xO,[| dump_positive p |])
-   | Mc.XI p -> Term.mkApp(Lazy.force coq_xI,[| dump_positive p |])
-
- let pp_positive o x = Printf.fprintf o "%i" (CoqToCaml.positive x)	  
-
-
- let rec dump_n x = 
-  match x with 
-   | Mc.N0 -> Lazy.force coq_N0
-   | Mc.Npos p -> Term.mkApp(Lazy.force coq_Npos,[| dump_positive p|])
-
- let rec dump_index x = 
-  match x with
-   | Mc.XH -> Lazy.force coq_xH
-   | Mc.XO p -> Term.mkApp(Lazy.force coq_xO,[| dump_index p |])
-   | Mc.XI p -> Term.mkApp(Lazy.force coq_xI,[| dump_index p |])
-
-
- let pp_index o x = Printf.fprintf o "%i" (CoqToCaml.index x)	  
-
- let rec dump_n x = 
-  match x with
-   | Mc.N0 -> Lazy.force coq_NO
-   | Mc.Npos p -> Term.mkApp(Lazy.force coq_Npos,[| dump_positive p |])
-
- let rec pp_n o x =  output_string o  (string_of_int (CoqToCaml.n x))
-
- let dump_pair t1 t2 dump_t1 dump_t2 (Mc.Pair (x,y)) =
-  Term.mkApp(Lazy.force coq_pair,[| t1 ; t2 ; dump_t1 x ; dump_t2 y|])
-
-
- let rec parse_z term =
-  let (i,c) = get_left_construct term in
-   match i with
-    | 1 -> Mc.Z0
-    | 2 -> Mc.Zpos (parse_positive c.(0))
-    | 3 -> Mc.Zneg (parse_positive c.(0))
-    | i -> raise ParseError
-
- let dump_z x =
-  match x with
-   | Mc.Z0 ->Lazy.force coq_ZERO
-   | Mc.Zpos p -> Term.mkApp(Lazy.force coq_POS,[| dump_positive p|]) 
-   | Mc.Zneg p -> Term.mkApp(Lazy.force coq_NEG,[| dump_positive p|])  
-
- let pp_z o x = Printf.fprintf o "%i" (CoqToCaml.z x)
-
-let dump_num bd1 = 
- Term.mkApp(Lazy.force coq_Qmake,
-	   [|dump_z (CamlToCoq.bigint (numerator bd1)) ; 
-	     dump_positive (CamlToCoq.positive_big_int (denominator bd1)) |])
-
-
-let dump_q q = 
- Term.mkApp(Lazy.force coq_Qmake, 
-	   [| dump_z q.Micromega.qnum ; dump_positive q.Micromega.qden|])
-
-let parse_q term =  
- match Term.kind_of_term term with
-  | Term.App(c, args) -> if c = Lazy.force coq_Qmake then
-	{Mc.qnum = parse_z args.(0) ; Mc.qden = parse_positive args.(1) }
-      else raise ParseError
-  |  _ -> raise ParseError
-
-  
- let rec parse_list parse_elt term = 
-  let (i,c) = get_left_construct term in
-   match i with
-    | 1 -> Mc.Nil
-    | 2 -> Mc.Cons(parse_elt c.(1), parse_list parse_elt c.(2))
-    | i -> raise ParseError
-
-
- let rec dump_list typ dump_elt l =
-  match l with
-   | Mc.Nil -> Term.mkApp(Lazy.force coq_nil,[| typ |])
-   | Mc.Cons(e,l) -> Term.mkApp(Lazy.force coq_cons, 
-			       [| typ; dump_elt e;dump_list typ dump_elt l|])
-      
- let rec dump_ml_list typ dump_elt l =
-  match l with
-   | [] -> Term.mkApp(Lazy.force coq_nil,[| typ |])
-   | e::l -> Term.mkApp(Lazy.force coq_cons, 
-		       [| typ; dump_elt e;dump_ml_list typ dump_elt l|])
-
-
-
- let pp_list op cl elt o l = 
-  let rec _pp  o l = 
-   match l with
-    | Mc.Nil -> ()
-    | Mc.Cons(e,Mc.Nil) -> Printf.fprintf o "%a" elt e
-    | Mc.Cons(e,l) -> Printf.fprintf o "%a ,%a" elt e  _pp l in
-   Printf.fprintf o "%s%a%s" op _pp l cl 
-
-
-
- let pp_var  = pp_positive
- let dump_var = dump_positive
-
- let rec pp_expr o e = 
-  match e with
-   | Mc.PEX n -> Printf.fprintf o "V %a" pp_var n
-   | Mc.PEc z -> pp_z o z
-   | Mc.PEadd(e1,e2) -> Printf.fprintf o "(%a)+(%a)" pp_expr e1 pp_expr e2
-   | Mc.PEmul(e1,e2) -> Printf.fprintf o "%a*(%a)" pp_expr e1 pp_expr e2
-   | Mc.PEopp e -> Printf.fprintf o "-(%a)" pp_expr e
-   | Mc.PEsub(e1,e2) -> Printf.fprintf o "(%a)-(%a)" pp_expr e1 pp_expr e2
-   | Mc.PEpow(e,n) -> Printf.fprintf o "(%a)^(%a)" pp_expr e pp_n  n
-
-
- let  dump_expr typ dump_z e =
-  let rec dump_expr  e =
-  match e with
-   | Mc.PEX n -> mkApp(Lazy.force coq_PEX,[| typ; dump_var n |])
-   | Mc.PEc z -> mkApp(Lazy.force coq_PEc,[| typ ; dump_z z |])
-   | Mc.PEadd(e1,e2) -> mkApp(Lazy.force coq_PEadd,
-			     [| typ; dump_expr e1;dump_expr e2|])
-   | Mc.PEsub(e1,e2) -> mkApp(Lazy.force coq_PEsub,
-			     [| typ; dump_expr  e1;dump_expr  e2|])
-   | Mc.PEopp e -> mkApp(Lazy.force coq_PEopp,
-			[| typ; dump_expr  e|])
-   | Mc.PEmul(e1,e2) ->  mkApp(Lazy.force coq_PEmul,
-			      [| typ; dump_expr  e1;dump_expr e2|])
-   | Mc.PEpow(e,n) ->  mkApp(Lazy.force coq_PEpow,
-			    [| typ; dump_expr  e; dump_n  n|])
-     in
-   dump_expr e
-
- let rec dump_monoid l = dump_list (Lazy.force coq_nat) dump_nat l
-
- let rec dump_cone typ dump_z e = 
-  let z = Lazy.force typ in 
- let rec dump_cone e =
-  match e with
-   | Mc.S_In n -> mkApp(Lazy.force coq_S_In,[| z; dump_nat n |])
-   | Mc.S_Ideal(e,c) -> mkApp(Lazy.force coq_S_Ideal, 
-			     [| z; dump_expr z dump_z e ; dump_cone c |])
-   | Mc.S_Square e -> mkApp(Lazy.force coq_S_Square, 
-			   [| z;dump_expr z dump_z e|])
-   | Mc.S_Monoid l -> mkApp (Lazy.force coq_S_Monoid, 
-			    [|z; dump_monoid l|])
-   | Mc.S_Add(e1,e2) -> mkApp(Lazy.force coq_S_Add,
-			     [| z; dump_cone e1; dump_cone e2|])
-   | Mc.S_Mult(e1,e2) -> mkApp(Lazy.force coq_S_Mult,
-			      [| z; dump_cone e1; dump_cone e2|])
-   | Mc.S_Pos p -> mkApp(Lazy.force coq_S_Pos,[| z; dump_z p|])
-   | Mc.S_Z    -> mkApp( Lazy.force coq_S_Z,[| z|]) in 
-  dump_cone e
-
-
- let  pp_cone pp_z o e = 
-  let rec pp_cone o e = 
-   match e with 
-    | Mc.S_In n -> 
-       Printf.fprintf o "(S_In %a)%%nat" pp_nat n
-    | Mc.S_Ideal(e,c) -> 
-       Printf.fprintf o "(S_Ideal %a %a)" pp_expr e pp_cone c
-    | Mc.S_Square e -> 
-       Printf.fprintf o "(S_Square %a)" pp_expr e
-    | Mc.S_Monoid l -> 
-       Printf.fprintf o "(S_Monoid %a)" (pp_list "[" "]" pp_nat) l
-    | Mc.S_Add(e1,e2) -> 
-       Printf.fprintf o "(S_Add %a %a)" pp_cone e1 pp_cone e2
-    | Mc.S_Mult(e1,e2) -> 
-       Printf.fprintf o "(S_Mult %a %a)" pp_cone e1 pp_cone e2
-    | Mc.S_Pos p -> 
-       Printf.fprintf o "(S_Pos %a)%%positive" pp_z p
-    | Mc.S_Z    -> 
-       Printf.fprintf o "S_Z" in
-   pp_cone o e
-
-
- let rec dump_op = function
-  | Mc.OpEq-> Lazy.force coq_OpEq
-  | Mc.OpNEq-> Lazy.force coq_OpNEq
-  | Mc.OpLe -> Lazy.force coq_OpLe
-  | Mc.OpGe -> Lazy.force coq_OpGe
-  | Mc.OpGt-> Lazy.force coq_OpGt
-  | Mc.OpLt-> Lazy.force coq_OpLt
-
-
-
- let pp_op o e= 
-  match e with 
-   | Mc.OpEq-> Printf.fprintf o "="
-   | Mc.OpNEq-> Printf.fprintf o "<>"
-   | Mc.OpLe -> Printf.fprintf o "=<"
-   | Mc.OpGe -> Printf.fprintf o ">="
-   | Mc.OpGt-> Printf.fprintf o ">"
-   | Mc.OpLt-> Printf.fprintf o "<"
-
-
-
-
- let pp_cstr o {Mc.flhs = l ; Mc.fop = op ; Mc.frhs = r } =
-  Printf.fprintf o"(%a %a %a)" pp_expr l pp_op op pp_expr r
-
- let dump_cstr typ dump_constant {Mc.flhs = e1 ; Mc.fop = o ; Mc.frhs = e2} =
-   Term.mkApp(Lazy.force coq_Build,
-	     [| typ; dump_expr typ dump_constant e1 ; 
-		dump_op o ; 
-		dump_expr typ dump_constant e2|])
-
- let assoc_const x l = 
-  try 
-  snd (List.find (fun (x',y) -> x = Lazy.force x') l)
-  with
-    Not_found -> raise ParseError
-
- let zop_table = [ 
-  coq_Zgt, Mc.OpGt ; 
-  coq_Zge, Mc.OpGe ;
-  coq_Zlt, Mc.OpLt ;
-  coq_Zle, Mc.OpLe ]
-
- let rop_table = [ 
-  coq_Rgt, Mc.OpGt ; 
-  coq_Rge, Mc.OpGe ;
-  coq_Rlt, Mc.OpLt ;
-  coq_Rle, Mc.OpLe ]
-
- let qop_table = [ 
-  coq_Qlt, Mc.OpLt ;
-  coq_Qle, Mc.OpLe ;
-  coq_Qeq, Mc.OpEq
- ]
-
-
- let parse_zop (op,args) =
-  match kind_of_term op with
-   | Const x -> (assoc_const op zop_table, args.(0) , args.(1))
-   |  Ind(n,0) -> 
-       if op = Lazy.force coq_Eq &&   args.(0) = Lazy.force coq_Z
-       then (Mc.OpEq, args.(1), args.(2))
-       else raise ParseError
-   |   _ -> failwith "parse_zop"
-
-
- let parse_rop (op,args) =
-   match kind_of_term op with
-    | Const x -> (assoc_const op rop_table, args.(0) , args.(1))
-    |  Ind(n,0) -> 
-       if op = Lazy.force coq_Eq &&   args.(0) = Lazy.force coq_R
-       then (Mc.OpEq, args.(1), args.(2))
-       else raise ParseError
-   |   _ -> failwith "parse_zop"
-
- let parse_qop (op,args) =
-   (assoc_const op qop_table, args.(0) , args.(1))
-
-
- module Env =
- struct 
-  type t = constr list
-    
-  let compute_rank_add env v =
-   let rec _add env n v =
-    match env with
-     | [] -> ([v],n)
-     | e::l -> 
-	if eq_constr e v 
-	then (env,n)
-	else 
-	 let (env,n) = _add l ( n+1) v in
-	  (e::env,n) in
-   let (env, n) =  _add env 1 v in
-    (env, CamlToCoq.idx n)
-
-     
-  let empty = []
-   
-  let elements env = env
-
- end
-
-
- let is_constant t = (* This is an approx *)
-  match kind_of_term t with
-   | Construct(i,_) -> true 
-   |   _ -> false
-
-
- type 'a op = 
-   | Binop of ('a Mc.pExpr -> 'a Mc.pExpr -> 'a Mc.pExpr) 
-   | Opp 
-   | Power 
-   | Ukn of string
-
-
- let assoc_ops x l = 
-  try 
-    snd (List.find (fun (x',y) -> x = Lazy.force x') l)
-  with
-    Not_found -> Ukn "Oups"
-
-
-
- let parse_expr parse_constant parse_exp ops_spec env term = 
- if debug 
- then (Pp.pp (Pp.str "parse_expr: ");   
-       Pp.pp_flush ();Pp.pp (Printer.prterm  term); Pp.pp_flush ());
-
-  let constant_or_variable env term = 
-   try 
-    ( Mc.PEc (parse_constant term) , env)
-   with ParseError -> 
-    let (env,n) = Env.compute_rank_add env term in
-     (Mc.PEX  n , env) in
-
-  let rec parse_expr env term = 
-   let combine env op (t1,t2) =
-    let (expr1,env) = parse_expr env t1 in
-    let (expr2,env) = parse_expr env t2 in
-    (op expr1 expr2,env) in
-    match kind_of_term term with
-     | App(t,args) -> 
-	(
-	 match kind_of_term t with
-	  | Const c -> 
-	     ( match assoc_ops t ops_spec  with
-	      | Binop f -> combine env f (args.(0),args.(1))
-	      | Opp     -> let (expr,env) = parse_expr env args.(0) in
-			    (Mc.PEopp expr, env)
-	      | Power   -> 
-		 let (expr,env) = parse_expr env args.(0) in
-		 let exp = (parse_exp args.(1)) in 
-		  (Mc.PEpow(expr, exp)  , env) 
-	      | Ukn  s -> 
-		 if debug 
-		 then (Printf.printf "unknown op: %s\n" s; flush stdout;);
-		 let (env,n) = Env.compute_rank_add env term in (Mc.PEX n, env)
-	     )
-	  |   _ -> constant_or_variable env term
-	)
-     | _ -> constant_or_variable env term in
-   parse_expr env term
-    
-
- let zop_spec = 
-   [ 
-     coq_Zplus , Binop (fun x y -> Mc.PEadd(x,y)) ;
-     coq_Zminus , Binop (fun x y -> Mc.PEsub(x,y)) ;
-     coq_Zmult  , Binop  (fun x y -> Mc.PEmul (x,y)) ; 
-     coq_Zopp   , Opp ; 
-     coq_Zpower , Power]
-
-let qop_spec = 
-  [
-     coq_Qplus , Binop (fun x y -> Mc.PEadd(x,y)) ;
-     coq_Qminus , Binop (fun x y -> Mc.PEsub(x,y)) ;
-     coq_Qmult  , Binop  (fun x y -> Mc.PEmul (x,y)) ; 
-     coq_Qopp   , Opp ; 
-     coq_Qpower , Power]
-
-let rop_spec = 
-  [
-     coq_Rplus , Binop (fun x y -> Mc.PEadd(x,y)) ;
-     coq_Rminus , Binop (fun x y -> Mc.PEsub(x,y)) ;
-     coq_Rmult  , Binop  (fun x y -> Mc.PEmul (x,y)) ; 
-     coq_Ropp   , Opp ; 
-     coq_Rpower , Power]
-
-
-
-
-      
-let zconstant = parse_z
-let qconstant = parse_q
-
-
-let rconstant term = 
- if debug 
- then (Pp.pp_flush ();
-       Pp.pp (Pp.str "rconstant: ");
-       Pp.pp (Printer.prterm  term); Pp.pp_flush ());
- match Term.kind_of_term term with
-  | Const x ->  
-      if term = Lazy.force coq_R0
-      then Mc.Z0
-      else if term = Lazy.force coq_R1
-      then Mc.Zpos Mc.XH
-      else raise ParseError
-  |  _ -> raise ParseError
-
-
-let parse_zexpr = 
- parse_expr zconstant (fun x -> Mc.n_of_Z (parse_z x))  zop_spec 
-let parse_qexpr  = 
- parse_expr qconstant (fun x -> Mc.n_of_Z (parse_z x)) qop_spec 
-let parse_rexpr = 
- parse_expr rconstant  (fun x -> Mc.n_of_nat (parse_nat x)) rop_spec
-
-
- let  parse_arith parse_op parse_expr env cstr = 
-  if debug 
-  then (Pp.pp_flush ();
-	Pp.pp (Pp.str "parse_arith: ");
-	Pp.pp (Printer.prterm  cstr); 
-	Pp.pp_flush ());
-  match kind_of_term cstr with
-   | App(op,args) -> 
-      let (op,lhs,rhs) = parse_op (op,args) in
-      let (e1,env) = parse_expr env lhs in
-      let (e2,env) = parse_expr env rhs in
-       ({Mc.flhs = e1; Mc.fop = op;Mc.frhs = e2},env)
-   |  _ -> failwith "error : parse_arith(2)"
-
- let parse_zarith = parse_arith  parse_zop parse_zexpr 
-  
- let parse_qarith = parse_arith  parse_qop parse_qexpr
-  
- let parse_rarith = parse_arith  parse_rop parse_rexpr
-  
-  
- (* generic parsing of arithmetic expressions *)
-  
-
-
-
- let rec f2f = function
-  | TT  -> Mc.TT
-  | FF  -> Mc.FF
-  | X _  -> Mc.X
-  | A (x,_) -> Mc.A x
-  | C (a,b,_)  -> Mc.Cj(f2f a,f2f b)
-  | D (a,b,_)  -> Mc.D(f2f a,f2f b)
-  | N (a,_) -> Mc.N(f2f a)
-  | I(a,b,_)  -> Mc.I(f2f a,f2f b)
-
- let is_prop t = 
-  match t with
-   | Names.Anonymous -> true (* Not quite right *)
-   | Names.Name x    -> false
-
- let mkC f1 f2 = C(f1,f2,none)
- let mkD f1 f2 = D(f1,f2,none)
- let mkIff f1 f2 = C(I(f1,f2,none),I(f2,f2,none),none)
- let mkI f1 f2 = I(f1,f2,none)
-
- let mkformula_binary g term f1 f2 =
-   match f1 , f2 with
-   |  X _  , X _ -> X(term)
-   |   _         -> g f1 f2
-
- let parse_formula parse_atom env term =
-  let parse_atom env t = try let (at,env) = parse_atom env t in (A(at,none), env) with _ -> (X(t),env) in
-
-  let rec xparse_formula env term =
-   match kind_of_term term with
-    | App(l,rst) ->
-        (match rst with
-         | [|a;b|] when l = Lazy.force coq_and ->
-	     let f,env = xparse_formula env a in
-	     let g,env = xparse_formula env b in
-             mkformula_binary mkC term f g,env
-         | [|a;b|] when l = Lazy.force coq_or ->
-	     let f,env = xparse_formula env a in
-	     let g,env = xparse_formula env b in
-             mkformula_binary mkD term f g,env
-         | [|a|] when l = Lazy.force coq_not ->
-             let (f,env) = xparse_formula env a in (N(f,none), env)
-         | [|a;b|] when l = Lazy.force coq_iff ->
-	     let f,env = xparse_formula env a in
-	     let g,env = xparse_formula env b in
-             mkformula_binary mkIff term f g,env
-         | _ -> parse_atom env term)
-    | Prod(typ,a,b) when not (Termops.dependent (mkRel 1) b) ->
-	let f,env = xparse_formula env a in
-	let g,env = xparse_formula env b in
-        mkformula_binary mkI term f g,env
-    | _ when term = Lazy.force coq_True -> (TT,env)
-    | _ when term = Lazy.force coq_False -> (FF,env)
-    | _  -> X(term),env in
-  xparse_formula env term
-
- let coq_TT = lazy 
-  (gen_constant_in_modules "ZMicromega" 
-    [["Coq" ; "micromega" ; "Tauto"];["Tauto"]]  "TT")
- let coq_FF = lazy 
-  (gen_constant_in_modules "ZMicromega" 
-    [["Coq" ; "micromega" ; "Tauto"];["Tauto"]]  "FF")
- let coq_And = lazy 
-  (gen_constant_in_modules "ZMicromega"    
-    [["Coq" ; "micromega" ; "Tauto"];["Tauto"]]  "Cj")
- let coq_Or = lazy 
-  (gen_constant_in_modules "ZMicromega"  
-    [["Coq" ; "micromega" ; "Tauto"];["Tauto"]]    "D")
- let coq_Neg = lazy 
-  (gen_constant_in_modules "ZMicromega" 
-    [["Coq" ; "micromega" ; "Tauto"];["Tauto"]]  "N")
- let coq_Atom = lazy 
-  (gen_constant_in_modules "ZMicromega" 
-    [["Coq" ; "micromega" ; "Tauto"];["Tauto"]]  "A")
- let coq_X = lazy 
-  (gen_constant_in_modules "ZMicromega"  
-    [["Coq" ; "micromega" ; "Tauto"];["Tauto"]]  "X")
- let coq_Impl = lazy 
-  (gen_constant_in_modules "ZMicromega" 
-    [["Coq" ; "micromega" ; "Tauto"];["Tauto"]]  "I")
- let coq_Formula = lazy 
-  (gen_constant_in_modules "ZMicromega" 
-    [["Coq" ; "micromega" ; "Tauto"];["Tauto"]]  "BFormula")
-
- let dump_formula typ dump_atom f = 
-  let rec xdump f = 
-   match f with
-    | TT  -> mkApp(Lazy.force coq_TT,[| typ|])
-    | FF  -> mkApp(Lazy.force coq_FF,[| typ|])
-    | C(x,y,_) -> mkApp(Lazy.force coq_And,[| typ ; xdump x ; xdump y|])
-    | D(x,y,_) -> mkApp(Lazy.force coq_Or,[| typ ; xdump x ; xdump y|])
-    | I(x,y,_) -> mkApp(Lazy.force coq_Impl,[| typ ; xdump x ; xdump y|])
-    | N(x,_) -> mkApp(Lazy.force coq_Neg,[| typ ; xdump x|])
-    | A(x,_) -> mkApp(Lazy.force coq_Atom,[| typ ; dump_atom x|]) 
-    | X(t) -> mkApp(Lazy.force coq_X,[| typ ; t|])  in
-
-   xdump f
-    
-
-
-
- (* ! reverse the list of bindings *)
- let set l concl =
-  let rec _set acc = function
-   | [] -> acc
-   | (e::l) ->  
-      let (name,expr,typ) = e in
-       _set (Term.mkNamedLetIn
-	      (Names.id_of_string name)
-	      expr typ acc) l in
-   _set concl l
-
-
-end            
-
-open M
-
-
-let rec sig_of_cone = function
- | Mc.S_In n -> [CoqToCaml.nat n]
- | Mc.S_Ideal(e,w) -> sig_of_cone w
- | Mc.S_Mult(w1,w2) ->
-    (sig_of_cone w1)@(sig_of_cone w2)
- | Mc.S_Add(w1,w2) -> 	(sig_of_cone w1)@(sig_of_cone w2)
- | _  -> []
-
-let same_proof sg cl1 cl2 =
- let cl1 = CoqToCaml.list (fun x -> x) cl1 in
- let cl2 = CoqToCaml.list (fun x -> x) cl2 in
- let rec xsame_proof sg = 
-  match sg with
-   | [] -> true
-   | n::sg -> (try List.nth cl1 n = List.nth cl2 n with _ -> false) 
-      && (xsame_proof sg ) in
-  xsame_proof sg
-
-
-
-
-let tags_of_clause tgs wit clause = 
- let rec xtags tgs = function
-  | Mc.S_In n -> Names.Idset.union tgs  
-     (snd (List.nth clause (CoqToCaml.nat n) ))
-  | Mc.S_Ideal(e,w) -> xtags tgs w
-  | Mc.S_Mult (w1,w2) | Mc.S_Add(w1,w2) -> xtags (xtags tgs w1) w2
-  |   _   -> tgs in
-  xtags tgs wit
-
-let tags_of_cnf wits cnf = 
- List.fold_left2 (fun acc w cl -> tags_of_clause acc w cl) 
-  Names.Idset.empty wits cnf
-
-
-let find_witness prover  polys1 =
- let l = CoqToCaml.list (fun x -> x) polys1 in
-  try_any prover l
-
-let rec witness prover   l1 l2 = 
- match l2 with
-  | Micromega.Nil -> Some (Micromega.Nil)
-  | Micromega.Cons(e,l2) -> 
-     match find_witness prover   (Micromega.Cons( e,l1)) with
-      | None -> None
-      | Some w -> 
-	 (match witness prover   l1 l2 with
-	  | None -> None
-	  | Some l -> Some (Micromega.Cons (w,l))
-	 )
-
-
-let rec apply_ids t ids = 
- match ids with
-  | [] -> t
-  | i::ids -> apply_ids (Term.mkApp(t,[| Term.mkVar i |])) ids
-
-     
-let coq_Node = lazy 
- (Coqlib.gen_constant_in_modules "VarMap" 
-   [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "Node")
-let coq_Leaf = lazy 
- (Coqlib.gen_constant_in_modules "VarMap" 
-   [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "Leaf")
-let coq_Empty = lazy 
- (Coqlib.gen_constant_in_modules "VarMap" 
-   [["Coq" ; "micromega" ;"VarMap"];["VarMap"]] "Empty")
- 
- 
-let btree_of_array typ a  =
- let size_of_a = Array.length a in
- let semi_size_of_a = size_of_a lsr 1 in
- let node = Lazy.force coq_Node
- and leaf = Lazy.force coq_Leaf
- and empty = Term.mkApp (Lazy.force coq_Empty, [| typ |]) in
- let rec aux n =
-  if n > size_of_a 
-  then empty
-  else if  n > semi_size_of_a 
-  then Term.mkApp (leaf, [| typ; a.(n-1) |])
-  else Term.mkApp (node, [| typ; aux (2*n); a.(n-1); aux (2*n+1) |])
- in 
-  aux 1
-
-let btree_of_array typ a = 
- try 
-  btree_of_array typ a
- with x -> 
-  failwith (Printf.sprintf "btree of array : %s" (Printexc.to_string x))
-
-let dump_varmap typ env =
- btree_of_array typ (Array.of_list env)
-
-
-let rec pp_varmap o vm = 
- match vm with
-  | Mc.Empty -> output_string o "[]"
-  | Mc.Leaf z -> Printf.fprintf o "[%a]" pp_z  z
-  | Mc.Node(l,z,r) -> Printf.fprintf o "[%a, %a, %a]" pp_varmap l  pp_z z pp_varmap r
-
-
-
-let rec dump_proof_term = function 
- | Micromega.RatProof cone -> 
-    Term.mkApp(Lazy.force coq_ratProof, [|dump_cone coq_Z dump_z cone|])
- | Micromega.CutProof(e,q,cone,prf) ->
-    Term.mkApp(Lazy.force coq_cutProof, 
-	      [| dump_expr (Lazy.force coq_Z) dump_z e ; 
-		 dump_q q ; 
-		 dump_cone coq_Z dump_z cone ; 
-		 dump_proof_term prf|])
- | Micromega.EnumProof( q1,e1,q2,c1,c2,prfs) -> 
-    Term.mkApp (Lazy.force coq_enumProof,
-	       [| dump_q q1 ; dump_expr (Lazy.force coq_Z) dump_z e1 ; dump_q q2;
-		  dump_cone coq_Z dump_z c1 ; dump_cone coq_Z dump_z c2 ; 
-		  dump_list (Lazy.force coq_proofTerm) dump_proof_term prfs |])
-
-let pp_q o q = Printf.fprintf o "%a/%a" pp_z q.Micromega.qnum pp_positive q.Micromega.qden
- 
- 
-let rec pp_proof_term o = function
- | Micromega.RatProof cone -> Printf.fprintf o "R[%a]" (pp_cone pp_z) cone
- | Micromega.CutProof(e,q,_,p) -> failwith "not implemented"
- | Micromega.EnumProof(q1,e1,q2,c1,c2,rst) -> 
-    Printf.fprintf o "EP[%a,%a,%a,%a,%a,%a]" 
-     pp_q q1 pp_expr e1 pp_q q2 (pp_cone pp_z) c1 (pp_cone pp_z) c2 
-     (pp_list "[" "]" pp_proof_term) rst
-
-let rec parse_hyps parse_arith env hyps =
- match hyps with
-  | [] -> ([],env)
-  | (i,t)::l -> 
-     let (lhyps,env) = parse_hyps parse_arith env l in
-      try 
-       let (c,env) = parse_formula parse_arith env  t in
-	((i,c)::lhyps, env)
-      with _ -> 		(lhyps,env)
-       (*(if debug then Printf.printf "parse_arith : %s\n" x);*)
-
-
-exception ParseError
-
-let parse_goal parse_arith env hyps term = 
- (*  try*)
- let (f,env) = parse_formula parse_arith env term in
- let (lhyps,env) = parse_hyps parse_arith env hyps in
-  (lhyps,f,env)
-   (*  with Failure x -> raise ParseError*)
-
-
-type ('a, 'b) domain_spec = { 
- typ : Term.constr; (* Z, Q , R *)
- coeff : Term.constr ; (* Z, Q *)
- dump_coeff : 'a -> Term.constr ; 
- proof_typ : Term.constr ; 
- dump_proof : 'b -> Term.constr
-}
-
-let zz_domain_spec  = lazy {
- typ = Lazy.force coq_Z;
- coeff = Lazy.force coq_Z;
- dump_coeff = dump_z ;
- proof_typ = Lazy.force coq_proofTerm ;
- dump_proof = dump_proof_term
-}
-
-let qq_domain_spec  = lazy {
- typ = Lazy.force coq_Q;
- coeff = Lazy.force coq_Q;
- dump_coeff = dump_q ;
- proof_typ = Lazy.force coq_QWitness ;
- dump_proof = dump_cone coq_Q dump_q
-}
-
-let rz_domain_spec = lazy {
- typ = Lazy.force coq_R;
- coeff = Lazy.force coq_Z;
- dump_coeff = dump_z;
- proof_typ = Lazy.force coq_ZWitness ;
- dump_proof = dump_cone coq_Z dump_z
-}
-
-
-
-
-let micromega_order_change spec cert cert_typ env  ff gl = 
- let formula_typ = (Term.mkApp( Lazy.force coq_Cstr,[|  spec.coeff|])) in
-
- let ff = dump_formula formula_typ (dump_cstr spec.coeff spec.dump_coeff) ff in
- let vm  = dump_varmap  ( spec.typ)  env in
-  Tactics.change_in_concl None
-   (set 
-     [ 
-      ("__ff", ff, Term.mkApp(Lazy.force coq_Formula ,[| formula_typ |]));
-      ("__varmap", vm , Term.mkApp 
-       (Coqlib.gen_constant_in_modules "VarMap" 
-	 [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "t", [|  spec.typ|]));
-      ("__wit", cert,cert_typ)
-     ]  	
-     (Tacmach.pf_concl gl )
-
-       )
-   gl 
-   
-
-let detect_duplicates cnf wit = 
- let cnf = CoqToCaml.list (fun x -> x) cnf in
- let wit = CoqToCaml.list (fun x -> x) wit in
-
- let rec xdup cnf wit = 
-  match wit with
-   | [] -> []
-   | w :: wit -> 
-      let sg = sig_of_cone w in
-       match cnf with
-	| [] -> []
-	| e::cnf -> 
-	   let (dups,cnf) = (List.partition (fun x -> same_proof sg e x) cnf) in
-	    dups@(xdup cnf wit) in
-  xdup cnf wit
-
-let find_witness prover    polys1 =
- try_any prover polys1
-
-
-let witness_list_with_tags prover l = 
- 
- let rec xwitness_list l = 
-  match l with
-   | [] -> Some([])
-   | e::l -> 
-      match find_witness prover  (List.map fst e)  with
-       | None -> None
-       | Some w -> 
-	  (match xwitness_list l with
-	   | None -> None
-	   | Some l -> Some (w::l)
-	  ) in
-  xwitness_list l
-
-let witness_list_without_tags prover l = 
- 
- let rec xwitness_list l = 
-  match l with
-   | [] -> Some([])
-   | e::l -> 
-      match find_witness prover e  with
-       | None -> None
-       | Some w -> 
-	  (match xwitness_list l with
-	   | None -> None
-	   | Some l -> Some (w::l)
-	  ) in
-  xwitness_list l
-
-let witness_list prover l = 
- let rec xwitness_list l = 
-  match l with
-   | Micromega.Nil -> Some(Micromega.Nil)
-   | Micromega.Cons(e,l) -> 
-      match find_witness prover e  with
-       | None -> None
-       | Some w -> 
-	  (match xwitness_list l with
-	   | None -> None
-	   | Some l -> Some (Micromega.Cons(w,l))
-	  ) in
-  xwitness_list l
-
-
-
-
-let is_singleton = function [] -> true | [e] -> true | _ -> false
- 
-
-let micromega_tauto negate normalise spec prover env polys1 polys2  gl = 
- let spec = Lazy.force spec in 
- let (ff,ids) = 
-  List.fold_right 
-   (fun (id,f)  (cc,ids) -> 
-    match f with 
-      X _ -> (cc,ids) 
-     | _ -> (I(tag_formula (Names.Name id) f,cc,none), id::ids)) 
-   polys1 (polys2,[]) in
-
- let cnf_ff = cnf negate normalise ff in
-
-  if debug then 
-   (Pp.pp (Pp.str "Formula....\n") ;
-     let formula_typ = (Term.mkApp( Lazy.force coq_Cstr,[| spec.coeff|])) in
-     let ff = dump_formula formula_typ 
-      (dump_cstr spec.typ spec.dump_coeff) ff in
-      Pp.pp (Printer.prterm  ff) ;  Pp.pp_flush ()) ;
-
-   match witness_list_without_tags prover  cnf_ff with
-    | None -> Tacticals.tclFAIL 0 (Pp.str "Cannot find witness") gl
-    | Some res -> (*Printf.printf "\nList %i" (List.length res); *)
-       let (ff,res,ids) = (ff,res,List.map Term.mkVar ids) in
-       let res' = dump_ml_list (spec.proof_typ) spec.dump_proof  res in
-	(Tacticals.tclTHENSEQ
-	  [
-	   Tactics.generalize ids;
-	   micromega_order_change spec res' 
-	    (Term.mkApp(Lazy.force coq_list,[|  spec.proof_typ|]))  env  ff ;
-	   ]) gl
-
-
-let micromega_gen parse_arith negate normalise spec  prover   gl =
- let concl = Tacmach.pf_concl gl in
- let hyps  = Tacmach.pf_hyps_types gl in
-  try
-   let (hyps,concl,env) = parse_goal parse_arith Env.empty hyps concl in
-   let env = Env.elements env in
-    micromega_tauto negate normalise spec prover env hyps concl gl
-  with 
-   | Failure x -> flush stdout ; Pp.pp_flush () ; 
-      Tacticals.tclFAIL 0 (Pp.str x) gl
-   | ParseError  -> Tacticals.tclFAIL 0 (Pp.str "Bad logical fragment") gl
-
-
-let lift_ratproof prover l =
- match prover l with
-  | None -> None
-  | Some c -> Some (Mc.RatProof c)
-
-
-type csdpcert = Sos.positivstellensatz option
-type micromega_polys = (Micromega.q Mc.pExpr, Mc.op1) Micromega.prod list
-type provername = string * int option
-
-let call_csdpcert provername poly =
-  let tmp_to,ch_to = Filename.open_temp_file "csdpcert" ".in" in
-  let tmp_from = Filename.temp_file "csdpcert" ".out" in
-  output_value ch_to (provername,poly : provername * micromega_polys);
-  close_out ch_to;
-  let cmdname =
-    List.fold_left Filename.concat (Envars.coqlib ())
-      ["contrib"; "micromega"; "csdpcert" ^ Coq_config.exec_extension] in
-  let c = Sys.command (cmdname ^" "^ tmp_to ^" "^ tmp_from) in
-  (try Sys.remove tmp_to with _ -> ());
-  if c <> 0 then Util.error ("Failed to call csdp certificate generator");
-  let ch_from = open_in tmp_from in
-  let cert = (input_value ch_from : csdpcert) in
-  close_in ch_from; Sys.remove tmp_from;
-  cert
-
-let rec z_to_q_expr e = 
- match e with
-  | Mc.PEc z   -> Mc.PEc {Mc.qnum = z ; Mc.qden = Mc.XH}
-  | Mc.PEX x   -> Mc.PEX x
-  | Mc.PEadd(e1,e2) -> Mc.PEadd(z_to_q_expr e1, z_to_q_expr e2)
-  | Mc.PEsub(e1,e2) -> Mc.PEsub(z_to_q_expr e1, z_to_q_expr e2)
-  | Mc.PEmul(e1,e2) -> Mc.PEmul(z_to_q_expr e1, z_to_q_expr e2)
-  | Mc.PEopp(e) -> Mc.PEopp(z_to_q_expr e)
-  | Mc.PEpow(e,n) -> Mc.PEpow(z_to_q_expr e,n)
-
-
-let call_csdpcert_q provername poly = 
- match call_csdpcert provername poly with
-  | None -> None
-  | Some cert -> 
-     let cert = Certificate.q_cert_of_pos cert in
-      match Mc.qWeakChecker (CamlToCoq.list (fun x -> x) poly)  cert with
-       | Mc.True -> Some cert
-       | Mc.False ->  (print_string "buggy certificate" ; flush stdout) ;None
-
-
-let call_csdpcert_z provername poly = 
- let l = List.map (fun (Mc.Pair(e,o)) -> (Mc.Pair(z_to_q_expr e,o))) poly in
-  match call_csdpcert provername l with
-   | None -> None
-   | Some cert -> 
-      let cert = Certificate.z_cert_of_pos cert in
-       match Mc.zWeakChecker (CamlToCoq.list (fun x -> x) poly)  cert with
-	| Mc.True -> Some cert
-	| Mc.False ->  (print_string "buggy certificate" ; flush stdout) ;None
-
-
-
-
-let psatzl_Z gl = 
- micromega_gen parse_zarith  Mc.negate Mc.normalise zz_domain_spec
-  [lift_ratproof 
-    (Certificate.linear_prover Certificate.z_spec), "fourier refutation" ] gl
-
-
-let psatzl_Q gl = 
- micromega_gen  parse_qarith Mc.cnf_negate Mc.cnf_normalise qq_domain_spec 
-  [ Certificate.linear_prover Certificate.q_spec, "fourier refutation" ]   gl
-
-let psatz_Q i gl = 
- micromega_gen parse_qarith Mc.cnf_negate Mc.cnf_normalise qq_domain_spec
-  [ call_csdpcert_q ("real_nonlinear_prover", Some i), "fourier refutation" ]  gl
-
-let psatzl_R gl = 
- micromega_gen  parse_rarith Mc.cnf_negate Mc.cnf_normalise rz_domain_spec 
-  [ Certificate.linear_prover Certificate.z_spec, "fourier refutation" ]   gl
-
-
-let psatz_R i gl = 
- micromega_gen parse_rarith Mc.cnf_negate Mc.cnf_normalise rz_domain_spec
-  [ call_csdpcert_z  ("real_nonlinear_prover", Some i), "fourier refutation" ]  gl
-
-  
-let psatz_Z i gl = 
- micromega_gen parse_zarith Mc.negate Mc.normalise zz_domain_spec 
- [lift_ratproof (call_csdpcert_z ("real_nonlinear_prover",Some i)), 
-  "fourier refutation" ] gl
-
-
-let sos_Z gl = 
- micromega_gen parse_zarith Mc.negate Mc.normalise  zz_domain_spec 
-  [lift_ratproof (call_csdpcert_z ("pure_sos", None)), "pure sos refutation"]  gl
-
-let sos_Q gl = 
- micromega_gen parse_qarith Mc.cnf_negate Mc.cnf_normalise  qq_domain_spec 
-  [call_csdpcert_q ("pure_sos", None), "pure sos refutation"]  gl
-
-let sos_R gl = 
- micromega_gen parse_rarith Mc.cnf_negate Mc.cnf_normalise  rz_domain_spec 
-  [call_csdpcert_z ("pure_sos", None), "pure sos refutation"]  gl
-
-
-
-let xlia gl = 
- micromega_gen parse_zarith Mc.negate Mc.normalise   zz_domain_spec 
-  [Certificate.zlinear_prover, "zprover"] gl
diff --git a/contrib/micromega/csdpcert.ml b/contrib/micromega/csdpcert.ml
deleted file mode 100644
index e451a38f..00000000
--- a/contrib/micromega/csdpcert.ml
+++ /dev/null
@@ -1,197 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-open Big_int
-open Num
-open Sos
-
-module Mc = Micromega
-module Ml2C = Mutils.CamlToCoq
-module C2Ml = Mutils.CoqToCaml
-
-let debug = false
-
-module M =
-struct
- open Mc
-
- let rec expr_to_term = function
-  |  PEc z ->  Const  (C2Ml.q_to_num z)
-  |  PEX v ->  Var ("x"^(string_of_int (C2Ml.index v)))
-  |  PEmul(p1,p2) -> 
-      let p1 = expr_to_term p1 in
-      let p2 = expr_to_term p2 in
-      let res = Mul(p1,p2) in 	   res
-
-  | PEadd(p1,p2) -> Add(expr_to_term p1, expr_to_term p2)
-  | PEsub(p1,p2) -> Sub(expr_to_term p1, expr_to_term p2)
-  | PEpow(p,n)   -> Pow(expr_to_term p , C2Ml.n n)
-  |  PEopp p ->  Opp (expr_to_term p)
-
-      
-
-
-(* let term_to_expr e =
-  let e' = term_to_expr e in
-   if debug 
-   then Printf.printf "term_to_expr : %s - %s\n"  
-    (string_of_poly (poly_of_term  e)) 
-    (string_of_poly (poly_of_term (expr_to_term e')));
-   e' *)
-
-end 
-open M      
-
-open List
-open Mutils 
-
-
-
-
-let rec canonical_sum_to_string = function s -> failwith "not implemented"
-
-let print_canonical_sum m = Format.print_string (canonical_sum_to_string m)
-
-let print_list_term l = 
- print_string "print_list_term\n";
- List.iter (fun (Mc.Pair(e,k)) -> Printf.printf "q: %s %s ;" 
-  (string_of_poly (poly_of_term (expr_to_term e))) 
-  (match k with 
-    Mc.Equal -> "= " 
-   | Mc.Strict -> "> " 
-   | Mc.NonStrict -> ">= " 
-   | _ -> failwith "not_implemented")) l ;
- print_string "\n"
-
-
-let partition_expr l = 
- let rec f i = function
-  | [] -> ([],[],[])
-  | Mc.Pair(e,k)::l -> 
-     let (eq,ge,neq) = f (i+1) l in
-      match k with 
-       | Mc.Equal -> ((e,i)::eq,ge,neq)
-       | Mc.NonStrict -> (eq,(e,Axiom_le i)::ge,neq)
-       | Mc.Strict    -> (* e > 0 == e >= 0 /\ e <> 0 *) 
-	  (eq, (e,Axiom_lt i)::ge,(e,Axiom_lt i)::neq)
-       | Mc.NonEqual -> (eq,ge,(e,Axiom_eq i)::neq) 
-	  (* Not quite sure -- Coq interface has changed *)
- in f 0 l
-
-
-let rec sets_of_list l =
- match l with
-  | [] -> [[]]
-  | e::l -> let s = sets_of_list l in
-	     s@(List.map (fun s0 -> e::s0) s) 
-
-(* The exploration is probably not complete - for simple cases, it works... *)
-let real_nonlinear_prover d l =
- try 
-  let (eq,ge,neq) = partition_expr l in
-
-  let rec elim_const  = function
-    [] ->  []
-   | (x,y)::l -> let p = poly_of_term (expr_to_term x) in
-		  if poly_isconst p 
-		  then elim_const l 
-		  else (p,y)::(elim_const l) in
-
-  let eq = elim_const eq in
-  let peq = List.map  fst eq in
-   
-  let pge = List.map 
-   (fun (e,psatz) -> poly_of_term (expr_to_term e),psatz) ge in
-   
-  let monoids = List.map (fun m ->  (List.fold_right (fun (p,kd) y -> 
-   let p = poly_of_term (expr_to_term p) in
-    match kd with
-     | Axiom_lt i -> poly_mul p y
-     | Axiom_eq i -> poly_mul (poly_pow p 2) y
-     |   _        -> failwith "monoids") m (poly_const (Int 1)) , map  snd m))
-   (sets_of_list neq) in
-
-  let (cert_ideal, cert_cone,monoid) = deepen_until d (fun d -> 
-   list_try_find (fun m -> let (ci,cc) = 
-    real_positivnullstellensatz_general false d peq pge (poly_neg (fst m) ) in
-		      (ci,cc,snd m)) monoids) 0 in
-   
-  let proofs_ideal = map2 (fun q i -> Eqmul(term_of_poly q,Axiom_eq i))  
-   cert_ideal (List.map snd eq) in
-
-  let proofs_cone = map term_of_sos cert_cone in
-   
-  let proof_ne =  
-   let (neq , lt) = List.partition 
-    (function  Axiom_eq _ -> true | _ -> false ) monoid in
-   let sq = match 
-     (List.map (function Axiom_eq i -> i | _ -> failwith "error") neq) 
-    with
-    | []  -> Rational_lt (Int 1)
-    | l   -> Monoid l in
-    List.fold_right (fun x y -> Product(x,y)) lt sq in
-
-  let proof = list_fold_right_elements 
-   (fun s t -> Sum(s,t)) (proof_ne :: proofs_ideal @ proofs_cone) in
-   Some proof
- with 
-  | Sos.TooDeep -> None
-
-
-(* This is somewhat buggy, over Z, strict inequality vanish... *)
-let pure_sos  l =
- (* If there is no strict inequality, 
-    I should nonetheless be able to try something - over Z  > is equivalent to -1  >= *)
- try 
-  let l = List.combine l (interval 0 (length l -1)) in
-  let (lt,i) =  try (List.find (fun (x,_) -> snd' x =  Mc.Strict) l) 
-   with Not_found -> List.hd l in
-  let plt = poly_neg (poly_of_term (expr_to_term (fst' lt))) in
-  let (n,polys) = sumofsquares plt in (* n * (ci * pi^2) *)
-  let pos = Product (Rational_lt n, 
-		    List.fold_right (fun (c,p) rst -> Sum (Product (Rational_lt c, Square
-		     (term_of_poly p)), rst)) 
-		     polys (Rational_lt (Int 0))) in
-  let proof = Sum(Axiom_lt i, pos) in
-(*  let s,proof' = scale_certificate proof in
-  let cert  = snd (cert_of_pos proof') in *)
-   Some proof
- with
-  | Not_found -> (* This is no strict inequality *) None
-  |  x        -> None
-
-
-type micromega_polys = (Micromega.q Mc.pExpr, Mc.op1) Micromega.prod list
-type csdp_certificate = Sos.positivstellensatz option
-type provername = string * int option
-
-let main () =
-  if Array.length Sys.argv <> 3 then
-    (Printf.printf "Usage: csdpcert inputfile outputfile\n"; exit 1);
-  let input_file = Sys.argv.(1) in
-  let output_file = Sys.argv.(2) in
-  let inch = open_in input_file in
-  let (prover,poly) = (input_value inch : provername * micromega_polys) in
-  close_in inch;
-  let cert =
-    match prover with
-    | "real_nonlinear_prover", Some d -> real_nonlinear_prover d poly
-    | "pure_sos", None -> pure_sos poly
-    | prover, _ -> (Printf.printf "unknown prover: %s\n" prover; exit 1) in
-  let outch = open_out output_file in
-  output_value outch (cert:csdp_certificate);
-  close_out outch;
-  exit 0;;
-
-let _ = main () in ()
diff --git a/contrib/micromega/g_micromega.ml4 b/contrib/micromega/g_micromega.ml4
deleted file mode 100644
index 50024e78..00000000
--- a/contrib/micromega/g_micromega.ml4
+++ /dev/null
@@ -1,74 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008			        *)
-(*                                                                      *)
-(************************************************************************)
-
-(*i camlp4deps: "parsing/grammar.cma" i*)
-
-(* $Id: g_micromega.ml4 11306 2008-08-05 16:51:08Z notin $ *)
-
-open Quote
-open Ring
-open Mutils
-open Rawterm
-open Util
-
-let out_arg = function
-  | ArgVar _ -> anomaly "Unevaluated or_var variable"
-  | ArgArg x -> x
-
-TACTIC EXTEND PsatzZ
-| [ "psatz_Z" int_or_var(i) ] -> [ Coq_micromega.psatz_Z (out_arg i) ]
-| [ "psatz_Z" ] -> [ Coq_micromega.psatz_Z (-1) ]
-END
-
-TACTIC EXTEND Sos_Z
-| [ "sos_Z" ] -> [ Coq_micromega.sos_Z]
-   END
-
-TACTIC EXTEND Sos_Q
-| [ "sos_Q" ] -> [ Coq_micromega.sos_Q]
-   END
-
-TACTIC EXTEND Sos_R
-| [ "sos_R" ] -> [ Coq_micromega.sos_R]
-END
-
-
-TACTIC EXTEND Omicron
-[ "psatzl_Z"  ] -> [ Coq_micromega.psatzl_Z]
-END
-
-TACTIC EXTEND QOmicron
-[ "psatzl_Q"  ] -> [ Coq_micromega.psatzl_Q]
-END
-
-
-TACTIC EXTEND ZOmicron
-[ "xlia"  ] -> [ Coq_micromega.xlia]
-END
-
-TACTIC EXTEND ROmicron
-[ "psatzl_R"  ] -> [ Coq_micromega.psatzl_R]
-END
-
-TACTIC EXTEND RMicromega
-| [ "psatz_R" int_or_var(i) ] -> [ Coq_micromega.psatz_R (out_arg i) ]
-| [ "psatz_R" ] -> [ Coq_micromega.psatz_R (-1) ]
-END
-
-
-TACTIC EXTEND QMicromega
-| [ "psatz_Q" int_or_var(i) ] -> [ Coq_micromega.psatz_Q (out_arg i) ]
-| [ "psatz_Q" ] -> [ Coq_micromega.psatz_Q (-1) ]
-END
-
diff --git a/contrib/micromega/mfourier.ml b/contrib/micromega/mfourier.ml
deleted file mode 100644
index 415d3a3e..00000000
--- a/contrib/micromega/mfourier.ml
+++ /dev/null
@@ -1,667 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-(* Yet another implementation of Fourier *)
-open Num
-
-module Cmp =
- (* How to compare pairs, lists ... *)
-struct
- let rec compare_lexical l = 
-  match l with
-   | [] -> 0 (* Equal *)
-   | f::l -> 
-      let cmp = f () in
-       if cmp = 0 	then  compare_lexical l else cmp
-	
- let rec compare_list cmp l1 l2 = 
-  match l1 , l2 with
-   | []  , [] -> 0
-   | []  , _  -> -1
-   | _   , [] -> 1
-   | e1::l1 , e2::l2 -> 
-      let c = cmp e1 e2 in
-       if c = 0 then compare_list cmp l1 l2 else c
-	
- let hash_list hash l = 
-  let rec xhash res l = 
-   match l with
-    | []  -> res 
-    | e::l -> xhash ((hash e)  lxor res) l in
-   xhash  (Hashtbl.hash []) l
-
-end
- 
-module Interval = 
-struct
- (** The type of intervals.  **)
- type intrvl = Empty | Point of num | Itv  of  num option * num option
-  
- (**
-    Different intervals can denote the same set of variables e.g., 
-    Point n && Itv (Some n, Some n)
-    Itv (Some x) (Some y) && Empty if x > y
-    see the 'belongs_to' function.
- **)
-
- (* The set of numerics that belong to an interval *)
- let belongs_to n = function
-  | Empty -> false
-  | Point x -> n =/ x
-  | Itv(Some x, Some y) -> x <=/ n && n <=/ y
-  | Itv(None,Some y) -> n <=/ y
-  | Itv(Some x,None) -> x <=/ n
-  | Itv(None,None) -> true
-
- let string_of_bound = function
-  | None -> "oo"
-  | Some n -> Printf.sprintf "Bd(%s)"  (string_of_num n)
-
- let string_of_intrvl = function
-  | Empty -> "[]"
-  | Point n -> Printf.sprintf "[%s]" (string_of_num n)
-  | Itv(bd1,bd2) -> 
-     Printf.sprintf "[%s,%s]" (string_of_bound bd1) (string_of_bound bd2)
-
- let pick_closed_to_zero = function
-  | Empty -> None
-  | Point n -> Some n
-  | Itv(None,None) -> Some (Int 0)
-  | Itv(None,Some i) -> 
-     Some (if  (Int 0) <=/ (floor_num  i) then Int 0 else floor_num i)
-  | Itv(Some i,None) -> 
-     Some (if i <=/ (Int 0) then Int 0 else ceiling_num i)
-  | Itv(Some i,Some j) -> 
-     Some (
-      if i <=/ Int 0 && Int 0 <=/ j 
-      then Int 0
-      else if ceiling_num i <=/ floor_num j 
-      then ceiling_num i (* why not *) else i)
-
- type status = 
-   | O | Qonly | Z | Q 
-       
- let interval_kind = function
-  | Empty -> O
-  | Point n -> if ceiling_num n =/ n then Z else Qonly
-  | Itv(None,None) -> Z
-  | Itv(None,Some i) -> if ceiling_num i <>/ i then Q else Z
-  | Itv(Some i,None) -> if ceiling_num i <>/ i then Q else Z
-  | Itv(Some i,Some j) -> 
-     if ceiling_num i <>/ i or floor_num j <>/ j then Q else Z
-
- let empty_z = function
-  | Empty -> true
-  | Point n ->  ceiling_num n <>/ n 
-  | Itv(None,None) | Itv(None,Some _) | Itv(Some _,None) -> false
-  | Itv(Some i,Some j) -> ceiling_num i >/ floor_num j
-
-
- let normalise b1 b2 =
-  match b1 , b2 with
-   | Some i , Some j -> 
-      (match compare_num i j with
-       | 1 -> Empty
-       | 0 -> Point i
-       | _ -> Itv(b1,b2)
-      )
-   |  _ -> Itv(b1,b2)
-
-       
-
- let min x y = 
-  match x , y with
-   | None , x | x , None -> x
-   | Some i , Some j -> Some (min_num i j)
-      
- let max x y = 
-  match x , y with
-   | None , x | x , None -> x
-   | Some i , Some j -> Some (max_num i j)
-
- let inter i1 i2 = 
-  match i1,i2 with
-   | Empty , _ -> Empty
-   |  _   , Empty -> Empty
-   |  Point n , Point m -> if n =/ m then i1 else Empty
-   | Point n , Itv (mn,mx) | Itv (mn,mx) , Point n-> 
-      if (match mn with 
-       | None -> true
-       | Some mn ->  mn <=/ n) && 
-       (match mx with 
-	| None -> true
-	| Some mx ->  n <=/ mx) then Point n else Empty
-   | Itv (min1,max1) , Itv (min2,max2) -> 
-      let bmin = max min1 min2
-      and bmax = min max1 max2 in
-       normalise bmin bmax
-
- (* a.x >= b*)
- let bound_of_constraint (a,b) =
-  match compare_num a (Int 0) with
-   | 0 -> 
-      if compare_num b (Int 0) = 1
-      then Empty  
-       (*actually this is a contradiction  failwith "bound_of_constraint" *)
-      else Itv (None,None)
-   | 1 -> Itv (Some (div_num  b a),None)
-   | -1 -> Itv (None, Some (div_num  b a))
-   | x -> failwith "bound_of_constraint(2)"
-
-
- let bounded x = 
-  match x with
-   | Itv(None,_) | Itv(_,None) -> false
-   |   _   -> true
-
-
- let range = function
-  | Empty -> Some (Int 0)
-  | Point n -> Some (Int (if ceiling_num n =/ n then 1 else 0))
-  | Itv(None,_) | Itv(_,None)-> None
-  | Itv(Some i,Some j) -> Some (floor_num j -/ceiling_num i +/ (Int 1))
-
- (* Returns the interval of smallest range *)
- let smaller_itv i1 i2 = 
-  match range i1 , range i2  with
-   | None , _ -> false
-   |  _   , None -> true
-   | Some i , Some j -> i <=/ j
-
-end
-open Interval
-
-(* A set of constraints *)
-module Sys(V:Vector.S) (* : Vector.SystemS with module Vect = V*) = 
-struct
- 
- module Vect = V
-  
- module Cstr = Vector.Cstr(V)
- open Cstr
- 
- 
- module CMap = Map.Make(
-  struct
-   type t = Vect.t
-   let compare = Vect.compare
-  end)
-  
- module CstrBag = 
- struct 
-
-  type mut_itv = { mutable itv : intrvl} 
-
-  type t = mut_itv CMap.t
-    
-  exception Contradiction
-
-  let cstr_to_itv cstr = 
-   let (n,l) = V.normalise cstr.coeffs in 
-    if n =/ (Int 0)
-    then (Vect.null, bound_of_constraint (Int 0,cstr.cst)) (* Might be empty *)
-    else
-     match cstr.op with
-      | Eq -> let n = cstr.cst // n in (l, Point n)
-      | Ge -> 
-	 match  compare_num n (Int 0) with
-	  | 0 -> failwith "intrvl_of_constraint"
-	  | 1 -> (l,Itv (Some (cstr.cst // n), None))
-	  | -1 -> (l, Itv(None,Some (cstr.cst // n)))
-	  |  _ -> failwith "cstr_to_itv"
-
-	      
-  let empty = CMap.empty
-
-
-
-
-  let is_empty = CMap.is_empty
-
-  let find_vect v bag = 
-   try
-    (bag,CMap.find v bag) 
-   with Not_found -> let x = { itv = Itv(None,None)} in (CMap.add v x bag ,x)
-
-
-  let add (v,b) bag = 
-   match b with
-    | Empty -> raise Contradiction
-    | Itv(None,None) -> bag
-    | _    -> 
-       let (bag,intrl) = find_vect v bag in
-	match inter b intrl.itv with
-	 | Empty -> raise Contradiction
-	 |  itv  -> intrl.itv <- itv ; bag
-
-  exception Found of cstr
-
-  let find_equation bag = 
-   try 
-    CMap.fold (fun v i () -> 
-     match i.itv with
-      | Point n -> let e = {coeffs = v ; op = Eq ; cst = n} 
-	in 	raise	(Found e)
-      |    _    -> () ) bag () ; None
-   with Found c -> Some c
-
-    
-  let fold f bag acc = 
-   CMap.fold (fun v itv acc -> 
-    match itv.itv with
-     | Empty | Itv(None,None)  -> failwith "fold Empty"
-     | Itv(None ,Some i) -> 
-	f {coeffs = V.mul (Int (-1)) v ; op = Ge ; cst = minus_num i} acc
-     | Point n           ->   f {coeffs =  v ; op = Eq ; cst = n} acc
-     | Itv(x,y) -> 	
-	(match x with 
-	 | None -> (fun x -> x)
-	 | Some i -> f {coeffs = v ; op = Ge ; cst = i})
-	 (match y with
-	  | None -> acc
-	  | Some i -> 
-	     f {coeffs = V.mul (Int (-1)) v ; op = Ge ; cst = minus_num i} acc
-	 ) ) bag acc
-
-
-  let remove l _ = failwith "remove:Not implemented"
-   
-  module Map = 
-   Map.Make(
-    struct 
-     type t = int 
-     let compare : int -> int -> int = Pervasives.compare 
-    end)
-
-  let split f (t:t) =
-   let res = 
-    fold (fun e m -> let i = f e in
-                      Map.add i (add (cstr_to_itv e) 
-				  (try Map.find i m with 
-				    Not_found -> empty)) m) t Map.empty in
-    (fun i -> try Map.find i res with Not_found -> empty)
-     
-  type map = (int list * int list) Map.t
-    
-    
-  let status (b:t) = 
-   let _ , map = fold (fun c ( (idx:int),(res: map)) ->
-    ( idx + 1,
-    List.fold_left (fun (res:map) (pos,s) -> 
-     let (lp,ln) = try  Map.find pos res with Not_found -> ([],[]) in
-      match s with
-       | Vect.Pos -> Map.add pos (idx::lp,ln) res
-       | Vect.Neg -> 
-	  Map.add pos (lp, idx::ln) res) res 
-     (Vect.status c.coeffs))) b (0,Map.empty) in
-    Map.fold (fun k e res -> (k,e)::res)  map []
-     
-
-  type it = num CMap.t
-    
-  let iterator x = x
-   
-  let element it = failwith "element:Not implemented"
-
- end
-end
-
-module Fourier(Vect : Vector.S)  =
-struct
- module Vect = Vect
- module Sys = Sys( Vect)
- module Cstr = Sys.Cstr
- module Bag = Sys.CstrBag
-
- open Cstr
- open Sys
-
- let debug = false
-
- let print_bag msg b =
-  print_endline msg;
-  CstrBag.fold (fun e () -> print_endline (Cstr.string_of_cstr e)) b () 
-
- let print_bag_file file msg b =
-  let f = open_out file in
-   output_string f msg;
-   CstrBag.fold (fun e () -> 
-    Printf.fprintf f "%s\n" (Cstr.string_of_cstr e)) b () 
-
-    
- (* A system with only inequations --
- *)
- let partition i m =
-  let splitter cstr =  compare_num (Vect.get i cstr.coeffs ) (Int 0) in
-  let split = CstrBag.split splitter m in
-   (split (-1) , split 0, split 1)
-
-    
- (* op of the result is arbitrary Ge *) 
- let lin_comb n1 c1 n2 c2 =
-  { coeffs = Vect.lin_comb n1 c1.coeffs n2 c2.coeffs ; 
-    op = Ge ; 
-    cst = (n1 */ c1.cst) +/ (n2 */ c2.cst)}
-
- (* BUG? : operator of the result ? *)
-
- let combine_project i c1 c2 =
-  let p = Vect.get  i c1.coeffs  
-  and n = Vect.get i c2.coeffs  in 
-   assert (n </ Int 0 && p >/ Int 0) ;
-   let nopp = minus_num n in 
-   let c =lin_comb nopp c1 p c2  in
-   let op = if c1.op = Ge ||  c2.op = Ge then Ge else Eq in
-    CstrBag.cstr_to_itv {coeffs =  c.coeffs ; op = op ; cst= c.cst }
-
-
- let project i m =
-  let (neg,zero,pos) = partition i m in
-  let project1 cpos acc = 
-   CstrBag.fold (fun cneg res ->
-    CstrBag.add (combine_project i cpos cneg) res) neg acc in
-   (CstrBag.fold project1 pos zero)
-
- (* Given a vector [x1 -> v1; ... ; xn -> vn]
-    and a constraint {x1 ; .... xn >= c }
- *)
- let evaluate_constraint i map cstr =
-  let {coeffs = _coeffs ; op = _op ; cst = _cst} = cstr in
-  let vi = Vect.get  i _coeffs  in
-  let v = Vect.set i (Int 0) _coeffs in
-   (vi, _cst -/ Vect.dotp map v)
-
-
- let rec bounds m itv =
-  match m with
-   | [] -> itv
-   | e::m -> bounds m (inter itv (bound_of_constraint e))
-
-
-
- let compare_status (i,(lp,ln)) (i',(lp',ln')) = 
-  let cmp = Pervasives.compare 
-   ((List.length lp) * (List.length ln))  
-   ((List.length lp') * (List.length ln')) in
-   if cmp = 0
-   then Pervasives.compare i i'
-   else cmp
-
- let cardinal m = CstrBag.fold (fun _ x -> x + 1) m 0
-
- let lightest_projection  l c m  =
-  let bound = c in 
-   if debug then (Printf.printf "l%i" bound; flush stdout) ; 
-   let rec xlight best l =
-    match l with
-     | [] -> best
-     | i::l -> 
-	let proj = (project i m) in
-	let cproj = cardinal proj in
-	 (*Printf.printf " p %i " cproj; flush stdout;*)
-	 match best with
-	  | None -> 
-	     if cproj < bound 
-	     then Some(cproj,proj,i) 
-	     else xlight (Some(cproj,proj,i)) l
-	  | Some (cbest,_,_) -> 		
-	     if cproj < cbest 
-	     then 
-	      if cproj < bound then Some(cproj,proj,i)
-	      else xlight (Some(cproj,proj,i)) l 
-	     else xlight best l in
-    match xlight None l with
-     | None -> None
-     | Some(_,p,i) -> Some (p,i)
-	
-
-
- exception Equality of cstr
-
- let find_equality m = Bag.find_equation m
-
-  
-
- let pivot (n,v) eq ge =
-  assert (eq.op = Eq) ;
-  let res = 
-   match 
-    compare_num v (Int 0), 
-    compare_num (Vect.get n ge.coeffs) (Int 0) 
-   with
-    | 0 , _ -> failwith "Buggy"
-    | _ ,0  -> (CstrBag.cstr_to_itv ge)
-    | 1 , -1 -> combine_project n eq ge
-    | -1 , 1 -> combine_project n ge eq
-    | 1  , 1 -> 
-       combine_project n ge 
-	{coeffs = Vect.mul (Int (-1)) eq.coeffs; 
-	 op = eq.op ; 
-	 cst = minus_num eq.cst}
-    | -1 , -1 -> 
-       combine_project n 
-	{coeffs = Vect.mul (Int (-1)) eq.coeffs; 
-	 op = eq.op ; cst = minus_num eq.cst} ge
-    | _ -> failwith "pivot" in
-   res
-
- let check_cstr v c = 
-  let {coeffs = _coeffs ; op = _op ; cst = _cst} = c in
-  let vl = Vect.dotp v _coeffs in
-   match _op with
-    | Eq -> vl =/ _cst
-    | Ge -> vl >= _cst
-
-
- let forall p  sys = 
-  try 
-   CstrBag.fold (fun c () -> if p c then () else raise Not_found) sys (); true
-  with Not_found -> false
-
-
- let check_sys v sys = forall (check_cstr v) sys
-
- let check_null_cstr c = 
-  let {coeffs = _coeffs ; op = _op ; cst = _cst} = c in
-   match _op with
-    | Eq -> (Int 0) =/ _cst
-    | Ge -> (Int 0) >= _cst
-       
- let check_null sys = forall check_null_cstr sys
-
-
- let optimise_ge 
-   quick_check choose choose_idx return_empty return_ge return_eq  m =
-  let c = cardinal m in
-  let bound =  2 * c  in
-   if debug then (Printf.printf "optimise_ge: %i\n" c; flush stdout);
-
-   let rec xoptimise  m =
-    if debug then (Printf.printf "x%i" (cardinal m) ; flush stdout);
-    if debug then (print_bag "xoptimise" m ; flush stdout);
-    if quick_check m
-    then return_empty m
-    else 
-     match find_equality m with
-      | None -> xoptimise_ge m
-      | Some eq -> xoptimise_eq eq m
-	 
-   and xoptimise_ge m =
-    begin
-     let c = cardinal m in
-     let l = List.map fst (List.sort compare_status (CstrBag.status m)) in
-     let  idx = choose bound l c m in
-      match idx with
-       | None -> return_empty m
-       | Some (proj,i) -> 
-	  match xoptimise proj with
-	   | None -> None
-	   | Some mapping -> return_ge m i mapping
-    end
-   and xoptimise_eq eq m = 
-    let l = List.map fst (Vect.status eq.coeffs) in
-     match choose_idx l with
-      | None -> (*if l = [] then None else*) return_empty m
-      | Some i -> 
-	 let p  = (i,Vect.get i eq.coeffs) in
-	 let m' = CstrBag.fold 
-	  (fun ge res -> CstrBag.add (pivot p eq ge) res) m CstrBag.empty in
-	  match xoptimise ( m') with
-	   | None -> None
-	   | Some mapp -> return_eq m eq i mapp in
-    try 
-     let res = xoptimise   m  in res
-    with CstrBag.Contradiction -> (*print_string "contradiction" ;*) None
-
-
-
- let minimise m = 
-  let opt_zero_choose bound l c m = 
-   if c > bound 
-   then lightest_projection l c m
-   else match l with
-    | [] -> None
-    | i::_ -> Some (project i m, i) in
-   
-  let choose_idx = function [] -> None | x::l -> Some x in
-
-  let opt_zero_return_empty m = Some Vect.null in
-
-   
-  let opt_zero_return_ge m i mapping = 
-   let (it:intrvl) = CstrBag.fold (fun cstr itv -> Interval.inter 
-    (bound_of_constraint (evaluate_constraint i mapping cstr)) itv) m 
-    (Itv (None, None)) in
-    match pick_closed_to_zero it with
-     | None -> print_endline "Cannot pick" ; None
-     | Some v -> 
-	let res =  (Vect.set i v mapping) in
-	 if debug 
-	 then Printf.printf "xoptimise res %i [%s]" i (Vect.string res) ;
-	 Some res in
-
-  let opt_zero_return_eq m eq i mapp = 
-   let (a,b) = evaluate_constraint i mapp eq in
-    Some (Vect.set i (div_num b a) mapp) in
-   
-   optimise_ge check_null opt_zero_choose 
-    choose_idx opt_zero_return_empty opt_zero_return_ge opt_zero_return_eq   m
-
- let normalise cstr = [CstrBag.cstr_to_itv cstr]
-
- let find_point l = 
-  (*  List.iter (fun e -> print_endline (Cstr.string_of_cstr e)) l;*)
-  try 
-   let m = List.fold_left (fun sys e -> CstrBag.add (CstrBag.cstr_to_itv e) sys) 
-    CstrBag.empty l in
-    match minimise m with
-     | None -> None
-     | Some res -> 
-	if debug then Printf.printf "[%s]"  (Vect.string res); 
-	Some res
-  with CstrBag.Contradiction -> None
-
-
- let find_q_interval_for x m = 
-  if debug then Printf.printf "find_q_interval_for %i\n" x ;
-
-  let choose bound l c m =
-   let rec xchoose l = 
-    match l with
-     | [] -> None
-     | i::l -> if i = x then xchoose l else Some (project i m,i) in
-    xchoose l in
-
-  let rec choose_idx = function 
-    [] -> None 
-   | e::l -> if e = x then choose_idx l else Some e in
-
-  let return_empty m = (* Beurk *)
-   (* returns the interval of x *)
-   Some (CstrBag.fold (fun cstr itv -> 
-    let i = if cstr.op = Eq 
-    then Point (cstr.cst // Vect.get x cstr.coeffs)  
-     else if Vect.is_null (Vect.set x (Int 0) cstr.coeffs) 
-     then  bound_of_constraint (Vect.get x cstr.coeffs  , cstr.cst) 
-     else itv
-   in
-		       Interval.inter i itv) m (Itv (None, None)))  in
-   
-  let return_ge m i res = Some res in
-
-  let return_eq m eq i res = Some res in
-
-   try 
-    optimise_ge 
-     (fun x -> false) choose choose_idx return_empty return_ge return_eq m
-   with CstrBag.Contradiction -> None
-
-
- let find_q_intervals sys =
-  let variables =  
-   List.map fst (List.sort compare_status (CstrBag.status sys)) in
-   List.map (fun x -> (x,find_q_interval_for x sys)) variables
-
- let pp_option f o = function 
-   None -> Printf.fprintf o "None" 
-  | Some x -> Printf.fprintf o "Some %a" f x
-
- let optimise vect sys = 
-  (* we have to modify the system with a dummy variable *)
-  let fresh = 
-   List.fold_left (fun fr c -> Pervasives.max fr (Vect.fresh c.coeffs)) 0 sys in
-   assert (List.for_all (fun x -> Vect.get fresh x.coeffs =/ Int 0) sys);
-   let cstr = {
-    coeffs = Vect.set fresh (Int (-1)) vect ; 
-    op = Eq ; 
-    cst = (Int 0)} in
-    try 
-     find_q_interval_for fresh 
-      (List.fold_left 
-	(fun bg c -> CstrBag.add (CstrBag.cstr_to_itv c) bg)  
-	CstrBag.empty (cstr::sys))
-    with CstrBag.Contradiction -> None
-
-
- let optimise vect sys = 
-  let res = optimise vect sys in 
-   if debug 
-   then Printf.printf "optimise %s -> %a\n" 
-    (Vect.string vect) (pp_option (fun o x -> Printf.printf "%s" (string_of_intrvl x))) res  
-   ; res
-
- let find_Q_interval sys = 
-  try 
-   let sys = 
-    (List.fold_left 
-      (fun bg c -> CstrBag.add (CstrBag.cstr_to_itv c) bg)  CstrBag.empty sys) in
-   let candidates = 
-    List.fold_left 
-     (fun l (x,i) -> match i with 
-       None -> (x,Empty)::l 
-      | Some i ->  (x,i)::l) [] (find_q_intervals sys) in
-    match List.fold_left 
-     (fun (x1,i1) (x2,i2) -> 
-      if smaller_itv i1 i2 
-      then (x1,i1) else (x2,i2)) (-1,Itv(None,None)) candidates 
-    with
-     | (i,Empty) -> None
-     | (x,Itv(Some i, Some j))  -> Some(i,x,j)
-     | (x,Point n) -> Some(n,x,n)
-     |   _        -> None
-  with CstrBag.Contradiction -> None
-
-
-end
-
diff --git a/contrib/micromega/micromega.ml b/contrib/micromega/micromega.ml
deleted file mode 100644
index e151e4e1..00000000
--- a/contrib/micromega/micromega.ml
+++ /dev/null
@@ -1,1512 +0,0 @@
-type __ = Obj.t
-let __ = let rec f _ = Obj.repr f in Obj.repr f
-
-type bool =
-  | True
-  | False
-
-(** val negb : bool -> bool **)
-
-let negb = function
-  | True -> False
-  | False -> True
-
-type nat =
-  | O
-  | S of nat
-
-type 'a option =
-  | Some of 'a
-  | None
-
-type ('a, 'b) prod =
-  | Pair of 'a * 'b
-
-type comparison =
-  | Eq
-  | Lt
-  | Gt
-
-(** val compOpp : comparison -> comparison **)
-
-let compOpp = function
-  | Eq -> Eq
-  | Lt -> Gt
-  | Gt -> Lt
-
-type sumbool =
-  | Left
-  | Right
-
-type 'a sumor =
-  | Inleft of 'a
-  | Inright
-
-type 'a list =
-  | Nil
-  | Cons of 'a * 'a list
-
-(** val app : 'a1 list -> 'a1 list -> 'a1 list **)
-
-let rec app l m =
-  match l with
-    | Nil -> m
-    | Cons (a, l1) -> Cons (a, (app l1 m))
-
-(** val nth : nat -> 'a1 list -> 'a1 -> 'a1 **)
-
-let rec nth n0 l default =
-  match n0 with
-    | O -> (match l with
-              | Nil -> default
-              | Cons (x, l') -> x)
-    | S m ->
-        (match l with
-           | Nil -> default
-           | Cons (x, t0) -> nth m t0 default)
-
-(** val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list **)
-
-let rec map f = function
-  | Nil -> Nil
-  | Cons (a, t0) -> Cons ((f a), (map f t0))
-
-type positive =
-  | XI of positive
-  | XO of positive
-  | XH
-
-(** val psucc : positive -> positive **)
-
-let rec psucc = function
-  | XI p -> XO (psucc p)
-  | XO p -> XI p
-  | XH -> XO XH
-
-(** val pplus : positive -> positive -> positive **)
-
-let rec pplus x y =
-  match x with
-    | XI p ->
-        (match y with
-           | XI q0 -> XO (pplus_carry p q0)
-           | XO q0 -> XI (pplus p q0)
-           | XH -> XO (psucc p))
-    | XO p ->
-        (match y with
-           | XI q0 -> XI (pplus p q0)
-           | XO q0 -> XO (pplus p q0)
-           | XH -> XI p)
-    | XH ->
-        (match y with
-           | XI q0 -> XO (psucc q0)
-           | XO q0 -> XI q0
-           | XH -> XO XH)
-
-(** val pplus_carry : positive -> positive -> positive **)
-
-and pplus_carry x y =
-  match x with
-    | XI p ->
-        (match y with
-           | XI q0 -> XI (pplus_carry p q0)
-           | XO q0 -> XO (pplus_carry p q0)
-           | XH -> XI (psucc p))
-    | XO p ->
-        (match y with
-           | XI q0 -> XO (pplus_carry p q0)
-           | XO q0 -> XI (pplus p q0)
-           | XH -> XO (psucc p))
-    | XH ->
-        (match y with
-           | XI q0 -> XI (psucc q0)
-           | XO q0 -> XO (psucc q0)
-           | XH -> XI XH)
-
-(** val p_of_succ_nat : nat -> positive **)
-
-let rec p_of_succ_nat = function
-  | O -> XH
-  | S x -> psucc (p_of_succ_nat x)
-
-(** val pdouble_minus_one : positive -> positive **)
-
-let rec pdouble_minus_one = function
-  | XI p -> XI (XO p)
-  | XO p -> XI (pdouble_minus_one p)
-  | XH -> XH
-
-type positive_mask =
-  | IsNul
-  | IsPos of positive
-  | IsNeg
-
-(** val pdouble_plus_one_mask : positive_mask -> positive_mask **)
-
-let pdouble_plus_one_mask = function
-  | IsNul -> IsPos XH
-  | IsPos p -> IsPos (XI p)
-  | IsNeg -> IsNeg
-
-(** val pdouble_mask : positive_mask -> positive_mask **)
-
-let pdouble_mask = function
-  | IsNul -> IsNul
-  | IsPos p -> IsPos (XO p)
-  | IsNeg -> IsNeg
-
-(** val pdouble_minus_two : positive -> positive_mask **)
-
-let pdouble_minus_two = function
-  | XI p -> IsPos (XO (XO p))
-  | XO p -> IsPos (XO (pdouble_minus_one p))
-  | XH -> IsNul
-
-(** val pminus_mask : positive -> positive -> positive_mask **)
-
-let rec pminus_mask x y =
-  match x with
-    | XI p ->
-        (match y with
-           | XI q0 -> pdouble_mask (pminus_mask p q0)
-           | XO q0 -> pdouble_plus_one_mask (pminus_mask p q0)
-           | XH -> IsPos (XO p))
-    | XO p ->
-        (match y with
-           | XI q0 -> pdouble_plus_one_mask (pminus_mask_carry p q0)
-           | XO q0 -> pdouble_mask (pminus_mask p q0)
-           | XH -> IsPos (pdouble_minus_one p))
-    | XH -> (match y with
-               | XH -> IsNul
-               | _ -> IsNeg)
-
-(** val pminus_mask_carry : positive -> positive -> positive_mask **)
-
-and pminus_mask_carry x y =
-  match x with
-    | XI p ->
-        (match y with
-           | XI q0 -> pdouble_plus_one_mask (pminus_mask_carry p q0)
-           | XO q0 -> pdouble_mask (pminus_mask p q0)
-           | XH -> IsPos (pdouble_minus_one p))
-    | XO p ->
-        (match y with
-           | XI q0 -> pdouble_mask (pminus_mask_carry p q0)
-           | XO q0 -> pdouble_plus_one_mask (pminus_mask_carry p q0)
-           | XH -> pdouble_minus_two p)
-    | XH -> IsNeg
-
-(** val pminus : positive -> positive -> positive **)
-
-let pminus x y =
-  match pminus_mask x y with
-    | IsPos z0 -> z0
-    | _ -> XH
-
-(** val pmult : positive -> positive -> positive **)
-
-let rec pmult x y =
-  match x with
-    | XI p -> pplus y (XO (pmult p y))
-    | XO p -> XO (pmult p y)
-    | XH -> y
-
-(** val pcompare : positive -> positive -> comparison -> comparison **)
-
-let rec pcompare x y r =
-  match x with
-    | XI p ->
-        (match y with
-           | XI q0 -> pcompare p q0 r
-           | XO q0 -> pcompare p q0 Gt
-           | XH -> Gt)
-    | XO p ->
-        (match y with
-           | XI q0 -> pcompare p q0 Lt
-           | XO q0 -> pcompare p q0 r
-           | XH -> Gt)
-    | XH -> (match y with
-               | XH -> r
-               | _ -> Lt)
-
-type n =
-  | N0
-  | Npos of positive
-
-type z =
-  | Z0
-  | Zpos of positive
-  | Zneg of positive
-
-(** val zdouble_plus_one : z -> z **)
-
-let zdouble_plus_one = function
-  | Z0 -> Zpos XH
-  | Zpos p -> Zpos (XI p)
-  | Zneg p -> Zneg (pdouble_minus_one p)
-
-(** val zdouble_minus_one : z -> z **)
-
-let zdouble_minus_one = function
-  | Z0 -> Zneg XH
-  | Zpos p -> Zpos (pdouble_minus_one p)
-  | Zneg p -> Zneg (XI p)
-
-(** val zdouble : z -> z **)
-
-let zdouble = function
-  | Z0 -> Z0
-  | Zpos p -> Zpos (XO p)
-  | Zneg p -> Zneg (XO p)
-
-(** val zPminus : positive -> positive -> z **)
-
-let rec zPminus x y =
-  match x with
-    | XI p ->
-        (match y with
-           | XI q0 -> zdouble (zPminus p q0)
-           | XO q0 -> zdouble_plus_one (zPminus p q0)
-           | XH -> Zpos (XO p))
-    | XO p ->
-        (match y with
-           | XI q0 -> zdouble_minus_one (zPminus p q0)
-           | XO q0 -> zdouble (zPminus p q0)
-           | XH -> Zpos (pdouble_minus_one p))
-    | XH ->
-        (match y with
-           | XI q0 -> Zneg (XO q0)
-           | XO q0 -> Zneg (pdouble_minus_one q0)
-           | XH -> Z0)
-
-(** val zplus : z -> z -> z **)
-
-let zplus x y =
-  match x with
-    | Z0 -> y
-    | Zpos x' ->
-        (match y with
-           | Z0 -> Zpos x'
-           | Zpos y' -> Zpos (pplus x' y')
-           | Zneg y' ->
-               (match pcompare x' y' Eq with
-                  | Eq -> Z0
-                  | Lt -> Zneg (pminus y' x')
-                  | Gt -> Zpos (pminus x' y')))
-    | Zneg x' ->
-        (match y with
-           | Z0 -> Zneg x'
-           | Zpos y' ->
-               (match pcompare x' y' Eq with
-                  | Eq -> Z0
-                  | Lt -> Zpos (pminus y' x')
-                  | Gt -> Zneg (pminus x' y'))
-           | Zneg y' -> Zneg (pplus x' y'))
-
-(** val zopp : z -> z **)
-
-let zopp = function
-  | Z0 -> Z0
-  | Zpos x0 -> Zneg x0
-  | Zneg x0 -> Zpos x0
-
-(** val zminus : z -> z -> z **)
-
-let zminus m n0 =
-  zplus m (zopp n0)
-
-(** val zmult : z -> z -> z **)
-
-let zmult x y =
-  match x with
-    | Z0 -> Z0
-    | Zpos x' ->
-        (match y with
-           | Z0 -> Z0
-           | Zpos y' -> Zpos (pmult x' y')
-           | Zneg y' -> Zneg (pmult x' y'))
-    | Zneg x' ->
-        (match y with
-           | Z0 -> Z0
-           | Zpos y' -> Zneg (pmult x' y')
-           | Zneg y' -> Zpos (pmult x' y'))
-
-(** val zcompare : z -> z -> comparison **)
-
-let zcompare x y =
-  match x with
-    | Z0 -> (match y with
-               | Z0 -> Eq
-               | Zpos y' -> Lt
-               | Zneg y' -> Gt)
-    | Zpos x' -> (match y with
-                    | Zpos y' -> pcompare x' y' Eq
-                    | _ -> Gt)
-    | Zneg x' ->
-        (match y with
-           | Zneg y' -> compOpp (pcompare x' y' Eq)
-           | _ -> Lt)
-
-(** val dcompare_inf : comparison -> sumbool sumor **)
-
-let dcompare_inf = function
-  | Eq -> Inleft Left
-  | Lt -> Inleft Right
-  | Gt -> Inright
-
-(** val zcompare_rec :
-    z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
-
-let zcompare_rec x y h1 h2 h3 =
-  match dcompare_inf (zcompare x y) with
-    | Inleft x0 -> (match x0 with
-                      | Left -> h1 __
-                      | Right -> h2 __)
-    | Inright -> h3 __
-
-(** val z_gt_dec : z -> z -> sumbool **)
-
-let z_gt_dec x y =
-  zcompare_rec x y (fun _ -> Right) (fun _ -> Right) (fun _ -> Left)
-
-(** val zle_bool : z -> z -> bool **)
-
-let zle_bool x y =
-  match zcompare x y with
-    | Gt -> False
-    | _ -> True
-
-(** val zge_bool : z -> z -> bool **)
-
-let zge_bool x y =
-  match zcompare x y with
-    | Lt -> False
-    | _ -> True
-
-(** val zgt_bool : z -> z -> bool **)
-
-let zgt_bool x y =
-  match zcompare x y with
-    | Gt -> True
-    | _ -> False
-
-(** val zeq_bool : z -> z -> bool **)
-
-let zeq_bool x y =
-  match zcompare x y with
-    | Eq -> True
-    | _ -> False
-
-(** val n_of_nat : nat -> n **)
-
-let n_of_nat = function
-  | O -> N0
-  | S n' -> Npos (p_of_succ_nat n')
-
-(** val zdiv_eucl_POS : positive -> z -> (z, z) prod **)
-
-let rec zdiv_eucl_POS a b =
-  match a with
-    | XI a' ->
-        let Pair (q0, r) = zdiv_eucl_POS a' b in
-        let r' = zplus (zmult (Zpos (XO XH)) r) (Zpos XH) in
-        (match zgt_bool b r' with
-           | True -> Pair ((zmult (Zpos (XO XH)) q0), r')
-           | False -> Pair ((zplus (zmult (Zpos (XO XH)) q0) (Zpos XH)),
-               (zminus r' b)))
-    | XO a' ->
-        let Pair (q0, r) = zdiv_eucl_POS a' b in
-        let r' = zmult (Zpos (XO XH)) r in
-        (match zgt_bool b r' with
-           | True -> Pair ((zmult (Zpos (XO XH)) q0), r')
-           | False -> Pair ((zplus (zmult (Zpos (XO XH)) q0) (Zpos XH)),
-               (zminus r' b)))
-    | XH ->
-        (match zge_bool b (Zpos (XO XH)) with
-           | True -> Pair (Z0, (Zpos XH))
-           | False -> Pair ((Zpos XH), Z0))
-
-(** val zdiv_eucl : z -> z -> (z, z) prod **)
-
-let zdiv_eucl a b =
-  match a with
-    | Z0 -> Pair (Z0, Z0)
-    | Zpos a' ->
-        (match b with
-           | Z0 -> Pair (Z0, Z0)
-           | Zpos p -> zdiv_eucl_POS a' b
-           | Zneg b' ->
-               let Pair (q0, r) = zdiv_eucl_POS a' (Zpos b') in
-               (match r with
-                  | Z0 -> Pair ((zopp q0), Z0)
-                  | _ -> Pair ((zopp (zplus q0 (Zpos XH))), (zplus b r))))
-    | Zneg a' ->
-        (match b with
-           | Z0 -> Pair (Z0, Z0)
-           | Zpos p ->
-               let Pair (q0, r) = zdiv_eucl_POS a' b in
-               (match r with
-                  | Z0 -> Pair ((zopp q0), Z0)
-                  | _ -> Pair ((zopp (zplus q0 (Zpos XH))), (zminus b r)))
-           | Zneg b' ->
-               let Pair (q0, r) = zdiv_eucl_POS a' (Zpos b') in
-               Pair (q0, (zopp r)))
-
-type 'c pol =
-  | Pc of 'c
-  | Pinj of positive * 'c pol
-  | PX of 'c pol * positive * 'c pol
-
-(** val p0 : 'a1 -> 'a1 pol **)
-
-let p0 cO =
-  Pc cO
-
-(** val p1 : 'a1 -> 'a1 pol **)
-
-let p1 cI =
-  Pc cI
-
-(** val peq : ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> bool **)
-
-let rec peq ceqb p p' =
-  match p with
-    | Pc c -> (match p' with
-                 | Pc c' -> ceqb c c'
-                 | _ -> False)
-    | Pinj (j, q0) ->
-        (match p' with
-           | Pinj (j', q') ->
-               (match pcompare j j' Eq with
-                  | Eq -> peq ceqb q0 q'
-                  | _ -> False)
-           | _ -> False)
-    | PX (p2, i, q0) ->
-        (match p' with
-           | PX (p'0, i', q') ->
-               (match pcompare i i' Eq with
-                  | Eq ->
-                      (match peq ceqb p2 p'0 with
-                         | True -> peq ceqb q0 q'
-                         | False -> False)
-                  | _ -> False)
-           | _ -> False)
-
-(** val mkPinj_pred : positive -> 'a1 pol -> 'a1 pol **)
-
-let mkPinj_pred j p =
-  match j with
-    | XI j0 -> Pinj ((XO j0), p)
-    | XO j0 -> Pinj ((pdouble_minus_one j0), p)
-    | XH -> p
-
-(** val mkPX :
-    'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
-
-let mkPX cO ceqb p i q0 =
-  match p with
-    | Pc c ->
-        (match ceqb c cO with
-           | True ->
-               (match q0 with
-                  | Pc c0 -> q0
-                  | Pinj (j', q1) -> Pinj ((pplus XH j'), q1)
-                  | PX (p2, p3, p4) -> Pinj (XH, q0))
-           | False -> PX (p, i, q0))
-    | Pinj (p2, p3) -> PX (p, i, q0)
-    | PX (p', i', q') ->
-        (match peq ceqb q' (p0 cO) with
-           | True -> PX (p', (pplus i' i), q0)
-           | False -> PX (p, i, q0))
-
-(** val mkXi : 'a1 -> 'a1 -> positive -> 'a1 pol **)
-
-let mkXi cO cI i =
-  PX ((p1 cI), i, (p0 cO))
-
-(** val mkX : 'a1 -> 'a1 -> 'a1 pol **)
-
-let mkX cO cI =
-  mkXi cO cI XH
-
-(** val popp : ('a1 -> 'a1) -> 'a1 pol -> 'a1 pol **)
-
-let rec popp copp = function
-  | Pc c -> Pc (copp c)
-  | Pinj (j, q0) -> Pinj (j, (popp copp q0))
-  | PX (p2, i, q0) -> PX ((popp copp p2), i, (popp copp q0))
-
-(** val paddC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol **)
-
-let rec paddC cadd p c =
-  match p with
-    | Pc c1 -> Pc (cadd c1 c)
-    | Pinj (j, q0) -> Pinj (j, (paddC cadd q0 c))
-    | PX (p2, i, q0) -> PX (p2, i, (paddC cadd q0 c))
-
-(** val psubC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol **)
-
-let rec psubC csub p c =
-  match p with
-    | Pc c1 -> Pc (csub c1 c)
-    | Pinj (j, q0) -> Pinj (j, (psubC csub q0 c))
-    | PX (p2, i, q0) -> PX (p2, i, (psubC csub q0 c))
-
-(** val paddI :
-    ('a1 -> 'a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol ->
-    positive -> 'a1 pol -> 'a1 pol **)
-
-let rec paddI cadd pop q0 j = function
-  | Pc c ->
-      let p2 = paddC cadd q0 c in
-      (match p2 with
-         | Pc c0 -> p2
-         | Pinj (j', q1) -> Pinj ((pplus j j'), q1)
-         | PX (p3, p4, p5) -> Pinj (j, p2))
-  | Pinj (j', q') ->
-      (match zPminus j' j with
-         | Z0 ->
-             let p2 = pop q' q0 in
-             (match p2 with
-                | Pc c -> p2
-                | Pinj (j'0, q1) -> Pinj ((pplus j j'0), q1)
-                | PX (p3, p4, p5) -> Pinj (j, p2))
-         | Zpos k ->
-             let p2 = pop (Pinj (k, q')) q0 in
-             (match p2 with
-                | Pc c -> p2
-                | Pinj (j'0, q1) -> Pinj ((pplus j j'0), q1)
-                | PX (p3, p4, p5) -> Pinj (j, p2))
-         | Zneg k ->
-             let p2 = paddI cadd pop q0 k q' in
-             (match p2 with
-                | Pc c -> p2
-                | Pinj (j'0, q1) -> Pinj ((pplus j' j'0), q1)
-                | PX (p3, p4, p5) -> Pinj (j', p2)))
-  | PX (p2, i, q') ->
-      (match j with
-         | XI j0 -> PX (p2, i, (paddI cadd pop q0 (XO j0) q'))
-         | XO j0 -> PX (p2, i, (paddI cadd pop q0 (pdouble_minus_one j0) q'))
-         | XH -> PX (p2, i, (pop q' q0)))
-
-(** val psubI :
-    ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
-    'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
-
-let rec psubI cadd copp pop q0 j = function
-  | Pc c ->
-      let p2 = paddC cadd (popp copp q0) c in
-      (match p2 with
-         | Pc c0 -> p2
-         | Pinj (j', q1) -> Pinj ((pplus j j'), q1)
-         | PX (p3, p4, p5) -> Pinj (j, p2))
-  | Pinj (j', q') ->
-      (match zPminus j' j with
-         | Z0 ->
-             let p2 = pop q' q0 in
-             (match p2 with
-                | Pc c -> p2
-                | Pinj (j'0, q1) -> Pinj ((pplus j j'0), q1)
-                | PX (p3, p4, p5) -> Pinj (j, p2))
-         | Zpos k ->
-             let p2 = pop (Pinj (k, q')) q0 in
-             (match p2 with
-                | Pc c -> p2
-                | Pinj (j'0, q1) -> Pinj ((pplus j j'0), q1)
-                | PX (p3, p4, p5) -> Pinj (j, p2))
-         | Zneg k ->
-             let p2 = psubI cadd copp pop q0 k q' in
-             (match p2 with
-                | Pc c -> p2
-                | Pinj (j'0, q1) -> Pinj ((pplus j' j'0), q1)
-                | PX (p3, p4, p5) -> Pinj (j', p2)))
-  | PX (p2, i, q') ->
-      (match j with
-         | XI j0 -> PX (p2, i, (psubI cadd copp pop q0 (XO j0) q'))
-         | XO j0 -> PX (p2, i,
-             (psubI cadd copp pop q0 (pdouble_minus_one j0) q'))
-         | XH -> PX (p2, i, (pop q' q0)))
-
-(** val paddX :
-    'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
-    -> positive -> 'a1 pol -> 'a1 pol **)
-
-let rec paddX cO ceqb pop p' i' p = match p with
-  | Pc c -> PX (p', i', p)
-  | Pinj (j, q') ->
-      (match j with
-         | XI j0 -> PX (p', i', (Pinj ((XO j0), q')))
-         | XO j0 -> PX (p', i', (Pinj ((pdouble_minus_one j0), q')))
-         | XH -> PX (p', i', q'))
-  | PX (p2, i, q') ->
-      (match zPminus i i' with
-         | Z0 -> mkPX cO ceqb (pop p2 p') i q'
-         | Zpos k -> mkPX cO ceqb (pop (PX (p2, k, (p0 cO))) p') i' q'
-         | Zneg k -> mkPX cO ceqb (paddX cO ceqb pop p' k p2) i q')
-
-(** val psubX :
-    'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
-    pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
-
-let rec psubX cO copp ceqb pop p' i' p = match p with
-  | Pc c -> PX ((popp copp p'), i', p)
-  | Pinj (j, q') ->
-      (match j with
-         | XI j0 -> PX ((popp copp p'), i', (Pinj ((XO j0), q')))
-         | XO j0 -> PX ((popp copp p'), i', (Pinj (
-             (pdouble_minus_one j0), q')))
-         | XH -> PX ((popp copp p'), i', q'))
-  | PX (p2, i, q') ->
-      (match zPminus i i' with
-         | Z0 -> mkPX cO ceqb (pop p2 p') i q'
-         | Zpos k -> mkPX cO ceqb (pop (PX (p2, k, (p0 cO))) p') i' q'
-         | Zneg k -> mkPX cO ceqb (psubX cO copp ceqb pop p' k p2) i q')
-
-(** val padd :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
-    -> 'a1 pol **)
-
-let rec padd cO cadd ceqb p = function
-  | Pc c' -> paddC cadd p c'
-  | Pinj (j', q') -> paddI cadd (fun x x0 -> padd cO cadd ceqb x x0) q' j' p
-  | PX (p'0, i', q') ->
-      (match p with
-         | Pc c -> PX (p'0, i', (paddC cadd q' c))
-         | Pinj (j, q0) ->
-             (match j with
-                | XI j0 -> PX (p'0, i',
-                    (padd cO cadd ceqb (Pinj ((XO j0), q0)) q'))
-                | XO j0 -> PX (p'0, i',
-                    (padd cO cadd ceqb (Pinj ((pdouble_minus_one j0), q0))
-                      q'))
-                | XH -> PX (p'0, i', (padd cO cadd ceqb q0 q')))
-         | PX (p2, i, q0) ->
-             (match zPminus i i' with
-                | Z0 ->
-                    mkPX cO ceqb (padd cO cadd ceqb p2 p'0) i
-                      (padd cO cadd ceqb q0 q')
-                | Zpos k ->
-                    mkPX cO ceqb
-                      (padd cO cadd ceqb (PX (p2, k, (p0 cO))) p'0) i'
-                      (padd cO cadd ceqb q0 q')
-                | Zneg k ->
-                    mkPX cO ceqb
-                      (paddX cO ceqb (fun x x0 -> padd cO cadd ceqb x x0) p'0
-                        k p2) i (padd cO cadd ceqb q0 q')))
-
-(** val psub :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
-    -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
-
-let rec psub cO cadd csub copp ceqb p = function
-  | Pc c' -> psubC csub p c'
-  | Pinj (j', q') ->
-      psubI cadd copp (fun x x0 -> psub cO cadd csub copp ceqb x x0) q' j' p
-  | PX (p'0, i', q') ->
-      (match p with
-         | Pc c -> PX ((popp copp p'0), i', (paddC cadd (popp copp q') c))
-         | Pinj (j, q0) ->
-             (match j with
-                | XI j0 -> PX ((popp copp p'0), i',
-                    (psub cO cadd csub copp ceqb (Pinj ((XO j0), q0)) q'))
-                | XO j0 -> PX ((popp copp p'0), i',
-                    (psub cO cadd csub copp ceqb (Pinj
-                      ((pdouble_minus_one j0), q0)) q'))
-                | XH -> PX ((popp copp p'0), i',
-                    (psub cO cadd csub copp ceqb q0 q')))
-         | PX (p2, i, q0) ->
-             (match zPminus i i' with
-                | Z0 ->
-                    mkPX cO ceqb (psub cO cadd csub copp ceqb p2 p'0) i
-                      (psub cO cadd csub copp ceqb q0 q')
-                | Zpos k ->
-                    mkPX cO ceqb
-                      (psub cO cadd csub copp ceqb (PX (p2, k, (p0 cO))) p'0)
-                      i' (psub cO cadd csub copp ceqb q0 q')
-                | Zneg k ->
-                    mkPX cO ceqb
-                      (psubX cO copp ceqb (fun x x0 ->
-                        psub cO cadd csub copp ceqb x x0) p'0 k p2) i
-                      (psub cO cadd csub copp ceqb q0 q')))
-
-(** val pmulC_aux :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 ->
-    'a1 pol **)
-
-let rec pmulC_aux cO cmul ceqb p c =
-  match p with
-    | Pc c' -> Pc (cmul c' c)
-    | Pinj (j, q0) ->
-        let p2 = pmulC_aux cO cmul ceqb q0 c in
-        (match p2 with
-           | Pc c0 -> p2
-           | Pinj (j', q1) -> Pinj ((pplus j j'), q1)
-           | PX (p3, p4, p5) -> Pinj (j, p2))
-    | PX (p2, i, q0) ->
-        mkPX cO ceqb (pmulC_aux cO cmul ceqb p2 c) i
-          (pmulC_aux cO cmul ceqb q0 c)
-
-(** val pmulC :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol ->
-    'a1 -> 'a1 pol **)
-
-let pmulC cO cI cmul ceqb p c =
-  match ceqb c cO with
-    | True -> p0 cO
-    | False ->
-        (match ceqb c cI with
-           | True -> p
-           | False -> pmulC_aux cO cmul ceqb p c)
-
-(** val pmulI :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
-    'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
-
-let rec pmulI cO cI cmul ceqb pmul0 q0 j = function
-  | Pc c ->
-      let p2 = pmulC cO cI cmul ceqb q0 c in
-      (match p2 with
-         | Pc c0 -> p2
-         | Pinj (j', q1) -> Pinj ((pplus j j'), q1)
-         | PX (p3, p4, p5) -> Pinj (j, p2))
-  | Pinj (j', q') ->
-      (match zPminus j' j with
-         | Z0 ->
-             let p2 = pmul0 q' q0 in
-             (match p2 with
-                | Pc c -> p2
-                | Pinj (j'0, q1) -> Pinj ((pplus j j'0), q1)
-                | PX (p3, p4, p5) -> Pinj (j, p2))
-         | Zpos k ->
-             let p2 = pmul0 (Pinj (k, q')) q0 in
-             (match p2 with
-                | Pc c -> p2
-                | Pinj (j'0, q1) -> Pinj ((pplus j j'0), q1)
-                | PX (p3, p4, p5) -> Pinj (j, p2))
-         | Zneg k ->
-             let p2 = pmulI cO cI cmul ceqb pmul0 q0 k q' in
-             (match p2 with
-                | Pc c -> p2
-                | Pinj (j'0, q1) -> Pinj ((pplus j' j'0), q1)
-                | PX (p3, p4, p5) -> Pinj (j', p2)))
-  | PX (p', i', q') ->
-      (match j with
-         | XI j' ->
-             mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q0 j p') i'
-               (pmulI cO cI cmul ceqb pmul0 q0 (XO j') q')
-         | XO j' ->
-             mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q0 j p') i'
-               (pmulI cO cI cmul ceqb pmul0 q0 (pdouble_minus_one j') q')
-         | XH ->
-             mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q0 XH p') i'
-               (pmul0 q' q0))
-
-(** val pmul :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
-
-let rec pmul cO cI cadd cmul ceqb p p'' = match p'' with
-  | Pc c -> pmulC cO cI cmul ceqb p c
-  | Pinj (j', q') ->
-      pmulI cO cI cmul ceqb (fun x x0 -> pmul cO cI cadd cmul ceqb x x0) q'
-        j' p
-  | PX (p', i', q') ->
-      (match p with
-         | Pc c -> pmulC cO cI cmul ceqb p'' c
-         | Pinj (j, q0) ->
-             mkPX cO ceqb (pmul cO cI cadd cmul ceqb p p') i'
-               (match j with
-                  | XI j0 ->
-                      pmul cO cI cadd cmul ceqb (Pinj ((XO j0), q0)) q'
-                  | XO j0 ->
-                      pmul cO cI cadd cmul ceqb (Pinj
-                        ((pdouble_minus_one j0), q0)) q'
-                  | XH -> pmul cO cI cadd cmul ceqb q0 q')
-         | PX (p2, i, q0) ->
-             padd cO cadd ceqb
-               (mkPX cO ceqb
-                 (padd cO cadd ceqb
-                   (mkPX cO ceqb (pmul cO cI cadd cmul ceqb p2 p') i (p0 cO))
-                   (pmul cO cI cadd cmul ceqb
-                     (match q0 with
-                        | Pc c -> q0
-                        | Pinj (j', q1) -> Pinj ((pplus XH j'), q1)
-                        | PX (p3, p4, p5) -> Pinj (XH, q0)) p')) i' 
-                 (p0 cO))
-               (mkPX cO ceqb
-                 (pmulI cO cI cmul ceqb (fun x x0 ->
-                   pmul cO cI cadd cmul ceqb x x0) q' XH p2) i
-                 (pmul cO cI cadd cmul ceqb q0 q')))
-
-type 'c pExpr =
-  | PEc of 'c
-  | PEX of positive
-  | PEadd of 'c pExpr * 'c pExpr
-  | PEsub of 'c pExpr * 'c pExpr
-  | PEmul of 'c pExpr * 'c pExpr
-  | PEopp of 'c pExpr
-  | PEpow of 'c pExpr * n
-
-(** val mk_X : 'a1 -> 'a1 -> positive -> 'a1 pol **)
-
-let mk_X cO cI j =
-  mkPinj_pred j (mkX cO cI)
-
-(** val ppow_pos :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1
-    pol **)
-
-let rec ppow_pos cO cI cadd cmul ceqb subst_l res p = function
-  | XI p3 ->
-      subst_l
-        (pmul cO cI cadd cmul ceqb
-          (ppow_pos cO cI cadd cmul ceqb subst_l
-            (ppow_pos cO cI cadd cmul ceqb subst_l res p p3) p p3) p)
-  | XO p3 ->
-      ppow_pos cO cI cadd cmul ceqb subst_l
-        (ppow_pos cO cI cadd cmul ceqb subst_l res p p3) p p3
-  | XH -> subst_l (pmul cO cI cadd cmul ceqb res p)
-
-(** val ppow_N :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol **)
-
-let ppow_N cO cI cadd cmul ceqb subst_l p = function
-  | N0 -> p1 cI
-  | Npos p2 -> ppow_pos cO cI cadd cmul ceqb subst_l (p1 cI) p p2
-
-(** val norm_aux :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **)
-
-let rec norm_aux cO cI cadd cmul csub copp ceqb = function
-  | PEc c -> Pc c
-  | PEX j -> mk_X cO cI j
-  | PEadd (pe1, pe2) ->
-      (match pe1 with
-         | PEopp pe3 ->
-             psub cO cadd csub copp ceqb
-               (norm_aux cO cI cadd cmul csub copp ceqb pe2)
-               (norm_aux cO cI cadd cmul csub copp ceqb pe3)
-         | _ ->
-             (match pe2 with
-                | PEopp pe3 ->
-                    psub cO cadd csub copp ceqb
-                      (norm_aux cO cI cadd cmul csub copp ceqb pe1)
-                      (norm_aux cO cI cadd cmul csub copp ceqb pe3)
-                | _ ->
-                    padd cO cadd ceqb
-                      (norm_aux cO cI cadd cmul csub copp ceqb pe1)
-                      (norm_aux cO cI cadd cmul csub copp ceqb pe2)))
-  | PEsub (pe1, pe2) ->
-      psub cO cadd csub copp ceqb
-        (norm_aux cO cI cadd cmul csub copp ceqb pe1)
-        (norm_aux cO cI cadd cmul csub copp ceqb pe2)
-  | PEmul (pe1, pe2) ->
-      pmul cO cI cadd cmul ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
-        (norm_aux cO cI cadd cmul csub copp ceqb pe2)
-  | PEopp pe1 -> popp copp (norm_aux cO cI cadd cmul csub copp ceqb pe1)
-  | PEpow (pe1, n0) ->
-      ppow_N cO cI cadd cmul ceqb (fun p -> p)
-        (norm_aux cO cI cadd cmul csub copp ceqb pe1) n0
-
-type 'a bFormula =
-  | TT
-  | FF
-  | X
-  | A of 'a
-  | Cj of 'a bFormula * 'a bFormula
-  | D of 'a bFormula * 'a bFormula
-  | N of 'a bFormula
-  | I of 'a bFormula * 'a bFormula
-
-type 'term' clause = 'term' list
-
-type 'term' cnf = 'term' clause list
-
-(** val tt : 'a1 cnf **)
-
-let tt =
-  Nil
-
-(** val ff : 'a1 cnf **)
-
-let ff =
-  Cons (Nil, Nil)
-
-(** val or_clause_cnf : 'a1 clause -> 'a1 cnf -> 'a1 cnf **)
-
-let or_clause_cnf t0 f =
-  map (fun x -> app t0 x) f
-
-(** val or_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf **)
-
-let rec or_cnf f f' =
-  match f with
-    | Nil -> tt
-    | Cons (e, rst) -> app (or_cnf rst f') (or_clause_cnf e f')
-
-(** val and_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf **)
-
-let and_cnf f1 f2 =
-  app f1 f2
-
-(** val xcnf :
-    ('a1 -> 'a2 cnf) -> ('a1 -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf **)
-
-let rec xcnf normalise0 negate0 pol0 = function
-  | TT -> (match pol0 with
-             | True -> tt
-             | False -> ff)
-  | FF -> (match pol0 with
-             | True -> ff
-             | False -> tt)
-  | X -> ff
-  | A x -> (match pol0 with
-              | True -> normalise0 x
-              | False -> negate0 x)
-  | Cj (e1, e2) ->
-      (match pol0 with
-         | True ->
-             and_cnf (xcnf normalise0 negate0 pol0 e1)
-               (xcnf normalise0 negate0 pol0 e2)
-         | False ->
-             or_cnf (xcnf normalise0 negate0 pol0 e1)
-               (xcnf normalise0 negate0 pol0 e2))
-  | D (e1, e2) ->
-      (match pol0 with
-         | True ->
-             or_cnf (xcnf normalise0 negate0 pol0 e1)
-               (xcnf normalise0 negate0 pol0 e2)
-         | False ->
-             and_cnf (xcnf normalise0 negate0 pol0 e1)
-               (xcnf normalise0 negate0 pol0 e2))
-  | N e -> xcnf normalise0 negate0 (negb pol0) e
-  | I (e1, e2) ->
-      (match pol0 with
-         | True ->
-             or_cnf (xcnf normalise0 negate0 (negb pol0) e1)
-               (xcnf normalise0 negate0 pol0 e2)
-         | False ->
-             and_cnf (xcnf normalise0 negate0 (negb pol0) e1)
-               (xcnf normalise0 negate0 pol0 e2))
-
-(** val cnf_checker :
-    ('a1 list -> 'a2 -> bool) -> 'a1 cnf -> 'a2 list -> bool **)
-
-let rec cnf_checker checker f l =
-  match f with
-    | Nil -> True
-    | Cons (e, f0) ->
-        (match l with
-           | Nil -> False
-           | Cons (c, l0) ->
-               (match checker e c with
-                  | True -> cnf_checker checker f0 l0
-                  | False -> False))
-
-(** val tauto_checker :
-    ('a1 -> 'a2 cnf) -> ('a1 -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1
-    bFormula -> 'a3 list -> bool **)
-
-let tauto_checker normalise0 negate0 checker f w =
-  cnf_checker checker (xcnf normalise0 negate0 True f) w
-
-type 'c pExprC = 'c pExpr
-
-type 'c polC = 'c pol
-
-type op1 =
-  | Equal
-  | NonEqual
-  | Strict
-  | NonStrict
-
-type 'c nFormula = ('c pExprC, op1) prod
-
-type monoidMember = nat list
-
-type 'c coneMember =
-  | S_In of nat
-  | S_Ideal of 'c pExprC * 'c coneMember
-  | S_Square of 'c pExprC
-  | S_Monoid of monoidMember
-  | S_Mult of 'c coneMember * 'c coneMember
-  | S_Add of 'c coneMember * 'c coneMember
-  | S_Pos of 'c
-  | S_Z
-
-(** val nformula_times : 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula **)
-
-let nformula_times f f' =
-  let Pair (p, op) = f in
-  let Pair (p', op') = f' in
-  Pair ((PEmul (p, p')),
-  (match op with
-     | Equal -> Equal
-     | NonEqual -> NonEqual
-     | Strict -> op'
-     | NonStrict -> NonStrict))
-
-(** val nformula_plus : 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula **)
-
-let nformula_plus f f' =
-  let Pair (p, op) = f in
-  let Pair (p', op') = f' in
-  Pair ((PEadd (p, p')),
-  (match op with
-     | Equal -> op'
-     | NonEqual -> NonEqual
-     | Strict -> Strict
-     | NonStrict -> (match op' with
-                       | Strict -> Strict
-                       | _ -> NonStrict)))
-
-(** val eval_monoid :
-    'a1 -> 'a1 nFormula list -> monoidMember -> 'a1 pExprC **)
-
-let rec eval_monoid cI l = function
-  | Nil -> PEc cI
-  | Cons (n0, ns0) -> PEmul
-      ((let Pair (q0, o) = nth n0 l (Pair ((PEc cI), NonEqual)) in
-       (match o with
-          | NonEqual -> q0
-          | _ -> PEc cI)), (eval_monoid cI l ns0))
-
-(** val eval_cone :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1
-    nFormula list -> 'a1 coneMember -> 'a1 nFormula **)
-
-let rec eval_cone cO cI ceqb cleb l = function
-  | S_In n0 ->
-      let Pair (p, o) = nth n0 l (Pair ((PEc cO), Equal)) in
-      (match o with
-         | NonEqual -> Pair ((PEc cO), Equal)
-         | _ -> nth n0 l (Pair ((PEc cO), Equal)))
-  | S_Ideal (p, cm') ->
-      let f = eval_cone cO cI ceqb cleb l cm' in
-      let Pair (q0, op) = f in
-      (match op with
-         | Equal -> Pair ((PEmul (q0, p)), Equal)
-         | _ -> f)
-  | S_Square p -> Pair ((PEmul (p, p)), NonStrict)
-  | S_Monoid m -> let p = eval_monoid cI l m in Pair ((PEmul (p, p)), Strict)
-  | S_Mult (p, q0) ->
-      nformula_times (eval_cone cO cI ceqb cleb l p)
-        (eval_cone cO cI ceqb cleb l q0)
-  | S_Add (p, q0) ->
-      nformula_plus (eval_cone cO cI ceqb cleb l p)
-        (eval_cone cO cI ceqb cleb l q0)
-  | S_Pos c ->
-      (match match cleb cO c with
-               | True -> negb (ceqb cO c)
-               | False -> False with
-         | True -> Pair ((PEc c), Strict)
-         | False -> Pair ((PEc cO), Equal))
-  | S_Z -> Pair ((PEc cO), Equal)
-
-(** val normalise_pexpr :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExprC -> 'a1 polC **)
-
-let normalise_pexpr cO cI cplus ctimes cminus copp ceqb x =
-  norm_aux cO cI cplus ctimes cminus copp ceqb x
-
-(** val check_inconsistent :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool)
-    -> 'a1 nFormula -> bool **)
-
-let check_inconsistent cO cI cplus ctimes cminus copp ceqb cleb = function
-  | Pair (e, op) ->
-      (match normalise_pexpr cO cI cplus ctimes cminus copp ceqb e with
-         | Pc c ->
-             (match op with
-                | Equal -> negb (ceqb c cO)
-                | NonEqual -> False
-                | Strict -> cleb c cO
-                | NonStrict ->
-                    (match cleb c cO with
-                       | True -> negb (ceqb c cO)
-                       | False -> False))
-         | _ -> False)
-
-(** val check_normalised_formulas :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool)
-    -> 'a1 nFormula list -> 'a1 coneMember -> bool **)
-
-let check_normalised_formulas cO cI cplus ctimes cminus copp ceqb cleb l cm =
-  check_inconsistent cO cI cplus ctimes cminus copp ceqb cleb
-    (eval_cone cO cI ceqb cleb l cm)
-
-type op2 =
-  | OpEq
-  | OpNEq
-  | OpLe
-  | OpGe
-  | OpLt
-  | OpGt
-
-type 'c formula = { flhs : 'c pExprC; fop : op2; frhs : 'c pExprC }
-
-(** val flhs : 'a1 formula -> 'a1 pExprC **)
-
-let flhs x = x.flhs
-
-(** val fop : 'a1 formula -> op2 **)
-
-let fop x = x.fop
-
-(** val frhs : 'a1 formula -> 'a1 pExprC **)
-
-let frhs x = x.frhs
-
-(** val xnormalise : 'a1 formula -> 'a1 nFormula list **)
-
-let xnormalise t0 =
-  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
-  (match o with
-     | OpEq -> Cons ((Pair ((PEsub (lhs, rhs)), Strict)), (Cons ((Pair
-         ((PEsub (rhs, lhs)), Strict)), Nil)))
-     | OpNEq -> Cons ((Pair ((PEsub (lhs, rhs)), Equal)), Nil)
-     | OpLe -> Cons ((Pair ((PEsub (lhs, rhs)), Strict)), Nil)
-     | OpGe -> Cons ((Pair ((PEsub (rhs, lhs)), Strict)), Nil)
-     | OpLt -> Cons ((Pair ((PEsub (lhs, rhs)), NonStrict)), Nil)
-     | OpGt -> Cons ((Pair ((PEsub (rhs, lhs)), NonStrict)), Nil))
-
-(** val cnf_normalise : 'a1 formula -> 'a1 nFormula cnf **)
-
-let cnf_normalise t0 =
-  map (fun x -> Cons (x, Nil)) (xnormalise t0)
-
-(** val xnegate : 'a1 formula -> 'a1 nFormula list **)
-
-let xnegate t0 =
-  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
-  (match o with
-     | OpEq -> Cons ((Pair ((PEsub (lhs, rhs)), Equal)), Nil)
-     | OpNEq -> Cons ((Pair ((PEsub (lhs, rhs)), Strict)), (Cons ((Pair
-         ((PEsub (rhs, lhs)), Strict)), Nil)))
-     | OpLe -> Cons ((Pair ((PEsub (rhs, lhs)), NonStrict)), Nil)
-     | OpGe -> Cons ((Pair ((PEsub (lhs, rhs)), NonStrict)), Nil)
-     | OpLt -> Cons ((Pair ((PEsub (rhs, lhs)), Strict)), Nil)
-     | OpGt -> Cons ((Pair ((PEsub (lhs, rhs)), Strict)), Nil))
-
-(** val cnf_negate : 'a1 formula -> 'a1 nFormula cnf **)
-
-let cnf_negate t0 =
-  map (fun x -> Cons (x, Nil)) (xnegate t0)
-
-(** val simpl_expr :
-    'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pExprC -> 'a1 pExprC **)
-
-let rec simpl_expr cI ceqb e = match e with
-  | PEadd (x, y) -> PEadd ((simpl_expr cI ceqb x), (simpl_expr cI ceqb y))
-  | PEmul (y, z0) ->
-      let y' = simpl_expr cI ceqb y in
-      (match y' with
-         | PEc c ->
-             (match ceqb c cI with
-                | True -> simpl_expr cI ceqb z0
-                | False -> PEmul (y', (simpl_expr cI ceqb z0)))
-         | _ -> PEmul (y', (simpl_expr cI ceqb z0)))
-  | _ -> e
-
-(** val simpl_cone :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1
-    coneMember -> 'a1 coneMember **)
-
-let simpl_cone cO cI ctimes ceqb e = match e with
-  | S_Square t0 ->
-      (match simpl_expr cI ceqb t0 with
-         | PEc c ->
-             (match ceqb cO c with
-                | True -> S_Z
-                | False -> S_Pos (ctimes c c))
-         | _ -> S_Square (simpl_expr cI ceqb t0))
-  | S_Mult (t1, t2) ->
-      (match t1 with
-         | S_Mult (x, x0) ->
-             (match x with
-                | S_Pos p2 ->
-                    (match t2 with
-                       | S_Pos c -> S_Mult ((S_Pos (ctimes c p2)), x0)
-                       | S_Z -> S_Z
-                       | _ -> e)
-                | _ ->
-                    (match x0 with
-                       | S_Pos p2 ->
-                           (match t2 with
-                              | S_Pos c -> S_Mult ((S_Pos (ctimes c p2)), x)
-                              | S_Z -> S_Z
-                              | _ -> e)
-                       | _ ->
-                           (match t2 with
-                              | S_Pos c ->
-                                  (match ceqb cI c with
-                                     | True -> t1
-                                     | False -> S_Mult (t1, t2))
-                              | S_Z -> S_Z
-                              | _ -> e)))
-         | S_Pos c ->
-             (match t2 with
-                | S_Mult (x, x0) ->
-                    (match x with
-                       | S_Pos p2 -> S_Mult ((S_Pos (ctimes c p2)), x0)
-                       | _ ->
-                           (match x0 with
-                              | S_Pos p2 -> S_Mult ((S_Pos (ctimes c p2)), x)
-                              | _ ->
-                                  (match ceqb cI c with
-                                     | True -> t2
-                                     | False -> S_Mult (t1, t2))))
-                | S_Add (y, z0) -> S_Add ((S_Mult ((S_Pos c), y)), (S_Mult
-                    ((S_Pos c), z0)))
-                | S_Pos c0 -> S_Pos (ctimes c c0)
-                | S_Z -> S_Z
-                | _ ->
-                    (match ceqb cI c with
-                       | True -> t2
-                       | False -> S_Mult (t1, t2)))
-         | S_Z -> S_Z
-         | _ ->
-             (match t2 with
-                | S_Pos c ->
-                    (match ceqb cI c with
-                       | True -> t1
-                       | False -> S_Mult (t1, t2))
-                | S_Z -> S_Z
-                | _ -> e))
-  | S_Add (t1, t2) ->
-      (match t1 with
-         | S_Z -> t2
-         | _ -> (match t2 with
-                   | S_Z -> t1
-                   | _ -> S_Add (t1, t2)))
-  | _ -> e
-
-type q = { qnum : z; qden : positive }
-
-(** val qnum : q -> z **)
-
-let qnum x = x.qnum
-
-(** val qden : q -> positive **)
-
-let qden x = x.qden
-
-(** val qplus : q -> q -> q **)
-
-let qplus x y =
-  { qnum = (zplus (zmult x.qnum (Zpos y.qden)) (zmult y.qnum (Zpos x.qden)));
-    qden = (pmult x.qden y.qden) }
-
-(** val qmult : q -> q -> q **)
-
-let qmult x y =
-  { qnum = (zmult x.qnum y.qnum); qden = (pmult x.qden y.qden) }
-
-(** val qopp : q -> q **)
-
-let qopp x =
-  { qnum = (zopp x.qnum); qden = x.qden }
-
-(** val qminus : q -> q -> q **)
-
-let qminus x y =
-  qplus x (qopp y)
-
-type 'a t =
-  | Empty
-  | Leaf of 'a
-  | Node of 'a t * 'a * 'a t
-
-(** val find : 'a1 -> 'a1 t -> positive -> 'a1 **)
-
-let rec find default vm p =
-  match vm with
-    | Empty -> default
-    | Leaf i -> i
-    | Node (l, e, r) ->
-        (match p with
-           | XI p2 -> find default r p2
-           | XO p2 -> find default l p2
-           | XH -> e)
-
-type zWitness = z coneMember
-
-(** val zWeakChecker : z nFormula list -> z coneMember -> bool **)
-
-let zWeakChecker x x0 =
-  check_normalised_formulas Z0 (Zpos XH) zplus zmult zminus zopp zeq_bool
-    zle_bool x x0
-
-(** val xnormalise0 : z formula -> z nFormula list **)
-
-let xnormalise0 t0 =
-  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
-  (match o with
-     | OpEq -> Cons ((Pair ((PEsub (lhs, (PEadd (rhs, (PEc (Zpos XH)))))),
-         NonStrict)), (Cons ((Pair ((PEsub (rhs, (PEadd (lhs, (PEc (Zpos
-         XH)))))), NonStrict)), Nil)))
-     | OpNEq -> Cons ((Pair ((PEsub (lhs, rhs)), Equal)), Nil)
-     | OpLe -> Cons ((Pair ((PEsub (lhs, (PEadd (rhs, (PEc (Zpos XH)))))),
-         NonStrict)), Nil)
-     | OpGe -> Cons ((Pair ((PEsub (rhs, (PEadd (lhs, (PEc (Zpos XH)))))),
-         NonStrict)), Nil)
-     | OpLt -> Cons ((Pair ((PEsub (lhs, rhs)), NonStrict)), Nil)
-     | OpGt -> Cons ((Pair ((PEsub (rhs, lhs)), NonStrict)), Nil))
-
-(** val normalise : z formula -> z nFormula cnf **)
-
-let normalise t0 =
-  map (fun x -> Cons (x, Nil)) (xnormalise0 t0)
-
-(** val xnegate0 : z formula -> z nFormula list **)
-
-let xnegate0 t0 =
-  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
-  (match o with
-     | OpEq -> Cons ((Pair ((PEsub (lhs, rhs)), Equal)), Nil)
-     | OpNEq -> Cons ((Pair ((PEsub (lhs, (PEadd (rhs, (PEc (Zpos XH)))))),
-         NonStrict)), (Cons ((Pair ((PEsub (rhs, (PEadd (lhs, (PEc (Zpos
-         XH)))))), NonStrict)), Nil)))
-     | OpLe -> Cons ((Pair ((PEsub (rhs, lhs)), NonStrict)), Nil)
-     | OpGe -> Cons ((Pair ((PEsub (lhs, rhs)), NonStrict)), Nil)
-     | OpLt -> Cons ((Pair ((PEsub (rhs, (PEadd (lhs, (PEc (Zpos XH)))))),
-         NonStrict)), Nil)
-     | OpGt -> Cons ((Pair ((PEsub (lhs, (PEadd (rhs, (PEc (Zpos XH)))))),
-         NonStrict)), Nil))
-
-(** val negate : z formula -> z nFormula cnf **)
-
-let negate t0 =
-  map (fun x -> Cons (x, Nil)) (xnegate0 t0)
-
-(** val ceiling : z -> z -> z **)
-
-let ceiling a b =
-  let Pair (q0, r) = zdiv_eucl a b in
-  (match r with
-     | Z0 -> q0
-     | _ -> zplus q0 (Zpos XH))
-
-type proofTerm =
-  | RatProof of zWitness
-  | CutProof of z pExprC * q * zWitness * proofTerm
-  | EnumProof of q * z pExprC * q * zWitness * zWitness * proofTerm list
-
-(** val makeLb : z pExpr -> q -> z nFormula **)
-
-let makeLb v q0 =
-  let { qnum = n0; qden = d } = q0 in
-  Pair ((PEsub ((PEmul ((PEc (Zpos d)), v)), (PEc n0))), NonStrict)
-
-(** val qceiling : q -> z **)
-
-let qceiling q0 =
-  let { qnum = n0; qden = d } = q0 in ceiling n0 (Zpos d)
-
-(** val makeLbCut : z pExprC -> q -> z nFormula **)
-
-let makeLbCut v q0 =
-  Pair ((PEsub (v, (PEc (qceiling q0)))), NonStrict)
-
-(** val neg_nformula : z nFormula -> (z pExpr, op1) prod **)
-
-let neg_nformula = function
-  | Pair (e, o) -> Pair ((PEopp (PEadd (e, (PEc (Zpos XH))))), o)
-
-(** val cutChecker :
-    z nFormula list -> z pExpr -> q -> zWitness -> z nFormula option **)
-
-let cutChecker l e lb pf =
-  match zWeakChecker (Cons ((neg_nformula (makeLb e lb)), l)) pf with
-    | True -> Some (makeLbCut e lb)
-    | False -> None
-
-(** val zChecker : z nFormula list -> proofTerm -> bool **)
-
-let rec zChecker l = function
-  | RatProof pf0 -> zWeakChecker l pf0
-  | CutProof (e, q0, pf0, rst) ->
-      (match cutChecker l e q0 pf0 with
-         | Some c -> zChecker (Cons (c, l)) rst
-         | None -> False)
-  | EnumProof (lb, e, ub, pf1, pf2, rst) ->
-      (match cutChecker l e lb pf1 with
-         | Some n0 ->
-             (match cutChecker l (PEopp e) (qopp ub) pf2 with
-                | Some n1 ->
-                    let rec label pfs lb0 ub0 =
-                      match pfs with
-                        | Nil ->
-                            (match z_gt_dec lb0 ub0 with
-                               | Left -> True
-                               | Right -> False)
-                        | Cons (pf0, rsr) ->
-                            (match zChecker (Cons ((Pair ((PEsub (e, (PEc
-                                     lb0))), Equal)), l)) pf0 with
-                               | True -> label rsr (zplus lb0 (Zpos XH)) ub0
-                               | False -> False)
-                    in label rst (qceiling lb) (zopp (qceiling (qopp ub)))
-                | None -> False)
-         | None -> False)
-
-(** val zTautoChecker : z formula bFormula -> proofTerm list -> bool **)
-
-let zTautoChecker f w =
-  tauto_checker normalise negate zChecker f w
-
-(** val map_cone : (nat -> nat) -> zWitness -> zWitness **)
-
-let rec map_cone f e = match e with
-  | S_In n0 -> S_In (f n0)
-  | S_Ideal (e0, cm) -> S_Ideal (e0, (map_cone f cm))
-  | S_Monoid l -> S_Monoid (map f l)
-  | S_Mult (cm1, cm2) -> S_Mult ((map_cone f cm1), (map_cone f cm2))
-  | S_Add (cm1, cm2) -> S_Add ((map_cone f cm1), (map_cone f cm2))
-  | _ -> e
-
-(** val indexes : zWitness -> nat list **)
-
-let rec indexes = function
-  | S_In n0 -> Cons (n0, Nil)
-  | S_Ideal (e0, cm) -> indexes cm
-  | S_Monoid l -> l
-  | S_Mult (cm1, cm2) -> app (indexes cm1) (indexes cm2)
-  | S_Add (cm1, cm2) -> app (indexes cm1) (indexes cm2)
-  | _ -> Nil
-
-(** val n_of_Z : z -> n **)
-
-let n_of_Z = function
-  | Zpos p -> Npos p
-  | _ -> N0
-
-(** val qeq_bool : q -> q -> bool **)
-
-let qeq_bool p q0 =
-  zeq_bool (zmult p.qnum (Zpos q0.qden)) (zmult q0.qnum (Zpos p.qden))
-
-(** val qle_bool : q -> q -> bool **)
-
-let qle_bool x y =
-  zle_bool (zmult x.qnum (Zpos y.qden)) (zmult y.qnum (Zpos x.qden))
-
-type qWitness = q coneMember
-
-(** val qWeakChecker : q nFormula list -> q coneMember -> bool **)
-
-let qWeakChecker x x0 =
-  check_normalised_formulas { qnum = Z0; qden = XH } { qnum = (Zpos XH);
-    qden = XH } qplus qmult qminus qopp qeq_bool qle_bool x x0
-
-(** val qTautoChecker : q formula bFormula -> qWitness list -> bool **)
-
-let qTautoChecker f w =
-  tauto_checker (fun x -> cnf_normalise x) (fun x -> 
-    cnf_negate x) qWeakChecker f w
-
diff --git a/contrib/micromega/micromega.mli b/contrib/micromega/micromega.mli
deleted file mode 100644
index f94f091e..00000000
--- a/contrib/micromega/micromega.mli
+++ /dev/null
@@ -1,398 +0,0 @@
-type __ = Obj.t
-
-type bool =
-  | True
-  | False
-
-val negb : bool -> bool
-
-type nat =
-  | O
-  | S of nat
-
-type 'a option =
-  | Some of 'a
-  | None
-
-type ('a, 'b) prod =
-  | Pair of 'a * 'b
-
-type comparison =
-  | Eq
-  | Lt
-  | Gt
-
-val compOpp : comparison -> comparison
-
-type sumbool =
-  | Left
-  | Right
-
-type 'a sumor =
-  | Inleft of 'a
-  | Inright
-
-type 'a list =
-  | Nil
-  | Cons of 'a * 'a list
-
-val app : 'a1 list -> 'a1 list -> 'a1 list
-
-val nth : nat -> 'a1 list -> 'a1 -> 'a1
-
-val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list
-
-type positive =
-  | XI of positive
-  | XO of positive
-  | XH
-
-val psucc : positive -> positive
-
-val pplus : positive -> positive -> positive
-
-val pplus_carry : positive -> positive -> positive
-
-val p_of_succ_nat : nat -> positive
-
-val pdouble_minus_one : positive -> positive
-
-type positive_mask =
-  | IsNul
-  | IsPos of positive
-  | IsNeg
-
-val pdouble_plus_one_mask : positive_mask -> positive_mask
-
-val pdouble_mask : positive_mask -> positive_mask
-
-val pdouble_minus_two : positive -> positive_mask
-
-val pminus_mask : positive -> positive -> positive_mask
-
-val pminus_mask_carry : positive -> positive -> positive_mask
-
-val pminus : positive -> positive -> positive
-
-val pmult : positive -> positive -> positive
-
-val pcompare : positive -> positive -> comparison -> comparison
-
-type n =
-  | N0
-  | Npos of positive
-
-type z =
-  | Z0
-  | Zpos of positive
-  | Zneg of positive
-
-val zdouble_plus_one : z -> z
-
-val zdouble_minus_one : z -> z
-
-val zdouble : z -> z
-
-val zPminus : positive -> positive -> z
-
-val zplus : z -> z -> z
-
-val zopp : z -> z
-
-val zminus : z -> z -> z
-
-val zmult : z -> z -> z
-
-val zcompare : z -> z -> comparison
-
-val dcompare_inf : comparison -> sumbool sumor
-
-val zcompare_rec : z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
-
-val z_gt_dec : z -> z -> sumbool
-
-val zle_bool : z -> z -> bool
-
-val zge_bool : z -> z -> bool
-
-val zgt_bool : z -> z -> bool
-
-val zeq_bool : z -> z -> bool
-
-val n_of_nat : nat -> n
-
-val zdiv_eucl_POS : positive -> z -> (z, z) prod
-
-val zdiv_eucl : z -> z -> (z, z) prod
-
-type 'c pol =
-  | Pc of 'c
-  | Pinj of positive * 'c pol
-  | PX of 'c pol * positive * 'c pol
-
-val p0 : 'a1 -> 'a1 pol
-
-val p1 : 'a1 -> 'a1 pol
-
-val peq : ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> bool
-
-val mkPinj_pred : positive -> 'a1 pol -> 'a1 pol
-
-val mkPX :
-  'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
-
-val mkXi : 'a1 -> 'a1 -> positive -> 'a1 pol
-
-val mkX : 'a1 -> 'a1 -> 'a1 pol
-
-val popp : ('a1 -> 'a1) -> 'a1 pol -> 'a1 pol
-
-val paddC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol
-
-val psubC : ('a1 -> 'a1 -> 'a1) -> 'a1 pol -> 'a1 -> 'a1 pol
-
-val paddI :
-  ('a1 -> 'a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol ->
-  positive -> 'a1 pol -> 'a1 pol
-
-val psubI :
-  ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
-  'a1 pol -> positive -> 'a1 pol -> 'a1 pol
-
-val paddX :
-  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
-  -> positive -> 'a1 pol -> 'a1 pol
-
-val psubX :
-  'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
-  pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
-
-val padd :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol ->
-  'a1 pol
-
-val psub :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
-  -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
-
-val pmulC_aux :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 -> 'a1
-  pol
-
-val pmulC :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
-  -> 'a1 pol
-
-val pmulI :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
-  'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
-
-val pmul :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
-
-type 'c pExpr =
-  | PEc of 'c
-  | PEX of positive
-  | PEadd of 'c pExpr * 'c pExpr
-  | PEsub of 'c pExpr * 'c pExpr
-  | PEmul of 'c pExpr * 'c pExpr
-  | PEopp of 'c pExpr
-  | PEpow of 'c pExpr * n
-
-val mk_X : 'a1 -> 'a1 -> positive -> 'a1 pol
-
-val ppow_pos :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1 pol
-
-val ppow_N :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol
-
-val norm_aux :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
-
-type 'a bFormula =
-  | TT
-  | FF
-  | X
-  | A of 'a
-  | Cj of 'a bFormula * 'a bFormula
-  | D of 'a bFormula * 'a bFormula
-  | N of 'a bFormula
-  | I of 'a bFormula * 'a bFormula
-
-type 'term' clause = 'term' list
-
-type 'term' cnf = 'term' clause list
-
-val tt : 'a1 cnf
-
-val ff : 'a1 cnf
-
-val or_clause_cnf : 'a1 clause -> 'a1 cnf -> 'a1 cnf
-
-val or_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf
-
-val and_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf
-
-val xcnf :
-  ('a1 -> 'a2 cnf) -> ('a1 -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf
-
-val cnf_checker : ('a1 list -> 'a2 -> bool) -> 'a1 cnf -> 'a2 list -> bool
-
-val tauto_checker :
-  ('a1 -> 'a2 cnf) -> ('a1 -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1
-  bFormula -> 'a3 list -> bool
-
-type 'c pExprC = 'c pExpr
-
-type 'c polC = 'c pol
-
-type op1 =
-  | Equal
-  | NonEqual
-  | Strict
-  | NonStrict
-
-type 'c nFormula = ('c pExprC, op1) prod
-
-type monoidMember = nat list
-
-type 'c coneMember =
-  | S_In of nat
-  | S_Ideal of 'c pExprC * 'c coneMember
-  | S_Square of 'c pExprC
-  | S_Monoid of monoidMember
-  | S_Mult of 'c coneMember * 'c coneMember
-  | S_Add of 'c coneMember * 'c coneMember
-  | S_Pos of 'c
-  | S_Z
-
-val nformula_times : 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula
-
-val nformula_plus : 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula
-
-val eval_monoid : 'a1 -> 'a1 nFormula list -> monoidMember -> 'a1 pExprC
-
-val eval_cone :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula
-  list -> 'a1 coneMember -> 'a1 nFormula
-
-val normalise_pexpr :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExprC -> 'a1 polC
-
-val check_inconsistent :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1
-  nFormula -> bool
-
-val check_normalised_formulas :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1
-  nFormula list -> 'a1 coneMember -> bool
-
-type op2 =
-  | OpEq
-  | OpNEq
-  | OpLe
-  | OpGe
-  | OpLt
-  | OpGt
-
-type 'c formula = { flhs : 'c pExprC; fop : op2; frhs : 'c pExprC }
-
-val flhs : 'a1 formula -> 'a1 pExprC
-
-val fop : 'a1 formula -> op2
-
-val frhs : 'a1 formula -> 'a1 pExprC
-
-val xnormalise : 'a1 formula -> 'a1 nFormula list
-
-val cnf_normalise : 'a1 formula -> 'a1 nFormula cnf
-
-val xnegate : 'a1 formula -> 'a1 nFormula list
-
-val cnf_negate : 'a1 formula -> 'a1 nFormula cnf
-
-val simpl_expr : 'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pExprC -> 'a1 pExprC
-
-val simpl_cone :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 coneMember
-  -> 'a1 coneMember
-
-type q = { qnum : z; qden : positive }
-
-val qnum : q -> z
-
-val qden : q -> positive
-
-val qplus : q -> q -> q
-
-val qmult : q -> q -> q
-
-val qopp : q -> q
-
-val qminus : q -> q -> q
-
-type 'a t =
-  | Empty
-  | Leaf of 'a
-  | Node of 'a t * 'a * 'a t
-
-val find : 'a1 -> 'a1 t -> positive -> 'a1
-
-type zWitness = z coneMember
-
-val zWeakChecker : z nFormula list -> z coneMember -> bool
-
-val xnormalise0 : z formula -> z nFormula list
-
-val normalise : z formula -> z nFormula cnf
-
-val xnegate0 : z formula -> z nFormula list
-
-val negate : z formula -> z nFormula cnf
-
-val ceiling : z -> z -> z
-
-type proofTerm =
-  | RatProof of zWitness
-  | CutProof of z pExprC * q * zWitness * proofTerm
-  | EnumProof of q * z pExprC * q * zWitness * zWitness * proofTerm list
-
-val makeLb : z pExpr -> q -> z nFormula
-
-val qceiling : q -> z
-
-val makeLbCut : z pExprC -> q -> z nFormula
-
-val neg_nformula : z nFormula -> (z pExpr, op1) prod
-
-val cutChecker :
-  z nFormula list -> z pExpr -> q -> zWitness -> z nFormula option
-
-val zChecker : z nFormula list -> proofTerm -> bool
-
-val zTautoChecker : z formula bFormula -> proofTerm list -> bool
-
-val map_cone : (nat -> nat) -> zWitness -> zWitness
-
-val indexes : zWitness -> nat list
-
-val n_of_Z : z -> n
-
-val qeq_bool : q -> q -> bool
-
-val qle_bool : q -> q -> bool
-
-type qWitness = q coneMember
-
-val qWeakChecker : q nFormula list -> q coneMember -> bool
-
-val qTautoChecker : q formula bFormula -> qWitness list -> bool
-
diff --git a/contrib/micromega/mutils.ml b/contrib/micromega/mutils.ml
deleted file mode 100644
index 2473608f..00000000
--- a/contrib/micromega/mutils.ml
+++ /dev/null
@@ -1,305 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-let debug = false
-
-let fst' (Micromega.Pair(x,y)) = x
-let snd' (Micromega.Pair(x,y)) = y
-
-let rec try_any l x = 
- match l with
-  | [] -> None
-  | (f,s)::l -> match f x with
-     | None -> try_any l x
-     | x -> x
-
-let list_try_find f =
-  let rec try_find_f = function
-    | [] -> failwith "try_find"
-    | h::t -> try f h with Failure _ -> try_find_f t
-  in
-  try_find_f
-
-let rec list_fold_right_elements f l =
-  let rec aux = function
-    | [] -> invalid_arg "list_fold_right_elements"
-    | [x] -> x
-    | x::l -> f x (aux l) in
-  aux l
-
-let interval n m = 
-  let rec interval_n (l,m) =
-    if n > m then l else interval_n (m::l,pred m)
-  in 
-  interval_n ([],m)
-
-open Num
-open Big_int
-
-let ppcm x y = 
- let g = gcd_big_int x y in
- let x' = div_big_int x g in
- let y' = div_big_int y g in
-  mult_big_int g (mult_big_int x' y')
-
-
-let denominator = function
- | Int _ | Big_int _ -> unit_big_int
- | Ratio r -> Ratio.denominator_ratio r
-
-let numerator = function
- | Ratio r -> Ratio.numerator_ratio r
- | Int i -> Big_int.big_int_of_int i
- | Big_int i -> i
-
-let rec ppcm_list c l =
- match l with
-  | [] -> c
-  | e::l -> ppcm_list (ppcm c (denominator e)) l
-
-let rec rec_gcd_list c l  = 
- match l with
-  | [] -> c
-  | e::l -> rec_gcd_list (gcd_big_int  c (numerator e)) l
-
-let rec gcd_list l = 
- let res = rec_gcd_list zero_big_int l in
-  if compare_big_int res zero_big_int = 0 
-  then unit_big_int else res
-   
-   
-   
-let rats_to_ints l = 
- let c = ppcm_list unit_big_int l in
-  List.map (fun x ->  (div_big_int (mult_big_int (numerator x) c) 
-			(denominator x))) l
-   
-(* Nasty reordering of lists - useful to trim certificate down *)
-let mapi f l =
- let rec xmapi i l = 
-  match l with
-   | []   -> []
-   | e::l ->  (f e i)::(xmapi (i+1) l) in
-  xmapi 0 l
-
-
-let concatMapi f l = List.rev (mapi (fun e i -> (i,f e)) l)
-
-(* assoc_pos j [a0...an] = [j,a0....an,j+n],j+n+1 *)
-let assoc_pos j l = (mapi (fun e i -> e,i+j) l, j + (List.length l))
-
-let assoc_pos_assoc l = 
- let rec xpos i l =
-  match l with
-   | [] -> []
-   | (x,l) ::rst -> let (l',j) = assoc_pos i l in 
-		     (x,l')::(xpos j rst) in
-  xpos 0 l
-
-let filter_pos f l =
- (* Could sort ... take care of duplicates... *)
- let rec xfilter l =
-  match l with
-   | []  -> []
-   | (x,e)::l -> 
-      if List.exists (fun ee -> List.mem ee f) (List.map snd e)
-      then (x,e)::(xfilter l)
-      else xfilter l in
-  xfilter l
-
-let  select_pos lpos l =
- let rec xselect i lpos l =
-  match lpos with
-   | [] -> []
-   | j::rpos -> 
-      match l with
-       | []   -> failwith "select_pos"
-       | e::l -> 
-	  if i = j 
-	  then e:: (xselect (i+1) rpos l)
-	  else xselect (i+1) lpos l in
-  xselect 0 lpos l
-
-
-module CoqToCaml =
-struct
- open Micromega
-
- let rec nat = function
-  | O -> 0
-  | S n -> (nat n) + 1
-
-
- let rec positive p = 
-  match p with
-   | XH -> 1
-   | XI p -> 1+ 2*(positive p)
-   | XO p -> 2*(positive p)
-
-
- let n nt =
-  match nt with
-   | N0 -> 0
-   | Npos p -> positive p
-
-
- let rec index i = (* Swap left-right ? *)
-  match i with
-   | XH -> 1
-   | XI i -> 1+(2*(index i))
-   | XO i -> 2*(index i)
-
-
- let z x = 
-  match x with
-   | Z0 -> 0
-   | Zpos p -> (positive p)
-   | Zneg p -> - (positive p)
-
- open Big_int
-
- let rec positive_big_int p =
-  match p with
-   | XH -> unit_big_int
-   | XI p -> add_int_big_int 1 (mult_int_big_int 2 (positive_big_int p))
-   | XO p -> (mult_int_big_int 2 (positive_big_int p))
-
-
- let z_big_int x = 
-  match x with
-   | Z0 -> zero_big_int
-   | Zpos p -> (positive_big_int p)
-   | Zneg p -> minus_big_int (positive_big_int p)
-
-
- let num x = Num.Big_int (z_big_int x)
-
- let rec list elt l =
-  match l with
-   | Nil -> []
-   | Cons(e,l) -> (elt e)::(list elt l)
-
- let q_to_num {qnum = x ; qden = y} = 
-  Big_int (z_big_int x) // (Big_int (z_big_int (Zpos y)))
-  
-end
-
-
-module CamlToCoq =
-struct
- open Micromega
-
- let rec nat = function
-  | 0 -> O
-  | n -> S (nat (n-1))
-
-
- let rec positive n =
-  if n=1 then XH
-  else if n land 1 = 1 then XI (positive (n lsr 1))
-  else  XO (positive (n lsr 1))
-
- let  n nt = 
-  if nt < 0 
-  then assert false
-  else if nt = 0 then N0
-  else Npos (positive nt)
-
-
-   
-
-   
- let rec index  n =
-  if n=1 then XH
-  else if n land 1 = 1 then XI (index (n lsr 1))
-  else  XO (index (n lsr 1))
-
-
- let idx n = 
-  (*a.k.a path_of_int *)
-  (* returns the list of digits of n in reverse order with
-     initial 1 removed *)
-  let rec digits_of_int n =
-   if n=1 then [] 
-   else (n mod 2 = 1)::(digits_of_int (n lsr 1))
-  in
-   List.fold_right 
-    (fun b c -> (if b then XI c else XO c))
-    (List.rev (digits_of_int n))
-    (XH)
-
-    
-
- let z x = 
-  match compare x 0 with
-   | 0 -> Z0
-   | 1 -> Zpos (positive x)
-   | _ -> (* this should be -1 *)
-      Zneg (positive (-x)) 
-
- open Big_int
-
- let positive_big_int n = 
-  let two = big_int_of_int 2 in 
-  let rec _pos n = 
-   if eq_big_int n unit_big_int then XH
-   else
-    let (q,m) = quomod_big_int n two  in
-     if eq_big_int unit_big_int m 
-     then XI (_pos q)
-     else XO (_pos q) in
-   _pos n
-
- let bigint x = 
-  match sign_big_int x with
-   | 0 -> Z0
-   | 1 -> Zpos (positive_big_int x)
-   | _ -> Zneg (positive_big_int (minus_big_int x))
-
- let q n = 
-  {Micromega.qnum = bigint (numerator n) ; 
-   Micromega.qden = positive_big_int (denominator n)}
-
-
- let list elt l = List.fold_right (fun x l -> Cons(elt x, l)) l Nil
-
-end
-
-module Cmp =
-struct
-
- let rec compare_lexical l = 
-  match l with
-   | [] -> 0 (* Equal *)
-   | f::l -> 
-      let cmp = f () in
-       if cmp = 0 	then  compare_lexical l else cmp
-
- let rec compare_list cmp l1 l2 = 
-  match l1 , l2 with
-   | []  , [] -> 0
-   | []  , _  -> -1
-   | _   , [] -> 1
-   | e1::l1 , e2::l2 -> 
-      let c = cmp e1 e2 in
-       if c = 0 then compare_list cmp l1 l2 else c
-	
- let hash_list hash l = 
-  let rec _hash_list l h =
-   match l with
-    | []  -> h lxor (Hashtbl.hash [])
-    | e::l -> _hash_list l   ((hash e)  lxor h) in
-
-   _hash_list  l 0
-end
diff --git a/contrib/micromega/sos.ml b/contrib/micromega/sos.ml
deleted file mode 100644
index e3d72ed9..00000000
--- a/contrib/micromega/sos.ml
+++ /dev/null
@@ -1,1919 +0,0 @@
-(* ========================================================================= *)
-(* - This code originates from John Harrison's HOL LIGHT 2.20                *)
-(*   (see file LICENSE.sos for license, copyright and disclaimer)            *)
-(* - Laurent Théry (thery@sophia.inria.fr) has isolated the HOL              *)
-(*   independent bits                                                        *)
-(* - Frédéric Besson (fbesson@irisa.fr) is using it to feed  micromega       *)
-(* - Addition of a csdp cache by the Coq development team                    *)
-(* ========================================================================= *)
-
-(* ========================================================================= *)
-(* Nonlinear universal reals procedure using SOS decomposition.              *)
-(* ========================================================================= *)
-
-open Num;;
-open List;;
-
-let debugging = ref false;;
-
-exception Sanity;;
-
-exception Unsolvable;;
-
-(* ------------------------------------------------------------------------- *)
-(* Comparisons that are reflexive on NaN and also short-circuiting.          *)
-(* ------------------------------------------------------------------------- *)
-
-let (=?) = fun x y -> Pervasives.compare x y = 0;;
-let (<?) = fun x y -> Pervasives.compare x y < 0;;
-let (<=?) = fun x y -> Pervasives.compare x y <= 0;;
-let (>?) = fun x y -> Pervasives.compare x y > 0;;
-let (>=?) = fun x y -> Pervasives.compare x y >= 0;;
-
-(* ------------------------------------------------------------------------- *)
-(* Combinators.                                                              *)
-(* ------------------------------------------------------------------------- *)
-
-let (o) = fun f g x -> f(g x);;
-
-(* ------------------------------------------------------------------------- *)
-(* Some useful functions on "num" type.                                      *)
-(* ------------------------------------------------------------------------- *)
-
-
-let num_0 = Int 0
-and num_1 = Int 1
-and num_2 = Int 2
-and num_10 = Int 10;;
-
-let pow2 n = power_num num_2 (Int n);;
-let pow10 n = power_num num_10 (Int n);;
-
-let numdom r =
-  let r' = Ratio.normalize_ratio (ratio_of_num r) in
-  num_of_big_int(Ratio.numerator_ratio r'),
-  num_of_big_int(Ratio.denominator_ratio r');;
-
-let numerator = (o) fst numdom
-and denominator = (o) snd numdom;;
-
-let gcd_num n1 n2 =
-  num_of_big_int(Big_int.gcd_big_int (big_int_of_num n1) (big_int_of_num n2));;
-
-let lcm_num x y =
-  if x =/ num_0 & y =/ num_0 then num_0
-  else abs_num((x */ y) // gcd_num x y);;
-
-
-(* ------------------------------------------------------------------------- *)
-(* List basics.                                                              *)
-(* ------------------------------------------------------------------------- *)
-
-let rec el n l =
-  if n = 0 then hd l else el (n - 1) (tl l);;
-
-
-(* ------------------------------------------------------------------------- *)
-(* Various versions of list iteration.                                       *)
-(* ------------------------------------------------------------------------- *)
-
-let rec itlist f l b =
-  match l with
-    [] -> b
-  | (h::t) -> f h (itlist f t b);;
-
-let rec end_itlist f l =
-  match l with
-        []     -> failwith "end_itlist"
-      | [x]    -> x
-      | (h::t) -> f h (end_itlist f t);;
-
-let rec itlist2 f l1 l2 b =
-  match (l1,l2) with
-    ([],[]) -> b
-  | (h1::t1,h2::t2) -> f h1 h2 (itlist2 f t1 t2 b)
-  | _ -> failwith "itlist2";;
-
-(* ------------------------------------------------------------------------- *)
-(* All pairs arising from applying a function over two lists.                *)
-(* ------------------------------------------------------------------------- *)
-
-let rec allpairs f l1 l2 =
-  match l1 with
-   h1::t1 ->  itlist (fun x a -> f h1 x :: a) l2 (allpairs f t1 l2)
-  | [] -> [];;
-
-(* ------------------------------------------------------------------------- *)
-(* String operations (surely there is a better way...)                       *)
-(* ------------------------------------------------------------------------- *)
-
-let implode l = itlist (^) l "";;
-
-let explode s =
-  let rec exap n l =
-      if n < 0 then l else
-      exap (n - 1) ((String.sub s n 1)::l) in
-  exap (String.length s - 1) [];;
-
-
-(* ------------------------------------------------------------------------- *)
-(* Attempting function or predicate applications.                            *)
-(* ------------------------------------------------------------------------- *)
-
-let can f x = try (f x; true) with Failure _ -> false;;
-
-
-(* ------------------------------------------------------------------------- *)
-(* Repetition of a function.                                                 *)
-(* ------------------------------------------------------------------------- *)
-
-let rec funpow n f x =
-  if n < 1 then x else funpow (n-1) f (f x);;
-
-
-(* ------------------------------------------------------------------------- *)
-(*  term??                                                                   *)
-(* ------------------------------------------------------------------------- *)
-
-type vname = string;;
-
-type term =
-| Zero
-| Const of Num.num
-| Var of vname
-| Inv of term
-| Opp of term
-| Add of (term * term)
-| Sub of (term * term)
-| Mul of (term * term)
-| Div of (term * term)
-| Pow of (term * int);;
-
-
-(* ------------------------------------------------------------------------- *)
-(* Data structure for Positivstellensatz refutations.                        *)
-(* ------------------------------------------------------------------------- *)
-
-type positivstellensatz =
-   Axiom_eq of int
- | Axiom_le of int
- | Axiom_lt of int
- | Rational_eq of num
- | Rational_le of num
- | Rational_lt of num
- | Square of term
- | Monoid of int list
- | Eqmul of term * positivstellensatz
- | Sum of positivstellensatz * positivstellensatz
- | Product of positivstellensatz * positivstellensatz;;
-
-
-
-(* ------------------------------------------------------------------------- *)
-(* Replication and sequences.                                                *)
-(* ------------------------------------------------------------------------- *)
-
-let rec replicate x n =
-    if n < 1 then []
-    else x::(replicate x (n - 1));;
-
-let rec (--) = fun m n -> if m > n then [] else m::((m + 1) -- n);;
-
-(* ------------------------------------------------------------------------- *)
-(* Various useful list operations.                                           *)
-(* ------------------------------------------------------------------------- *)
-
-let rec forall p l =
-  match l with
-    [] -> true
-  | h::t -> p(h) & forall p t;;
-
-let rec tryfind f l =
-  match l with
-      [] -> failwith "tryfind"
-    | (h::t) -> try f h with Failure _ -> tryfind f t;;
-
-let index x =
-  let rec ind n l =
-    match l with
-      [] -> failwith "index"
-    | (h::t) -> if x =? h then n else ind (n + 1) t in
-  ind 0;;
-
-(* ------------------------------------------------------------------------- *)
-(* "Set" operations on lists.                                                *)
-(* ------------------------------------------------------------------------- *)
-
-let rec mem x lis =
-  match lis with
-    [] -> false
-  | (h::t) -> x =? h or mem x t;;
-
-let insert x l =
-  if mem x l then l else x::l;;
-
-let union l1 l2 = itlist insert l1 l2;;
-
-let subtract l1 l2 = filter (fun x -> not (mem x l2)) l1;;
-
-(* ------------------------------------------------------------------------- *)
-(* Merging and bottom-up mergesort.                                          *)
-(* ------------------------------------------------------------------------- *)
-
-let rec merge ord l1 l2 =
-  match l1 with
-    [] -> l2
-  | h1::t1 -> match l2 with
-                [] -> l1
-              | h2::t2 -> if ord h1 h2 then h1::(merge ord t1 l2)
-                          else h2::(merge ord l1 t2);;
-
-
-(* ------------------------------------------------------------------------- *)
-(* Common measure predicates to use with "sort".                             *)
-(* ------------------------------------------------------------------------- *)
-
-let increasing f x y = f x <? f y;;
-
-let decreasing f x y = f x >? f y;;
-
-(* ------------------------------------------------------------------------- *)
-(* Zipping, unzipping etc.                                                   *)
-(* ------------------------------------------------------------------------- *)
-
-let rec zip l1 l2 =
-  match (l1,l2) with
-        ([],[]) -> []
-      | (h1::t1,h2::t2) -> (h1,h2)::(zip t1 t2)
-      | _ -> failwith "zip";;
-
-let rec unzip =
-  function [] -> [],[]
-         | ((a,b)::rest) -> let alist,blist = unzip rest in
-                            (a::alist,b::blist);;
-
-(* ------------------------------------------------------------------------- *)
-(* Iterating functions over lists.                                           *)
-(* ------------------------------------------------------------------------- *)
-
-let rec do_list f l =
-  match l with
-    [] -> ()
-  | (h::t) -> (f h; do_list f t);;
-
-(* ------------------------------------------------------------------------- *)
-(* Sorting.                                                                  *)
-(* ------------------------------------------------------------------------- *)
-
-let rec sort cmp lis =
-  match lis with
-    [] -> []
-  | piv::rest ->
-      let r,l = partition (cmp piv) rest in
-      (sort cmp l) @ (piv::(sort cmp r));;
-
-(* ------------------------------------------------------------------------- *)
-(* Removing adjacent (NB!) equal elements from list.                         *)
-(* ------------------------------------------------------------------------- *)
-
-let rec uniq l =
-  match l with
-    x::(y::_ as t) -> let t' = uniq t in
-                      if x =? y then t' else
-                      if t'==t then l else x::t'
- | _ -> l;;
-
-(* ------------------------------------------------------------------------- *)
-(* Convert list into set by eliminating duplicates.                          *)
-(* ------------------------------------------------------------------------- *)
-
-let setify s = uniq (sort (<=?) s);;
-
-(* ------------------------------------------------------------------------- *)
-(* Polymorphic finite partial functions via Patricia trees.                  *)
-(*                                                                           *)
-(* The point of this strange representation is that it is canonical (equal   *)
-(* functions have the same encoding) yet reasonably efficient on average.    *)
-(*                                                                           *)
-(* Idea due to Diego Olivier Fernandez Pons (OCaml list, 2003/11/10).        *)
-(* ------------------------------------------------------------------------- *)
-
-type ('a,'b)func =
-   Empty
- | Leaf of int * ('a*'b)list
- | Branch of int * int * ('a,'b)func * ('a,'b)func;;
-
-(* ------------------------------------------------------------------------- *)
-(* Undefined function.                                                       *)
-(* ------------------------------------------------------------------------- *)
-
-let undefined = Empty;;
-
-(* ------------------------------------------------------------------------- *)
-(* In case of equality comparison worries, better use this.                  *)
-(* ------------------------------------------------------------------------- *)
-
-let is_undefined f =
-  match f with
-    Empty -> true
-  | _ -> false;;
-
-(* ------------------------------------------------------------------------- *)
-(* Operation analagous to "map" for lists.                                   *)
-(* ------------------------------------------------------------------------- *)
-
-let mapf =
-  let rec map_list f l =
-    match l with
-      [] -> []
-    | (x,y)::t -> (x,f(y))::(map_list f t) in
-  let rec mapf f t =
-    match t with
-      Empty -> Empty
-    | Leaf(h,l) -> Leaf(h,map_list f l)
-    | Branch(p,b,l,r) -> Branch(p,b,mapf f l,mapf f r) in
-  mapf;;
-
-(* ------------------------------------------------------------------------- *)
-(* Operations analogous to "fold" for lists.                                 *)
-(* ------------------------------------------------------------------------- *)
-
-let foldl =
-  let rec foldl_list f a l =
-    match l with
-      [] -> a
-    | (x,y)::t -> foldl_list f (f a x y) t in
-  let rec foldl f a t =
-    match t with
-      Empty -> a
-    | Leaf(h,l) -> foldl_list f a l
-    | Branch(p,b,l,r) -> foldl f (foldl f a l) r in
-  foldl;;
-
-let foldr =
-  let rec foldr_list f l a =
-    match l with
-      [] -> a
-    | (x,y)::t -> f x y (foldr_list f t a) in
-  let rec foldr f t a =
-    match t with
-      Empty -> a
-    | Leaf(h,l) -> foldr_list f l a
-    | Branch(p,b,l,r) -> foldr f l (foldr f r a) in
-  foldr;;
-
-(* ------------------------------------------------------------------------- *)
-(* Redefinition and combination.                                             *)
-(* ------------------------------------------------------------------------- *)
-
-let (|->),combine =
-  let ldb x y = let z = x lxor y in z land (-z) in
-  let newbranch p1 t1 p2 t2 =
-    let b = ldb p1 p2 in
-    let p = p1 land (b - 1) in
-    if p1 land b = 0 then Branch(p,b,t1,t2)
-    else Branch(p,b,t2,t1) in
-  let rec define_list (x,y as xy) l =
-    match l with
-      (a,b as ab)::t ->
-          if x =? a then xy::t
-          else if x <? a then xy::l
-          else ab::(define_list xy t)
-    | [] -> [xy]
-  and combine_list op z l1 l2 =
-    match (l1,l2) with
-      [],_ -> l2
-    | _,[] -> l1
-    | ((x1,y1 as xy1)::t1,(x2,y2 as xy2)::t2) ->
-          if x1 <? x2 then xy1::(combine_list op z t1 l2)
-          else if x2 <? x1 then xy2::(combine_list op z l1 t2) else
-          let y = op y1 y2 and l = combine_list op z t1 t2 in
-          if z(y) then l else (x1,y)::l in
-  let (|->) x y =
-    let k = Hashtbl.hash x in
-    let rec upd t =
-      match t with
-        Empty -> Leaf (k,[x,y])
-      | Leaf(h,l) ->
-           if h = k then Leaf(h,define_list (x,y) l)
-           else newbranch h t k (Leaf(k,[x,y]))
-      | Branch(p,b,l,r) ->
-          if k land (b - 1) <> p then newbranch p t k (Leaf(k,[x,y]))
-          else if k land b = 0 then Branch(p,b,upd l,r)
-          else Branch(p,b,l,upd r) in
-    upd in
-  let rec combine op z t1 t2 =
-    match (t1,t2) with
-      Empty,_ -> t2
-    | _,Empty -> t1
-    | Leaf(h1,l1),Leaf(h2,l2) ->
-          if h1 = h2 then
-            let l = combine_list op z l1 l2 in
-            if l = [] then Empty else Leaf(h1,l)
-          else newbranch h1 t1 h2 t2
-    | (Leaf(k,lis) as lf),(Branch(p,b,l,r) as br) |
-      (Branch(p,b,l,r) as br),(Leaf(k,lis) as lf) ->
-          if k land (b - 1) = p then
-            if k land b = 0 then
-              let l' = combine op z lf l in
-              if is_undefined l' then r else Branch(p,b,l',r)
-            else
-              let r' = combine op z lf r in
-              if is_undefined r' then l else Branch(p,b,l,r')
-          else
-            newbranch k lf p br
-    | Branch(p1,b1,l1,r1),Branch(p2,b2,l2,r2) ->
-          if b1 < b2 then
-            if p2 land (b1 - 1) <> p1 then newbranch p1 t1 p2 t2
-            else if p2 land b1 = 0 then
-              let l = combine op z l1 t2 in
-              if is_undefined l then r1 else Branch(p1,b1,l,r1)
-            else
-              let r = combine op z r1 t2 in
-              if is_undefined r then l1 else Branch(p1,b1,l1,r)
-          else if b2 < b1 then
-            if p1 land (b2 - 1) <> p2 then newbranch p1 t1 p2 t2
-            else if p1 land b2 = 0 then
-              let l = combine op z t1 l2 in
-              if is_undefined l then r2 else Branch(p2,b2,l,r2)
-            else
-              let r = combine op z t1 r2 in
-              if is_undefined r then l2 else Branch(p2,b2,l2,r)
-          else if p1 = p2 then
-            let l = combine op z l1 l2 and r = combine op z r1 r2 in
-            if is_undefined l then r
-            else if is_undefined r then l else Branch(p1,b1,l,r)
-          else
-            newbranch p1 t1 p2 t2 in
-  (|->),combine;;
-
-(* ------------------------------------------------------------------------- *)
-(* Special case of point function.                                           *)
-(* ------------------------------------------------------------------------- *)
-
-let (|=>) = fun x y -> (x |-> y) undefined;;
-
-
-(* ------------------------------------------------------------------------- *)
-(* Grab an arbitrary element.                                                *)
-(* ------------------------------------------------------------------------- *)
-
-let rec choose t =
-  match t with
-    Empty -> failwith "choose: completely undefined function"
-  | Leaf(h,l) -> hd l
-  | Branch(b,p,t1,t2) -> choose t1;;
-
-(* ------------------------------------------------------------------------- *)
-(* Application.                                                              *)
-(* ------------------------------------------------------------------------- *)
-
-let applyd =
-  let rec apply_listd l d x =
-    match l with
-      (a,b)::t -> if x =? a then b
-                  else if x >? a then apply_listd t d x else d x
-    | [] -> d x in
-  fun f d x ->
-    let k = Hashtbl.hash x in
-    let rec look t =
-      match t with
-        Leaf(h,l) when h = k -> apply_listd l d x
-      | Branch(p,b,l,r) -> look (if k land b = 0 then l else r)
-      | _ -> d x in
-    look f;;
-
-let apply f = applyd f (fun x -> failwith "apply");;
-
-let tryapplyd f a d = applyd f (fun x -> d) a;;
-
-let defined f x = try apply f x; true with Failure _ -> false;;
-
-(* ------------------------------------------------------------------------- *)
-(* Undefinition.                                                             *)
-(* ------------------------------------------------------------------------- *)
-
-let undefine =
-  let rec undefine_list x l =
-    match l with
-      (a,b as ab)::t ->
-          if x =? a then t
-          else if x <? a then l else
-          let t' = undefine_list x t in
-          if t' == t then l else ab::t'
-    | [] -> [] in
-  fun x ->
-    let k = Hashtbl.hash x in
-    let rec und t =
-      match t with
-        Leaf(h,l) when h = k ->
-          let l' = undefine_list x l in
-          if l' == l then t
-          else if l' = [] then Empty
-          else Leaf(h,l')
-      | Branch(p,b,l,r) when k land (b - 1) = p ->
-          if k land b = 0 then
-            let l' = und l in
-            if l' == l then t
-            else if is_undefined l' then r
-            else Branch(p,b,l',r)
-          else
-            let r' = und r in
-            if r' == r then t
-            else if is_undefined r' then l
-            else Branch(p,b,l,r')
-      | _ -> t in
-    und;;
-
-
-(* ------------------------------------------------------------------------- *)
-(* Mapping to sorted-list representation of the graph, domain and range.     *)
-(* ------------------------------------------------------------------------- *)
-
-let graph f = setify (foldl (fun a x y -> (x,y)::a) [] f);;
-
-let dom f = setify(foldl (fun a x y -> x::a) [] f);;
-
-let ran f = setify(foldl (fun a x y -> y::a) [] f);;
-
-(* ------------------------------------------------------------------------- *)
-(* Turn a rational into a decimal string with d sig digits.                  *)
-(* ------------------------------------------------------------------------- *)
-
-let decimalize =
-  let rec normalize y =
-    if abs_num y </ Int 1 // Int 10 then normalize (Int 10 */ y) - 1
-    else if abs_num y >=/ Int 1 then normalize (y // Int 10) + 1
-    else 0 in
-  fun d x ->
-    if x =/ Int 0 then "0.0" else
-    let y = abs_num x in
-    let e = normalize y in
-    let z = pow10(-e) */ y +/ Int 1 in
-    let k = round_num(pow10 d */ z) in
-    (if x </ Int 0 then "-0." else "0.") ^
-    implode(tl(explode(string_of_num k))) ^
-    (if e = 0 then "" else "e"^string_of_int e);;
-
-
-(* ------------------------------------------------------------------------- *)
-(* Iterations over numbers, and lists indexed by numbers.                    *)
-(* ------------------------------------------------------------------------- *)
-
-let rec itern k l f a =
-  match l with
-    [] -> a
-  | h::t -> itern (k + 1) t f (f h k a);;
-
-let rec iter (m,n) f a =
-  if n < m then a
-  else iter (m+1,n) f (f m a);;
-
-(* ------------------------------------------------------------------------- *)
-(* The main types.                                                           *)
-(* ------------------------------------------------------------------------- *)
-
-type vector = int*(int,num)func;;
-
-type matrix = (int*int)*(int*int,num)func;;
-
-type monomial = (vname,int)func;;
-
-type poly = (monomial,num)func;;
-
-(* ------------------------------------------------------------------------- *)
-(* Assignment avoiding zeros.                                                *)
-(* ------------------------------------------------------------------------- *)
-
-let (|-->) x y a = if y =/ Int 0 then a else (x |-> y) a;;
-
-(* ------------------------------------------------------------------------- *)
-(* This can be generic.                                                      *)
-(* ------------------------------------------------------------------------- *)
-
-let element (d,v) i = tryapplyd v i (Int 0);;
-
-let mapa f (d,v) =
-  d,foldl (fun a i c -> (i |--> f(c)) a) undefined v;;
-
-let is_zero (d,v) =
-  match v with
-    Empty -> true
-  | _ -> false;;
-
-(* ------------------------------------------------------------------------- *)
-(* Vectors. Conventionally indexed 1..n.                                     *)
-(* ------------------------------------------------------------------------- *)
-
-let vector_0 n = (n,undefined:vector);;
-
-let dim (v:vector) = fst v;;
-
-let vector_const c n =
-  if c =/ Int 0 then vector_0 n
-  else (n,itlist (fun k -> k |-> c) (1--n) undefined :vector);;
-
-let vector_1 = vector_const (Int 1);;
-
-let vector_cmul c (v:vector) =
-  let n = dim v in
-  if c =/ Int 0 then vector_0 n
-  else n,mapf (fun x -> c */ x) (snd v);;
-
-let vector_neg (v:vector) = (fst v,mapf minus_num (snd v) :vector);;
-
-let vector_add (v1:vector) (v2:vector) =
-  let m = dim v1 and n = dim v2 in
-  if m <> n then failwith "vector_add: incompatible dimensions" else
-  (n,combine (+/) (fun x -> x =/ Int 0) (snd v1) (snd v2) :vector);;
-
-let vector_sub v1 v2 = vector_add v1 (vector_neg v2);;
-
-let vector_of_list l =
-  let n = length l in
-  (n,itlist2 (|->) (1--n) l undefined :vector);;
-
-(* ------------------------------------------------------------------------- *)
-(* Matrices; again rows and columns indexed from 1.                          *)
-(* ------------------------------------------------------------------------- *)
-
-let matrix_0 (m,n) = ((m,n),undefined:matrix);;
-
-let dimensions (m:matrix) = fst m;;
-
-let matrix_const c (m,n as mn) =
-  if m <> n then failwith "matrix_const: needs to be square"
-  else if c =/ Int 0 then matrix_0 mn
-  else (mn,itlist (fun k -> (k,k) |-> c) (1--n) undefined :matrix);;
-
-let matrix_1 = matrix_const (Int 1);;
-
-let matrix_cmul c (m:matrix) =
-  let (i,j) = dimensions m in
-  if c =/ Int 0 then matrix_0 (i,j)
-  else (i,j),mapf (fun x -> c */ x) (snd m);;
-
-let matrix_neg (m:matrix) = (dimensions m,mapf minus_num (snd m) :matrix);;
-
-let matrix_add (m1:matrix) (m2:matrix) =
-  let d1 = dimensions m1 and d2 = dimensions m2 in
-  if d1 <> d2 then failwith "matrix_add: incompatible dimensions"
-  else (d1,combine (+/) (fun x -> x =/ Int 0) (snd m1) (snd m2) :matrix);;
-
-let matrix_sub m1 m2 = matrix_add m1 (matrix_neg m2);;
-
-let row k (m:matrix) =
-  let i,j = dimensions m in
-  (j,
-   foldl (fun a (i,j) c -> if i = k then (j |-> c) a else a) undefined (snd m)
-   : vector);;
-
-let column k (m:matrix) =
-  let i,j = dimensions m in
-  (i,
-   foldl (fun a (i,j) c -> if j = k then (i |-> c) a else a) undefined (snd m)
-   : vector);;
-
-let transp (m:matrix) =
-  let i,j = dimensions m in
-  ((j,i),foldl (fun a (i,j) c -> ((j,i) |-> c) a) undefined (snd m) :matrix);;
-
-let diagonal (v:vector) =
-  let n = dim v in
-  ((n,n),foldl (fun a i c -> ((i,i) |-> c) a) undefined (snd v) : matrix);;
-
-let matrix_of_list l =
-  let m = length l in
-  if m = 0 then matrix_0 (0,0) else
-  let n = length (hd l) in
-  (m,n),itern 1 l (fun v i -> itern 1 v (fun c j -> (i,j) |-> c)) undefined;;
-
-(* ------------------------------------------------------------------------- *)
-(* Monomials.                                                                *)
-(* ------------------------------------------------------------------------- *)
-
-let monomial_eval assig (m:monomial) =
-  foldl (fun a x k -> a */ power_num (apply assig x) (Int k))
-        (Int 1) m;;
-
-let monomial_1 = (undefined:monomial);;
-
-let monomial_var x = (x |=> 1 :monomial);;
-
-let (monomial_mul:monomial->monomial->monomial) =
-  combine (+) (fun x -> false);;
-
-let monomial_pow (m:monomial) k =
-  if k = 0 then monomial_1
-  else mapf (fun x -> k * x) m;;
-
-let monomial_divides (m1:monomial) (m2:monomial) =
-  foldl (fun a x k -> tryapplyd m2 x 0 >= k & a) true m1;;
-
-let monomial_div (m1:monomial) (m2:monomial) =
-  let m = combine (+) (fun x -> x = 0) m1 (mapf (fun x -> -x) m2) in
-  if foldl (fun a x k -> k >= 0 & a) true m then m
-  else failwith "monomial_div: non-divisible";;
-
-let monomial_degree x (m:monomial) = tryapplyd m x 0;;
-
-let monomial_lcm (m1:monomial) (m2:monomial) =
-  (itlist (fun x -> x |-> max (monomial_degree x m1) (monomial_degree x m2))
-          (union (dom m1) (dom m2)) undefined :monomial);;
-
-let monomial_multidegree (m:monomial) = foldl (fun a x k -> k + a) 0 m;;
-
-let monomial_variables m = dom m;;
-
-(* ------------------------------------------------------------------------- *)
-(* Polynomials.                                                              *)
-(* ------------------------------------------------------------------------- *)
-
-let eval assig (p:poly) =
-  foldl (fun a m c -> a +/ c */ monomial_eval assig m) (Int 0) p;;
-
-let poly_0 = (undefined:poly);;
-
-let poly_isconst (p:poly) = foldl (fun a m c -> m = monomial_1 & a) true p;;
-
-let poly_var x = ((monomial_var x) |=> Int 1 :poly);;
-
-let poly_const c =
-  if c =/ Int 0 then poly_0 else (monomial_1 |=> c);;
-
-let poly_cmul c (p:poly) =
-  if c =/ Int 0 then poly_0
-  else mapf (fun x -> c */ x) p;;
-
-let poly_neg (p:poly) = (mapf minus_num p :poly);;
-
-let poly_add (p1:poly) (p2:poly) =
-  (combine (+/) (fun x -> x =/ Int 0) p1 p2 :poly);;
-
-let poly_sub p1 p2 = poly_add p1 (poly_neg p2);;
-
-let poly_cmmul (c,m) (p:poly) =
-  if c =/ Int 0 then poly_0
-  else if m = monomial_1 then mapf (fun d -> c */ d) p
-  else foldl (fun a m' d -> (monomial_mul m m' |-> c */ d) a) poly_0 p;;
-
-let poly_mul (p1:poly) (p2:poly) =
-  foldl (fun a m c -> poly_add (poly_cmmul (c,m) p2) a) poly_0 p1;;
-
-let poly_div (p1:poly) (p2:poly) =
-  if not(poly_isconst p2) then failwith "poly_div: non-constant" else
-  let c = eval undefined p2 in
-  if c =/ Int 0 then failwith "poly_div: division by zero"
-  else poly_cmul (Int 1 // c) p1;;
-
-let poly_square p = poly_mul p p;;
-
-let rec poly_pow p k =
-  if k = 0 then poly_const (Int 1)
-  else if k = 1 then p
-  else let q = poly_square(poly_pow p (k / 2)) in
-       if k mod 2 = 1 then poly_mul p q else q;;
-
-let poly_exp p1 p2 =
-  if not(poly_isconst p2) then failwith "poly_exp: not a constant" else
-  poly_pow p1 (Num.int_of_num (eval undefined p2));;
-
-let degree x (p:poly) = foldl (fun a m c -> max (monomial_degree x m) a) 0 p;;
-
-let multidegree (p:poly) =
-  foldl (fun a m c -> max (monomial_multidegree m) a) 0 p;;
-
-let poly_variables (p:poly) =
-  foldr (fun m c -> union (monomial_variables m)) p [];;
-
-(* ------------------------------------------------------------------------- *)
-(* Order monomials for human presentation.                                   *)
-(* ------------------------------------------------------------------------- *)
-
-let humanorder_varpow (x1,k1) (x2,k2) = x1 < x2 or (x1 = x2 & k1 > k2);;
-
-let humanorder_monomial =
-  let rec ord l1 l2 = match (l1,l2) with
-    _,[] -> true
-  | [],_ -> false
-  | h1::t1,h2::t2 -> humanorder_varpow h1 h2 or (h1 = h2 & ord t1 t2) in
-  fun m1 m2 -> m1 = m2 or
-               ord (sort humanorder_varpow (graph m1))
-                   (sort humanorder_varpow (graph m2));;
-
-(* ------------------------------------------------------------------------- *)
-(* Conversions to strings.                                                   *)
-(* ------------------------------------------------------------------------- *)
-
-let string_of_vector min_size max_size (v:vector) =
-  let n_raw = dim v in
-  if n_raw = 0 then "[]" else
-  let n = max min_size (min n_raw max_size) in
-  let xs = map ((o) string_of_num (element v)) (1--n) in
-  "[" ^ end_itlist (fun s t -> s ^ ", " ^ t) xs ^
-  (if n_raw > max_size then ", ...]" else "]");;
-
-let string_of_matrix max_size (m:matrix) =
-  let i_raw,j_raw = dimensions m in
-  let i = min max_size i_raw and j = min max_size j_raw in
-  let rstr = map (fun k -> string_of_vector j j (row k m)) (1--i) in
-  "["^end_itlist(fun s t -> s^";\n "^t) rstr ^
-  (if j > max_size then "\n ...]" else "]");;
-
-let string_of_vname (v:vname): string = (v: string);;
-
-let rec string_of_term t =
-  match t with
-  Opp t1 -> "(- " ^ string_of_term t1 ^ ")"
-| Add (t1, t2) -> 
-   "(" ^ (string_of_term t1) ^ " + " ^ (string_of_term t2) ^ ")"
-| Sub (t1, t2) -> 
-   "(" ^ (string_of_term t1) ^ " - " ^ (string_of_term t2) ^ ")"
-| Mul (t1, t2) -> 
-   "(" ^ (string_of_term t1) ^ " * " ^ (string_of_term t2) ^ ")"
-| Inv t1 -> "(/ " ^ string_of_term t1 ^ ")"
-| Div (t1, t2) -> 
-   "(" ^ (string_of_term t1) ^ " / " ^ (string_of_term t2) ^ ")"
-| Pow (t1, n1) -> 
-   "(" ^ (string_of_term t1) ^ " ^ " ^ (string_of_int n1) ^ ")"
-| Zero -> "0"
-| Var v -> "x" ^ (string_of_vname v)
-| Const x -> string_of_num x;;
-
-
-let string_of_varpow x k =
-  if k = 1 then string_of_vname x else string_of_vname x^"^"^string_of_int k;;
-
-let string_of_monomial m =
-  if m = monomial_1 then "1" else
-  let vps = List.fold_right (fun (x,k) a -> string_of_varpow x k :: a)
-                            (sort humanorder_varpow (graph m)) [] in
-  end_itlist (fun s t -> s^"*"^t) vps;;
-
-let string_of_cmonomial (c,m) =
-  if m = monomial_1 then string_of_num c
-  else if c =/ Int 1 then string_of_monomial m
-  else string_of_num c ^ "*" ^ string_of_monomial m;;
-
-let string_of_poly (p:poly) =
-  if p = poly_0 then "<<0>>" else
-  let cms = sort (fun (m1,_) (m2,_) -> humanorder_monomial m1 m2) (graph p) in
-  let s =
-    List.fold_left (fun a (m,c) ->
-             if c </ Int 0 then a ^ " - " ^ string_of_cmonomial(minus_num c,m)
-             else a ^ " + " ^ string_of_cmonomial(c,m))
-          "" cms in
-  let s1 = String.sub s 0 3
-  and s2 = String.sub s 3 (String.length s - 3) in
-  "<<" ^(if s1 = " + " then s2 else "-"^s2)^">>";;
-
-(* ------------------------------------------------------------------------- *)
-(* Printers.                                                                 *)
-(* ------------------------------------------------------------------------- *)
-
-let print_vector v = Format.print_string(string_of_vector 0 20 v);;
-
-let print_matrix m = Format.print_string(string_of_matrix 20 m);;
-
-let print_monomial m = Format.print_string(string_of_monomial m);;
-
-let print_poly m = Format.print_string(string_of_poly m);;
-
-(*
-#install_printer print_vector;;
-#install_printer print_matrix;;
-#install_printer print_monomial;;
-#install_printer print_poly;;
-*)
-
-(* ------------------------------------------------------------------------- *)
-(* Conversion from term.                                                     *)
-(* ------------------------------------------------------------------------- *)
-
-let rec poly_of_term t = match t with
-  Zero -> poly_0 
-| Const n -> poly_const n
-| Var x -> poly_var x
-| Opp t1 -> poly_neg (poly_of_term t1)
-| Inv t1 -> 
-      let p = poly_of_term t1 in
-      if poly_isconst p then poly_const(Int 1 // eval undefined p)
-      else failwith "poly_of_term: inverse of non-constant polyomial"
-| Add (l, r) -> poly_add (poly_of_term l) (poly_of_term r)
-| Sub (l, r) -> poly_sub (poly_of_term l) (poly_of_term r)
-| Mul (l, r) -> poly_mul (poly_of_term l) (poly_of_term r)
-| Div (l, r) ->
-      let p = poly_of_term l and q = poly_of_term r in
-      if poly_isconst q then poly_cmul (Int 1 // eval undefined q) p
-      else failwith "poly_of_term: division by non-constant polynomial"
-| Pow (t, n) ->
-      poly_pow (poly_of_term t) n;;
-
-(* ------------------------------------------------------------------------- *)
-(* String of vector (just a list of space-separated numbers).                *)
-(* ------------------------------------------------------------------------- *)
-
-let sdpa_of_vector (v:vector) =
-  let n = dim v in
-  let strs = map (o (decimalize 20) (element v)) (1--n) in
-  end_itlist (fun x y -> x ^ " " ^ y) strs ^ "\n";;
-
-(* ------------------------------------------------------------------------- *)
-(* String for block diagonal matrix numbered k.                              *)
-(* ------------------------------------------------------------------------- *)
-
-let sdpa_of_blockdiagonal k m =
-  let pfx = string_of_int k ^" " in
-  let ents =
-    foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in
-  let entss = sort (increasing fst) ents in
-  itlist (fun ((b,i,j),c) a ->
-     pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^
-     " " ^ decimalize 20 c ^ "\n" ^ a) entss "";;
-
-(* ------------------------------------------------------------------------- *)
-(* String for a matrix numbered k, in SDPA sparse format.                    *)
-(* ------------------------------------------------------------------------- *)
-
-let sdpa_of_matrix k (m:matrix) =
-  let pfx = string_of_int k ^ " 1 " in
-  let ms = foldr (fun (i,j) c a -> if i > j then a else ((i,j),c)::a)
-                 (snd m) [] in
-  let mss = sort (increasing fst) ms in
-  itlist (fun ((i,j),c) a ->
-     pfx ^ string_of_int i ^ " " ^ string_of_int j ^
-     " " ^ decimalize 20 c ^ "\n" ^ a) mss "";;
-
-(* ------------------------------------------------------------------------- *)
-(* String in SDPA sparse format for standard SDP problem:                    *)
-(*                                                                           *)
-(*    X = v_1 * [M_1] + ... + v_m * [M_m] - [M_0] must be PSD                *)
-(*    Minimize obj_1 * v_1 + ... obj_m * v_m                                 *)
-(* ------------------------------------------------------------------------- *)
-
-let sdpa_of_problem comment obj mats =
-  let m = length mats - 1
-  and n,_ = dimensions (hd mats) in
-  "\"" ^ comment ^ "\"\n" ^
-  string_of_int m ^ "\n" ^
-  "1\n" ^
-  string_of_int n ^ "\n" ^
-  sdpa_of_vector obj ^
-  itlist2 (fun k m a -> sdpa_of_matrix (k - 1) m ^ a)
-          (1--length mats) mats "";;
-
-(* ------------------------------------------------------------------------- *)
-(* More parser basics.                                                       *)
-(* ------------------------------------------------------------------------- *)
-
-exception Noparse;;
-
-
-let isspace,issep,isbra,issymb,isalpha,isnum,isalnum =
-  let charcode s = Char.code(String.get s 0) in
-  let spaces = " \t\n\r"
-  and separators = ",;"
-  and brackets = "()[]{}"
-  and symbs = "\\!@#$%^&*-+|\\<=>/?~.:"
-  and alphas = "'abcdefghijklmnopqrstuvwxyz_ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-  and nums = "0123456789" in
-  let allchars = spaces^separators^brackets^symbs^alphas^nums in
-  let csetsize = itlist ((o) max charcode) (explode allchars) 256 in
-  let ctable = Array.make csetsize 0 in
-  do_list (fun c -> Array.set ctable (charcode c) 1) (explode spaces);
-  do_list (fun c -> Array.set ctable (charcode c) 2) (explode separators);
-  do_list (fun c -> Array.set ctable (charcode c) 4) (explode brackets);
-  do_list (fun c -> Array.set ctable (charcode c) 8) (explode symbs);
-  do_list (fun c -> Array.set ctable (charcode c) 16) (explode alphas);
-  do_list (fun c -> Array.set ctable (charcode c) 32) (explode nums);
-  let isspace c = Array.get ctable (charcode c) = 1
-  and issep c  = Array.get ctable (charcode c) = 2
-  and isbra c  = Array.get ctable (charcode c) = 4
-  and issymb c = Array.get ctable (charcode c) = 8
-  and isalpha c = Array.get ctable (charcode c) = 16
-  and isnum c = Array.get ctable (charcode c) = 32
-  and isalnum c = Array.get ctable (charcode c) >= 16 in
-  isspace,issep,isbra,issymb,isalpha,isnum,isalnum;;
-
-let (||) parser1 parser2 input =
-  try parser1 input
-  with Noparse -> parser2 input;;
-
-let (++) parser1 parser2 input =
-  let result1,rest1 = parser1 input in
-  let result2,rest2 = parser2 rest1 in
-  (result1,result2),rest2;;
-
-let rec many prs input =
-  try let result,next = prs input in
-      let results,rest = many prs next in
-      (result::results),rest
-  with Noparse -> [],input;;
-
-let (>>) prs treatment input =
-  let result,rest = prs input in
-  treatment(result),rest;;
-
-let fix err prs input =
-  try prs input
-  with Noparse -> failwith (err ^ " expected");;
-
-let rec listof prs sep err =
-  prs ++ many (sep ++ fix err prs >> snd) >> (fun (h,t) -> h::t);;
-
-let possibly prs input =
-  try let x,rest = prs input in [x],rest
-  with Noparse -> [],input;;
-
-let some p =
-  function
-      [] -> raise Noparse
-    | (h::t) -> if p h then (h,t) else raise Noparse;;
-
-let a tok = some (fun item -> item = tok);;
-
-let rec atleast n prs i =
-  (if n <= 0 then many prs
-   else prs ++ atleast (n - 1) prs >> (fun (h,t) -> h::t)) i;;
-
-let finished input =
-  if input = [] then 0,input else failwith "Unparsed input";;
-
-let word s =
-   end_itlist (fun p1 p2 -> (p1 ++ p2) >> (fun (s,t) -> s^t))
-              (map a (explode s));;
-
-let token s =
-  many (some isspace) ++ word s ++ many (some isspace)
-  >> (fun ((_,t),_) -> t);;
-
-let decimal =
-  let numeral = some isnum in
-  let decimalint = atleast 1 numeral >> ((o) Num.num_of_string implode) in
-  let decimalfrac = atleast 1 numeral
-    >> (fun s -> Num.num_of_string(implode s) // pow10 (length s)) in
-  let decimalsig =
-    decimalint ++ possibly (a "." ++ decimalfrac >> snd)
-    >> (function (h,[]) -> h | (h,[x]) -> h +/ x | _ -> failwith "decimalsig") in
-  let signed prs =
-       a "-" ++ prs >> ((o) minus_num snd)
-    || a "+" ++ prs >> snd
-    || prs in
-  let exponent = (a "e" || a "E") ++ signed decimalint >> snd in
-    signed decimalsig ++ possibly exponent
-    >> (function (h,[]) -> h | (h,[x]) -> h */ power_num (Int 10) x | _ -> 
-     failwith "exponent");;
-
-let mkparser p s =
-  let x,rst = p(explode s) in
-  if rst = [] then x else failwith "mkparser: unparsed input";;
-
-let parse_decimal = mkparser decimal;;
-
-(* ------------------------------------------------------------------------- *)
-(* Parse back a vector.                                                      *)
-(* ------------------------------------------------------------------------- *)
-
-let parse_csdpoutput =
-  let rec skipupto dscr prs inp =
-      (dscr ++ prs >> snd
-    || some (fun c -> true) ++ skipupto dscr prs >> snd) inp in
-  let ignore inp = (),[] in
-  let csdpoutput =
-    (decimal ++ many(a " " ++ decimal >> snd) >> (fun (h,t) -> h::t)) ++
-    (a " " ++ a "\n" ++ ignore) >> ((o) vector_of_list fst) in
-  mkparser csdpoutput;;
-
-(* ------------------------------------------------------------------------- *)
-(* CSDP parameters; so far I'm sticking with the defaults.                   *)
-(* ------------------------------------------------------------------------- *)
-
-let csdp_default_parameters =
-"axtol=1.0e-8
-atytol=1.0e-8
-objtol=1.0e-8
-pinftol=1.0e8
-dinftol=1.0e8
-maxiter=100
-minstepfrac=0.9
-maxstepfrac=0.97
-minstepp=1.0e-8
-minstepd=1.0e-8
-usexzgap=1
-tweakgap=0
-affine=0
-printlevel=1
-";;
-
-let csdp_params = csdp_default_parameters;;
-
-(* ------------------------------------------------------------------------- *)
-(* The same thing with CSDP.                                                 *)
-(* Modified by the Coq development team to use a cache                       *)
-(* ------------------------------------------------------------------------- *)
-
-let buffer_add_line buff line =
-  Buffer.add_string buff line; Buffer.add_char buff '\n'
-
-let string_of_file filename =
-  let fd = open_in filename in
-  let buff = Buffer.create 16 in
-  try while true do buffer_add_line buff (input_line fd) done; failwith ""
-  with End_of_file -> (close_in fd; Buffer.contents buff)
-
-let file_of_string filename s =
-  let fd = Pervasives.open_out filename in
-  output_string fd s; close_out fd
-
-let request_mark = "*** REQUEST ***"
-let answer_mark  = "*** ANSWER ***"
-let end_mark     = "*** END ***"
-let infeasible_mark = "Infeasible\n"
-let failure_mark    = "Failure\n"
-
-let cache_name = "csdp.cache"
-
-let look_in_cache string_problem =
-  let n = String.length string_problem in
-  try
-    let inch = open_in cache_name in
-    let rec search () =
-      while input_line inch <> request_mark do () done;
-      let i = ref 0 in
-      while !i < n & string_problem.[!i] = input_char inch do incr i done;
-      if !i < n or input_line inch <> answer_mark then
-	search ()
-      else begin
-	let buff = Buffer.create 16 in
-	let line = ref (input_line inch) in
-	while (!line <> end_mark) do
-	  buffer_add_line buff !line; line := input_line inch
-	done;
-	close_in inch;
-	Buffer.contents buff
-      end in
-    try search () with End_of_file -> close_in inch; raise Not_found
-  with Sys_error _ -> raise Not_found
-
-let flush_to_cache string_problem string_result =
-  try
-    let flags = [Open_append;Open_text;Open_creat] in
-    let outch = open_out_gen flags 0o666 cache_name in
-    begin 
-    try
-      Printf.fprintf outch "%s\n" request_mark;
-      Printf.fprintf outch "%s" string_problem;
-      Printf.fprintf outch "%s\n" answer_mark;
-      Printf.fprintf outch "%s" string_result;
-      Printf.fprintf outch "%s\n" end_mark;
-    with Sys_error _ as e -> close_out outch; raise e
-    end;
-    close_out outch
-  with Sys_error _ -> 
-    print_endline "Warning: Could not open or write to csdp cache"
-
-exception CsdpInfeasible
-
-let run_csdp dbg string_problem =
-  try
-   let res = look_in_cache string_problem in
-   if res = infeasible_mark then raise CsdpInfeasible;
-   if res = failure_mark then failwith "csdp error";
-   res
-  with Not_found ->
-  let input_file = Filename.temp_file "sos" ".dat-s" in
-  let output_file = Filename.temp_file "sos" ".dat-s" in
-  let temp_path = Filename.dirname input_file in
-  let params_file = Filename.concat temp_path "param.csdp" in
-  file_of_string input_file string_problem;
-  file_of_string params_file csdp_params;
-  let rv = Sys.command("cd "^temp_path^"; csdp "^input_file^" "^output_file^
-                       (if dbg then "" else "> /dev/null")) in
-  if rv = 1 or rv = 2 then 
-    (flush_to_cache string_problem infeasible_mark; raise CsdpInfeasible);
-  if rv = 127 then
-     (print_string "csdp not found, exiting..."; exit 1);
-  if rv <> 0 & rv <> 3 (* reduced accuracy *) then
-    (flush_to_cache string_problem failure_mark;
-     failwith("csdp: error "^string_of_int rv));
-  let string_result = string_of_file output_file in
-  flush_to_cache string_problem string_result;
-  if not dbg then
-    (Sys.remove input_file; Sys.remove output_file; Sys.remove params_file);
-  string_result
-
-let csdp obj mats =
-  try parse_csdpoutput (run_csdp !debugging (sdpa_of_problem "" obj mats))
-  with CsdpInfeasible -> failwith "csdp: Problem is infeasible"
-
-(* ------------------------------------------------------------------------- *)
-(* Try some apparently sensible scaling first. Note that this is purely to   *)
-(* get a cleaner translation to floating-point, and doesn't affect any of    *)
-(* the results, in principle. In practice it seems a lot better when there   *)
-(* are extreme numbers in the original problem.                              *)
-(* ------------------------------------------------------------------------- *)
-
-let scale_then =
-  let common_denominator amat acc =
-    foldl (fun a m c -> lcm_num (denominator c) a) acc amat
-  and maximal_element amat acc =
-    foldl (fun maxa m c -> max_num maxa (abs_num c)) acc amat in
-  fun solver obj mats ->
-    let cd1 = itlist common_denominator mats (Int 1)
-    and cd2 = common_denominator (snd obj)  (Int 1) in
-    let mats' = map (mapf (fun x -> cd1 */ x)) mats
-    and obj' = vector_cmul cd2 obj in
-    let max1 = itlist maximal_element mats' (Int 0)
-    and max2 = maximal_element (snd obj') (Int 0) in
-    let scal1 = pow2 (20-int_of_float(log(float_of_num max1) /. log 2.0))
-    and scal2 = pow2 (20-int_of_float(log(float_of_num max2) /. log 2.0)) in
-    let mats'' = map (mapf (fun x -> x */ scal1)) mats'
-    and obj'' = vector_cmul scal2 obj' in
-    solver obj'' mats'';;
-
-(* ------------------------------------------------------------------------- *)
-(* Round a vector to "nice" rationals.                                       *)
-(* ------------------------------------------------------------------------- *)
-
-let nice_rational n x = round_num (n */ x) // n;;
-
-let nice_vector n = mapa (nice_rational n);;
-
-(* ------------------------------------------------------------------------- *)
-(* Reduce linear program to SDP (diagonal matrices) and test with CSDP. This *)
-(* one tests A [-1;x1;..;xn] >= 0 (i.e. left column is negated constants).   *)
-(* ------------------------------------------------------------------------- *)
-
-let linear_program_basic a =
-  let m,n = dimensions a in
-  let mats =  map (fun j -> diagonal (column j a)) (1--n)
-  and obj = vector_const (Int 1) m in
-  try ignore (run_csdp false (sdpa_of_problem "" obj mats)); true
-  with CsdpInfeasible -> false
-
-(* ------------------------------------------------------------------------- *)
-(* Test whether a point is in the convex hull of others. Rather than use     *)
-(* computational geometry, express as linear inequalities and call CSDP.     *)
-(* This is a bit lazy of me, but it's easy and not such a bottleneck so far. *)
-(* ------------------------------------------------------------------------- *)
-
-let in_convex_hull pts pt =
-  let pts1 = (1::pt) :: map (fun x -> 1::x) pts in
-  let pts2 = map (fun p -> map (fun x -> -x) p @ p) pts1 in
-  let n = length pts + 1
-  and v = 2 * (length pt + 1) in
-  let m = v + n - 1 in
-  let mat =
-    (m,n),
-    itern 1 pts2 (fun pts j -> itern 1 pts (fun x i -> (i,j) |-> Int x))
-                 (iter (1,n) (fun i -> (v + i,i+1) |-> Int 1) undefined) in
-  linear_program_basic mat;;
-
-(* ------------------------------------------------------------------------- *)
-(* Filter down a set of points to a minimal set with the same convex hull.   *)
-(* ------------------------------------------------------------------------- *)
-
-let minimal_convex_hull =
-  let augment1 = function (m::ms) -> if in_convex_hull ms m then ms else ms@[m] 
-          | _ -> failwith "augment1"
-  in
-  let augment m ms = funpow 3 augment1 (m::ms) in
-  fun mons ->
-    let mons' = itlist augment (tl mons) [hd mons] in
-    funpow (length mons') augment1 mons';;
-
-(* ------------------------------------------------------------------------- *)
-(* Stuff for "equations" (generic A->num functions).                         *)
-(* ------------------------------------------------------------------------- *)
-
-let equation_cmul c eq =
-  if c =/ Int 0 then Empty else mapf (fun d -> c */ d) eq;;
-
-let equation_add eq1 eq2 = combine (+/) (fun x -> x =/ Int 0) eq1 eq2;;
-
-let equation_eval assig eq =
-  let value v = apply assig v in
-  foldl (fun a v c -> a +/ value(v) */ c) (Int 0) eq;;
-
-(* ------------------------------------------------------------------------- *)
-(* Eliminate among linear equations: return unconstrained variables and      *)
-(* assignments for the others in terms of them. We give one pseudo-variable  *)
-(* "one" that's used for a constant term.                                    *)
-(* ------------------------------------------------------------------------- *)
-
-
-let eliminate_equations =
-  let rec extract_first p l =
-    match l with
-      [] -> failwith "extract_first"
-    | h::t -> if p(h) then h,t else
-              let k,s = extract_first p t in
-              k,h::s in
-  let rec eliminate vars dun eqs =
-    match vars with
-      [] -> if forall is_undefined eqs then dun
-            else (raise Unsolvable)
-    | v::vs ->
-            try let eq,oeqs = extract_first (fun e -> defined e v) eqs in
-                let a = apply eq v in
-                let eq' = equation_cmul (Int(-1) // a) (undefine v eq) in
-                let elim e =
-                  let b = tryapplyd e v (Int 0) in
-                  if b =/ Int 0 then e else
-                  equation_add e (equation_cmul (minus_num b // a) eq) in
-                eliminate vs ((v |-> eq') (mapf elim dun)) (map elim oeqs)
-            with Failure _ -> eliminate vs dun eqs in
-  fun one vars eqs ->
-    let assig = eliminate vars undefined eqs in
-    let vs = foldl (fun a x f -> subtract (dom f) [one] @ a) [] assig in
-    setify vs,assig;;
-
-(* ------------------------------------------------------------------------- *)
-(* Eliminate all variables, in an essentially arbitrary order.               *)
-(* ------------------------------------------------------------------------- *)
-
-let eliminate_all_equations one =
-  let choose_variable eq =
-    let (v,_) = choose eq in
-    if v = one then
-      let eq' = undefine v eq in
-      if is_undefined eq' then failwith "choose_variable" else
-      let (w,_) = choose eq' in w
-    else v in
-  let rec eliminate dun eqs =
-    match eqs with
-      [] -> dun
-    | eq::oeqs ->
-        if is_undefined eq then eliminate dun oeqs else
-        let v = choose_variable eq in
-        let a = apply eq v in
-        let eq' = equation_cmul (Int(-1) // a) (undefine v eq) in
-        let elim e =
-          let b = tryapplyd e v (Int 0) in
-          if b =/ Int 0 then e else
-          equation_add e (equation_cmul (minus_num b // a) eq) in
-        eliminate ((v |-> eq') (mapf elim dun)) (map elim oeqs) in
-  fun eqs ->
-    let assig = eliminate undefined eqs in
-    let vs = foldl (fun a x f -> subtract (dom f) [one] @ a) [] assig in
-    setify vs,assig;;
-
-(* ------------------------------------------------------------------------- *)
-(* Solve equations by assigning arbitrary numbers.                           *)
-(* ------------------------------------------------------------------------- *)
-
-let solve_equations one eqs =
-  let vars,assigs = eliminate_all_equations one eqs in
-  let vfn = itlist (fun v -> (v |-> Int 0)) vars (one |=> Int(-1)) in
-  let ass =
-    combine (+/) (fun c -> false) (mapf (equation_eval vfn) assigs) vfn in
-  if forall (fun e -> equation_eval ass e =/ Int 0) eqs
-  then undefine one ass else raise Sanity;;
-
-(* ------------------------------------------------------------------------- *)
-(* Hence produce the "relevant" monomials: those whose squares lie in the    *)
-(* Newton polytope of the monomials in the input. (This is enough according  *)
-(* to Reznik: "Extremal PSD forms with few terms", Duke Math. Journal,       *)
-(* vol 45, pp. 363--374, 1978.                                               *)
-(*                                                                           *)
-(* These are ordered in sort of decreasing degree. In particular the         *)
-(* constant monomial is last; this gives an order in diagonalization of the  *)
-(* quadratic form that will tend to display constants.                       *)
-(* ------------------------------------------------------------------------- *)
-
-let newton_polytope pol =
-  let vars = poly_variables pol in
-  let mons = map (fun m -> map (fun x -> monomial_degree x m) vars) (dom pol)
-  and ds = map (fun x -> (degree x pol + 1) / 2) vars in
-  let all = itlist (fun n -> allpairs (fun h t -> h::t) (0--n)) ds [[]]
-  and mons' = minimal_convex_hull mons in
-  let all' =
-    filter (fun m -> in_convex_hull mons' (map (fun x -> 2 * x) m)) all in
-  map (fun m -> itlist2 (fun v i a -> if i = 0 then a else (v |-> i) a)
-                        vars m monomial_1) (rev all');;
-
-(* ------------------------------------------------------------------------- *)
-(* Diagonalize (Cholesky/LDU) the matrix corresponding to a quadratic form.  *)
-(* ------------------------------------------------------------------------- *)
-
-let diag m =
-  let nn = dimensions m in
-  let n = fst nn in
-  if snd nn <> n then failwith "diagonalize: non-square matrix" else
-  let rec diagonalize i m =
-    if is_zero m then [] else
-    let a11 = element m (i,i) in
-    if a11 </ Int 0 then failwith "diagonalize: not PSD"
-    else if a11 =/ Int 0 then
-      if is_zero(row i m) then diagonalize (i + 1) m
-      else failwith "diagonalize: not PSD"
-    else
-      let v = row i m in
-      let v' = mapa (fun a1k -> a1k // a11) v in
-      let m' =
-      (n,n),
-      iter (i+1,n) (fun j ->
-          iter (i+1,n) (fun k ->
-              ((j,k) |--> (element m (j,k) -/ element v j */ element v' k))))
-          undefined in
-      (a11,v')::diagonalize (i + 1) m' in
-  diagonalize 1 m;;
-
-(* ------------------------------------------------------------------------- *)
-(* Adjust a diagonalization to collect rationals at the start.               *)
-(* ------------------------------------------------------------------------- *)
-
-let deration d =
-  if d = [] then Int 0,d else
-  let adj(c,l) =
-    let a = foldl (fun a i c -> lcm_num a (denominator c)) (Int 1) (snd l) //
-            foldl (fun a i c -> gcd_num a (numerator c)) (Int 0) (snd l) in
-    (c // (a */ a)),mapa (fun x -> a */ x) l in
-  let d' = map adj d in
-  let a = itlist ((o) lcm_num ((o) denominator fst)) d' (Int 1) //
-          itlist ((o) gcd_num ((o) numerator fst)) d' (Int 0)  in
-  (Int 1 // a),map (fun (c,l) -> (a */ c,l)) d';;
-
-(* ------------------------------------------------------------------------- *)
-(* Enumeration of monomials with given multidegree bound.                    *)
-(* ------------------------------------------------------------------------- *)
-
-let rec enumerate_monomials d vars =
-  if d < 0 then []
-  else if d = 0 then [undefined]
-  else if vars = [] then [monomial_1] else
-  let alts =
-    map (fun k -> let oths = enumerate_monomials (d - k) (tl vars) in
-                  map (fun ks -> if k = 0 then ks else (hd vars |-> k) ks) oths)
-        (0--d) in
-  end_itlist (@) alts;;
-
-(* ------------------------------------------------------------------------- *)
-(* Enumerate products of distinct input polys with degree <= d.              *)
-(* We ignore any constant input polynomials.                                 *)
-(* Give the output polynomial and a record of how it was derived.            *)
-(* ------------------------------------------------------------------------- *)
-
-let rec enumerate_products d pols =
-  if d = 0 then [poly_const num_1,Rational_lt num_1] else if d < 0 then [] else
-  match pols with
-    [] -> [poly_const num_1,Rational_lt num_1]
-  | (p,b)::ps -> let e = multidegree p in
-                 if e = 0 then enumerate_products d ps else
-                 enumerate_products d ps @
-                 map (fun (q,c) -> poly_mul p q,Product(b,c))
-                     (enumerate_products (d - e) ps);;
-
-(* ------------------------------------------------------------------------- *)
-(* Multiply equation-parametrized poly by regular poly and add accumulator.  *)
-(* ------------------------------------------------------------------------- *)
-
-let epoly_pmul p q acc =
-  foldl (fun a m1 c ->
-           foldl (fun b m2 e ->
-                        let m =  monomial_mul m1 m2 in
-                        let es = tryapplyd b m undefined in
-                        (m |-> equation_add (equation_cmul c e) es) b)
-                 a q) acc p;;
-
-(* ------------------------------------------------------------------------- *)
-(* Usual operations on equation-parametrized poly.                           *)
-(* ------------------------------------------------------------------------- *)
-
-let epoly_cmul c l =
-  if c =/ Int 0 then undefined else mapf (equation_cmul c) l;;
-
-let epoly_neg x = epoly_cmul (Int(-1)) x;;
-
-let epoly_add x = combine equation_add is_undefined x;;
-
-let epoly_sub p q = epoly_add p (epoly_neg q);;
-
-(* ------------------------------------------------------------------------- *)
-(* Convert regular polynomial. Note that we treat (0,0,0) as -1.             *)
-(* ------------------------------------------------------------------------- *)
-
-let epoly_of_poly p =
-  foldl (fun a m c -> (m |-> ((0,0,0) |=> minus_num c)) a) undefined p;;
-
-(* ------------------------------------------------------------------------- *)
-(* String for block diagonal matrix numbered k.                              *)
-(* ------------------------------------------------------------------------- *)
-
-let sdpa_of_blockdiagonal k m =
-  let pfx = string_of_int k ^" " in
-  let ents =
-    foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in
-  let entss = sort (increasing fst) ents in
-  itlist (fun ((b,i,j),c) a ->
-     pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^
-     " " ^ decimalize 20 c ^ "\n" ^ a) entss "";;
-
-(* ------------------------------------------------------------------------- *)
-(* SDPA for problem using block diagonal (i.e. multiple SDPs)                *)
-(* ------------------------------------------------------------------------- *)
-
-let sdpa_of_blockproblem comment nblocks blocksizes obj mats =
-  let m = length mats - 1 in
-  "\"" ^ comment ^ "\"\n" ^
-  string_of_int m ^ "\n" ^
-  string_of_int nblocks ^ "\n" ^
-  (end_itlist (fun s t -> s^" "^t) (map string_of_int blocksizes)) ^
-  "\n" ^
-  sdpa_of_vector obj ^
-  itlist2 (fun k m a -> sdpa_of_blockdiagonal (k - 1) m ^ a)
-          (1--length mats) mats "";;
-
-(* ------------------------------------------------------------------------- *)
-(* Hence run CSDP on a problem in block diagonal form.                       *)
-(* ------------------------------------------------------------------------- *)
-
-let csdp_blocks nblocks blocksizes obj mats =
-  let string_problem = sdpa_of_blockproblem "" nblocks blocksizes obj mats in
-  try parse_csdpoutput (run_csdp !debugging string_problem)
-  with CsdpInfeasible -> failwith "csdp: Problem is infeasible"
-
-(* ------------------------------------------------------------------------- *)
-(* 3D versions of matrix operations to consider blocks separately.           *)
-(* ------------------------------------------------------------------------- *)
-
-let bmatrix_add = combine (+/) (fun x -> x =/ Int 0);;
-
-let bmatrix_cmul c bm =
-  if c =/ Int 0 then undefined
-  else mapf (fun x -> c */ x) bm;;
-
-let bmatrix_neg = bmatrix_cmul (Int(-1));;
-
-let bmatrix_sub m1 m2 = bmatrix_add m1 (bmatrix_neg m2);;
-
-(* ------------------------------------------------------------------------- *)
-(* Smash a block matrix into components.                                     *)
-(* ------------------------------------------------------------------------- *)
-
-let blocks blocksizes bm =
-  map (fun (bs,b0) ->
-        let m = foldl
-          (fun a (b,i,j) c -> if b = b0 then ((i,j) |-> c) a else a)
-          undefined bm in
-        (*let d = foldl (fun a (i,j) c -> max a (max i j)) 0 m in*)
-        (((bs,bs),m):matrix))
-      (zip blocksizes (1--length blocksizes));;
-
-(* ------------------------------------------------------------------------- *)
-(* Positiv- and Nullstellensatz. Flag "linf" forces a linear representation. *)
-(* ------------------------------------------------------------------------- *)
-
-let real_positivnullstellensatz_general linf d eqs leqs pol 
-  :   poly list *  (positivstellensatz * (num * poly) list) list  =
-  
-  let vars = itlist ((o) union poly_variables) (pol::eqs @ map fst leqs) [] in
-  let monoid =
-    if linf then
-      (poly_const num_1,Rational_lt num_1)::
-      (filter (fun (p,c) -> multidegree p <= d) leqs)
-    else enumerate_products d leqs in
-  let nblocks = length monoid in
-  let mk_idmultiplier k p =
-    let e = d - multidegree p in
-    let mons = enumerate_monomials e vars in
-    let nons = zip mons (1--length mons) in
-    mons,
-    itlist (fun (m,n) -> (m |-> ((-k,-n,n) |=> Int 1))) nons undefined in
-  let mk_sqmultiplier k (p,c) =
-    let e = (d - multidegree p) / 2 in
-    let mons = enumerate_monomials e vars in
-    let nons = zip mons (1--length mons) in
-    mons,
-    itlist (fun (m1,n1) ->
-      itlist (fun (m2,n2) a ->
-          let m = monomial_mul m1 m2 in
-          if n1 > n2 then a else
-          let c = if n1 = n2 then Int 1 else Int 2 in
-          let e = tryapplyd a m undefined in
-          (m |-> equation_add ((k,n1,n2) |=> c) e) a)
-         nons)
-       nons undefined in
-  let sqmonlist,sqs = unzip(map2 mk_sqmultiplier (1--length monoid) monoid)
-  and idmonlist,ids =  unzip(map2 mk_idmultiplier (1--length eqs) eqs) in
-  let blocksizes = map length sqmonlist in
-  let bigsum =
-    itlist2 (fun p q a -> epoly_pmul p q a) eqs ids
-            (itlist2 (fun (p,c) s a -> epoly_pmul p s a) monoid sqs
-                     (epoly_of_poly(poly_neg pol))) in
-  let eqns = foldl (fun a m e -> e::a) [] bigsum in
-  let pvs,assig = eliminate_all_equations (0,0,0) eqns in
-  let qvars = (0,0,0)::pvs in
-  let allassig = itlist (fun v -> (v |-> (v |=> Int 1))) pvs assig in
-  let mk_matrix v =
-    foldl (fun m (b,i,j) ass -> if b < 0 then m else
-                                let c = tryapplyd ass v (Int 0) in
-                                if c =/ Int 0 then m else
-                                ((b,j,i) |-> c) (((b,i,j) |-> c) m))
-          undefined allassig in
-  let diagents = foldl
-    (fun a (b,i,j) e -> if b > 0 & i = j then equation_add e a else a)
-    undefined allassig in
-  let mats = map mk_matrix qvars
-  and obj = length pvs,
-            itern 1 pvs (fun v i -> (i |--> tryapplyd diagents v (Int 0)))
-                        undefined in
-  let raw_vec = if pvs = [] then vector_0 0
-                else scale_then (csdp_blocks nblocks blocksizes) obj mats in
-  let find_rounding d =
-   (if !debugging then
-     (Format.print_string("Trying rounding with limit "^string_of_num d);
-      Format.print_newline())
-    else ());
-    let vec = nice_vector d raw_vec in
-    let blockmat = iter (1,dim vec)
-     (fun i a -> bmatrix_add (bmatrix_cmul (element vec i) (el i mats)) a)
-     (bmatrix_neg (el 0 mats)) in
-    let allmats = blocks blocksizes blockmat in
-    vec,map diag allmats in
-  let vec,ratdias =
-    if pvs = [] then find_rounding num_1
-    else tryfind find_rounding (map Num.num_of_int (1--31) @
-                                map pow2 (5--66)) in
-  let newassigs =
-    itlist (fun k -> el (k - 1) pvs |-> element vec k)
-           (1--dim vec) ((0,0,0) |=> Int(-1)) in
-  let finalassigs =
-    foldl (fun a v e -> (v |-> equation_eval newassigs e) a) newassigs
-          allassig in
-  let poly_of_epoly p =
-    foldl (fun a v e -> (v |--> equation_eval finalassigs e) a)
-          undefined p in
-  let mk_sos mons =
-    let mk_sq (c,m) =
-        c,itlist (fun k a -> (el (k - 1) mons |--> element m k) a)
-                 (1--length mons) undefined in
-    map mk_sq in
-  let sqs = map2 mk_sos sqmonlist ratdias
-  and cfs = map poly_of_epoly ids in
-  let msq = filter (fun (a,b) -> b <> []) (map2 (fun a b -> a,b) monoid sqs) in
-  let eval_sq sqs = itlist
-   (fun (c,q) -> poly_add (poly_cmul c (poly_mul q q))) sqs poly_0 in
-  let sanity =
-    itlist (fun ((p,c),s) -> poly_add (poly_mul p (eval_sq s))) msq
-           (itlist2 (fun p q -> poly_add (poly_mul p q)) cfs eqs
-                    (poly_neg pol)) in
-  if not(is_undefined sanity) then raise Sanity else
-     cfs,map (fun (a,b) -> snd a,b) msq;;
-
-
-let term_of_monoid l1 m = itlist  (fun i m -> Mul (nth l1 i,m)) m (Const num_1)
-
-let rec term_of_pos l1 x = match x with
-   Axiom_eq i -> failwith "term_of_pos"
- | Axiom_le i -> nth l1 i
- | Axiom_lt i -> nth l1 i
- | Monoid m   -> term_of_monoid l1 m
- | Rational_eq n -> Const n
- | Rational_le n -> Const n
- | Rational_lt n -> Const n
- | Square t -> Pow (t, 2)
- | Eqmul (t, y) -> Mul (t, term_of_pos l1 y)
- | Sum (y, z) -> Add  (term_of_pos l1 y, term_of_pos l1 z)
- | Product (y, z) -> Mul (term_of_pos l1 y, term_of_pos l1 z);;
-
-
-let dest_monomial mon = sort (increasing fst) (graph mon);;
-
-let monomial_order =
-  let rec lexorder l1 l2 =
-    match (l1,l2) with
-      [],[] -> true
-    | vps,[] -> false
-    | [],vps -> true
-    | ((x1,n1)::vs1),((x2,n2)::vs2) ->
-          if x1 < x2 then true
-          else if x2 < x1 then false
-          else if n1 < n2 then false
-          else if n2 < n1 then true
-          else lexorder vs1 vs2 in
-  fun m1 m2 ->
-    if m2 = monomial_1 then true else if m1 = monomial_1 then false else
-    let mon1 = dest_monomial m1 and mon2 = dest_monomial m2 in
-    let deg1 = itlist ((o) (+) snd) mon1 0
-    and deg2 = itlist ((o) (+) snd) mon2 0 in
-    if deg1 < deg2 then false else if deg1 > deg2 then true
-    else lexorder mon1 mon2;;
-
-let dest_poly p =
-  map (fun (m,c) -> c,dest_monomial m)
-      (sort (fun (m1,_) (m2,_) -> monomial_order m1 m2) (graph p));;
-
-(* ------------------------------------------------------------------------- *)
-(* Map back polynomials and their composites to term.                        *)
-(* ------------------------------------------------------------------------- *)
-
-let term_of_varpow =
-  fun x k ->
-    if k = 1 then Var x else Pow (Var x, k);;
-
-let term_of_monomial =
-  fun m -> if m = monomial_1 then Const num_1 else
-           let m' = dest_monomial m in
-           let vps = itlist (fun (x,k) a -> term_of_varpow x k :: a) m' [] in
-           end_itlist (fun s t -> Mul (s,t)) vps;;
-
-let term_of_cmonomial =
-  fun (m,c) ->
-    if m = monomial_1 then Const c
-    else if c =/ num_1 then term_of_monomial m
-    else Mul (Const c,term_of_monomial m);;
-
-let term_of_poly =
-  fun p ->
-    if p = poly_0 then Zero else
-    let cms = map term_of_cmonomial
-     (sort (fun (m1,_) (m2,_) -> monomial_order m1 m2) (graph p)) in
-    end_itlist (fun t1 t2 -> Add (t1,t2)) cms;;
-
-let term_of_sqterm (c,p) =
-  Product(Rational_lt c,Square(term_of_poly p));;
-
-let term_of_sos (pr,sqs) =
-  if sqs = [] then pr
-  else Product(pr,end_itlist (fun a b -> Sum(a,b)) (map term_of_sqterm sqs));;
-
-let rec deepen f n =
-  try (*print_string "Searching with depth limit ";
-      print_int n; print_newline();*) f n
-  with Failure _ -> deepen f (n + 1);;
-
-
-
-
-
-exception TooDeep
-
-let deepen_until limit f n = 
-  match compare limit 0 with
-    | 0 -> raise TooDeep
-    | -1 -> deepen f n
-    | _  -> 
-	let rec d_until  f n =
-	  try if !debugging 
-	  then (print_string "Searching with depth limit "; 
-		print_int n; print_newline()) ; f n
-	  with Failure x -> 
-	    if !debugging then (Printf.printf "solver error : %s\n" x) ; 
-	    if n = limit then raise TooDeep else  d_until f (n + 1) in
-	  d_until f n
-
-
-(* patch to remove  zero polynomials from equalities.
-   In this case, hol light loops *)
-
-let real_nonlinear_prover  depthmax eqs les lts =
-  let eq = map poly_of_term eqs
-  and le = map poly_of_term les
-  and lt = map poly_of_term lts in
-  let pol = itlist poly_mul lt (poly_const num_1)
-  and lep = map (fun (t,i) -> t,Axiom_le i) (zip le (0--(length le - 1)))
-  and ltp =  map (fun (t,i) -> t,Axiom_lt i) (zip lt (0--(length lt - 1))) 
-  and eqp =  itlist2 (fun t i res -> 
-   if t = undefined then res else (t,Axiom_eq i)::res) eq (0--(length eq - 1)) []
-  in
-    
-  let proof =
-      let leq = lep @ ltp in
-      let eq = List.map fst eqp in
-      let tryall d =
-	let e = multidegree pol (*and pol' = poly_neg pol*) in
-	let k = if e = 0 then 1 else d / e in
-	  tryfind (fun i -> d,i, 
-	   real_positivnullstellensatz_general false d  eq leq
-            (poly_neg(poly_pow pol i)))
-           (0--k) in
-      let d,i,(cert_ideal,cert_cone) = deepen_until depthmax tryall 0 in
-      let proofs_ideal =
-       map2 (fun q i -> Eqmul(term_of_poly q,i))
-        cert_ideal (List.map snd eqp)
-      and proofs_cone = map term_of_sos cert_cone
-      and proof_ne =
-       if lt = [] then Rational_lt num_1 else
-	let p = end_itlist (fun s t -> Product(s,t)) (map snd ltp) in
-	 funpow i (fun q -> Product(p,q)) (Rational_lt num_1) in
-       end_itlist (fun s t -> Sum(s,t)) (proof_ne :: proofs_ideal @ proofs_cone) in
-   if !debugging then (print_string("Translating proof certificate to Coq"); print_newline());
-   proof;;
-
-
-(* ------------------------------------------------------------------------- *)
-(* Now pure SOS stuff.                                                       *)
-(* ------------------------------------------------------------------------- *)
-
-(* ------------------------------------------------------------------------- *)
-(* Some combinatorial helper functions.                                      *)
-(* ------------------------------------------------------------------------- *)
-
-let rec allpermutations l =
-  if l = [] then [[]] else
-  itlist (fun h acc -> map (fun t -> h::t)
-                (allpermutations (subtract l [h])) @ acc) l [];;
-
-let allvarorders l =
-  map (fun vlis x -> index x vlis) (allpermutations l);;
-
-let changevariables_monomial zoln (m:monomial) =
-  foldl (fun a x k -> (assoc x zoln |-> k) a) monomial_1 m;;
-
-let changevariables zoln pol =
-  foldl (fun a m c -> (changevariables_monomial zoln m |-> c) a)
-        poly_0 pol;;
-
-(* ------------------------------------------------------------------------- *)
-(* Sum-of-squares function with some lowbrow symmetry reductions.            *)
-(* ------------------------------------------------------------------------- *)
-
-let sumofsquares_general_symmetry tool pol =
-  let vars = poly_variables pol
-  and lpps = newton_polytope pol in
-  let n = length lpps in
-  let sym_eqs =
-    let invariants = filter
-     (fun vars' ->
-        is_undefined(poly_sub pol (changevariables (zip vars vars') pol)))
-     (allpermutations vars) in
-(*    let lpps2 = allpairs monomial_mul lpps lpps in*)
-(*    let lpp2_classes =
-       setify(map (fun m ->
-         setify(map (fun vars' -> changevariables_monomial (zip vars vars') m)
-                   invariants)) lpps2) in *)
-    let lpns = zip lpps (1--length lpps) in
-    let lppcs =
-      filter (fun (m,(n1,n2)) -> n1 <= n2)
-             (allpairs
-               (fun (m1,n1) (m2,n2) -> (m1,m2),(n1,n2)) lpns lpns) in
-    let clppcs = end_itlist (@)
-       (map (fun ((m1,m2),(n1,n2)) ->
-                map (fun vars' ->
-                        (changevariables_monomial (zip vars vars') m1,
-                         changevariables_monomial (zip vars vars') m2),(n1,n2))
-                    invariants)
-            lppcs) in
-    let clppcs_dom = setify(map fst clppcs) in
-    let clppcs_cls = map (fun d -> filter (fun (e,_) -> e = d) clppcs)
-                         clppcs_dom in
-    let eqvcls = map (o setify (map snd)) clppcs_cls in
-    let mk_eq cls acc =
-      match cls with
-        [] -> raise Sanity
-      | [h] -> acc
-      | h::t -> map (fun k -> (k |-> Int(-1)) (h |=> Int 1)) t @ acc in
-    itlist mk_eq eqvcls [] in
-  let eqs = foldl (fun a x y -> y::a) []
-   (itern 1 lpps (fun m1 n1 ->
-        itern 1 lpps (fun m2 n2 f ->
-                let m = monomial_mul m1 m2 in
-                if n1 > n2 then f else
-                let c = if n1 = n2 then Int 1 else Int 2 in
-                (m |-> ((n1,n2) |-> c) (tryapplyd f m undefined)) f))
-       (foldl (fun a m c -> (m |-> ((0,0)|=>c)) a)
-              undefined pol)) @
-    sym_eqs in
-  let pvs,assig = eliminate_all_equations (0,0) eqs in
-  let allassig = itlist (fun v -> (v |-> (v |=> Int 1))) pvs assig in
-  let qvars = (0,0)::pvs in
-  let diagents =
-    end_itlist equation_add (map (fun i -> apply allassig (i,i)) (1--n)) in
-  let mk_matrix v =
-   ((n,n),
-    foldl (fun m (i,j) ass -> let c = tryapplyd ass v (Int 0) in
-                              if c =/ Int 0 then m else
-                              ((j,i) |-> c) (((i,j) |-> c) m))
-          undefined allassig :matrix) in
-  let mats = map mk_matrix qvars
-  and obj = length pvs,
-            itern 1 pvs (fun v i -> (i |--> tryapplyd diagents v (Int 0)))
-                undefined in
-  let raw_vec = if pvs = [] then vector_0 0 else tool obj mats in
-  let find_rounding d =
-   (if !debugging then
-     (Format.print_string("Trying rounding with limit "^string_of_num d);
-      Format.print_newline())
-    else ());
-    let vec = nice_vector d raw_vec in
-    let mat = iter (1,dim vec)
-     (fun i a -> matrix_add (matrix_cmul (element vec i) (el i mats)) a)
-     (matrix_neg (el 0 mats)) in
-    deration(diag mat) in
-  let rat,dia =
-    if pvs = [] then
-       let mat = matrix_neg (el 0 mats) in
-       deration(diag mat)
-    else
-       tryfind find_rounding (map Num.num_of_int (1--31) @
-                              map pow2 (5--66)) in
-  let poly_of_lin(d,v) =
-    d,foldl(fun a i c -> (el (i - 1) lpps |-> c) a) undefined (snd v) in
-  let lins = map poly_of_lin dia in
-  let sqs = map (fun (d,l) -> poly_mul (poly_const d) (poly_pow l 2)) lins in
-  let sos = poly_cmul rat (end_itlist poly_add sqs) in
-  if is_undefined(poly_sub sos pol) then rat,lins else raise Sanity;;
-
-let (sumofsquares: poly -> Num.num * (( Num.num * poly) list))  = 
-sumofsquares_general_symmetry csdp;;
diff --git a/contrib/micromega/sos.mli b/contrib/micromega/sos.mli
deleted file mode 100644
index 31c9518c..00000000
--- a/contrib/micromega/sos.mli
+++ /dev/null
@@ -1,66 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-
-type vname = string;;
-
-type term =
-| Zero
-| Const of Num.num
-| Var of vname
-| Inv of term
-| Opp of term
-| Add of (term * term)
-| Sub of (term * term)
-| Mul of (term * term)
-| Div of (term * term)
-| Pow of (term * int)
-
-type positivstellensatz =
-   Axiom_eq of int
- | Axiom_le of int
- | Axiom_lt of int
- | Rational_eq of Num.num
- | Rational_le of Num.num
- | Rational_lt of Num.num
- | Square of term
- | Monoid of int list
- | Eqmul of term * positivstellensatz
- | Sum of positivstellensatz * positivstellensatz
- | Product of positivstellensatz * positivstellensatz
-
-type poly
-
-val poly_isconst : poly -> bool
-
-val poly_neg : poly -> poly
-
-val poly_mul : poly -> poly -> poly
-
-val poly_pow : poly -> int -> poly
-
-val poly_const : Num.num -> poly
-
-val poly_of_term : term -> poly
-
-val term_of_poly : poly -> term
-
-val term_of_sos : positivstellensatz * (Num.num * poly) list -> 
-     positivstellensatz
-
-val string_of_poly : poly -> string
-
-exception TooDeep
-
-val deepen_until : int -> (int -> 'a) -> int -> 'a
-
-val real_positivnullstellensatz_general : bool -> int -> poly list ->
-     (poly * positivstellensatz) list ->
-     poly -> poly list * (positivstellensatz * (Num.num * poly) list) list
-
-val sumofsquares : poly -> Num.num * ( Num.num * poly) list
diff --git a/contrib/micromega/vector.ml b/contrib/micromega/vector.ml
deleted file mode 100644
index fee4ebfc..00000000
--- a/contrib/micromega/vector.ml
+++ /dev/null
@@ -1,674 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(*                                                                      *)
-(* Micromega: A reflexive tactic using the Positivstellensatz           *)
-(*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
-(*                                                                      *)
-(************************************************************************)
-
-open Num
-
-module type S =
-sig
- type t 
-
- val fresh : t -> int
-
- val null : t
-
- val is_null : t -> bool
-
- val get : int -> t -> num
-
- val update : int -> (num -> num) -> t -> t
-  (* behaviour is undef if index < 0 -- might loop*)
-
- val set : int -> num -> t -> t
-
- (* 
-    For efficiency...
-
-    val get_update : int -> (num -> num) -> t -> num * t  
- *)
-
- val mul : num -> t -> t
-
- val uminus : t -> t
-
- val add : t -> t -> t
-
- val dotp : t -> t -> num
-
- val lin_comb : num -> t -> num -> t -> t
-  (* lin_comb n1 t1 n2 t2 = (n1 * t1) + (n2 * t2) *)
-
- val gcd : t -> Big_int.big_int
-
- val normalise : t -> num * t 
-
- val hash : t -> int
-
- val compare : t -> t -> int 
-
- type it 
-
- val iterator : t -> it
- val element : it -> (num*it) option
-
- val string : t -> string
-
- type status = Pos | Neg
-
- (* the result list is ordered by fst *)
- val status : t -> (int * status) list 
-
- val from_list : num list -> t
- val to_list : t -> num list
-
-end
-
-
-module type SystemS = 
-sig
- 
- module Vect : S
-
- module  Cstr :
- sig
-  type kind = Eq | Ge
-  val string_of_kind : kind -> string
-  type cstr = {coeffs : Vect.t ; op : kind ; cst : num} 
-  val  string_of_cstr : cstr -> string
-  val compare : cstr -> cstr -> int
- end
- open Cstr
-
-
- module CstrBag : 
- sig 
-  type t
-  exception Contradiction
-
-  val empty : t
-
-  val is_empty : t -> bool
-
-  val add : cstr -> t -> t
-   (* c can be deduced from add c t *)
-
-  val find : (cstr -> bool) -> t  ->  cstr option
-
-  val fold : (cstr -> 'a -> 'a) -> t -> 'a -> 'a
-
-  val status : t ->  (int * (int list * int list)) list
-   (* aggregate of vector statuses *)
-
-  val remove : cstr -> t -> t
-
-  (* remove_list the ith element -- it is the ith element visited by 'fold' *)
-
-  val split : (cstr -> int) -> t -> (int ->  t)
-
-  type it 
-  val iterator : t -> it
-  val element : it -> (cstr*it) option
-
- end
-
-end
-
-let zero_num = Int 0
-let unit_num = Int 1
-
-
-
-
-module Cstr(V:S) = 
-struct 
- type kind = Eq | Ge
- let string_of_kind = function Eq -> "Eq" | Ge -> "Ge"
-
- type cstr = {coeffs : V.t ; op : kind ; cst : num} 
-
- let string_of_cstr  {coeffs =a  ; op = b ; cst =c} =
-  Printf.sprintf "{coeffs = %s;op=%s;cst=%s}" (V.string a) (string_of_kind b) (string_of_num c)
-
- type t = cstr
- let compare 
-   {coeffs = v1 ; op = op1 ; cst = c1}
-   {coeffs = v2 ; op = op2 ; cst = c2} =
-  Mutils.Cmp.compare_lexical [
-   (fun () -> V.compare v1 v2);
-   (fun () -> Pervasives.compare op1 op2);
-   (fun () -> compare_num c1 c2)
-  ]
-
-
-end
-
-
-
-module VList : S with type t = num list =
-struct
- type t =  num list
-
- let fresh l = failwith "not implemented"
-
- let null = []
-
- let is_null  = List.for_all ((=/) zero_num) 
-
- let normalise l = failwith "Not implemented"
-  (*match l with (* Buggy : What if the first num is zero! *)
-    | [] -> (Int 0,[])
-    | [n] -> (n,[Int 1])
-    | n::l -> (n, (Int 1) :: List.map (fun x -> x // n) l)
-  *)
-
-
- let get i l = try List.nth l i with _ -> zero_num
-
- (* This is not tail-recursive *)
- let rec update i f t =
-  match t with
-   | []   -> if i = 0 then [f zero_num] else (zero_num)::(update (i-1) f [])
-   | e::t -> if i = 0 then (f e)::t else e::(update (i-1) f t)
-
- let rec set i n t =
-  match t with
-   | []   -> if i = 0 then [n] else (zero_num)::(set (i-1) n [])
-   | e::t -> if i = 0 then (n)::t else e::(set (i-1) n t)
-
-
-
-
- let rec mul z t = 
-  match z with
-   | Int 0 -> null
-   | Int 1 -> t
-   |  _    -> List.map (mult_num z) t
-
- let uminus t = mul (Int (-1)) t
-
- let rec add t1 t2 =
-  match t1,t2 with
-   | [], _  -> t2
-   | _ , [] -> t1
-   | e1::t1,e2::t2 -> (e1 +/ e2 )::(add t1 t2)
-
- let dotp t1 t2 =
-  let rec _dotp t1 t2 acc = 
-   match t1, t2 with
-    | [] , _  -> acc
-    | _  , [] -> acc
-    | e1::t1,e2::t2 -> _dotp t1 t2 (acc +/ (e1 */ e2)) in
-   _dotp t1 t2 zero_num
-
- let add_mul n t1 t2 =
-  match n with
-   | Int 0 -> t2
-   | Int 1  -> add t1 t2
-   |  _     -> 
-       let rec _add_mul t1 t2 = 
-	match t1,t2 with
-	 | [], _  -> t2
-	 | _ , [] -> mul n t1
-	 | e1::t1,e2::t2 -> ( (n */e1) +/ e2 )::(_add_mul t1 t2) in
-	_add_mul t1 t2
-
- let lin_comb n1 t1 n2 t2 = 
-  match n1,n2 with
-   | Int 0 , _  -> mul n2 t2
-   | Int 1 , _ -> add_mul n2 t2 t1
-   |   _   , Int 0 ->  mul n1 t1
-   |   _   , Int 1 -> add_mul n1 t1 t2  
-   |       _       -> 
-	    let rec _lin_comb t1 t2 = 
-	     match t1,t2 with
-	      | [], _  -> mul n2 t2
-	      | _ , [] -> mul n1 t1
-	      | e1::t1,e2::t2 -> ( (n1 */e1) +/ (n2 */ e2 ))::(_lin_comb t1 t2) in
-	     _lin_comb t1 t2
-	      
- (* could be computed on the fly *)
- let gcd  t =Mutils.gcd_list t
-
-
-
-
- let hash = Mutils.Cmp.hash_list int_of_num 
-
- let compare = Mutils.Cmp.compare_list compare_num
-
- type it = t
- let iterator (x:t) : it = x
- let element it = 
-  match it with
-   | [] -> None
-   | e::l -> Some (e,l)
-
- (* TODO: Buffer! *)
- let string l = List.fold_right (fun n s -> (string_of_num n)^";"^s) l ""
-
- type status = Pos | Neg
-
- let status l =
-  let rec xstatus i l = 
-   match l with 
-    | [] -> []
-    | e::l -> 
-       begin
-	match compare_num e (Int 0) with
-	 | 1 -> (i,Pos):: (xstatus (i+1) l)
-	 | 0 -> xstatus (i+1) l
-	 | -1 -> (i,Neg) :: (xstatus (i+1) l)
-	 | _  -> assert false
-       end in
-   xstatus 0 l
-
- let from_list l = l
- let to_list l = l
-  
-end
-
-module VMap : S =
-struct
- module Map = Map.Make(struct type t = int let compare (x:int) (y:int) = Pervasives.compare x y end)
-
- type t =  num Map.t
-
- let null = Map.empty
-
- let fresh m = failwith "not implemented"
-
- let is_null  = Map.is_empty
-
- let normalise m = failwith "Not implemented"
-
-
-
- let get i l = try Map.find i l with _ -> zero_num
-
- let  update i f t =
-  try
-   let res = f (Map.find i t) in
-    if res =/ zero_num
-    then Map.remove i t
-    else Map.add i res t
-  with
-    Not_found -> 
-     let res = f zero_num in
-      if res =/ zero_num then t else Map.add i res t
-
- let set i n t =
-  if n =/ zero_num then Map.remove i t
-  else Map.add i n t
-
-
- let rec mul z t = 
-  match z with
-   | Int 0 -> null
-   | Int 1 -> t
-   |  _    -> Map.map (mult_num z) t
-
- let uminus t = mul (Int (-1)) t
-  
-
- let map2 f m1 m2 = 
-  let res,m2' = 
-   Map.fold (fun k e (res,m2) -> 
-    let v = f e (get k m2) in
-     if v =/ zero_num
-     then (res,Map.remove k m2)
-     else (Map.add k v res,Map.remove k m2)) m1 (Map.empty,m2) in
-   Map.fold (fun k e res -> 
-    let v = f zero_num e in
-     if v =/ zero_num
-     then res else Map.add k v res) m2' res
-    
- let  add t1 t2 = map2 (+/) t1 t2
-  
-
- let dotp t1 t2 =
-  Map.fold (fun k e res -> 
-   res +/ (e */ get k t2)) t1 zero_num
-
-
-
- let add_mul n t1 t2 =
-  match n with
-   | Int 0 -> t2
-   | Int 1  -> add t1 t2
-   |  _     -> map2 (fun x y -> (n */ x) +/ y) t1 t2
-
- let lin_comb n1 t1 n2 t2 = 
-  match n1,n2 with
-   | Int 0 , _  -> mul n2 t2
-   | Int 1 , _ -> add_mul n2 t2 t1
-   |   _   , Int 0 ->  mul n1 t1
-   |   _   , Int 1 -> add_mul n1 t1 t2  
-   |       _       -> map2 (fun x y -> (n1 */ x) +/ (n2 */ y)) t1 t2
-
-
- let hash map = Map.fold (fun k e res -> k lxor (int_of_num e) lxor res) map 0
-
- let compare = Map.compare compare_num
-
- type it = t * int
-
- let iterator (x:t) : it = (x,0)
-  
- let element (mp,id) = 
-  try 
-   Some (Map.find id mp, (mp, id+1))
-  with
-    Not_found -> None
-
- (* TODO: Buffer! *)
- type status = Pos | Neg
-
- let status l = Map.fold (fun k e l -> 
-  match compare_num e (Int 0) with
-   | 1 -> (k,Pos)::l
-   | 0 ->  l
-   | -1 -> (k,Neg) :: l
-   | _  -> assert false) l []
- let from_list l = 
-  let rec from_list i l map = 
-   match l with
-    | [] -> map
-    | e::l -> from_list (i+1) l (if e <>/ Int 0 then Map.add i e map else map) in
-   from_list 0 l Map.empty
-
- let gcd m = 
-  let res = Map.fold (fun _ e x -> Big_int.gcd_big_int  x (Mutils.numerator e)) m Big_int.zero_big_int in
-   if Big_int.compare_big_int res Big_int.zero_big_int = 0 
-   then Big_int.unit_big_int else res
-
-
- let to_list m = 
-  let l = List.rev (Map.fold (fun k e l -> (k,e)::l) m []) in
-  let rec xto_list i l =
-   match l with
-    | [] -> []
-    |	(x,v)::l' -> if i = x then v::(xto_list (i+1) l') else zero_num ::(xto_list (i+1) l) in
-   xto_list 0 l
-
- let string l = VList.string (to_list l)
-
-  
-end
-
-
-module VSparse : S =
-struct
-
- type t = (int*num) list
-
- let null = []
-  
- let fresh l = List.fold_left (fun acc (i,_) -> max (i+1) acc)  0 l
-
- let is_null l = l = []
-  
- let rec is_sorted l =
-  match l with
-   |	[] -> true
-   | [e] -> true
-   | (i,_)::(j,x)::l -> i < j && is_sorted ((j,x)::l)
-      
-      
- let check l = (List.for_all (fun (_,n) -> compare_num n (Int 0) <> 0) l) && (is_sorted l)
-  
- (*	let get i t = 
-	assert (check t);
-	try List.assoc i t with Not_found -> zero_num *)
-
- let rec get (i:int) t = 
-  match t with
-   | [] -> zero_num
-   | (j,n)::t -> 
-      match compare i j with
-       | 0 -> n
-       | 1 -> get i t
-       |  _ -> zero_num
-
- let cons i v rst = if v =/ Int 0 then rst else (i,v)::rst
-   
- let rec update i f t = 
-  match t with
-   | [] -> cons i (f zero_num) []
-   | (k,v)::l -> 
-      match Pervasives.compare i k with
-       | 0 -> cons k (f v) l
-       | -1 -> cons i (f zero_num) t
-       |  1 -> (k,v) ::(update i f l)
-       |  _  -> failwith "compare_num"
-	   
- let update i f t =
-  assert (check t); 
-  let res = update i f t in
-   assert (check t) ; res
-    
-    
- let rec set i n t =
-  match t with
-   | [] -> cons i n []
-   | (k,v)::l -> 
-      match Pervasives.compare i k with
-       | 0 -> cons k n l
-       | -1 -> cons i n t
-       |  1 -> (k,v) :: (set i n l)
-       |  _  -> failwith "compare_num"
-	   
-
- let rec map f l = 
-  match l with
-   | [] -> []
-   | (i,e)::l -> cons i (f e) (map f l)
-      
- let rec mul z t = 
-  match z with
-   | Int 0 -> null
-   | Int 1 -> t
-   |  _    -> List.map (fun (i,n) -> (i, mult_num z n)) t
-       
- let mul z t = 
-  assert (check t) ;
-  let res = mul z t in
-   assert (check res) ; 
-   res
-
- let uminus t = mul (Int (-1)) t
-
-
- let normalise l = 
-  match l with
-   | []   -> (Int 0,[])
-   | (i,n)::_ -> (n, mul ((Int 1) // n) l)
-      
-
- let rec map2 f m1 m2 = 
-  match m1, m2 with
-   | [] , [] -> []
-   | l  , [] -> map (fun x -> f x zero_num) l
-   | [] ,l   -> map (f zero_num) l
-   | (i,e)::l1,(i',e')::l2 -> 
-      match Pervasives.compare i i' with
-       | 0 -> cons i (f e e') (map2 f l1 l2)
-       | -1 -> cons i (f e zero_num) (map2 f l1 m2)
-       |  1 -> cons i' (f zero_num e') (map2 f m1 l2)
-       | _  -> assert false
-	  
- (* let  add t1 t2 = map2 (+/) t1 t2*)
-
- let rec add (m1:t) (m2:t) = 
-  match m1, m2 with
-   | [] , [] -> []
-   | l  , [] -> l
-   | [] ,l   -> l
-   | (i,e)::l1,(i',e')::l2 -> 
-      match Pervasives.compare i i' with
-       | 0 -> cons i ( e +/ e') (add  l1 l2)
-       | -1 -> (i,e) :: (add l1 m2)
-       |  1 -> (i', e') :: (add m1 l2)
-       | _  -> assert false
-
-
-
-
- let add t1 t2 = 
-  assert (check t1 && check t2);
-  let res = add t1 t2 in
-   assert (check res);
-   res
-
-
- let rec dotp (t1:t) (t2:t) =
-  match t1, t2 with
-   | [] , _ -> zero_num
-   | _  , [] -> zero_num
-   | (i,e)::l1 , (i',e')::l2 -> 
-      match Pervasives.compare i i' with
-       | 0 -> (e */ e') +/ (dotp l1 l2)
-       | -1 -> dotp l1 t2
-       |  1 -> dotp t1 l2
-       |  _ -> assert false
-	   
- let dotp t1 t2 = 
-  assert (check t1 && check t2) ; dotp t1 t2
-
- let add_mul n t1 t2 =
-  match n with
-   | Int 0 -> t2
-   | Int 1  -> add t1 t2
-   |  _     -> map2 (fun x y -> (n */ x) +/ y) t1 t2
-
- let add_mul n (t1:t) (t2:t) =
-  match n with
-   | Int 0 -> t2
-   | Int 1  -> add t1 t2
-   |   _    -> 
-	let rec xadd_mul m1 m2 = 
-	 match m1, m2 with
-	  | [] , [] -> []
-	  | _  , [] -> mul n m1
-	  | [] , _   -> m2
-	  | (i,e)::l1,(i',e')::l2 -> 
-	     match Pervasives.compare i i' with
-	      | 0 -> cons i ( n */ e +/ e') (xadd_mul  l1 l2)
-	      | -1 -> (i,n */ e) :: (xadd_mul l1 m2)
-	      |  1 -> (i', e') :: (xadd_mul m1 l2)
-	      | _  -> assert false in
-	 xadd_mul t1 t2
-	  
-
-
-
- let lin_comb n1 t1 n2 t2 = 
-  match n1,n2 with
-   | Int 0 , _  -> mul n2 t2
-   | Int 1 , _ -> add_mul n2 t2 t1
-   |   _   , Int 0 ->  mul n1 t1
-   |   _   , Int 1 -> add_mul n1 t1 t2  
-   |       _       -> (*map2 (fun x y -> (n1 */ x) +/ (n2 */ y)) t1 t2*)
-	    let rec xlin_comb m1 m2 = 
-	     match m1, m2 with
-	      | [] , [] -> []
-	      | _  , [] -> mul n1 m1
-	      | [] , _   -> mul n2 m2
-	      | (i,e)::l1,(i',e')::l2 -> 
-		 match Pervasives.compare i i' with
-		  | 0 -> cons i ( n1 */ e +/ n2 */ e') (xlin_comb  l1 l2)
-		  | -1 -> (i,n1 */ e) :: (xlin_comb l1 m2)
-		  |  1 -> (i', n2 */ e') :: (xlin_comb m1 l2)
-		  | _  -> assert false in
-	     xlin_comb t1 t2
-
-
-
-
-
- let lin_comb n1 t1 n2 t2 = 
-  assert (check t1 && check t2);
-  let res = lin_comb n1 t1 n2 t2 in
-   assert (check res); res
-
- let hash = Mutils.Cmp.hash_list (fun (x,y) -> (Hashtbl.hash x) lxor (int_of_num y))
-
-
- let compare = Mutils.Cmp.compare_list (fun x y -> Mutils.Cmp.compare_lexical 
-  [
-   (fun () -> Pervasives.compare (fst x) (fst y));
-   (fun () -> compare_num (snd x) (snd y))]) 
-
- (* 
-    let compare (x:t) (y:t) = 
-    let rec xcompare acc1 acc2 x y = 
-    match x , y with
-    | [] , [] -> xcomp acc1 acc2
-    | [] , _  -> -1
-    |  _ , [] -> 1
-    | (i,n1)::l1 , (j,n2)::l2 -> 
-    match Pervasives.compare i j with
-    | 0 -> xcompare (n1::acc1) (n2::acc2) l1 l2
-    | c -> c
-    and xcomp acc1 acc2 = Mutils.Cmp.compare_list compare_num acc1 acc2 in
-    xcompare [] [] x y
- *)
-
- type it = t
-
- let iterator (x:t) : it =  x
-  
- let element l = failwith "Not_implemented"
-
- (* TODO: Buffer! *)
- type status = Pos | Neg
-
- let status l = List.map (fun (i,e) -> 
-  match compare_num e (Int 0) with
-   | 1 -> i,Pos
-   | -1 -> i,Neg
-   | _  -> assert false) l
-
- let from_list (l: num list) = 
-  let rec xfrom_list i l = 
-   match l with
-    | [] -> []
-    | e::l ->  
-       if e <>/ Int 0 
-       then (i,e)::(xfrom_list (i+1) l)
-       else xfrom_list (i+1) l in
-   
-  let res = xfrom_list 0 l in
-   assert (check res) ; res
-
-
- let gcd m = 
-  let res = List.fold_left (fun x (i,e) -> Big_int.gcd_big_int  x (Mutils.numerator e))  Big_int.zero_big_int m in
-   if Big_int.compare_big_int res Big_int.zero_big_int = 0 
-   then Big_int.unit_big_int else res
-
- let to_list m = 
-  let rec xto_list i l =
-   match l with
-    | [] -> []
-    |	(x,v)::l' -> 
-	 if i = x then v::(xto_list (i+1) l') else zero_num ::(xto_list (i+1) l) in
-   xto_list 0 m
-
- let to_list l =
-  assert (check l); 
-  to_list l
-
-
- let string l = VList.string (to_list l)
-  
-end