Merge branch 'experimental/upstream' into upstream

429 files changed, 45423 insertions, 30320 deletions

diff --git a/theories/Arith/Arith.v b/theories/Arith/Arith.v
index 2e9dc2de..fea10ce1 100644
--- a/theories/Arith/Arith.v
+++ b/theories/Arith/Arith.v
@@ -1,12 +1,10 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Arith.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Arith_base.
 Require Export ArithRing.
diff --git a/theories/Arith/Arith_base.v b/theories/Arith/Arith_base.v
index e9953e54..9f0f05db 100644
--- a/theories/Arith/Arith_base.v
+++ b/theories/Arith/Arith_base.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Arith_base.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Le.
 Require Export Lt.
 Require Export Plus.
diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v
index 65753e31..fb488526 100644
--- a/theories/Arith/Between.v
+++ b/theories/Arith/Between.v
@@ -1,17 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Between.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Le.
 Require Import Lt.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types k l p q r : nat.
 
@@ -76,7 +74,7 @@ Section Between.
 
   Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r.
   Proof.
-    red in |- *; auto with arith.
+    red; auto with arith.
   Qed.
   Hint Resolve in_int_intro: arith v62.
 
@@ -151,7 +149,7 @@ Section Between.
       between k l ->
       (forall n:nat, in_int k l n -> P n -> ~ Q n) -> ~ exists_between k l.
   Proof.
-    induction 1; red in |- *; intros.
+    induction 1; red; intros.
     absurd (k < k); auto with arith.
     absurd (Q l); auto with arith.
     elim (exists_in_int k (S l)); auto with arith; intros l' inl' Ql'.
diff --git a/theories/Arith/Bool_nat.v b/theories/Arith/Bool_nat.v
index b3dcd8ec..4c15a173 100644
--- a/theories/Arith/Bool_nat.v
+++ b/theories/Arith/Bool_nat.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Bool_nat.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Export Compare_dec.
 Require Export Peano_dec.
 Require Import Sumbool.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n x y : nat.
 
@@ -36,4 +34,4 @@ Definition nat_noteq_bool x y :=
   bool_of_sumbool (sumbool_not _ _ (eq_nat_dec x y)).
 
 Definition zerop_bool x := bool_of_sumbool (zerop x).
-Definition notzerop_bool x := bool_of_sumbool (notzerop x).
\ No newline at end of file
+Definition notzerop_bool x := bool_of_sumbool (notzerop x).
diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v
index 2fe5c0d9..65219655 100644
--- a/theories/Arith/Compare.v
+++ b/theories/Arith/Compare.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Compare.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Equality is decidable on [nat] *)
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
-Notation not_eq_sym := sym_not_eq.
+Notation not_eq_sym := not_eq_sym (only parsing).
 
 Implicit Types m n p q : nat.
 
@@ -43,7 +41,7 @@ Proof.
   lapply (lt_le_S m n); auto with arith.
   intro H'; lapply (le_lt_or_eq (S m) n); auto with arith.
   induction 1; auto with arith.
-  right; exists (n - S (S m)); simpl in |- *.
+  right; exists (n - S (S m)); simpl.
   rewrite (plus_comm m (n - S (S m))).
   rewrite (plus_n_Sm (n - S (S m)) m).
   rewrite (plus_n_Sm (n - S (S m)) (S m)).
@@ -52,4 +50,4 @@ Qed.
 
 Require Export Wf_nat.
 
-Require Export Min Max.
\ No newline at end of file
+Require Export Min Max.
diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v
index 99c7415e..a90a9ce9 100644
--- a/theories/Arith/Compare_dec.v
+++ b/theories/Arith/Compare_dec.v
@@ -1,19 +1,17 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Compare_dec.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Le.
 Require Import Lt.
 Require Import Gt.
 Require Import Decidable.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n x y : nat.
 
@@ -22,21 +20,21 @@ Proof.
   destruct n; auto with arith.
 Defined.
 
-Definition lt_eq_lt_dec : forall n m, {n < m} + {n = m} + {m < n}.
+Definition lt_eq_lt_dec n m : {n < m} + {n = m} + {m < n}.
 Proof.
-  induction n; destruct m; auto with arith.
+  induction n in m |- *; destruct m; auto with arith.
   destruct (IHn m) as [H|H]; auto with arith.
   destruct H; auto with arith.
 Defined.
 
-Definition gt_eq_gt_dec : forall n m, {m > n} + {n = m} + {n > m}.
+Definition gt_eq_gt_dec n m : {m > n} + {n = m} + {n > m}.
 Proof.
   intros; apply lt_eq_lt_dec; assumption.
 Defined.
 
-Definition le_lt_dec : forall n m, {n <= m} + {m < n}.
+Definition le_lt_dec n m : {n <= m} + {m < n}.
 Proof.
-  induction n.
+  induction n in m |- *.
   auto with arith.
   destruct m.
   auto with arith.
@@ -140,7 +138,7 @@ Proof.
 Qed.
 
 
-(** A ternary comparison function in the spirit of [Zcompare]. *)
+(** A ternary comparison function in the spirit of [Z.compare]. *)
 
 Fixpoint nat_compare n m :=
   match n, m with
@@ -200,16 +198,16 @@ Proof.
    apply -> nat_compare_lt; auto.
 Qed.
 
-Lemma nat_compare_spec : forall x y, CompSpec eq lt x y (nat_compare x y).
+Lemma nat_compare_spec :
+  forall x y, CompareSpec (x=y) (x<y) (y<x) (nat_compare x y).
 Proof.
  intros.
- destruct (nat_compare x y) as [ ]_eqn; constructor.
+ destruct (nat_compare x y) eqn:?; constructor.
  apply nat_compare_eq; auto.
  apply <- nat_compare_lt; auto.
  apply <- nat_compare_gt; auto.
 Qed.
 
-
 (** Some projections of the above equivalences. *)
 
 Lemma nat_compare_Lt_lt : forall n m, nat_compare n m = Lt -> n<m.
@@ -258,7 +256,7 @@ Lemma leb_correct : forall m n, m <= n -> leb m n = true.
 Proof.
   induction m as [| m IHm]. trivial.
   destruct n. intro H. elim (le_Sn_O _ H).
-  intros. simpl in |- *. apply IHm. apply le_S_n. assumption.
+  intros. simpl. apply IHm. apply le_S_n. assumption.
 Qed.
 
 Lemma leb_complete : forall m n, leb m n = true -> m <= n.
diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v
index 89620f5f..56115c7f 100644
--- a/theories/Arith/Div2.v
+++ b/theories/Arith/Div2.v
@@ -1,19 +1,17 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Div2.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Lt.
 Require Import Plus.
 Require Import Compare_dec.
 Require Import Even.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Type n : nat.
 
@@ -45,7 +43,7 @@ Qed.
 
 Lemma lt_div2 : forall n, 0 < n -> div2 n < n.
 Proof.
-  intro n. pattern n in |- *. apply ind_0_1_SS.
+  intro n. pattern n. apply ind_0_1_SS.
   (* n = 0 *)
   inversion 1.
   (* n=1 *)
@@ -71,24 +69,24 @@ Proof.
     (* S n *) inversion_clear H. apply even_div2 in H0 as <-. trivial.
 Qed.
 
-Lemma div2_even : forall n, div2 n = div2 (S n) -> even n
-with div2_odd : forall n, S (div2 n) = div2 (S n) -> odd n.
+Lemma div2_even n : div2 n = div2 (S n) -> even n
+with div2_odd n : S (div2 n) = div2 (S n) -> odd n.
 Proof.
-  destruct n; intro H.
-    (* 0 *) constructor.
-    (* S n *) constructor. apply div2_odd. rewrite H. trivial.
-  destruct n; intro H.
-    (* 0 *) discriminate.
-    (* S n *) constructor. apply div2_even. injection H as <-. trivial.
+{ destruct n; intro H.
+  - constructor.
+  - constructor. apply div2_odd. rewrite H. trivial. }
+{ destruct n; intro H.
+  - discriminate.
+  - constructor. apply div2_even. injection H as <-. trivial. }
 Qed.
 
 Hint Resolve even_div2 div2_even odd_div2 div2_odd: arith.
 
-Lemma even_odd_div2 :
-  forall n,
-    (even n <-> div2 n = div2 (S n)) /\ (odd n <-> S (div2 n) = div2 (S n)).
+Lemma even_odd_div2 n :
+ (even n <-> div2 n = div2 (S n)) /\
+ (odd n <-> S (div2 n) = div2 (S n)).
 Proof.
-  auto decomp using div2_odd, div2_even, odd_div2, even_div2.
+ split; split; auto using div2_odd, div2_even, odd_div2, even_div2.
 Qed.
 
 
@@ -101,12 +99,12 @@ Hint Unfold double: arith.
 
 Lemma double_S : forall n, double (S n) = S (S (double n)).
 Proof.
-  intro. unfold double in |- *. simpl in |- *. auto with arith.
+  intro. unfold double. simpl. auto with arith.
 Qed.
 
 Lemma double_plus : forall n (m:nat), double (n + m) = double n + double m.
 Proof.
-  intros m n. unfold double in |- *.
+  intros m n. unfold double.
   do 2 rewrite plus_assoc_reverse. rewrite (plus_permute n).
   reflexivity.
 Qed.
@@ -117,7 +115,7 @@ Lemma even_odd_double :
   forall n,
     (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))).
 Proof.
-  intro n. pattern n in |- *. apply ind_0_1_SS.
+  intro n. pattern n. apply ind_0_1_SS.
   (* n = 0 *)
   split; split; auto with arith.
   intro H. inversion H.
@@ -128,11 +126,11 @@ Proof.
   intros. destruct H as ((IH1,IH2),(IH3,IH4)).
   split; split.
   intro H. inversion H. inversion H1.
-  simpl in |- *. rewrite (double_S (div2 n0)). auto with arith.
-  simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
+  simpl. rewrite (double_S (div2 n0)). auto with arith.
+  simpl. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
   intro H. inversion H. inversion H1.
-  simpl in |- *. rewrite (double_S (div2 n0)). auto with arith.
-  simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
+  simpl. rewrite (double_S (div2 n0)). auto with arith.
+  simpl. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
 Qed.
 (** Specializations *)
 
diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v
index 60575beb..ce8eb478 100644
--- a/theories/Arith/EqNat.v
+++ b/theories/Arith/EqNat.v
@@ -1,16 +1,14 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: EqNat.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Equality on natural numbers *)
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n x y : nat.
 
@@ -25,7 +23,7 @@ Fixpoint eq_nat n m : Prop :=
   end.
 
 Theorem eq_nat_refl : forall n, eq_nat n n.
-  induction n; simpl in |- *; auto.
+  induction n; simpl; auto.
 Qed.
 Hint Resolve eq_nat_refl: arith v62.
 
@@ -37,7 +35,7 @@ Qed.
 Hint Immediate eq_eq_nat: arith v62.
 
 Lemma eq_nat_eq : forall n m, eq_nat n m -> n = m.
-  induction n; induction m; simpl in |- *; contradiction || auto with arith.
+  induction n; induction m; simpl; contradiction || auto with arith.
 Qed.
 Hint Immediate eq_nat_eq: arith v62.
 
@@ -57,11 +55,11 @@ Proof.
   induction n.
   destruct m as [| n].
   auto with arith.
-  intros; right; red in |- *; trivial with arith.
+  intros; right; red; trivial with arith.
   destruct m as [| n0].
-  right; red in |- *; auto with arith.
+  right; red; auto with arith.
   intros.
-  simpl in |- *.
+  simpl.
   apply IHn.
 Defined.
 
@@ -78,12 +76,12 @@ Fixpoint beq_nat n m : bool :=
 
 Lemma beq_nat_refl : forall n, true = beq_nat n n.
 Proof.
-  intro x; induction x; simpl in |- *; auto.
+  intro x; induction x; simpl; auto.
 Qed.
 
 Definition beq_nat_eq : forall x y, true = beq_nat x y -> x = y.
 Proof.
-  double induction x y; simpl in |- *.
+  double induction x y; simpl.
     reflexivity.
     intros n H1 H2. discriminate H2.
     intros n H1 H2. discriminate H2.
diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v
index f32e1ad4..3abdff98 100644
--- a/theories/Arith/Euclid.v
+++ b/theories/Arith/Euclid.v
@@ -1,71 +1,68 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Euclid.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Mult.
 Require Import Compare_dec.
 Require Import Wf_nat.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types a b n q r : nat.
 
 Inductive diveucl a b : Set :=
   divex : forall q r, b > r -> a = q * b + r -> diveucl a b.
 
-
 Lemma eucl_dev : forall n, n > 0 -> forall m:nat, diveucl m n.
 Proof.
-  intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
+  intros b H a; pattern a; apply gt_wf_rec; intros n H0.
   elim (le_gt_dec b n).
   intro lebn.
   elim (H0 (n - b)); auto with arith.
   intros q r g e.
-  apply divex with (S q) r; simpl in |- *; auto with arith.
+  apply divex with (S q) r; simpl; auto with arith.
   elim plus_assoc.
   elim e; auto with arith.
   intros gtbn.
-  apply divex with 0 n; simpl in |- *; auto with arith.
-Qed.
+  apply divex with 0 n; simpl; auto with arith.
+Defined.
 
 Lemma quotient :
   forall n,
     n > 0 ->
     forall m:nat, {q : nat |  exists r : nat, m = q * n + r /\ n > r}.
 Proof.
-  intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
+  intros b H a; pattern a; apply gt_wf_rec; intros n H0.
   elim (le_gt_dec b n).
   intro lebn.
   elim (H0 (n - b)); auto with arith.
   intros q Hq; exists (S q).
   elim Hq; intros r Hr.
-  exists r; simpl in |- *; elim Hr; intros.
+  exists r; simpl; elim Hr; intros.
   elim plus_assoc.
   elim H1; auto with arith.
   intros gtbn.
-  exists 0; exists n; simpl in |- *; auto with arith.
-Qed.
+  exists 0; exists n; simpl; auto with arith.
+Defined.
 
 Lemma modulo :
   forall n,
     n > 0 ->
     forall m:nat, {r : nat |  exists q : nat, m = q * n + r /\ n > r}.
 Proof.
-  intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
+  intros b H a; pattern a; apply gt_wf_rec; intros n H0.
   elim (le_gt_dec b n).
   intro lebn.
   elim (H0 (n - b)); auto with arith.
   intros r Hr; exists r.
   elim Hr; intros q Hq.
-  elim Hq; intros; exists (S q); simpl in |- *.
+  elim Hq; intros; exists (S q); simpl.
   elim plus_assoc.
   elim H1; auto with arith.
   intros gtbn.
-  exists n; exists 0; simpl in |- *; auto with arith.
-Qed.
+  exists n; exists 0; simpl; auto with arith.
+Defined.
diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v
index 5bab97c2..4f679fe2 100644
--- a/theories/Arith/Even.v
+++ b/theories/Arith/Even.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Even.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Here we define the predicates [even] and [odd] by mutual induction
     and we prove the decidability and the exclusion of those predicates.
     The main results about parity are proved in the module Div2. *)
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n : nat.
 
@@ -147,7 +145,7 @@ Lemma even_mult_aux :
   forall n m,
     (odd (n * m) <-> odd n /\ odd m) /\ (even (n * m) <-> even n \/ even m).
 Proof.
-  intros n; elim n; simpl in |- *; auto with arith.
+  intros n; elim n; simpl; auto with arith.
   intros m; split; split; auto with arith.
   intros H'; inversion H'.
   intros H'; elim H'; auto.
diff --git a/theories/Arith/Factorial.v b/theories/Arith/Factorial.v
index 3b434b96..37aa1b2c 100644
--- a/theories/Arith/Factorial.v
+++ b/theories/Arith/Factorial.v
@@ -1,37 +1,35 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Factorial.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Plus.
 Require Import Mult.
 Require Import Lt.
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 (** Factorial *)
 
-Boxed Fixpoint fact (n:nat) : nat :=
+Fixpoint fact (n:nat) : nat :=
   match n with
     | O => 1
     | S n => S n * fact n
   end.
 
-Arguments Scope fact [nat_scope].
+Arguments fact n%nat.
 
 Lemma lt_O_fact : forall n:nat, 0 < fact n.
 Proof.
-  simple induction n; unfold lt in |- *; simpl in |- *; auto with arith.
+  simple induction n; unfold lt; simpl; auto with arith.
 Qed.
 
 Lemma fact_neq_0 : forall n:nat, fact n <> 0.
 Proof.
   intro.
-  apply sym_not_eq.
+  apply not_eq_sym.
   apply lt_O_neq.
   apply lt_O_fact.
 Qed.
diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v
index 43df01c0..31b15507 100644
--- a/theories/Arith/Gt.v
+++ b/theories/Arith/Gt.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Gt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Theorems about [gt] in [nat]. [gt] is defined in [Init/Peano.v] as:
 <<
 Definition gt (n m:nat) := m < n.
@@ -17,7 +15,7 @@ Definition gt (n m:nat) := m < n.
 Require Import Le.
 Require Import Lt.
 Require Import Plus.
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n p : nat.
 
@@ -49,7 +47,7 @@ Hint Immediate gt_S_n: arith v62.
 
 Theorem gt_S : forall n m, S n > m -> n > m \/ m = n.
 Proof.
-  intros n m H; unfold gt in |- *; apply le_lt_or_eq; auto with arith.
+  intros n m H; unfold gt; apply le_lt_or_eq; auto with arith.
 Qed.
 
 Lemma gt_pred : forall n m, m > S n -> pred m > n.
@@ -112,23 +110,23 @@ Hint Resolve le_gt_S: arith v62.
 
 Theorem le_gt_trans : forall n m p, m <= n -> m > p -> n > p.
 Proof.
-  red in |- *; intros; apply lt_le_trans with m; auto with arith.
+  red; intros; apply lt_le_trans with m; auto with arith.
 Qed.
 
 Theorem gt_le_trans : forall n m p, n > m -> p <= m -> n > p.
 Proof.
-  red in |- *; intros; apply le_lt_trans with m; auto with arith.
+  red; intros; apply le_lt_trans with m; auto with arith.
 Qed.
 
 Lemma gt_trans : forall n m p, n > m -> m > p -> n > p.
 Proof.
-  red in |- *; intros n m p H1 H2.
+  red; intros n m p H1 H2.
   apply lt_trans with m; auto with arith.
 Qed.
 
 Theorem gt_trans_S : forall n m p, S n > m -> m > p -> n > p.
 Proof.
-  red in |- *; intros; apply lt_le_trans with m; auto with arith.
+  red; intros; apply lt_le_trans with m; auto with arith.
 Qed.
 
 Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62.
@@ -144,7 +142,7 @@ Qed.
 
 Lemma plus_gt_reg_l : forall n m p, p + n > p + m -> n > m.
 Proof.
-  red in |- *; intros n m p H; apply plus_lt_reg_l with p; auto with arith.
+  red; intros n m p H; apply plus_lt_reg_l with p; auto with arith.
 Qed.
 
 Lemma plus_gt_compat_l : forall n m p, n > m -> p + n > p + m.
diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v
index b73959e7..1febb76b 100644
--- a/theories/Arith/Le.v
+++ b/theories/Arith/Le.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Le.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Order on natural numbers. [le] is defined in [Init/Peano.v] as:
 <<
 Inductive le (n:nat) : nat -> Prop :=
@@ -18,7 +16,7 @@ where "n <= m" := (le n m) : nat_scope.
 >>
  *)
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n p : nat.
 
@@ -48,8 +46,8 @@ Qed.
 
 Theorem le_Sn_0 : forall n, ~ S n <= 0.
 Proof.
-  red in |- *; intros n H.
-  change (IsSucc 0) in |- *; elim H; simpl in |- *; auto with arith.
+  red; intros n H.
+  change (IsSucc 0); elim H; simpl; auto with arith.
 Qed.
 
 Hint Resolve le_0_n le_Sn_0: arith v62.
@@ -84,8 +82,7 @@ Hint Immediate le_Sn_le: arith v62.
 
 Theorem le_S_n : forall n m, S n <= S m -> n <= m.
 Proof.
-  intros n m H; change (pred (S n) <= pred (S m)) in |- *.
-  destruct H; simpl; auto with arith.
+  exact Peano.le_S_n.
 Qed.
 Hint Immediate le_S_n: arith v62.
 
@@ -105,11 +102,9 @@ Hint Resolve le_pred_n: arith v62.
 
 Theorem le_pred : forall n m, n <= m -> pred n <= pred m.
 Proof.
-  destruct n; simpl; auto with arith.
-  destruct m; simpl; auto with arith.
+  exact Peano.le_pred.
 Qed.
 
-
 (** * [le] is a order on [nat] *)
 (** Antisymmetry *)
 
diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v
index 004274fe..8559b782 100644
--- a/theories/Arith/Lt.v
+++ b/theories/Arith/Lt.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Lt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Theorems about [lt] in nat. [lt] is defined in library [Init/Peano.v] as:
 <<
 Definition lt (n m:nat) := S n <= m.
@@ -16,7 +14,7 @@ Infix "<" := lt : nat_scope.
 *)
 
 Require Import Le.
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n p : nat.
 
@@ -53,7 +51,7 @@ Qed.
 
 Theorem lt_not_le : forall n m, n < m -> ~ m <= n.
 Proof.
-  red in |- *; intros n m Lt Le; exact (le_not_lt m n Le Lt).
+  red; intros n m Lt Le; exact (le_not_lt m n Le Lt).
 Qed.
 Hint Immediate le_not_lt lt_not_le: arith v62.
 
@@ -96,9 +94,9 @@ Proof.
 Qed.
 Hint Resolve lt_0_Sn: arith v62.
 
-Theorem lt_n_O : forall n, ~ n < 0.
-Proof le_Sn_O.
-Hint Resolve lt_n_O: arith v62.
+Theorem lt_n_0 : forall n, ~ n < 0.
+Proof le_Sn_0.
+Hint Resolve lt_n_0: arith v62.
 
 (** * Predecessor *)
 
@@ -109,12 +107,12 @@ Qed.
 
 Lemma lt_pred : forall n m, S n < m -> n < pred m.
 Proof.
-induction 1; simpl in |- *; auto with arith.
+induction 1; simpl; auto with arith.
 Qed.
 Hint Immediate lt_pred: arith v62.
 
 Lemma lt_pred_n_n : forall n, 0 < n -> pred n < n.
-destruct 1; simpl in |- *; auto with arith.
+destruct 1; simpl; auto with arith.
 Qed.
 Hint Resolve lt_pred_n_n: arith v62.
 
@@ -161,7 +159,7 @@ Hint Immediate lt_le_weak: arith v62.
 
 Theorem le_or_lt : forall n m, n <= m \/ m < n.
 Proof.
-  intros n m; pattern n, m in |- *; apply nat_double_ind; auto with arith.
+  intros n m; pattern n, m; apply nat_double_ind; auto with arith.
   induction 1; auto with arith.
 Qed.
 
@@ -192,4 +190,5 @@ Hint Immediate lt_0_neq: arith v62.
 Notation lt_O_Sn := lt_0_Sn (only parsing).
 Notation neq_O_lt := neq_0_lt (only parsing).
 Notation lt_O_neq := lt_0_neq (only parsing).
+Notation lt_n_O := lt_n_0 (only parsing).
 (* end hide *)
diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v
index d1b1b269..5623564a 100644
--- a/theories/Arith/Max.v
+++ b/theories/Arith/Max.v
@@ -1,44 +1,48 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Max.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(** THIS FILE IS DEPRECATED. Use [NPeano.Nat] instead. *)
 
-(** THIS FILE IS DEPRECATED. Use [MinMax] instead. *)
-
-Require Export MinMax.
+Require Import NPeano.
 
 Local Open Scope nat_scope.
 Implicit Types m n p : nat.
 
-Notation max := MinMax.max (only parsing).
-
-Definition max_0_l := max_0_l.
-Definition max_0_r := max_0_r.
-Definition succ_max_distr := succ_max_distr.
-Definition plus_max_distr_l := plus_max_distr_l.
-Definition plus_max_distr_r := plus_max_distr_r.
-Definition max_case_strong := max_case_strong.
-Definition max_spec := max_spec.
-Definition max_dec := max_dec.
-Definition max_case := max_case.
-Definition max_idempotent := max_id.
-Definition max_assoc := max_assoc.
-Definition max_comm := max_comm.
-Definition max_l := max_l.
-Definition max_r := max_r.
-Definition le_max_l := le_max_l.
-Definition le_max_r := le_max_r.
-Definition max_lub_l := max_lub_l.
-Definition max_lub_r := max_lub_r.
-Definition max_lub := max_lub.
+Notation max := Peano.max (only parsing).
+
+Definition max_0_l := Nat.max_0_l.
+Definition max_0_r := Nat.max_0_r.
+Definition succ_max_distr := Nat.succ_max_distr.
+Definition plus_max_distr_l := Nat.add_max_distr_l.
+Definition plus_max_distr_r := Nat.add_max_distr_r.
+Definition max_case_strong := Nat.max_case_strong.
+Definition max_spec := Nat.max_spec.
+Definition max_dec := Nat.max_dec.
+Definition max_case := Nat.max_case.
+Definition max_idempotent := Nat.max_id.
+Definition max_assoc := Nat.max_assoc.
+Definition max_comm := Nat.max_comm.
+Definition max_l := Nat.max_l.
+Definition max_r := Nat.max_r.
+Definition le_max_l := Nat.le_max_l.
+Definition le_max_r := Nat.le_max_r.
+Definition max_lub_l := Nat.max_lub_l.
+Definition max_lub_r := Nat.max_lub_r.
+Definition max_lub := Nat.max_lub.
 
 (* begin hide *)
 (* Compatibility *)
 Notation max_case2 := max_case (only parsing).
-Notation max_SS := succ_max_distr (only parsing).
+Notation max_SS := Nat.succ_max_distr (only parsing).
 (* end hide *)
+
+Hint Resolve
+ Nat.max_l Nat.max_r Nat.le_max_l Nat.le_max_r : arith v62.
+
+Hint Resolve
+ Nat.min_l Nat.min_r Nat.le_min_l Nat.le_min_r : arith v62.
diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v
index 0c8b5669..a2a7930d 100644
--- a/theories/Arith/Min.v
+++ b/theories/Arith/Min.v
@@ -1,44 +1,42 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Min.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(** THIS FILE IS DEPRECATED. Use [NPeano.Nat] instead. *)
 
-(** THIS FILE IS DEPRECATED. Use [MinMax] instead. *)
+Require Import NPeano.
 
-Require Export MinMax.
-
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 Implicit Types m n p : nat.
 
-Notation min := MinMax.min (only parsing).
+Notation min := Peano.min (only parsing).
 
-Definition min_0_l := min_0_l.
-Definition min_0_r := min_0_r.
-Definition succ_min_distr := succ_min_distr.
-Definition plus_min_distr_l := plus_min_distr_l.
-Definition plus_min_distr_r := plus_min_distr_r.
-Definition min_case_strong := min_case_strong.
-Definition min_spec := min_spec.
-Definition min_dec := min_dec.
-Definition min_case := min_case.
-Definition min_idempotent := min_id.
-Definition min_assoc := min_assoc.
-Definition min_comm := min_comm.
-Definition min_l := min_l.
-Definition min_r := min_r.
-Definition le_min_l := le_min_l.
-Definition le_min_r := le_min_r.
-Definition min_glb_l := min_glb_l.
-Definition min_glb_r := min_glb_r.
-Definition min_glb := min_glb.
+Definition min_0_l := Nat.min_0_l.
+Definition min_0_r := Nat.min_0_r.
+Definition succ_min_distr := Nat.succ_min_distr.
+Definition plus_min_distr_l := Nat.add_min_distr_l.
+Definition plus_min_distr_r := Nat.add_min_distr_r.
+Definition min_case_strong := Nat.min_case_strong.
+Definition min_spec := Nat.min_spec.
+Definition min_dec := Nat.min_dec.
+Definition min_case := Nat.min_case.
+Definition min_idempotent := Nat.min_id.
+Definition min_assoc := Nat.min_assoc.
+Definition min_comm := Nat.min_comm.
+Definition min_l := Nat.min_l.
+Definition min_r := Nat.min_r.
+Definition le_min_l := Nat.le_min_l.
+Definition le_min_r := Nat.le_min_r.
+Definition min_glb_l := Nat.min_glb_l.
+Definition min_glb_r := Nat.min_glb_r.
+Definition min_glb := Nat.min_glb.
 
 (* begin hide *)
 (* Compatibility *)
 Notation min_case2 := min_case (only parsing).
-Notation min_SS := succ_min_distr (only parsing).
-(* end hide *)
\ No newline at end of file
+Notation min_SS := Nat.succ_min_distr (only parsing).
+(* end hide *)
diff --git a/theories/Arith/MinMax.v b/theories/Arith/MinMax.v
deleted file mode 100644
index 8a23c8f6..00000000
--- a/theories/Arith/MinMax.v
+++ /dev/null
@@ -1,113 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-Require Import Orders NatOrderedType GenericMinMax.
-
-(** * Maximum and Minimum of two natural numbers *)
-
-Fixpoint max n m : nat :=
-  match n, m with
-    | O, _ => m
-    | S n', O => n
-    | S n', S m' => S (max n' m')
-  end.
-
-Fixpoint min n m : nat :=
-  match n, m with
-    | O, _ => 0
-    | S n', O => 0
-    | S n', S m' => S (min n' m')
-  end.
-
-(** These functions implement indeed a maximum and a minimum *)
-
-Lemma max_l : forall x y, y<=x -> max x y = x.
-Proof.
- induction x; destruct y; simpl; auto with arith.
-Qed.
-
-Lemma max_r : forall x y, x<=y -> max x y = y.
-Proof.
- induction x; destruct y; simpl; auto with arith.
-Qed.
-
-Lemma min_l : forall x y, x<=y -> min x y = x.
-Proof.
- induction x; destruct y; simpl; auto with arith.
-Qed.
-
-Lemma min_r : forall x y, y<=x -> min x y = y.
-Proof.
- induction x; destruct y; simpl; auto with arith.
-Qed.
-
-
-Module NatHasMinMax <: HasMinMax Nat_as_OT.
- Definition max := max.
- Definition min := min.
- Definition max_l := max_l.
- Definition max_r := max_r.
- Definition min_l := min_l.
- Definition min_r := min_r.
-End NatHasMinMax.
-
-(** We obtain hence all the generic properties of [max] and [min],
-    see file [GenericMinMax] or use SearchAbout. *)
-
-Module Export MMP := UsualMinMaxProperties Nat_as_OT NatHasMinMax.
-
-
-(** * Properties specific to the [nat] domain *)
-
-(** Simplifications *)
-
-Lemma max_0_l : forall n, max 0 n = n.
-Proof. reflexivity. Qed.
-
-Lemma max_0_r : forall n, max n 0 = n.
-Proof. destruct n; auto. Qed.
-
-Lemma min_0_l : forall n, min 0 n = 0.
-Proof. reflexivity. Qed.
-
-Lemma min_0_r : forall n, min n 0 = 0.
-Proof. destruct n; auto. Qed.
-
-(** Compatibilities (consequences of monotonicity) *)
-
-Lemma succ_max_distr : forall n m, S (max n m) = max (S n) (S m).
-Proof. auto. Qed.
-
-Lemma succ_min_distr : forall n m, S (min n m) = min (S n) (S m).
-Proof. auto. Qed.
-
-Lemma plus_max_distr_l : forall n m p, max (p + n) (p + m) = p + max n m.
-Proof.
-intros. apply max_monotone. repeat red; auto with arith.
-Qed.
-
-Lemma plus_max_distr_r : forall n m p, max (n + p) (m + p) = max n m + p.
-Proof.
-intros. apply max_monotone with (f:=fun x => x + p).
-repeat red; auto with arith.
-Qed.
-
-Lemma plus_min_distr_l : forall n m p, min (p + n) (p + m) = p + min n m.
-Proof.
-intros. apply min_monotone. repeat red; auto with arith.
-Qed.
-
-Lemma plus_min_distr_r : forall n m p, min (n + p) (m + p) = min n m + p.
-Proof.
-intros. apply min_monotone with (f:=fun x => x + p).
-repeat red; auto with arith.
-Qed.
-
-Hint Resolve
- max_l max_r le_max_l le_max_r
- min_l min_r le_min_l le_min_r : arith v62.
diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v
index 1b36f236..48024331 100644
--- a/theories/Arith/Minus.v
+++ b/theories/Arith/Minus.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Minus.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** [minus] (difference between two natural numbers) is defined in [Init/Peano.v] as:
 <<
 Fixpoint minus (n m:nat) : nat :=
@@ -23,7 +21,7 @@ where "n - m" := (minus n m) : nat_scope.
 Require Import Lt.
 Require Import Le.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n p : nat.
 
@@ -31,7 +29,7 @@ Implicit Types m n p : nat.
 
 Lemma minus_n_O : forall n, n = n - 0.
 Proof.
-  induction n; simpl in |- *; auto with arith.
+  induction n; simpl; auto with arith.
 Qed.
 Hint Resolve minus_n_O: arith v62.
 
@@ -39,21 +37,21 @@ Hint Resolve minus_n_O: arith v62.
 
 Lemma minus_Sn_m : forall n m, m <= n -> S (n - m) = S n - m.
 Proof.
-  intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *;
+  intros n m Le; pattern m, n; apply le_elim_rel; simpl;
     auto with arith.
 Qed.
 Hint Resolve minus_Sn_m: arith v62.
 
 Theorem pred_of_minus : forall n, pred n = n - 1.
 Proof.
-  intro x; induction x; simpl in |- *; auto with arith.
+  intro x; induction x; simpl; auto with arith.
 Qed.
 
 (** * Diagonal *)
 
 Lemma minus_diag : forall n, n - n = 0.
 Proof.
-  induction n; simpl in |- *; auto with arith.
+  induction n; simpl; auto with arith.
 Qed.
 
 Lemma minus_diag_reverse : forall n, 0 = n - n.
@@ -68,7 +66,7 @@ Notation minus_n_n := minus_diag_reverse.
 
 Lemma minus_plus_simpl_l_reverse : forall n m p, n - m = p + n - (p + m).
 Proof.
-  induction p; simpl in |- *; auto with arith.
+  induction p; simpl; auto with arith.
 Qed.
 Hint Resolve minus_plus_simpl_l_reverse: arith v62.
 
@@ -76,7 +74,7 @@ Hint Resolve minus_plus_simpl_l_reverse: arith v62.
 
 Lemma plus_minus : forall n m p, n = m + p -> p = n - m.
 Proof.
-  intros n m p; pattern m, n in |- *; apply nat_double_ind; simpl in |- *;
+  intros n m p; pattern m, n; apply nat_double_ind; simpl;
     intros.
   replace (n0 - 0) with n0; auto with arith.
   absurd (0 = S (n0 + p)); auto with arith.
@@ -85,20 +83,20 @@ Qed.
 Hint Immediate plus_minus: arith v62.
 
 Lemma minus_plus : forall n m, n + m - n = m.
-  symmetry  in |- *; auto with arith.
+  symmetry ; auto with arith.
 Qed.
 Hint Resolve minus_plus: arith v62.
 
 Lemma le_plus_minus : forall n m, n <= m -> m = n + (m - n).
 Proof.
-  intros n m Le; pattern n, m in |- *; apply le_elim_rel; simpl in |- *;
+  intros n m Le; pattern n, m; apply le_elim_rel; simpl;
     auto with arith.
 Qed.
 Hint Resolve le_plus_minus: arith v62.
 
 Lemma le_plus_minus_r : forall n m, n <= m -> n + (m - n) = m.
 Proof.
-  symmetry  in |- *; auto with arith.
+  symmetry ; auto with arith.
 Qed.
 Hint Resolve le_plus_minus_r: arith v62.
 
@@ -134,7 +132,7 @@ Qed.
 
 Lemma lt_minus : forall n m, m <= n -> 0 < m -> n - m < n.
 Proof.
-  intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *;
+  intros n m Le; pattern m, n; apply le_elim_rel; simpl;
     auto using le_minus with arith.
     intros; absurd (0 < 0); auto with arith.
 Qed.
@@ -142,7 +140,7 @@ Hint Resolve lt_minus: arith v62.
 
 Lemma lt_O_minus_lt : forall n m, 0 < n - m -> m < n.
 Proof.
-  intros n m; pattern n, m in |- *; apply nat_double_ind; simpl in |- *;
+  intros n m; pattern n, m; apply nat_double_ind; simpl;
     auto with arith.
   intros; absurd (0 < 0); trivial with arith.
 Qed.
@@ -150,9 +148,9 @@ Hint Immediate lt_O_minus_lt: arith v62.
 
 Theorem not_le_minus_0 : forall n m, ~ m <= n -> n - m = 0.
 Proof.
-  intros y x; pattern y, x in |- *; apply nat_double_ind;
-    [ simpl in |- *; trivial with arith
+  intros y x; pattern y, x; apply nat_double_ind;
+    [ simpl; trivial with arith
       | intros n H; absurd (0 <= S n); [ assumption | apply le_O_n ]
-      | simpl in |- *; intros n m H1 H2; apply H1; unfold not in |- *; intros H3;
+      | simpl; intros n m H1 H2; apply H1; unfold not; intros H3;
 	apply H2; apply le_n_S; assumption ].
 Qed.
diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v
index 5dd61d67..cbb9b376 100644
--- a/theories/Arith/Mult.v
+++ b/theories/Arith/Mult.v
@@ -1,19 +1,17 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Mult.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Plus.
 Require Export Minus.
 Require Export Lt.
 Require Export Le.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n p : nat.
 
@@ -25,7 +23,7 @@ Implicit Types m n p : nat.
 
 Lemma mult_0_r : forall n, n * 0 = 0.
 Proof.
-  intro; symmetry  in |- *; apply mult_n_O.
+  intro; symmetry ; apply mult_n_O.
 Qed.
 
 Lemma mult_0_l : forall n, 0 * n = 0.
@@ -37,7 +35,7 @@ Qed.
 
 Lemma mult_1_l : forall n, 1 * n = n.
 Proof.
-  simpl in |- *; auto with arith.
+  simpl; auto with arith.
 Qed.
 Hint Resolve mult_1_l: arith v62.
 
@@ -70,12 +68,12 @@ Hint Resolve mult_plus_distr_r: arith v62.
 Lemma mult_plus_distr_l : forall n m p, n * (m + p) = n * m + n * p.
 Proof.
   induction n. trivial.
-  intros. simpl in |- *. rewrite IHn. symmetry. apply plus_permute_2_in_4.
+  intros. simpl. rewrite IHn. symmetry. apply plus_permute_2_in_4.
 Qed.
 
 Lemma mult_minus_distr_r : forall n m p, (n - m) * p = n * p - m * p.
 Proof.
-  intros; induction n m using nat_double_ind; simpl; auto with arith.
+  intros; induction n, m using nat_double_ind; simpl; auto with arith.
   rewrite <- minus_plus_simpl_l_reverse; auto with arith.
 Qed.
 Hint Resolve mult_minus_distr_r: arith v62.
@@ -139,13 +137,13 @@ Qed.
 
 Lemma mult_O_le : forall n m, m = 0 \/ n <= m * n.
 Proof.
-  induction m; simpl in |- *; auto with arith.
+  induction m; simpl; auto with arith.
 Qed.
 Hint Resolve mult_O_le: arith v62.
 
 Lemma mult_le_compat_l : forall n m p, n <= m -> p * n <= p * m.
 Proof.
-  induction p as [| p IHp]; intros; simpl in |- *.
+  induction p as [| p IHp]; intros; simpl.
   apply le_n.
   auto using plus_le_compat.
 Qed.
@@ -169,7 +167,7 @@ Proof.
   assumption.
   apply le_plus_l.
   (* m*p<=m0*q -> m*p<=(S m0)*q *)
-  simpl in |- *; apply le_trans with (m0 * q).
+  simpl; apply le_trans with (m0 * q).
   assumption.
   apply le_plus_r.
 Qed.
@@ -177,19 +175,22 @@ Qed.
 Lemma mult_S_lt_compat_l : forall n m p, m < p -> S n * m < S n * p.
 Proof.
   induction n; intros; simpl in *.
-    rewrite <- 2! plus_n_O; assumption.
+    rewrite <- 2 plus_n_O; assumption.
     auto using plus_lt_compat.
 Qed.
 
 Hint Resolve mult_S_lt_compat_l: arith.
 
+Lemma mult_lt_compat_l : forall n m p, n < m -> 0 < p -> p * n < p * m.
+Proof.
+ intros m n p H Hp. destruct p. elim (lt_irrefl _ Hp).
+ now apply mult_S_lt_compat_l.
+Qed.
+
 Lemma mult_lt_compat_r : forall n m p, n < m -> 0 < p -> n * p < m * p.
 Proof.
-  intros m n p H H0.
-  induction p.
-  elim (lt_irrefl _ H0).
-  rewrite mult_comm.
-  replace (n * S p) with (S p * n); auto with arith.
+  intros m n p H Hp. destruct p. elim (lt_irrefl _ Hp).
+  rewrite (mult_comm m), (mult_comm n). now apply mult_S_lt_compat_l.
 Qed.
 
 Lemma mult_S_le_reg_l : forall n m p, S n * m <= S n * p -> m <= p.
@@ -231,7 +232,7 @@ Fixpoint mult_acc (s:nat) m n : nat :=
 
 Lemma mult_acc_aux : forall n m p, m + n * p = mult_acc m p n.
 Proof.
-  induction n as [| p IHp]; simpl in |- *; auto.
+  induction n as [| p IHp]; simpl; auto.
   intros s m; rewrite <- plus_tail_plus; rewrite <- IHp.
   rewrite <- plus_assoc_reverse; apply f_equal2; auto.
   rewrite plus_comm; auto.
@@ -241,7 +242,7 @@ Definition tail_mult n m := mult_acc 0 m n.
 
 Lemma mult_tail_mult : forall n m, n * m = tail_mult n m.
 Proof.
-  intros; unfold tail_mult in |- *; rewrite <- mult_acc_aux; auto.
+  intros; unfold tail_mult; rewrite <- mult_acc_aux; auto.
 Qed.
 
 (** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus]
@@ -249,4 +250,4 @@ Qed.
 
 Ltac tail_simpl :=
   repeat rewrite <- plus_tail_plus; repeat rewrite <- mult_tail_mult;
-    simpl in |- *.
+    simpl.
diff --git a/theories/Arith/NatOrderedType.v b/theories/Arith/NatOrderedType.v
deleted file mode 100644
index fb4bf233..00000000
--- a/theories/Arith/NatOrderedType.v
+++ /dev/null
@@ -1,64 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-Require Import Lt Peano_dec Compare_dec EqNat
- Equalities Orders OrdersTac.
-
-
-(** * DecidableType structure for Peano numbers *)
-
-Module Nat_as_UBE <: UsualBoolEq.
- Definition t := nat.
- Definition eq := @eq nat.
- Definition eqb := beq_nat.
- Definition eqb_eq := beq_nat_true_iff.
-End Nat_as_UBE.
-
-Module Nat_as_DT <: UsualDecidableTypeFull := Make_UDTF Nat_as_UBE.
-
-(** Note that the last module fulfills by subtyping many other
-    interfaces, such as [DecidableType] or [EqualityType]. *)
-
-
-
-(** * OrderedType structure for Peano numbers *)
-
-Module Nat_as_OT <: OrderedTypeFull.
- Include Nat_as_DT.
- Definition lt := lt.
- Definition le := le.
- Definition compare := nat_compare.
-
- Instance lt_strorder : StrictOrder lt.
- Proof. split; [ exact lt_irrefl | exact lt_trans ]. Qed.
-
- Instance lt_compat : Proper (Logic.eq==>Logic.eq==>iff) lt.
- Proof. repeat red; intros; subst; auto. Qed.
-
- Definition le_lteq := le_lt_or_eq_iff.
- Definition compare_spec := nat_compare_spec.
-
-End Nat_as_OT.
-
-(** Note that [Nat_as_OT] can also be seen as a [UsualOrderedType]
-   and a [OrderedType] (and also as a [DecidableType]). *)
-
-
-
-(** * An [order] tactic for Peano numbers *)
-
-Module NatOrder := OTF_to_OrderTac Nat_as_OT.
-Ltac nat_order := NatOrder.order.
-
-(** Note that [nat_order] is domain-agnostic: it will not prove
-    [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
-
-Section Test.
-Let test : forall x y : nat, x<=y -> y<=x -> x=y.
-Proof. nat_order. Qed.
-End Test.
diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v
index 5cceab8b..e0bed0d3 100644
--- a/theories/Arith/Peano_dec.v
+++ b/theories/Arith/Peano_dec.v
@@ -1,16 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Peano_dec.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Decidable.
-
-Open Local Scope nat_scope.
+Require Eqdep_dec.
+Require Import Le Lt.
+Local Open Scope nat_scope.
 
 Implicit Types m n x y : nat.
 
@@ -30,5 +29,24 @@ Defined.
 Hint Resolve O_or_S eq_nat_dec: arith.
 
 Theorem dec_eq_nat : forall n m, decidable (n = m).
-  intros x y; unfold decidable in |- *; elim (eq_nat_dec x y); auto with arith.
+  intros x y; unfold decidable; elim (eq_nat_dec x y); auto with arith.
 Defined.
+
+Definition UIP_nat:= Eqdep_dec.UIP_dec eq_nat_dec.
+
+Lemma le_unique: forall m n (h1 h2: m <= n), h1 = h2.
+Proof.
+fix 3.
+refine (fun m _ h1 => match h1 as h' in _ <= k return forall hh: m <= k, h' = hh
+  with le_n => _ |le_S i H => _ end).
+refine (fun hh => match hh as h' in _ <= k return forall eq: m = k, 
+  le_n m = match eq in _ = p return m <= p -> m <= m with |eq_refl => fun bli => bli end h' with
+    |le_n => fun eq => _ |le_S j H' => fun eq => _ end eq_refl).
+rewrite (UIP_nat _ _ eq eq_refl). reflexivity.
+subst m. destruct (Lt.lt_irrefl j H').
+refine (fun hh => match hh as h' in _ <= k return match k as k' return m <= k' -> Prop
+  with |0 => fun _ => True |S i' => fun h'' => forall H':m <= i', le_S m i' H' = h'' end h'
+    with |le_n => _ |le_S j H2 => fun H' => _ end H).
+destruct m. exact I. intros; destruct (Lt.lt_irrefl m H').
+f_equal. apply le_unique.
+Qed.
diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v
index 12f12300..5428ada3 100644
--- a/theories/Arith/Plus.v
+++ b/theories/Arith/Plus.v
@@ -1,13 +1,11 @@
-(************************************************************************)
+ (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Plus.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Properties of addition. [add] is defined in [Init/Peano.v] as:
 <<
 Fixpoint plus (n m:nat) : nat :=
@@ -22,45 +20,32 @@ where "n + m" := (plus n m) : nat_scope.
 Require Import Le.
 Require Import Lt.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n p q : nat.
 
-(** * Zero is neutral *)
-
-Lemma plus_0_l : forall n, 0 + n = n.
-Proof.
-  reflexivity.
-Qed.
-
-Lemma plus_0_r : forall n, n + 0 = n.
-Proof.
-  intro; symmetry  in |- *; apply plus_n_O.
-Qed.
+(** * Zero is neutral 
+Deprecated : Already in Init/Peano.v *)
+Notation plus_0_l := plus_O_n (only parsing).
+Definition plus_0_r n := eq_sym (plus_n_O n).
 
 (** * Commutativity *)
 
 Lemma plus_comm : forall n m, n + m = m + n.
 Proof.
-  intros n m; elim n; simpl in |- *; auto with arith.
+  intros n m; elim n; simpl; auto with arith.
   intros y H; elim (plus_n_Sm m y); auto with arith.
 Qed.
 Hint Immediate plus_comm: arith v62.
 
 (** * Associativity *)
 
-Lemma plus_Snm_nSm : forall n m, S n + m = n + S m.
-Proof.
-  intros.
-  simpl in |- *.
-  rewrite (plus_comm n m).
-  rewrite (plus_comm n (S m)).
-  trivial with arith.
-Qed.
+Definition plus_Snm_nSm : forall n m, S n + m = n + S m:=
+ plus_n_Sm.
 
 Lemma plus_assoc : forall n m p, n + (m + p) = n + m + p.
 Proof.
-  intros n m p; elim n; simpl in |- *; auto with arith.
+  intros n m p; elim n; simpl; auto with arith.
 Qed.
 Hint Resolve plus_assoc: arith v62.
 
@@ -79,42 +64,42 @@ Hint Resolve plus_assoc_reverse: arith v62.
 
 Lemma plus_reg_l : forall n m p, p + n = p + m -> n = m.
 Proof.
-  intros m p n; induction n; simpl in |- *; auto with arith.
+  intros m p n; induction n; simpl; auto with arith.
 Qed.
 
 Lemma plus_le_reg_l : forall n m p, p + n <= p + m -> n <= m.
 Proof.
-  induction p; simpl in |- *; auto with arith.
+  induction p; simpl; auto with arith.
 Qed.
 
 Lemma plus_lt_reg_l : forall n m p, p + n < p + m -> n < m.
 Proof.
-  induction p; simpl in |- *; auto with arith.
+  induction p; simpl; auto with arith.
 Qed.
 
 (** * Compatibility with order *)
 
 Lemma plus_le_compat_l : forall n m p, n <= m -> p + n <= p + m.
 Proof.
-  induction p; simpl in |- *; auto with arith.
+  induction p; simpl; auto with arith.
 Qed.
 Hint Resolve plus_le_compat_l: arith v62.
 
 Lemma plus_le_compat_r : forall n m p, n <= m -> n + p <= m + p.
 Proof.
-  induction 1; simpl in |- *; auto with arith.
+  induction 1; simpl; auto with arith.
 Qed.
 Hint Resolve plus_le_compat_r: arith v62.
 
 Lemma le_plus_l : forall n m, n <= n + m.
 Proof.
-  induction n; simpl in |- *; auto with arith.
+  induction n; simpl; auto with arith.
 Qed.
 Hint Resolve le_plus_l: arith v62.
 
 Lemma le_plus_r : forall n m, m <= n + m.
 Proof.
-  intros n m; elim n; simpl in |- *; auto with arith.
+  intros n m; elim n; simpl; auto with arith.
 Qed.
 Hint Resolve le_plus_r: arith v62.
 
@@ -132,7 +117,7 @@ Hint Immediate lt_plus_trans: arith v62.
 
 Lemma plus_lt_compat_l : forall n m p, n < m -> p + n < p + m.
 Proof.
-  induction p; simpl in |- *; auto with arith.
+  induction p; simpl; auto with arith.
 Qed.
 Hint Resolve plus_lt_compat_l: arith v62.
 
@@ -146,18 +131,18 @@ Hint Resolve plus_lt_compat_r: arith v62.
 Lemma plus_le_compat : forall n m p q, n <= m -> p <= q -> n + p <= m + q.
 Proof.
   intros n m p q H H0.
-  elim H; simpl in |- *; auto with arith.
+  elim H; simpl; auto with arith.
 Qed.
 
 Lemma plus_le_lt_compat : forall n m p q, n <= m -> p < q -> n + p < m + q.
 Proof.
-  unfold lt in |- *. intros. change (S n + p <= m + q) in |- *. rewrite plus_Snm_nSm.
+  unfold lt. intros. change (S n + p <= m + q). rewrite plus_Snm_nSm.
   apply plus_le_compat; assumption.
 Qed.
 
 Lemma plus_lt_le_compat : forall n m p q, n < m -> p <= q -> n + p < m + q.
 Proof.
-  unfold lt in |- *. intros. change (S n + p <= m + q) in |- *. apply plus_le_compat; assumption.
+  unfold lt. intros. change (S n + p <= m + q). apply plus_le_compat; assumption.
 Qed.
 
 Lemma plus_lt_compat : forall n m p q, n < m -> p < q -> n + p < m + q.
@@ -205,8 +190,8 @@ Fixpoint tail_plus n m : nat :=
   end.
 
 Lemma plus_tail_plus : forall n m, n + m = tail_plus n m.
-induction n as [| n IHn]; simpl in |- *; auto.
-intro m; rewrite <- IHn; simpl in |- *; auto.
+induction n as [| n IHn]; simpl; auto.
+intro m; rewrite <- IHn; simpl; auto.
 Qed.
 
 (** * Discrimination *)
diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v
index 23419531..b5545123 100644
--- a/theories/Arith/Wf_nat.v
+++ b/theories/Arith/Wf_nat.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Wf_nat.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Well-founded relations and natural numbers *)
 
 Require Import Lt.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Implicit Types m n p : nat.
 
@@ -26,14 +24,14 @@ Definition gtof (a b:A) := f b > f a.
 
 Theorem well_founded_ltof : well_founded ltof.
 Proof.
-  red in |- *.
+  red.
   cut (forall n (a:A), f a < n -> Acc ltof a).
   intros H a; apply (H (S (f a))); auto with arith.
   induction n.
   intros; absurd (f a < 0); auto with arith.
   intros a ltSma.
   apply Acc_intro.
-  unfold ltof in |- *; intros b ltfafb.
+  unfold ltof; intros b ltfafb.
   apply IHn.
   apply lt_le_trans with (f a); auto with arith.
 Defined.
@@ -75,7 +73,7 @@ Proof.
   intros; absurd (f a < 0); auto with arith.
   intros a ltSma.
   apply F.
-  unfold ltof in |- *; intros b ltfafb.
+  unfold ltof; intros b ltfafb.
   apply IHn.
   apply lt_le_trans with (f a); auto with arith.
 Defined.
@@ -110,7 +108,7 @@ Hypothesis H_compat : forall x y:A, R x y -> f x < f y.
 
 Theorem well_founded_lt_compat : well_founded R.
 Proof.
-  red in |- *.
+  red.
   cut (forall n (a:A), f a < n -> Acc R a).
   intros H a; apply (H (S (f a))); auto with arith.
   induction n.
@@ -163,8 +161,8 @@ Lemma lt_wf_double_rec :
      (forall p q, p < n -> P p q) ->
      (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m.
 Proof.
-  intros P Hrec p; pattern p in |- *; apply lt_wf_rec.
-  intros n H q; pattern q in |- *; apply lt_wf_rec; auto with arith.
+  intros P Hrec p; pattern p; apply lt_wf_rec.
+  intros n H q; pattern q; apply lt_wf_rec; auto with arith.
 Defined.
 
 Lemma lt_wf_double_ind :
@@ -173,8 +171,8 @@ Lemma lt_wf_double_ind :
       (forall p (q:nat), p < n -> P p q) ->
       (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m.
 Proof.
-  intros P Hrec p; pattern p in |- *; apply lt_wf_ind.
-  intros n H q; pattern q in |- *; apply lt_wf_ind; auto with arith.
+  intros P Hrec p; pattern p; apply lt_wf_ind.
+  intros n H q; pattern q; apply lt_wf_ind; auto with arith.
 Qed.
 
 Hint Resolve lt_wf: arith.
@@ -192,7 +190,7 @@ Section LT_WF_REL.
   Remark acc_lt_rel : forall x:A, (exists n, F x n) -> Acc R x.
   Proof.
     intros x [n fxn]; generalize dependent x.
-    pattern n in |- *; apply lt_wf_ind; intros.
+    pattern n; apply lt_wf_ind; intros.
     constructor; intros.
     destruct (F_compat y x) as (x0,H1,H2); trivial.
     apply (H x0); auto.
@@ -260,19 +258,6 @@ Qed.
 
 Unset Implicit Arguments.
 
-(** [n]th iteration of the function [f] *)
-
-Fixpoint iter_nat (n:nat) (A:Type) (f:A -> A) (x:A) : A :=
-  match n with
-    | O => x
-    | S n' => f (iter_nat n' A f x)
-  end.
-
-Theorem iter_nat_plus :
-  forall (n m:nat) (A:Type) (f:A -> A) (x:A),
-    iter_nat (n + m) A f x = iter_nat n A f (iter_nat m A f x).
-Proof.
-  simple induction n;
-    [ simpl in |- *; auto with arith
-      | intros; simpl in |- *; apply f_equal with (f := f); apply H ].
-Qed.
+Notation iter_nat := @nat_iter (only parsing).
+Notation iter_nat_plus := @nat_iter_plus (only parsing).
+Notation iter_nat_invariant := @nat_iter_invariant (only parsing).
diff --git a/theories/Arith/vo.itarget b/theories/Arith/vo.itarget
index c3f29d21..0b6564e1 100644
--- a/theories/Arith/vo.itarget
+++ b/theories/Arith/vo.itarget
@@ -19,5 +19,3 @@ Mult.vo
 Peano_dec.vo
 Plus.vo
 Wf_nat.vo
-NatOrderedType.vo
-MinMax.vo
diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v
index 9509d9fd..a947e4fd 100644
--- a/theories/Bool/Bool.v
+++ b/theories/Bool/Bool.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Bool.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** The type [bool] is defined in the prelude as
     [Inductive bool : Set := true : bool | false : bool] *)
 
@@ -259,6 +257,11 @@ Proof.
   intros. apply orb_false_iff; trivial.
 Qed.
 
+Lemma orb_diag : forall b, b || b = b.
+Proof.
+ destr_bool.
+Qed.
+
 (** [true] is a zero for [orb] *)
 
 Lemma orb_true_r : forall b:bool, b || true = true.
@@ -364,6 +367,11 @@ Qed.
 Notation andb_b_false := andb_false_r (only parsing).
 Notation andb_false_b := andb_false_l (only parsing).
 
+Lemma andb_diag : forall b, b && b = b.
+Proof.
+ destr_bool.
+Qed.
+
 (** [true] is neutral for [andb] *)
 
 Lemma andb_true_r : forall b:bool, b && true = b.
@@ -547,6 +555,21 @@ Proof.
   destr_bool.
 Qed.
 
+Lemma negb_xorb_l : forall b b', negb (xorb b b') = xorb (negb b) b'.
+Proof.
+ destruct b,b'; trivial.
+Qed.
+
+Lemma negb_xorb_r : forall b b', negb (xorb b b') = xorb b (negb b').
+Proof.
+ destruct b,b'; trivial.
+Qed.
+
+Lemma xorb_negb_negb : forall b b', xorb (negb b) (negb b') = xorb b b'.
+Proof.
+ destruct b,b'; trivial.
+Qed.
+
 (** Lemmas about the [b = true] embedding of [bool] to [Prop] *)
 
 Lemma eq_iff_eq_true : forall b1 b2, b1 = b2 <-> (b1 = true <-> b2 = true).
@@ -592,12 +615,12 @@ Proof.
 Qed.
 Hint Resolve absurd_eq_true.
 
-(* A specific instance of trans_eq that preserves compatibility with
+(* A specific instance of eq_trans that preserves compatibility with
    old hint bool_2 *)
 
 Lemma trans_eq_bool : forall x y z:bool, x = y -> y = z -> x = z.
 Proof.
-  apply trans_eq.
+  apply eq_trans.
 Qed.
 Hint Resolve trans_eq_bool.
 
@@ -731,7 +754,7 @@ Notation "a &&& b" := (if a then b else false)
 Notation "a ||| b" := (if a then true else b)
  (at level 50, left associativity) : lazy_bool_scope.
 
-Open Local Scope lazy_bool_scope.
+Local Open Scope lazy_bool_scope.
 
 Lemma andb_lazy_alt : forall a b : bool, a && b = a &&& b.
 Proof.
@@ -768,7 +791,7 @@ Qed.
 Lemma iff_reflect : forall P b, (P<->b=true) -> reflect P b.
 Proof.
  destr_bool; intuition.
-Qed.
+Defined.
 
 (** It would be nice to join [reflect_iff] and [iff_reflect]
     in a unique [iff] statement, but this isn't allowed since
@@ -779,7 +802,7 @@ Qed.
 Lemma reflect_dec : forall P b, reflect P b -> {P}+{~P}.
 Proof.
  destruct 1; auto.
-Qed.
+Defined.
 
 (** Reciprocally, from a decidability, we could state a
     [reflect] as soon as we have a [bool_of_sumbool]. *)
diff --git a/theories/Bool/BoolEq.v b/theories/Bool/BoolEq.v
index ee82caf1..34777491 100644
--- a/theories/Bool/BoolEq.v
+++ b/theories/Bool/BoolEq.v
@@ -1,12 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: BoolEq.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
 (* Cuihtlauac Alvarado - octobre 2000 *)
 
 (** Properties of a boolean equality   *)
@@ -53,12 +52,12 @@ Section Bool_eq_dec.
   Definition not_eq_false_beq : forall x y:A, x <> y -> false = beq x y.
   Proof.
     intros x y H.
-    symmetry  in |- *.
+    symmetry .
     apply not_true_is_false.
     intro.
     apply H.
     apply beq_eq.
-    symmetry  in |- *.
+    symmetry .
     assumption.
   Defined.
 
diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v
index daf3a9fb..d7162e62 100644
--- a/theories/Bool/Bvector.v
+++ b/theories/Bool/Bvector.v
@@ -1,20 +1,19 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Bvector.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Bit vectors. Contribution by Jean Duprat (ENS Lyon). *)
 
-Require Export Bool.
-Require Export Sumbool.
-Require Import Arith.
+Require Export Bool Sumbool.
+Require Vector.
+Export Vector.VectorNotations.
+Require Import Minus.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 (**
 We build bit vectors in the spirit of List.v.
@@ -30,161 +29,6 @@ as definition, since the type inference mechanism for pattern-matching
 is sometimes weaker that the one implemented for elimination tactiques.
 *)
 
-Section VECTORS.
-
-(**
-A vector is a list of size n whose elements belongs to a set A.
-If the size is non-zero, we can extract the first component and the
-rest of the vector, as well as the last component, or adding or
-removing a component (carry) or repeating the last component at the
-end of the vector.
-We can also truncate the vector and remove its p last components or
-reciprocally extend the vector by concatenation.
-A unary function over A generates a function on vectors of size n by
-applying f pointwise.
-A binary function over A generates a function on pairs of vectors of
-size n by applying f pointwise.
-*)
-
-Variable A : Type.
-
-Inductive vector : nat -> Type :=
-  | Vnil : vector 0
-  | Vcons : forall (a:A) (n:nat), vector n -> vector (S n).
-
-Definition Vhead (n:nat) (v:vector (S n)) :=
-  match v with
-  | Vcons a _ _ => a
-  end.
-
-Definition Vtail (n:nat) (v:vector (S n)) :=
-  match v with
-  | Vcons _ _ v => v
-  end.
-
-Definition Vlast : forall n:nat, vector (S n) -> A.
-Proof.
-  induction n as [| n f]; intro v.
-  inversion v.
-  exact a.
-
-  inversion v as [| n0 a H0 H1].
-  exact (f H0).
-Defined.
-
-Fixpoint Vconst (a:A) (n:nat) :=
-  match n return vector n with
-  | O => Vnil
-  | S n => Vcons a _ (Vconst a n)
-  end.
-
-(** Shifting and truncating *)
-
-Lemma Vshiftout : forall n:nat, vector (S n) -> vector n.
-Proof.
-  induction n as [| n f]; intro v.
-  exact Vnil.
-
-  inversion v as [| a n0 H0 H1].
-  exact (Vcons a n (f H0)).
-Defined.
-
-Lemma Vshiftin : forall n:nat, A -> vector n -> vector (S n).
-Proof.
-  induction n as [| n f]; intros a v.
-  exact (Vcons a 0 v).
-
-  inversion v as [| a0 n0 H0 H1 ].
-  exact (Vcons a (S n) (f a H0)).
-Defined.
-
-Lemma Vshiftrepeat : forall n:nat, vector (S n) -> vector (S (S n)).
-Proof.
-  induction n as [| n f]; intro v.
-  inversion v.
-  exact (Vcons a 1 v).
-
-  inversion v as [| a n0 H0 H1 ].
-  exact (Vcons a (S (S n)) (f H0)).
-Defined.
-
-Lemma Vtrunc : forall n p:nat, n > p -> vector n -> vector (n - p).
-Proof.
-  induction p as [| p f]; intros H v.
-  rewrite <- minus_n_O.
-  exact v.
-
-  apply (Vshiftout (n - S p)).
-
-  rewrite minus_Sn_m.
-  apply f.
-  auto with *.
-  exact v.
-  auto with *.
-Defined.
-
-(** Concatenation of two vectors *)
-
-Fixpoint Vextend n p (v:vector n) (w:vector p) : vector (n+p) :=
-  match v with
-  | Vnil => w
-  | Vcons a n' v' => Vcons a (n'+p) (Vextend n' p v' w)
-  end.
-
-(** Uniform application on the arguments of the vector *)
-
-Variable f : A -> A.
-
-Fixpoint Vunary n (v:vector n) : vector n :=
-  match v with
-  | Vnil => Vnil
-  | Vcons a n' v' => Vcons (f a) n' (Vunary n' v')
-  end.
-
-Variable g : A -> A -> A.
-
-Lemma Vbinary : forall n:nat, vector n -> vector n -> vector n.
-Proof.
-  induction n as [| n h]; intros v v0.
-  exact Vnil.
-
-  inversion v as [| a n0 H0 H1]; inversion v0 as [| a0 n1 H2 H3].
-  exact (Vcons (g a a0) n (h H0 H2)).
-Defined.
-
-(** Eta-expansion of a vector *)
-
-Definition Vid n : vector n -> vector n :=
-  match n with
-  | O => fun _ => Vnil
-  | _ => fun v => Vcons (Vhead _ v) _ (Vtail _ v)
-  end.
-
-Lemma Vid_eq : forall (n:nat) (v:vector n), v = Vid n v.
-Proof.
-  destruct v; auto.
-Qed.
-
-Lemma VSn_eq :
-  forall (n : nat) (v : vector (S n)), v = Vcons (Vhead _ v) _ (Vtail _ v).
-Proof.
-  intros.
-  exact (Vid_eq _ v).
-Qed.
-
-Lemma V0_eq : forall (v : vector 0), v = Vnil.
-Proof.
-  intros.
-  exact (Vid_eq _ v).
-Qed.
-
-End VECTORS.
-
-(* suppressed: incompatible with Coq-Art book
-Implicit Arguments Vnil [A].
-Implicit Arguments Vcons [A n].
-*)
-
 Section BOOLEAN_VECTORS.
 
 (**
@@ -200,38 +44,38 @@ NOTA BENE: all shift operations expect predecessor of size as parameter
 (they only work on non-empty vectors).
 *)
 
-Definition Bvector := vector bool.
+Definition Bvector := Vector.t bool.
 
-Definition Bnil := @Vnil bool.
+Definition Bnil := @Vector.nil bool.
 
-Definition Bcons := @Vcons bool.
+Definition Bcons := @Vector.cons bool.
 
-Definition Bvect_true := Vconst bool true.
+Definition Bvect_true := Vector.const true.
 
-Definition Bvect_false := Vconst bool false.
+Definition Bvect_false := Vector.const false.
 
-Definition Blow := Vhead bool.
+Definition Blow := @Vector.hd bool.
 
-Definition Bhigh := Vtail bool.
+Definition Bhigh := @Vector.tl bool.
 
-Definition Bsign := Vlast bool.
+Definition Bsign := @Vector.last bool.
 
-Definition Bneg := Vunary bool negb.
+Definition Bneg n (v : Bvector n) := Vector.map negb v.
 
-Definition BVand := Vbinary bool andb.
+Definition BVand n (v : Bvector n) := Vector.map2 andb v.
 
-Definition BVor := Vbinary bool orb.
+Definition BVor n (v : Bvector n) := Vector.map2 orb v.
 
-Definition BVxor := Vbinary bool xorb.
+Definition BVxor n (v : Bvector n) := Vector.map2 xorb v.
 
 Definition BshiftL (n:nat) (bv:Bvector (S n)) (carry:bool) :=
-  Bcons carry n (Vshiftout bool n bv).
+  Bcons carry n (Vector.shiftout bv).
 
 Definition BshiftRl (n:nat) (bv:Bvector (S n)) (carry:bool) :=
-  Bhigh (S n) (Vshiftin bool (S n) carry bv).
+  Bhigh (S n) (Vector.shiftin carry bv).
 
 Definition BshiftRa (n:nat) (bv:Bvector (S n)) :=
-  Bhigh (S n) (Vshiftrepeat bool n bv).
+  Bhigh (S n) (Vector.shiftrepeat bv).
 
 Fixpoint BshiftL_iter (n:nat) (bv:Bvector (S n)) (p:nat) : Bvector (S n) :=
   match p with
@@ -252,3 +96,4 @@ Fixpoint BshiftRa_iter (n:nat) (bv:Bvector (S n)) (p:nat) : Bvector (S n) :=
   end.
 
 End BOOLEAN_VECTORS.
+
diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v
index e49d1f97..ae01b9da 100644
--- a/theories/Bool/DecBool.v
+++ b/theories/Bool/DecBool.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: DecBool.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Definition ifdec (A B:Prop) (C:Type) (H:{A} + {B}) (x y:C) : C :=
diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v
index 9cca05d4..57ffa6a4 100644
--- a/theories/Bool/IfProp.v
+++ b/theories/Bool/IfProp.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: IfProp.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Bool.
 
 Inductive IfProp (A B:Prop) : bool -> Prop :=
@@ -47,4 +45,4 @@ Lemma IfProp_sum : forall (A B:Prop) (b:bool), IfProp A B b -> {A} + {B}.
 destruct b; intro H.
 left; inversion H; auto with bool.
 right; inversion H; auto with bool.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v
index 5b1822be..5a9daa94 100644
--- a/theories/Bool/Sumbool.v
+++ b/theories/Bool/Sumbool.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Sumbool.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Here are collected some results about the type sumbool (see INIT/Specif.v)
    [sumbool A B], which is written [{A}+{B}], is the informative
    disjunction "A or B", where A and B are logical propositions.
@@ -68,4 +66,4 @@ Definition bool_of_sumbool :
   intros A B H.
   elim H; intro; [exists true | exists false]; assumption.
 Defined.
-Implicit Arguments bool_of_sumbool.
\ No newline at end of file
+Arguments bool_of_sumbool : default implicits.
diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v
index e67ba677..e8798d0d 100644
--- a/theories/Bool/Zerob.v
+++ b/theories/Bool/Zerob.v
@@ -1,17 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zerob.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Arith.
 Require Import Bool.
 
-Open Local Scope nat_scope.
+Local Open Scope nat_scope.
 
 Definition zerob (n:nat) : bool :=
   match n with
@@ -39,4 +37,4 @@ Hint Resolve zerob_false_intro: bool.
 Lemma zerob_false_elim : forall n:nat, zerob n = false -> n <> 0.
 Proof.
   destruct n; [ inversion 1 | auto with bool ].
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Classes/EquivDec.v b/theories/Classes/EquivDec.v
index ea1543e3..cb1bdb1d 100644
--- a/theories/Classes/EquivDec.v
+++ b/theories/Classes/EquivDec.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -12,8 +12,6 @@
    Institution: LRI, CNRS UMR 8623 - University Paris Sud
 *)
 
-(* $Id: EquivDec.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Export notations. *)
 
 Require Export Coq.Classes.Equivalence.
@@ -51,7 +49,7 @@ Definition swap_sumbool {A B} (x : { A } + { B }) : { B } + { A } :=
     | right H => @left _ _ H
   end.
 
-Open Local Scope program_scope.
+Local Open Scope program_scope.
 
 (** Invert the branches. *)
 
diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v
index e562328d..e0f5a395 100644
--- a/theories/Classes/Equivalence.v
+++ b/theories/Classes/Equivalence.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -12,8 +12,6 @@
    Institution: LRI, CNRS UMR 8623 - University Paris Sud
 *)
 
-(* $Id: Equivalence.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Import Coq.Program.Basics.
 Require Import Coq.Program.Tactics.
 
@@ -28,7 +26,7 @@ Unset Strict Implicit.
 Generalizable Variables A R eqA B S eqB.
 Local Obligation Tactic := simpl_relation.
 
-Open Local Scope signature_scope.
+Local Open Scope signature_scope.
 
 Definition equiv `{Equivalence A R} : relation A := R.
 
@@ -39,7 +37,7 @@ Notation " x === y " := (equiv x y) (at level 70, no associativity) : equiv_scop
 
 Notation " x =/= y " := (complement equiv x y) (at level 70, no associativity) : equiv_scope.
 
-Open Local Scope equiv_scope.
+Local Open Scope equiv_scope.
 
 (** Overloading for [PER]. *)
 
diff --git a/theories/Classes/Init.v b/theories/Classes/Init.v
index eea16129..06730095 100644
--- a/theories/Classes/Init.v
+++ b/theories/Classes/Init.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -13,8 +13,6 @@
    Institution: LRI, CNRS UMR 8623 - University Paris Sud
 *)
 
-(* $Id: Init.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Hints for the proof search: these combinators should be considered rigid. *)
 
 Require Import Coq.Program.Basics.
@@ -36,4 +34,4 @@ Ltac unconvertible :=
     | |- _ => exact tt
   end.
 
-Hint Extern 0 (@Unconvertible _ _ _) => unconvertible : typeclass_instances.
\ No newline at end of file
+Hint Extern 0 (@Unconvertible _ _ _) => unconvertible : typeclass_instances.
diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v
index ea869a66..617ff190 100644
--- a/theories/Classes/Morphisms.v
+++ b/theories/Classes/Morphisms.v
@@ -1,7 +1,7 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -13,8 +13,6 @@
    Institution: LRI, CNRS UMR 8623 - University Paris Sud
 *)
 
-(* $Id: Morphisms.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Import Coq.Program.Basics.
 Require Import Coq.Program.Tactics.
 Require Import Coq.Relations.Relation_Definitions.
@@ -23,12 +21,6 @@ Require Export Coq.Classes.RelationClasses.
 Generalizable All Variables.
 Local Obligation Tactic := simpl_relation.
 
-Local Notation "'λ'  x .. y , t" := (fun x => .. (fun y => t) ..)
-  (at level 200, x binder, y binder, right associativity).
-
-Local Notation "'Π'  x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity) : type_scope.
-
 (** * Morphisms.
 
    We now turn to the definition of [Proper] and declare standard instances.
@@ -63,8 +55,8 @@ Definition respectful {A B : Type}
 
 Delimit Scope signature_scope with signature.
 
-Arguments Scope Proper [type_scope signature_scope].
-Arguments Scope respectful [type_scope type_scope signature_scope signature_scope].
+Arguments Proper {A}%type R%signature m.
+Arguments respectful {A B}%type (R R')%signature _ _.
 
 Module ProperNotations.
 
@@ -81,19 +73,60 @@ End ProperNotations.
 
 Export ProperNotations.
 
-Open Local Scope signature_scope.
+Local Open Scope signature_scope.
+
+(** [solve_proper] try to solve the goal [Proper (?==> ... ==>?) f]
+    by repeated introductions and setoid rewrites. It should work
+    fine when [f] is a combination of already known morphisms and
+    quantifiers. *)
+
+Ltac solve_respectful t :=
+ match goal with
+   | |- respectful _ _ _ _ =>
+     let H := fresh "H" in
+     intros ? ? H; solve_respectful ltac:(setoid_rewrite H; t)
+   | _ => t; reflexivity
+ end.
+
+Ltac solve_proper := unfold Proper; solve_respectful ltac:(idtac).
+
+(** [f_equiv] is a clone of [f_equal] that handles setoid equivalences.
+    For example, if we know that [f] is a morphism for [E1==>E2==>E],
+    then the goal [E (f x y) (f x' y')] will be transformed by [f_equiv]
+    into the subgoals [E1 x x'] and [E2 y y'].
+*)
+
+Ltac f_equiv :=
+ match goal with
+  | |- ?R (?f ?x) (?f' _) =>
+    let T := type of x in
+    let Rx := fresh "R" in
+    evar (Rx : relation T);
+    let H := fresh in
+    assert (H : (Rx==>R)%signature f f');
+    unfold Rx in *; clear Rx; [ f_equiv | apply H; clear H; try reflexivity ]
+  | |- ?R ?f ?f' =>
+    try reflexivity;
+    change (Proper R f); eauto with typeclass_instances; fail
+  | _ => idtac
+ end.
+
+(** [forall_def] reifies the dependent product as a definition. *)
+
+Definition forall_def {A : Type} (B : A -> Type) : Type := forall x : A, B x.
 
 (** Dependent pointwise lifting of a relation on the range. *)
 
-Definition forall_relation {A : Type} {B : A -> Type} (sig : Π a : A, relation (B a)) : relation (Π x : A, B x) :=
-  λ f g, Π a : A, sig a (f a) (g a).
+Definition forall_relation {A : Type} {B : A -> Type}
+ (sig : forall a, relation (B a)) : relation (forall x, B x) :=
+ fun f g => forall a, sig a (f a) (g a).
 
-Arguments Scope forall_relation [type_scope type_scope signature_scope].
+Arguments forall_relation {A B}%type sig%signature _ _.
 
 (** Non-dependent pointwise lifting *)
 
 Definition pointwise_relation (A : Type) {B : Type} (R : relation B) : relation (A -> B) :=
-  Eval compute in forall_relation (B:=λ _, B) (λ _, R).
+  Eval compute in forall_relation (B:=fun _ => B) (fun _ => R).
 
 Lemma pointwise_pointwise A B (R : relation B) :
   relation_equivalence (pointwise_relation A R) (@eq A ==> R).
@@ -192,28 +225,34 @@ Hint Extern 4 (subrelation (inverse _) _) =>
 
 (** The complement of a relation conserves its proper elements. *)
 
-Program Instance complement_proper
+Program Definition complement_proper
   `(mR : Proper (A -> A -> Prop) (RA ==> RA ==> iff) R) :
-  Proper (RA ==> RA ==> iff) (complement R).
+  Proper (RA ==> RA ==> iff) (complement R) := _.
 
-  Next Obligation.
+ Next Obligation.
   Proof.
     unfold complement.
     pose (mR x y H x0 y0 H0).
     intuition.
   Qed.
+ 
+Hint Extern 1 (Proper _ (complement _)) => 
+  apply @complement_proper : typeclass_instances.
 
 (** The [inverse] too, actually the [flip] instance is a bit more general. *)
 
-Program Instance flip_proper
+Program Definition flip_proper
   `(mor : Proper (A -> B -> C) (RA ==> RB ==> RC) f) :
-  Proper (RB ==> RA ==> RC) (flip f).
+  Proper (RB ==> RA ==> RC) (flip f) := _.
 
   Next Obligation.
   Proof.
     apply mor ; auto.
   Qed.
 
+Hint Extern 1 (Proper _ (flip _)) => 
+  apply @flip_proper : typeclass_instances.
+
 (** Every Transitive relation gives rise to a binary morphism on [impl],
    contravariant in the first argument, covariant in the second. *)
 
@@ -369,41 +408,45 @@ Class PartialApplication.
 CoInductive normalization_done : Prop := did_normalization.
 
 Ltac partial_application_tactic :=
-  let rec do_partial_apps H m :=
+  let rec do_partial_apps H m cont := 
     match m with
-      | ?m' ?x => class_apply @Reflexive_partial_app_morphism ; [do_partial_apps H m'|clear H]
-      | _ => idtac
+      | ?m' ?x => class_apply @Reflexive_partial_app_morphism ; 
+        [(do_partial_apps H m' ltac:idtac)|clear H]
+      | _ => cont
     end
   in
-  let rec do_partial H ar m :=
+  let rec do_partial H ar m := 
     match ar with
-      | 0 => do_partial_apps H m
+      | 0%nat => do_partial_apps H m ltac:(fail 1)
       | S ?n' =>
         match m with
           ?m' ?x => do_partial H n' m'
         end
     end
   in
-  let on_morphism m :=
-    let m' := fresh in head_of_constr m' m ;
-    let n := fresh in evar (n:nat) ;
-    let v := eval compute in n in clear n ;
-    let H := fresh in
-      assert(H:Params m' v) by typeclasses eauto ;
-      let v' := eval compute in v in subst m';
-      do_partial H v' m
- in
+  let params m sk fk :=
+    (let m' := fresh in head_of_constr m' m ;
+     let n := fresh in evar (n:nat) ;
+     let v := eval compute in n in clear n ;
+      let H := fresh in
+        assert(H:Params m' v) by typeclasses eauto ;
+          let v' := eval compute in v in subst m';
+            (sk H v' || fail 1))
+    || fk
+  in
+  let on_morphism m cont :=
+    params m ltac:(fun H n => do_partial H n m)
+      ltac:(cont)
+  in
   match goal with
     | [ _ : normalization_done |- _ ] => fail 1
     | [ _ : @Params _ _ _ |- _ ] => fail 1
     | [ |- @Proper ?T _ (?m ?x) ] =>
       match goal with
-        | [ _ : PartialApplication |- _ ] =>
-          class_apply @Reflexive_partial_app_morphism
-        | _ =>
-          on_morphism (m x) ||
-            (class_apply @Reflexive_partial_app_morphism ;
-              [ pose Build_PartialApplication | idtac ])
+        | [ H : PartialApplication |- _ ] =>
+          class_apply @Reflexive_partial_app_morphism; [|clear H]
+        | _ => on_morphism (m x)
+          ltac:(class_apply @Reflexive_partial_app_morphism)
       end
   end.
 
@@ -432,7 +475,7 @@ Qed.
 
 Lemma inverse_arrow `(NA : Normalizes A R (inverse R'''), NB : Normalizes B R' (inverse R'')) :
   Normalizes (A -> B) (R ==> R') (inverse (R''' ==> R'')%signature).
-Proof. unfold Normalizes in *. intros.
+Proof. unfold Normalizes in *. intros. 
   rewrite NA, NB. firstorder.
 Qed.
 
diff --git a/theories/Classes/Morphisms_Prop.v b/theories/Classes/Morphisms_Prop.v
index 5a2482d4..2252e42f 100644
--- a/theories/Classes/Morphisms_Prop.v
+++ b/theories/Classes/Morphisms_Prop.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -107,3 +107,33 @@ Program Instance all_inverse_impl_morphism {A : Type} :
     unfold pointwise_relation, all in *.
     intuition ; specialize (H x0) ; intuition.
   Qed.
+
+(** Equivalent points are simultaneously accessible or not *)
+
+Instance Acc_pt_morphism {A:Type}(E R : A->A->Prop)
+ `(Equivalence _ E) `(Proper _ (E==>E==>iff) R) :
+ Proper (E==>iff) (Acc R).
+Proof.
+ apply proper_sym_impl_iff; auto with *.
+ intros x y EQ WF. apply Acc_intro; intros z Hz.
+ rewrite <- EQ in Hz. now apply Acc_inv with x.
+Qed.
+
+(** Equivalent relations have the same accessible points *)
+
+Instance Acc_rel_morphism {A:Type} :
+ Proper (@relation_equivalence A ==> Logic.eq ==> iff) (@Acc A).
+Proof.
+ apply proper_sym_impl_iff_2. red; now symmetry. red; now symmetry.
+ intros R R' EQ a a' Ha WF. subst a'.
+ induction WF as [x _ WF']. constructor.
+ intros y Ryx. now apply WF', EQ.
+Qed.
+
+(** Equivalent relations are simultaneously well-founded or not *)
+
+Instance well_founded_morphism {A : Type} :
+ Proper (@relation_equivalence A ==> iff) (@well_founded A).
+Proof.
+ unfold well_founded. solve_proper.
+Qed.
diff --git a/theories/Classes/Morphisms_Relations.v b/theories/Classes/Morphisms_Relations.v
index a8009f9e..ea2afb30 100644
--- a/theories/Classes/Morphisms_Relations.v
+++ b/theories/Classes/Morphisms_Relations.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -32,11 +32,11 @@ Instance relation_disjunction_morphism : Proper (relation_equivalence (A:=A) ==>
 
 Require Import List.
 
-Lemma predicate_equivalence_pointwise (l : list Type) :
+Lemma predicate_equivalence_pointwise (l : Tlist) :
   Proper (@predicate_equivalence l ==> pointwise_lifting iff l) id.
 Proof. do 2 red. unfold predicate_equivalence. auto. Qed.
 
-Lemma predicate_implication_pointwise (l : list Type) :
+Lemma predicate_implication_pointwise (l : Tlist) :
   Proper (@predicate_implication l ==> pointwise_lifting impl l) id.
 Proof. do 2 red. unfold predicate_implication. auto. Qed.
 
@@ -45,11 +45,11 @@ Proof. do 2 red. unfold predicate_implication. auto. Qed.
 
 Instance relation_equivalence_pointwise :
   Proper (relation_equivalence ==> pointwise_relation A (pointwise_relation A iff)) id.
-Proof. intro. apply (predicate_equivalence_pointwise (cons A (cons A nil))). Qed.
+Proof. intro. apply (predicate_equivalence_pointwise (Tcons A (Tcons A Tnil))). Qed.
 
 Instance subrelation_pointwise :
   Proper (subrelation ==> pointwise_relation A (pointwise_relation A impl)) id.
-Proof. intro. apply (predicate_implication_pointwise (cons A (cons A nil))). Qed.
+Proof. intro. apply (predicate_implication_pointwise (Tcons A (Tcons A Tnil))). Qed.
 
 
 Lemma inverse_pointwise_relation A (R : relation A) :
diff --git a/theories/Classes/RelationClasses.v b/theories/Classes/RelationClasses.v
index 94c51bf1..71647953 100644
--- a/theories/Classes/RelationClasses.v
+++ b/theories/Classes/RelationClasses.v
@@ -1,13 +1,13 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(** *  Typeclass-based relations, tactics and standard instances
+(** * Typeclass-based relations, tactics and standard instances
 
    This is the basic theory needed to formalize morphisms and setoids.
 
@@ -15,8 +15,6 @@
    Institution: LRI, CNRS UMR 8623 - University Paris Sud
 *)
 
-(* $Id: RelationClasses.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Export Coq.Classes.Init.
 Require Import Coq.Program.Basics.
 Require Import Coq.Program.Tactics.
@@ -143,9 +141,9 @@ Program Instance impl_Transitive : Transitive impl.
 
 (** Logical equivalence. *)
 
-Program Instance iff_Reflexive : Reflexive iff.
-Program Instance iff_Symmetric : Symmetric iff.
-Program Instance iff_Transitive : Transitive iff.
+Instance iff_Reflexive : Reflexive iff := iff_refl.
+Instance iff_Symmetric : Symmetric iff := iff_sym.
+Instance iff_Transitive : Transitive iff := iff_trans.
 
 (** Leibniz equality. *)
 
@@ -158,14 +156,14 @@ Instance eq_Transitive {A} : Transitive (@eq A) := @eq_trans A.
 (** A [PreOrder] is both Reflexive and Transitive. *)
 
 Class PreOrder {A} (R : relation A) : Prop := {
-  PreOrder_Reflexive :> Reflexive R ;
-  PreOrder_Transitive :> Transitive R }.
+  PreOrder_Reflexive :> Reflexive R | 2 ;
+  PreOrder_Transitive :> Transitive R | 2 }.
 
 (** A partial equivalence relation is Symmetric and Transitive. *)
 
 Class PER {A} (R : relation A) : Prop := {
-  PER_Symmetric :> Symmetric R ;
-  PER_Transitive :> Transitive R }.
+  PER_Symmetric :> Symmetric R | 3 ;
+  PER_Transitive :> Transitive R | 3 }.
 
 (** Equivalence relations. *)
 
@@ -210,17 +208,21 @@ Local Open Scope list_scope.
 
 (** A compact representation of non-dependent arities, with the codomain singled-out. *)
 
-Fixpoint arrows (l : list Type) (r : Type) : Type :=
+(* Note, we do not use [list Type] because it imposes unnecessary universe constraints *)
+Inductive Tlist : Type := Tnil : Tlist | Tcons : Type -> Tlist -> Tlist.
+Local Infix "::" := Tcons.
+
+Fixpoint arrows (l : Tlist) (r : Type) : Type :=
   match l with
-    | nil => r
+    | Tnil => r
     | A :: l' => A -> arrows l' r
   end.
 
 (** We can define abbreviations for operation and relation types based on [arrows]. *)
 
-Definition unary_operation A := arrows (A::nil) A.
-Definition binary_operation A := arrows (A::A::nil) A.
-Definition ternary_operation A := arrows (A::A::A::nil) A.
+Definition unary_operation A := arrows (A::Tnil) A.
+Definition binary_operation A := arrows (A::A::Tnil) A.
+Definition ternary_operation A := arrows (A::A::A::Tnil) A.
 
 (** We define n-ary [predicate]s as functions into [Prop]. *)
 
@@ -228,23 +230,23 @@ Notation predicate l := (arrows l Prop).
 
 (** Unary predicates, or sets. *)
 
-Definition unary_predicate A := predicate (A::nil).
+Definition unary_predicate A := predicate (A::Tnil).
 
 (** Homogeneous binary relations, equivalent to [relation A]. *)
 
-Definition binary_relation A := predicate (A::A::nil).
+Definition binary_relation A := predicate (A::A::Tnil).
 
 (** We can close a predicate by universal or existential quantification. *)
 
-Fixpoint predicate_all (l : list Type) : predicate l -> Prop :=
+Fixpoint predicate_all (l : Tlist) : predicate l -> Prop :=
   match l with
-    | nil => fun f => f
+    | Tnil => fun f => f
     | A :: tl => fun f => forall x : A, predicate_all tl (f x)
   end.
 
-Fixpoint predicate_exists (l : list Type) : predicate l -> Prop :=
+Fixpoint predicate_exists (l : Tlist) : predicate l -> Prop :=
   match l with
-    | nil => fun f => f
+    | Tnil => fun f => f
     | A :: tl => fun f => exists x : A, predicate_exists tl (f x)
   end.
 
@@ -253,30 +255,30 @@ Fixpoint predicate_exists (l : list Type) : predicate l -> Prop :=
    For an operator on [Prop] this lifts the operator to a binary operation. *)
 
 Fixpoint pointwise_extension {T : Type} (op : binary_operation T)
-  (l : list Type) : binary_operation (arrows l T) :=
+  (l : Tlist) : binary_operation (arrows l T) :=
   match l with
-    | nil => fun R R' => op R R'
+    | Tnil => fun R R' => op R R'
     | A :: tl => fun R R' =>
       fun x => pointwise_extension op tl (R x) (R' x)
   end.
 
 (** Pointwise lifting, equivalent to doing [pointwise_extension] and closing using [predicate_all]. *)
 
-Fixpoint pointwise_lifting (op : binary_relation Prop)  (l : list Type) : binary_relation (predicate l) :=
+Fixpoint pointwise_lifting (op : binary_relation Prop)  (l : Tlist) : binary_relation (predicate l) :=
   match l with
-    | nil => fun R R' => op R R'
+    | Tnil => fun R R' => op R R'
     | A :: tl => fun R R' =>
       forall x, pointwise_lifting op tl (R x) (R' x)
   end.
 
 (** The n-ary equivalence relation, defined by lifting the 0-ary [iff] relation. *)
 
-Definition predicate_equivalence {l : list Type} : binary_relation (predicate l) :=
+Definition predicate_equivalence {l : Tlist} : binary_relation (predicate l) :=
   pointwise_lifting iff l.
 
 (** The n-ary implication relation, defined by lifting the 0-ary [impl] relation. *)
 
-Definition predicate_implication {l : list Type} :=
+Definition predicate_implication {l : Tlist} :=
   pointwise_lifting impl l.
 
 (** Notations for pointwise equivalence and implication of predicates. *)
@@ -284,7 +286,7 @@ Definition predicate_implication {l : list Type} :=
 Infix "<∙>" := predicate_equivalence (at level 95, no associativity) : predicate_scope.
 Infix "-∙>" := predicate_implication (at level 70, right associativity) : predicate_scope.
 
-Open Local Scope predicate_scope.
+Local Open Scope predicate_scope.
 
 (** The pointwise liftings of conjunction and disjunctions.
    Note that these are [binary_operation]s, building new relations out of old ones. *)
@@ -297,15 +299,15 @@ Infix "\∙/" := predicate_union (at level 85, right associativity) : predicate_
 
 (** The always [True] and always [False] predicates. *)
 
-Fixpoint true_predicate {l : list Type} : predicate l :=
+Fixpoint true_predicate {l : Tlist} : predicate l :=
   match l with
-    | nil => True
+    | Tnil => True
     | A :: tl => fun _ => @true_predicate tl
   end.
 
-Fixpoint false_predicate {l : list Type} : predicate l :=
+Fixpoint false_predicate {l : Tlist} : predicate l :=
   match l with
-    | nil => False
+    | Tnil => False
     | A :: tl => fun _ => @false_predicate tl
   end.
 
@@ -315,6 +317,7 @@ Notation "∙⊥∙" := false_predicate : predicate_scope.
 (** Predicate equivalence is an equivalence, and predicate implication defines a preorder. *)
 
 Program Instance predicate_equivalence_equivalence : Equivalence (@predicate_equivalence l).
+
   Next Obligation.
     induction l ; firstorder.
   Qed.
@@ -343,18 +346,18 @@ Program Instance predicate_implication_preorder :
    from the general ones. *)
 
 Definition relation_equivalence {A : Type} : relation (relation A) :=
-  @predicate_equivalence (_::_::nil).
+  @predicate_equivalence (_::_::Tnil).
 
 Class subrelation {A:Type} (R R' : relation A) : Prop :=
-  is_subrelation : @predicate_implication (A::A::nil) R R'.
+  is_subrelation : @predicate_implication (A::A::Tnil) R R'.
 
-Implicit Arguments subrelation [[A]].
+Arguments subrelation {A} R R'.
 
 Definition relation_conjunction {A} (R : relation A) (R' : relation A) : relation A :=
-  @predicate_intersection (A::A::nil) R R'.
+  @predicate_intersection (A::A::Tnil) R R'.
 
 Definition relation_disjunction {A} (R : relation A) (R' : relation A) : relation A :=
-  @predicate_union (A::A::nil) R R'.
+  @predicate_union (A::A::Tnil) R R'.
 
 (** Relation equivalence is an equivalence, and subrelation defines a partial order. *)
 
@@ -362,10 +365,10 @@ Set Automatic Introduction.
 
 Instance relation_equivalence_equivalence (A : Type) :
   Equivalence (@relation_equivalence A).
-Proof. exact (@predicate_equivalence_equivalence (A::A::nil)). Qed.
+Proof. exact (@predicate_equivalence_equivalence (A::A::Tnil)). Qed.
 
 Instance relation_implication_preorder A : PreOrder (@subrelation A).
-Proof. exact (@predicate_implication_preorder (A::A::nil)). Qed.
+Proof. exact (@predicate_implication_preorder (A::A::Tnil)). Qed.
 
 (** *** Partial Order.
    A partial order is a preorder which is additionally antisymmetric.
@@ -393,7 +396,7 @@ Program Instance subrelation_partial_order :
 
   Next Obligation.
   Proof.
-    unfold relation_equivalence in *. firstorder.
+    unfold relation_equivalence in *. compute; firstorder.
   Qed.
 
 Typeclasses Opaque arrows predicate_implication predicate_equivalence
@@ -420,7 +423,7 @@ Instance equivalence_rewrite_relation `(Equivalence A eqA) : RewriteRelation eqA
 
 (** Strict Order *)
 
-Class StrictOrder {A : Type} (R : relation A) := {
+Class StrictOrder {A : Type} (R : relation A) : Prop := {
   StrictOrder_Irreflexive :> Irreflexive R ;
   StrictOrder_Transitive :> Transitive R
 }.
diff --git a/theories/Classes/RelationPairs.v b/theories/Classes/RelationPairs.v
index 7972c96c..2b010206 100644
--- a/theories/Classes/RelationPairs.v
+++ b/theories/Classes/RelationPairs.v
@@ -15,27 +15,25 @@ Require Import Relations Morphisms.
     fix the simpl tactic, since "simpl fst" would be refused for
     the moment.
 
-Implicit Arguments fst [[A] [B]].
-Implicit Arguments snd [[A] [B]].
-Implicit Arguments pair [[A] [B]].
+Arguments fst {A B}.
+Arguments snd {A B}.
+Arguments pair {A B}.
 
 /NB *)
 
 Local Notation Fst := (@fst _ _).
 Local Notation Snd := (@snd _ _).
 
-Arguments Scope relation_conjunction
- [type_scope signature_scope signature_scope].
-Arguments Scope relation_equivalence
- [type_scope signature_scope signature_scope].
-Arguments Scope subrelation [type_scope signature_scope signature_scope].
-Arguments Scope Reflexive [type_scope signature_scope].
-Arguments Scope Irreflexive [type_scope signature_scope].
-Arguments Scope Symmetric [type_scope signature_scope].
-Arguments Scope Transitive [type_scope signature_scope].
-Arguments Scope PER [type_scope signature_scope].
-Arguments Scope Equivalence [type_scope signature_scope].
-Arguments Scope StrictOrder [type_scope signature_scope].
+Arguments relation_conjunction A%type (R R')%signature _ _.
+Arguments relation_equivalence A%type (_ _)%signature.
+Arguments subrelation A%type (R R')%signature.
+Arguments Reflexive A%type R%signature.
+Arguments Irreflexive A%type R%signature.
+Arguments Symmetric A%type R%signature.
+Arguments Transitive A%type R%signature.
+Arguments PER A%type R%signature.
+Arguments Equivalence A%type R%signature.
+Arguments StrictOrder A%type R%signature.
 
 Generalizable Variables A B RA RB Ri Ro f.
 
@@ -88,10 +86,10 @@ Section RelCompFun_Instances.
     `(Measure A B f, Irreflexive _ R) : Irreflexive (R@@f).
   Proof. firstorder. Qed.
 
-  Global Instance RelCompFun_Equivalence
+  Global Program Instance RelCompFun_Equivalence
     `(Measure A B f, Equivalence _ R) : Equivalence (R@@f).
 
-  Global Instance RelCompFun_StrictOrder
+  Global Program Instance RelCompFun_StrictOrder
     `(Measure A B f, StrictOrder _ R) : StrictOrder (R@@f).
 
 End RelCompFun_Instances.
@@ -108,7 +106,7 @@ Instance RelProd_Transitive {A B}(RA:relation A)(RB:relation B)
  `(Transitive _ RA, Transitive _ RB) : Transitive (RA*RB).
 Proof. firstorder. Qed.
 
-Instance RelProd_Equivalence {A B}(RA:relation A)(RB:relation B)
+Program Instance RelProd_Equivalence {A B}(RA:relation A)(RB:relation B)
  `(Equivalence _ RA, Equivalence _ RB) : Equivalence (RA*RB).
 
 Lemma FstRel_ProdRel {A B}(RA:relation A) :
diff --git a/theories/Classes/SetoidClass.v b/theories/Classes/SetoidClass.v
index e9da6874..6efc2302 100644
--- a/theories/Classes/SetoidClass.v
+++ b/theories/Classes/SetoidClass.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -12,8 +12,6 @@
    Institution: LRI, CNRS UMR 8623 - University Paris Sud
 *)
 
-(* $Id: SetoidClass.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Set Implicit Arguments.
 Unset Strict Implicit.
 
@@ -71,7 +69,7 @@ Notation " x =/= y " := (complement equiv x y) (at level 70, no associativity) :
 (** Use the [clsubstitute] command which substitutes an equality in every hypothesis. *)
 
 Ltac clsubst H :=
-  match type of H with
+  lazymatch type of H with
     ?x == ?y => substitute H ; clear H x
   end.
 
diff --git a/theories/Classes/SetoidDec.v b/theories/Classes/SetoidDec.v
index 4f70b244..ac1e1dc4 100644
--- a/theories/Classes/SetoidDec.v
+++ b/theories/Classes/SetoidDec.v
@@ -1,7 +1,7 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -13,16 +13,11 @@
    Institution: LRI, CNRS UMR 8623 - University Paris Sud
 *)
 
-(* $Id: SetoidDec.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Set Implicit Arguments.
 Unset Strict Implicit.
 
 Generalizable Variables A B .
 
-Local Notation "'λ'  x .. y , t" := (fun x => .. (fun y => t) ..)
-  (at level 200, x binder, y binder, right associativity).
-
 (** Export notations. *)
 
 Require Export Coq.Classes.SetoidClass.
@@ -55,7 +50,7 @@ Definition swap_sumbool {A B} (x : { A } + { B }) : { B } + { A } :=
 
 Require Import Coq.Program.Program.
 
-Open Local Scope program_scope.
+Local Open Scope program_scope.
 
 (** Invert the branches. *)
 
@@ -95,7 +90,7 @@ Program Instance bool_eqdec : EqDec (eq_setoid bool) :=
   bool_dec.
 
 Program Instance unit_eqdec : EqDec (eq_setoid unit) :=
-  λ x y, in_left.
+  fun x y => in_left.
 
   Next Obligation.
   Proof.
@@ -103,8 +98,9 @@ Program Instance unit_eqdec : EqDec (eq_setoid unit) :=
     reflexivity.
   Qed.
 
-Program Instance prod_eqdec `(! EqDec (eq_setoid A), ! EqDec (eq_setoid B)) : EqDec (eq_setoid (prod A B)) :=
-  λ x y,
+Program Instance prod_eqdec `(! EqDec (eq_setoid A), ! EqDec (eq_setoid B))
+ : EqDec (eq_setoid (prod A B)) :=
+  fun x y =>
     let '(x1, x2) := x in
     let '(y1, y2) := y in
     if x1 == y1 then
@@ -117,8 +113,9 @@ Program Instance prod_eqdec `(! EqDec (eq_setoid A), ! EqDec (eq_setoid B)) : Eq
 (** Objects of function spaces with countable domains like bool
   have decidable equality. *)
 
-Program Instance bool_function_eqdec `(! EqDec (eq_setoid A)) : EqDec (eq_setoid (bool -> A)) :=
-  λ f g,
+Program Instance bool_function_eqdec `(! EqDec (eq_setoid A))
+ : EqDec (eq_setoid (bool -> A)) :=
+  fun f g =>
     if f true == g true then
       if f false == g false then in_left
       else in_right
diff --git a/theories/Classes/SetoidTactics.v b/theories/Classes/SetoidTactics.v
index a1a0c969..fa939e22 100644
--- a/theories/Classes/SetoidTactics.v
+++ b/theories/Classes/SetoidTactics.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -12,8 +12,6 @@
    Institution: LRI, CNRS UMR 8623 - University Paris Sud
 *)
 
-(* $Id: SetoidTactics.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Import Coq.Classes.Morphisms Coq.Classes.Morphisms_Prop.
 Require Export Coq.Classes.RelationClasses Coq.Relations.Relation_Definitions.
 Require Import Coq.Classes.Equivalence Coq.Program.Basics.
@@ -148,7 +146,7 @@ Tactic Notation "setoid_replace" constr(x) "with" constr(y)
 
 Require Import Coq.Program.Tactics.
 
-Open Local Scope signature_scope.
+Local Open Scope signature_scope.
 
 Ltac red_subst_eq_morphism concl :=
   match concl with
diff --git a/theories/FSets/FMapAVL.v b/theories/FSets/FMapAVL.v
index 49f595d7..c68216e6 100644
--- a/theories/FSets/FMapAVL.v
+++ b/theories/FSets/FMapAVL.v
@@ -8,8 +8,6 @@
 
 (* Finite map library.  *)
 
-(* $Id: FMapAVL.v 13768 2011-01-06 13:55:35Z glondu $ *)
-
 (** * FMapAVL *)
 
 (** This module implements maps using AVL trees.
@@ -34,11 +32,13 @@ Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope.
    preservation *)
 
 Module Raw (Import I:Int)(X: OrderedType).
-Open Local Scope pair_scope.
-Open Local Scope lazy_bool_scope.
-Open Local Scope Int_scope.
+Local Open Scope pair_scope.
+Local Open Scope lazy_bool_scope.
+Local Open Scope Int_scope.
+Local Notation int := I.t.
 
 Definition key := X.t.
+Hint Transparent key.
 
 (** * Trees *)
 
@@ -542,12 +542,12 @@ Ltac intuition_in := repeat progress (intuition; inv In; inv MapsTo).
 Ltac join_tac :=
  intros l; induction l as [| ll _ lx ld lr Hlr lh];
    [ | intros x d r; induction r as [| rl Hrl rx rd rr _ rh]; unfold join;
-     [ | destruct (gt_le_dec lh (rh+2));
+     [ | destruct (gt_le_dec lh (rh+2)) as [GT|LE];
        [ match goal with |- context [ bal ?u ?v ?w ?z ] =>
            replace (bal u v w z)
            with (bal ll lx ld (join lr x d (Node rl rx rd rr rh))); [ | auto]
          end
-       | destruct (gt_le_dec rh (lh+2));
+       | destruct (gt_le_dec rh (lh+2)) as [GT'|LE'];
          [ match goal with |- context [ bal ?u ?v ?w ?z ] =>
              replace (bal u v w z)
              with (bal (join (Node ll lx ld lr lh) x d rl) rx rd rr); [ | auto]
@@ -604,12 +604,12 @@ Qed.
 
 Lemma lt_leaf : forall x, lt_tree x (Leaf elt).
 Proof.
- unfold lt_tree in |- *; intros; intuition_in.
+ unfold lt_tree; intros; intuition_in.
 Qed.
 
 Lemma gt_leaf : forall x, gt_tree x (Leaf elt).
 Proof.
-  unfold gt_tree in |- *; intros; intuition_in.
+  unfold gt_tree; intros; intuition_in.
 Qed.
 
 Lemma lt_tree_node : forall x y l r e h,
@@ -823,7 +823,7 @@ Proof.
  intros l x e r; functional induction (bal l x e r); intros; clearf;
  inv bst; repeat apply create_bst; auto; unfold create; try constructor;
  (apply lt_tree_node || apply gt_tree_node); auto;
- (eapply lt_tree_trans || eapply gt_tree_trans); eauto.
+ (eapply lt_tree_trans || eapply gt_tree_trans); eauto. 
 Qed.
 Hint Resolve bal_bst.
 
@@ -1113,7 +1113,7 @@ Lemma join_bst : forall l x d r, bst l -> bst r ->
  lt_tree x l -> gt_tree x r -> bst (join l x d r).
 Proof.
  join_tac; auto; try (simpl; auto; fail); inv bst; apply bal_bst; auto;
- clear Hrl Hlr z; intro; intros; rewrite join_in in *.
+ clear Hrl Hlr; intro; intros; rewrite join_in in *.
  intuition; [ apply MX.lt_eq with x | ]; eauto.
  intuition; [ apply MX.eq_lt with x | ]; eauto.
 Qed.
@@ -1333,7 +1333,7 @@ Proof.
  inversion_clear H.
  destruct H7; simpl in *.
  order.
- destruct (elements_aux_mapsto r acc x e0); intuition eauto.
+ destruct (elements_aux_mapsto r acc x e0); intuition eauto. 
 Qed.
 
 Lemma elements_sort : forall s : t elt, bst s -> sort ltk (elements s).
@@ -1389,8 +1389,8 @@ Lemma fold_equiv_aux :
  L.fold f (elements_aux acc s) a = L.fold f acc (fold f s a).
 Proof.
  simple induction s.
- simpl in |- *; intuition.
- simpl in |- *; intros.
+ simpl; intuition.
+ simpl; intros.
  rewrite H.
  simpl.
  apply H0.
@@ -1400,11 +1400,11 @@ Lemma fold_equiv :
  forall (A : Type) (s : t elt) (f : key -> elt -> A -> A) (a : A),
  fold f s a = fold' f s a.
 Proof.
- unfold fold', elements in |- *.
- simple induction s; simpl in |- *; auto; intros.
+ unfold fold', elements.
+ simple induction s; simpl; auto; intros.
  rewrite fold_equiv_aux.
  rewrite H0.
- simpl in |- *; auto.
+ simpl; auto.
 Qed.
 
 Lemma fold_1 :
diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v
index 8944f7ce..0c1448c9 100644
--- a/theories/FSets/FMapFacts.v
+++ b/theories/FSets/FMapFacts.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FMapFacts.v 12459 2009-11-02 18:51:43Z letouzey $ *)
-
 (** * Finite maps library *)
 
 (** This functor derives additional facts from [FMapInterface.S]. These
@@ -259,7 +257,7 @@ Qed.
 
 Lemma mapi_inv : forall m x b (f : key -> elt -> elt'),
  MapsTo x b (mapi f m) ->
- exists a, exists y, E.eq y x /\ b = f y a /\ MapsTo x a m.
+ exists a y, E.eq y x /\ b = f y a /\ MapsTo x a m.
 Proof.
 intros; case_eq (find x m); intros.
 exists e.
@@ -654,7 +652,7 @@ Add Relation key E.eq
  transitivity proved by E.eq_trans
  as KeySetoid.
 
-Implicit Arguments Equal [[elt]].
+Arguments Equal {elt} m m'.
 
 Add Parametric Relation (elt : Type) : (t elt) Equal
  reflexivity proved by (@Equal_refl elt)
@@ -740,7 +738,7 @@ End WFacts_fun.
 
 (** * Same facts for self-contained weak sets and for full maps *)
 
-Module WFacts (M:S) := WFacts_fun M.E M.
+Module WFacts (M:WS) := WFacts_fun M.E M.
 Module Facts := WFacts.
 
 (** * Additional Properties for weak maps
@@ -761,8 +759,8 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
   Notation eqk := (@eq_key elt).
 
   Instance eqk_equiv : Equivalence eqk.
-  Proof. split; repeat red; eauto. Qed.
-
+  Proof. unfold eq_key; split; eauto. Qed.
+  
   Instance eqke_equiv : Equivalence eqke.
   Proof.
    unfold eq_key_elt; split; repeat red; firstorder.
@@ -834,8 +832,11 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
 
   (** * Conversions between maps and association lists. *)
 
+  Definition uncurry {U V W : Type} (f : U -> V -> W) : U*V -> W :=
+   fun p => f (fst p) (snd p).
+
   Definition of_list (l : list (key*elt)) :=
-    List.fold_right (fun p => add (fst p) (snd p)) (empty _) l.
+    List.fold_right (uncurry (@add _)) (empty _) l.
 
   Definition to_list := elements.
 
@@ -845,6 +846,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
   Proof.
   induction l as [|(k',e') l IH]; simpl; intros k e Hnodup.
   rewrite empty_mapsto_iff, InA_nil; intuition.
+  unfold uncurry; simpl.
   inversion_clear Hnodup as [| ? ? Hnotin Hnodup'].
   specialize (IH k e Hnodup'); clear Hnodup'.
   rewrite add_mapsto_iff, InA_cons, <- IH.
@@ -861,6 +863,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
   Proof.
   induction l as [|(k',e') l IH]; simpl; intros k Hnodup.
   apply empty_o.
+  unfold uncurry; simpl.
   inversion_clear Hnodup as [| ? ? Hnotin Hnodup'].
   specialize (IH k Hnodup'); clear Hnodup'.
   rewrite add_o, IH.
@@ -883,6 +886,14 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
 
   (** * Fold *)
 
+  (** Alternative specification via [fold_right] *)
+
+  Lemma fold_spec_right m (A:Type)(i:A)(f : key -> elt -> A -> A) :
+    fold f m i = List.fold_right (uncurry f) i (rev (elements m)).
+  Proof.
+   rewrite fold_1. symmetry. apply fold_left_rev_right.
+  Qed.
+
   (** ** Induction principles about fold contributed by S. Lescuyer *)
 
   (** In the following lemma, the step hypothesis is deliberately restricted
@@ -897,8 +908,8 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
       P m (fold f m i).
   Proof.
   intros A P f i m Hempty Hstep.
-  rewrite fold_1, <- fold_left_rev_right.
-  set (F:=fun (y : key * elt) (x : A) => f (fst y) (snd y) x).
+  rewrite fold_spec_right.
+  set (F:=uncurry f).
   set (l:=rev (elements m)).
   assert (Hstep' : forall k e a m' m'', InA eqke (k,e) l -> ~In k m' ->
              Add k e m' m'' -> P m' a -> P m'' (F (k,e) a)).
@@ -983,8 +994,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
      R (fold f m i) (fold g m j).
   Proof.
   intros A B R f g i j m Rempty Rstep.
-  do 2 rewrite fold_1, <- fold_left_rev_right.
-  set (l:=rev (elements m)).
+  rewrite 2 fold_spec_right. set (l:=rev (elements m)).
   assert (Rstep' : forall k e a b, InA eqke (k,e) l ->
     R a b -> R (f k e a) (g k e b)) by
     (intros; apply Rstep; auto; rewrite elements_mapsto_iff, <- InA_rev; auto with *).
@@ -1099,14 +1109,15 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
   Lemma fold_Equal : forall m1 m2 i, Equal m1 m2 ->
    eqA (fold f m1 i) (fold f m2 i).
   Proof.
-  intros; do 2 rewrite fold_1; do 2 rewrite <- fold_left_rev_right.
+  intros.
+  rewrite 2 fold_spec_right.
   assert (NoDupA eqk (rev (elements m1))) by (auto with *).
   assert (NoDupA eqk (rev (elements m2))) by (auto with *).
   apply fold_right_equivlistA_restr with (R:=complement eqk)(eqA:=eqke);
    auto with *.
   intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; simpl in *; apply Comp; auto.
   unfold complement, eq_key, eq_key_elt; repeat red. intuition eauto.
-  intros (k,e) (k',e'); unfold eq_key; simpl; auto.
+  intros (k,e) (k',e'); unfold eq_key, uncurry; simpl; auto.
   rewrite <- NoDupA_altdef; auto.
   intros (k,e).
   rewrite 2 InA_rev, <- 2 elements_mapsto_iff, 2 find_mapsto_iff, H;
@@ -1116,8 +1127,9 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
   Lemma fold_Add : forall m1 m2 k e i, ~In k m1 -> Add k e m1 m2 ->
    eqA (fold f m2 i) (f k e (fold f m1 i)).
   Proof.
-  intros; do 2 rewrite fold_1; do 2 rewrite <- fold_left_rev_right.
-  set (f':=fun y x0 => f (fst y) (snd y) x0) in *.
+  intros.
+  rewrite 2 fold_spec_right.
+  set (f':=uncurry f).
   change (f k e (fold_right f' i (rev (elements m1))))
    with (f' (k,e) (fold_right f' i (rev (elements m1)))).
   assert (NoDupA eqk (rev (elements m1))) by (auto with *).
@@ -1126,7 +1138,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
    (R:=complement eqk)(eqA:=eqke)(eqB:=eqA); auto with *.
   intros (k1,e1) (k2,e2) (Hk,He) a a' Ha; unfold f'; simpl in *. apply Comp; auto.
   unfold complement, eq_key_elt, eq_key; repeat red; intuition eauto.
-  unfold f'; intros (k1,e1) (k2,e2); unfold eq_key; simpl; auto.
+  unfold f'; intros (k1,e1) (k2,e2); unfold eq_key, uncurry; simpl; auto.
   rewrite <- NoDupA_altdef; auto.
   rewrite InA_rev, <- elements_mapsto_iff by (auto with *). firstorder.
   intros (a,b).
@@ -2130,8 +2142,7 @@ Module OrdProperties (M:S).
    eqA (fold f m1 i) (fold f m2 i).
   Proof.
   intros m1 m2 A eqA st f i Hf Heq.
-  do 2 rewrite fold_1.
-  do 2 rewrite <- fold_left_rev_right.
+  rewrite 2 fold_spec_right.
   apply fold_right_eqlistA with (eqA:=eqke) (eqB:=eqA); auto.
   intros (k,e) (k',e') (Hk,He) a a' Ha; simpl in *; apply Hf; auto.
   apply eqlistA_rev. apply elements_Equal_eqlistA. auto.
@@ -2142,8 +2153,7 @@ Module OrdProperties (M:S).
    Above x m1 -> Add x e m1 m2 ->
    eqA (fold f m2 i) (f x e (fold f m1 i)).
   Proof.
-  intros; do 2 rewrite fold_1; do 2 rewrite <- fold_left_rev_right.
-  set (f':=fun y x0 => f (fst y) (snd y) x0) in *.
+  intros. rewrite 2 fold_spec_right. set (f':=uncurry f).
   transitivity (fold_right f' i (rev (elements m1 ++ (x,e)::nil))).
   apply fold_right_eqlistA with (eqA:=eqke) (eqB:=eqA); auto.
   intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; unfold f'; simpl in *. apply P; auto.
@@ -2158,8 +2168,7 @@ Module OrdProperties (M:S).
    Below x m1 -> Add x e m1 m2 ->
    eqA (fold f m2 i) (fold f m1 (f x e i)).
   Proof.
-  intros; do 2 rewrite fold_1; do 2 rewrite <- fold_left_rev_right.
-  set (f':=fun y x0 => f (fst y) (snd y) x0) in *.
+  intros. rewrite 2 fold_spec_right. set (f':=uncurry f).
   transitivity (fold_right f' i (rev (((x,e)::nil)++elements m1))).
   apply fold_right_eqlistA with (eqA:=eqke) (eqB:=eqA); auto.
   intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; unfold f'; simpl in *; apply P; auto.
diff --git a/theories/FSets/FMapFullAVL.v b/theories/FSets/FMapFullAVL.v
index 2b9e7077..e1c60351 100644
--- a/theories/FSets/FMapFullAVL.v
+++ b/theories/FSets/FMapFullAVL.v
@@ -8,8 +8,6 @@
 
 (* Finite map library.  *)
 
-(* $Id: FMapFullAVL.v 13090 2010-06-08 13:56:14Z herbelin $ *)
-
 (** * FMapFullAVL
 
    This file contains some complements to [FMapAVL].
@@ -36,8 +34,8 @@ Module AvlProofs (Import I:Int)(X: OrderedType).
 Module Import Raw := Raw I X.
 Module Import II:=MoreInt(I).
 Import Raw.Proofs.
-Open Local Scope pair_scope.
-Open Local Scope Int_scope.
+Local Open Scope pair_scope.
+Local Open Scope Int_scope.
 
 Ltac omega_max := i2z_refl; romega with Z.
 
diff --git a/theories/FSets/FMapInterface.v b/theories/FSets/FMapInterface.v
index bbfecfb1..4d89b562 100644
--- a/theories/FSets/FMapInterface.v
+++ b/theories/FSets/FMapInterface.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FMapInterface.v 12640 2010-01-07 15:32:49Z letouzey $ *)
-
 (** * Finite map library *)
 
 (** This file proposes interfaces for finite maps *)
@@ -58,6 +56,7 @@ Definition Cmp (elt:Type)(cmp:elt->elt->bool) e1 e2 := cmp e1 e2 = true.
 Module Type WSfun (E : DecidableType).
 
   Definition key := E.t.
+  Hint Transparent key.
 
   Parameter t : Type -> Type.
   (** the abstract type of maps *)
diff --git a/theories/FSets/FMapList.v b/theories/FSets/FMapList.v
index 4b7f183c..f15ab222 100644
--- a/theories/FSets/FMapList.v
+++ b/theories/FSets/FMapList.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FMapList.v 12458 2009-11-02 18:50:33Z letouzey $ *)
-
 (** * Finite map library *)
 
 (** This file proposes an implementation of the non-dependant interface
diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v
index 30bce2db..c59f7c22 100644
--- a/theories/FSets/FMapPositive.v
+++ b/theories/FSets/FMapPositive.v
@@ -6,14 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FMapPositive.v 13297 2010-07-19 23:32:42Z letouzey $ *)
-
 (** * FMapPositive : an implementation of FMapInterface for [positive] keys. *)
 
 Require Import Bool ZArith OrderedType OrderedTypeEx FMapInterface.
 
 Set Implicit Arguments.
-Open Local Scope positive_scope.
+Local Open Scope positive_scope.
 
 Local Unset Elimination Schemes.
 Local Unset Case Analysis Schemes.
@@ -86,7 +84,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
   Section A.
   Variable A:Type.
 
-  Implicit Arguments Leaf [A].
+  Arguments Leaf [A].
 
   Definition empty : t A := Leaf.
 
@@ -496,9 +494,9 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
 
   Definition lt_key (p p':positive*A) := E.lt (fst p) (fst p').
 
-  Global Instance eqk_equiv : Equivalence eq_key.
-  Global Instance eqke_equiv : Equivalence eq_key_elt.
-  Global Instance ltk_strorder : StrictOrder lt_key.
+  Global Program Instance eqk_equiv : Equivalence eq_key.
+  Global Program Instance eqke_equiv : Equivalence eq_key_elt.
+  Global Program Instance ltk_strorder : StrictOrder lt_key.
 
   Lemma mem_find :
     forall m x, mem x m = match find x m with None => false | _ => true end.
@@ -816,7 +814,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
   Variable A B C : Type.
   Variable f : option A -> option B -> option C.
 
-  Implicit Arguments Leaf [A].
+  Arguments Leaf [A].
 
   Fixpoint xmap2_l (m : t A) : t C :=
       match m with
diff --git a/theories/FSets/FMapWeakList.v b/theories/FSets/FMapWeakList.v
index db479ea8..6c1e8ca8 100644
--- a/theories/FSets/FMapWeakList.v
+++ b/theories/FSets/FMapWeakList.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FMapWeakList.v 12458 2009-11-02 18:50:33Z letouzey $ *)
-
 (** * Finite map library *)
 
 (** This file proposes an implementation of the non-dependant interface
diff --git a/theories/FSets/FMaps.v b/theories/FSets/FMaps.v
index 75904202..19b25d95 100644
--- a/theories/FSets/FMaps.v
+++ b/theories/FSets/FMaps.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FMaps.v 10699 2008-03-19 20:56:43Z letouzey $ *)
-
 
 Require Export OrderedType OrderedTypeEx OrderedTypeAlt.
 Require Export DecidableType DecidableTypeEx.
diff --git a/theories/FSets/FSetAVL.v b/theories/FSets/FSetAVL.v
index 2cbba723..df627a14 100644
--- a/theories/FSets/FSetAVL.v
+++ b/theories/FSets/FSetAVL.v
@@ -7,8 +7,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetAVL.v 12641 2010-01-07 15:32:52Z letouzey $ *)
-
 (** * FSetAVL : Implementation of FSetInterface via AVL trees *)
 
 (** This module implements finite sets using AVL trees.
diff --git a/theories/FSets/FSetBridge.v b/theories/FSets/FSetBridge.v
index c2d921be..1ac544e1 100644
--- a/theories/FSets/FSetBridge.v
+++ b/theories/FSets/FSetBridge.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetBridge.v 13253 2010-07-07 08:39:30Z letouzey $ *)
-
 (** * Finite sets library *)
 
 (** This module implements bridges (as functors) from dependent
@@ -46,7 +44,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E.
   Definition add : forall (x : elt) (s : t), {s' : t | Add x s s'}.
   Proof.
     intros; exists (add x s); auto.
-    unfold Add in |- *; intuition.
+    unfold Add; intuition.
     elim (E.eq_dec x y); auto.
     intros; right.
     eapply add_3; eauto.
@@ -133,7 +131,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E.
    forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}),
    compat_P E.eq P -> compat_bool E.eq (fdec Pdec).
   Proof.
-    unfold compat_P, compat_bool, Proper, respectful, fdec in |- *; intros.
+    unfold compat_P, compat_bool, Proper, respectful, fdec; intros.
     generalize (E.eq_sym H0); case (Pdec x); case (Pdec y); firstorder.
   Qed.
 
@@ -149,11 +147,11 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E.
     intuition.
     eauto with set.
     generalize (filter_2 H0 H1).
-    unfold fdec in |- *.
+    unfold fdec.
     case (Pdec x); intuition.
     inversion H2.
     apply filter_3; auto.
-    unfold fdec in |- *; simpl in |- *.
+    unfold fdec; simpl.
     case (Pdec x); intuition.
   Qed.
 
@@ -164,17 +162,17 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E.
     intros.
     generalize (for_all_1 (s:=s) (f:=fdec Pdec))
      (for_all_2 (s:=s) (f:=fdec Pdec)).
-    case (for_all (fdec Pdec) s); unfold For_all in |- *; [ left | right ];
+    case (for_all (fdec Pdec) s); unfold For_all; [ left | right ];
      intros.
     assert (compat_bool E.eq (fdec Pdec)); auto.
-    generalize (H0 H3 (refl_equal _) _ H2).
-    unfold fdec in |- *.
+    generalize (H0 H3 Logic.eq_refl _ H2).
+    unfold fdec.
     case (Pdec x); intuition.
     inversion H4.
     intuition.
     absurd (false = true); [ auto with bool | apply H; auto ].
     intro.
-    unfold fdec in |- *.
+    unfold fdec.
     case (Pdec x); intuition.
   Qed.
 
@@ -185,19 +183,19 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E.
     intros.
     generalize (exists_1 (s:=s) (f:=fdec Pdec))
      (exists_2 (s:=s) (f:=fdec Pdec)).
-    case (exists_ (fdec Pdec) s); unfold Exists in |- *; [ left | right ];
+    case (exists_ (fdec Pdec) s); unfold Exists; [ left | right ];
      intros.
     elim H0; auto; intros.
     exists x; intuition.
     generalize H4.
-    unfold fdec in |- *.
+    unfold fdec.
     case (Pdec x); intuition.
     inversion H2.
     intuition.
     elim H2; intros.
     absurd (false = true); [ auto with bool | apply H; auto ].
     exists x; intuition.
-    unfold fdec in |- *.
+    unfold fdec.
     case (Pdec x); intuition.
   Qed.
 
@@ -214,26 +212,26 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E.
     exists (partition (fdec Pdec) s).
     generalize (partition_1 s (f:=fdec Pdec)) (partition_2 s (f:=fdec Pdec)).
     case (partition (fdec Pdec) s).
-    intros s1 s2; simpl in |- *.
+    intros s1 s2; simpl.
     intros; assert (compat_bool E.eq (fdec Pdec)); auto.
     intros; assert (compat_bool E.eq (fun x => negb (fdec Pdec x))).
-    generalize H2; unfold compat_bool, Proper, respectful in |- *; intuition;
+    generalize H2; unfold compat_bool, Proper, respectful; intuition;
      apply (f_equal negb); auto.
     intuition.
-    generalize H4; unfold For_all, Equal in |- *; intuition.
+    generalize H4; unfold For_all, Equal; intuition.
     elim (H0 x); intros.
     assert (fdec Pdec x = true).
      eapply filter_2; eauto with set.
-    generalize H8; unfold fdec in |- *; case (Pdec x); intuition.
+    generalize H8; unfold fdec; case (Pdec x); intuition.
     inversion H9.
-    generalize H; unfold For_all, Equal in |- *; intuition.
+    generalize H; unfold For_all, Equal; intuition.
     elim (H0 x); intros.
     cut ((fun x => negb (fdec Pdec x)) x = true).
-    unfold fdec in |- *; case (Pdec x); intuition.
-      change ((fun x => negb (fdec Pdec x)) x = true) in |- *.
+    unfold fdec; case (Pdec x); intuition.
+      change ((fun x => negb (fdec Pdec x)) x = true).
       apply (filter_2 (s:=s) (x:=x)); auto.
-    set (b := fdec Pdec x) in *; generalize (refl_equal b);
-     pattern b at -1 in |- *; case b; unfold b in |- *;
+    set (b := fdec Pdec x) in *; generalize (Logic.eq_refl b);
+     pattern b at -1; case b; unfold b;
      [ left | right ].
     elim (H4 x); intros _ B; apply B; auto with set.
     elim (H x); intros _ B; apply B; auto with set.
@@ -310,7 +308,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E.
     intros;
      generalize (min_elt_1 (s:=s)) (min_elt_2 (s:=s)) (min_elt_3 (s:=s)).
     case (min_elt s); [ left | right ]; auto.
-    exists e; unfold For_all in |- *; eauto.
+    exists e; unfold For_all; eauto.
   Qed.
 
   Definition max_elt :
@@ -320,7 +318,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E.
     intros;
      generalize (max_elt_1 (s:=s)) (max_elt_2 (s:=s)) (max_elt_3 (s:=s)).
     case (max_elt s); [ left | right ]; auto.
-    exists e; unfold For_all in |- *; eauto.
+    exists e; unfold For_all; eauto.
   Qed.
 
   Definition elt := elt.
@@ -362,7 +360,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma empty_1 : Empty empty.
   Proof.
-    unfold empty in |- *; case M.empty; auto.
+    unfold empty; case M.empty; auto.
   Qed.
 
   Definition is_empty (s : t) : bool :=
@@ -370,12 +368,12 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true.
   Proof.
-    intros; unfold is_empty in |- *; case (M.is_empty s); auto.
+    intros; unfold is_empty; case (M.is_empty s); auto.
   Qed.
 
   Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s.
   Proof.
-    intro s; unfold is_empty in |- *; case (M.is_empty s); auto.
+    intro s; unfold is_empty; case (M.is_empty s); auto.
     intros; discriminate H.
   Qed.
 
@@ -384,12 +382,12 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma mem_1 : forall (s : t) (x : elt), In x s -> mem x s = true.
   Proof.
-    intros; unfold mem in |- *; case (M.mem x s); auto.
+    intros; unfold mem; case (M.mem x s); auto.
   Qed.
 
   Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s.
   Proof.
-    intros s x; unfold mem in |- *; case (M.mem x s); auto.
+    intros s x; unfold mem; case (M.mem x s); auto.
     intros; discriminate H.
   Qed.
 
@@ -400,12 +398,12 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma equal_1 : forall s s' : t, Equal s s' -> equal s s' = true.
   Proof.
-    intros; unfold equal in |- *; case M.equal; intuition.
+    intros; unfold equal; case M.equal; intuition.
   Qed.
 
   Lemma equal_2 : forall s s' : t, equal s s' = true -> Equal s s'.
   Proof.
-    intros s s'; unfold equal in |- *; case (M.equal s s'); intuition;
+    intros s s'; unfold equal; case (M.equal s s'); intuition;
      inversion H.
   Qed.
 
@@ -414,12 +412,12 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma subset_1 : forall s s' : t, Subset s s' -> subset s s' = true.
   Proof.
-    intros; unfold subset in |- *; case M.subset; intuition.
+    intros; unfold subset; case M.subset; intuition.
   Qed.
 
   Lemma subset_2 : forall s s' : t, subset s s' = true -> Subset s s'.
   Proof.
-    intros s s'; unfold subset in |- *; case (M.subset s s'); intuition;
+    intros s s'; unfold subset; case (M.subset s s'); intuition;
      inversion H.
   Qed.
 
@@ -431,14 +429,14 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma choose_1 : forall (s : t) (x : elt), choose s = Some x -> In x s.
   Proof.
-    intros s x; unfold choose in |- *; case (M.choose s).
+    intros s x; unfold choose; case (M.choose s).
     simple destruct s0; intros; injection H; intros; subst; auto.
     intros; discriminate H.
   Qed.
 
   Lemma choose_2 : forall s : t, choose s = None -> Empty s.
   Proof.
-    intro s; unfold choose in |- *; case (M.choose s); auto.
+    intro s; unfold choose; case (M.choose s); auto.
     simple destruct s0; intros; discriminate H.
   Qed.
 
@@ -455,17 +453,17 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma elements_1 : forall (s : t) (x : elt), In x s -> InA E.eq x (elements s).
   Proof.
-    intros; unfold elements in |- *; case (M.elements s); firstorder.
+    intros; unfold elements; case (M.elements s); firstorder.
   Qed.
 
   Lemma elements_2 : forall (s : t) (x : elt), InA E.eq x (elements s) -> In x s.
   Proof.
-    intros s x; unfold elements in |- *; case (M.elements s); firstorder.
+    intros s x; unfold elements; case (M.elements s); firstorder.
   Qed.
 
   Lemma elements_3 : forall s : t, sort E.lt (elements s).
   Proof.
-    intros; unfold elements in |- *; case (M.elements s); firstorder.
+    intros; unfold elements; case (M.elements s); firstorder.
   Qed.
   Hint Resolve elements_3.
 
@@ -480,7 +478,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s.
   Proof.
-    intros s x; unfold min_elt in |- *; case (M.min_elt s).
+    intros s x; unfold min_elt; case (M.min_elt s).
     simple destruct s0; intros; injection H; intros; subst; intuition.
     intros; discriminate H.
   Qed.
@@ -488,15 +486,15 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
   Lemma min_elt_2 :
    forall (s : t) (x y : elt), min_elt s = Some x -> In y s -> ~ E.lt y x.
   Proof.
-    intros s x y; unfold min_elt in |- *; case (M.min_elt s).
-    unfold For_all in |- *; simple destruct s0; intros; injection H; intros;
+    intros s x y; unfold min_elt; case (M.min_elt s).
+    unfold For_all; simple destruct s0; intros; injection H; intros;
      subst; firstorder.
     intros; discriminate H.
   Qed.
 
   Lemma min_elt_3 : forall s : t, min_elt s = None -> Empty s.
   Proof.
-    intros s; unfold min_elt in |- *; case (M.min_elt s); auto.
+    intros s; unfold min_elt; case (M.min_elt s); auto.
     simple destruct s0; intros; discriminate H.
   Qed.
 
@@ -508,7 +506,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s.
   Proof.
-    intros s x; unfold max_elt in |- *; case (M.max_elt s).
+    intros s x; unfold max_elt; case (M.max_elt s).
     simple destruct s0; intros; injection H; intros; subst; intuition.
     intros; discriminate H.
   Qed.
@@ -516,15 +514,15 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
   Lemma max_elt_2 :
    forall (s : t) (x y : elt), max_elt s = Some x -> In y s -> ~ E.lt x y.
   Proof.
-    intros s x y; unfold max_elt in |- *; case (M.max_elt s).
-    unfold For_all in |- *; simple destruct s0; intros; injection H; intros;
+    intros s x y; unfold max_elt; case (M.max_elt s).
+    unfold For_all; simple destruct s0; intros; injection H; intros;
      subst; firstorder.
     intros; discriminate H.
   Qed.
 
   Lemma max_elt_3 : forall s : t, max_elt s = None -> Empty s.
   Proof.
-    intros s; unfold max_elt in |- *; case (M.max_elt s); auto.
+    intros s; unfold max_elt; case (M.max_elt s); auto.
     simple destruct s0; intros; discriminate H.
   Qed.
 
@@ -532,20 +530,20 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma add_1 : forall (s : t) (x y : elt), E.eq x y -> In y (add x s).
   Proof.
-    intros; unfold add in |- *; case (M.add x s); unfold Add in |- *;
+    intros; unfold add; case (M.add x s); unfold Add;
      firstorder.
   Qed.
 
   Lemma add_2 : forall (s : t) (x y : elt), In y s -> In y (add x s).
   Proof.
-    intros; unfold add in |- *; case (M.add x s); unfold Add in |- *;
+    intros; unfold add; case (M.add x s); unfold Add;
      firstorder.
   Qed.
 
   Lemma add_3 :
    forall (s : t) (x y : elt), ~ E.eq x y -> In y (add x s) -> In y s.
   Proof.
-    intros s x y; unfold add in |- *; case (M.add x s); unfold Add in |- *;
+    intros s x y; unfold add; case (M.add x s); unfold Add;
      firstorder.
   Qed.
 
@@ -553,30 +551,30 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
 
   Lemma remove_1 : forall (s : t) (x y : elt), E.eq x y -> ~ In y (remove x s).
   Proof.
-    intros; unfold remove in |- *; case (M.remove x s); firstorder.
+    intros; unfold remove; case (M.remove x s); firstorder.
   Qed.
 
   Lemma remove_2 :
    forall (s : t) (x y : elt), ~ E.eq x y -> In y s -> In y (remove x s).
   Proof.
-    intros; unfold remove in |- *; case (M.remove x s); firstorder.
+    intros; unfold remove; case (M.remove x s); firstorder.
   Qed.
 
   Lemma remove_3 : forall (s : t) (x y : elt), In y (remove x s) -> In y s.
   Proof.
-    intros s x y; unfold remove in |- *; case (M.remove x s); firstorder.
+    intros s x y; unfold remove; case (M.remove x s); firstorder.
   Qed.
 
   Definition singleton (x : elt) : t := let (s, _) := singleton x in s.
 
   Lemma singleton_1 : forall x y : elt, In y (singleton x) -> E.eq x y.
   Proof.
-    intros x y; unfold singleton in |- *; case (M.singleton x); firstorder.
+    intros x y; unfold singleton; case (M.singleton x); firstorder.
   Qed.
 
   Lemma singleton_2 : forall x y : elt, E.eq x y -> In y (singleton x).
   Proof.
-    intros x y; unfold singleton in |- *; case (M.singleton x); firstorder.
+    intros x y; unfold singleton; case (M.singleton x); firstorder.
   Qed.
 
   Definition union (s s' : t) : t := let (s'', _) := union s s' in s''.
@@ -584,60 +582,60 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
   Lemma union_1 :
    forall (s s' : t) (x : elt), In x (union s s') -> In x s \/ In x s'.
   Proof.
-    intros s s' x; unfold union in |- *; case (M.union s s'); firstorder.
+    intros s s' x; unfold union; case (M.union s s'); firstorder.
   Qed.
 
   Lemma union_2 : forall (s s' : t) (x : elt), In x s -> In x (union s s').
   Proof.
-    intros s s' x; unfold union in |- *; case (M.union s s'); firstorder.
+    intros s s' x; unfold union; case (M.union s s'); firstorder.
   Qed.
 
   Lemma union_3 : forall (s s' : t) (x : elt), In x s' -> In x (union s s').
   Proof.
-    intros s s' x; unfold union in |- *; case (M.union s s'); firstorder.
+    intros s s' x; unfold union; case (M.union s s'); firstorder.
   Qed.
 
   Definition inter (s s' : t) : t := let (s'', _) := inter s s' in s''.
 
   Lemma inter_1 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s.
   Proof.
-    intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder.
+    intros s s' x; unfold inter; case (M.inter s s'); firstorder.
   Qed.
 
   Lemma inter_2 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s'.
   Proof.
-    intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder.
+    intros s s' x; unfold inter; case (M.inter s s'); firstorder.
   Qed.
 
   Lemma inter_3 :
    forall (s s' : t) (x : elt), In x s -> In x s' -> In x (inter s s').
   Proof.
-    intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder.
+    intros s s' x; unfold inter; case (M.inter s s'); firstorder.
   Qed.
 
   Definition diff (s s' : t) : t := let (s'', _) := diff s s' in s''.
 
   Lemma diff_1 : forall (s s' : t) (x : elt), In x (diff s s') -> In x s.
   Proof.
-    intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder.
+    intros s s' x; unfold diff; case (M.diff s s'); firstorder.
   Qed.
 
   Lemma diff_2 : forall (s s' : t) (x : elt), In x (diff s s') -> ~ In x s'.
   Proof.
-    intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder.
+    intros s s' x; unfold diff; case (M.diff s s'); firstorder.
   Qed.
 
   Lemma diff_3 :
    forall (s s' : t) (x : elt), In x s -> ~ In x s' -> In x (diff s s').
   Proof.
-    intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder.
+    intros s s' x; unfold diff; case (M.diff s s'); firstorder.
   Qed.
 
   Definition cardinal (s : t) : nat := let (f, _) := cardinal s in f.
 
   Lemma cardinal_1 : forall s, cardinal s = length (elements s).
   Proof.
-    intros; unfold cardinal in |- *; case (M.cardinal s); unfold elements in *;
+    intros; unfold cardinal; case (M.cardinal s); unfold elements in *;
     destruct (M.elements s); auto.
   Qed.
 
@@ -648,7 +646,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    forall (s : t) (A : Type) (i : A) (f : elt -> A -> A),
    fold f s i = fold_left (fun a e => f e a) (elements s) i.
   Proof.
-    intros; unfold fold in |- *; case (M.fold f s i); unfold elements in *;
+    intros; unfold fold; case (M.fold f s i); unfold elements in *;
     destruct (M.elements s); auto.
   Qed.
 
@@ -675,7 +673,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    forall (s : t) (x : elt) (f : elt -> bool),
    compat_bool E.eq f -> In x (filter f s) -> In x s.
   Proof.
-    intros s x f; unfold filter in |- *; case M.filter; intuition.
+    intros s x f; unfold filter; case M.filter; intuition.
     generalize (i (compat_P_aux H)); firstorder.
   Qed.
 
@@ -683,7 +681,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    forall (s : t) (x : elt) (f : elt -> bool),
    compat_bool E.eq f -> In x (filter f s) -> f x = true.
   Proof.
-    intros s x f; unfold filter in |- *; case M.filter; intuition.
+    intros s x f; unfold filter; case M.filter; intuition.
     generalize (i (compat_P_aux H)); firstorder.
   Qed.
 
@@ -691,7 +689,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    forall (s : t) (x : elt) (f : elt -> bool),
    compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s).
   Proof.
-    intros s x f; unfold filter in |- *; case M.filter; intuition.
+    intros s x f; unfold filter; case M.filter; intuition.
     generalize (i (compat_P_aux H)); firstorder.
   Qed.
 
@@ -705,7 +703,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    compat_bool E.eq f ->
    For_all (fun x => f x = true) s -> for_all f s = true.
   Proof.
-    intros s f; unfold for_all in |- *; case M.for_all; intuition; elim n;
+    intros s f; unfold for_all; case M.for_all; intuition; elim n;
      auto.
   Qed.
 
@@ -714,7 +712,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    compat_bool E.eq f ->
    for_all f s = true -> For_all (fun x => f x = true) s.
   Proof.
-    intros s f; unfold for_all in |- *; case M.for_all; intuition;
+    intros s f; unfold for_all; case M.for_all; intuition;
      inversion H0.
   Qed.
 
@@ -727,7 +725,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    forall (s : t) (f : elt -> bool),
    compat_bool E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true.
   Proof.
-    intros s f; unfold exists_ in |- *; case M.exists_; intuition; elim n;
+    intros s f; unfold exists_; case M.exists_; intuition; elim n;
      auto.
   Qed.
 
@@ -735,7 +733,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    forall (s : t) (f : elt -> bool),
    compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s.
   Proof.
-    intros s f; unfold exists_ in |- *; case M.exists_; intuition;
+    intros s f; unfold exists_; case M.exists_; intuition;
      inversion H0.
   Qed.
 
@@ -747,10 +745,10 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    forall (s : t) (f : elt -> bool),
    compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s).
   Proof.
-    intros s f; unfold partition in |- *; case M.partition.
+    intros s f; unfold partition; case M.partition.
     intro p; case p; clear p; intros s1 s2 H C.
     generalize (H (compat_P_aux C)); clear H; intro H.
-    simpl in |- *; unfold Equal in |- *; intuition.
+    simpl; unfold Equal; intuition.
     apply filter_3; firstorder.
     elim (H2 a); intros.
     assert (In a s).
@@ -765,13 +763,13 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
    forall (s : t) (f : elt -> bool),
    compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s).
   Proof.
-    intros s f; unfold partition in |- *; case M.partition.
+    intros s f; unfold partition; case M.partition.
     intro p; case p; clear p; intros s1 s2 H C.
     generalize (H (compat_P_aux C)); clear H; intro H.
     assert (D : compat_bool E.eq (fun x => negb (f x))).
     generalize C; unfold compat_bool, Proper, respectful; intros; apply (f_equal negb);
      auto.
-    simpl in |- *; unfold Equal in |- *; intuition.
+    simpl; unfold Equal; intuition.
     apply filter_3; firstorder.
     elim (H2 a); intros.
     assert (In a s).
diff --git a/theories/FSets/FSetCompat.v b/theories/FSets/FSetCompat.v
index c3d614ee..6b3d86d3 100644
--- a/theories/FSets/FSetCompat.v
+++ b/theories/FSets/FSetCompat.v
@@ -264,7 +264,7 @@ Module Update_WSets
  Instance In_compat : Proper (E.eq==>Logic.eq==>iff) In.
  Proof. intros x x' Hx s s' Hs. subst. apply MF.In_eq_iff; auto. Qed.
 
- Instance eq_equiv : Equivalence eq.
+ Instance eq_equiv : Equivalence eq := _.
 
  Section Spec.
   Variable s s': t.
diff --git a/theories/FSets/FSetDecide.v b/theories/FSets/FSetDecide.v
index 7c321779..f64df9fe 100644
--- a/theories/FSets/FSetDecide.v
+++ b/theories/FSets/FSetDecide.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetDecide.v 14527 2011-10-07 14:33:38Z letouzey $ *)
-
 (**************************************************************)
 (* FSetDecide.v                                               *)
 (*                                                            *)
diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v
index ac55aef5..ac495c04 100644
--- a/theories/FSets/FSetEqProperties.v
+++ b/theories/FSets/FSetEqProperties.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetEqProperties.v 12400 2009-10-19 13:14:18Z letouzey $ *)
-
 (** * Finite sets library *)
 
 (** This module proves many properties of finite sets that
@@ -208,7 +206,7 @@ intros.
 generalize (@choose_1 s) (@choose_2 s).
 destruct (choose s);intros.
 exists e;auto with set.
-generalize (H1 (refl_equal None)); clear H1.
+generalize (H1 Logic.eq_refl); clear H1.
 intros; rewrite (is_empty_1 H1) in H; discriminate.
 Qed.
 
@@ -633,7 +631,7 @@ destruct (choose (filter f s)).
 intros H0 _; apply exists_1; auto.
 exists e; generalize (H0 e); rewrite filter_iff; auto.
 intros _ H0.
-rewrite (is_empty_1 (H0 (refl_equal None))) in H; auto; discriminate.
+rewrite (is_empty_1 (H0 Logic.eq_refl)) in H; auto; discriminate.
 Qed.
 
 Lemma partition_filter_1:
@@ -883,8 +881,8 @@ generalize (@add_filter_1 f Hf s0 (add x s0) x) (@add_filter_2 f Hf s0 (add x s0
 assert (~ In x (filter f s0)).
  intro H1; rewrite (mem_1 (filter_1 Hf H1)) in H; discriminate H.
 case (f x); simpl; intros.
-rewrite (MP.cardinal_2 H1 (H2 (refl_equal true) (MP.Add_add s0 x))); auto.
-rewrite <- (MP.Equal_cardinal (H3 (refl_equal false) (MP.Add_add s0 x))); auto.
+rewrite (MP.cardinal_2 H1 (H2 Logic.eq_refl (MP.Add_add s0 x))); auto.
+rewrite <- (MP.Equal_cardinal (H3 Logic.eq_refl (MP.Add_add s0 x))); auto.
 intros; rewrite fold_empty;auto.
 rewrite MP.cardinal_1; auto.
 unfold Empty; intros.
diff --git a/theories/FSets/FSetFacts.v b/theories/FSets/FSetFacts.v
index 45b43d83..b240ede4 100644
--- a/theories/FSets/FSetFacts.v
+++ b/theories/FSets/FSetFacts.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetFacts.v 12461 2009-11-03 08:24:06Z letouzey $ *)
-
 (** * Finite sets library *)
 
 (** This functor derives additional facts from [FSetInterface.S]. These
@@ -317,11 +315,11 @@ symmetry.
 rewrite <- H1; intros a Ha.
 rewrite <- (H a) in Ha.
 destruct H0 as (_,H0).
-exact (H0 (refl_equal true) _ Ha).
+exact (H0 Logic.eq_refl _ Ha).
 rewrite <- H0; intros a Ha.
 rewrite (H a) in Ha.
 destruct H1 as (_,H1).
-exact (H1 (refl_equal true) _ Ha).
+exact (H1 Logic.eq_refl _ Ha).
 Qed.
 
 Instance Empty_m : Proper (Equal ==> iff) Empty.
@@ -491,5 +489,3 @@ End WFacts_fun.
 
 Module WFacts (M:WS) := WFacts_fun M.E M.
 Module Facts := WFacts.
-
-
diff --git a/theories/FSets/FSetInterface.v b/theories/FSets/FSetInterface.v
index f366ed3e..a0361119 100644
--- a/theories/FSets/FSetInterface.v
+++ b/theories/FSets/FSetInterface.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetInterface.v 12640 2010-01-07 15:32:49Z letouzey $ *)
-
 (** * Finite set library *)
 
 (** Set interfaces, inspired by the one of Ocaml. When compared with
@@ -253,6 +251,7 @@ Module Type WSfun (E : DecidableType).
 
   End Spec.
 
+  Hint Transparent elt.
   Hint Resolve mem_1 equal_1 subset_1 empty_1
     is_empty_1 choose_1 choose_2 add_1 add_2 remove_1
     remove_2 singleton_2 union_1 union_2 union_3
diff --git a/theories/FSets/FSetList.v b/theories/FSets/FSetList.v
index 9408ba05..1f36306c 100644
--- a/theories/FSets/FSetList.v
+++ b/theories/FSets/FSetList.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetList.v 12641 2010-01-07 15:32:52Z letouzey $ *)
-
 (** * Finite sets library *)
 
 (** This file proposes an implementation of the non-dependant
diff --git a/theories/FSets/FSetProperties.v b/theories/FSets/FSetProperties.v
index 59e19cd3..d53ce0c8 100644
--- a/theories/FSets/FSetProperties.v
+++ b/theories/FSets/FSetProperties.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetProperties.v 12400 2009-10-19 13:14:18Z letouzey $ *)
-
 (** * Finite sets library *)
 
 (** This functor derives additional properties from [FSetInterface.S].
@@ -337,6 +335,14 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E).
 
   Section Fold.
 
+  (** Alternative specification via [fold_right] *)
+
+  Lemma fold_spec_right (s:t)(A:Type)(i:A)(f : elt -> A -> A) :
+    fold f s i = List.fold_right f i (rev (elements s)).
+  Proof.
+   rewrite fold_1. symmetry. apply fold_left_rev_right.
+  Qed.
+
   Notation NoDup := (NoDupA E.eq).
   Notation InA := (InA E.eq).
 
@@ -353,8 +359,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E).
      P s (fold f s i).
   Proof.
   intros A P f i s Pempty Pstep.
-  rewrite fold_1, <- fold_left_rev_right.
-  set (l:=rev (elements s)).
+  rewrite fold_spec_right. set (l:=rev (elements s)).
   assert (Pstep' : forall x a s' s'', InA x l -> ~In x s' -> Add x s' s'' ->
            P s' a -> P s'' (f x a)).
    intros; eapply Pstep; eauto.
@@ -426,8 +431,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E).
      R (fold f s i) (fold g s j).
   Proof.
   intros A B R f g i j s Rempty Rstep.
-  do 2 rewrite fold_1, <- fold_left_rev_right.
-  set (l:=rev (elements s)).
+  rewrite 2 fold_spec_right. set (l:=rev (elements s)).
   assert (Rstep' : forall x a b, InA x l -> R a b -> R (f x a) (g x b)) by
     (intros; apply Rstep; auto; rewrite elements_iff, <- InA_rev; auto with *).
   clearbody l; clear Rstep s.
@@ -485,8 +489,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E).
   split; intros.
   rewrite elements_iff; do 2 rewrite InA_alt.
   split; destruct 1; generalize (In_rev (elements s) x0); exists x0; intuition.
-  rewrite fold_left_rev_right.
-  apply fold_1.
+  apply fold_spec_right.
   Qed.
 
   (** An alternate (and previous) specification for [fold] was based on
@@ -820,7 +823,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E).
   rewrite (inter_subset_equal H).
   generalize (@cardinal_inv_1 (diff s' s)).
   destruct (cardinal (diff s' s)).
-  intro H2; destruct (H2 (refl_equal _) x).
+  intro H2; destruct (H2 Logic.eq_refl x).
   set_iff; auto.
   intros _.
   change (0 + cardinal s < S n + cardinal s).
@@ -1088,8 +1091,7 @@ Module OrdProperties (M:S).
    Above x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)).
   Proof.
   intros.
-  do 2 rewrite M.fold_1.
-  do 2 rewrite <- fold_left_rev_right.
+  rewrite 2 fold_spec_right.
   change (f x (fold_right f i (rev (elements s)))) with
     (fold_right f i (rev (x::nil)++rev (elements s))).
   apply (@fold_right_eqlistA E.t E.eq A eqA st); auto.
@@ -1105,11 +1107,11 @@ Module OrdProperties (M:S).
    Below x s -> Add x s s' -> eqA (fold f s' i) (fold f s (f x i)).
   Proof.
   intros.
-  do 2 rewrite M.fold_1.
+  rewrite 2 M.fold_1.
   set (g:=fun (a : A) (e : elt) => f e a).
   change (eqA (fold_left g (elements s') i) (fold_left g (x::elements s) i)).
   unfold g.
-  do 2 rewrite <- fold_left_rev_right.
+  rewrite <- 2 fold_left_rev_right.
   apply (@fold_right_eqlistA E.t E.eq A eqA st); auto.
   apply eqlistA_rev.
   apply elements_Add_Below; auto.
@@ -1126,8 +1128,7 @@ Module OrdProperties (M:S).
   Lemma fold_equal :
    forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i).
   Proof.
-  intros; do 2 rewrite M.fold_1.
-  do 2 rewrite <- fold_left_rev_right.
+  intros. rewrite 2 fold_spec_right.
   apply (@fold_right_eqlistA E.t E.eq A eqA st); auto.
   apply eqlistA_rev.
   apply sort_equivlistA_eqlistA; auto with set.
diff --git a/theories/FSets/FSetToFiniteSet.v b/theories/FSets/FSetToFiniteSet.v
index 2aa1b433..3ac5d9e4 100644
--- a/theories/FSets/FSetToFiniteSet.v
+++ b/theories/FSets/FSetToFiniteSet.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetToFiniteSet.v 12363 2009-09-28 15:04:07Z letouzey $ *)
-
 (** * Finite sets library : conversion to old [Finite_sets] *)
 
 Require Import Ensembles Finite_sets.
diff --git a/theories/FSets/FSetWeakList.v b/theories/FSets/FSetWeakList.v
index b55db37a..2ea32e97 100644
--- a/theories/FSets/FSetWeakList.v
+++ b/theories/FSets/FSetWeakList.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetWeakList.v 12641 2010-01-07 15:32:52Z letouzey $ *)
-
 (** * Finite sets library *)
 
 (** This file proposes an implementation of the non-dependant
diff --git a/theories/FSets/FSets.v b/theories/FSets/FSets.v
index a725c1eb..572f2865 100644
--- a/theories/FSets/FSets.v
+++ b/theories/FSets/FSets.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSets.v 13297 2010-07-19 23:32:42Z letouzey $ *)
-
 Require Export OrderedType.
 Require Export OrderedTypeEx.
 Require Export OrderedTypeAlt.
diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v
index deadec43..fc620f71 100644
--- a/theories/Init/Datatypes.v
+++ b/theories/Init/Datatypes.v
@@ -1,25 +1,33 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Datatypes.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import Notations.
 Require Import Logic.
 Declare ML Module "nat_syntax_plugin".
 
+(********************************************************************)
+(** * Datatypes with zero and one element *)
+
+(** [Empty_set] is a datatype with no inhabitant *)
+
+Inductive Empty_set : Set :=.
 
 (** [unit] is a singleton datatype with sole inhabitant [tt] *)
 
 Inductive unit : Set :=
     tt : unit.
 
+
+(********************************************************************)
+(** * The boolean datatype *)
+
 (** [bool] is the datatype of the boolean values [true] and [false] *)
 
 Inductive bool : Set :=
@@ -53,9 +61,7 @@ Definition negb (b:bool) := if b then false else true.
 Infix "||" := orb : bool_scope.
 Infix "&&" := andb : bool_scope.
 
-(*******************************)
-(** * Properties of [andb]     *)
-(*******************************)
+(** Basic properties of [andb] *)
 
 Lemma andb_prop : forall a b:bool, andb a b = true -> a = true /\ b = true.
 Proof.
@@ -66,7 +72,7 @@ Hint Resolve andb_prop: bool.
 Lemma andb_true_intro :
   forall b1 b2:bool, b1 = true /\ b2 = true -> andb b1 b2 = true.
 Proof.
-  destruct b1; destruct b2; simpl in |- *; tauto || auto with bool.
+  destruct b1; destruct b2; simpl; intros [? ?]; assumption.
 Qed.
 Hint Resolve andb_true_intro: bool.
 
@@ -104,6 +110,22 @@ Proof.
   intros P b H H0; destruct H0 in H; assumption.
 Defined.
 
+(** The [BoolSpec] inductive will be used to relate a [boolean] value
+    and two propositions corresponding respectively to the [true]
+    case and the [false] case.
+    Interest: [BoolSpec] behave nicely with [case] and [destruct].
+    See also [Bool.reflect] when [Q = ~P].
+*)
+
+Inductive BoolSpec (P Q : Prop) : bool -> Prop :=
+  | BoolSpecT : P -> BoolSpec P Q true
+  | BoolSpecF : Q -> BoolSpec P Q false.
+Hint Constructors BoolSpec.
+
+
+(********************************************************************)
+(** * Peano natural numbers *)
+
 (** [nat] is the datatype of natural numbers built from [O] and successor [S];
     note that the constructor name is the letter O.
     Numbers in [nat] can be denoted using a decimal notation;
@@ -115,23 +137,11 @@ Inductive nat : Set :=
 
 Delimit Scope nat_scope with nat.
 Bind Scope nat_scope with nat.
-Arguments Scope S [nat_scope].
+Arguments S _%nat.
 
-(** [Empty_set] has no inhabitant *)
 
-Inductive Empty_set : Set :=.
-
-(** [identity A a] is the family of datatypes on [A] whose sole non-empty
-    member is the singleton datatype [identity A a a] whose
-    sole inhabitant is denoted [refl_identity A a] *)
-
-Inductive identity (A:Type) (a:A) : A -> Type :=
-  identity_refl : identity a a.
-Hint Resolve identity_refl: core.
-
-Implicit Arguments identity_ind [A].
-Implicit Arguments identity_rec [A].
-Implicit Arguments identity_rect [A].
+(********************************************************************)
+(** * Container datatypes *)
 
 (** [option A] is the extension of [A] with an extra element [None] *)
 
@@ -139,7 +149,7 @@ Inductive option (A:Type) : Type :=
   | Some : A -> option A
   | None : option A.
 
-Implicit Arguments None [A].
+Arguments None [A].
 
 Definition option_map (A B:Type) (f:A->B) o :=
   match o with
@@ -155,6 +165,9 @@ Inductive sum (A B:Type) : Type :=
 
 Notation "x + y" := (sum x y) : type_scope.
 
+Arguments inl {A B} _ , [A] B _.
+Arguments inr {A B} _ , A [B] _.
+
 (** [prod A B], written [A * B], is the product of [A] and [B];
     the pair [pair A B a b] of [a] and [b] is abbreviated [(a,b)] *)
 
@@ -166,6 +179,8 @@ Add Printing Let prod.
 Notation "x * y" := (prod x y) : type_scope.
 Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope.
 
+Arguments pair {A B} _ _.
+
 Section projections.
   Variables A B : Type.
   Definition fst (p:A * B) := match p with
@@ -188,7 +203,7 @@ Lemma injective_projections :
   forall (A B:Type) (p1 p2:A * B),
     fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2.
 Proof.
-  destruct p1; destruct p2; simpl in |- *; intros Hfst Hsnd.
+  destruct p1; destruct p2; simpl; intros Hfst Hsnd.
   rewrite Hfst; rewrite Hsnd; reflexivity.
 Qed.
 
@@ -200,7 +215,40 @@ Definition prod_curry (A B C:Type) (f:A -> B -> C)
                        | pair x y => f x y
                        end.
 
-(** Comparison *)
+(** Polymorphic lists and some operations *)
+
+Inductive list (A : Type) : Type :=
+ | nil : list A
+ | cons : A -> list A -> list A.
+
+Arguments nil [A].
+Infix "::" := cons (at level 60, right associativity) : list_scope.
+Delimit Scope list_scope with list.
+Bind Scope list_scope with list.
+
+Local Open Scope list_scope.
+
+Definition length (A : Type) : list A -> nat :=
+  fix length l :=
+  match l with
+   | nil => O
+   | _ :: l' => S (length l')
+  end.
+
+(** Concatenation of two lists *)
+
+Definition app (A : Type) : list A -> list A -> list A :=
+  fix app l m :=
+  match l with
+   | nil => m
+   | a :: l1 => a :: app l1 m
+  end.
+
+Infix "++" := app (right associativity, at level 60) : list_scope.
+
+
+(********************************************************************)
+(** * The comparison datatype *)
 
 Inductive comparison : Set :=
   | Eq : comparison
@@ -229,81 +277,81 @@ Proof.
   split; intros; apply CompOpp_inj; rewrite CompOpp_involutive; auto.
 Qed.
 
-(** The [CompSpec] inductive will be used to relate a [compare] function
-    (returning a comparison answer) and some equality and order predicates.
-    Interest: [CompSpec] behave nicely with [case] and [destruct]. *)
+(** The [CompareSpec] inductive relates a [comparison] value with three
+   propositions, one for each possible case. Typically, it can be used to
+   specify a comparison function via some equality and order predicates.
+   Interest: [CompareSpec] behave nicely with [case] and [destruct]. *)
 
-Inductive CompSpec {A} (eq lt : A->A->Prop)(x y:A) : comparison -> Prop :=
- | CompEq : eq x y -> CompSpec eq lt x y Eq
- | CompLt : lt x y -> CompSpec eq lt x y Lt
- | CompGt : lt y x -> CompSpec eq lt x y Gt.
-Hint Constructors CompSpec.
+Inductive CompareSpec (Peq Plt Pgt : Prop) : comparison -> Prop :=
+ | CompEq : Peq -> CompareSpec Peq Plt Pgt Eq
+ | CompLt : Plt -> CompareSpec Peq Plt Pgt Lt
+ | CompGt : Pgt -> CompareSpec Peq Plt Pgt Gt.
+Hint Constructors CompareSpec.
 
-(** For having clean interfaces after extraction, [CompSpec] is declared
+(** For having clean interfaces after extraction, [CompareSpec] is declared
     in Prop. For some situations, it is nonetheless useful to have a
-    version in Type. Interestingly, these two versions are equivalent.
-*)
+    version in Type. Interestingly, these two versions are equivalent. *)
 
-Inductive CompSpecT {A} (eq lt : A->A->Prop)(x y:A) : comparison -> Type :=
- | CompEqT : eq x y -> CompSpecT eq lt x y Eq
- | CompLtT : lt x y -> CompSpecT eq lt x y Lt
- | CompGtT : lt y x -> CompSpecT eq lt x y Gt.
-Hint Constructors CompSpecT.
+Inductive CompareSpecT (Peq Plt Pgt : Prop) : comparison -> Type :=
+ | CompEqT : Peq -> CompareSpecT Peq Plt Pgt Eq
+ | CompLtT : Plt -> CompareSpecT Peq Plt Pgt Lt
+ | CompGtT : Pgt -> CompareSpecT Peq Plt Pgt Gt.
+Hint Constructors CompareSpecT.
 
-Lemma CompSpec2Type : forall A (eq lt:A->A->Prop) x y c,
- CompSpec eq lt x y c -> CompSpecT eq lt x y c.
+Lemma CompareSpec2Type : forall Peq Plt Pgt c,
+ CompareSpec Peq Plt Pgt c -> CompareSpecT Peq Plt Pgt c.
 Proof.
  destruct c; intros H; constructor; inversion_clear H; auto.
 Defined.
 
-(** Identity *)
+(** As an alternate formulation, one may also directly refer to predicates
+ [eq] and [lt] for specifying a comparison, rather that fully-applied
+ propositions. This [CompSpec] is now a particular case of [CompareSpec]. *)
 
-Definition ID := forall A:Type, A -> A.
-Definition id : ID := fun A x => x.
+Definition CompSpec {A} (eq lt : A->A->Prop)(x y:A) : comparison -> Prop :=
+ CompareSpec (eq x y) (lt x y) (lt y x).
+Definition CompSpecT {A} (eq lt : A->A->Prop)(x y:A) : comparison -> Type :=
+ CompareSpecT (eq x y) (lt x y) (lt y x).
+Hint Unfold CompSpec CompSpecT.
 
-(** Polymorphic lists and some operations *)
+Lemma CompSpec2Type : forall A (eq lt:A->A->Prop) x y c,
+ CompSpec eq lt x y c -> CompSpecT eq lt x y c.
+Proof. intros. apply CompareSpec2Type; assumption. Defined.
 
-Inductive list (A : Type) : Type :=
- | nil : list A
- | cons : A -> list A -> list A.
 
-Implicit Arguments nil [A].
-Infix "::" := cons (at level 60, right associativity) : list_scope.
-Delimit Scope list_scope with list.
-Bind Scope list_scope with list.
+(******************************************************************)
+(** * Misc Other Datatypes *)
 
-Local Open Scope list_scope.
+(** [identity A a] is the family of datatypes on [A] whose sole non-empty
+    member is the singleton datatype [identity A a a] whose
+    sole inhabitant is denoted [refl_identity A a] *)
 
-Definition length (A : Type) : list A -> nat :=
-  fix length l :=
-  match l with
-   | nil => O
-   | _ :: l' => S (length l')
-  end.
+Inductive identity (A:Type) (a:A) : A -> Type :=
+  identity_refl : identity a a.
+Hint Resolve identity_refl: core.
 
-(** Concatenation of two lists *)
+Arguments identity_ind [A] a P f y i.
+Arguments identity_rec [A] a P f y i.
+Arguments identity_rect [A] a P f y i.
 
-Definition app (A : Type) : list A -> list A -> list A :=
-  fix app l m :=
-  match l with
-   | nil => m
-   | a :: l1 => a :: app l1 m
-  end.
+(** Identity type *)
+
+Definition ID := forall A:Type, A -> A.
+Definition id : ID := fun A x => x.
 
-Infix "++" := app (right associativity, at level 60) : list_scope.
 
 (* begin hide *)
 
 (* Compatibility *)
 
-Notation prodT := prod (only parsing).
-Notation pairT := pair (only parsing).
-Notation prodT_rect := prod_rect (only parsing).
-Notation prodT_rec := prod_rec (only parsing).
-Notation prodT_ind := prod_ind (only parsing).
-Notation fstT := fst (only parsing).
-Notation sndT := snd (only parsing).
-Notation prodT_uncurry := prod_uncurry (only parsing).
-Notation prodT_curry := prod_curry (only parsing).
+Notation prodT := prod (compat "8.2").
+Notation pairT := pair (compat "8.2").
+Notation prodT_rect := prod_rect (compat "8.2").
+Notation prodT_rec := prod_rec (compat "8.2").
+Notation prodT_ind := prod_ind (compat "8.2").
+Notation fstT := fst (compat "8.2").
+Notation sndT := snd (compat "8.2").
+Notation prodT_uncurry := prod_uncurry (compat "8.2").
+Notation prodT_curry := prod_curry (compat "8.2").
 
 (* end hide *)
diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v
index b95d78a4..4e6df444 100644
--- a/theories/Init/Logic.v
+++ b/theories/Init/Logic.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Logic.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import Notations.
@@ -64,6 +62,9 @@ Inductive or (A B:Prop) : Prop :=
 
 where "A \/ B" := (or A B) : type_scope.
 
+Arguments or_introl [A B] _, [A] B _.
+Arguments or_intror [A B] _, A [B] _.
+
 (** [iff A B], written [A <-> B], expresses the equivalence of [A] and [B] *)
 
 Definition iff (A B:Prop) := (A -> B) /\ (B -> A).
@@ -95,53 +96,53 @@ Hint Unfold iff: extcore.
 
 Theorem neg_false : forall A : Prop, ~ A <-> (A <-> False).
 Proof.
-intro A; unfold not; split.
-intro H; split; [exact H | intro H1; elim H1].
-intros [H _]; exact H.
+  intro A; unfold not; split.
+  - intro H; split; [exact H | intro H1; elim H1].
+  - intros [H _]; exact H.
 Qed.
 
 Theorem and_cancel_l : forall A B C : Prop,
   (B -> A) -> (C -> A) -> ((A /\ B <-> A /\ C) <-> (B <-> C)).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem and_cancel_r : forall A B C : Prop,
   (B -> A) -> (C -> A) -> ((B /\ A <-> C /\ A) <-> (B <-> C)).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem and_comm : forall A B : Prop, A /\ B <-> B /\ A.
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem and_assoc : forall A B C : Prop, (A /\ B) /\ C <-> A /\ B /\ C.
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem or_cancel_l : forall A B C : Prop,
   (B -> ~ A) -> (C -> ~ A) -> ((A \/ B <-> A \/ C) <-> (B <-> C)).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem or_cancel_r : forall A B C : Prop,
   (B -> ~ A) -> (C -> ~ A) -> ((B \/ A <-> C \/ A) <-> (B <-> C)).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem or_comm : forall A B : Prop, (A \/ B) <-> (B \/ A).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem or_assoc : forall A B C : Prop, (A \/ B) \/ C <-> A \/ B \/ C.
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 (** Backward direction of the equivalences above does not need assumptions *)
@@ -149,35 +150,35 @@ Qed.
 Theorem and_iff_compat_l : forall A B C : Prop,
   (B <-> C) -> (A /\ B <-> A /\ C).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem and_iff_compat_r : forall A B C : Prop,
   (B <-> C) -> (B /\ A <-> C /\ A).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem or_iff_compat_l : forall A B C : Prop,
   (B <-> C) -> (A \/ B <-> A \/ C).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Theorem or_iff_compat_r : forall A B C : Prop,
   (B <-> C) -> (B \/ A <-> C \/ A).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Lemma iff_and : forall A B : Prop, (A <-> B) -> (A -> B) /\ (B -> A).
 Proof.
-intros A B []; split; trivial.
+  intros A B []; split; trivial.
 Qed.
 
 Lemma iff_to_and : forall A B : Prop, (A <-> B) <-> (A -> B) /\ (B -> A).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 (** [(IF_then_else P Q R)], written [IF P then Q else R] denotes
@@ -218,11 +219,9 @@ Definition all (A:Type) (P:A -> Prop) := forall x:A, P x.
 
 (* Rule order is important to give printing priority to fully typed exists *)
 
-Notation "'exists' x , p" := (ex (fun x => p))
-  (at level 200, x ident, right associativity) : type_scope.
-Notation "'exists' x : t , p" := (ex (fun x:t => p))
-  (at level 200, x ident, right associativity,
-    format "'[' 'exists'  '/  ' x  :  t ,  '/  ' p ']'")
+Notation "'exists' x .. y , p" := (ex (fun x => .. (ex (fun y => p)) ..))
+  (at level 200, x binder, right associativity,
+   format "'[' 'exists'  '/  ' x  ..  y ,  '/  ' p ']'")
   : type_scope.
 
 Notation "'exists2' x , p & q" := (ex2 (fun x => p) (fun x => q))
@@ -241,12 +240,12 @@ Section universal_quantification.
 
   Theorem inst : forall x:A, all (fun x => P x) -> P x.
   Proof.
-    unfold all in |- *; auto.
+    unfold all; auto.
   Qed.
 
   Theorem gen : forall (B:Prop) (f:forall y:A, B -> P y), B -> all P.
   Proof.
-    red in |- *; auto.
+    red; auto.
   Qed.
 
 End universal_quantification.
@@ -271,11 +270,12 @@ Notation "x = y" := (x = y :>_) : type_scope.
 Notation "x <> y  :> T" := (~ x = y :>T) : type_scope.
 Notation "x <> y" := (x <> y :>_) : type_scope.
 
-Implicit Arguments eq [ [A] ].
+Arguments eq {A} x _.
+Arguments eq_refl {A x} , [A] x.
 
-Implicit Arguments eq_ind [A].
-Implicit Arguments eq_rec [A].
-Implicit Arguments eq_rect [A].
+Arguments eq_ind [A] x P _ y _.
+Arguments eq_rec [A] x P _ y _.
+Arguments eq_rect [A] x P _ y _.
 
 Hint Resolve I conj or_introl or_intror eq_refl: core.
 Hint Resolve ex_intro ex_intro2: core.
@@ -284,7 +284,7 @@ Section Logic_lemmas.
 
   Theorem absurd : forall A C:Prop, A -> ~ A -> C.
   Proof.
-    unfold not in |- *; intros A C h1 h2.
+    unfold not; intros A C h1 h2.
     destruct (h2 h1).
   Qed.
 
@@ -313,7 +313,7 @@ Section Logic_lemmas.
 
     Theorem not_eq_sym : x <> y -> y <> x.
     Proof.
-      red in |- *; intros h1 h2; apply h1; destruct h2; trivial.
+      red; intros h1 h2; apply h1; destruct h2; trivial.
     Qed.
 
   End equality.
@@ -334,6 +334,15 @@ Section Logic_lemmas.
   Defined.
 End Logic_lemmas.
 
+Module EqNotations.
+  Notation "'rew' H 'in' H'" := (eq_rect _ _ H' _ H)
+    (at level 10, H' at level 10).
+  Notation "'rew' <- H 'in' H'" := (eq_rect_r _ H' H)
+    (at level 10, H' at level 10).
+  Notation "'rew' -> H 'in' H'" := (eq_rect _ _ H' _ H)
+    (at level 10, H' at level 10, only parsing).
+End EqNotations.
+
 Theorem f_equal2 :
   forall (A1 A2 B:Type) (f:A1 -> A2 -> B) (x1 y1:A1)
     (x2 y2:A2), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2.
@@ -369,14 +378,14 @@ Qed.
 
 (* Aliases *)
 
-Notation sym_eq := eq_sym (only parsing).
-Notation trans_eq := eq_trans (only parsing).
-Notation sym_not_eq := not_eq_sym (only parsing).
+Notation sym_eq := eq_sym (compat "8.3").
+Notation trans_eq := eq_trans (compat "8.3").
+Notation sym_not_eq := not_eq_sym (compat "8.3").
 
-Notation refl_equal := eq_refl (only parsing).
-Notation sym_equal := eq_sym (only parsing).
-Notation trans_equal := eq_trans (only parsing).
-Notation sym_not_equal := not_eq_sym (only parsing).
+Notation refl_equal := eq_refl (compat "8.3").
+Notation sym_equal := eq_sym (compat "8.3").
+Notation trans_equal := eq_trans (compat "8.3").
+Notation sym_not_equal := not_eq_sym (compat "8.3").
 
 Hint Immediate eq_sym not_eq_sym: core.
 
@@ -392,26 +401,47 @@ Definition uniqueness (A:Type) (P:A->Prop) := forall x y, P x -> P y -> x = y.
 
 (** Unique existence *)
 
-Notation "'exists' ! x , P" := (ex (unique (fun x => P)))
-  (at level 200, x ident, right associativity,
-    format "'[' 'exists' !  '/  ' x ,  '/  ' P ']'") : type_scope.
-Notation "'exists' ! x : A , P" :=
-  (ex (unique (fun x:A => P)))
-  (at level 200, x ident, right associativity,
-    format "'[' 'exists' !  '/  ' x  :  A ,  '/  ' P ']'") : type_scope.
+Notation "'exists' ! x .. y , p" :=
+  (ex (unique (fun x => .. (ex (unique (fun y => p))) ..)))
+  (at level 200, x binder, right associativity,
+   format "'[' 'exists'  !  '/  ' x  ..  y ,  '/  ' p ']'")
+  : type_scope.
 
 Lemma unique_existence : forall (A:Type) (P:A->Prop),
   ((exists x, P x) /\ uniqueness P) <-> (exists! x, P x).
 Proof.
   intros A P; split.
-  intros ((x,Hx),Huni); exists x; red; auto.
-  intros (x,(Hx,Huni)); split.
-  exists x; assumption.
-  intros x' x'' Hx' Hx''; transitivity x.
-  symmetry; auto.
-  auto.
+  - intros ((x,Hx),Huni); exists x; red; auto.
+  - intros (x,(Hx,Huni)); split.
+    + exists x; assumption.
+    + intros x' x'' Hx' Hx''; transitivity x.
+      symmetry; auto.
+      auto.
 Qed.
 
+Lemma forall_exists_unique_domain_coincide :
+  forall A (P:A->Prop), (exists! x, P x) ->
+  forall Q:A->Prop, (forall x, P x -> Q x) <-> (exists x, P x /\ Q x).
+Proof.
+  intros A P (x & Hp & Huniq); split.
+  - intro; exists x; auto.
+  - intros (x0 & HPx0 & HQx0) x1 HPx1.
+    replace x1 with x0 by (transitivity x; [symmetry|]; auto).
+    assumption.
+Qed.   
+
+Lemma forall_exists_coincide_unique_domain :
+  forall A (P:A->Prop),
+  (forall Q:A->Prop, (forall x, P x -> Q x) <-> (exists x, P x /\ Q x))
+  -> (exists! x, P x).
+Proof.
+  intros A P H.
+  destruct H with (Q:=P) as ((x & Hx & _),_); [trivial|].
+  exists x. split; [trivial|].
+  destruct H with (Q:=fun x'=>x=x') as (_,Huniq).
+  apply Huniq. exists x; auto.
+Qed.       
+
 (** * Being inhabited *)
 
 (** The predicate [inhabited] can be used in different contexts. If [A] is
@@ -436,7 +466,7 @@ Qed.
 
 Lemma eq_stepl : forall (A : Type) (x y z : A), x = y -> x = z -> z = y.
 Proof.
-intros A x y z H1 H2. rewrite <- H2; exact H1.
+  intros A x y z H1 H2. rewrite <- H2; exact H1.
 Qed.
 
 Declare Left Step eq_stepl.
@@ -444,7 +474,7 @@ Declare Right Step eq_trans.
 
 Lemma iff_stepl : forall A B C : Prop, (A <-> B) -> (A <-> C) -> (C <-> B).
 Proof.
-intros; tauto.
+  intros; tauto.
 Qed.
 
 Declare Left Step iff_stepl.
diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v
index bf4031d5..0281c516 100644
--- a/theories/Init/Logic_Type.v
+++ b/theories/Init/Logic_Type.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Logic_Type.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This module defines type constructors for types in [Type]
     ([Datatypes.v] and [Logic.v] defined them for types in [Set]) *)
 
@@ -46,7 +44,7 @@ Section identity_is_a_congruence.
 
  Lemma not_identity_sym : notT (identity x y) -> notT (identity y x).
  Proof.
-  red in |- *; intros H H'; apply H; destruct H'; trivial.
+  red; intros H H'; apply H; destruct H'; trivial.
  Qed.
 
 End identity_is_a_congruence.
@@ -68,7 +66,7 @@ Defined.
 
 Hint Immediate identity_sym not_identity_sym: core v62.
 
-Notation refl_id := identity_refl (only parsing).
-Notation sym_id := identity_sym (only parsing).
-Notation trans_id := identity_trans (only parsing).
-Notation sym_not_id := not_identity_sym (only parsing).
+Notation refl_id := identity_refl (compat "8.3").
+Notation sym_id := identity_sym (compat "8.3").
+Notation trans_id := identity_trans (compat "8.3").
+Notation sym_not_id := not_identity_sym (compat "8.3").
diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v
index 3619d827..323dab90 100644
--- a/theories/Init/Notations.v
+++ b/theories/Init/Notations.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Notations.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** These are the notations whose level and associativity are imposed by Coq *)
 
 (** Notations for propositional connectives *)
diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v
index abf843bf..8c6fba50 100644
--- a/theories/Init/Peano.v
+++ b/theories/Init/Peano.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Peano.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** The type [nat] of Peano natural numbers (built from [O] and [S])
     is defined in [Datatypes.v] *)
 
@@ -28,7 +26,6 @@
 Require Import Notations.
 Require Import Datatypes.
 Require Import Logic.
-Unset Boxed Definitions.
 
 Open Scope nat_scope.
 
@@ -52,18 +49,12 @@ Qed.
 
 (** Injectivity of successor *)
 
-Theorem eq_add_S : forall n m:nat, S n = S m -> n = m.
-Proof.
-  intros n m Sn_eq_Sm.
-  replace (n=m) with (pred (S n) = pred (S m)) by auto using pred_Sn.
-  rewrite Sn_eq_Sm; trivial.
-Qed.
-
+Definition eq_add_S n m (H: S n = S m): n = m := f_equal pred H.
 Hint Immediate eq_add_S: core.
 
 Theorem not_eq_S : forall n m:nat, n <> m -> S n <> S m.
 Proof.
-  red in |- *; auto.
+  red; auto.
 Qed.
 Hint Resolve not_eq_S: core.
 
@@ -102,7 +93,7 @@ Hint Resolve (f_equal2 (A1:=nat) (A2:=nat)): core.
 
 Lemma plus_n_O : forall n:nat, n = n + 0.
 Proof.
-  induction n; simpl in |- *; auto.
+  induction n; simpl; auto.
 Qed.
 Hint Resolve plus_n_O: core.
 
@@ -113,7 +104,7 @@ Qed.
 
 Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m.
 Proof.
-  intros n m; induction n; simpl in |- *; auto.
+  intros n m; induction n; simpl; auto.
 Qed.
 Hint Resolve plus_n_Sm: core.
 
@@ -124,8 +115,8 @@ Qed.
 
 (** Standard associated names *)
 
-Notation plus_0_r_reverse := plus_n_O (only parsing).
-Notation plus_succ_r_reverse := plus_n_Sm (only parsing).
+Notation plus_0_r_reverse := plus_n_O (compat "8.2").
+Notation plus_succ_r_reverse := plus_n_Sm (compat "8.2").
 
 (** Multiplication *)
 
@@ -141,22 +132,22 @@ Hint Resolve (f_equal2 mult): core.
 
 Lemma mult_n_O : forall n:nat, 0 = n * 0.
 Proof.
-  induction n; simpl in |- *; auto.
+  induction n; simpl; auto.
 Qed.
 Hint Resolve mult_n_O: core.
 
 Lemma mult_n_Sm : forall n m:nat, n * m + n = n * S m.
 Proof.
-  intros; induction n as [| p H]; simpl in |- *; auto.
-  destruct H; rewrite <- plus_n_Sm; apply (f_equal S).
-  pattern m at 1 3 in |- *; elim m; simpl in |- *; auto.
+  intros; induction n as [| p H]; simpl; auto.
+  destruct H; rewrite <- plus_n_Sm; apply eq_S.
+  pattern m at 1 3; elim m; simpl; auto.
 Qed.
 Hint Resolve mult_n_Sm: core.
 
 (** Standard associated names *)
 
-Notation mult_0_r_reverse := mult_n_O (only parsing).
-Notation mult_succ_r_reverse := mult_n_Sm (only parsing).
+Notation mult_0_r_reverse := mult_n_O (compat "8.2").
+Notation mult_succ_r_reverse := mult_n_Sm (compat "8.2").
 
 (** Truncated subtraction: [m-n] is [0] if [n>=m] *)
 
@@ -201,6 +192,16 @@ Notation "x <= y < z" := (x <= y /\ y < z) : nat_scope.
 Notation "x < y < z" := (x < y /\ y < z) : nat_scope.
 Notation "x < y <= z" := (x < y /\ y <= z) : nat_scope.
 
+Theorem le_pred : forall n m, n <= m -> pred n <= pred m.
+Proof.
+induction 1; auto. destruct m; simpl; auto.
+Qed.
+
+Theorem le_S_n : forall n m, S n <= S m -> n <= m.
+Proof.
+intros n m. exact (le_pred (S n) (S m)).
+Qed.
+
 (** Case analysis *)
 
 Theorem nat_case :
@@ -218,5 +219,78 @@ Theorem nat_double_ind :
    (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m.
 Proof.
   induction n; auto.
-  destruct m as [| n0]; auto.
+  destruct m; auto.
+Qed.
+
+(** Maximum and minimum : definitions and specifications *)
+
+Fixpoint max n m : nat :=
+  match n, m with
+    | O, _ => m
+    | S n', O => n
+    | S n', S m' => S (max n' m')
+  end.
+
+Fixpoint min n m : nat :=
+  match n, m with
+    | O, _ => 0
+    | S n', O => 0
+    | S n', S m' => S (min n' m')
+  end.
+
+Theorem max_l : forall n m : nat, m <= n -> max n m = n.
+Proof.
+induction n; destruct m; simpl; auto. inversion 1.
+intros. apply f_equal. apply IHn. apply le_S_n. trivial.
+Qed.
+
+Theorem max_r : forall n m : nat, n <= m -> max n m = m.
+Proof.
+induction n; destruct m; simpl; auto. inversion 1.
+intros. apply f_equal. apply IHn. apply le_S_n. trivial.
+Qed.
+
+Theorem min_l : forall n m : nat, n <= m -> min n m = n.
+Proof.
+induction n; destruct m; simpl; auto. inversion 1.
+intros. apply f_equal. apply IHn. apply le_S_n. trivial.
+Qed.
+
+Theorem min_r : forall n m : nat, m <= n -> min n m = m.
+Proof.
+induction n; destruct m; simpl; auto. inversion 1.
+intros. apply f_equal. apply IHn. apply le_S_n. trivial.
+Qed.
+
+(** [n]th iteration of the function [f] *)
+
+Fixpoint nat_iter (n:nat) {A} (f:A->A) (x:A) : A :=
+  match n with
+    | O => x
+    | S n' => f (nat_iter n' f x)
+  end.
+
+Lemma nat_iter_succ_r n {A} (f:A->A) (x:A) :
+  nat_iter (S n) f x = nat_iter n f (f x).
+Proof.
+  induction n; intros; simpl; rewrite <- ?IHn; trivial.
+Qed.
+
+Theorem nat_iter_plus :
+  forall (n m:nat) {A} (f:A -> A) (x:A),
+    nat_iter (n + m) f x = nat_iter n f (nat_iter m f x).
+Proof.
+  induction n; intros; simpl; rewrite ?IHn; trivial.
+Qed.
+
+(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv],
+    then the iterates of [f] also preserve it. *)
+
+Theorem nat_iter_invariant :
+  forall (n:nat) {A} (f:A -> A) (P : A -> Prop),
+    (forall x, P x -> P (f x)) ->
+    forall x, P x -> P (nat_iter n f x).
+Proof.
+  induction n; simpl; trivial.
+  intros A f P Hf x Hx. apply Hf, IHn; trivial.
 Qed.
diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v
index 5fcb2671..e723cadf 100644
--- a/theories/Init/Prelude.v
+++ b/theories/Init/Prelude.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Prelude.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Notations.
 Require Export Logic.
 Require Export Datatypes.
@@ -18,9 +16,11 @@ Require Export Coq.Init.Tactics.
 (* Initially available plugins
    (+ nat_syntax_plugin loaded in Datatypes) *)
 Declare ML Module "extraction_plugin".
+Declare ML Module "decl_mode_plugin".
 Declare ML Module "cc_plugin".
 Declare ML Module "ground_plugin".
-Declare ML Module "dp_plugin".
 Declare ML Module "recdef_plugin".
 Declare ML Module "subtac_plugin".
 Declare ML Module "xml_plugin".
+(* Default substrings not considered by queries like SearchAbout *)
+Add Search Blacklist "_admitted" "_subproof" "Private_".
diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v
index 5a951d14..d1610f0a 100644
--- a/theories/Init/Specif.v
+++ b/theories/Init/Specif.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Specif.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Basic specifications : sets that may contain logical information *)
 
 Set Implicit Arguments.
@@ -40,10 +38,10 @@ Inductive sigT2 (A:Type) (P Q:A -> Type) : Type :=
 
 (* Notations *)
 
-Arguments Scope sig [type_scope type_scope].
-Arguments Scope sig2 [type_scope type_scope type_scope].
-Arguments Scope sigT [type_scope type_scope].
-Arguments Scope sigT2 [type_scope type_scope type_scope].
+Arguments sig (A P)%type.
+Arguments sig2 (A P Q)%type.
+Arguments sigT (A P)%type.
+Arguments sigT2 (A P Q)%type.
 
 Notation "{ x  |  P }" := (sig (fun x => P)) : type_scope.
 Notation "{ x  |  P  & Q }" := (sig2 (fun x => P) (fun x => Q)) : type_scope.
@@ -62,7 +60,7 @@ Add Printing Let sigT2.
 
 (** Projections of [sig]
 
-    An element [y] of a subset [{x:A & (P x)}] is the pair of an [a]
+    An element [y] of a subset [{x:A | (P x)}] is the pair of an [a]
     of type [A] and of a proof [h] that [a] satisfies [P].  Then
     [(proj1_sig y)] is the witness [a] and [(proj2_sig y)] is the
     proof of [(P a)] *)
@@ -128,6 +126,9 @@ Inductive sumbool (A B:Prop) : Set :=
 
 Add Printing If sumbool.
 
+Arguments left {A B} _, [A] B _.
+Arguments right {A B} _ , A [B] _.
+
 (** [sumor] is an option type equipped with the justification of why
     it may not be a regular value *)
 
@@ -138,6 +139,9 @@ Inductive sumor (A:Type) (B:Prop) : Type :=
 
 Add Printing If sumor.
 
+Arguments inleft {A B} _ , [A] B _.
+Arguments inright {A B} _ , A [B] _.
+
 (** Various forms of the axiom of choice for specifications *)
 
 Section Choice_lemmas.
@@ -152,16 +156,16 @@ Section Choice_lemmas.
   Proof.
    intro H.
    exists (fun z => proj1_sig (H z)).
-   intro z; destruct (H z); trivial.
-  Qed.
+   intro z; destruct (H z); assumption.
+  Defined.
 
   Lemma Choice2 :
    (forall x:S, {y:S' & R' x y}) -> {f:S -> S' & forall z:S, R' z (f z)}.
   Proof.
     intro H.
     exists (fun z => projT1 (H z)).
-    intro z; destruct (H z); trivial.
-  Qed.
+    intro z; destruct (H z); assumption.
+  Defined.
 
   Lemma bool_choice :
    (forall x:S, {R1 x} + {R2 x}) ->
@@ -170,7 +174,7 @@ Section Choice_lemmas.
     intro H.
     exists (fun z:S => if H z then true else false).
     intro z; destruct (H z); auto.
-  Qed.
+  Defined.
 
 End Choice_lemmas.
 
@@ -188,7 +192,7 @@ Section Dependent_choice_lemmas.
     exists f.
     split. reflexivity.
     induction n; simpl; apply proj2_sig.
-  Qed.
+  Defined.
 
 End Dependent_choice_lemmas.
 
@@ -204,34 +208,34 @@ Definition Exc := option.
 Definition value := Some.
 Definition error := @None.
 
-Implicit Arguments error [A].
+Arguments error [A].
 
 Definition except := False_rec. (* for compatibility with previous versions *)
 
-Implicit Arguments except [P].
+Arguments except [P] _.
 
 Theorem absurd_set : forall (A:Prop) (C:Set), A -> ~ A -> C.
 Proof.
   intros A C h1 h2.
   apply False_rec.
   apply (h2 h1).
-Qed.
+Defined.
 
 Hint Resolve left right inleft inright: core v62.
 Hint Resolve exist exist2 existT existT2: core.
 
 (* Compatibility *)
 
-Notation sigS := sigT (only parsing).
-Notation existS := existT (only parsing).
-Notation sigS_rect := sigT_rect (only parsing).
-Notation sigS_rec := sigT_rec (only parsing).
-Notation sigS_ind := sigT_ind (only parsing).
-Notation projS1 := projT1 (only parsing).
-Notation projS2 := projT2 (only parsing).
-
-Notation sigS2 := sigT2 (only parsing).
-Notation existS2 := existT2 (only parsing).
-Notation sigS2_rect := sigT2_rect (only parsing).
-Notation sigS2_rec := sigT2_rec (only parsing).
-Notation sigS2_ind := sigT2_ind (only parsing).
+Notation sigS := sigT (compat "8.2").
+Notation existS := existT (compat "8.2").
+Notation sigS_rect := sigT_rect (compat "8.2").
+Notation sigS_rec := sigT_rec (compat "8.2").
+Notation sigS_ind := sigT_ind (compat "8.2").
+Notation projS1 := projT1 (compat "8.2").
+Notation projS2 := projT2 (compat "8.2").
+
+Notation sigS2 := sigT2 (compat "8.2").
+Notation existS2 := existT2 (compat "8.2").
+Notation sigS2_rect := sigT2_rect (compat "8.2").
+Notation sigS2_rec := sigT2_rec (compat "8.2").
+Notation sigS2_ind := sigT2_ind (compat "8.2").
diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v
index 1fa4a77f..23d9d10e 100644
--- a/theories/Init/Tactics.v
+++ b/theories/Init/Tactics.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Tactics.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Notations.
 Require Import Logic.
 Require Import Specif.
@@ -77,18 +75,22 @@ Ltac false_hyp H G :=
 
 (* A case with no loss of information. *)
 
-Ltac case_eq x := generalize (refl_equal x); pattern x at -1; case x.
+Ltac case_eq x := generalize (eq_refl x); pattern x at -1; case x.
+
+(* use either discriminate or injection on a hypothesis *)
+
+Ltac destr_eq H := discriminate H || (try (injection H; clear H; intro H)).
 
 (* Similar variants of destruct *)
 
 Tactic Notation "destruct_with_eqn" constr(x) :=
-  destruct x as []_eqn.
+  destruct x eqn:?.
 Tactic Notation "destruct_with_eqn" ident(n) :=
-  try intros until n; destruct n as []_eqn.
+  try intros until n; destruct n eqn:?.
 Tactic Notation "destruct_with_eqn" ":" ident(H) constr(x) :=
-  destruct x as []_eqn:H.
+  destruct x eqn:H.
 Tactic Notation "destruct_with_eqn" ":" ident(H) ident(n) :=
-  try intros until n; destruct n as []_eqn:H.
+  try intros until n; destruct n eqn:H.
 
 (** Break every hypothesis of a certain type *)
 
@@ -187,6 +189,10 @@ Ltac easy :=
 
 Tactic Notation "now" tactic(t) := t; easy.
 
+(** Slightly more than [easy]*)
+
+Ltac easy' := repeat split; simpl; easy || now destruct 1.
+
 (** A tactic to document or check what is proved at some point of a script *)
 
 Ltac now_show c := change c.
diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v
index 5a5f672b..c9fcb570 100644
--- a/theories/Init/Wf.v
+++ b/theories/Init/Wf.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Wf.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** * This module proves the validity of
     - well-founded recursion (also known as course of values)
     - well-founded induction
@@ -105,7 +103,7 @@ Section Well_founded.
 
   Lemma Fix_eq : forall x:A, Fix x = F (fun (y:A) (p:R y x) => Fix y).
   Proof.
-   intro x; unfold Fix in |- *.
+   intro x; unfold Fix.
    rewrite <- Fix_F_eq.
    apply F_ext; intros.
    apply Fix_F_inv.
diff --git a/theories/Lists/List.v b/theories/Lists/List.v
index 4c14008c..69475a6f 100644
--- a/theories/Lists/List.v
+++ b/theories/Lists/List.v
@@ -1,14 +1,12 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: List.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import Le Gt Minus Min Bool.
+Require Import Le Gt Minus Bool Setoid.
 
 Set Implicit Arguments.
 
@@ -55,9 +53,16 @@ Section Lists.
 
 End Lists.
 
-(* Keep these notations local to prevent conflicting notations *)
-Local Notation "[ ]" := nil : list_scope.
-Local Notation "[ a ; .. ; b ]" := (a :: .. (b :: []) ..) : list_scope.
+
+(** Standard notations for lists. 
+In a special module to avoid conflict. *)
+Module ListNotations.
+Notation " [ ] " := nil : list_scope.
+Notation " [ x ] " := (cons x nil) : list_scope.
+Notation " [ x ; .. ; y ] " := (cons x .. (cons y nil) ..) : list_scope.
+End ListNotations.
+
+Import ListNotations.
 
 (** ** Facts about lists *)
 
@@ -119,7 +124,7 @@ Section Facts.
     unfold not; intros a H; inversion_clear H.
   Qed.
 
-  Theorem in_split : forall x (l:list A), In x l -> exists l1, exists l2, l = l1++x::l2.
+  Theorem in_split : forall x (l:list A), In x l -> exists l1 l2, l = l1++x::l2.
   Proof.
   induction l; simpl; destruct 1.
   subst a; auto.
@@ -254,7 +259,7 @@ Section Facts.
   Qed.
 
 
-  (** Compatibility wtih other operations *)
+  (** Compatibility with other operations *)
 
   Lemma app_length : forall l l' : list A, length (l++l') = length l + length l'.
   Proof.
@@ -541,30 +546,21 @@ Section Elts.
     end.
 
   (** Compatibility of count_occ with operations on list *)
-  Theorem count_occ_In : forall (l : list A) (x : A), In x l <-> count_occ l x > 0.
+  Theorem count_occ_In (l : list A) (x : A) : In x l <-> count_occ l x > 0.
   Proof.
-    induction l as [|y l].
-    simpl; intros; split; [destruct 1 | apply gt_irrefl].
-    simpl. intro x; destruct (eq_dec y x) as [Heq|Hneq].
-    rewrite Heq; intuition.
-    pose (IHl x). intuition.
+    induction l as [|y l]; simpl.
+    - split; [destruct 1 | apply gt_irrefl].
+    - destruct eq_dec as [->|Hneq]; rewrite IHl; intuition.
   Qed.
 
-  Theorem count_occ_inv_nil : forall (l : list A), (forall x:A, count_occ l x = 0) <-> l = [].
+  Theorem count_occ_inv_nil (l : list A) :
+    (forall x:A, count_occ l x = 0) <-> l = [].
   Proof.
     split.
-    (* Case -> *)
-    induction l as [|x l].
-    trivial.
-    intro H.
-    elim (O_S (count_occ l x)).
-    apply sym_eq.
-    generalize (H x).
-    simpl. destruct (eq_dec x x) as [|HF].
-    trivial.
-    elim HF; reflexivity.
-    (* Case <- *)
-    intro H; rewrite H; simpl; reflexivity.
+    - induction l as [|x l]; trivial.
+      intros H. specialize (H x). simpl in H.
+      destruct eq_dec as [_|NEQ]; [discriminate|now elim NEQ].
+    - now intros ->.
   Qed.
 
   Lemma count_occ_nil : forall (x : A), count_occ [] x = 0.
@@ -749,22 +745,11 @@ Section ListOps.
 
   Hypothesis eq_dec : forall (x y : A), {x = y}+{x <> y}.
 
-  Lemma list_eq_dec :
-    forall l l':list A, {l = l'} + {l <> l'}.
-  Proof.
-    induction l as [| x l IHl]; destruct l' as [| y l'].
-    left; trivial.
-    right; apply nil_cons.
-    right; unfold not; intro HF; apply (nil_cons (sym_eq HF)).
-    destruct (eq_dec x y) as [xeqy|xneqy]; destruct (IHl l') as [leql'|lneql'];
-      try (right; unfold not; intro HF; injection HF; intros; contradiction).
-    rewrite xeqy; rewrite leql'; left; trivial.
-  Qed.
-
+  Lemma list_eq_dec : forall l l':list A, {l = l'} + {l <> l'}.
+  Proof. decide equality. Defined.
 
 End ListOps.
 
-
 (***************************************************)
 (** * Applying functions to the elements of a list *)
 (***************************************************)
@@ -1643,7 +1628,7 @@ Proof. exact Forall2_nil. Qed.
 
 Theorem Forall2_app_inv_l : forall A B (R:A->B->Prop) l1 l2 l',
   Forall2 R (l1 ++ l2) l' ->
-  exists l1', exists l2', Forall2 R l1 l1' /\ Forall2 R l2 l2' /\ l' = l1' ++ l2'.
+  exists l1' l2', Forall2 R l1 l1' /\ Forall2 R l2 l2' /\ l' = l1' ++ l2'.
 Proof.
   induction l1; intros.
     exists [], l'; auto.
@@ -1654,7 +1639,7 @@ Qed.
 
 Theorem Forall2_app_inv_r : forall A B (R:A->B->Prop) l1' l2' l,
   Forall2 R l (l1' ++ l2') ->
-  exists l1, exists l2, Forall2 R l1 l1' /\ Forall2 R l2 l2' /\ l = l1 ++ l2.
+  exists l1 l2, Forall2 R l1 l1' /\ Forall2 R l2 l2' /\ l = l1 ++ l2.
 Proof.
   induction l1'; intros.
     exists [], l; auto.
diff --git a/theories/Lists/ListSet.v b/theories/Lists/ListSet.v
index 56df3f9c..b846c48d 100644
--- a/theories/Lists/ListSet.v
+++ b/theories/Lists/ListSet.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ListSet.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** A Library for finite sets, implemented as lists *)
 
 (** List is loaded, but not exported.
@@ -87,15 +85,15 @@ Section first_definitions.
   Lemma set_In_dec : forall (a:A) (x:set), {set_In a x} + {~ set_In a x}.
 
   Proof.
-    unfold set_In in |- *.
+    unfold set_In.
     (*** Realizer set_mem. Program_all. ***)
     simple induction x.
     auto.
     intros a0 x0 Ha0. case (Aeq_dec a a0); intro eq.
-    rewrite eq; simpl in |- *; auto with datatypes.
+    rewrite eq; simpl; auto with datatypes.
     elim Ha0.
     auto with datatypes.
-    right; simpl in |- *; unfold not in |- *; intros [Hc1| Hc2];
+    right; simpl; unfold not; intros [Hc1| Hc2];
      auto with datatypes.
   Qed.
 
@@ -104,7 +102,7 @@ Section first_definitions.
      (set_In a x -> P y) -> P z -> P (if set_mem a x then y else z).
 
   Proof.
-    simple induction x; simpl in |- *; intros.
+    simple induction x; simpl; intros.
     assumption.
     elim (Aeq_dec a a0); auto with datatypes.
   Qed.
@@ -115,11 +113,11 @@ Section first_definitions.
      (~ set_In a x -> P z) -> P (if set_mem a x then y else z).
 
   Proof.
-    simple induction x; simpl in |- *; intros.
-    apply H0; red in |- *; trivial.
+    simple induction x; simpl; intros.
+    apply H0; red; trivial.
     case (Aeq_dec a a0); auto with datatypes.
     intro; apply H; intros; auto.
-    apply H1; red in |- *; intro.
+    apply H1; red; intro.
     case H3; auto.
   Qed.
 
@@ -127,7 +125,7 @@ Section first_definitions.
   Lemma set_mem_correct1 :
    forall (a:A) (x:set), set_mem a x = true -> set_In a x.
   Proof.
-    simple induction x; simpl in |- *.
+    simple induction x; simpl.
     discriminate.
     intros a0 l; elim (Aeq_dec a a0); auto with datatypes.
   Qed.
@@ -135,7 +133,7 @@ Section first_definitions.
   Lemma set_mem_correct2 :
    forall (a:A) (x:set), set_In a x -> set_mem a x = true.
   Proof.
-    simple induction x; simpl in |- *.
+    simple induction x; simpl.
     intro Ha; elim Ha.
     intros a0 l; elim (Aeq_dec a a0); auto with datatypes.
     intros H1 H2 [H3| H4].
@@ -146,17 +144,17 @@ Section first_definitions.
   Lemma set_mem_complete1 :
    forall (a:A) (x:set), set_mem a x = false -> ~ set_In a x.
   Proof.
-    simple induction x; simpl in |- *.
+    simple induction x; simpl.
     tauto.
     intros a0 l; elim (Aeq_dec a a0).
     intros; discriminate H0.
-    unfold not in |- *; intros; elim H1; auto with datatypes.
+    unfold not; intros; elim H1; auto with datatypes.
   Qed.
 
   Lemma set_mem_complete2 :
    forall (a:A) (x:set), ~ set_In a x -> set_mem a x = false.
   Proof.
-    simple induction x; simpl in |- *.
+    simple induction x; simpl.
     tauto.
     intros a0 l; elim (Aeq_dec a a0).
     intros; elim H0; auto with datatypes.
@@ -167,7 +165,7 @@ Section first_definitions.
    forall (a b:A) (x:set), set_In a x -> set_In a (set_add b x).
 
   Proof.
-    unfold set_In in |- *; simple induction x; simpl in |- *.
+    unfold set_In; simple induction x; simpl.
     auto with datatypes.
     intros a0 l H [Ha0a| Hal].
     elim (Aeq_dec b a0); left; assumption.
@@ -178,11 +176,11 @@ Section first_definitions.
    forall (a b:A) (x:set), a = b -> set_In a (set_add b x).
 
   Proof.
-    unfold set_In in |- *; simple induction x; simpl in |- *.
+    unfold set_In; simple induction x; simpl.
     auto with datatypes.
     intros a0 l H Hab.
     elim (Aeq_dec b a0);
-     [ rewrite Hab; intro Hba0; rewrite Hba0; simpl in |- *;
+     [ rewrite Hab; intro Hba0; rewrite Hba0; simpl;
         auto with datatypes
      | auto with datatypes ].
   Qed.
@@ -200,13 +198,13 @@ Section first_definitions.
    forall (a b:A) (x:set), set_In a (set_add b x) -> a = b \/ set_In a x.
 
   Proof.
-    unfold set_In in |- *.
+    unfold set_In.
     simple induction x.
-    simpl in |- *; intros [H1| H2]; auto with datatypes.
-    simpl in |- *; do 3 intro.
+    simpl; intros [H1| H2]; auto with datatypes.
+    simpl; do 3 intro.
     elim (Aeq_dec b a0).
-    simpl in |- *; tauto.
-    simpl in |- *; intros; elim H0.
+    simpl; tauto.
+    simpl; intros; elim H0.
     trivial with datatypes.
     tauto.
     tauto.
@@ -222,7 +220,7 @@ Section first_definitions.
 
   Lemma set_add_not_empty : forall (a:A) (x:set), set_add a x <> empty_set.
   Proof.
-    simple induction x; simpl in |- *.
+    simple induction x; simpl.
     discriminate.
     intros; elim (Aeq_dec a a0); intros; discriminate.
   Qed.
@@ -231,13 +229,13 @@ Section first_definitions.
   Lemma set_union_intro1 :
    forall (a:A) (x y:set), set_In a x -> set_In a (set_union x y).
   Proof.
-    simple induction y; simpl in |- *; auto with datatypes.
+    simple induction y; simpl; auto with datatypes.
   Qed.
 
   Lemma set_union_intro2 :
    forall (a:A) (x y:set), set_In a y -> set_In a (set_union x y).
   Proof.
-    simple induction y; simpl in |- *.
+    simple induction y; simpl.
     tauto.
     intros; elim H0; auto with datatypes.
   Qed.
@@ -255,7 +253,7 @@ Section first_definitions.
    forall (a:A) (x y:set),
      set_In a (set_union x y) -> set_In a x \/ set_In a y.
   Proof.
-    simple induction y; simpl in |- *.
+    simple induction y; simpl.
     auto with datatypes.
     intros.
     generalize (set_add_elim _ _ _ H0).
@@ -282,11 +280,11 @@ Section first_definitions.
   Proof.
     simple induction x.
     auto with datatypes.
-    simpl in |- *; intros a0 l Hrec y [Ha0a| Hal] Hy.
-    simpl in |- *; rewrite Ha0a.
+    simpl; intros a0 l Hrec y [Ha0a| Hal] Hy.
+    simpl; rewrite Ha0a.
     generalize (set_mem_correct1 a y).
     generalize (set_mem_complete1 a y).
-    elim (set_mem a y); simpl in |- *; intros.
+    elim (set_mem a y); simpl; intros.
     auto with datatypes.
     absurd (set_In a y); auto with datatypes.
     elim (set_mem a0 y); [ right; auto with datatypes | auto with datatypes ].
@@ -297,9 +295,9 @@ Section first_definitions.
   Proof.
     simple induction x.
     auto with datatypes.
-    simpl in |- *; intros a0 l Hrec y.
+    simpl; intros a0 l Hrec y.
     generalize (set_mem_correct1 a0 y).
-    elim (set_mem a0 y); simpl in |- *; intros.
+    elim (set_mem a0 y); simpl; intros.
     elim H0; eauto with datatypes.
     eauto with datatypes.
   Qed.
@@ -308,10 +306,10 @@ Section first_definitions.
    forall (a:A) (x y:set), set_In a (set_inter x y) -> set_In a y.
   Proof.
     simple induction x.
-    simpl in |- *; tauto.
-    simpl in |- *; intros a0 l Hrec y.
+    simpl; tauto.
+    simpl; intros a0 l Hrec y.
     generalize (set_mem_correct1 a0 y).
-    elim (set_mem a0 y); simpl in |- *; intros.
+    elim (set_mem a0 y); simpl; intros.
     elim H0;
      [ intro Hr; rewrite <- Hr; eauto with datatypes | eauto with datatypes ].
     eauto with datatypes.
@@ -331,8 +329,8 @@ Section first_definitions.
      set_In a x -> ~ set_In a y -> set_In a (set_diff x y).
   Proof.
     simple induction x.
-    simpl in |- *; tauto.
-    simpl in |- *; intros a0 l Hrec y [Ha0a| Hal] Hay.
+    simpl; tauto.
+    simpl; intros a0 l Hrec y [Ha0a| Hal] Hay.
     rewrite Ha0a; generalize (set_mem_complete2 _ _ Hay).
     elim (set_mem a y);
      [ intro Habs; discriminate Habs | auto with datatypes ].
@@ -343,8 +341,8 @@ Section first_definitions.
    forall (a:A) (x y:set), set_In a (set_diff x y) -> set_In a x.
   Proof.
     simple induction x.
-    simpl in |- *; tauto.
-    simpl in |- *; intros a0 l Hrec y; elim (set_mem a0 y).
+    simpl; tauto.
+    simpl; intros a0 l Hrec y; elim (set_mem a0 y).
     eauto with datatypes.
     intro; generalize (set_add_elim _ _ _ H).
     intros [H1| H2]; eauto with datatypes.
@@ -352,7 +350,7 @@ Section first_definitions.
 
   Lemma set_diff_elim2 :
    forall (a:A) (x y:set), set_In a (set_diff x y) -> ~ set_In a y.
-  intros a x y; elim x; simpl in |- *.
+  intros a x y; elim x; simpl.
   intros; contradiction.
   intros a0 l Hrec.
   apply set_mem_ind2; auto.
@@ -361,7 +359,7 @@ Section first_definitions.
   Qed.
 
   Lemma set_diff_trivial : forall (a:A) (x:set), ~ set_In a (set_diff x x).
-  red in |- *; intros a x H.
+  red; intros a x H.
   apply (set_diff_elim2 _ _ _ H).
   apply (set_diff_elim1 _ _ _ H).
   Qed.
diff --git a/theories/Lists/ListTactics.v b/theories/Lists/ListTactics.v
index 08669499..74336555 100644
--- a/theories/Lists/ListTactics.v
+++ b/theories/Lists/ListTactics.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ListTactics.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import BinPos.
 Require Import List.
 
@@ -62,7 +60,7 @@ Ltac Find_at a l :=
    match l with
    | nil     => fail 100 "anomaly: Find_at"
    | a :: _  => eval compute in n
-   | _ :: ?l => find (Psucc n) l
+   | _ :: ?l => find (Pos.succ n) l
    end
  in find 1%positive l.
 
diff --git a/theories/Lists/SetoidList.v b/theories/Lists/SetoidList.v
index ec31f37d..0fd1693e 100644
--- a/theories/Lists/SetoidList.v
+++ b/theories/Lists/SetoidList.v
@@ -6,10 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: SetoidList.v 12919 2010-04-10 16:30:44Z herbelin $ *)
-
 Require Export List.
-Require Export Sorting.
+Require Export Sorted.
 Require Export Setoid Basics Morphisms.
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -82,6 +80,10 @@ Qed.
 Definition inclA l l' := forall x, InA x l -> InA x l'.
 Definition equivlistA l l' := forall x, InA x l <-> InA x l'.
 
+Lemma incl_nil l : inclA nil l.
+Proof. intro. intros. inversion H. Qed.
+Hint Resolve incl_nil : list.
+
 (** lists with same elements modulo [eqA] at the same place *)
 
 Inductive eqlistA : list A -> list A -> Prop :=
@@ -159,8 +161,7 @@ Qed.
 Hint Resolve In_InA.
 
 Lemma InA_split : forall l x, InA x l ->
- exists l1, exists y, exists l2,
- eqA x y /\ l = l1++y::l2.
+ exists l1 y l2, eqA x y /\ l = l1++y::l2.
 Proof.
 induction l; intros; inv.
 exists (@nil A); exists a; exists l; auto.
@@ -198,7 +199,29 @@ Proof.
  rewrite <- In_rev; auto.
 Qed.
 
+(** Some more facts about InA *)
+
+Lemma InA_singleton x y : InA x (y::nil) <-> eqA x y.
+Proof.
+ rewrite InA_cons, InA_nil; tauto.
+Qed.
+
+Lemma InA_double_head x y l :
+ InA x (y :: y :: l) <-> InA x (y :: l).
+Proof.
+ rewrite !InA_cons; tauto.
+Qed.
+
+Lemma InA_permute_heads x y z l :
+ InA x (y :: z :: l) <-> InA x (z :: y :: l).
+Proof.
+ rewrite !InA_cons; tauto.
+Qed.
 
+Lemma InA_app_idem x l : InA x (l ++ l) <-> InA x l.
+Proof.
+ rewrite InA_app_iff; tauto.
+Qed.
 
 Section NoDupA.
 
@@ -269,7 +292,56 @@ Proof.
  eapply NoDupA_split; eauto.
 Qed.
 
-Lemma equivlistA_NoDupA_split : forall l l1 l2 x y, eqA x y ->
+Lemma NoDupA_singleton x : NoDupA (x::nil).
+Proof.
+ repeat constructor. inversion 1.
+Qed.
+
+End NoDupA.
+
+Section EquivlistA.
+
+Global Instance equivlistA_cons_proper:
+ Proper (eqA ==> equivlistA ==> equivlistA) (@cons A).
+Proof.
+ intros ? ? E1 ? ? E2 ?; now rewrite !InA_cons, E1, E2.
+Qed.
+
+Global Instance equivlistA_app_proper:
+ Proper (equivlistA ==> equivlistA ==> equivlistA) (@app A).
+Proof.
+ intros ? ? E1 ? ? E2 ?. now rewrite !InA_app_iff, E1, E2.
+Qed.
+
+Lemma equivlistA_cons_nil x l : ~ equivlistA (x :: l) nil.
+Proof.
+ intros E. now eapply InA_nil, E, InA_cons_hd.
+Qed.
+
+Lemma equivlistA_nil_eq l : equivlistA l nil -> l = nil.
+Proof.
+ destruct l.
+ - trivial.
+ - intros H. now apply equivlistA_cons_nil in H.
+Qed.
+
+Lemma equivlistA_double_head x l : equivlistA (x :: x :: l) (x :: l).
+Proof.
+ intro. apply InA_double_head.
+Qed.
+
+Lemma equivlistA_permute_heads x y l :
+ equivlistA (x :: y :: l) (y :: x :: l).
+Proof.
+ intro. apply InA_permute_heads.
+Qed.
+
+Lemma equivlistA_app_idem l : equivlistA (l ++ l) l.
+Proof.
+ intro. apply InA_app_idem.
+Qed.
+
+Lemma equivlistA_NoDupA_split l l1 l2 x y : eqA x y ->
  NoDupA (x::l) -> NoDupA (l1++y::l2) ->
  equivlistA (x::l) (l1++y::l2) -> equivlistA l (l1++l2).
 Proof.
@@ -289,9 +361,7 @@ Proof.
  rewrite <-H,<-EQN; auto.
 Qed.
 
-End NoDupA.
-
-
+End EquivlistA.
 
 Section Fold.
 
@@ -587,10 +657,9 @@ Proof.
 Qed.
 
 (** For compatibility, can be deduced from [InfA_compat] *)
-Lemma InfA_eqA :
- forall l x y, eqA x y -> InfA y l -> InfA x l.
+Lemma InfA_eqA l x y : eqA x y -> InfA y l -> InfA x l.
 Proof.
- intros l x y H; rewrite H; auto.
+ intros H; now rewrite H.
 Qed.
 Hint Immediate InfA_ltA InfA_eqA.
 
@@ -747,7 +816,7 @@ rewrite filter_In in H; destruct H.
 eapply SortA_InfA_InA; eauto.
 Qed.
 
-Implicit Arguments eq [ [A] ].
+Arguments eq {A} x _.
 
 Lemma filter_InA : forall f, Proper (eqA==>eq) f ->
  forall l x, InA x (List.filter f l) <-> InA x l /\ f x = true.
@@ -784,9 +853,11 @@ Qed.
 End Filter.
 End Type_with_equality.
 
-
 Hint Constructors InA eqlistA NoDupA sort lelistA.
 
+Arguments equivlistA_cons_nil {A} eqA {eqA_equiv} x l _.
+Arguments equivlistA_nil_eq {A} eqA {eqA_equiv} l _.
+
 Section Find.
 
 Variable A B : Type.
@@ -837,7 +908,6 @@ Qed.
 
 End Find.
 
-
 (** Compatibility aliases. [Proper] is rather to be used directly now.*)
 
 Definition compat_bool {A} (eqA:A->A->Prop)(f:A->bool) :=
@@ -851,4 +921,3 @@ Definition compat_P {A} (eqA:A->A->Prop)(P:A->Prop) :=
 
 Definition compat_op {A B} (eqA:A->A->Prop)(eqB:B->B->Prop)(f:A->B->B) :=
  Proper (eqA==>eqB==>eqB) f.
-
diff --git a/theories/Lists/SetoidPermutation.v b/theories/Lists/SetoidPermutation.v
new file mode 100644
index 00000000..b0657b63
--- /dev/null
+++ b/theories/Lists/SetoidPermutation.v
@@ -0,0 +1,125 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+Require Import SetoidList.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+(** Permutations of list modulo a setoid equality. *)
+
+(** Contribution by Robbert Krebbers (Nijmegen University). *)
+
+Section Permutation.
+Context {A : Type} (eqA : relation A) (e : Equivalence eqA).
+
+Inductive PermutationA : list A -> list A -> Prop :=
+  | permA_nil: PermutationA nil nil
+  | permA_skip x₁ x₂ l₁ l₂ :
+     eqA x₁ x₂ -> PermutationA l₁ l₂ -> PermutationA (x₁ :: l₁) (x₂ :: l₂)
+  | permA_swap x y l : PermutationA (y :: x :: l) (x :: y :: l)
+  | permA_trans l₁ l₂ l₃ :
+     PermutationA l₁ l₂ -> PermutationA l₂ l₃ -> PermutationA l₁ l₃.
+Local Hint Constructors PermutationA.
+
+Global Instance: Equivalence PermutationA.
+Proof.
+ constructor.
+ - intro l. induction l; intuition.
+ - intros l₁ l₂. induction 1; eauto. apply permA_skip; intuition.
+ - exact permA_trans.
+Qed.
+
+Global Instance PermutationA_cons :
+  Proper (eqA ==> PermutationA ==> PermutationA) (@cons A).
+Proof.
+ repeat intro. now apply permA_skip.
+Qed.
+
+Lemma PermutationA_app_head l₁ l₂ l :
+  PermutationA l₁ l₂ -> PermutationA (l ++ l₁) (l ++ l₂).
+Proof.
+ induction l; trivial; intros. apply permA_skip; intuition.
+Qed.
+
+Global Instance PermutationA_app :
+  Proper (PermutationA ==> PermutationA ==> PermutationA) (@app A).
+Proof.
+ intros l₁ l₂ Pl k₁ k₂ Pk.
+ induction Pl.
+ - easy.
+ - now apply permA_skip.
+ - etransitivity.
+   * rewrite <-!app_comm_cons. now apply permA_swap.
+   * rewrite !app_comm_cons. now apply PermutationA_app_head.
+ - do 2 (etransitivity; try eassumption).
+   apply PermutationA_app_head. now symmetry.
+Qed.
+
+Lemma PermutationA_app_tail l₁ l₂ l :
+  PermutationA l₁ l₂ -> PermutationA (l₁ ++ l) (l₂ ++ l).
+Proof.
+ intros E. now rewrite E.
+Qed.
+
+Lemma PermutationA_cons_append l x :
+  PermutationA (x :: l) (l ++ x :: nil).
+Proof.
+ induction l.
+ - easy.
+ - simpl. rewrite <-IHl. intuition.
+Qed.
+
+Lemma PermutationA_app_comm l₁ l₂ :
+  PermutationA (l₁ ++ l₂) (l₂ ++ l₁).
+Proof.
+ induction l₁.
+ - now rewrite app_nil_r.
+ - rewrite <-app_comm_cons, IHl₁, app_comm_cons.
+   now rewrite PermutationA_cons_append, <-app_assoc.
+Qed.
+
+Lemma PermutationA_cons_app l l₁ l₂ x :
+  PermutationA l (l₁ ++ l₂) -> PermutationA (x :: l) (l₁ ++ x :: l₂).
+Proof.
+ intros E. rewrite E.
+ now rewrite app_comm_cons, PermutationA_cons_append, <-app_assoc.
+Qed.
+
+Lemma PermutationA_middle l₁ l₂ x :
+  PermutationA (x :: l₁ ++ l₂) (l₁ ++ x :: l₂).
+Proof.
+ now apply PermutationA_cons_app.
+Qed.
+
+Lemma PermutationA_equivlistA l₁ l₂ :
+  PermutationA l₁ l₂ -> equivlistA eqA l₁ l₂.
+Proof.
+ induction 1.
+ - reflexivity.
+ - now apply equivlistA_cons_proper.
+ - now apply equivlistA_permute_heads.
+ - etransitivity; eassumption.
+Qed.
+
+Lemma NoDupA_equivlistA_PermutationA l₁ l₂ :
+  NoDupA eqA l₁ -> NoDupA eqA l₂ ->
+   equivlistA eqA l₁ l₂ -> PermutationA l₁ l₂.
+Proof.
+  intros Pl₁. revert l₂. induction Pl₁ as [|x l₁ E1].
+  - intros l₂ _ H₂. symmetry in H₂. now rewrite (equivlistA_nil_eq eqA).
+  - intros l₂ Pl₂ E2.
+    destruct (@InA_split _ eqA l₂ x) as [l₂h [y [l₂t [E3 ?]]]].
+    { rewrite <-E2. intuition. }
+    subst. transitivity (y :: l₁); [intuition |].
+    apply PermutationA_cons_app, IHPl₁.
+    now apply NoDupA_split with y.
+    apply equivlistA_NoDupA_split with x y; intuition.
+Qed.
+
+End Permutation.
diff --git a/theories/Lists/StreamMemo.v b/theories/Lists/StreamMemo.v
index 1ab4fa9d..67882cde 100644
--- a/theories/Lists/StreamMemo.v
+++ b/theories/Lists/StreamMemo.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -32,10 +32,10 @@ Fixpoint memo_get (n:nat) (l:Stream A) : A :=
 Theorem memo_get_correct: forall n, memo_get n memo_list = f n.
 Proof.
 assert (F1: forall n m, memo_get n (memo_make m) = f (n + m)).
-  induction n as [| n Hrec]; try (intros m; refine (refl_equal _)).
+{ induction n as [| n Hrec]; try (intros m; reflexivity).
   intros m; simpl; rewrite Hrec.
-  rewrite plus_n_Sm; auto.
-intros n; apply trans_equal with (f (n + 0)); try exact (F1 n 0).
+  rewrite plus_n_Sm; auto. }
+intros n; transitivity (f (n + 0)); try exact (F1 n 0).
 rewrite <- plus_n_O; auto.
 Qed.
 
@@ -57,11 +57,10 @@ Definition imemo_list := let f0 := f 0 in
 
 Theorem imemo_get_correct: forall n, memo_get n imemo_list = f n.
 Proof.
-assert (F1: forall n m,
-    memo_get n (imemo_make (f m)) = f (S (n + m))).
-  induction n as [| n Hrec]; try (intros m; exact (sym_equal (Hg_correct m))).
-  simpl; intros m; rewrite <- Hg_correct; rewrite Hrec; rewrite <- plus_n_Sm; auto.
-destruct n as [| n]; try apply refl_equal.
+assert (F1: forall n m, memo_get n (imemo_make (f m)) = f (S (n + m))).
+{ induction n as [| n Hrec]; try (intros m; exact (eq_sym (Hg_correct m))).
+  simpl; intros m; rewrite <- Hg_correct, Hrec, <- plus_n_Sm; auto. }
+destruct n as [| n]; try reflexivity.
 unfold imemo_list; simpl; rewrite F1.
 rewrite <- plus_n_O; auto.
 Qed.
@@ -82,7 +81,7 @@ Inductive memo_val: Type :=
 
 Fixpoint is_eq (n m : nat) : {n = m} + {True} :=
   match n, m return {n = m} + {True} with
-  | 0, 0 =>left True (refl_equal 0)
+  | 0, 0 =>left True (eq_refl 0)
   | 0, S m1 => right (0 = S m1) I
   | S n1, 0 => right (S n1 = 0) I
   | S n1, S m1 =>
@@ -98,7 +97,7 @@ match v with
     match is_eq n m with
     | left H =>
        match H in (eq _ y) return (A y -> A n) with
-        | refl_equal => fun v1 : A n => v1
+        | eq_refl => fun v1 : A n => v1
        end
     | right _ => fun _ : A m => f n
     end x
@@ -115,7 +114,7 @@ Proof.
 intros n; unfold dmemo_get, dmemo_list.
 rewrite (memo_get_correct memo_val mf n); simpl.
 case (is_eq n n); simpl; auto; intros e.
-assert (e = refl_equal n).
+assert (e = eq_refl n).
  apply eq_proofs_unicity.
  induction x as [| x Hx]; destruct y as [| y].
  left; auto.
@@ -144,7 +143,7 @@ Proof.
 intros n; unfold dmemo_get, dimemo_list.
 rewrite (imemo_get_correct memo_val mf mg); simpl.
 case (is_eq n n); simpl; auto; intros e.
-assert (e = refl_equal n).
+assert (e = eq_refl n).
  apply eq_proofs_unicity.
  induction x as [| x Hx]; destruct y as [| y].
  left; auto.
@@ -169,11 +168,11 @@ Open Scope Z_scope.
 Fixpoint tfact (n: nat) :=
   match n with
    | O => 1
-   | S n1 => Z_of_nat n * tfact n1
+   | S n1 => Z.of_nat n * tfact n1
   end.
 
 Definition lfact_list :=
-  dimemo_list _ tfact (fun n z => (Z_of_nat (S  n) * z)).
+  dimemo_list _ tfact (fun n z => (Z.of_nat (S  n) * z)).
 
 Definition lfact n := dmemo_get _ tfact n lfact_list.
 
diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v
index 02d17211..e1122cf9 100644
--- a/theories/Lists/Streams.v
+++ b/theories/Lists/Streams.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Streams.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 (** Streams *)
@@ -51,21 +49,21 @@ Qed.
 Lemma tl_nth_tl :
  forall (n:nat) (s:Stream), tl (Str_nth_tl n s) = Str_nth_tl n (tl s).
 Proof.
-  simple induction n; simpl in |- *; auto.
+  simple induction n; simpl; auto.
 Qed.
 Hint Resolve tl_nth_tl: datatypes v62.
 
 Lemma Str_nth_tl_plus :
  forall (n m:nat) (s:Stream),
    Str_nth_tl n (Str_nth_tl m s) = Str_nth_tl (n + m) s.
-simple induction n; simpl in |- *; intros; auto with datatypes.
+simple induction n; simpl; intros; auto with datatypes.
 rewrite <- H.
 rewrite tl_nth_tl; trivial with datatypes.
 Qed.
 
 Lemma Str_nth_plus :
  forall (n m:nat) (s:Stream), Str_nth n (Str_nth_tl m s) = Str_nth (n + m) s.
-intros; unfold Str_nth in |- *; rewrite Str_nth_tl_plus;
+intros; unfold Str_nth; rewrite Str_nth_tl_plus;
  trivial with datatypes.
 Qed.
 
@@ -91,7 +89,7 @@ Qed.
 
 Theorem sym_EqSt : forall s1 s2:Stream, EqSt s1 s2 -> EqSt s2 s1.
 coinduction Eq_sym.
-case H; intros; symmetry  in |- *; assumption.
+case H; intros; symmetry ; assumption.
 case H; intros; assumption.
 Qed.
 
@@ -112,10 +110,10 @@ Qed.
 
 Theorem eqst_ntheq :
  forall (n:nat) (s1 s2:Stream), EqSt s1 s2 -> Str_nth n s1 = Str_nth n s2.
-unfold Str_nth in |- *; simple induction n.
+unfold Str_nth; simple induction n.
 intros s1 s2 H; case H; trivial with datatypes.
 intros m hypind.
-simpl in |- *.
+simpl.
 intros s1 s2 H.
 apply hypind.
 case H; trivial with datatypes.
diff --git a/theories/Lists/TheoryList.v b/theories/Lists/TheoryList.v
deleted file mode 100644
index 498a9dca..00000000
--- a/theories/Lists/TheoryList.v
+++ /dev/null
@@ -1,423 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(*i $Id: TheoryList.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-(** Some programs and results about lists following CAML Manual *)
-
-Require Export List.
-Set Implicit Arguments.
-
-Local Notation "[ ]" := nil (at level 0).
-Local Notation "[ a ; .. ; b ]" := (a :: .. (b :: []) ..) (at level 0).
-
-Section Lists.
-
-Variable A : Type.
-
-(**********************)
-(** The null function *)
-(**********************)
-
-Definition Isnil (l:list A) : Prop := nil = l.
-
-Lemma Isnil_nil : Isnil nil.
-Proof.
-red in |- *; auto.
-Qed.
-Hint Resolve Isnil_nil.
-
-Lemma not_Isnil_cons : forall (a:A) (l:list A), ~ Isnil (a :: l).
-Proof.
-unfold Isnil in |- *.
-intros; discriminate.
-Qed.
-
-Hint Resolve Isnil_nil not_Isnil_cons.
-
-Lemma Isnil_dec : forall l:list A, {Isnil l} + {~ Isnil l}.
-Proof.
-intro l; case l; auto.
-(*
-Realizer (fun l => match l with
-  | nil => true
-  | _ => false
-  end).
-*)
-Qed.
-
-(************************)
-(** The Uncons function *)
-(************************)
-
-Lemma Uncons :
- forall l:list A, {a : A &  {m : list A | a :: m = l}} + {Isnil l}.
-Proof.
-intro l; case l.
-auto.
-intros a m; intros; left; exists a; exists m; reflexivity.
-(*
-Realizer (fun l => match l with
-  | nil => error
-  | (cons a m) => value (a,m)
-  end).
-*)
-Qed.
-
-(********************************)
-(** The head function           *)
-(********************************)
-
-Lemma Hd :
- forall l:list A, {a : A |  exists m : list A, a :: m = l} + {Isnil l}.
-Proof.
-intro l; case l.
-auto.
-intros a m; intros; left; exists a; exists m; reflexivity.
-(*
-Realizer (fun l => match l with
-  | nil => error
-  | (cons a m) => value a
-  end).
-*)
-Qed.
-
-Lemma Tl :
- forall l:list A,
-   {m : list A | (exists a : A, a :: m = l) \/ Isnil l /\ Isnil m}.
-Proof.
-intro l; case l.
-exists (nil (A:=A)); auto.
-intros a m; intros; exists m; left; exists a; reflexivity.
-(*
-Realizer (fun l => match l with
-  | nil => nil
-  | (cons a m) => m
-  end).
-*)
-Qed.
-
-(****************************************)
-(** Length of lists                     *)
-(****************************************)
-
-(* length is defined in List *)
-Fixpoint Length_l (l:list A) (n:nat) : nat :=
-  match l with
-  | nil => n
-  | _ :: m => Length_l m (S n)
-  end.
-
-(* A tail recursive version *)
-Lemma Length_l_pf : forall (l:list A) (n:nat), {m : nat | n + length l = m}.
-Proof.
-induction l as [| a m lrec].
-intro n; exists n; simpl in |- *; auto.
-intro n; elim (lrec (S n)); simpl in |- *; intros.
-exists x; transitivity (S (n + length m)); auto.
-(*
-Realizer Length_l.
-*)
-Qed.
-
-Lemma Length : forall l:list A, {m : nat | length l = m}.
-Proof.
-intro l. apply (Length_l_pf l 0).
-(*
-Realizer (fun l -> Length_l_pf l O).
-*)
-Qed.
-
-(*******************************)
-(** Members of lists           *)
-(*******************************)
-Inductive In_spec (a:A) : list A -> Prop :=
-  | in_hd : forall l:list A, In_spec a (a :: l)
-  | in_tl : forall (l:list A) (b:A), In a l -> In_spec a (b :: l).
-Hint Resolve in_hd in_tl.
-Hint Unfold In.
-Hint Resolve in_cons.
-
-Theorem In_In_spec : forall (a:A) (l:list A), In a l <-> In_spec a l.
-split.
-elim l;
- [ intros; contradiction
- | intros; elim H0; [ intros; rewrite H1; auto | auto ] ].
-intros; elim H; auto.
-Qed.
-
-Hypothesis eqA_dec : forall a b:A, {a = b} + {a <> b}.
-
-Fixpoint mem (a:A) (l:list A) : bool :=
-  match l with
-  | nil => false
-  | b :: m => if eqA_dec a b then true else mem a m
-  end.
-
-Hint Unfold In.
-Lemma Mem : forall (a:A) (l:list A), {In a l} + {AllS (fun b:A => b <> a) l}.
-Proof.
-induction l.
-auto.
-elim (eqA_dec a a0).
-auto.
-simpl in |- *. elim IHl; auto.
-(*
-Realizer mem.
-*)
-Qed.
-
-(*********************************)
-(** Index of elements            *)
-(*********************************)
-
-Require Import Le.
-Require Import Lt.
-
-Inductive nth_spec : list A -> nat -> A -> Prop :=
-  | nth_spec_O : forall (a:A) (l:list A), nth_spec (a :: l) 1 a
-  | nth_spec_S :
-      forall (n:nat) (a b:A) (l:list A),
-        nth_spec l n a -> nth_spec (b :: l) (S n) a.
-Hint Resolve nth_spec_O nth_spec_S.
-
-Inductive fst_nth_spec : list A -> nat -> A -> Prop :=
-  | fst_nth_O : forall (a:A) (l:list A), fst_nth_spec (a :: l) 1 a
-  | fst_nth_S :
-      forall (n:nat) (a b:A) (l:list A),
-        a <> b -> fst_nth_spec l n a -> fst_nth_spec (b :: l) (S n) a.
-Hint Resolve fst_nth_O fst_nth_S.
-
-Lemma fst_nth_nth :
- forall (l:list A) (n:nat) (a:A), fst_nth_spec l n a -> nth_spec l n a.
-Proof.
-induction 1; auto.
-Qed.
-Hint Immediate fst_nth_nth.
-
-Lemma nth_lt_O : forall (l:list A) (n:nat) (a:A), nth_spec l n a -> 0 < n.
-Proof.
-induction 1; auto.
-Qed.
-
-Lemma nth_le_length :
- forall (l:list A) (n:nat) (a:A), nth_spec l n a -> n <= length l.
-Proof.
-induction 1; simpl in |- *; auto with arith.
-Qed.
-
-Fixpoint Nth_func (l:list A) (n:nat) : Exc A :=
-  match l, n with
-  | a :: _, S O => value a
-  | _ :: l', S (S p) => Nth_func l' (S p)
-  | _, _ => error
-  end.
-
-Lemma Nth :
- forall (l:list A) (n:nat),
-   {a : A | nth_spec l n a} + {n = 0 \/ length l < n}.
-Proof.
-induction l as [| a l IHl].
-intro n; case n; simpl in |- *; auto with arith.
-intro n; destruct n as [| [| n1]]; simpl in |- *; auto.
-left; exists a; auto.
-destruct (IHl (S n1)) as [[b]| o].
-left; exists b; auto.
-right; destruct o.
-absurd (S n1 = 0); auto.
-auto with arith.
-(*
-Realizer Nth_func.
-*)
-Qed.
-
-Lemma Item :
- forall (l:list A) (n:nat), {a : A | nth_spec l (S n) a} + {length l <= n}.
-Proof.
-intros l n; case (Nth l (S n)); intro.
-case s; intro a; left; exists a; auto.
-right; case o; intro.
-absurd (S n = 0); auto.
-auto with arith.
-Qed.
-
-Require Import Minus.
-Require Import DecBool.
-
-Fixpoint index_p (a:A) (l:list A) : nat -> Exc nat :=
-  match l with
-  | nil => fun p => error
-  | b :: m => fun p => ifdec (eqA_dec a b) (value p) (index_p a m (S p))
-  end.
-
-Lemma Index_p :
- forall (a:A) (l:list A) (p:nat),
-   {n : nat | fst_nth_spec l (S n - p) a} + {AllS (fun b:A => a <> b) l}.
-Proof.
-induction l as [| b m irec].
-auto.
-intro p.
-destruct (eqA_dec a b) as [e| e].
-left; exists p.
-destruct e; elim minus_Sn_m; trivial; elim minus_n_n; auto with arith.
-destruct (irec (S p)) as [[n H]| ].
-left; exists n; auto with arith.
-elim minus_Sn_m; auto with arith.
-apply lt_le_weak; apply lt_O_minus_lt; apply nth_lt_O with m a;
- auto with arith.
-auto.
-Qed.
-
-Lemma Index :
- forall (a:A) (l:list A),
-   {n : nat | fst_nth_spec l n a} + {AllS (fun b:A => a <> b) l}.
-
-Proof.
-intros a l; case (Index_p a l 1); auto.
-intros [n P]; left; exists n; auto.
-rewrite (minus_n_O n); trivial.
-(*
-Realizer (fun a l -> Index_p a l (S O)).
-*)
-Qed.
-
-Section Find_sec.
-Variables R P : A -> Prop.
-
-Inductive InR : list A -> Prop :=
-  | inR_hd : forall (a:A) (l:list A), R a -> InR (a :: l)
-  | inR_tl : forall (a:A) (l:list A), InR l -> InR (a :: l).
-Hint Resolve inR_hd inR_tl.
-
-Definition InR_inv (l:list A) :=
-  match l with
-  | nil => False
-  | b :: m => R b \/ InR m
-  end.
-
-Lemma InR_INV : forall l:list A, InR l -> InR_inv l.
-Proof.
-induction 1; simpl in |- *; auto.
-Qed.
-
-Lemma InR_cons_inv : forall (a:A) (l:list A), InR (a :: l) -> R a \/ InR l.
-Proof.
-intros a l H; exact (InR_INV H).
-Qed.
-
-Lemma InR_or_app : forall l m:list A, InR l \/ InR m -> InR (l ++ m).
-Proof.
-intros l m [| ].
-induction 1; simpl in |- *; auto.
-intro. induction l; simpl in |- *; auto.
-Qed.
-
-Lemma InR_app_or : forall l m:list A, InR (l ++ m) -> InR l \/ InR m.
-Proof.
-intros l m; elim l; simpl in |- *; auto.
-intros b l' Hrec IAc; elim (InR_cons_inv IAc); auto.
-intros; elim Hrec; auto.
-Qed.
-
-Hypothesis RS_dec : forall a:A, {R a} + {P a}.
-
-Fixpoint find (l:list A) : Exc A :=
-  match l with
-  | nil => error
-  | a :: m => ifdec (RS_dec a) (value a) (find m)
-  end.
-
-Lemma Find : forall l:list A, {a : A | In a l &  R a} + {AllS P l}.
-Proof.
-induction l as [| a m [[b H1 H2]| H]]; auto.
-left; exists b; auto.
-destruct (RS_dec a).
-left; exists a; auto.
-auto.
-(*
-Realizer find.
-*)
-Qed.
-
-Variable B : Type.
-Variable T : A -> B -> Prop.
-
-Variable TS_dec : forall a:A, {c : B | T a c} + {P a}.
-
-Fixpoint try_find (l:list A) : Exc B :=
-  match l with
-  | nil => error
-  | a :: l1 =>
-      match TS_dec a with
-      | inleft (exist c _) => value c
-      | inright _ => try_find l1
-      end
-  end.
-
-Lemma Try_find :
- forall l:list A, {c : B |  exists2 a : A, In a l & T a c} + {AllS P l}.
-Proof.
-induction l as [| a m [[b H1]| H]].
-auto.
-left; exists b; destruct H1 as [a' H2 H3]; exists a'; auto.
-destruct (TS_dec a) as [[c H1]| ].
-left; exists c.
-exists a; auto.
-auto.
-(*
-Realizer try_find.
-*)
-Qed.
-
-End Find_sec.
-
-Section Assoc_sec.
-
-Variable B : Type.
-Fixpoint assoc (a:A) (l:list (A * B)) :
- Exc B :=
-  match l with
-  | nil => error
-  | (a', b) :: m => ifdec (eqA_dec a a') (value b) (assoc a m)
-  end.
-
-Inductive AllS_assoc (P:A -> Prop) : list (A * B) -> Prop :=
-  | allS_assoc_nil : AllS_assoc P nil
-  | allS_assoc_cons :
-      forall (a:A) (b:B) (l:list (A * B)),
-        P a -> AllS_assoc P l -> AllS_assoc P ((a, b) :: l).
-
-Hint Resolve allS_assoc_nil allS_assoc_cons.
-
-(* The specification seems too weak: it is enough to return b if the
-   list has at least an element (a,b); probably the intention is to have
-   the specification
-
-   (a:A)(l:(list A*B)){b:B|(In_spec (a,b) l)}+{(AllS_assoc [a':A]~(a=a') l)}.
-*)
-
-Lemma Assoc :
- forall (a:A) (l:list (A * B)), B + {AllS_assoc (fun a':A => a <> a') l}.
-Proof.
-induction l as [| [a' b] m assrec]. auto.
-destruct (eqA_dec a a').
-left; exact b.
-destruct assrec as [b'| ].
-left; exact b'.
-right; auto.
-(*
-Realizer assoc.
-*)
-Qed.
-
-End Assoc_sec.
-
-End Lists.
-
-Hint Resolve Isnil_nil not_Isnil_cons in_hd in_tl in_cons : datatypes.
-Hint Immediate fst_nth_nth: datatypes.
diff --git a/theories/Lists/intro.tex b/theories/Lists/intro.tex
index 0051e2c2..d372de8e 100755
--- a/theories/Lists/intro.tex
+++ b/theories/Lists/intro.tex
@@ -13,12 +13,8 @@ This library includes the following files:
 \item {\tt ListSet.v} contains definitions and properties of finite
   sets, implemented as lists.
 
-\item {\tt TheoryList.v} contains complementary results on lists. Here
-  a more theoretic point of view is assumed : one extracts functions
-  from propositions, rather than defining functions and then prove them.
-
 \item {\tt Streams.v} defines the type of infinite lists (streams). It is a
-  coinductive type. Basic facts are stated and proved. The streams are
+  co-inductive type. Basic facts are stated and proved. The streams are
   also polymorphic.
 
 \end{itemize}
diff --git a/theories/Lists/vo.itarget b/theories/Lists/vo.itarget
index d2a31367..04994f59 100644
--- a/theories/Lists/vo.itarget
+++ b/theories/Lists/vo.itarget
@@ -2,6 +2,6 @@ ListSet.vo
 ListTactics.vo
 List.vo
 SetoidList.vo
+SetoidPermutation.vo
 StreamMemo.vo
 Streams.vo
-TheoryList.vo
diff --git a/theories/Logic/Berardi.v b/theories/Logic/Berardi.v
index d954f40c..38377573 100644
--- a/theories/Logic/Berardi.v
+++ b/theories/Logic/Berardi.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Berardi.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file formalizes Berardi's paradox which says that in
    the calculus of constructions, excluded middle (EM) and axiom of
    choice (AC) imply proof irrelevance (PI).
@@ -47,7 +45,7 @@ Lemma AC_IF :
    (B -> Q e1) -> (~ B -> Q e2) -> Q (IFProp B e1 e2).
 Proof.
 intros P B e1 e2 Q p1 p2.
-unfold IFProp in |- *.
+unfold IFProp.
 case (EM B); assumption.
 Qed.
 
@@ -78,7 +76,7 @@ Record retract_cond : Prop :=
 Lemma AC : forall r:retract_cond, retract -> forall a:A, j2 r (i2 r a) = a.
 Proof.
 intros r.
-case r; simpl in |- *.
+case r; simpl.
 trivial.
 Qed.
 
@@ -115,7 +113,7 @@ Lemma retract_pow_U_U : retract (pow U) U.
 Proof.
 exists g f.
 intro a.
-unfold f, g in |- *; simpl in |- *.
+unfold f, g; simpl.
 apply AC.
 exists (fun x:pow U => x) (fun x:pow U => x).
 trivial.
@@ -132,8 +130,8 @@ Definition R : U := g (fun u:U => Not_b (u U u)).
 
 Lemma not_has_fixpoint : R R = Not_b (R R).
 Proof.
-unfold R at 1 in |- *.
-unfold g in |- *.
+unfold R at 1.
+unfold g.
 rewrite AC with (r := L1 U U) (a := fun u:U => Not_b (u U u)).
 trivial.
 exists (fun x:pow U => x) (fun x:pow U => x); trivial.
@@ -143,7 +141,7 @@ Qed.
 Theorem classical_proof_irrelevence : T = F.
 Proof.
 generalize not_has_fixpoint.
-unfold Not_b in |- *.
+unfold Not_b.
 apply AC_IF.
 intros is_true is_false.
 elim is_true; elim is_false; trivial.
diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v
index 60dbf3ea..1a32d518 100644
--- a/theories/Logic/ChoiceFacts.v
+++ b/theories/Logic/ChoiceFacts.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ChoiceFacts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Some facts and definitions concerning choice and description in
        intuitionistic logic.
 
@@ -346,7 +344,7 @@ Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice :
   RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice.
 Proof.
   intros rel_choice proof_irrel.
-  red in |- *; intros A B P R H.
+  red; intros A B P R H.
   destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as (R',(HR'R,H0)).
   intros (x,HPx).
   destruct (H x HPx) as (y,HRxy).
@@ -387,7 +385,7 @@ Qed.
 Lemma subset_types_imp_guarded_rel_choice_iff_rel_choice :
   ProofIrrelevance -> (GuardedRelationalChoice <-> RelationalChoice).
 Proof.
-  auto decomp using
+  intuition auto using
     guarded_rel_choice_imp_rel_choice,
     rel_choice_and_proof_irrel_imp_guarded_rel_choice.
 Qed.
@@ -441,7 +439,7 @@ Corollary fun_choice_and_indep_general_prem_iff_guarded_fun_choice :
   FunctionalChoiceOnInhabitedSet /\ IndependenceOfGeneralPremises
   <-> GuardedFunctionalChoice.
 Proof.
-  auto decomp using
+  intuition auto using
     guarded_fun_choice_imp_indep_of_general_premises,
     guarded_fun_choice_imp_fun_choice,
     fun_choice_and_indep_general_prem_imp_guarded_fun_choice.
@@ -482,7 +480,7 @@ Corollary fun_choice_and_small_drinker_iff_omniscient_fun_choice :
   FunctionalChoiceOnInhabitedSet /\ SmallDrinker'sParadox
   <-> OmniscientFunctionalChoice.
 Proof.
-  auto decomp using
+  intuition auto using
     omniscient_fun_choice_imp_small_drinker,
     omniscient_fun_choice_imp_fun_choice,
     fun_choice_and_small_drinker_imp_omniscient_fun_choice.
@@ -549,7 +547,7 @@ Theorem constructive_indefinite_description_and_small_drinker_iff_epsilon :
   (EpsilonStatement ->
    SmallDrinker'sParadox * ConstructiveIndefiniteDescription).
 Proof.
-  auto decomp using
+  intuition auto using
     epsilon_imp_constructive_indefinite_description,
     constructive_indefinite_description_and_small_drinker_imp_epsilon,
     epsilon_imp_small_drinker.
@@ -582,7 +580,7 @@ Lemma classical_denumerable_description_imp_fun_choice :
       (forall x y, decidable (R x y)) -> FunctionalChoice_on_rel R.
 Proof.
   intros A Descr.
-  red in |- *; intros R Rdec H.
+  red; intros R Rdec H.
   set (R':= fun x y => R x y /\ forall y', R x y' -> y <= y').
   destruct (Descr R') as (f,Hf).
   intro x.
@@ -691,7 +689,7 @@ Qed.
 Corollary dep_iff_non_dep_functional_rel_reification :
   FunctionalRelReification <-> DependentFunctionalRelReification.
 Proof.
-  auto decomp using
+  intuition auto using
     non_dep_dep_functional_rel_reification,
     dep_non_dep_functional_rel_reification.
 Qed.
@@ -816,9 +814,9 @@ Corollary fun_reification_descr_computational_excluded_middle_in_prop_context :
   (forall P:Prop, P \/ ~ P) ->
   forall C:Prop, ((forall P:Prop, {P} + {~ P}) -> C) -> C.
 Proof.
-  intros FunReify EM C; auto decomp using
-    constructive_definite_descr_excluded_middle,
-    (relative_non_contradiction_of_definite_descr (C:=C)).
+  intros FunReify EM C H.
+  apply relative_non_contradiction_of_definite_descr; trivial.
+  auto using constructive_definite_descr_excluded_middle.
 Qed.
 
 (**********************************************************************)
diff --git a/theories/Logic/Classical.v b/theories/Logic/Classical.v
index 3f36ff38..d25e0e21 100644
--- a/theories/Logic/Classical.v
+++ b/theories/Logic/Classical.v
@@ -1,12 +1,12 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(* File created for Coq V5.10.14b, Oct 1995 *)
 
 (** Classical Logic *)
 
diff --git a/theories/Logic/ClassicalChoice.v b/theories/Logic/ClassicalChoice.v
index 17b08a2f..479056c9 100644
--- a/theories/Logic/ClassicalChoice.v
+++ b/theories/Logic/ClassicalChoice.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalChoice.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file provides classical logic and functional choice; this
     especially provides both indefinite descriptions and choice functions
     but this is weaker than providing epsilon operator and classical logic
diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v
index ad454a4d..2fd6e68e 100644
--- a/theories/Logic/ClassicalDescription.v
+++ b/theories/Logic/ClassicalDescription.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalDescription.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file provides classical logic and definite description, which is
     equivalent to providing classical logic and Church's iota operator *)
 
@@ -18,13 +16,11 @@
 
 Set Implicit Arguments.
 
-Require Export Classical.
+Require Export Classical.   (* Axiomatize classical reasoning *)
+Require Export Description. (* Axiomatize constructive form of Church's iota *)
 Require Import ChoiceFacts.
 
-Notation Local inhabited A := A (only parsing).
-
-Axiom constructive_definite_description :
-  forall (A : Type) (P : A->Prop), (exists! x : A, P x) -> { x : A | P x }.
+Local Notation inhabited A := A (only parsing).
 
 (** The idea for the following proof comes from [ChicliPottierSimpson02] *)
 
diff --git a/theories/Logic/ClassicalEpsilon.v b/theories/Logic/ClassicalEpsilon.v
index 52ecadaf..7ab991f8 100644
--- a/theories/Logic/ClassicalEpsilon.v
+++ b/theories/Logic/ClassicalEpsilon.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalEpsilon.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file provides classical logic and indefinite description under
     the form of Hilbert's epsilon operator *)
 
diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v
index 5f4516dd..34ae1cd5 100644
--- a/theories/Logic/ClassicalFacts.v
+++ b/theories/Logic/ClassicalFacts.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalFacts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Some facts and definitions about classical logic
 
 Table of contents:
@@ -119,7 +117,7 @@ Qed.
 
 *)
 
-Notation Local inhabited A := A (only parsing).
+Local Notation inhabited A := A (only parsing).
 
 Lemma prop_ext_A_eq_A_imp_A :
   prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A.
@@ -150,7 +148,7 @@ Proof.
   case (prop_ext_retract_A_A_imp_A Ext A a); intros g1 g2 g1_o_g2.
   exists (fun f => (fun x:A => f (g1 x x)) (g2 (fun x => f (g1 x x)))).
   intro f.
-  pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1 in |- *.
+  pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1.
   rewrite (g1_o_g2 (fun x:A => f (g1 x x))).
   reflexivity.
 Qed.
@@ -193,13 +191,13 @@ Section Proof_irrelevance_gen.
     intros Ext Ind.
     case (ext_prop_fixpoint Ext bool true); intros G Gfix.
     set (neg := fun b:bool => bool_elim bool false true b).
-    generalize (refl_equal (G neg)).
-    pattern (G neg) at 1 in |- *.
+    generalize (eq_refl (G neg)).
+    pattern (G neg) at 1.
     apply Ind with (b := G neg); intro Heq.
     rewrite (bool_elim_redl bool false true).
-    change (true = neg true) in |- *; rewrite Heq; apply Gfix.
+    change (true = neg true); rewrite Heq; apply Gfix.
     rewrite (bool_elim_redr bool false true).
-    change (neg false = false) in |- *; rewrite Heq; symmetry  in |- *;
+    change (neg false = false); rewrite Heq; symmetry ;
       apply Gfix.
   Qed.
 
@@ -209,9 +207,9 @@ Section Proof_irrelevance_gen.
     intros Ext Ind A a1 a2.
     set (f := fun b:bool => bool_elim A a1 a2 b).
     rewrite (bool_elim_redl A a1 a2).
-    change (f true = a2) in |- *.
+    change (f true = a2).
     rewrite (bool_elim_redr A a1 a2).
-    change (f true = f false) in |- *.
+    change (f true = f false).
     rewrite (aux Ext Ind).
     reflexivity.
   Qed.
@@ -230,9 +228,9 @@ Section Proof_irrelevance_Prop_Ext_CC.
   Definition FalseP : BoolP := fun C c1 c2 => c2.
   Definition BoolP_elim C c1 c2 (b:BoolP) := b C c1 c2.
   Definition BoolP_elim_redl (C:Prop) (c1 c2:C) :
-    c1 = BoolP_elim C c1 c2 TrueP := refl_equal c1.
+    c1 = BoolP_elim C c1 c2 TrueP := eq_refl c1.
   Definition BoolP_elim_redr (C:Prop) (c1 c2:C) :
-    c2 = BoolP_elim C c1 c2 FalseP := refl_equal c2.
+    c2 = BoolP_elim C c1 c2 FalseP := eq_refl c2.
 
   Definition BoolP_dep_induction :=
     forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall b:BoolP, P b.
@@ -265,9 +263,9 @@ Section Proof_irrelevance_CIC.
     | trueP : boolP
     | falseP : boolP.
   Definition boolP_elim_redl (C:Prop) (c1 c2:C) :
-    c1 = boolP_ind C c1 c2 trueP := refl_equal c1.
+    c1 = boolP_ind C c1 c2 trueP := eq_refl c1.
   Definition boolP_elim_redr (C:Prop) (c1 c2:C) :
-    c2 = boolP_ind C c1 c2 falseP := refl_equal c2.
+    c2 = boolP_ind C c1 c2 falseP := eq_refl c2.
   Scheme boolP_indd := Induction for boolP Sort Prop.
 
   Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance.
@@ -346,8 +344,8 @@ Section Proof_irrelevance_EM_CC.
 
   Lemma p2p1 : forall A:Prop, A -> b2p (p2b A).
   Proof.
-    unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A);
-      unfold b2p in |- *; intros.
+    unfold p2b; intro A; apply or_dep_elim with (b := em A);
+      unfold b2p; intros.
     apply (or_elim_redl A (~ A) B (fun _ => b1) (fun _ => b2)).
     destruct (b H).
   Qed.
@@ -355,8 +353,8 @@ Section Proof_irrelevance_EM_CC.
   Lemma p2p2 : b1 <> b2 -> forall A:Prop, b2p (p2b A) -> A.
   Proof.
     intro not_eq_b1_b2.
-    unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A);
-      unfold b2p in |- *; intros.
+    unfold p2b; intro A; apply or_dep_elim with (b := em A);
+      unfold b2p; intros.
     assumption.
     destruct not_eq_b1_b2.
     rewrite <- (or_elim_redr A (~ A) B (fun _ => b1) (fun _ => b2)) in H.
@@ -394,9 +392,9 @@ Section Proof_irrelevance_CCI.
   Hypothesis em : forall A:Prop, A \/ ~ A.
 
   Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C)
-    (a:A) : f a = or_ind f g (or_introl B a) := refl_equal (f a).
+    (a:A) : f a = or_ind f g (or_introl B a) := eq_refl (f a).
   Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C)
-    (b:B) : g b = or_ind f g (or_intror A b) := refl_equal (g b).
+    (b:B) : g b = or_ind f g (or_intror A b) := eq_refl (g b).
   Scheme or_indd := Induction for or Sort Prop.
 
   Theorem proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), b1 = b2.
diff --git a/theories/Logic/ClassicalUniqueChoice.v b/theories/Logic/ClassicalUniqueChoice.v
index fafa0b94..4a4fc23f 100644
--- a/theories/Logic/ClassicalUniqueChoice.v
+++ b/theories/Logic/ClassicalUniqueChoice.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalUniqueChoice.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file provides classical logic and unique choice; this is
     weaker than providing iota operator and classical logic as the
     definite descriptions provided by the axiom of unique choice can
diff --git a/theories/Logic/Classical_Pred_Set.v b/theories/Logic/Classical_Pred_Set.v
index 06502d63..cda9d22c 100644
--- a/theories/Logic/Classical_Pred_Set.v
+++ b/theories/Logic/Classical_Pred_Set.v
@@ -1,12 +1,13 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical_Pred_Set.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(* File created for Coq V5.10.14b, Oct 1995, by duplication of
+   Classical_Pred_Type.v *)
 
 (** This file is obsolete, use Classical_Pred_Type.v via Classical.v
 instead *)
diff --git a/theories/Logic/Classical_Pred_Type.v b/theories/Logic/Classical_Pred_Type.v
index bcd529f0..7e1a4096 100644
--- a/theories/Logic/Classical_Pred_Type.v
+++ b/theories/Logic/Classical_Pred_Type.v
@@ -1,12 +1,13 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical_Pred_Type.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(* This file is a renaming for V5.10.14b, Oct 1995, of file Classical.v
+   introduced in Coq V5.8.3, June 1993 *)
 
 (** Classical Predicate Logic on Type *)
 
@@ -41,7 +42,7 @@ Qed.
 Lemma not_ex_all_not :
  forall P:U -> Prop, ~ (exists n : U, P n) -> forall n:U, ~ P n.
 Proof. (* Intuitionistic *)
-unfold not in |- *; intros P notex n abs.
+unfold not; intros P notex n abs.
 apply notex.
 exists n; trivial.
 Qed.
@@ -51,20 +52,20 @@ Lemma not_ex_not_all :
 Proof.
 intros P H n.
 apply NNPP.
-red in |- *; intro K; apply H; exists n; trivial.
+red; intro K; apply H; exists n; trivial.
 Qed.
 
 Lemma ex_not_not_all :
  forall P:U -> Prop, (exists n : U, ~ P n) -> ~ (forall n:U, P n).
 Proof. (* Intuitionistic *)
-unfold not in |- *; intros P exnot allP.
+unfold not; intros P exnot allP.
 elim exnot; auto.
 Qed.
 
 Lemma all_not_not_ex :
  forall P:U -> Prop, (forall n:U, ~ P n) -> ~ (exists n : U, P n).
 Proof. (* Intuitionistic *)
-unfold not in |- *; intros P allnot exP; elim exP; intros n p.
+unfold not; intros P allnot exP; elim exP; intros n p.
 apply allnot with n; auto.
 Qed.
 
diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v
index c51050d5..1f6b05f5 100644
--- a/theories/Logic/Classical_Prop.v
+++ b/theories/Logic/Classical_Prop.v
@@ -1,12 +1,14 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical_Prop.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(* File created for Coq V5.10.14b, Oct 1995 *)
+(* Classical tactics for proving disjunctions by Julien Narboux, Jul 2005 *)
+(* Inferred proof-irrelevance and eq_rect_eq added by Hugo Herbelin, Mar 2006 *)
 
 (** Classical Propositional Logic *)
 
@@ -18,7 +20,7 @@ Axiom classic : forall P:Prop, P \/ ~ P.
 
 Lemma NNPP : forall p:Prop, ~ ~ p -> p.
 Proof.
-unfold not in |- *; intros; elim (classic p); auto.
+unfold not; intros; elim (classic p); auto.
 intro NP; elim (H NP).
 Qed.
 
@@ -33,7 +35,7 @@ Qed.
 
 Lemma not_imply_elim : forall P Q:Prop, ~ (P -> Q) -> P.
 Proof.
-intros; apply NNPP; red in |- *.
+intros; apply NNPP; red.
 intro; apply H; intro; absurd P; trivial.
 Qed.
 
@@ -66,7 +68,7 @@ Qed.
 
 Lemma or_not_and : forall P Q:Prop, ~ P \/ ~ Q -> ~ (P /\ Q).
 Proof.
-simple induction 1; red in |- *; simple induction 2; auto.
+simple induction 1; red; simple induction 2; auto.
 Qed.
 
 Lemma not_or_and : forall P Q:Prop, ~ (P \/ Q) -> ~ P /\ ~ Q.
@@ -110,7 +112,7 @@ Module Eq_rect_eq.
 Lemma eq_rect_eq :
   forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
 Proof.
-intros; rewrite proof_irrelevance with (p1:=h) (p2:=refl_equal p); reflexivity.
+intros; rewrite proof_irrelevance with (p1:=h) (p2:=eq_refl p); reflexivity.
 Qed.
 
 End Eq_rect_eq.
diff --git a/theories/Logic/Classical_Type.v b/theories/Logic/Classical_Type.v
index 94e623bd..86fdd69f 100644
--- a/theories/Logic/Classical_Type.v
+++ b/theories/Logic/Classical_Type.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical_Type.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file is obsolete, use Classical.v instead *)
 
 (** Classical Logic for Type *)
diff --git a/theories/Logic/ConstructiveEpsilon.v b/theories/Logic/ConstructiveEpsilon.v
index 004fdef3..89d3eebc 100644
--- a/theories/Logic/ConstructiveEpsilon.v
+++ b/theories/Logic/ConstructiveEpsilon.v
@@ -1,26 +1,25 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ConstructiveEpsilon.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(*i $Id: ConstructiveEpsilon.v 15714 2012-08-08 18:54:37Z herbelin $ i*)
 
-(*i $Id: ConstructiveEpsilon.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-(** This module proves the constructive description schema, which
-infers the sigma-existence (i.e., [Set]-existence) of a witness to a
-predicate from the regular existence (i.e., [Prop]-existence). One
-requires that the underlying set is countable and that the predicate
-is decidable. *)
+(** This provides with a proof of the constructive form of definite
+and indefinite descriptions for Sigma^0_1-formulas (hereafter called
+"small" formulas), which infers the sigma-existence (i.e.,
+[Type]-existence) of a witness to a decidable predicate over a
+countable domain from the regular existence (i.e.,
+[Prop]-existence). *)
 
 (** Coq does not allow case analysis on sort [Prop] when the goal is in
-[Set]. Therefore, one cannot eliminate [exists n, P n] in order to
+not in [Prop]. Therefore, one cannot eliminate [exists n, P n] in order to
 show [{n : nat | P n}]. However, one can perform a recursion on an
 inductive predicate in sort [Prop] so that the returning type of the
-recursion is in [Set]. This trick is described in Coq'Art book, Sect.
+recursion is in [Type]. This trick is described in Coq'Art book, Sect.
 14.2.3 and 15.4. In particular, this trick is used in the proof of
 [Fix_F] in the module Coq.Init.Wf. There, recursion is done on an
 inductive predicate [Acc] and the resulting type is in [Type].
@@ -41,7 +40,7 @@ For the first one we provide explicit and short proof terms. *)
 
 (* Direct version *)
 
-Section ConstructiveIndefiniteDescription_Direct.
+Section ConstructiveIndefiniteGroundDescription_Direct.
 
 Variable P : nat -> Prop.
 
@@ -79,11 +78,11 @@ Fixpoint linear_search m (b : before_witness m) : {n : nat | P n} :=
     | right no => linear_search (S m) (inv_before_witness m b no)
   end.
 
-Definition constructive_indefinite_description_nat :
+Definition constructive_indefinite_ground_description_nat :
   (exists n, P n) -> {n:nat | P n} :=
   fun e => linear_search O (let (n, p) := e in O_witness n (stop n p)).
 
-End ConstructiveIndefiniteDescription_Direct.
+End ConstructiveIndefiniteGroundDescription_Direct.
 
 (************************************************************************)
 
@@ -91,7 +90,7 @@ End ConstructiveIndefiniteDescription_Direct.
 
 Require Import Arith.
 
-Section ConstructiveIndefiniteDescription_Acc.
+Section ConstructiveIndefiniteGroundDescription_Acc.
 
 Variable P : nat -> Prop.
 
@@ -113,7 +112,7 @@ of our searching algorithm. *)
 
 Let R (x y : nat) : Prop := x = S y /\ ~ P y.
 
-Notation Local acc x := (Acc R x).
+Local Notation acc x := (Acc R x).
 
 Lemma P_implies_acc : forall x : nat, P x -> acc x.
 Proof.
@@ -151,40 +150,40 @@ destruct (IH y Ryx) as [n Hn].
 exists n; assumption.
 Defined.
 
-Theorem constructive_indefinite_description_nat_Acc :
+Theorem constructive_indefinite_ground_description_nat_Acc :
   (exists n : nat, P n) -> {n : nat | P n}.
 Proof.
 intros H; apply acc_implies_P_eventually.
 apply P_eventually_implies_acc_ex; assumption.
 Defined.
 
-End ConstructiveIndefiniteDescription_Acc.
+End ConstructiveIndefiniteGroundDescription_Acc.
 
 (************************************************************************)
 
-Section ConstructiveEpsilon_nat.
+Section ConstructiveGroundEpsilon_nat.
 
 Variable P : nat -> Prop.
 
 Hypothesis P_decidable : forall x : nat, {P x} + {~ P x}.
 
-Definition constructive_epsilon_nat (E : exists n : nat, P n) : nat
-  := proj1_sig (constructive_indefinite_description_nat P P_decidable E).
+Definition constructive_ground_epsilon_nat (E : exists n : nat, P n) : nat
+  := proj1_sig (constructive_indefinite_ground_description_nat P P_decidable E).
 
-Definition constructive_epsilon_spec_nat (E : (exists n, P n)) : P (constructive_epsilon_nat E)
-  := proj2_sig (constructive_indefinite_description_nat P P_decidable E).
+Definition constructive_ground_epsilon_spec_nat (E : (exists n, P n)) : P (constructive_ground_epsilon_nat E)
+  := proj2_sig (constructive_indefinite_ground_description_nat P P_decidable E).
 
-End ConstructiveEpsilon_nat.
+End ConstructiveGroundEpsilon_nat.
 
 (************************************************************************)
 
-Section ConstructiveEpsilon.
+Section ConstructiveGroundEpsilon.
 
 (** For the current purpose, we say that a set [A] is countable if
 there are functions [f : A -> nat] and [g : nat -> A] such that [g] is
 a left inverse of [f]. *)
 
-Variable A : Set.
+Variable A : Type.
 Variable f : A -> nat.
 Variable g : nat -> A.
 
@@ -201,24 +200,43 @@ Proof.
 intro n; unfold P'; destruct (P_decidable (g n)); auto.
 Defined.
 
-Lemma constructive_indefinite_description : (exists x : A, P x) -> {x : A | P x}.
+Lemma constructive_indefinite_ground_description : (exists x : A, P x) -> {x : A | P x}.
 Proof.
 intro H. assert (H1 : exists n : nat, P' n).
 destruct H as [x Hx]. exists (f x); unfold P'. rewrite gof_eq_id; assumption.
-apply (constructive_indefinite_description_nat P' P'_decidable)  in H1.
+apply (constructive_indefinite_ground_description_nat P' P'_decidable)  in H1.
 destruct H1 as [n Hn]. exists (g n); unfold P' in Hn; assumption.
 Defined.
 
-Lemma constructive_definite_description : (exists! x : A, P x) -> {x : A | P x}.
+Lemma constructive_definite_ground_description : (exists! x : A, P x) -> {x : A | P x}.
 Proof.
-  intros; apply constructive_indefinite_description; firstorder.
+  intros; apply constructive_indefinite_ground_description; firstorder.
 Defined.
 
-Definition constructive_epsilon (E : exists x : A, P x) : A
-  := proj1_sig (constructive_indefinite_description E).
-
-Definition constructive_epsilon_spec (E : (exists x, P x)) : P (constructive_epsilon E)
-  := proj2_sig (constructive_indefinite_description E).
-
-End ConstructiveEpsilon.
-
+Definition constructive_ground_epsilon (E : exists x : A, P x) : A
+  := proj1_sig (constructive_indefinite_ground_description E).
+
+Definition constructive_ground_epsilon_spec (E : (exists x, P x)) : P (constructive_ground_epsilon E)
+  := proj2_sig (constructive_indefinite_ground_description E).
+
+End ConstructiveGroundEpsilon.
+
+(* begin hide *)
+(* Compatibility: the qualificative "ground" was absent from the initial
+names of the results in this file but this had introduced confusion
+with the similarly named statement in Description.v *)
+Notation constructive_indefinite_description_nat :=
+  constructive_indefinite_ground_description_nat (only parsing).
+Notation constructive_epsilon_spec_nat :=
+  constructive_ground_epsilon_spec_nat (only parsing).
+Notation constructive_epsilon_nat :=
+  constructive_ground_epsilon_nat (only parsing).
+Notation constructive_indefinite_description :=
+  constructive_indefinite_ground_description (only parsing).
+Notation constructive_definite_description :=
+  constructive_definite_ground_description (only parsing).
+Notation constructive_epsilon_spec :=
+  constructive_ground_epsilon_spec (only parsing).
+Notation constructive_epsilon :=
+  constructive_ground_epsilon (only parsing).
+(* end hide *)
diff --git a/theories/Logic/Decidable.v b/theories/Logic/Decidable.v
index ace50884..aaf1813b 100644
--- a/theories/Logic/Decidable.v
+++ b/theories/Logic/Decidable.v
@@ -1,12 +1,10 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Decidable.v 14641 2011-11-06 11:59:10Z herbelin $	 i*)
-
 (** Properties of decidable propositions *)
 
 Definition decidable (P:Prop) := P \/ ~ P.
diff --git a/theories/Logic/Description.v b/theories/Logic/Description.v
index c59d8460..3e5d4ef0 100644
--- a/theories/Logic/Description.v
+++ b/theories/Logic/Description.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Description.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file provides a constructive form of definite description; it
     allows to build functions from the proof of their existence in any
     context; this is weaker than Church's iota operator *)
diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v
index 257245cc..87b27987 100644
--- a/theories/Logic/Diaconescu.v
+++ b/theories/Logic/Diaconescu.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Diaconescu.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Diaconescu showed that the Axiom of Choice entails Excluded-Middle
    in topoi [Diaconescu75]. Lacas and Werner adapted the proof to show
    that the axiom of choice in equivalence classes entails
@@ -63,7 +61,7 @@ Variable pred_extensionality : PredicateExtensionality.
 Lemma prop_ext : forall A B:Prop, (A <-> B) -> A = B.
 Proof.
   intros A B H.
-  change ((fun _ => A) true = (fun _ => B) true) in |- *.
+  change ((fun _ => A) true = (fun _ => B) true).
   rewrite
    pred_extensionality with (P := fun _:bool => A) (Q := fun _:bool => B).
     reflexivity.
@@ -136,8 +134,8 @@ right.
 intro HP.
 assert (Hequiv : forall b:bool, class_of_true b <-> class_of_false b).
 intro b; split.
-unfold class_of_false in |- *; right; assumption.
-unfold class_of_true in |- *; right; assumption.
+unfold class_of_false; right; assumption.
+unfold class_of_true; right; assumption.
 assert (Heq : class_of_true = class_of_false).
 apply pred_extensionality with (1 := Hequiv).
 apply diff_true_false.
@@ -158,8 +156,8 @@ End PredExt_RelChoice_imp_EM.
 (**********************************************************************)
 (** * B. Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *)
 
-(** This is an adaptation of Diaconescu's paradox exploiting that
-    proof-irrelevance is some form of extensionality *)
+(** This is an adaptation of Diaconescu's theorem, exploiting the
+    form of extensionality provided by proof-irrelevance *)
 
 Section ProofIrrel_RelChoice_imp_EqEM.
 
@@ -190,8 +188,8 @@ Lemma projT1_injective : a1=a2 -> a1'=a2'.
 Proof.
   intro Heq ; unfold a1', a2', A'.
   rewrite Heq.
-  replace (or_introl (a2=a2) (refl_equal a2))
-     with (or_intror (a2=a2) (refl_equal a2)).
+  replace (or_introl (a2=a2) (eq_refl a2))
+     with (or_intror (a2=a2) (eq_refl a2)).
   reflexivity.
   apply proof_irrelevance.
 Qed.
@@ -267,7 +265,7 @@ End ProofIrrel_RelChoice_imp_EqEM.
 
 (** Proof sketch from Bell [Bell93] (with thanks to P. Castéran) *)
 
-Notation Local inhabited A := A (only parsing).
+Local Notation inhabited A := A (only parsing).
 
 Section ExtensionalEpsilon_imp_EM.
 
@@ -281,7 +279,7 @@ Hypothesis epsilon_extensionality :
   forall (A:Type) (i:inhabited A) (P Q:A->Prop),
   (forall a, P a <-> Q a) -> epsilon A i P = epsilon A i Q.
 
-Notation Local eps := (epsilon bool true) (only parsing).
+Local Notation eps := (epsilon bool true) (only parsing).
 
 Theorem extensional_epsilon_imp_EM : forall P:Prop, P \/ ~ P.
 Proof.
diff --git a/theories/Logic/Epsilon.v b/theories/Logic/Epsilon.v
index 9134b3aa..da3e5b08 100644
--- a/theories/Logic/Epsilon.v
+++ b/theories/Logic/Epsilon.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Epsilon.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file provides indefinite description under the form of
     Hilbert's epsilon operator; it does not assume classical logic. *)
 
diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v
index 7918061c..6841334f 100644
--- a/theories/Logic/Eqdep.v
+++ b/theories/Logic/Eqdep.v
@@ -1,13 +1,15 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Eqdep.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(* File Eqdep.v created by Christine Paulin-Mohring in Coq V5.6, May 1992 *)
+(* Abstraction with respect to the eq_rect_eq axiom and creation of
+   EqdepFacts.v by Hugo Herbelin, Mar 2006 *)
 
 (** This file axiomatizes the invariance by substitution of reflexive
     equality proofs [[Streicher93]] and exports its consequences, such
diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v
index 2d5f1537..a22f286e 100644
--- a/theories/Logic/EqdepFacts.v
+++ b/theories/Logic/EqdepFacts.v
@@ -1,13 +1,17 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: EqdepFacts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(* File Eqdep.v created by Christine Paulin-Mohring in Coq V5.6, May 1992 *)
+(* Further documentation and variants of eq_rect_eq by Hugo Herbelin,
+   Apr 2003 *)
+(* Abstraction with respect to the eq_rect_eq axiom and renaming to
+   EqdepFacts.v by Hugo Herbelin, Mar 2006 *)
 
 (** This file defines dependent equality and shows its equivalence with
     equality on dependent pairs (inhabiting sigma-types). It derives
@@ -33,7 +37,8 @@
 
 Table of contents:
 
-1. Definition of dependent equality and equivalence with equality
+1. Definition of dependent equality and equivalence with equality of
+   dependent pairs and with dependent pair of equalities
 
 2. Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K
 
@@ -45,6 +50,8 @@ Table of contents:
 (************************************************************************)
 (** * Definition of dependent equality and equivalence with equality of dependent pairs *)
 
+Import EqNotations.
+
 Section Dependent_Equality.
 
   Variable U : Type.
@@ -75,11 +82,11 @@ Section Dependent_Equality.
 
   Scheme eq_indd := Induction for eq Sort Prop.
 
-  (** Equivalent definition of dependent equality expressed as a non
-      dependent inductive type *)
+  (** Equivalent definition of dependent equality as a dependent pair of
+      equalities *)
 
   Inductive eq_dep1 (p:U) (x:P p) (q:U) (y:P q) : Prop :=
-    eq_dep1_intro : forall h:q = p, x = eq_rect q P y p h -> eq_dep1 p x q y.
+    eq_dep1_intro : forall h:q = p, x = rew h in y -> eq_dep1 p x q y.
 
   Lemma eq_dep1_dep :
     forall (p:U) (x:P p) (q:U) (y:P q), eq_dep1 p x q y -> eq_dep p x q y.
@@ -94,14 +101,14 @@ Section Dependent_Equality.
     forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep1 p x q y.
   Proof.
     destruct 1.
-    apply eq_dep1_intro with (refl_equal p).
-    simpl in |- *; trivial.
+    apply eq_dep1_intro with (eq_refl p).
+    simpl; trivial.
   Qed.
 
 End Dependent_Equality.
 
-Implicit Arguments eq_dep [U P].
-Implicit Arguments eq_dep1 [U P].
+Arguments eq_dep  [U P] p x q _.
+Arguments eq_dep1 [U P] p x q y.
 
 (** Dependent equality is equivalent to equality on dependent pairs *)
 
@@ -114,26 +121,105 @@ Proof.
   apply eq_dep_intro.
 Qed.
 
-Notation eq_sigS_eq_dep := eq_sigT_eq_dep (only parsing). (* Compatibility *)
+Notation eq_sigS_eq_dep := eq_sigT_eq_dep (compat "8.2"). (* Compatibility *)
 
-Lemma equiv_eqex_eqdep :
+Lemma eq_dep_eq_sigT :
   forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q),
-   existT P p x = existT P q y <-> eq_dep p x q y.
+    eq_dep p x q y -> existT P p x = existT P q y.
 Proof.
-  split.
-  (* -> *)
-  apply eq_sigT_eq_dep.
-  (* <- *)
   destruct 1; reflexivity.
 Qed.
 
-Lemma eq_dep_eq_sigT :
+Lemma eq_sigT_iff_eq_dep :
   forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q),
-    eq_dep p x q y -> existT P p x = existT P q y.
+    existT P p x = existT P q y <-> eq_dep p x q y.
+Proof.
+  split; auto using eq_sigT_eq_dep, eq_dep_eq_sigT.
+Qed.
+
+Notation equiv_eqex_eqdep := eq_sigT_iff_eq_dep (only parsing). (* Compat *)
+
+Lemma eq_sig_eq_dep :
+  forall (U:Prop) (P:U -> Prop) (p q:U) (x:P p) (y:P q),
+    exist P p x = exist P q y -> eq_dep p x q y.
+Proof.
+  intros.
+  dependent rewrite H.
+  apply eq_dep_intro.
+Qed.
+
+Lemma eq_dep_eq_sig :
+  forall (U:Prop) (P:U -> Prop) (p q:U) (x:P p) (y:P q),
+    eq_dep p x q y -> exist P p x = exist P q y.
 Proof.
   destruct 1; reflexivity.
 Qed.
 
+Lemma eq_sig_iff_eq_dep :
+  forall (U:Prop) (P:U -> Prop) (p q:U) (x:P p) (y:P q),
+    exist P p x = exist P q y <-> eq_dep p x q y.
+Proof.
+  split; auto using eq_sig_eq_dep, eq_dep_eq_sig.
+Qed.
+
+(** Dependent equality is equivalent to a dependent pair of equalities *)
+
+Set Implicit Arguments.
+
+Lemma eq_sigT_sig_eq : forall X P (x1 x2:X) H1 H2, existT P x1 H1 = existT P x2 H2 <-> {H:x1=x2 | rew H in H1 = H2}.
+Proof.
+  intros; split; intro H.
+  - change x2 with (projT1 (existT P x2 H2)).
+    change H2 with (projT2 (existT P x2 H2)) at 5.
+    destruct H. simpl.
+    exists eq_refl.
+    reflexivity.
+  - destruct H as (->,<-).
+    reflexivity.
+Defined.
+
+Lemma eq_sigT_fst :
+  forall X P (x1 x2:X) H1 H2 (H:existT P x1 H1 = existT P x2 H2), x1 = x2.
+Proof.
+  intros.
+  change x2 with (projT1 (existT P x2 H2)).
+  destruct H.
+  reflexivity.
+Defined.
+
+Lemma eq_sigT_snd :
+  forall X P (x1 x2:X) H1 H2 (H:existT P x1 H1 = existT P x2 H2), rew (eq_sigT_fst H) in H1 = H2.
+Proof.
+  intros.
+  unfold eq_sigT_fst.
+  change x2 with (projT1 (existT P x2 H2)).
+  change H2 with (projT2 (existT P x2 H2)) at 3.
+  destruct H.
+  reflexivity.
+Defined.
+
+Lemma eq_sig_fst :
+  forall X P (x1 x2:X) H1 H2 (H:exist P x1 H1 = exist P x2 H2), x1 = x2.
+Proof.
+  intros.
+  change x2 with (proj1_sig (exist P x2 H2)).
+  destruct H.
+  reflexivity.
+Defined.
+
+Lemma eq_sig_snd :
+  forall X P (x1 x2:X) H1 H2 (H:exist P x1 H1 = exist P x2 H2), rew (eq_sig_fst H) in H1 = H2.
+Proof.
+  intros.
+  unfold eq_sig_fst, eq_ind.
+  change x2 with (proj1_sig (exist P x2 H2)).
+  change H2 with (proj2_sig (exist P x2 H2)) at 3.
+  destruct H.
+  reflexivity.
+Defined.
+
+Unset Implicit Arguments.
+
 (** Exported hints *)
 
 Hint Resolve eq_dep_intro: core.
@@ -164,12 +250,12 @@ Section Equivalences.
   (** Uniqueness of Reflexive Identity Proofs *)
 
   Definition UIP_refl_ :=
-    forall (x:U) (p:x = x), p = refl_equal x.
+    forall (x:U) (p:x = x), p = eq_refl x.
 
   (** Streicher's axiom K *)
 
   Definition Streicher_K_ :=
-    forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+    forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p.
 
   (** Injectivity of Dependent Equality is a consequence of *)
   (** Invariance by Substitution of Reflexive Equality Proof *)
@@ -303,14 +389,14 @@ Proof (eq_dep_eq__UIP U eq_dep_eq).
 
 (** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *)
 
-Lemma UIP_refl : forall (x:U) (p:x = x), p = refl_equal x.
+Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x.
 Proof (UIP__UIP_refl U UIP).
 
 (** Streicher's axiom K is a direct consequence of Uniqueness of
     Reflexive Identity Proofs *)
 
 Lemma Streicher_K :
-  forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+  forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p.
 Proof (UIP_refl__Streicher_K U UIP_refl).
 
 End Axioms.
@@ -326,5 +412,5 @@ Notation inj_pairT2 := inj_pair2.
 
 End EqdepTheory.
 
-Implicit Arguments eq_dep [].
-Implicit Arguments eq_dep1 [].
+Arguments eq_dep  U P p x q _ : clear implicits.
+Arguments eq_dep1 U P p x q y : clear implicits.
diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v
index 77908b08..3a6f6a23 100644
--- a/theories/Logic/Eqdep_dec.v
+++ b/theories/Logic/Eqdep_dec.v
@@ -1,14 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Eqdep_dec.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(* Created by Bruno Barras, Jan 1998 *)
+(* Made a module instance for EqdepFacts by Hugo Herbelin, Mar 2006 *)
 
-(** We prove that there is only one proof of [x=x], i.e [refl_equal x].
+(** We prove that there is only one proof of [x=x], i.e [eq_refl x].
     This holds if the equality upon the set of [x] is decidable.
     A corollary of this theorem is the equality of the right projections
     of two equal dependent pairs.
@@ -42,7 +43,7 @@ Section EqdepDec.
   Let comp (x y y':A) (eq1:x = y) (eq2:x = y') : y = y' :=
     eq_ind _ (fun a => a = y') eq2 _ eq1.
 
-  Remark trans_sym_eq : forall (x y:A) (u:x = y), comp u u = refl_equal y.
+  Remark trans_sym_eq : forall (x y:A) (u:x = y), comp u u = eq_refl y.
   Proof.
     intros.
     case u; trivial.
@@ -60,7 +61,7 @@ Section EqdepDec.
 
   Let nu_constant : forall (y:A) (u v:x = y), nu u = nu v.
     intros.
-    unfold nu in |- *.
+    unfold nu.
     case (eq_dec x y); intros.
     reflexivity.
 
@@ -68,13 +69,13 @@ Section EqdepDec.
   Qed.
 
 
-  Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (refl_equal x)) v.
+  Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (eq_refl x)) v.
 
 
   Remark nu_left_inv : forall (y:A) (u:x = y), nu_inv (nu u) = u.
   Proof.
     intros.
-    case u; unfold nu_inv in |- *.
+    case u; unfold nu_inv.
     apply trans_sym_eq.
   Qed.
 
@@ -89,10 +90,10 @@ Section EqdepDec.
   Qed.
 
   Theorem K_dec :
-    forall P:x = x -> Prop, P (refl_equal x) -> forall p:x = x, P p.
+    forall P:x = x -> Prop, P (eq_refl x) -> forall p:x = x, P p.
   Proof.
     intros.
-    elim eq_proofs_unicity with x (refl_equal x) p.
+    elim eq_proofs_unicity with x (eq_refl x) p.
     trivial.
   Qed.
 
@@ -114,7 +115,7 @@ Section EqdepDec.
   Proof.
     intros.
     cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y).
-    simpl in |- *.
+    simpl.
     case (eq_dec x x).
     intro e.
     elim e using K_dec; trivial.
@@ -134,7 +135,7 @@ Require Import EqdepFacts.
 Theorem K_dec_type :
   forall A:Type,
     (forall x y:A, {x = y} + {x <> y}) ->
-    forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+    forall (x:A) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p.
 Proof.
   intros A eq_dec x P H p.
   elim p using K_dec; intros.
@@ -145,7 +146,7 @@ Qed.
 Theorem K_dec_set :
   forall A:Set,
     (forall x y:A, {x = y} + {x <> y}) ->
-    forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+    forall (x:A) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p.
 Proof fun A => K_dec_type (A:=A).
 
 (** We deduce the [eq_rect_eq] axiom for (decidable) types *)
@@ -211,13 +212,13 @@ Module DecidableEqDep (M:DecidableType).
 
   (** Uniqueness of Reflexive Identity Proofs *)
 
-  Lemma UIP_refl : forall (x:U) (p:x = x), p = refl_equal x.
+  Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x.
   Proof (UIP__UIP_refl U UIP).
 
   (** Streicher's axiom K *)
 
   Lemma Streicher_K :
-    forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+    forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p.
   Proof (K_dec_type eq_dec).
 
   (** Injectivity of equality on dependent pairs in [Type] *)
@@ -280,13 +281,13 @@ Module DecidableEqDepSet (M:DecidableSet).
 
   (** Uniqueness of Reflexive Identity Proofs *)
 
-  Lemma UIP_refl : forall (x:U) (p:x = x), p = refl_equal x.
+  Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x.
   Proof N.UIP_refl.
 
   (** Streicher's axiom K *)
 
   Lemma Streicher_K :
-    forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+    forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p.
   Proof N.Streicher_K.
 
   (** Proof-irrelevance on subsets of decidable sets *)
@@ -300,7 +301,7 @@ Module DecidableEqDepSet (M:DecidableSet).
 
   Lemma inj_pair2 :
     forall (P:U -> Type) (p:U) (x y:P p),
-      existS P p x = existS P p y -> x = y.
+      existT P p x = existT P p y -> x = y.
   Proof eq_dep_eq__inj_pair2 U N.eq_dep_eq.
 
   (** Injectivity of equality on dependent pairs with second component
diff --git a/theories/Logic/ExtensionalityFacts.v b/theories/Logic/ExtensionalityFacts.v
new file mode 100644
index 00000000..9cbf756d
--- /dev/null
+++ b/theories/Logic/ExtensionalityFacts.v
@@ -0,0 +1,136 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Some facts and definitions about extensionality
+
+We investigate the relations between the following extensionality principles
+
+- Functional extensionality
+- Equality of projections from diagonal
+- Unicity of inverse bijections
+- Bijectivity of bijective composition
+
+Table of contents
+
+1. Definitions
+
+2. Functional extensionality <-> Equality of projections from diagonal
+
+3. Functional extensionality <-> Unicity of inverse bijections
+
+4. Functional extensionality <-> Bijectivity of bijective composition
+
+*)
+
+Set Implicit Arguments.
+
+(**********************************************************************)
+(** * Definitions *)
+
+(** Being an inverse *)
+
+Definition is_inverse A B f g := (forall a:A, g (f a) = a) /\ (forall b:B, f (g b) = b).
+
+(** The diagonal over A and the one-one correspondence with A *)
+
+Record Delta A := { pi1:A; pi2:A; eq:pi1=pi2 }.
+
+Definition delta {A} (a:A) := {|pi1 := a; pi2 := a; eq := eq_refl a |}.
+
+Arguments pi1 {A} _.
+Arguments pi2 {A} _.
+
+Lemma diagonal_projs_same_behavior : forall A (x:Delta A), pi1 x = pi2 x.
+Proof.
+  destruct x as (a1,a2,Heq); assumption.
+Qed.
+
+Lemma diagonal_inverse1 : forall A, is_inverse (A:=A) delta pi1.
+Proof.
+  split; [trivial|]; destruct b as (a1,a2,[]); reflexivity.
+Qed.
+
+Lemma diagonal_inverse2 : forall A, is_inverse (A:=A) delta pi2.
+Proof.
+  split; [trivial|]; destruct b as (a1,a2,[]); reflexivity.
+Qed.
+
+(** Functional extensionality *)
+
+Local Notation FunctionalExtensionality := 
+  (forall A B (f g : A -> B), (forall x, f x = g x) -> f = g).
+
+(** Equality of projections from diagonal *)
+
+Local Notation EqDeltaProjs := (forall A, pi1 = pi2 :> (Delta A -> A)).
+
+(** Unicity of bijection inverse *)
+
+Local Notation UniqueInverse := (forall A B (f:A->B) g1 g2, is_inverse f g1 -> is_inverse f g2 -> g1 = g2).
+
+(** Bijectivity of bijective composition *)
+
+Definition action A B C (f:A->B) := (fun h:B->C => fun x => h (f x)).
+
+Local Notation BijectivityBijectiveComp := (forall A B C (f:A->B) g,
+  is_inverse f g -> is_inverse (A:=B->C) (action f) (action g)).
+
+(**********************************************************************)
+(** * Functional extensionality <-> Equality of projections from diagonal *)
+
+Theorem FunctExt_iff_EqDeltaProjs : FunctionalExtensionality <-> EqDeltaProjs.
+Proof.
+  split.
+  - intros FunExt *; apply FunExt, diagonal_projs_same_behavior. 
+  - intros EqProjs **; change f with (fun x => pi1 {|pi1:=f x; pi2:=g x; eq:=H x|}).
+    rewrite EqProjs; reflexivity.
+Qed.
+
+(**********************************************************************)
+(** * Functional extensionality <-> Unicity of bijection inverse *)
+
+Lemma FunctExt_UniqInverse : FunctionalExtensionality -> UniqueInverse.
+Proof.
+  intros FunExt * (Hg1f,Hfg1) (Hg2f,Hfg2).
+  apply FunExt. intros; congruence.
+Qed.
+
+Lemma UniqInverse_EqDeltaProjs : UniqueInverse -> EqDeltaProjs.
+Proof.
+  intros UniqInv *.
+  apply UniqInv with delta; [apply diagonal_inverse1 | apply diagonal_inverse2].
+Qed.
+
+Theorem FunctExt_iff_UniqInverse : FunctionalExtensionality <-> UniqueInverse.
+Proof.
+  split. 
+  - apply FunctExt_UniqInverse.
+  - intro; apply FunctExt_iff_EqDeltaProjs, UniqInverse_EqDeltaProjs; trivial.
+Qed.
+
+(**********************************************************************)
+(** * Functional extensionality <-> Bijectivity of bijective composition *)
+
+Lemma FunctExt_BijComp : FunctionalExtensionality -> BijectivityBijectiveComp.
+Proof.
+  intros FunExt * (Hgf,Hfg). split; unfold action.
+  - intros h; apply FunExt; intro b; rewrite Hfg; reflexivity.
+  - intros h; apply FunExt; intro a; rewrite Hgf; reflexivity.
+Qed.
+
+Lemma BijComp_FunctExt : BijectivityBijectiveComp -> FunctionalExtensionality.
+Proof.
+  intros BijComp.
+  apply FunctExt_iff_UniqInverse. intros * H1 H2.
+  destruct BijComp with (C:=A) (1:=H2) as (Hg2f,_).
+  destruct BijComp with (C:=A) (1:=H1) as (_,Hfg1).
+  rewrite <- (Hg2f g1).
+  change g1 with (action g1 (fun x => x)).
+  rewrite -> (Hfg1 (fun x => x)).
+  reflexivity.
+Qed.
diff --git a/theories/Logic/FunctionalExtensionality.v b/theories/Logic/FunctionalExtensionality.v
index a696b6c8..ecb7428e 100644
--- a/theories/Logic/FunctionalExtensionality.v
+++ b/theories/Logic/FunctionalExtensionality.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: FunctionalExtensionality.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This module states the axiom of (dependent) functional extensionality and (dependent) eta-expansion.
    It introduces a tactic [extensionality] to apply the axiom of extensionality to an equality goal. *)
 
diff --git a/theories/Logic/Hurkens.v b/theories/Logic/Hurkens.v
index afaeb51a..1dce51b2 100644
--- a/theories/Logic/Hurkens.v
+++ b/theories/Logic/Hurkens.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -46,7 +46,7 @@ Lemma Omega : forall i:U -> bool, induct i -> b2p (i WF).
 Proof.
 intros i y.
 apply y.
-unfold le, WF, induct in |- *.
+unfold le, WF, induct.
 apply p2p2.
 intros x H0.
 apply y.
@@ -55,7 +55,7 @@ Qed.
 
 Lemma lemma1 : induct (fun u => p2b (I u)).
 Proof.
-unfold induct in |- *.
+unfold induct.
 intros x p.
 apply (p2p2 (I x)).
 intro q.
diff --git a/theories/Logic/IndefiniteDescription.v b/theories/Logic/IndefiniteDescription.v
index afca2ee1..5424eea8 100644
--- a/theories/Logic/IndefiniteDescription.v
+++ b/theories/Logic/IndefiniteDescription.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: IndefiniteDescription.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file provides a constructive form of indefinite description that
     allows to build choice functions; this is weaker than Hilbert's
     epsilon operator (which implies weakly classical properties) but
diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v
index 95640d67..530e0555 100644
--- a/theories/Logic/JMeq.v
+++ b/theories/Logic/JMeq.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: JMeq.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** John Major's Equality as proposed by Conor McBride
 
   Reference:
@@ -26,6 +24,8 @@ Inductive JMeq (A:Type) (x:A) : forall B:Type, B -> Prop :=
 
 Set Elimination Schemes.
 
+Arguments JMeq_refl {A x} , [A] x.
+
 Hint Resolve JMeq_refl.
 
 Lemma JMeq_sym : forall (A B:Type) (x:A) (y:B), JMeq x y -> JMeq y x.
@@ -113,8 +113,7 @@ apply JMeq_refl.
 Qed.
 
 Lemma eq_dep_strictly_stronger_JMeq :
- exists U, exists P, exists p, exists q, exists x, exists y,
-  JMeq x y /\ ~ eq_dep U P p x q y.
+ exists U P p q x y, JMeq x y /\ ~ eq_dep U P p x q y.
 Proof.
 exists bool. exists (fun _ => True). exists true. exists false.
 exists I. exists I.
diff --git a/theories/Logic/ProofIrrelevance.v b/theories/Logic/ProofIrrelevance.v
index 2a55f0bb..7d6d0cf8 100644
--- a/theories/Logic/ProofIrrelevance.v
+++ b/theories/Logic/ProofIrrelevance.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
diff --git a/theories/Logic/ProofIrrelevanceFacts.v b/theories/Logic/ProofIrrelevanceFacts.v
index 160ac2d5..2e9f0c19 100644
--- a/theories/Logic/ProofIrrelevanceFacts.v
+++ b/theories/Logic/ProofIrrelevanceFacts.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -25,7 +25,7 @@ Module ProofIrrelevanceTheory (M:ProofIrrelevance).
       forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p),
         x = eq_rect p Q x p h.
     Proof.
-      intros; rewrite M.proof_irrelevance with (p1:=h) (p2:=refl_equal p).
+      intros; rewrite M.proof_irrelevance with (p1:=h) (p2:=eq_refl p).
       reflexivity.
     Qed.
   End Eq_rect_eq.
diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v
index 25d07fc9..efec03d4 100644
--- a/theories/Logic/RelationalChoice.v
+++ b/theories/Logic/RelationalChoice.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: RelationalChoice.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file axiomatizes the relational form of the axiom of choice *)
 
 Axiom relational_choice :
diff --git a/theories/Logic/SetIsType.v b/theories/Logic/SetIsType.v
index df64822d..c0a6f9ed 100644
--- a/theories/Logic/SetIsType.v
+++ b/theories/Logic/SetIsType.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -14,4 +14,4 @@
     Set: simply insert some Require Export of this file at starting
     points of the development and try to recompile...  *)
 
-Notation "'Set'" := Type (only parsing).
\ No newline at end of file
+Notation "'Set'" := Type (only parsing).
diff --git a/theories/MSets/MSetAVL.v b/theories/MSets/MSetAVL.v
index 96580749..db12ee31 100644
--- a/theories/MSets/MSetAVL.v
+++ b/theories/MSets/MSetAVL.v
@@ -7,15 +7,13 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 (** * MSetAVL : Implementation of MSetInterface via AVL trees *)
 
 (** This module implements finite sets using AVL trees.
     It follows the implementation from Ocaml's standard library,
 
     All operations given here expect and produce well-balanced trees
-    (in the ocaml sense: heigths of subtrees shouldn't differ by more
+    (in the ocaml sense: heights of subtrees shouldn't differ by more
     than 2), and hence has low complexities (e.g. add is logarithmic
     in the size of the set). But proving these balancing preservations
     is in fact not necessary for ensuring correct operational behavior
@@ -33,73 +31,42 @@
     code after extraction.
 *)
 
-Require Import MSetInterface ZArith Int.
+Require Import MSetInterface MSetGenTree ZArith Int.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
-(* for nicer extraction, we create only logical inductive principles *)
+(* for nicer extraction, we create inductive principles
+   only when needed *)
 Local Unset Elimination Schemes.
 Local Unset Case Analysis Schemes.
 
 (** * Ops : the pure functions *)
 
-Module Ops (Import I:Int)(X:OrderedType) <: WOps X.
+Module Ops (Import I:Int)(X:OrderedType) <: MSetInterface.Ops X.
 Local Open Scope Int_scope.
-Local Open Scope lazy_bool_scope.
-
-Definition elt := X.t.
+Local Notation int := I.t.
 
-(** ** Trees
+(** ** Generic trees instantiated with integer height *)
 
-   The fourth field of [Node] is the height of the tree *)
+(** We reuse a generic definition of trees where the information
+    parameter is a [Int.t]. Functions like mem or fold are also
+    provided by this generic functor. *)
 
-Inductive tree :=
-  | Leaf : tree
-  | Node : tree -> X.t -> tree -> int -> tree.
+Include MSetGenTree.Ops X I.
 
 Definition t := tree.
 
-(** ** Basic functions on trees: height and cardinal *)
+(** ** Height of trees *)
 
 Definition height (s : t) : int :=
   match s with
   | Leaf => 0
-  | Node _ _ _ h => h
-  end.
-
-Fixpoint cardinal (s : t) : nat :=
-  match s with
-   | Leaf => 0%nat
-   | Node l _ r _ => S (cardinal l + cardinal r)
+  | Node h _ _ _ => h
   end.
 
-(** ** Empty Set *)
-
-Definition empty := Leaf.
-
-(** ** Emptyness test *)
-
-Definition is_empty s :=
-  match s with Leaf => true | _ => false end.
-
-(** ** Membership *)
-
-(** The [mem] function is deciding membership. It exploits the
-    binary search tree invariant to achieve logarithmic complexity. *)
-
-Fixpoint mem x s :=
-   match s with
-     |  Leaf => false
-     |  Node l y r _ => match X.compare x y with
-             | Lt => mem x l
-             | Eq => true
-             | Gt => mem x r
-         end
-   end.
-
 (** ** Singleton set *)
 
-Definition singleton x := Node Leaf x Leaf 1.
+Definition singleton x := Node 1 Leaf x Leaf.
 
 (** ** Helper functions *)
 
@@ -107,7 +74,7 @@ Definition singleton x := Node Leaf x Leaf 1.
     to be balanced and [|height l - height r| <= 2]. *)
 
 Definition create l x r :=
-   Node l x r (max (height l) (height r) + 1).
+   Node (max (height l) (height r) + 1) l x r.
 
 (** [bal l x r] acts as [create], but performs one step of
     rebalancing if necessary, i.e. assumes [|height l - height r| <= 3]. *)
@@ -120,13 +87,13 @@ Definition bal l x r :=
   if gt_le_dec hl (hr+2) then
     match l with
      | Leaf => assert_false l x r
-     | Node ll lx lr _ =>
+     | Node _ ll lx lr =>
        if ge_lt_dec (height ll) (height lr) then
          create ll lx (create lr x r)
        else
          match lr with
           | Leaf => assert_false l x r
-          | Node lrl lrx lrr _ =>
+          | Node _ lrl lrx lrr =>
               create (create ll lx lrl) lrx (create lrr x r)
          end
     end
@@ -134,13 +101,13 @@ Definition bal l x r :=
     if gt_le_dec hr (hl+2) then
       match r with
        | Leaf => assert_false l x r
-       | Node rl rx rr _ =>
+       | Node _ rl rx rr =>
          if ge_lt_dec (height rr) (height rl) then
             create (create l x rl) rx rr
          else
            match rl with
             | Leaf => assert_false l x r
-            | Node rll rlx rlr _ =>
+            | Node _ rll rlx rlr =>
                 create (create l x rll) rlx (create rlr rx rr)
            end
       end
@@ -150,11 +117,11 @@ Definition bal l x r :=
 (** ** Insertion *)
 
 Fixpoint add x s := match s with
-   | Leaf => Node Leaf x Leaf 1
-   | Node l y r h =>
+   | Leaf => Node 1 Leaf x Leaf
+   | Node h l y r =>
       match X.compare x y with
          | Lt => bal (add x l) y r
-         | Eq => Node l y r h
+         | Eq => Node h l y r
          | Gt => bal l y (add x r)
       end
   end.
@@ -168,10 +135,10 @@ Fixpoint add x s := match s with
 Fixpoint join l : elt -> t -> t :=
   match l with
     | Leaf => add
-    | Node ll lx lr lh => fun x =>
+    | Node lh ll lx lr => fun x =>
        fix join_aux (r:t) : t := match r with
-          | Leaf =>  add x l
-          | Node rl rx rr rh =>
+          | Leaf => add x l
+          | Node rh rl rx rr =>
                if gt_le_dec lh (rh+2) then bal ll lx (join lr x r)
                else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rr
                else create l x r
@@ -181,14 +148,14 @@ Fixpoint join l : elt -> t -> t :=
 (** ** Extraction of minimum element
 
   Morally, [remove_min] is to be applied to a non-empty tree
-  [t = Node l x r h]. Since we can't deal here with [assert false]
+  [t = Node h l x r]. Since we can't deal here with [assert false]
   for [t=Leaf], we pre-unpack [t] (and forget about [h]).
 *)
 
 Fixpoint remove_min l x r : t*elt :=
   match l with
     | Leaf => (r,x)
-    | Node ll lx lr lh =>
+    | Node lh ll lx lr =>
        let (l',m) := remove_min ll lx lr in (bal l' x r, m)
   end.
 
@@ -202,7 +169,7 @@ Fixpoint remove_min l x r : t*elt :=
 Definition merge s1 s2 :=  match s1,s2 with
   | Leaf, _ => s2
   | _, Leaf => s1
-  | _, Node l2 x2 r2 h2 =>
+  | _, Node _ l2 x2 r2 =>
         let (s2',m) := remove_min l2 x2 r2 in bal s1 m s2'
 end.
 
@@ -210,34 +177,14 @@ end.
 
 Fixpoint remove x s := match s with
   | Leaf => Leaf
-  | Node l y r h =>
+  | Node _ l y r =>
       match X.compare x y with
          | Lt => bal (remove x l) y r
          | Eq => merge l r
-         | Gt => bal l  y (remove x r)
+         | Gt => bal l y (remove x r)
       end
    end.
 
-(** ** Minimum element *)
-
-Fixpoint min_elt s := match s with
-   | Leaf => None
-   | Node Leaf y _  _ => Some y
-   | Node l _ _ _ => min_elt l
-end.
-
-(** ** Maximum element *)
-
-Fixpoint max_elt s := match s with
-   | Leaf => None
-   | Node _ y Leaf  _ => Some y
-   | Node _ _ r _ => max_elt r
-end.
-
-(** ** Any element *)
-
-Definition choose := min_elt.
-
 (** ** Concatenation
 
     Same as [merge] but does not assume anything about heights.
@@ -247,7 +194,7 @@ Definition concat s1 s2 :=
    match s1, s2 with
       | Leaf, _ => s2
       | _, Leaf => s1
-      | _, Node l2 x2 r2 _ =>
+      | _, Node _ l2 x2 r2 =>
             let (s2',m) := remove_min l2 x2 r2 in
             join s1 m s2'
    end.
@@ -265,7 +212,7 @@ Notation "<< l , b , r >>" := (mktriple l b r) (at level 9).
 
 Fixpoint split x s : triple := match s with
   | Leaf => << Leaf, false, Leaf >>
-  | Node l y r h =>
+  | Node _ l y r =>
      match X.compare x y with
       | Lt => let (ll,b,rl) := split x l in << ll, b, join rl y r >>
       | Eq => << l, true, r >>
@@ -278,7 +225,7 @@ Fixpoint split x s : triple := match s with
 Fixpoint inter s1 s2 := match s1, s2 with
     | Leaf, _ => Leaf
     | _, Leaf => Leaf
-    | Node l1 x1 r1 h1, _ =>
+    | Node _ l1 x1 r1, _ =>
             let (l2',pres,r2') := split x1 s2 in
             if pres then join (inter l1 l2') x1 (inter r1 r2')
             else concat (inter l1 l2') (inter r1 r2')
@@ -289,7 +236,7 @@ Fixpoint inter s1 s2 := match s1, s2 with
 Fixpoint diff s1 s2 := match s1, s2 with
  | Leaf, _ => Leaf
  | _, Leaf => s1
- | Node l1 x1 r1 h1, _ =>
+ | Node _ l1 x1 r1, _ =>
     let (l2',pres,r2') := split x1 s2 in
     if pres then concat (diff l1 l2') (diff r1 r2')
     else join (diff l1 l2') x1 (diff r1 r2')
@@ -312,187 +259,36 @@ Fixpoint union s1 s2 :=
  match s1, s2 with
   | Leaf, _ => s2
   | _, Leaf => s1
-  | Node l1 x1 r1 h1, _ =>
+  | Node _ l1 x1 r1, _ =>
      let (l2',_,r2') := split x1 s2 in
      join (union l1 l2') x1 (union r1 r2')
  end.
 
-(** ** Elements *)
-
-(** [elements_tree_aux acc t] catenates the elements of [t] in infix
-    order to the list [acc] *)
-
-Fixpoint elements_aux (acc : list X.t) (s : t) : list X.t :=
-  match s with
-   | Leaf => acc
-   | Node l x r _ => elements_aux (x :: elements_aux acc r) l
-  end.
-
-(** then [elements] is an instanciation with an empty [acc] *)
-
-Definition elements := elements_aux nil.
-
 (** ** Filter *)
 
-Fixpoint filter_acc (f:elt->bool) acc s := match s with
-  | Leaf => acc
-  | Node l x r h =>
-     filter_acc f (filter_acc f (if f x then add x acc else acc) l) r
+Fixpoint filter (f:elt->bool) s := match s with
+  | Leaf => Leaf
+  | Node _ l x r =>
+    let l' := filter f l in
+    let r' := filter f r in
+    if f x then join l' x r' else concat l' r'
  end.
 
-Definition filter f := filter_acc f Leaf.
-
-
 (** ** Partition *)
 
-Fixpoint partition_acc (f:elt->bool)(acc : t*t)(s : t) : t*t :=
+Fixpoint partition (f:elt->bool)(s : t) : t*t :=
   match s with
-   | Leaf => acc
-   | Node l x r _ =>
-      let (acct,accf) := acc in
-      partition_acc f
-        (partition_acc f
-           (if f x then (add x acct, accf) else (acct, add x accf)) l) r
+   | Leaf => (Leaf, Leaf)
+   | Node _ l x r =>
+      let (l1,l2) := partition f l in
+      let (r1,r2) := partition f r in
+      if f x then (join l1 x r1, concat l2 r2)
+      else (concat l1 r1, join l2 x r2)
   end.
 
-Definition partition f := partition_acc f (Leaf,Leaf).
-
-(** ** [for_all] and [exists] *)
-
-Fixpoint for_all (f:elt->bool) s := match s with
-  | Leaf => true
-  | Node l x r _ => f x &&& for_all f l &&& for_all f r
-end.
-
-Fixpoint exists_ (f:elt->bool) s := match s with
-  | Leaf => false
-  | Node l x r _ => f x ||| exists_ f l ||| exists_ f r
-end.
-
-(** ** Fold *)
-
-Fixpoint fold (A : Type) (f : elt -> A -> A)(s : t) : A -> A :=
- fun a => match s with
-  | Leaf => a
-  | Node l x r _ => fold f r (f x (fold f l a))
- end.
-Implicit Arguments fold [A].
-
-
-(** ** Subset *)
-
-(** In ocaml, recursive calls are made on "half-trees" such as
-   (Node l1 x1 Leaf _) and (Node Leaf x1 r1 _). Instead of these
-   non-structural calls, we propose here two specialized functions for
-   these situations. This version should be almost as efficient as
-   the one of ocaml (closures as arguments may slow things a bit),
-   it is simply less compact. The exact ocaml version has also been
-   formalized (thanks to Function+measure), see [ocaml_subset] in
-   [MSetFullAVL].
- *)
-
-Fixpoint subsetl (subset_l1:t->bool) x1 s2 : bool :=
- match s2 with
-  | Leaf => false
-  | Node l2 x2 r2 h2 =>
-     match X.compare x1 x2 with
-      | Eq => subset_l1 l2
-      | Lt => subsetl subset_l1 x1 l2
-      | Gt => mem x1 r2 &&& subset_l1 s2
-     end
- end.
-
-Fixpoint subsetr (subset_r1:t->bool) x1 s2 : bool :=
- match s2 with
-  | Leaf => false
-  | Node l2 x2 r2 h2 =>
-     match X.compare x1 x2 with
-      | Eq => subset_r1 r2
-      | Lt => mem x1 l2 &&& subset_r1 s2
-      | Gt => subsetr subset_r1 x1 r2
-     end
- end.
-
-Fixpoint subset s1 s2 : bool := match s1, s2 with
-  | Leaf, _ => true
-  | Node _ _ _ _, Leaf => false
-  | Node l1 x1 r1 h1, Node l2 x2 r2 h2 =>
-     match X.compare x1 x2 with
-      | Eq => subset l1 l2 &&& subset r1 r2
-      | Lt => subsetl (subset l1) x1 l2 &&& subset r1 s2
-      | Gt => subsetr (subset r1) x1 r2 &&& subset l1 s2
-     end
- end.
-
-(** ** A new comparison algorithm suggested by Xavier Leroy
-
-    Transformation in C.P.S. suggested by Benjamin Grégoire.
-    The original ocaml code (with non-structural recursive calls)
-    has also been formalized (thanks to Function+measure), see
-    [ocaml_compare] in [MSetFullAVL]. The following code with
-    continuations computes dramatically faster in Coq, and
-    should be almost as efficient after extraction.
-*)
-
-(** Enumeration of the elements of a tree *)
-
-Inductive enumeration :=
- | End : enumeration
- | More : elt -> t -> enumeration -> enumeration.
-
-
-(** [cons t e] adds the elements of tree [t] on the head of
-    enumeration [e]. *)
-
-Fixpoint cons s e : enumeration :=
- match s with
-  | Leaf => e
-  | Node l x r h => cons l (More x r e)
- end.
-
-(** One step of comparison of elements *)
-
-Definition compare_more x1 (cont:enumeration->comparison) e2 :=
- match e2 with
- | End => Gt
- | More x2 r2 e2 =>
-     match X.compare x1 x2 with
-      | Eq => cont (cons r2 e2)
-      | Lt => Lt
-      | Gt => Gt
-     end
- end.
-
-(** Comparison of left tree, middle element, then right tree *)
-
-Fixpoint compare_cont s1 (cont:enumeration->comparison) e2 :=
- match s1 with
-  | Leaf => cont e2
-  | Node l1 x1 r1 _ =>
-     compare_cont l1 (compare_more x1 (compare_cont r1 cont)) e2
-  end.
-
-(** Initial continuation *)
-
-Definition compare_end e2 :=
- match e2 with End => Eq | _ => Lt end.
-
-(** The complete comparison *)
-
-Definition compare s1 s2 := compare_cont s1 compare_end (cons s2 End).
-
-(** ** Equality test *)
-
-Definition equal s1 s2 : bool :=
- match compare s1 s2 with
-  | Eq => true
-  | _ => false
- end.
-
 End Ops.
 
 
-
 (** * MakeRaw
 
    Functor of pure functions + a posteriori proofs of invariant
@@ -501,265 +297,47 @@ End Ops.
 Module MakeRaw (Import I:Int)(X:OrderedType) <: RawSets X.
 Include Ops I X.
 
-(** * Invariants *)
-
-(** ** Occurrence in a tree *)
-
-Inductive InT (x : elt) : tree -> Prop :=
-  | IsRoot : forall l r h y, X.eq x y -> InT x (Node l y r h)
-  | InLeft : forall l r h y, InT x l -> InT x (Node l y r h)
-  | InRight : forall l r h y, InT x r -> InT x (Node l y r h).
-
-Definition In := InT.
-
-(** ** Some shortcuts *)
-
-Definition Equal s s' := forall a : elt, InT a s <-> InT a s'.
-Definition Subset s s' := forall a : elt, InT a s -> InT a s'.
-Definition Empty s := forall a : elt, ~ InT a s.
-Definition For_all (P : elt -> Prop) s := forall x, InT x s -> P x.
-Definition Exists (P : elt -> Prop) s := exists x, InT x s /\ P x.
-
-(** ** Binary search trees *)
-
-(** [lt_tree x s]: all elements in [s] are smaller than [x]
-   (resp. greater for [gt_tree]) *)
-
-Definition lt_tree x s := forall y, InT y s -> X.lt y x.
-Definition gt_tree x s := forall y, InT y s -> X.lt x y.
-
-(** [bst t] : [t] is a binary search tree *)
-
-Inductive bst : tree -> Prop :=
-  | BSLeaf : bst Leaf
-  | BSNode : forall x l r h, bst l -> bst r ->
-     lt_tree x l -> gt_tree x r -> bst (Node l x r h).
-
-(** [bst] is the (decidable) invariant our trees will have to satisfy. *)
-
-Definition IsOk := bst.
-
-Class Ok (s:t) : Prop := ok : bst s.
-
-Instance bst_Ok s (Hs : bst s) : Ok s := { ok := Hs }.
-
-Fixpoint ltb_tree x s :=
- match s with
-  | Leaf => true
-  | Node l y r _ =>
-     match X.compare x y with
-      | Gt => ltb_tree x l && ltb_tree x r
-      | _ => false
-     end
- end.
-
-Fixpoint gtb_tree x s :=
- match s with
-  | Leaf => true
-  | Node l y r _ =>
-     match X.compare x y with
-      | Lt => gtb_tree x l && gtb_tree x r
-      | _ => false
-     end
- end.
-
-Fixpoint isok s :=
- match s with
-  | Leaf => true
-  | Node l x r _ => isok l && isok r && ltb_tree x l && gtb_tree x r
- end.
-
+(** Generic definition of binary-search-trees and proofs of
+    specifications for generic functions such as mem or fold. *)
 
-(** * Correctness proofs *)
+Include MSetGenTree.Props X I.
 
-Module Import MX := OrderedTypeFacts X.
+(** Automation and dedicated tactics *)
 
-(** * Automation and dedicated tactics *)
-
-Scheme tree_ind := Induction for tree Sort Prop.
-
-Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans @ok.
 Local Hint Immediate MX.eq_sym.
-Local Hint Unfold In lt_tree gt_tree.
+Local Hint Unfold In lt_tree gt_tree Ok.
 Local Hint Constructors InT bst.
-Local Hint Unfold Ok.
-
-Tactic Notation "factornode" ident(l) ident(x) ident(r) ident(h)
- "as" ident(s) :=
- set (s:=Node l x r h) in *; clearbody s; clear l x r h.
-
-(** Automatic treatment of [Ok] hypothesis *)
-
-Ltac inv_ok := match goal with
- | H:Ok (Node _ _ _ _) |- _ => inversion_clear H; inv_ok
- | H:Ok Leaf |- _ => clear H; inv_ok
- | H:bst ?x |- _ => change (Ok x) in H; inv_ok
- | _ => idtac
-end.
-
-(** A tactic to repeat [inversion_clear] on all hyps of the
-    form [(f (Node _ _ _ _))] *)
-
-Ltac is_tree_constr c :=
-  match c with
-   | Leaf => idtac
-   | Node _ _ _ _ => idtac
-   | _ => fail
-  end.
-
-Ltac invtree f :=
-  match goal with
-     | H:f ?s |- _ => is_tree_constr s; inversion_clear H; invtree f
-     | H:f _ ?s |- _ => is_tree_constr s; inversion_clear H; invtree f
-     | H:f _ _ ?s |- _ => is_tree_constr s; inversion_clear H; invtree f
-     | _ => idtac
-  end.
-
-Ltac inv := inv_ok; invtree InT.
-
-Ltac intuition_in := repeat progress (intuition; inv).
-
-(** Helper tactic concerning order of elements. *)
-
-Ltac order := match goal with
- | U: lt_tree _ ?s, V: InT _ ?s |- _ => generalize (U _ V); clear U; order
- | U: gt_tree _ ?s, V: InT _ ?s |- _ => generalize (U _ V); clear U; order
- | _ => MX.order
-end.
-
-
-(** [isok] is indeed a decision procedure for [Ok] *)
-
-Lemma ltb_tree_iff : forall x s, lt_tree x s <-> ltb_tree x s = true.
-Proof.
- induction s as [|l IHl y r IHr h]; simpl.
- unfold lt_tree; intuition_in.
- elim_compare x y.
- split; intros; try discriminate. assert (X.lt y x) by auto. order.
- split; intros; try discriminate. assert (X.lt y x) by auto. order.
- rewrite !andb_true_iff, <-IHl, <-IHr.
-  unfold lt_tree; intuition_in; order.
-Qed.
-
-Lemma gtb_tree_iff : forall x s, gt_tree x s <-> gtb_tree x s = true.
-Proof.
- induction s as [|l IHl y r IHr h]; simpl.
- unfold gt_tree; intuition_in.
- elim_compare x y.
- split; intros; try discriminate. assert (X.lt x y) by auto. order.
- rewrite !andb_true_iff, <-IHl, <-IHr.
-  unfold gt_tree; intuition_in; order.
- split; intros; try discriminate. assert (X.lt x y) by auto. order.
-Qed.
-
-Lemma isok_iff : forall s, Ok s <-> isok s = true.
-Proof.
- induction s as [|l IHl y r IHr h]; simpl.
- intuition_in.
- rewrite !andb_true_iff, <- IHl, <-IHr, <- ltb_tree_iff, <- gtb_tree_iff.
- intuition_in.
-Qed.
-
-Instance isok_Ok s : isok s = true -> Ok s | 10.
-Proof. intros; apply <- isok_iff; auto. Qed.
-
-
-(** * Basic results about [In], [lt_tree], [gt_tree], [height] *)
-
-(** [In] is compatible with [X.eq] *)
-
-Lemma In_1 :
- forall s x y, X.eq x y -> InT x s -> InT y s.
-Proof.
- induction s; simpl; intuition_in; eauto.
-Qed.
-Local Hint Immediate In_1.
-
-Instance In_compat : Proper (X.eq==>eq==>iff) InT.
-Proof.
-apply proper_sym_impl_iff_2; auto with *.
-repeat red; intros; subst. apply In_1 with x; auto.
-Qed.
-
-Lemma In_node_iff :
- forall l x r h y,
-  InT y (Node l x r h) <-> InT y l \/ X.eq y x \/ InT y r.
-Proof.
- intuition_in.
-Qed.
-
-(** Results about [lt_tree] and [gt_tree] *)
-
-Lemma lt_leaf : forall x : elt, lt_tree x Leaf.
-Proof.
- red; inversion 1.
-Qed.
-
-Lemma gt_leaf : forall x : elt, gt_tree x Leaf.
-Proof.
- red; inversion 1.
-Qed.
-
-Lemma lt_tree_node :
- forall (x y : elt) (l r : tree) (h : int),
- lt_tree x l -> lt_tree x r -> X.lt y x -> lt_tree x (Node l y r h).
-Proof.
- unfold lt_tree; intuition_in; order.
-Qed.
-
-Lemma gt_tree_node :
- forall (x y : elt) (l r : tree) (h : int),
- gt_tree x l -> gt_tree x r -> X.lt x y -> gt_tree x (Node l y r h).
-Proof.
- unfold gt_tree; intuition_in; order.
-Qed.
-
+Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans @ok.
 Local Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node.
+Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans.
+Local Hint Resolve elements_spec2.
 
-Lemma lt_tree_not_in :
- forall (x : elt) (t : tree), lt_tree x t -> ~ InT x t.
-Proof.
- intros; intro; order.
-Qed.
-
-Lemma lt_tree_trans :
- forall x y, X.lt x y -> forall t, lt_tree x t -> lt_tree y t.
-Proof.
- eauto.
-Qed.
+(* Sometimes functional induction will expose too much of
+   a tree structure. The following tactic allows to factor back
+   a Node whose internal parts occurs nowhere else. *)
 
-Lemma gt_tree_not_in :
- forall (x : elt) (t : tree), gt_tree x t -> ~ InT x t.
-Proof.
- intros; intro; order.
-Qed.
+(* TODO: why Ltac instead of Tactic Notation don't work ? why clear ? *)
 
-Lemma gt_tree_trans :
- forall x y, X.lt y x -> forall t, gt_tree x t -> gt_tree y t.
-Proof.
- eauto.
-Qed.
-
-Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans.
+Tactic Notation "factornode" ident(s) :=
+ try clear s;
+ match goal with
+   | |- context [Node ?l ?x ?r ?h] =>
+       set (s:=Node l x r h) in *; clearbody s; clear l x r h
+   | _ : context [Node ?l ?x ?r ?h] |- _ =>
+       set (s:=Node l x r h) in *; clearbody s; clear l x r h
+ end.
 
-(** * Inductions principles for some of the set operators *)
+(** Inductions principles for some of the set operators *)
 
 Functional Scheme bal_ind := Induction for bal Sort Prop.
 Functional Scheme remove_min_ind := Induction for remove_min Sort Prop.
 Functional Scheme merge_ind := Induction for merge Sort Prop.
-Functional Scheme min_elt_ind := Induction for min_elt Sort Prop.
-Functional Scheme max_elt_ind := Induction for max_elt Sort Prop.
 Functional Scheme concat_ind := Induction for concat Sort Prop.
 Functional Scheme inter_ind := Induction for inter Sort Prop.
 Functional Scheme diff_ind := Induction for diff Sort Prop.
 Functional Scheme union_ind := Induction for union Sort Prop.
 
-Ltac induct s x :=
- induction s as [|l IHl x' r IHr h]; simpl; intros;
- [|elim_compare x x'; intros; inv].
-
-
-(** * Notations and helper lemma about pairs and triples *)
+(** Notations and helper lemma about pairs and triples *)
 
 Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope.
 Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope.
@@ -767,42 +345,9 @@ Notation "t #l" := (t_left t) (at level 9, format "t '#l'") : pair_scope.
 Notation "t #b" := (t_in t) (at level 9, format "t '#b'") : pair_scope.
 Notation "t #r" := (t_right t) (at level 9, format "t '#r'") : pair_scope.
 
-Open Local Scope pair_scope.
-
-
-(** * Empty set *)
-
-Lemma empty_spec : Empty empty.
-Proof.
- intro; intro.
- inversion H.
-Qed.
-
-Instance empty_ok : Ok empty.
-Proof.
- auto.
-Qed.
-
-(** * Emptyness test *)
-
-Lemma is_empty_spec : forall s, is_empty s = true <-> Empty s.
-Proof.
- destruct s as [|r x l h]; simpl; auto.
- split; auto. red; red; intros; inv.
- split; auto. try discriminate. intro H; elim (H x); auto.
-Qed.
-
-(** * Membership *)
-
-Lemma mem_spec : forall s x `{Ok s}, mem x s = true <-> InT x s.
-Proof.
- split.
- induct s x; auto; try discriminate.
- induct s x; intuition_in; order.
-Qed.
-
+Local Open Scope pair_scope.
 
-(** * Singleton set *)
+(** ** Singleton set *)
 
 Lemma singleton_spec : forall x y, InT y (singleton x) <-> X.eq y x.
 Proof.
@@ -814,9 +359,7 @@ Proof.
  unfold singleton; auto.
 Qed.
 
-
-
-(** * Helper functions *)
+(** ** Helper functions *)
 
 Lemma create_spec :
  forall l x r y,  InT y (create l x r) <-> X.eq y x \/ InT y l \/ InT y r.
@@ -847,7 +390,7 @@ Proof.
 Qed.
 
 
-(** * Insertion *)
+(** ** Insertion *)
 
 Lemma add_spec' : forall s x y,
  InT y (add x s) <-> X.eq y x \/ InT y s.
@@ -867,25 +410,25 @@ Proof.
 Qed.
 
 
-Open Scope Int_scope.
+Local Open Scope Int_scope.
 
-(** * Join *)
+(** ** Join *)
 
-(* Function/Functional Scheme can't deal with internal fix.
-   Let's do its job by hand: *)
+(** Function/Functional Scheme can't deal with internal fix.
+    Let's do its job by hand: *)
 
 Ltac join_tac :=
- intro l; induction l as [| ll _ lx lr Hlr lh];
-   [ | intros x r; induction r as [| rl Hrl rx rr _ rh]; unfold join;
-     [ | destruct (gt_le_dec lh (rh+2));
+ intro l; induction l as [| lh ll _ lx lr Hlr];
+   [ | intros x r; induction r as [| rh rl Hrl rx rr _]; unfold join;
+     [ | destruct (gt_le_dec lh (rh+2)) as [GT|LE];
        [ match goal with |- context b [ bal ?a ?b ?c] =>
            replace (bal a b c)
-           with (bal ll lx (join lr x (Node rl rx rr rh))); [ | auto]
+           with (bal ll lx (join lr x (Node rh rl rx rr))); [ | auto]
          end
-       | destruct (gt_le_dec rh (lh+2));
+       | destruct (gt_le_dec rh (lh+2)) as [GT'|LE'];
          [ match goal with |- context b [ bal ?a ?b ?c] =>
              replace (bal a b c)
-             with (bal (join (Node ll lx lr lh) x rl) rx rr); [ | auto]
+             with (bal (join (Node lh ll lx lr) x rl) rx rr); [ | auto]
            end
          | ] ] ] ]; intros.
 
@@ -905,16 +448,16 @@ Instance join_ok : forall l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r),
  Ok (join l x r).
 Proof.
  join_tac; auto with *; inv; apply bal_ok; auto;
- clear Hrl Hlr z; intro; intros; rewrite join_spec in *.
+ clear Hrl Hlr; intro; intros; rewrite join_spec in *.
  intuition; [ setoid_replace y with x | ]; eauto.
  intuition; [ setoid_replace y with x | ]; eauto.
 Qed.
 
 
-(** * Extraction of minimum element *)
+(** ** Extraction of minimum element *)
 
-Lemma remove_min_spec : forall l x r h y,
- InT y (Node l x r h) <->
+Lemma remove_min_spec : forall l x r y h,
+ InT y (Node h l x r) <->
   X.eq y (remove_min l x r)#2 \/ InT y (remove_min l x r)#1.
 Proof.
  intros l x r; functional induction (remove_min l x r); simpl in *; intros.
@@ -922,13 +465,13 @@ Proof.
  rewrite bal_spec, In_node_iff, IHp, e0; simpl; intuition.
 Qed.
 
-Instance remove_min_ok l x r : forall h `(Ok (Node l x r h)),
+Instance remove_min_ok l x r : forall h `(Ok (Node h l x r)),
  Ok (remove_min l x r)#1.
 Proof.
  functional induction (remove_min l x r); simpl; intros.
  inv; auto.
- assert (O : Ok (Node ll lx lr _x)) by (inv; auto).
- assert (L : lt_tree x (Node ll lx lr _x)) by (inv; auto).
+ assert (O : Ok (Node _x ll lx lr)) by (inv; auto).
+ assert (L : lt_tree x (Node _x ll lx lr)) by (inv; auto).
  specialize IHp with (1:=O); rewrite e0 in IHp; auto; simpl in *.
  apply bal_ok; auto.
  inv; auto.
@@ -937,13 +480,13 @@ Proof.
  inv; auto.
 Qed.
 
-Lemma remove_min_gt_tree : forall l x r h `{Ok (Node l x r h)},
+Lemma remove_min_gt_tree : forall l x r h `{Ok (Node h l x r)},
  gt_tree (remove_min l x r)#2 (remove_min l x r)#1.
 Proof.
  intros l x r; functional induction (remove_min l x r); simpl; intros.
  inv; auto.
- assert (O : Ok (Node ll lx lr _x)) by (inv; auto).
- assert (L : lt_tree x (Node ll lx lr _x)) by (inv; auto).
+ assert (O : Ok (Node _x ll lx lr)) by (inv; auto).
+ assert (L : lt_tree x (Node _x ll lx lr)) by (inv; auto).
  specialize IHp with (1:=O); rewrite e0 in IHp; simpl in IHp.
  intro y; rewrite bal_spec; intuition;
   specialize (L m); rewrite remove_min_spec, e0 in L; simpl in L;
@@ -952,14 +495,13 @@ Qed.
 Local Hint Resolve remove_min_gt_tree.
 
 
-
-(** * Merging two trees *)
+(** ** Merging two trees *)
 
 Lemma merge_spec : forall s1 s2 y,
  InT y (merge s1 s2) <-> InT y s1 \/ InT y s2.
 Proof.
  intros s1 s2; functional induction (merge s1 s2); intros;
- try factornode _x _x0 _x1 _x2 as s1.
+  try factornode s1.
  intuition_in.
  intuition_in.
  rewrite bal_spec, remove_min_spec, e1; simpl; intuition.
@@ -970,7 +512,7 @@ Instance merge_ok s1 s2 : forall `(Ok s1, Ok s2)
  Ok (merge s1 s2).
 Proof.
  functional induction (merge s1 s2); intros; auto;
- try factornode _x _x0 _x1 _x2 as s1.
+  try factornode s1.
  apply bal_ok; auto.
  change s2' with ((s2',m)#1); rewrite <-e1; eauto with *.
  intros y Hy.
@@ -981,7 +523,7 @@ Qed.
 
 
 
-(** * Deletion *)
+(** ** Deletion *)
 
 Lemma remove_spec : forall s x y `{Ok s},
  (InT y (remove x s) <-> InT y s /\ ~ X.eq y x).
@@ -989,7 +531,7 @@ Proof.
  induct s x.
  intuition_in.
  rewrite merge_spec; intuition; [order|order|intuition_in].
- elim H6; eauto.
+ elim H2; eauto.
  rewrite bal_spec, IHl; clear IHl IHr; intuition; [order|order|intuition_in].
  rewrite bal_spec, IHr; clear IHl IHr; intuition; [order|order|intuition_in].
 Qed.
@@ -1009,109 +551,13 @@ Proof.
 Qed.
 
 
-(** * Minimum element *)
-
-Lemma min_elt_spec1 : forall s x, min_elt s = Some x -> InT x s.
-Proof.
- intro s; functional induction (min_elt s); auto; inversion 1; auto.
-Qed.
-
-Lemma min_elt_spec2 : forall s x y `{Ok s},
- min_elt s = Some x -> InT y s -> ~ X.lt y x.
-Proof.
- intro s; functional induction (min_elt s);
- try rename _x1 into l1, _x2 into x1, _x3 into r1, _x4 into h1.
- discriminate.
- intros x y0 U V W.
- inversion V; clear V; subst.
- inv; order.
- intros; inv; auto.
- assert (X.lt x y) by (apply H4; apply min_elt_spec1; auto).
- order.
- assert (X.lt x1 y) by auto.
- assert (~X.lt x1 x) by auto.
- order.
-Qed.
-
-Lemma min_elt_spec3 : forall s, min_elt s = None -> Empty s.
-Proof.
- intro s; functional induction (min_elt s).
- red; red; inversion 2.
- inversion 1.
- intro H0.
- destruct (IHo H0 _x2); auto.
-Qed.
-
-
-
-(** * Maximum element *)
-
-Lemma max_elt_spec1 : forall s x, max_elt s = Some x -> InT x s.
-Proof.
- intro s; functional induction (max_elt s); auto; inversion 1; auto.
-Qed.
-
-Lemma max_elt_spec2 : forall s x y `{Ok s},
- max_elt s = Some x -> InT y s -> ~ X.lt x y.
-Proof.
- intro s; functional induction (max_elt s);
- try rename _x1 into l1, _x2 into x1, _x3 into r1, _x4 into h1.
- discriminate.
- intros x y0 U V W.
- inversion V; clear V; subst.
- inv; order.
- intros; inv; auto.
- assert (X.lt y x1) by auto.
- assert (~ X.lt x x1) by auto.
- order.
- assert (X.lt y x) by (apply H5; apply max_elt_spec1; auto).
- order.
-Qed.
-
-Lemma max_elt_spec3 : forall s, max_elt s = None -> Empty s.
-Proof.
- intro s; functional induction (max_elt s).
- red; auto.
- inversion 1.
- intros H0; destruct (IHo H0 _x2); auto.
-Qed.
-
-
-
-(** * Any element *)
-
-Lemma choose_spec1 : forall s x, choose s = Some x -> InT x s.
-Proof.
- exact min_elt_spec1.
-Qed.
-
-Lemma choose_spec2 : forall s, choose s = None -> Empty s.
-Proof.
- exact min_elt_spec3.
-Qed.
-
-Lemma choose_spec3 : forall s s' x x' `{Ok s, Ok s'},
-  choose s = Some x -> choose s' = Some x' ->
-  Equal s s' -> X.eq x x'.
-Proof.
- unfold choose, Equal; intros s s' x x' Hb Hb' Hx Hx' H.
- assert (~X.lt x x').
-  apply min_elt_spec2 with s'; auto.
-  rewrite <-H; auto using min_elt_spec1.
- assert (~X.lt x' x).
-  apply min_elt_spec2 with s; auto.
-  rewrite H; auto using min_elt_spec1.
- elim_compare x x'; intuition.
-Qed.
-
-
-(** * Concatenation *)
+(** ** Concatenation *)
 
 Lemma concat_spec : forall s1 s2 y,
  InT y (concat s1 s2) <-> InT y s1 \/ InT y s2.
 Proof.
  intros s1 s2; functional induction (concat s1 s2); intros;
- try factornode _x _x0 _x1 _x2 as s1.
+  try factornode s1.
  intuition_in.
  intuition_in.
  rewrite join_spec, remove_min_spec, e1; simpl; intuition.
@@ -1122,7 +568,7 @@ Instance concat_ok s1 s2 : forall `(Ok s1, Ok s2)
  Ok (concat s1 s2).
 Proof.
  functional induction (concat s1 s2); intros; auto;
- try factornode _x _x0 _x1 _x2 as s1.
+  try factornode s1.
  apply join_ok; auto.
  change (Ok (s2',m)#1); rewrite <-e1; eauto with *.
  intros y Hy.
@@ -1133,7 +579,7 @@ Qed.
 
 
 
-(** * Splitting *)
+(** ** Splitting *)
 
 Lemma split_spec1 : forall s x y `{Ok s},
  (InT y (split x s)#l <-> InT y s /\ X.lt y x).
@@ -1175,11 +621,11 @@ Lemma split_ok : forall s x `{Ok s}, Ok (split x s)#l /\ Ok (split x s)#r.
 Proof.
  induct s x; simpl; auto.
  specialize (IHl x).
- generalize (fun y => @split_spec2 _ x y H1).
+ generalize (fun y => @split_spec2 l x y _).
  destruct (split x l); simpl in *; intuition. apply join_ok; auto.
  intros y; rewrite H; intuition.
  specialize (IHr x).
- generalize (fun y => @split_spec1 _ x y H2).
+ generalize (fun y => @split_spec1 r x y _).
  destruct (split x r); simpl in *; intuition. apply join_ok; auto.
  intros y; rewrite H; intuition.
 Qed.
@@ -1191,7 +637,7 @@ Instance split_ok2 s x `(Ok s) : Ok (split x s)#r.
 Proof. intros; destruct (@split_ok s x); auto. Qed.
 
 
-(** * Intersection *)
+(** ** Intersection *)
 
 Ltac destruct_split := match goal with
  | H : split ?x ?s = << ?u, ?v, ?w >> |- _ =>
@@ -1205,23 +651,24 @@ Lemma inter_spec_ok : forall s1 s2 `{Ok s1, Ok s2},
  Ok (inter s1 s2) /\ (forall y, InT y (inter s1 s2) <-> InT y s1 /\ InT y s2).
 Proof.
  intros s1 s2; functional induction inter s1 s2; intros B1 B2;
- [intuition_in|intuition_in | | ];
- factornode _x0 _x1 _x2 _x3 as s2; destruct_split; inv;
+ [intuition_in|intuition_in | | ]; factornode s2;
+ destruct_split; inv;
  destruct IHt0 as (IHo1,IHi1), IHt1 as (IHo2,IHi2); auto with *;
  split; intros.
- (* Ok join *)
- apply join_ok; auto with *; intro y; rewrite ?IHi1, ?IHi2; intuition.
- (* InT join *)
- rewrite join_spec, IHi1, IHi2, split_spec1, split_spec2; intuition_in.
- setoid_replace y with x1; auto. rewrite <- split_spec3; auto.
- (* Ok concat *)
- apply concat_ok; auto with *; intros y1 y2; rewrite IHi1, IHi2; intuition; order.
- (* InT concat *)
- rewrite concat_spec, IHi1, IHi2, split_spec1, split_spec2; auto.
- intuition_in.
- absurd (InT x1 s2).
-  rewrite <- split_spec3; auto; congruence.
-  setoid_replace x1 with y; auto.
+ - (* Ok join *)
+   apply join_ok; auto with *; intro y; rewrite ?IHi1, ?IHi2; intuition.
+ - (* InT join *)
+   rewrite join_spec, IHi1, IHi2, split_spec1, split_spec2; intuition_in.
+   setoid_replace y with x1; auto. rewrite <- split_spec3; auto.
+ - (* Ok concat *)
+   apply concat_ok; auto with *; intros y1 y2; rewrite IHi1, IHi2;
+   intuition; order.
+ - (* InT concat *)
+   rewrite concat_spec, IHi1, IHi2, split_spec1, split_spec2; auto.
+   intuition_in.
+   absurd (InT x1 s2).
+   rewrite <- split_spec3; auto; congruence.
+   setoid_replace x1 with y; auto.
 Qed.
 
 Lemma inter_spec : forall s1 s2 y `{Ok s1, Ok s2},
@@ -1232,31 +679,31 @@ Instance inter_ok s1 s2 `(Ok s1, Ok s2) : Ok (inter s1 s2).
 Proof. intros; destruct (@inter_spec_ok s1 s2); auto. Qed.
 
 
-(** * Difference *)
+(** ** Difference *)
 
 Lemma diff_spec_ok : forall s1 s2 `{Ok s1, Ok s2},
  Ok (diff s1 s2) /\ (forall y, InT y (diff s1 s2) <-> InT y s1 /\ ~InT y s2).
 Proof.
  intros s1 s2; functional induction diff s1 s2; intros B1 B2;
- [intuition_in|intuition_in | | ];
- factornode _x0 _x1 _x2 _x3 as s2; destruct_split; inv;
+ [intuition_in|intuition_in | | ]; factornode s2;
+ destruct_split; inv;
  destruct IHt0 as (IHb1,IHi1), IHt1 as (IHb2,IHi2); auto with *;
  split; intros.
- (* Ok concat *)
- apply concat_ok; auto; intros y1 y2; rewrite IHi1, IHi2; intuition; order.
- (* InT concat *)
- rewrite concat_spec, IHi1, IHi2, split_spec1, split_spec2; intuition_in.
- absurd (InT x1 s2).
-  setoid_replace x1 with y; auto.
-  rewrite <- split_spec3; auto; congruence.
- (* Ok join *)
- apply join_ok; auto; intro y; rewrite ?IHi1, ?IHi2; intuition.
- (* InT join *)
- rewrite join_spec, IHi1, IHi2, split_spec1, split_spec2; auto with *.
- intuition_in.
- absurd (InT x1 s2); auto.
-  rewrite <- split_spec3; auto; congruence.
-  setoid_replace x1 with y; auto.
+ - (* Ok concat *)
+   apply concat_ok; auto; intros y1 y2; rewrite IHi1, IHi2; intuition; order.
+ - (* InT concat *)
+   rewrite concat_spec, IHi1, IHi2, split_spec1, split_spec2; intuition_in.
+   absurd (InT x1 s2).
+   + setoid_replace x1 with y; auto.
+   + rewrite <- split_spec3; auto; congruence.
+ - (* Ok join *)
+   apply join_ok; auto; intro y; rewrite ?IHi1, ?IHi2; intuition.
+ - (* InT join *)
+   rewrite join_spec, IHi1, IHi2, split_spec1, split_spec2; auto with *.
+   intuition_in.
+   absurd (InT x1 s2); auto.
+   * rewrite <- split_spec3; auto; congruence.
+   * setoid_replace x1 with y; auto.
 Qed.
 
 Lemma diff_spec : forall s1 s2 y `{Ok s1, Ok s2},
@@ -1267,7 +714,7 @@ Instance diff_ok s1 s2 `(Ok s1, Ok s2) : Ok (diff s1 s2).
 Proof. intros; destruct (@diff_spec_ok s1 s2); auto. Qed.
 
 
-(** * Union *)
+(** ** Union *)
 
 Lemma union_spec : forall s1 s2 y `{Ok s1, Ok s2},
  (InT y (union s1 s2) <-> InT y s1 \/ InT y s2).
@@ -1275,548 +722,90 @@ Proof.
  intros s1 s2; functional induction union s1 s2; intros y B1 B2.
  intuition_in.
  intuition_in.
- factornode _x0 _x1 _x2 _x3 as s2; destruct_split; inv.
+ factornode s2; destruct_split; inv.
  rewrite join_spec, IHt0, IHt1, split_spec1, split_spec2; auto with *.
- elim_compare y x1; intuition_in.
+ destruct (X.compare_spec y x1); intuition_in.
 Qed.
 
 Instance union_ok s1 s2 : forall `(Ok s1, Ok s2), Ok (union s1 s2).
 Proof.
  functional induction union s1 s2; intros B1 B2; auto.
- factornode _x0 _x1 _x2 _x3 as s2; destruct_split; inv.
+ factornode s2; destruct_split; inv.
  apply join_ok; auto with *.
  intro y; rewrite union_spec, split_spec1; intuition_in.
  intro y; rewrite union_spec, split_spec2; intuition_in.
 Qed.
 
-
-(** * Elements *)
-
-Lemma elements_spec1' : forall s acc x,
- InA X.eq x (elements_aux acc s) <-> InT x s \/ InA X.eq x acc.
-Proof.
- induction s as [ | l Hl x r Hr h ]; simpl; auto.
- intuition.
- inversion H0.
- intros.
- rewrite Hl.
- destruct (Hr acc x0); clear Hl Hr.
- intuition; inversion_clear H3; intuition.
-Qed.
-
-Lemma elements_spec1 : forall s x, InA X.eq x (elements s) <-> InT x s.
-Proof.
- intros; generalize (elements_spec1' s nil x); intuition.
- inversion_clear H0.
-Qed.
-
-Lemma elements_spec2' : forall s acc `{Ok s}, sort X.lt acc ->
- (forall x y : elt, InA X.eq x acc -> InT y s -> X.lt y x) ->
- sort X.lt (elements_aux acc s).
-Proof.
- induction s as [ | l Hl y r Hr h]; simpl; intuition.
- inv.
- apply Hl; auto.
- constructor.
- apply Hr; auto.
- eapply InA_InfA; eauto with *.
- intros.
- destruct (elements_spec1' r acc y0); intuition.
- intros.
- inversion_clear H.
- order.
- destruct (elements_spec1' r acc x); intuition eauto.
-Qed.
-
-Lemma elements_spec2 : forall s `(Ok s), sort X.lt (elements s).
-Proof.
- intros; unfold elements; apply elements_spec2'; auto.
- intros; inversion H0.
-Qed.
-Local Hint Resolve elements_spec2.
-
-Lemma elements_spec2w : forall s `(Ok s), NoDupA X.eq (elements s).
-Proof.
- intros. eapply SortA_NoDupA; eauto with *.
-Qed.
-
-Lemma elements_aux_cardinal :
- forall s acc, (length acc + cardinal s)%nat = length (elements_aux acc s).
-Proof.
- simple induction s; simpl in |- *; intuition.
- rewrite <- H.
- simpl in |- *.
- rewrite <- H0; omega.
-Qed.
-
-Lemma elements_cardinal : forall s : tree, cardinal s = length (elements s).
-Proof.
- exact (fun s => elements_aux_cardinal s nil).
-Qed.
-
-Definition cardinal_spec (s:t)(Hs:Ok s) := elements_cardinal s.
-
-Lemma elements_app :
- forall s acc, elements_aux acc s = elements s ++ acc.
-Proof.
- induction s; simpl; intros; auto.
- rewrite IHs1, IHs2.
- unfold elements; simpl.
- rewrite 2 IHs1, IHs2, <- !app_nil_end, !app_ass; auto.
-Qed.
-
-Lemma elements_node :
- forall l x r h acc,
- elements l ++ x :: elements r ++ acc =
- elements (Node l x r h) ++ acc.
-Proof.
- unfold elements; simpl; intros; auto.
- rewrite !elements_app, <- !app_nil_end, !app_ass; auto.
-Qed.
-
-
 (** * Filter *)
 
-Lemma filter_spec' : forall s x acc f,
- Proper (X.eq==>eq) f ->
- (InT x (filter_acc f acc s) <-> InT x acc \/ InT x s /\ f x = true).
-Proof.
- induction s; simpl; intros.
- intuition_in.
- rewrite IHs2, IHs1 by (destruct (f t0); auto).
- case_eq (f t0); intros.
- rewrite add_spec'; auto.
- intuition_in.
- rewrite (H _ _ H2).
- intuition.
- intuition_in.
- rewrite (H _ _ H2) in H3.
- rewrite H0 in H3; discriminate.
-Qed.
-
-Instance filter_ok' : forall s acc f `(Ok s, Ok acc),
- Ok (filter_acc f acc s).
+Lemma filter_spec : forall s x f,
+ Proper (X.eq==>Logic.eq) f ->
+ (InT x (filter f s) <-> InT x s /\ f x = true).
 Proof.
- induction s; simpl; auto.
- intros. inv.
- destruct (f t0); auto with *.
+ induction s as [ |h l Hl x0 r Hr]; intros x f Hf; simpl.
+ - intuition_in.
+ - case_eq (f x0); intros Hx0.
+   * rewrite join_spec, Hl, Hr; intuition_in.
+     now setoid_replace x with x0.
+   * rewrite concat_spec, Hl, Hr; intuition_in.
+     assert (f x = f x0) by auto. congruence.
 Qed.
 
-Lemma filter_spec : forall s x f,
- Proper (X.eq==>eq) f ->
- (InT x (filter f s) <-> InT x s /\ f x = true).
+Lemma filter_weak_spec : forall s x f,
+ InT x (filter f s) -> InT x s.
 Proof.
- unfold filter; intros; rewrite filter_spec'; intuition_in.
+ induction s as [ |h l Hl x0 r Hr]; intros x f; simpl.
+ - trivial.
+ - destruct (f x0).
+   * rewrite join_spec; intuition_in; eauto.
+   * rewrite concat_spec; intuition_in; eauto.
 Qed.
 
-Instance filter_ok s f `(Ok s) : Ok (filter f s).
+Instance filter_ok s f `(H : Ok s) : Ok (filter f s).
 Proof.
- unfold filter; intros; apply filter_ok'; auto.
+ induction H as [ | h x l r Hl Hfl Hr Hfr Hlt Hgt ].
+ - constructor.
+ - simpl.
+   assert (lt_tree x (filter f l)) by (eauto using filter_weak_spec).
+   assert (gt_tree x (filter f r)) by (eauto using filter_weak_spec).
+   destruct (f x); eauto using concat_ok, join_ok.
 Qed.
 
 
 (** * Partition *)
 
-Lemma partition_spec1' : forall s acc f,
- Proper (X.eq==>eq) f -> forall x : elt,
- InT x (partition_acc f acc s)#1 <->
- InT x acc#1 \/ InT x s /\ f x = true.
+Lemma partition_spec1' s f : (partition f s)#1 = filter f s.
 Proof.
- induction s; simpl; intros.
- intuition_in.
- destruct acc as [acct accf]; simpl in *.
- rewrite IHs2 by
-  (destruct (f t0); auto; apply partition_acc_avl_1; simpl; auto).
- rewrite IHs1 by (destruct (f t0); simpl; auto).
- case_eq (f t0); simpl; intros.
- rewrite add_spec'; auto.
- intuition_in.
- rewrite (H _ _ H2).
- intuition.
- intuition_in.
- rewrite (H _ _ H2) in H3.
- rewrite H0 in H3; discriminate.
+ induction s as [ | h l Hl x r Hr ]; simpl.
+ - trivial.
+ - rewrite <- Hl, <- Hr.
+   now destruct (partition f l), (partition f r), (f x).
 Qed.
 
-Lemma partition_spec2' : forall s acc f,
- Proper (X.eq==>eq) f -> forall x : elt,
- InT x (partition_acc f acc s)#2 <->
- InT x acc#2 \/ InT x s /\ f x = false.
+Lemma partition_spec2' s f :
+ (partition f s)#2 = filter (fun x => negb (f x)) s.
 Proof.
- induction s; simpl; intros.
- intuition_in.
- destruct acc as [acct accf]; simpl in *.
- rewrite IHs2 by
-  (destruct (f t0); auto; apply partition_acc_avl_2; simpl; auto).
- rewrite IHs1 by (destruct (f t0); simpl; auto).
- case_eq (f t0); simpl; intros.
- intuition.
- intuition_in.
- rewrite (H _ _ H2) in H3.
- rewrite H0 in H3; discriminate.
- rewrite add_spec'; auto.
- intuition_in.
- rewrite (H _ _ H2).
- intuition.
+ induction s as [ | h l Hl x r Hr ]; simpl.
+ - trivial.
+ - rewrite <- Hl, <- Hr.
+   now destruct (partition f l), (partition f r), (f x).
 Qed.
 
-Lemma partition_spec1 : forall s f,
- Proper (X.eq==>eq) f ->
+Lemma partition_spec1 s f :
+ Proper (X.eq==>Logic.eq) f ->
  Equal (partition f s)#1 (filter f s).
-Proof.
- unfold partition; intros s f P x.
- rewrite partition_spec1', filter_spec; simpl; intuition_in.
-Qed.
+Proof. now rewrite partition_spec1'. Qed.
 
-Lemma partition_spec2 : forall s f,
- Proper (X.eq==>eq) f ->
+Lemma partition_spec2 s f :
+ Proper (X.eq==>Logic.eq) f ->
  Equal (partition f s)#2 (filter (fun x => negb (f x)) s).
-Proof.
- unfold partition; intros s f P x.
- rewrite partition_spec2', filter_spec; simpl; intuition_in.
- rewrite H1; auto.
- right; split; auto.
- rewrite negb_true_iff in H1; auto.
- intros u v H; rewrite H; auto.
-Qed.
-
-Instance partition_ok1' : forall s acc f `(Ok s, Ok acc#1),
- Ok (partition_acc f acc s)#1.
-Proof.
- induction s; simpl; auto.
- destruct acc as [acct accf]; simpl in *.
- intros. inv.
- destruct (f t0); auto.
- apply IHs2; simpl; auto.
- apply IHs1; simpl; auto with *.
-Qed.
-
-Instance partition_ok2' : forall s acc f `(Ok s, Ok acc#2),
- Ok (partition_acc f acc s)#2.
-Proof.
- induction s; simpl; auto.
- destruct acc as [acct accf]; simpl in *.
- intros. inv.
- destruct (f t0); auto.
- apply IHs2; simpl; auto.
- apply IHs1; simpl; auto with *.
-Qed.
+Proof. now rewrite partition_spec2'. Qed.
 
 Instance partition_ok1 s f `(Ok s) : Ok (partition f s)#1.
-Proof. apply partition_ok1'; auto. Qed.
+Proof. rewrite partition_spec1'; now apply filter_ok. Qed.
 
 Instance partition_ok2 s f `(Ok s) : Ok (partition f s)#2.
-Proof. apply partition_ok2'; auto. Qed.
-
-
-
-(** * [for_all] and [exists] *)
-
-Lemma for_all_spec : forall s f, Proper (X.eq==>eq) f ->
- (for_all f s = true <-> For_all (fun x => f x = true) s).
-Proof.
- split.
- induction s; simpl; auto; intros; red; intros; inv.
- destruct (andb_prop _ _ H0); auto.
- destruct (andb_prop _ _ H1); eauto.
- apply IHs1; auto.
- destruct (andb_prop _ _ H0); auto.
- destruct (andb_prop _ _ H1); auto.
- apply IHs2; auto.
- destruct (andb_prop _ _ H0); auto.
- (* <- *)
- induction s; simpl; auto.
- intros. red in H0.
- rewrite IHs1; try red; auto.
- rewrite IHs2; try red; auto.
- generalize (H0 t0).
- destruct (f t0); simpl; auto.
-Qed.
-
-Lemma exists_spec : forall s f, Proper (X.eq==>eq) f ->
- (exists_ f s = true <-> Exists (fun x => f x = true) s).
-Proof.
- split.
- induction s; simpl; intros; rewrite <- ?orb_lazy_alt in *.
- discriminate.
- destruct (orb_true_elim _ _ H0) as [H1|H1].
- destruct (orb_true_elim _ _ H1) as [H2|H2].
- exists t0; auto.
- destruct (IHs1 H2); auto; exists x; intuition.
- destruct (IHs2 H1); auto; exists x; intuition.
- (* <- *)
- induction s; simpl; destruct 1 as (x,(U,V)); inv; rewrite <- ?orb_lazy_alt.
- rewrite (H _ _ (MX.eq_sym H0)); rewrite V; auto.
- apply orb_true_intro; left.
- apply orb_true_intro; right; apply IHs1; auto; exists x; auto.
- apply orb_true_intro; right; apply IHs2; auto; exists x; auto.
-Qed.
-
-
-(** * Fold *)
-
-Lemma fold_spec' :
- forall (A : Type) (f : elt -> A -> A) (s : tree) (i : A) (acc : list elt),
- fold_left (flip f) (elements_aux acc s) i = fold_left (flip f) acc (fold f s i).
-Proof.
- induction s as [|l IHl x r IHr h]; simpl; intros; auto.
- rewrite IHl.
- simpl. unfold flip at 2.
- apply IHr.
-Qed.
-
-Lemma fold_spec :
- forall (s:t) (A : Type) (i : A) (f : elt -> A -> A),
- fold f s i = fold_left (flip f) (elements s) i.
-Proof.
- unfold elements.
- induction s as [|l IHl x r IHr h]; simpl; intros; auto.
- rewrite fold_spec'.
- rewrite IHr.
- simpl; auto.
-Qed.
-
-
-(** * Subset *)
-
-Lemma subsetl_spec : forall subset_l1 l1 x1 h1 s2
- `{Ok (Node l1 x1 Leaf h1), Ok s2},
- (forall s `{Ok s}, (subset_l1 s = true <-> Subset l1 s)) ->
- (subsetl subset_l1 x1 s2 = true <-> Subset (Node l1 x1 Leaf h1) s2 ).
-Proof.
- induction s2 as [|l2 IHl2 x2 r2 IHr2 h2]; simpl; intros.
- unfold Subset; intuition; try discriminate.
- assert (H': InT x1 Leaf) by auto; inversion H'.
- specialize (IHl2 H).
- specialize (IHr2 H).
- inv.
- elim_compare x1 x2.
-
- rewrite H1 by auto; clear H1 IHl2 IHr2.
- unfold Subset. intuition_in.
- assert (X.eq a x2) by order; intuition_in.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
-
- rewrite IHl2 by auto; clear H1 IHl2 IHr2.
- unfold Subset. intuition_in.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
-
- rewrite <-andb_lazy_alt, andb_true_iff, H1 by auto; clear H1 IHl2 IHr2.
- unfold Subset. intuition_in.
- constructor 3. setoid_replace a with x1; auto. rewrite <- mem_spec; auto.
- rewrite mem_spec; auto.
- assert (InT x1 (Node l2 x2 r2 h2)) by auto; intuition_in; order.
-Qed.
-
-
-Lemma subsetr_spec : forall subset_r1 r1 x1 h1 s2,
- bst (Node Leaf x1 r1 h1) -> bst s2 ->
- (forall s, bst s -> (subset_r1 s = true <-> Subset r1 s)) ->
- (subsetr subset_r1 x1 s2 = true <-> Subset (Node Leaf x1 r1 h1) s2).
-Proof.
- induction s2 as [|l2 IHl2 x2 r2 IHr2 h2]; simpl; intros.
- unfold Subset; intuition; try discriminate.
- assert (H': InT x1 Leaf) by auto; inversion H'.
- specialize (IHl2 H).
- specialize (IHr2 H).
- inv.
- elim_compare x1 x2.
-
- rewrite H1 by auto; clear H1 IHl2 IHr2.
- unfold Subset. intuition_in.
- assert (X.eq a x2) by order; intuition_in.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
-
- rewrite <-andb_lazy_alt, andb_true_iff, H1 by auto;  clear H1 IHl2 IHr2.
- unfold Subset. intuition_in.
- constructor 2. setoid_replace a with x1; auto. rewrite <- mem_spec; auto.
- rewrite mem_spec; auto.
- assert (InT x1 (Node l2 x2 r2 h2)) by auto; intuition_in; order.
-
- rewrite IHr2 by auto; clear H1 IHl2 IHr2.
- unfold Subset. intuition_in.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
-Qed.
-
-Lemma subset_spec : forall s1 s2 `{Ok s1, Ok s2},
- (subset s1 s2 = true <-> Subset s1 s2).
-Proof.
- induction s1 as [|l1 IHl1 x1 r1 IHr1 h1]; simpl; intros.
- unfold Subset; intuition_in.
- destruct s2 as [|l2 x2 r2 h2]; simpl; intros.
- unfold Subset; intuition_in; try discriminate.
- assert (H': InT x1 Leaf) by auto; inversion H'.
- inv.
- elim_compare x1 x2.
-
- rewrite <-andb_lazy_alt, andb_true_iff, IHl1, IHr1 by auto.
- clear IHl1 IHr1.
- unfold Subset; intuition_in.
- assert (X.eq a x2) by order; intuition_in.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
-
- rewrite <-andb_lazy_alt, andb_true_iff, IHr1 by auto.
- rewrite (@subsetl_spec (subset l1) l1 x1 h1) by auto.
- clear IHl1 IHr1.
- unfold Subset; intuition_in.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
-
- rewrite <-andb_lazy_alt, andb_true_iff, IHl1 by auto.
- rewrite (@subsetr_spec (subset r1) r1 x1 h1) by auto.
- clear IHl1 IHr1.
- unfold Subset; intuition_in.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
- assert (InT a (Node l2 x2 r2 h2)) by auto; intuition_in; order.
-Qed.
-
-
-(** * Comparison *)
-
-(** ** Relations [eq] and [lt] over trees *)
-
-Module L := MakeListOrdering X.
-
-Definition eq := Equal.
-Instance eq_equiv : Equivalence eq.
-Proof. firstorder. Qed.
-
-Lemma eq_Leq : forall s s', eq s s' <-> L.eq (elements s) (elements s').
-Proof.
- unfold eq, Equal, L.eq; intros.
- setoid_rewrite elements_spec1; firstorder.
-Qed.
-
-Definition lt (s1 s2 : t) : Prop :=
- exists s1', exists s2', Ok s1' /\ Ok s2' /\ eq s1 s1' /\ eq s2 s2'
-   /\ L.lt (elements s1') (elements s2').
-
-Instance lt_strorder : StrictOrder lt.
-Proof.
- split.
- intros s (s1 & s2 & B1 & B2 & E1 & E2 & L).
- assert (eqlistA X.eq (elements s1) (elements s2)).
-  apply SortA_equivlistA_eqlistA with (ltA:=X.lt); auto with *.
-  rewrite <- eq_Leq. transitivity s; auto. symmetry; auto.
- rewrite H in L.
- apply (StrictOrder_Irreflexive (elements s2)); auto.
- intros s1 s2 s3 (s1' & s2' & B1 & B2 & E1 & E2 & L12)
-                 (s2'' & s3' & B2' & B3 & E2' & E3 & L23).
- exists s1', s3'; do 4 (split; trivial).
- assert (eqlistA X.eq (elements s2') (elements s2'')).
-  apply SortA_equivlistA_eqlistA with (ltA:=X.lt); auto with *.
-  rewrite <- eq_Leq. transitivity s2; auto. symmetry; auto.
- transitivity (elements s2'); auto.
- rewrite H; auto.
-Qed.
-
-Instance lt_compat : Proper (eq==>eq==>iff) lt.
-Proof.
- intros s1 s2 E12 s3 s4 E34. split.
- intros (s1' & s3' & B1 & B3 & E1 & E3 & LT).
- exists s1', s3'; do 2 (split; trivial).
-  split. transitivity s1; auto. symmetry; auto.
-  split; auto. transitivity s3; auto. symmetry; auto.
- intros (s1' & s3' & B1 & B3 & E1 & E3 & LT).
- exists s1', s3'; do 2 (split; trivial).
-  split. transitivity s2; auto.
-  split; auto. transitivity s4; auto.
-Qed.
-
-
-(** * Proof of the comparison algorithm *)
-
-(** [flatten_e e] returns the list of elements of [e] i.e. the list
-    of elements actually compared *)
-
-Fixpoint flatten_e (e : enumeration) : list elt := match e with
-  | End => nil
-  | More x t r => x :: elements t ++ flatten_e r
- end.
-
-Lemma flatten_e_elements :
- forall l x r h e,
- elements l ++ flatten_e (More x r e) = elements (Node l x r h) ++ flatten_e e.
-Proof.
- intros; simpl; apply elements_node.
-Qed.
-
-Lemma cons_1 : forall s e,
-  flatten_e (cons s e) = elements s ++ flatten_e e.
-Proof.
- induction s; simpl; auto; intros.
- rewrite IHs1; apply flatten_e_elements.
-Qed.
-
-(** Correctness of this comparison *)
-
-Definition Cmp c x y := CompSpec L.eq L.lt x y c.
-
-Local Hint Unfold Cmp flip.
-
-Lemma compare_end_Cmp :
- forall e2, Cmp (compare_end e2) nil (flatten_e e2).
-Proof.
- destruct e2; simpl; constructor; auto. reflexivity.
-Qed.
-
-Lemma compare_more_Cmp : forall x1 cont x2 r2 e2 l,
-  Cmp (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) ->
-   Cmp (compare_more x1 cont (More x2 r2 e2)) (x1::l)
-      (flatten_e (More x2 r2 e2)).
-Proof.
- simpl; intros; elim_compare x1 x2; simpl; auto.
-Qed.
-
-Lemma compare_cont_Cmp : forall s1 cont e2 l,
- (forall e, Cmp (cont e) l (flatten_e e)) ->
- Cmp (compare_cont s1 cont e2) (elements s1 ++ l) (flatten_e e2).
-Proof.
- induction s1 as [|l1 Hl1 x1 r1 Hr1 h1]; simpl; intros; auto.
- rewrite <- elements_node; simpl.
- apply Hl1; auto. clear e2. intros [|x2 r2 e2].
- simpl; auto.
- apply compare_more_Cmp.
- rewrite <- cons_1; auto.
-Qed.
-
-Lemma compare_Cmp : forall s1 s2,
- Cmp (compare s1 s2) (elements s1) (elements s2).
-Proof.
- intros; unfold compare.
- rewrite (app_nil_end (elements s1)).
- replace (elements s2) with (flatten_e (cons s2 End)) by
-  (rewrite cons_1; simpl; rewrite <- app_nil_end; auto).
- apply compare_cont_Cmp; auto.
- intros.
- apply compare_end_Cmp; auto.
-Qed.
-
-Lemma compare_spec : forall s1 s2 `{Ok s1, Ok s2},
- CompSpec eq lt s1 s2 (compare s1 s2).
-Proof.
- intros.
- destruct (compare_Cmp s1 s2); constructor.
- rewrite eq_Leq; auto.
- intros; exists s1, s2; repeat split; auto.
- intros; exists s2, s1; repeat split; auto.
-Qed.
-
-
-(** * Equality test *)
-
-Lemma equal_spec : forall s1 s2 `{Ok s1, Ok s2},
- equal s1 s2 = true <-> eq s1 s2.
-Proof.
-unfold equal; intros s1 s2 B1 B2.
-destruct (@compare_spec s1 s2 B1 B2) as [H|H|H];
- split; intros H'; auto; try discriminate.
-rewrite H' in H. elim (StrictOrder_Irreflexive s2); auto.
-rewrite H' in H. elim (StrictOrder_Irreflexive s2); auto.
-Qed.
+Proof. rewrite partition_spec2'; now apply filter_ok. Qed.
 
 End MakeRaw.
 
diff --git a/theories/MSets/MSetDecide.v b/theories/MSets/MSetDecide.v
index 4ec050bd..eefd2951 100644
--- a/theories/MSets/MSetDecide.v
+++ b/theories/MSets/MSetDecide.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 (**************************************************************)
 (* MSetDecide.v                                               *)
 (*                                                            *)
diff --git a/theories/MSets/MSetEqProperties.v b/theories/MSets/MSetEqProperties.v
index fe6c3c79..4f0d93fb 100644
--- a/theories/MSets/MSetEqProperties.v
+++ b/theories/MSets/MSetEqProperties.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 (** * Finite sets library *)
 
 (** This module proves many properties of finite sets that
@@ -208,7 +206,7 @@ intros.
 generalize (@choose_1 s) (@choose_2 s).
 destruct (choose s);intros.
 exists e;auto with set.
-generalize (H1 (refl_equal None)); clear H1.
+generalize (H1 (eq_refl None)); clear H1.
 intros; rewrite (is_empty_1 H1) in H; discriminate.
 Qed.
 
@@ -633,7 +631,7 @@ destruct (choose (filter f s)).
 intros H0 _; apply exists_1; auto.
 exists e; generalize (H0 e); rewrite filter_iff; auto.
 intros _ H0.
-rewrite (is_empty_1 (H0 (refl_equal None))) in H; auto; discriminate.
+rewrite (is_empty_1 (H0 (eq_refl None))) in H; auto; discriminate.
 Qed.
 
 Lemma partition_filter_1:
@@ -881,8 +879,8 @@ generalize (@add_filter_1 f Hf s0 (add x s0) x) (@add_filter_2 f Hf s0 (add x s0
 assert (~ In x (filter f s0)).
  intro H1; rewrite (mem_1 (filter_1 Hf H1)) in H; discriminate H.
 case (f x); simpl; intros.
-rewrite (MP.cardinal_2 H1 (H2 (refl_equal true) (MP.Add_add s0 x))); auto.
-rewrite <- (MP.Equal_cardinal (H3 (refl_equal false) (MP.Add_add s0 x))); auto.
+rewrite (MP.cardinal_2 H1 (H2 (eq_refl true) (MP.Add_add s0 x))); auto.
+rewrite <- (MP.Equal_cardinal (H3 (eq_refl false) (MP.Add_add s0 x))); auto.
 intros; rewrite fold_empty;auto.
 rewrite MP.cardinal_1; auto.
 unfold Empty; intros.
diff --git a/theories/MSets/MSetFacts.v b/theories/MSets/MSetFacts.v
index 6d38b696..4e17618f 100644
--- a/theories/MSets/MSetFacts.v
+++ b/theories/MSets/MSetFacts.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 (** * Finite sets library *)
 
 (** This functor derives additional facts from [MSetInterface.S]. These
diff --git a/theories/MSets/MSetGenTree.v b/theories/MSets/MSetGenTree.v
new file mode 100644
index 00000000..704ff31b
--- /dev/null
+++ b/theories/MSets/MSetGenTree.v
@@ -0,0 +1,1145 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(** * MSetGenTree : sets via generic trees
+
+    This module factorizes common parts in implementations
+    of finite sets as AVL trees and as Red-Black trees. The nodes
+    of the trees defined here include an generic information
+    parameter, that will be the heigth in AVL trees and the color
+    in Red-Black trees. Without more details here about these
+    information parameters, trees here are not known to be
+    well-balanced, but simply binary-search-trees.
+
+    The operations we could define and prove correct here are the
+    one that do not build non-empty trees, but only analyze them :
+
+     - empty is_empty
+     - mem
+     - compare equal subset
+     - fold cardinal elements
+     - for_all exists_
+     - min_elt max_elt choose
+*)
+
+Require Import Orders OrdersFacts MSetInterface NPeano.
+Local Open Scope list_scope.
+Local Open Scope lazy_bool_scope.
+
+(* For nicer extraction, we create induction principles
+   only when needed *)
+Local Unset Elimination Schemes.
+Local Unset Case Analysis Schemes.
+
+Module Type InfoTyp.
+ Parameter t : Set.
+End InfoTyp.
+
+(** * Ops : the pure functions *)
+
+Module Type Ops (X:OrderedType)(Info:InfoTyp).
+
+Definition elt := X.t.
+Hint Transparent elt.
+
+Inductive tree  : Type :=
+| Leaf : tree
+| Node : Info.t -> tree -> X.t -> tree -> tree.
+
+(** ** The empty set and emptyness test *)
+
+Definition empty := Leaf.
+
+Definition is_empty t :=
+ match t with
+ | Leaf => true
+ | _ => false
+ end.
+
+(** ** Membership test *)
+
+(** The [mem] function is deciding membership. It exploits the
+    binary search tree invariant to achieve logarithmic complexity. *)
+
+Fixpoint mem x t :=
+ match t with
+ | Leaf => false
+ | Node _ l k r =>
+   match X.compare x k with
+     | Lt => mem x l
+     | Eq => true
+     | Gt => mem x r
+   end
+ end.
+
+(** ** Minimal, maximal, arbitrary elements *)
+
+Fixpoint min_elt (t : tree) : option elt :=
+ match t with
+ | Leaf => None
+ | Node _ Leaf x r => Some x
+ | Node _ l x r => min_elt l
+ end.
+
+Fixpoint max_elt (t : tree) : option elt :=
+  match t with
+  | Leaf => None
+  | Node _ l x Leaf => Some x
+  | Node _ l x r => max_elt r
+  end.
+
+Definition choose := min_elt.
+
+(** ** Iteration on elements *)
+
+Fixpoint fold {A: Type} (f: elt -> A -> A) (t: tree) (base: A) : A :=
+  match t with
+  | Leaf => base
+  | Node _ l x r => fold f r (f x (fold f l base))
+ end.
+
+Fixpoint elements_aux acc s :=
+  match s with
+   | Leaf => acc
+   | Node _ l x r => elements_aux (x :: elements_aux acc r) l
+  end.
+
+Definition elements := elements_aux nil.
+
+Fixpoint rev_elements_aux acc s :=
+  match s with
+   | Leaf => acc
+   | Node _ l x r => rev_elements_aux (x :: rev_elements_aux acc l) r
+  end.
+
+Definition rev_elements := rev_elements_aux nil.
+
+Fixpoint cardinal (s : tree) : nat :=
+  match s with
+   | Leaf => 0
+   | Node _ l _ r => S (cardinal l + cardinal r)
+  end.
+
+Fixpoint maxdepth s :=
+ match s with
+ | Leaf => 0
+ | Node _ l _ r => S (max (maxdepth l) (maxdepth r))
+ end.
+
+Fixpoint mindepth s :=
+ match s with
+ | Leaf => 0
+ | Node _ l _ r => S (min (mindepth l) (mindepth r))
+ end.
+
+(** ** Testing universal or existential properties. *)
+
+(** We do not use the standard boolean operators of Coq,
+    but lazy ones. *)
+
+Fixpoint for_all (f:elt->bool) s := match s with
+  | Leaf => true
+  | Node _ l x r => f x &&& for_all f l &&& for_all f r
+end.
+
+Fixpoint exists_ (f:elt->bool) s := match s with
+  | Leaf => false
+  | Node _ l x r => f x ||| exists_ f l ||| exists_ f r
+end.
+
+(** ** Comparison of trees *)
+
+(** The algorithm here has been suggested by Xavier Leroy,
+    and transformed into c.p.s. by Benjamin Grégoire.
+    The original ocaml code (with non-structural recursive calls)
+    has also been formalized (thanks to Function+measure), see
+    [ocaml_compare] in [MSetFullAVL]. The following code with
+    continuations computes dramatically faster in Coq, and
+    should be almost as efficient after extraction.
+*)
+
+(** Enumeration of the elements of a tree. This corresponds
+    to the "samefringe" notion in the litterature. *)
+
+Inductive enumeration :=
+ | End : enumeration
+ | More : elt -> tree -> enumeration -> enumeration.
+
+
+(** [cons t e] adds the elements of tree [t] on the head of
+    enumeration [e]. *)
+
+Fixpoint cons s e : enumeration :=
+ match s with
+  | Leaf => e
+  | Node _ l x r => cons l (More x r e)
+ end.
+
+(** One step of comparison of elements *)
+
+Definition compare_more x1 (cont:enumeration->comparison) e2 :=
+ match e2 with
+ | End => Gt
+ | More x2 r2 e2 =>
+     match X.compare x1 x2 with
+      | Eq => cont (cons r2 e2)
+      | Lt => Lt
+      | Gt => Gt
+     end
+ end.
+
+(** Comparison of left tree, middle element, then right tree *)
+
+Fixpoint compare_cont s1 (cont:enumeration->comparison) e2 :=
+ match s1 with
+  | Leaf => cont e2
+  | Node _ l1 x1 r1 =>
+     compare_cont l1 (compare_more x1 (compare_cont r1 cont)) e2
+  end.
+
+(** Initial continuation *)
+
+Definition compare_end e2 :=
+ match e2 with End => Eq | _ => Lt end.
+
+(** The complete comparison *)
+
+Definition compare s1 s2 := compare_cont s1 compare_end (cons s2 End).
+
+Definition equal s1 s2 :=
+ match compare s1 s2 with Eq => true | _ => false end.
+
+(** ** Subset test *)
+
+(** In ocaml, recursive calls are made on "half-trees" such as
+   (Node _ l1 x1 Leaf) and (Node _ Leaf x1 r1). Instead of these
+   non-structural calls, we propose here two specialized functions
+   for these situations. This version should be almost as efficient
+   as the one of ocaml (closures as arguments may slow things a bit),
+   it is simply less compact. The exact ocaml version has also been
+   formalized (thanks to Function+measure), see [ocaml_subset] in
+   [MSetFullAVL].
+*)
+
+Fixpoint subsetl (subset_l1 : tree -> bool) x1 s2 : bool :=
+ match s2 with
+  | Leaf => false
+  | Node _ l2 x2 r2 =>
+     match X.compare x1 x2 with
+      | Eq => subset_l1 l2
+      | Lt => subsetl subset_l1 x1 l2
+      | Gt => mem x1 r2 &&& subset_l1 s2
+     end
+ end.
+
+Fixpoint subsetr (subset_r1 : tree -> bool) x1 s2 : bool :=
+ match s2 with
+  | Leaf => false
+  | Node _ l2 x2 r2 =>
+     match X.compare x1 x2 with
+      | Eq => subset_r1 r2
+      | Lt => mem x1 l2 &&& subset_r1 s2
+      | Gt => subsetr subset_r1 x1 r2
+     end
+ end.
+
+Fixpoint subset s1 s2 : bool := match s1, s2 with
+  | Leaf, _ => true
+  | Node _ _ _ _, Leaf => false
+  | Node _ l1 x1 r1, Node _ l2 x2 r2 =>
+     match X.compare x1 x2 with
+      | Eq => subset l1 l2 &&& subset r1 r2
+      | Lt => subsetl (subset l1) x1 l2 &&& subset r1 s2
+      | Gt => subsetr (subset r1) x1 r2 &&& subset l1 s2
+     end
+ end.
+
+End Ops.
+
+(** * Props : correctness proofs of these generic operations *)
+
+Module Type Props (X:OrderedType)(Info:InfoTyp)(Import M:Ops X Info).
+
+(** ** Occurrence in a tree *)
+
+Inductive InT (x : elt) : tree -> Prop :=
+  | IsRoot : forall c l r y, X.eq x y -> InT x (Node c l y r)
+  | InLeft : forall c l r y, InT x l -> InT x (Node c l y r)
+  | InRight : forall c l r y, InT x r -> InT x (Node c l y r).
+
+Definition In := InT.
+
+(** ** Some shortcuts *)
+
+Definition Equal s s' := forall a : elt, InT a s <-> InT a s'.
+Definition Subset s s' := forall a : elt, InT a s -> InT a s'.
+Definition Empty s := forall a : elt, ~ InT a s.
+Definition For_all (P : elt -> Prop) s := forall x, InT x s -> P x.
+Definition Exists (P : elt -> Prop) s := exists x, InT x s /\ P x.
+
+(** ** Binary search trees *)
+
+(** [lt_tree x s]: all elements in [s] are smaller than [x]
+   (resp. greater for [gt_tree]) *)
+
+Definition lt_tree x s := forall y, InT y s -> X.lt y x.
+Definition gt_tree x s := forall y, InT y s -> X.lt x y.
+
+(** [bst t] : [t] is a binary search tree *)
+
+Inductive bst : tree -> Prop :=
+  | BSLeaf : bst Leaf
+  | BSNode : forall c x l r, bst l -> bst r ->
+     lt_tree x l -> gt_tree x r -> bst (Node c l x r).
+
+(** [bst] is the (decidable) invariant our trees will have to satisfy. *)
+
+Definition IsOk := bst.
+
+Class Ok (s:tree) : Prop := ok : bst s.
+
+Instance bst_Ok s (Hs : bst s) : Ok s := { ok := Hs }.
+
+Fixpoint ltb_tree x s :=
+ match s with
+  | Leaf => true
+  | Node _ l y r =>
+     match X.compare x y with
+      | Gt => ltb_tree x l && ltb_tree x r
+      | _ => false
+     end
+ end.
+
+Fixpoint gtb_tree x s :=
+ match s with
+  | Leaf => true
+  | Node _ l y r =>
+     match X.compare x y with
+      | Lt => gtb_tree x l && gtb_tree x r
+      | _ => false
+     end
+ end.
+
+Fixpoint isok s :=
+ match s with
+  | Leaf => true
+  | Node _  l x r => isok l && isok r && ltb_tree x l && gtb_tree x r
+ end.
+
+
+(** ** Known facts about ordered types *)
+
+Module Import MX := OrderedTypeFacts X.
+
+(** ** Automation and dedicated tactics *)
+
+Scheme tree_ind := Induction for tree Sort Prop.
+Scheme bst_ind := Induction for bst Sort Prop.
+
+Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans @ok.
+Local Hint Immediate MX.eq_sym.
+Local Hint Unfold In lt_tree gt_tree.
+Local Hint Constructors InT bst.
+Local Hint Unfold Ok.
+
+(** Automatic treatment of [Ok] hypothesis *)
+
+Ltac clear_inversion H := inversion H; clear H; subst.
+
+Ltac inv_ok := match goal with
+ | H:Ok (Node _ _ _ _) |- _ => clear_inversion H; inv_ok
+ | H:Ok Leaf |- _ => clear H; inv_ok
+ | H:bst ?x |- _ => change (Ok x) in H; inv_ok
+ | _ => idtac
+end.
+
+(** A tactic to repeat [inversion_clear] on all hyps of the
+    form [(f (Node _ _ _ _))] *)
+
+Ltac is_tree_constr c :=
+  match c with
+   | Leaf => idtac
+   | Node _ _ _ _ => idtac
+   | _ => fail
+  end.
+
+Ltac invtree f :=
+  match goal with
+     | H:f ?s |- _ => is_tree_constr s; clear_inversion H; invtree f
+     | H:f _ ?s |- _ => is_tree_constr s; clear_inversion H; invtree f
+     | H:f _ _ ?s |- _ => is_tree_constr s; clear_inversion H; invtree f
+     | _ => idtac
+  end.
+
+Ltac inv := inv_ok; invtree InT.
+
+Ltac intuition_in := repeat progress (intuition; inv).
+
+(** Helper tactic concerning order of elements. *)
+
+Ltac order := match goal with
+ | U: lt_tree _ ?s, V: InT _ ?s |- _ => generalize (U _ V); clear U; order
+ | U: gt_tree _ ?s, V: InT _ ?s |- _ => generalize (U _ V); clear U; order
+ | _ => MX.order
+end.
+
+
+(** [isok] is indeed a decision procedure for [Ok] *)
+
+Lemma ltb_tree_iff : forall x s, lt_tree x s <-> ltb_tree x s = true.
+Proof.
+ induction s as [|c l IHl y r IHr]; simpl.
+ unfold lt_tree; intuition_in.
+ elim_compare x y.
+ split; intros; try discriminate. assert (X.lt y x) by auto. order.
+ split; intros; try discriminate. assert (X.lt y x) by auto. order.
+ rewrite !andb_true_iff, <-IHl, <-IHr.
+  unfold lt_tree; intuition_in; order.
+Qed.
+
+Lemma gtb_tree_iff : forall x s, gt_tree x s <-> gtb_tree x s = true.
+Proof.
+ induction s as [|c l IHl y r IHr]; simpl.
+ unfold gt_tree; intuition_in.
+ elim_compare x y.
+ split; intros; try discriminate. assert (X.lt x y) by auto. order.
+ rewrite !andb_true_iff, <-IHl, <-IHr.
+  unfold gt_tree; intuition_in; order.
+ split; intros; try discriminate. assert (X.lt x y) by auto. order.
+Qed.
+
+Lemma isok_iff : forall s, Ok s <-> isok s = true.
+Proof.
+ induction s as [|c l IHl y r IHr]; simpl.
+ intuition_in.
+ rewrite !andb_true_iff, <- IHl, <-IHr, <- ltb_tree_iff, <- gtb_tree_iff.
+ intuition_in.
+Qed.
+
+Instance isok_Ok s : isok s = true -> Ok s | 10.
+Proof. intros; apply <- isok_iff; auto. Qed.
+
+(** ** Basic results about [In] *)
+
+Lemma In_1 :
+ forall s x y, X.eq x y -> InT x s -> InT y s.
+Proof.
+ induction s; simpl; intuition_in; eauto.
+Qed.
+Local Hint Immediate In_1.
+
+Instance In_compat : Proper (X.eq==>eq==>iff) InT.
+Proof.
+apply proper_sym_impl_iff_2; auto with *.
+repeat red; intros; subst. apply In_1 with x; auto.
+Qed.
+
+Lemma In_node_iff :
+ forall c l x r y,
+  InT y (Node c l x r) <-> InT y l \/ X.eq y x \/ InT y r.
+Proof.
+ intuition_in.
+Qed.
+
+Lemma In_leaf_iff : forall x, InT x Leaf <-> False.
+Proof.
+ intuition_in.
+Qed.
+
+(** Results about [lt_tree] and [gt_tree] *)
+
+Lemma lt_leaf : forall x : elt, lt_tree x Leaf.
+Proof.
+ red; inversion 1.
+Qed.
+
+Lemma gt_leaf : forall x : elt, gt_tree x Leaf.
+Proof.
+ red; inversion 1.
+Qed.
+
+Lemma lt_tree_node :
+ forall (x y : elt) (l r : tree) (i : Info.t),
+ lt_tree x l -> lt_tree x r -> X.lt y x -> lt_tree x (Node i l y r).
+Proof.
+ unfold lt_tree; intuition_in; order.
+Qed.
+
+Lemma gt_tree_node :
+ forall (x y : elt) (l r : tree) (i : Info.t),
+ gt_tree x l -> gt_tree x r -> X.lt x y -> gt_tree x (Node i l y r).
+Proof.
+ unfold gt_tree; intuition_in; order.
+Qed.
+
+Local Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node.
+
+Lemma lt_tree_not_in :
+ forall (x : elt) (t : tree), lt_tree x t -> ~ InT x t.
+Proof.
+ intros; intro; order.
+Qed.
+
+Lemma lt_tree_trans :
+ forall x y, X.lt x y -> forall t, lt_tree x t -> lt_tree y t.
+Proof.
+ eauto.
+Qed.
+
+Lemma gt_tree_not_in :
+ forall (x : elt) (t : tree), gt_tree x t -> ~ InT x t.
+Proof.
+ intros; intro; order.
+Qed.
+
+Lemma gt_tree_trans :
+ forall x y, X.lt y x -> forall t, gt_tree x t -> gt_tree y t.
+Proof.
+ eauto.
+Qed.
+
+Instance lt_tree_compat : Proper (X.eq ==> Logic.eq ==> iff) lt_tree.
+Proof.
+ apply proper_sym_impl_iff_2; auto.
+ intros x x' Hx s s' Hs H y Hy. subst. setoid_rewrite <- Hx; auto.
+Qed.
+
+Instance gt_tree_compat : Proper (X.eq ==> Logic.eq ==> iff) gt_tree.
+Proof.
+ apply proper_sym_impl_iff_2; auto.
+ intros x x' Hx s s' Hs H y Hy. subst. setoid_rewrite <- Hx; auto.
+Qed.
+
+Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans.
+
+Ltac induct s x :=
+ induction s as [|i l IHl x' r IHr]; simpl; intros;
+ [|elim_compare x x'; intros; inv].
+
+Ltac auto_tc := auto with typeclass_instances.
+
+Ltac ok :=
+ inv; change bst with Ok in *;
+ match goal with
+   | |- Ok (Node _ _ _ _) => constructor; auto_tc; ok
+   | |- lt_tree _ (Node _ _ _ _) => apply lt_tree_node; ok
+   | |- gt_tree _ (Node _ _ _ _) => apply gt_tree_node; ok
+   | _ => eauto with typeclass_instances
+ end.
+
+(** ** Empty set *)
+
+Lemma empty_spec : Empty empty.
+Proof.
+ intros x H. inversion H.
+Qed.
+
+Instance empty_ok : Ok empty.
+Proof.
+ auto.
+Qed.
+
+(** ** Emptyness test *)
+
+Lemma is_empty_spec : forall s, is_empty s = true <-> Empty s.
+Proof.
+ destruct s as [|c r x l]; simpl; auto.
+ - split; auto. intros _ x H. inv.
+ - split; auto. try discriminate. intro H; elim (H x); auto.
+Qed.
+
+(** ** Membership *)
+
+Lemma mem_spec : forall s x `{Ok s}, mem x s = true <-> InT x s.
+Proof.
+ split.
+ - induct s x; now auto.
+ - induct s x; intuition_in; order.
+Qed.
+
+(** ** Minimal and maximal elements *)
+
+Functional Scheme min_elt_ind := Induction for min_elt Sort Prop.
+Functional Scheme max_elt_ind := Induction for max_elt Sort Prop.
+
+Lemma min_elt_spec1 s x : min_elt s = Some x -> InT x s.
+Proof.
+ functional induction (min_elt s); auto; inversion 1; auto.
+Qed.
+
+Lemma min_elt_spec2 s x y `{Ok s} :
+ min_elt s = Some x -> InT y s -> ~ X.lt y x.
+Proof.
+ revert y.
+ functional induction (min_elt s);
+ try rename _x0 into r; try rename _x2 into l1, _x3 into x1, _x4 into r1.
+ - discriminate.
+ - intros y V W.
+   inversion V; clear V; subst.
+   inv; order.
+ - intros; inv; auto.
+   * assert (X.lt x x0) by (apply H8; apply min_elt_spec1; auto).
+     order.
+   * assert (X.lt x1 x0) by auto.
+     assert (~X.lt x1 x) by auto.
+     order.
+Qed.
+
+Lemma min_elt_spec3 s : min_elt s = None -> Empty s.
+Proof.
+ functional induction (min_elt s).
+ red; red; inversion 2.
+ inversion 1.
+ intro H0.
+ destruct (IHo H0 _x3); auto.
+Qed.
+
+Lemma max_elt_spec1 s x : max_elt s = Some x -> InT x s.
+Proof.
+ functional induction (max_elt s); auto; inversion 1; auto.
+Qed.
+
+Lemma max_elt_spec2 s x y `{Ok s} :
+ max_elt s = Some x -> InT y s -> ~ X.lt x y.
+Proof.
+ revert y.
+ functional induction (max_elt s);
+ try rename _x0 into r; try rename _x2 into l1, _x3 into x1, _x4 into r1.
+ - discriminate.
+ - intros y V W.
+   inversion V; clear V; subst.
+   inv; order.
+ - intros; inv; auto.
+   * assert (X.lt x0 x) by (apply H9; apply max_elt_spec1; auto).
+     order.
+   * assert (X.lt x0 x1) by auto.
+     assert (~X.lt x x1) by auto.
+     order.
+Qed.
+
+Lemma max_elt_spec3 s : max_elt s = None -> Empty s.
+Proof.
+ functional induction (max_elt s).
+ red; red; inversion 2.
+ inversion 1.
+ intro H0.
+ destruct (IHo H0 _x3); auto.
+Qed.
+
+Lemma choose_spec1 : forall s x, choose s = Some x -> InT x s.
+Proof.
+ exact min_elt_spec1.
+Qed.
+
+Lemma choose_spec2 : forall s, choose s = None -> Empty s.
+Proof.
+ exact min_elt_spec3.
+Qed.
+
+Lemma choose_spec3 : forall s s' x x' `{Ok s, Ok s'},
+  choose s = Some x -> choose s' = Some x' ->
+  Equal s s' -> X.eq x x'.
+Proof.
+ unfold choose, Equal; intros s s' x x' Hb Hb' Hx Hx' H.
+ assert (~X.lt x x').
+  apply min_elt_spec2 with s'; auto.
+  rewrite <-H; auto using min_elt_spec1.
+ assert (~X.lt x' x).
+  apply min_elt_spec2 with s; auto.
+  rewrite H; auto using min_elt_spec1.
+ elim_compare x x'; intuition.
+Qed.
+
+(** ** Elements *)
+
+Lemma elements_spec1' : forall s acc x,
+ InA X.eq x (elements_aux acc s) <-> InT x s \/ InA X.eq x acc.
+Proof.
+ induction s as [ | c l Hl x r Hr ]; simpl; auto.
+ intuition.
+ inversion H0.
+ intros.
+ rewrite Hl.
+ destruct (Hr acc x0); clear Hl Hr.
+ intuition; inversion_clear H3; intuition.
+Qed.
+
+Lemma elements_spec1 : forall s x, InA X.eq x (elements s) <-> InT x s.
+Proof.
+ intros; generalize (elements_spec1' s nil x); intuition.
+ inversion_clear H0.
+Qed.
+
+Lemma elements_spec2' : forall s acc `{Ok s}, sort X.lt acc ->
+ (forall x y : elt, InA X.eq x acc -> InT y s -> X.lt y x) ->
+ sort X.lt (elements_aux acc s).
+Proof.
+ induction s as [ | c l Hl y r Hr]; simpl; intuition.
+ inv.
+ apply Hl; auto.
+ constructor.
+ apply Hr; auto.
+ eapply InA_InfA; eauto with *.
+ intros.
+ destruct (elements_spec1' r acc y0); intuition.
+ intros.
+ inversion_clear H.
+ order.
+ destruct (elements_spec1' r acc x); intuition eauto.
+Qed.
+
+Lemma elements_spec2 : forall s `(Ok s), sort X.lt (elements s).
+Proof.
+ intros; unfold elements; apply elements_spec2'; auto.
+ intros; inversion H0.
+Qed.
+Local Hint Resolve elements_spec2.
+
+Lemma elements_spec2w : forall s `(Ok s), NoDupA X.eq (elements s).
+Proof.
+ intros. eapply SortA_NoDupA; eauto with *.
+Qed.
+
+Lemma elements_aux_cardinal :
+ forall s acc, (length acc + cardinal s)%nat = length (elements_aux acc s).
+Proof.
+ simple induction s; simpl; intuition.
+ rewrite <- H.
+ simpl.
+ rewrite <- H0. rewrite (Nat.add_comm (cardinal t0)).
+ now rewrite <- Nat.add_succ_r, Nat.add_assoc.
+Qed.
+
+Lemma elements_cardinal : forall s : tree, cardinal s = length (elements s).
+Proof.
+ exact (fun s => elements_aux_cardinal s nil).
+Qed.
+
+Definition cardinal_spec (s:tree)(Hs:Ok s) := elements_cardinal s.
+
+Lemma elements_app :
+ forall s acc, elements_aux acc s = elements s ++ acc.
+Proof.
+ induction s; simpl; intros; auto.
+ rewrite IHs1, IHs2.
+ unfold elements; simpl.
+ rewrite 2 IHs1, IHs2, !app_nil_r, !app_ass; auto.
+Qed.
+
+Lemma elements_node c l x r :
+ elements (Node c l x r) = elements l ++ x :: elements r.
+Proof.
+ unfold elements; simpl.
+ now rewrite !elements_app, !app_nil_r.
+Qed.
+
+Lemma rev_elements_app :
+ forall s acc, rev_elements_aux acc s = rev_elements s ++ acc.
+Proof.
+ induction s; simpl; intros; auto.
+ rewrite IHs1, IHs2.
+ unfold rev_elements; simpl.
+ rewrite IHs1, 2 IHs2, !app_nil_r, !app_ass; auto.
+Qed.
+
+Lemma rev_elements_node c l x r :
+ rev_elements (Node c l x r) = rev_elements r ++ x :: rev_elements l.
+Proof.
+ unfold rev_elements; simpl.
+ now rewrite !rev_elements_app, !app_nil_r.
+Qed.
+
+Lemma rev_elements_rev s : rev_elements s = rev (elements s).
+Proof.
+ induction s as [|c l IHl x r IHr]; trivial.
+ rewrite elements_node, rev_elements_node, IHl, IHr, rev_app_distr.
+ simpl. now rewrite !app_ass.
+Qed.
+
+(** The converse of [elements_spec2], used in MSetRBT *)
+
+(* TODO: TO MIGRATE ELSEWHERE... *)
+
+Lemma sorted_app_inv l1 l2 :
+ sort X.lt (l1++l2) ->
+ sort X.lt l1 /\ sort X.lt l2 /\
+ forall x1 x2, InA X.eq x1 l1 -> InA X.eq x2 l2 -> X.lt x1 x2.
+Proof.
+ induction l1 as [|a1 l1 IHl1].
+ - simpl; repeat split; auto.
+   intros. now rewrite InA_nil in *.
+ - simpl. inversion_clear 1 as [ | ? ? Hs Hhd ].
+   destruct (IHl1 Hs) as (H1 & H2 & H3).
+   repeat split.
+   * constructor; auto.
+     destruct l1; simpl in *; auto; inversion_clear Hhd; auto.
+   * trivial.
+   * intros x1 x2 Hx1 Hx2. rewrite InA_cons in Hx1. destruct Hx1.
+     + rewrite H.
+       apply SortA_InfA_InA with (eqA:=X.eq)(l:=l1++l2); auto_tc.
+       rewrite InA_app_iff; auto_tc.
+     + auto.
+Qed.
+
+Lemma elements_sort_ok s : sort X.lt (elements s) -> Ok s.
+Proof.
+ induction s as [|c l IHl x r IHr].
+ - auto.
+ - rewrite elements_node.
+   intros H. destruct (sorted_app_inv _ _ H) as (H1 & H2 & H3).
+   inversion_clear H2.
+   constructor; ok.
+   * intros y Hy. apply H3.
+     + now rewrite elements_spec1.
+     + rewrite InA_cons. now left.
+   * intros y Hy.
+     apply SortA_InfA_InA with (eqA:=X.eq)(l:=elements r); auto_tc.
+     now rewrite elements_spec1.
+Qed.
+
+(** ** [for_all] and [exists] *)
+
+Lemma for_all_spec s f : Proper (X.eq==>eq) f ->
+ (for_all f s = true <-> For_all (fun x => f x = true) s).
+Proof.
+ intros Hf; unfold For_all.
+ induction s as [|i l IHl x r IHr]; simpl; auto.
+ - split; intros; inv; auto.
+ - rewrite <- !andb_lazy_alt, !andb_true_iff, IHl, IHr. clear IHl IHr.
+   intuition_in. eauto.
+Qed.
+
+Lemma exists_spec s f : Proper (X.eq==>eq) f ->
+ (exists_ f s = true <-> Exists (fun x => f x = true) s).
+Proof.
+ intros Hf; unfold Exists.
+ induction s as [|i l IHl x r IHr]; simpl; auto.
+ - split.
+   * discriminate.
+   * intros (y,(H,_)); inv.
+ - rewrite <- !orb_lazy_alt, !orb_true_iff, IHl, IHr. clear IHl IHr.
+   split; [intros [[H|(y,(H,H'))]|(y,(H,H'))]|intros (y,(H,H'))].
+   * exists x; auto.
+   * exists y; auto.
+   * exists y; auto.
+   * inv; [left;left|left;right|right]; try (exists y); eauto.
+Qed.
+
+(** ** Fold *)
+
+Lemma fold_spec' {A} (f : elt -> A -> A) (s : tree) (i : A) (acc : list elt) :
+ fold_left (flip f) (elements_aux acc s) i = fold_left (flip f) acc (fold f s i).
+Proof.
+ revert i acc.
+ induction s as [|c l IHl x r IHr]; simpl; intros; auto.
+ rewrite IHl.
+ simpl. unfold flip at 2.
+ apply IHr.
+Qed.
+
+Lemma fold_spec (s:tree) {A} (i : A) (f : elt -> A -> A) :
+ fold f s i = fold_left (flip f) (elements s) i.
+Proof.
+ revert i. unfold elements.
+ induction s as [|c l IHl x r IHr]; simpl; intros; auto.
+ rewrite fold_spec'.
+ rewrite IHr.
+ simpl; auto.
+Qed.
+
+
+(** ** Subset *)
+
+Lemma subsetl_spec : forall subset_l1 l1 x1 c1 s2
+ `{Ok (Node c1 l1 x1 Leaf), Ok s2},
+ (forall s `{Ok s}, (subset_l1 s = true <-> Subset l1 s)) ->
+ (subsetl subset_l1 x1 s2 = true <-> Subset (Node c1 l1 x1 Leaf) s2 ).
+Proof.
+ induction s2 as [|c2 l2 IHl2 x2 r2 IHr2]; simpl; intros.
+ unfold Subset; intuition; try discriminate.
+ assert (H': InT x1 Leaf) by auto; inversion H'.
+ specialize (IHl2 H).
+ specialize (IHr2 H).
+ inv.
+ elim_compare x1 x2.
+
+ rewrite H1 by auto; clear H1 IHl2 IHr2.
+ unfold Subset. intuition_in.
+ assert (X.eq a x2) by order; intuition_in.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+
+ rewrite IHl2 by auto; clear H1 IHl2 IHr2.
+ unfold Subset. intuition_in.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+
+ rewrite <-andb_lazy_alt, andb_true_iff, H1 by auto; clear H1 IHl2 IHr2.
+ unfold Subset. intuition_in.
+ constructor 3. setoid_replace a with x1; auto. rewrite <- mem_spec; auto.
+ rewrite mem_spec; auto.
+ assert (InT x1 (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+Qed.
+
+
+Lemma subsetr_spec : forall subset_r1 r1 x1 c1 s2,
+ bst (Node c1 Leaf x1 r1) -> bst s2 ->
+ (forall s, bst s -> (subset_r1 s = true <-> Subset r1 s)) ->
+ (subsetr subset_r1 x1 s2 = true <-> Subset (Node c1 Leaf x1 r1) s2).
+Proof.
+ induction s2 as [|c2 l2 IHl2 x2 r2 IHr2]; simpl; intros.
+ unfold Subset; intuition; try discriminate.
+ assert (H': InT x1 Leaf) by auto; inversion H'.
+ specialize (IHl2 H).
+ specialize (IHr2 H).
+ inv.
+ elim_compare x1 x2.
+
+ rewrite H1 by auto; clear H1 IHl2 IHr2.
+ unfold Subset. intuition_in.
+ assert (X.eq a x2) by order; intuition_in.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+
+ rewrite <-andb_lazy_alt, andb_true_iff, H1 by auto;  clear H1 IHl2 IHr2.
+ unfold Subset. intuition_in.
+ constructor 2. setoid_replace a with x1; auto. rewrite <- mem_spec; auto.
+ rewrite mem_spec; auto.
+ assert (InT x1 (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+
+ rewrite IHr2 by auto; clear H1 IHl2 IHr2.
+ unfold Subset. intuition_in.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+Qed.
+
+Lemma subset_spec : forall s1 s2 `{Ok s1, Ok s2},
+ (subset s1 s2 = true <-> Subset s1 s2).
+Proof.
+ induction s1 as [|c1 l1 IHl1 x1 r1 IHr1]; simpl; intros.
+ unfold Subset; intuition_in.
+ destruct s2 as [|c2 l2 x2 r2]; simpl; intros.
+ unfold Subset; intuition_in; try discriminate.
+ assert (H': InT x1 Leaf) by auto; inversion H'.
+ inv.
+ elim_compare x1 x2.
+
+ rewrite <-andb_lazy_alt, andb_true_iff, IHl1, IHr1 by auto.
+ clear IHl1 IHr1.
+ unfold Subset; intuition_in.
+ assert (X.eq a x2) by order; intuition_in.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+
+ rewrite <-andb_lazy_alt, andb_true_iff, IHr1 by auto.
+ rewrite (@subsetl_spec (subset l1) l1 x1 c1) by auto.
+ clear IHl1 IHr1.
+ unfold Subset; intuition_in.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+
+ rewrite <-andb_lazy_alt, andb_true_iff, IHl1 by auto.
+ rewrite (@subsetr_spec (subset r1) r1 x1 c1) by auto.
+ clear IHl1 IHr1.
+ unfold Subset; intuition_in.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+ assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order.
+Qed.
+
+
+(** ** Comparison *)
+
+(** Relations [eq] and [lt] over trees *)
+
+Module L := MSetInterface.MakeListOrdering X.
+
+Definition eq := Equal.
+Instance eq_equiv : Equivalence eq.
+Proof. firstorder. Qed.
+
+Lemma eq_Leq : forall s s', eq s s' <-> L.eq (elements s) (elements s').
+Proof.
+ unfold eq, Equal, L.eq; intros.
+ setoid_rewrite elements_spec1; firstorder.
+Qed.
+
+Definition lt (s1 s2 : tree) : Prop :=
+ exists s1' s2', Ok s1' /\ Ok s2' /\ eq s1 s1' /\ eq s2 s2'
+   /\ L.lt (elements s1') (elements s2').
+
+Instance lt_strorder : StrictOrder lt.
+Proof.
+ split.
+ intros s (s1 & s2 & B1 & B2 & E1 & E2 & L).
+ assert (eqlistA X.eq (elements s1) (elements s2)).
+  apply SortA_equivlistA_eqlistA with (ltA:=X.lt); auto with *.
+  rewrite <- eq_Leq. transitivity s; auto. symmetry; auto.
+ rewrite H in L.
+ apply (StrictOrder_Irreflexive (elements s2)); auto.
+ intros s1 s2 s3 (s1' & s2' & B1 & B2 & E1 & E2 & L12)
+                 (s2'' & s3' & B2' & B3 & E2' & E3 & L23).
+ exists s1', s3'; do 4 (split; trivial).
+ assert (eqlistA X.eq (elements s2') (elements s2'')).
+  apply SortA_equivlistA_eqlistA with (ltA:=X.lt); auto with *.
+  rewrite <- eq_Leq. transitivity s2; auto. symmetry; auto.
+ transitivity (elements s2'); auto.
+ rewrite H; auto.
+Qed.
+
+Instance lt_compat : Proper (eq==>eq==>iff) lt.
+Proof.
+ intros s1 s2 E12 s3 s4 E34. split.
+ intros (s1' & s3' & B1 & B3 & E1 & E3 & LT).
+ exists s1', s3'; do 2 (split; trivial).
+  split. transitivity s1; auto. symmetry; auto.
+  split; auto. transitivity s3; auto. symmetry; auto.
+ intros (s1' & s3' & B1 & B3 & E1 & E3 & LT).
+ exists s1', s3'; do 2 (split; trivial).
+  split. transitivity s2; auto.
+  split; auto. transitivity s4; auto.
+Qed.
+
+
+(** Proof of the comparison algorithm *)
+
+(** [flatten_e e] returns the list of elements of [e] i.e. the list
+    of elements actually compared *)
+
+Fixpoint flatten_e (e : enumeration) : list elt := match e with
+  | End => nil
+  | More x t r => x :: elements t ++ flatten_e r
+ end.
+
+Lemma flatten_e_elements :
+ forall l x r c e,
+ elements l ++ flatten_e (More x r e) = elements (Node c l x r) ++ flatten_e e.
+Proof.
+ intros; simpl. now rewrite elements_node, app_ass.
+Qed.
+
+Lemma cons_1 : forall s e,
+  flatten_e (cons s e) = elements s ++ flatten_e e.
+Proof.
+ induction s; simpl; auto; intros.
+ rewrite IHs1; apply flatten_e_elements.
+Qed.
+
+(** Correctness of this comparison *)
+
+Definition Cmp c x y := CompSpec L.eq L.lt x y c.
+
+Local Hint Unfold Cmp flip.
+
+Lemma compare_end_Cmp :
+ forall e2, Cmp (compare_end e2) nil (flatten_e e2).
+Proof.
+ destruct e2; simpl; constructor; auto. reflexivity.
+Qed.
+
+Lemma compare_more_Cmp : forall x1 cont x2 r2 e2 l,
+  Cmp (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) ->
+   Cmp (compare_more x1 cont (More x2 r2 e2)) (x1::l)
+      (flatten_e (More x2 r2 e2)).
+Proof.
+ simpl; intros; elim_compare x1 x2; simpl; red; auto.
+Qed.
+
+Lemma compare_cont_Cmp : forall s1 cont e2 l,
+ (forall e, Cmp (cont e) l (flatten_e e)) ->
+ Cmp (compare_cont s1 cont e2) (elements s1 ++ l) (flatten_e e2).
+Proof.
+ induction s1 as [|c1 l1 Hl1 x1 r1 Hr1]; simpl; intros; auto.
+ rewrite elements_node, app_ass; simpl.
+ apply Hl1; auto. clear e2. intros [|x2 r2 e2].
+ simpl; auto.
+ apply compare_more_Cmp.
+ rewrite <- cons_1; auto.
+Qed.
+
+Lemma compare_Cmp : forall s1 s2,
+ Cmp (compare s1 s2) (elements s1) (elements s2).
+Proof.
+ intros; unfold compare.
+ rewrite (app_nil_end (elements s1)).
+ replace (elements s2) with (flatten_e (cons s2 End)) by
+  (rewrite cons_1; simpl; rewrite <- app_nil_end; auto).
+ apply compare_cont_Cmp; auto.
+ intros.
+ apply compare_end_Cmp; auto.
+Qed.
+
+Lemma compare_spec : forall s1 s2 `{Ok s1, Ok s2},
+ CompSpec eq lt s1 s2 (compare s1 s2).
+Proof.
+ intros.
+ destruct (compare_Cmp s1 s2); constructor.
+ rewrite eq_Leq; auto.
+ intros; exists s1, s2; repeat split; auto.
+ intros; exists s2, s1; repeat split; auto.
+Qed.
+
+
+(** ** Equality test *)
+
+Lemma equal_spec : forall s1 s2 `{Ok s1, Ok s2},
+ equal s1 s2 = true <-> eq s1 s2.
+Proof.
+unfold equal; intros s1 s2 B1 B2.
+destruct (@compare_spec s1 s2 B1 B2) as [H|H|H];
+ split; intros H'; auto; try discriminate.
+rewrite H' in H. elim (StrictOrder_Irreflexive s2); auto.
+rewrite H' in H. elim (StrictOrder_Irreflexive s2); auto.
+Qed.
+
+(** ** A few results about [mindepth] and [maxdepth] *)
+
+Lemma mindepth_maxdepth s : mindepth s <= maxdepth s.
+Proof.
+ induction s; simpl; auto.
+ rewrite <- Nat.succ_le_mono.
+ transitivity (mindepth s1). apply Nat.le_min_l.
+ transitivity (maxdepth s1). trivial. apply Nat.le_max_l.
+Qed.
+
+Lemma maxdepth_cardinal s : cardinal s < 2^(maxdepth s).
+Proof.
+ unfold Peano.lt.
+ induction s as [|c l IHl x r IHr].
+ - auto.
+ - simpl. rewrite <- Nat.add_succ_r, <- Nat.add_succ_l, Nat.add_0_r.
+   apply Nat.add_le_mono; etransitivity;
+   try apply IHl; try apply IHr; apply Nat.pow_le_mono; auto.
+   * apply Nat.le_max_l.
+   * apply Nat.le_max_r.
+Qed.
+
+Lemma mindepth_cardinal s : 2^(mindepth s) <= S (cardinal s).
+Proof.
+ unfold Peano.lt.
+ induction s as [|c l IHl x r IHr].
+ - auto.
+ - simpl. rewrite <- Nat.add_succ_r, <- Nat.add_succ_l, Nat.add_0_r.
+   apply Nat.add_le_mono; etransitivity;
+   try apply IHl; try apply IHr; apply Nat.pow_le_mono; auto.
+   * apply Nat.le_min_l.
+   * apply Nat.le_min_r.
+Qed.
+
+Lemma maxdepth_log_cardinal s : s <> Leaf ->
+ log2 (cardinal s) < maxdepth s.
+Proof.
+ intros H.
+ apply Nat.log2_lt_pow2. destruct s; simpl; intuition.
+ apply maxdepth_cardinal.
+Qed.
+
+Lemma mindepth_log_cardinal s : mindepth s <= log2 (S (cardinal s)).
+Proof.
+ apply Nat.log2_le_pow2. auto with arith.
+ apply mindepth_cardinal.
+Qed.
+
+End Props.
\ No newline at end of file
diff --git a/theories/MSets/MSetInterface.v b/theories/MSets/MSetInterface.v
index 194cb904..6778deff 100644
--- a/theories/MSets/MSetInterface.v
+++ b/theories/MSets/MSetInterface.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 (** * Finite set library *)
 
 (** Set interfaces, inspired by the one of Ocaml. When compared with
@@ -439,7 +437,7 @@ Module WRaw2SetsOn (E:DecidableType)(M:WRawSets E) <: WSetsOn E.
 
  Record t_ := Mkt {this :> M.t; is_ok : M.Ok this}.
  Definition t := t_.
- Implicit Arguments Mkt [ [is_ok] ].
+ Arguments Mkt this {is_ok}.
  Hint Resolve is_ok : typeclass_instances.
 
  Definition In (x : elt)(s : t) := M.In x s.(this).
@@ -482,7 +480,7 @@ Module WRaw2SetsOn (E:DecidableType)(M:WRawSets E) <: WSetsOn E.
  Proof.
   intros (s,Hs) (s',Hs').
   change ({M.Equal s s'}+{~M.Equal s s'}).
-  destruct (M.equal s s') as [ ]_eqn:H; [left|right];
+  destruct (M.equal s s') eqn:H; [left|right];
    rewrite <- M.equal_spec; congruence.
  Defined.
 
@@ -653,7 +651,218 @@ Module Raw2Sets (O:OrderedType)(M:RawSets O) <: Sets with Module E := O.
 End Raw2Sets.
 
 
-(** We provide an ordering for sets-as-sorted-lists *)
+(** It is in fact possible to provide an ordering on sets with
+    very little information on them (more or less only the [In]
+    predicate). This generic build of ordering is in fact not
+    used for the moment, we rather use a simplier version
+    dedicated to sets-as-sorted-lists, see [MakeListOrdering].
+*)
+
+Module Type IN (O:OrderedType).
+ Parameter Inline t : Type.
+ Parameter Inline In : O.t -> t -> Prop.
+ Declare Instance In_compat : Proper (O.eq==>eq==>iff) In.
+ Definition Equal s s' := forall x, In x s <-> In x s'.
+ Definition Empty s := forall x, ~In x s.
+End IN.
+
+Module MakeSetOrdering (O:OrderedType)(Import M:IN O).
+ Module Import MO := OrderedTypeFacts O.
+
+ Definition eq : t -> t -> Prop := Equal.
+
+ Instance eq_equiv : Equivalence eq.
+ Proof. firstorder. Qed.
+
+ Instance : Proper (O.eq==>eq==>iff) In.
+ Proof.
+ intros x x' Ex s s' Es. rewrite Ex. apply Es.
+ Qed.
+
+ Definition Below x s := forall y, In y s -> O.lt y x.
+ Definition Above x s := forall y, In y s -> O.lt x y.
+
+ Definition EquivBefore x s s' :=
+   forall y, O.lt y x -> (In y s <-> In y s').
+
+ Definition EmptyBetween x y s :=
+   forall z, In z s -> O.lt z y -> O.lt z x.
+
+ Definition lt s s' := exists x, EquivBefore x s s' /\
+   ((In x s' /\ Below x s) \/
+    (In x s  /\ exists y, In y s' /\ O.lt x y /\ EmptyBetween x y s')).
+
+ Instance : Proper (O.eq==>eq==>eq==>iff) EquivBefore.
+ Proof.
+  unfold EquivBefore. intros x x' E s1 s1' E1 s2 s2' E2.
+  setoid_rewrite E; setoid_rewrite E1; setoid_rewrite E2; intuition.
+ Qed.
+
+ Instance : Proper (O.eq==>eq==>iff) Below.
+ Proof.
+  unfold Below. intros x x' Ex s s' Es.
+  setoid_rewrite Ex; setoid_rewrite Es; intuition.
+ Qed.
+
+ Instance : Proper (O.eq==>eq==>iff) Above.
+ Proof.
+  unfold Above. intros x x' Ex s s' Es.
+  setoid_rewrite Ex; setoid_rewrite Es; intuition.
+ Qed.
+
+ Instance : Proper (O.eq==>O.eq==>eq==>iff) EmptyBetween.
+ Proof.
+  unfold EmptyBetween. intros x x' Ex y y' Ey s s' Es.
+  setoid_rewrite Ex; setoid_rewrite Ey; setoid_rewrite Es; intuition.
+ Qed.
+
+ Instance lt_compat : Proper (eq==>eq==>iff) lt.
+ Proof.
+  unfold lt. intros s1 s1' E1 s2 s2' E2.
+  setoid_rewrite E1; setoid_rewrite E2; intuition.
+ Qed.
+
+ Instance lt_strorder : StrictOrder lt.
+ Proof.
+  split.
+  (* irreflexive *)
+  intros s (x & _ & [(IN,Em)|(IN & y & IN' & LT & Be)]).
+  specialize (Em x IN); order.
+  specialize (Be x IN LT); order.
+  (* transitive *)
+  intros s1 s2 s3 (x & EQ & [(IN,Pre)|(IN,Lex)])
+                  (x' & EQ' & [(IN',Pre')|(IN',Lex')]).
+  (* 1) Pre / Pre --> Pre *)
+  assert (O.lt x x') by (specialize (Pre' x IN); auto).
+  exists x; split.
+  intros y Hy; rewrite <- (EQ' y); auto; order.
+  left; split; auto.
+  rewrite <- (EQ' x); auto.
+  (* 2) Pre / Lex *)
+  elim_compare x x'.
+  (* 2a) x=x' --> Pre *)
+  destruct Lex' as (y & INy & LT & Be).
+  exists y; split.
+  intros z Hz. split; intros INz.
+   specialize (Pre z INz). rewrite <- (EQ' z), <- (EQ z); auto; order.
+   specialize (Be z INz Hz). rewrite (EQ z), (EQ' z); auto; order.
+  left; split; auto.
+  intros z Hz. transitivity x; auto; order.
+  (* 2b) x<x' --> Pre *)
+  exists x; split.
+  intros z Hz. rewrite <- (EQ' z) by order; auto.
+  left; split; auto.
+  rewrite <- (EQ' x); auto.
+  (* 2c) x>x' --> Lex *)
+  exists x'; split.
+  intros z Hz. rewrite (EQ z) by order; auto.
+  right; split; auto.
+  rewrite (EQ x'); auto.
+  (* 3) Lex / Pre --> Lex *)
+  destruct Lex as (y & INy & LT & Be).
+  specialize (Pre' y INy).
+  exists x; split.
+  intros z Hz. rewrite <- (EQ' z) by order; auto.
+  right; split; auto.
+  exists y; repeat split; auto.
+  rewrite <- (EQ' y); auto.
+  intros z Hz LTz; apply Be; auto. rewrite (EQ' z); auto; order.
+  (* 4) Lex / Lex *)
+  elim_compare x x'.
+  (* 4a) x=x' --> impossible *)
+  destruct Lex as (y & INy & LT & Be).
+  setoid_replace x with x' in LT; auto.
+  specialize (Be x' IN' LT); order.
+  (* 4b) x<x' --> Lex *)
+  exists x; split.
+  intros z Hz. rewrite <- (EQ' z) by order; auto.
+  right; split; auto.
+  destruct Lex as (y & INy & LT & Be).
+  elim_compare y x'.
+   (* 4ba *)
+   destruct Lex' as (y' & Iny' & LT' & Be').
+   exists y'; repeat split; auto. order.
+   intros z Hz LTz. specialize (Be' z Hz LTz).
+    rewrite <- (EQ' z) in Hz by order.
+    apply Be; auto. order.
+   (* 4bb *)
+   exists y; repeat split; auto.
+   rewrite <- (EQ' y); auto.
+   intros z Hz LTz. apply Be; auto. rewrite (EQ' z); auto; order.
+   (* 4bc*)
+   assert (O.lt x' x) by auto. order.
+  (* 4c) x>x' --> Lex *)
+  exists x'; split.
+  intros z Hz. rewrite (EQ z) by order; auto.
+  right; split; auto.
+  rewrite (EQ x'); auto.
+ Qed.
+
+ Lemma lt_empty_r : forall s s', Empty s' -> ~ lt s s'.
+ Proof.
+  intros s s' Hs' (x & _ & [(IN,_)|(_ & y & IN & _)]).
+  elim (Hs' x IN).
+  elim (Hs' y IN).
+ Qed.
+
+ Definition Add x s s' := forall y, In y s' <-> O.eq x y \/ In y s.
+
+ Lemma lt_empty_l : forall x s1 s2 s2',
+  Empty s1 -> Above x s2 -> Add x s2 s2' -> lt s1 s2'.
+ Proof.
+  intros x s1 s2 s2' Em Ab Ad.
+  exists x; split.
+  intros y Hy; split; intros IN.
+  elim (Em y IN).
+  rewrite (Ad y) in IN; destruct IN as [EQ|IN]. order.
+  specialize (Ab y IN). order.
+  left; split.
+  rewrite (Ad x). now left.
+  intros y Hy. elim (Em y Hy).
+ Qed.
+
+ Lemma lt_add_lt : forall x1 x2 s1 s1' s2 s2',
+   Above x1 s1 -> Above x2 s2 -> Add x1 s1 s1' -> Add x2 s2 s2' ->
+   O.lt x1 x2 -> lt s1' s2'.
+  Proof.
+  intros x1 x2 s1 s1' s2 s2' Ab1 Ab2 Ad1 Ad2 LT.
+  exists x1; split; [ | right; split]; auto.
+  intros y Hy. rewrite (Ad1 y), (Ad2 y).
+  split; intros [U|U]; try order.
+  specialize (Ab1 y U). order.
+  specialize (Ab2 y U). order.
+  rewrite (Ad1 x1); auto with *.
+  exists x2; repeat split; auto.
+  rewrite (Ad2 x2); now left.
+  intros y. rewrite (Ad2 y). intros [U|U]. order.
+  specialize (Ab2 y U). order.
+  Qed.
+
+  Lemma lt_add_eq : forall x1 x2 s1 s1' s2 s2',
+   Above x1 s1 -> Above x2 s2 -> Add x1 s1 s1' -> Add x2 s2 s2' ->
+   O.eq x1 x2 -> lt s1 s2 -> lt s1' s2'.
+  Proof.
+  intros x1 x2 s1 s1' s2 s2' Ab1 Ab2 Ad1 Ad2 Hx (x & EQ & Disj).
+  assert (O.lt x1 x).
+   destruct Disj as [(IN,_)|(IN,_)]; auto. rewrite Hx; auto.
+  exists x; split.
+  intros z Hz. rewrite (Ad1 z), (Ad2 z).
+  split; intros [U|U]; try (left; order); right.
+  rewrite <- (EQ z); auto.
+  rewrite (EQ z); auto.
+  destruct Disj as [(IN,Em)|(IN & y & INy & LTy & Be)].
+  left; split; auto.
+  rewrite (Ad2 x); auto.
+  intros z. rewrite (Ad1 z); intros [U|U]; try specialize (Ab1 z U); auto; order.
+  right; split; auto.
+  rewrite (Ad1 x); auto.
+  exists y; repeat split; auto.
+  rewrite (Ad2 y); auto.
+  intros z. rewrite (Ad2 z). intros [U|U]; try specialize (Ab2 z U); auto; order.
+  Qed.
+
+End MakeSetOrdering.
+
 
 Module MakeListOrdering (O:OrderedType).
  Module MO:=OrderedTypeFacts O.
@@ -663,7 +872,7 @@ Module MakeListOrdering (O:OrderedType).
 
  Definition eq s s' := forall x, In x s <-> In x s'.
 
- Instance eq_equiv : Equivalence eq.
+ Instance eq_equiv : Equivalence eq := _.
 
  Inductive lt_list : t -> t -> Prop :=
     | lt_nil : forall x s, lt_list nil (x :: s)
diff --git a/theories/MSets/MSetList.v b/theories/MSets/MSetList.v
index 48af7e6a..d9b1fd9b 100644
--- a/theories/MSets/MSetList.v
+++ b/theories/MSets/MSetList.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 (** * Finite sets library *)
 
 (** This file proposes an implementation of the non-dependant
@@ -664,7 +662,7 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
   Proof.
   induction s; simpl; intros.
   split; intuition; inv.
-  destruct (f a) as [ ]_eqn:F; rewrite !InA_cons, ?IHs; intuition.
+  destruct (f a) eqn:F; rewrite !InA_cons, ?IHs; intuition.
   setoid_replace x with a; auto.
   setoid_replace a with x in F; auto; congruence.
   Qed.
@@ -676,7 +674,7 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
   Proof.
   unfold For_all; induction s; simpl; intros.
   split; intros; auto. inv.
-  destruct (f a) as [ ]_eqn:F.
+  destruct (f a) eqn:F.
   rewrite IHs; auto. firstorder. inv; auto.
   setoid_replace x with a; auto.
   split; intros H'. discriminate.
@@ -690,7 +688,7 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
   Proof.
   unfold Exists; induction s; simpl; intros.
   firstorder. discriminate. inv.
-  destruct (f a) as [ ]_eqn:F.
+  destruct (f a) eqn:F.
   firstorder.
   rewrite IHs; auto.
   firstorder.
@@ -788,8 +786,7 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
   Definition eq := L.eq.
   Definition eq_equiv := L.eq_equiv.
   Definition lt l1 l2 :=
-    exists l1', exists l2', Ok l1' /\ Ok l2' /\
-      eq l1 l1' /\ eq l2 l2' /\ L.lt l1' l2'.
+    exists l1' l2', Ok l1' /\ Ok l2' /\ eq l1 l1' /\ eq l2 l2' /\ L.lt l1' l2'.
 
   Instance lt_strorder : StrictOrder lt.
   Proof.
diff --git a/theories/MSets/MSetPositive.v b/theories/MSets/MSetPositive.v
index e83ac27d..e500602f 100644
--- a/theories/MSets/MSetPositive.v
+++ b/theories/MSets/MSetPositive.v
@@ -36,8 +36,8 @@ Local Unset Boolean Equality Schemes.
 Module PositiveOrderedTypeBits <: UsualOrderedType.
   Definition t:=positive.
   Include HasUsualEq <+ UsualIsEq.
-  Definition eqb := Peqb.
-  Definition eqb_eq := Peqb_eq.
+  Definition eqb := Pos.eqb.
+  Definition eqb_eq := Pos.eqb_eq.
   Include HasEqBool2Dec.
 
   Fixpoint bits_lt (p q:positive) : Prop :=
diff --git a/theories/MSets/MSetProperties.v b/theories/MSets/MSetProperties.v
index c0038a4f..396067b5 100644
--- a/theories/MSets/MSetProperties.v
+++ b/theories/MSets/MSetProperties.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 (** * Finite sets library *)
 
 (** This functor derives additional properties from [MSetInterface.S].
@@ -339,6 +337,14 @@ Module WPropertiesOn (Import E : DecidableType)(M : WSetsOn E).
   Notation NoDup := (NoDupA E.eq).
   Notation InA := (InA E.eq).
 
+  (** Alternative specification via [fold_right] *)
+
+  Lemma fold_spec_right (s:t)(A:Type)(i:A)(f : elt -> A -> A) :
+    fold f s i = List.fold_right f i (rev (elements s)).
+  Proof.
+   rewrite fold_spec. symmetry. apply fold_left_rev_right.
+  Qed.
+
   (** ** Induction principles for fold (contributed by S. Lescuyer) *)
 
   (** In the following lemma, the step hypothesis is deliberately restricted
@@ -352,8 +358,7 @@ Module WPropertiesOn (Import E : DecidableType)(M : WSetsOn E).
      P s (fold f s i).
   Proof.
   intros A P f i s Pempty Pstep.
-  rewrite fold_1; unfold flip; rewrite <- fold_left_rev_right.
-  set (l:=rev (elements s)).
+  rewrite fold_spec_right. set (l:=rev (elements s)).
   assert (Pstep' : forall x a s' s'', InA x l -> ~In x s' -> Add x s' s'' ->
            P s' a -> P s'' (f x a)).
    intros; eapply Pstep; eauto.
@@ -425,8 +430,7 @@ Module WPropertiesOn (Import E : DecidableType)(M : WSetsOn E).
      R (fold f s i) (fold g s j).
   Proof.
   intros A B R f g i j s Rempty Rstep.
-  do 2 (rewrite fold_1; unfold flip; rewrite <- fold_left_rev_right).
-  set (l:=rev (elements s)).
+  rewrite 2 fold_spec_right. set (l:=rev (elements s)).
   assert (Rstep' : forall x a b, InA x l -> R a b -> R (f x a) (g x b)) by
     (intros; apply Rstep; auto; rewrite elements_iff, <- InA_rev; auto with *).
   clearbody l; clear Rstep s.
@@ -484,8 +488,7 @@ Module WPropertiesOn (Import E : DecidableType)(M : WSetsOn E).
   split; intros.
   rewrite elements_iff; do 2 rewrite InA_alt.
   split; destruct 1; generalize (In_rev (elements s) x0); exists x0; intuition.
-  rewrite fold_left_rev_right.
-  apply fold_1.
+  apply fold_spec_right.
   Qed.
 
   (** An alternate (and previous) specification for [fold] was based on
@@ -828,7 +831,7 @@ Module WPropertiesOn (Import E : DecidableType)(M : WSetsOn E).
   rewrite (inter_subset_equal H).
   generalize (@cardinal_inv_1 (diff s' s)).
   destruct (cardinal (diff s' s)).
-  intro H2; destruct (H2 (refl_equal _) x).
+  intro H2; destruct (H2 (eq_refl _) x).
   set_iff; auto.
   intros _.
   change (0 + cardinal s < S n + cardinal s).
@@ -1095,8 +1098,7 @@ Module OrdProperties (M:Sets).
    Above x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)).
   Proof.
   intros.
-  rewrite !FM.fold_1.
-  unfold flip; rewrite <-!fold_left_rev_right.
+  rewrite 2 fold_spec_right.
   change (f x (fold_right f i (rev (elements s)))) with
     (fold_right f i (rev (x::nil)++rev (elements s))).
   apply (@fold_right_eqlistA E.t E.eq A eqA st); auto with *.
@@ -1112,7 +1114,7 @@ Module OrdProperties (M:Sets).
    Below x s -> Add x s s' -> eqA (fold f s' i) (fold f s (f x i)).
   Proof.
   intros.
-  rewrite !FM.fold_1.
+  rewrite !fold_spec.
   change (eqA (fold_left (flip f) (elements s') i)
               (fold_left (flip f) (x::elements s) i)).
   unfold flip; rewrite <-!fold_left_rev_right.
@@ -1133,8 +1135,7 @@ Module OrdProperties (M:Sets).
    forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i).
   Proof.
   intros.
-  rewrite !FM.fold_1.
-  unfold flip; rewrite <- !fold_left_rev_right.
+  rewrite 2 fold_spec_right.
   apply (@fold_right_eqlistA E.t E.eq A eqA st); auto.
   apply eqlistA_rev.
   apply sort_equivlistA_eqlistA; auto with set.
diff --git a/theories/MSets/MSetRBT.v b/theories/MSets/MSetRBT.v
new file mode 100644
index 00000000..b838495f
--- /dev/null
+++ b/theories/MSets/MSetRBT.v
@@ -0,0 +1,1965 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(** * MSetRBT : Implementation of MSetInterface via Red-Black trees *)
+
+(** Initial author: Andrew W. Appel, 2011.
+    Extra modifications by: Pierre Letouzey
+
+The design decisions behind this implementation are described here:
+
+ - Efficient Verified Red-Black Trees, by Andrew W. Appel, September 2011.
+   http://www.cs.princeton.edu/~appel/papers/redblack.pdf
+
+Additional suggested reading:
+
+ - Red-Black Trees in a Functional Setting by Chris Okasaki.
+   Journal of Functional Programming, 9(4):471-477, July 1999.
+   http://www.eecs.usma.edu/webs/people/okasaki/jfp99redblack.pdf
+
+ - Red-black trees with types, by Stefan Kahrs.
+   Journal of Functional Programming, 11(4), 425-432, 2001.
+
+ - Functors for Proofs and Programs, by J.-C. Filliatre and P. Letouzey.
+   ESOP'04: European Symposium on Programming, pp. 370-384, 2004.
+   http://www.lri.fr/~filliatr/ftp/publis/fpp.ps.gz
+*)
+
+Require MSetGenTree.
+Require Import Bool List BinPos Pnat Setoid SetoidList NPeano.
+Local Open Scope list_scope.
+
+(* For nicer extraction, we create induction principles
+   only when needed *)
+Local Unset Elimination Schemes.
+Local Unset Case Analysis Schemes.
+
+(** An extra function not (yet?) in MSetInterface.S *)
+
+Module Type MSetRemoveMin (Import M:MSetInterface.S).
+
+ Parameter remove_min : t -> option (elt * t).
+
+ Axiom remove_min_spec1 : forall s k s',
+  remove_min s = Some (k,s') ->
+   min_elt s = Some k /\ remove k s [=] s'.
+
+ Axiom remove_min_spec2 : forall s, remove_min s = None -> Empty s.
+
+End MSetRemoveMin.
+
+(** The type of color annotation. *)
+
+Inductive color := Red | Black.
+
+Module Color.
+ Definition t := color.
+End Color.
+
+(** * Ops : the pure functions *)
+
+Module Ops (X:Orders.OrderedType) <: MSetInterface.Ops X.
+
+(** ** Generic trees instantiated with color *)
+
+(** We reuse a generic definition of trees where the information
+    parameter is a color. Functions like mem or fold are also
+    provided by this generic functor. *)
+
+Include MSetGenTree.Ops X Color.
+
+Definition t := tree.
+Local Notation Rd := (Node Red).
+Local Notation Bk := (Node Black).
+
+(** ** Basic tree *)
+
+Definition singleton (k: elt) : tree := Bk Leaf k Leaf.
+
+(** ** Changing root color *)
+
+Definition makeBlack t :=
+ match t with
+ | Leaf => Leaf
+ | Node _ a x b => Bk a x b
+ end.
+
+Definition makeRed t :=
+ match t with
+ | Leaf => Leaf
+ | Node _ a x b => Rd a x b
+ end.
+
+(** ** Balancing *)
+
+(** We adapt when one side is not a true red-black tree.
+    Both sides have the same black depth. *)
+
+Definition lbal l k r :=
+ match l with
+ | Rd (Rd a x b) y c => Rd (Bk a x b) y (Bk c k r)
+ | Rd a x (Rd b y c) => Rd (Bk a x b) y (Bk c k r)
+ | _ => Bk l k r
+ end.
+
+Definition rbal l k r :=
+ match r with
+ | Rd (Rd b y c) z d => Rd (Bk l k b) y (Bk c z d)
+ | Rd b y (Rd c z d) => Rd (Bk l k b) y (Bk c z d)
+ | _ => Bk l k r
+ end.
+
+(** A variant of [rbal], with reverse pattern order.
+    Is it really useful ? Should we always use it ? *)
+
+Definition rbal' l k r :=
+ match r with
+ | Rd b y (Rd c z d) => Rd (Bk l k b) y (Bk c z d)
+ | Rd (Rd b y c) z d => Rd (Bk l k b) y (Bk c z d)
+ | _ => Bk l k r
+ end.
+
+(** Balancing with different black depth.
+    One side is almost a red-black tree, while the other is
+    a true red-black tree, but with black depth + 1.
+    Used in deletion. *)
+
+Definition lbalS l k r :=
+ match l with
+ | Rd a x b => Rd (Bk a x b) k r
+ | _ =>
+   match r with
+   | Bk a y b => rbal' l k (Rd a y b)
+   | Rd (Bk a y b) z c => Rd (Bk l k a) y (rbal' b z (makeRed c))
+   | _ => Rd l k r (* impossible *)
+   end
+ end.
+
+Definition rbalS l k r :=
+ match r with
+ | Rd b y c => Rd l k (Bk b y c)
+ | _ =>
+   match l with
+   | Bk a x b => lbal (Rd a x b) k r
+   | Rd a x (Bk b y c) => Rd (lbal (makeRed a) x b) y (Bk c k r)
+   | _ => Rd l k r (* impossible *)
+   end
+ end.
+
+(** ** Insertion *)
+
+Fixpoint ins x s :=
+ match s with
+ | Leaf => Rd Leaf x Leaf
+ | Node c l y r =>
+   match X.compare x y with
+   | Eq => s
+   | Lt =>
+     match c with
+     | Red => Rd (ins x l) y r
+     | Black => lbal (ins x l) y r
+     end
+   | Gt =>
+     match c with
+     | Red => Rd l y (ins x r)
+     | Black => rbal l y (ins x r)
+     end
+   end
+ end.
+
+Definition add x s := makeBlack (ins x s).
+
+(** ** Deletion *)
+
+Fixpoint append (l:tree) : tree -> tree :=
+ match l with
+ | Leaf => fun r => r
+ | Node lc ll lx lr =>
+   fix append_l (r:tree) : tree :=
+   match r with
+   | Leaf => l
+   | Node rc rl rx rr =>
+     match lc, rc with
+     | Red, Red =>
+       let lrl := append lr rl in
+       match lrl with
+       | Rd lr' x rl' => Rd (Rd ll lx lr') x (Rd rl' rx rr)
+       | _ => Rd ll lx (Rd lrl rx rr)
+       end
+     | Black, Black =>
+       let lrl := append lr rl in
+       match lrl with
+       | Rd lr' x rl' => Rd (Bk ll lx lr') x (Bk rl' rx rr)
+       | _ => lbalS ll lx (Bk lrl rx rr)
+       end
+     | Black, Red => Rd (append_l rl) rx rr
+     | Red, Black => Rd ll lx (append lr r)
+     end
+   end
+ end.
+
+Fixpoint del x t :=
+ match t with
+ | Leaf => Leaf
+ | Node _ a y b =>
+   match X.compare x y with
+   | Eq => append a b
+   | Lt =>
+     match a with
+     | Bk _ _ _ => lbalS (del x a) y b
+     | _ => Rd (del x a) y b
+     end
+   | Gt =>
+     match b with
+     | Bk _ _ _ => rbalS a y (del x b)
+     | _ => Rd a y (del x b)
+     end
+   end
+ end.
+
+Definition remove x t := makeBlack (del x t).
+
+(** ** Removing minimal element *)
+
+Fixpoint delmin l x r : (elt * tree) :=
+ match l with
+ | Leaf => (x,r)
+ | Node lc ll lx lr =>
+   let (k,l') := delmin ll lx lr in
+   match lc with
+   | Black => (k, lbalS l' x r)
+   | Red => (k, Rd l' x r)
+   end
+ end.
+
+Definition remove_min t : option (elt * tree) :=
+ match t with
+ | Leaf => None
+ | Node _ l x r =>
+   let (k,t) := delmin l x r in
+   Some (k, makeBlack t)
+ end.
+
+(** ** Tree-ification
+
+    We rebuild a tree of size [if pred then n-1 else n] as soon
+    as the list [l] has enough elements *)
+
+Definition bogus : tree * list elt := (Leaf, nil).
+
+Notation treeify_t := (list elt -> tree * list elt).
+
+Definition treeify_zero : treeify_t :=
+ fun acc => (Leaf,acc).
+
+Definition treeify_one : treeify_t :=
+ fun acc => match acc with
+ | x::acc => (Rd Leaf x Leaf, acc)
+ | _ => bogus
+ end.
+
+Definition treeify_cont (f g : treeify_t) : treeify_t :=
+ fun acc =>
+ match f acc with
+ | (l, x::acc) =>
+   match g acc with
+   | (r, acc) => (Bk l x r, acc)
+   end
+ | _ => bogus
+ end.
+
+Fixpoint treeify_aux (pred:bool)(n: positive) : treeify_t :=
+ match n with
+ | xH => if pred then treeify_zero else treeify_one
+ | xO n => treeify_cont (treeify_aux pred n) (treeify_aux true n)
+ | xI n => treeify_cont (treeify_aux false n) (treeify_aux pred n)
+ end.
+
+Fixpoint plength_aux (l:list elt)(p:positive) := match l with
+ | nil => p
+ | _::l => plength_aux l (Pos.succ p)
+end.
+
+Definition plength l := plength_aux l 1.
+
+Definition treeify (l:list elt) :=
+ fst (treeify_aux true (plength l) l).
+
+(** ** Filtering *)
+
+Fixpoint filter_aux (f: elt -> bool) s acc :=
+ match s with
+ | Leaf => acc
+ | Node _ l k r =>
+   let acc := filter_aux f r acc in
+   if f k then filter_aux f l (k::acc)
+   else filter_aux f l acc
+ end.
+
+Definition filter (f: elt -> bool) (s: t) : t :=
+ treeify (filter_aux f s nil).
+
+Fixpoint partition_aux (f: elt -> bool) s acc1 acc2 :=
+ match s with
+ | Leaf => (acc1,acc2)
+ | Node _ sl k sr =>
+   let (acc1, acc2) := partition_aux f sr acc1 acc2 in
+   if f k then partition_aux f sl (k::acc1) acc2
+   else partition_aux f sl acc1 (k::acc2)
+ end.
+
+Definition partition (f: elt -> bool) (s:t) : t*t :=
+  let (ok,ko) := partition_aux f s nil nil in
+  (treeify ok, treeify ko).
+
+(** ** Union, intersection, difference *)
+
+(** union of the elements of [l1] and [l2] into a third [acc] list. *)
+
+Fixpoint union_list l1 : list elt -> list elt -> list elt :=
+ match l1 with
+ | nil => @rev_append _
+ | x::l1' =>
+    fix union_l1 l2 acc :=
+    match l2 with
+    | nil => rev_append l1 acc
+    | y::l2' =>
+       match X.compare x y with
+       | Eq => union_list l1' l2' (x::acc)
+       | Lt => union_l1 l2' (y::acc)
+       | Gt => union_list l1' l2 (x::acc)
+       end
+    end
+ end.
+
+Definition linear_union s1 s2 :=
+  treeify (union_list (rev_elements s1) (rev_elements s2) nil).
+
+Fixpoint inter_list l1 : list elt -> list elt -> list elt :=
+ match l1 with
+ | nil => fun _ acc => acc
+ | x::l1' =>
+    fix inter_l1 l2 acc :=
+    match l2 with
+    | nil => acc
+    | y::l2' =>
+       match X.compare x y with
+       | Eq => inter_list l1' l2' (x::acc)
+       | Lt => inter_l1 l2' acc
+       | Gt => inter_list l1' l2 acc
+       end
+    end
+ end.
+
+Definition linear_inter s1 s2 :=
+  treeify (inter_list (rev_elements s1) (rev_elements s2) nil).
+
+Fixpoint diff_list l1 : list elt -> list elt -> list elt :=
+ match l1 with
+ | nil => fun _ acc => acc
+ | x::l1' =>
+    fix diff_l1 l2 acc :=
+    match l2 with
+    | nil => rev_append l1 acc
+    | y::l2' =>
+       match X.compare x y with
+       | Eq => diff_list l1' l2' acc
+       | Lt => diff_l1 l2' acc
+       | Gt => diff_list l1' l2 (x::acc)
+       end
+    end
+ end.
+
+Definition linear_diff s1 s2 :=
+  treeify (diff_list (rev_elements s1) (rev_elements s2) nil).
+
+(** [compare_height] returns:
+  - [Lt] if [height s2] is at least twice [height s1];
+  - [Gt] if [height s1] is at least twice [height s2];
+  - [Eq] if heights are approximately equal.
+  Warning: this is not an equivalence relation! but who cares.... *)
+
+Definition skip_red t :=
+ match t with
+ | Rd t' _ _ => t'
+ | _ => t
+ end.
+
+Definition skip_black t :=
+ match skip_red t with
+ | Bk t' _ _ => t'
+ | t' => t'
+ end.
+
+Fixpoint compare_height (s1x s1 s2 s2x: tree) : comparison :=
+ match skip_red s1x, skip_red s1, skip_red s2, skip_red s2x with
+ | Node _ s1x' _ _, Node _ s1' _ _, Node _ s2' _ _, Node _ s2x' _ _ =>
+   compare_height (skip_black s2x') s1' s2' (skip_black s2x')
+ | _, Leaf, _, Node _ _ _ _ => Lt
+ | Node _ _ _ _, _, Leaf, _ => Gt
+ | Node _ s1x' _ _, Node _ s1' _ _, Node _ s2' _ _, Leaf =>
+   compare_height (skip_black s1x') s1' s2' Leaf
+ | Leaf, Node _ s1' _ _, Node _ s2' _ _, Node _ s2x' _ _ =>
+   compare_height Leaf s1'  s2'  (skip_black s2x')
+ | _, _, _, _ => Eq
+ end.
+
+(** When one tree is quite smaller than the other, we simply
+    adds repeatively all its elements in the big one.
+    For trees of comparable height, we rather use [linear_union]. *)
+
+Definition union (t1 t2: t) : t :=
+ match compare_height t1 t1 t2 t2 with
+ | Lt => fold add t1 t2
+ | Gt => fold add t2 t1
+ | Eq => linear_union t1 t2
+ end.
+
+Definition diff (t1 t2: t) : t :=
+ match compare_height t1 t1 t2 t2 with
+ | Lt => filter (fun k => negb (mem k t2)) t1
+ | Gt => fold remove t2 t1
+ | Eq => linear_diff t1 t2
+ end.
+
+Definition inter (t1 t2: t) : t :=
+ match compare_height t1 t1 t2 t2 with
+ | Lt => filter (fun k => mem k t2) t1
+ | Gt => filter (fun k => mem k t1) t2
+ | Eq => linear_inter t1 t2
+ end.
+
+End Ops.
+
+(** * MakeRaw : the pure functions and their specifications *)
+
+Module Type MakeRaw (X:Orders.OrderedType) <: MSetInterface.RawSets X.
+Include Ops X.
+
+(** Generic definition of binary-search-trees and proofs of
+    specifications for generic functions such as mem or fold. *)
+
+Include MSetGenTree.Props X Color.
+
+Local Notation Rd := (Node Red).
+Local Notation Bk := (Node Black).
+
+Local Hint Immediate MX.eq_sym.
+Local Hint Unfold In lt_tree gt_tree Ok.
+Local Hint Constructors InT bst.
+Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans @ok.
+Local Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node.
+Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans.
+Local Hint Resolve elements_spec2.
+
+(** ** Singleton set *)
+
+Lemma singleton_spec x y : InT y (singleton x) <-> X.eq y x.
+Proof.
+ unfold singleton; intuition_in.
+Qed.
+
+Instance singleton_ok x : Ok (singleton x).
+Proof.
+ unfold singleton; auto.
+Qed.
+
+(** ** makeBlack, MakeRed *)
+
+Lemma makeBlack_spec s x : InT x (makeBlack s) <-> InT x s.
+Proof.
+ destruct s; simpl; intuition_in.
+Qed.
+
+Lemma makeRed_spec s x : InT x (makeRed s) <-> InT x s.
+Proof.
+ destruct s; simpl; intuition_in.
+Qed.
+
+Instance makeBlack_ok s `{Ok s} : Ok (makeBlack s).
+Proof.
+ destruct s; simpl; ok.
+Qed.
+
+Instance makeRed_ok s `{Ok s} : Ok (makeRed s).
+Proof.
+ destruct s; simpl; ok.
+Qed.
+
+(** ** Generic handling for red-matching and red-red-matching *)
+
+Definition isblack t :=
+ match t with Bk _ _ _ => True | _ => False end.
+
+Definition notblack t :=
+ match t with Bk _ _ _ => False | _ => True end.
+
+Definition notred t :=
+ match t with Rd _ _ _ => False | _ => True end.
+
+Definition rcase {A} f g t : A :=
+ match t with
+ | Rd a x b => f a x b
+ | _ => g t
+ end.
+
+Inductive rspec {A} f g : tree -> A -> Prop :=
+ | rred a x b : rspec f g (Rd a x b) (f a x b)
+ | relse t : notred t -> rspec f g t (g t).
+
+Fact rmatch {A} f g t : rspec (A:=A) f g t (rcase f g t).
+Proof.
+destruct t as [|[|] l x r]; simpl; now constructor.
+Qed.
+
+Definition rrcase {A} f g t : A :=
+ match t with
+ | Rd (Rd a x b) y c => f a x b y c
+ | Rd a x (Rd b y c) => f a x b y c
+ | _ => g t
+ end.
+
+Notation notredred := (rrcase (fun _ _ _ _ _ => False) (fun _ => True)).
+
+Inductive rrspec {A} f g : tree -> A -> Prop :=
+ | rrleft a x b y c : rrspec f g (Rd (Rd a x b) y c) (f a x b y c)
+ | rrright a x b y c : rrspec f g (Rd a x (Rd b y c)) (f a x b y c)
+ | rrelse t : notredred t -> rrspec f g t (g t).
+
+Fact rrmatch {A} f g t : rrspec (A:=A) f g t (rrcase f g t).
+Proof.
+destruct t as [|[|] l x r]; simpl; try now constructor.
+destruct l as [|[|] ll lx lr], r as [|[|] rl rx rr]; now constructor.
+Qed.
+
+Definition rrcase' {A} f g t : A :=
+ match t with
+ | Rd a x (Rd b y c) => f a x b y c
+ | Rd (Rd a x b) y c => f a x b y c
+ | _ => g t
+ end.
+
+Fact rrmatch' {A} f g t : rrspec (A:=A) f g t (rrcase' f g t).
+Proof.
+destruct t as [|[|] l x r]; simpl; try now constructor.
+destruct l as [|[|] ll lx lr], r as [|[|] rl rx rr]; now constructor.
+Qed.
+
+(** Balancing operations are instances of generic match *)
+
+Fact lbal_match l k r :
+ rrspec
+   (fun a x b y c => Rd (Bk a x b) y (Bk c k r))
+   (fun l => Bk l k r)
+   l
+   (lbal l k r).
+Proof.
+ exact (rrmatch _ _ _).
+Qed.
+
+Fact rbal_match l k r :
+ rrspec
+   (fun a x b y c => Rd (Bk l k a) x (Bk b y c))
+   (fun r => Bk l k r)
+   r
+   (rbal l k r).
+Proof.
+ exact (rrmatch _ _ _).
+Qed.
+
+Fact rbal'_match l k r :
+ rrspec
+   (fun a x b y c => Rd (Bk l k a) x (Bk b y c))
+   (fun r => Bk l k r)
+   r
+   (rbal' l k r).
+Proof.
+ exact (rrmatch' _ _ _).
+Qed.
+
+Fact lbalS_match l x r :
+ rspec
+  (fun a y b => Rd (Bk a y b) x r)
+  (fun l =>
+    match r with
+    | Bk a y b => rbal' l x (Rd a y b)
+    | Rd (Bk a y b) z c => Rd (Bk l x a) y (rbal' b z (makeRed c))
+    | _ => Rd l x r
+    end)
+  l
+  (lbalS l x r).
+Proof.
+ exact (rmatch _ _ _).
+Qed.
+
+Fact rbalS_match l x r :
+ rspec
+  (fun a y b => Rd l x (Bk a y b))
+  (fun r =>
+    match l with
+    | Bk a y b => lbal (Rd a y b) x r
+    | Rd a y (Bk b z c) => Rd (lbal (makeRed a) y b) z (Bk c x r)
+    | _ => Rd l x r
+    end)
+  r
+  (rbalS l x r).
+Proof.
+ exact (rmatch _ _ _).
+Qed.
+
+(** ** Balancing for insertion *)
+
+Lemma lbal_spec l x r y :
+   InT y (lbal l x r) <-> X.eq y x \/ InT y l \/ InT y r.
+Proof.
+ case lbal_match; intuition_in.
+Qed.
+
+Instance lbal_ok l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r) :
+ Ok (lbal l x r).
+Proof.
+ destruct (lbal_match l x r); ok.
+Qed.
+
+Lemma rbal_spec l x r y :
+   InT y (rbal l x r) <-> X.eq y x \/ InT y l \/ InT y r.
+Proof.
+ case rbal_match; intuition_in.
+Qed.
+
+Instance rbal_ok l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r) :
+ Ok (rbal l x r).
+Proof.
+ destruct (rbal_match l x r); ok.
+Qed.
+
+Lemma rbal'_spec l x r y :
+   InT y (rbal' l x r) <-> X.eq y x \/ InT y l \/ InT y r.
+Proof.
+ case rbal'_match; intuition_in.
+Qed.
+
+Instance rbal'_ok l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r) :
+ Ok (rbal' l x r).
+Proof.
+ destruct (rbal'_match l x r); ok.
+Qed.
+
+Hint Rewrite In_node_iff In_leaf_iff
+ makeRed_spec makeBlack_spec lbal_spec rbal_spec rbal'_spec : rb.
+
+Ltac descolor := destruct_all Color.t.
+Ltac destree t := destruct t as [|[|] ? ? ?].
+Ltac autorew := autorewrite with rb.
+Tactic Notation "autorew" "in" ident(H) := autorewrite with rb in H.
+
+(** ** Insertion *)
+
+Lemma ins_spec : forall s x y,
+ InT y (ins x s) <-> X.eq y x \/ InT y s.
+Proof.
+ induct s x.
+ - intuition_in.
+ - intuition_in. setoid_replace y with x; eauto.
+ - descolor; autorew; rewrite IHl; intuition_in.
+ - descolor; autorew; rewrite IHr; intuition_in.
+Qed.
+Hint Rewrite ins_spec : rb.
+
+Instance ins_ok s x `{Ok s} : Ok (ins x s).
+Proof.
+ induct s x; auto; descolor;
+ (apply lbal_ok || apply rbal_ok || ok); auto;
+ intros y; autorew; intuition; order.
+Qed.
+
+Lemma add_spec' s x y :
+ InT y (add x s) <-> X.eq y x \/ InT y s.
+Proof.
+ unfold add. now autorew.
+Qed.
+
+Hint Rewrite add_spec' : rb.
+
+Lemma add_spec s x y `{Ok s} :
+ InT y (add x s) <-> X.eq y x \/ InT y s.
+Proof.
+ apply add_spec'.
+Qed.
+
+Instance add_ok s x `{Ok s} : Ok (add x s).
+Proof.
+ unfold add; auto_tc.
+Qed.
+
+(** ** Balancing for deletion *)
+
+Lemma lbalS_spec l x r y :
+  InT y (lbalS l x r) <-> X.eq y x \/ InT y l \/ InT y r.
+Proof.
+ case lbalS_match.
+ - intros; autorew; intuition_in.
+ - clear l. intros l _.
+   destruct r as [|[|] rl rx rr].
+   * autorew. intuition_in.
+   * destree rl; autorew; intuition_in.
+   * autorew. intuition_in.
+Qed.
+
+Instance lbalS_ok l x r :
+ forall `(Ok l, Ok r, lt_tree x l, gt_tree x r), Ok (lbalS l x r).
+Proof.
+ case lbalS_match; intros.
+ - ok.
+ - destruct r as [|[|] rl rx rr].
+   * ok.
+   * destruct rl as [|[|] rll rlx rlr]; intros; ok.
+     + apply rbal'_ok; ok.
+       intros w; autorew; auto.
+     + intros w; autorew.
+       destruct 1 as [Hw|[Hw|Hw]]; try rewrite Hw; eauto.
+   * ok. autorew. apply rbal'_ok; ok.
+Qed.
+
+Lemma rbalS_spec l x r y :
+  InT y (rbalS l x r) <-> X.eq y x \/ InT y l \/ InT y r.
+Proof.
+ case rbalS_match.
+ - intros; autorew; intuition_in.
+ - intros t _.
+   destruct l as [|[|] ll lx lr].
+   * autorew. intuition_in.
+   * destruct lr as [|[|] lrl lrx lrr]; autorew; intuition_in.
+   * autorew. intuition_in.
+Qed.
+
+Instance rbalS_ok l x r :
+ forall `(Ok l, Ok r, lt_tree x l, gt_tree x r), Ok (rbalS l x r).
+Proof.
+ case rbalS_match; intros.
+ - ok.
+ - destruct l as [|[|] ll lx lr].
+   * ok.
+   * destruct lr as [|[|] lrl lrx lrr]; intros; ok.
+     + apply lbal_ok; ok.
+       intros w; autorew; auto.
+     + intros w; autorew.
+       destruct 1 as [Hw|[Hw|Hw]]; try rewrite Hw; eauto.
+   * ok. apply lbal_ok; ok.
+Qed.
+
+Hint Rewrite lbalS_spec rbalS_spec : rb.
+
+(** ** Append for deletion *)
+
+Ltac append_tac l r :=
+ induction l as [| lc ll _ lx lr IHlr];
+ [intro r; simpl
+ |induction r as [| rc rl IHrl rx rr _];
+   [simpl
+   |destruct lc, rc;
+     [specialize (IHlr rl); clear IHrl
+     |simpl;
+      assert (Hr:notred (Bk rl rx rr)) by (simpl; trivial);
+      set (r:=Bk rl rx rr) in *; clearbody r; clear IHrl rl rx rr;
+      specialize (IHlr r)
+     |change (append _ _) with (Rd (append (Bk ll lx lr) rl) rx rr);
+      assert (Hl:notred (Bk ll lx lr)) by (simpl; trivial);
+      set (l:=Bk ll lx lr) in *; clearbody l; clear IHlr ll lx lr
+     |specialize (IHlr rl); clear IHrl]]].
+
+Fact append_rr_match ll lx lr rl rx rr :
+ rspec
+  (fun a x b => Rd (Rd ll lx a) x (Rd b rx rr))
+  (fun t => Rd ll lx (Rd t rx rr))
+  (append lr rl)
+  (append (Rd ll lx lr) (Rd rl rx rr)).
+Proof.
+ exact (rmatch _ _ _).
+Qed.
+
+Fact append_bb_match ll lx lr rl rx rr :
+ rspec
+  (fun a x b => Rd (Bk ll lx a) x (Bk b rx rr))
+  (fun t => lbalS ll lx (Bk t rx rr))
+  (append lr rl)
+  (append (Bk ll lx lr) (Bk rl rx rr)).
+Proof.
+ exact (rmatch _ _ _).
+Qed.
+
+Lemma append_spec l r x :
+ InT x (append l r) <-> InT x l \/ InT x r.
+Proof.
+ revert r.
+ append_tac l r; autorew; try tauto.
+ - (* Red / Red *)
+   revert IHlr; case append_rr_match;
+    [intros a y b | intros t Ht]; autorew; tauto.
+ - (* Black / Black *)
+   revert IHlr; case append_bb_match;
+    [intros a y b | intros t Ht]; autorew; tauto.
+Qed.
+
+Hint Rewrite append_spec : rb.
+
+Lemma append_ok : forall x l r `{Ok l, Ok r},
+ lt_tree x l -> gt_tree x r -> Ok (append l r).
+Proof.
+ append_tac l r.
+ - (* Leaf / _ *)
+   trivial.
+ - (* _ / Leaf *)
+   trivial.
+ - (* Red / Red *)
+   intros; inv.
+   assert (IH : Ok (append lr rl)) by (apply IHlr; eauto). clear IHlr.
+   assert (X.lt lx rx) by (transitivity x; eauto).
+   assert (G : gt_tree lx (append lr rl)).
+    { intros w. autorew. destruct 1; [|transitivity x]; eauto. }
+   assert (L : lt_tree rx (append lr rl)).
+    { intros w. autorew. destruct 1; [transitivity x|]; eauto. }
+   revert IH G L; case append_rr_match; intros; ok.
+ - (* Red / Black *)
+   intros; ok.
+   intros w; autorew; destruct 1; eauto.
+ - (* Black / Red *)
+   intros; ok.
+   intros w; autorew; destruct 1; eauto.
+ - (* Black / Black *)
+   intros; inv.
+   assert (IH : Ok (append lr rl)) by (apply IHlr; eauto). clear IHlr.
+   assert (X.lt lx rx) by (transitivity x; eauto).
+   assert (G : gt_tree lx (append lr rl)).
+    { intros w. autorew. destruct 1; [|transitivity x]; eauto. }
+   assert (L : lt_tree rx (append lr rl)).
+    { intros w. autorew. destruct 1; [transitivity x|]; eauto. }
+   revert IH G L; case append_bb_match; intros; ok.
+    apply lbalS_ok; ok.
+Qed.
+
+(** ** Deletion *)
+
+Lemma del_spec : forall s x y `{Ok s},
+ InT y (del x s) <-> InT y s /\ ~X.eq y x.
+Proof.
+induct s x.
+- intuition_in.
+- autorew; intuition_in.
+  assert (X.lt y x') by eauto. order.
+  assert (X.lt x' y) by eauto. order.
+  order.
+- destruct l as [|[|] ll lx lr]; autorew;
+  rewrite ?IHl by trivial; intuition_in; order.
+- destruct r as [|[|] rl rx rr]; autorew;
+  rewrite ?IHr by trivial; intuition_in; order.
+Qed.
+
+Hint Rewrite del_spec : rb.
+
+Instance del_ok s x `{Ok s} : Ok (del x s).
+Proof.
+induct s x.
+- trivial.
+- eapply append_ok; eauto.
+- assert (lt_tree x' (del x l)).
+  { intro w. autorew; trivial. destruct 1. eauto. }
+  destruct l as [|[|] ll lx lr]; auto_tc.
+- assert (gt_tree x' (del x r)).
+  { intro w. autorew; trivial. destruct 1. eauto. }
+  destruct r as [|[|] rl rx rr]; auto_tc.
+Qed.
+
+Lemma remove_spec s x y `{Ok s} :
+ InT y (remove x s) <-> InT y s /\ ~X.eq y x.
+Proof.
+unfold remove. now autorew.
+Qed.
+
+Hint Rewrite remove_spec : rb.
+
+Instance remove_ok s x `{Ok s} : Ok (remove x s).
+Proof.
+unfold remove; auto_tc.
+Qed.
+
+(** ** Removing the minimal element *)
+
+Lemma delmin_spec l y r c x s' `{O : Ok (Node c l y r)} :
+ delmin l y r = (x,s') ->
+  min_elt (Node c l y r) = Some x /\ del x (Node c l y r) = s'.
+Proof.
+ revert y r c x s' O.
+ induction l as [|lc ll IH ly lr _].
+ - simpl. intros y r _ x s' _. injection 1; intros; subst.
+   now rewrite MX.compare_refl.
+ - intros y r c x s' O.
+   simpl delmin.
+   specialize (IH ly lr). destruct delmin as (x0,s0).
+   destruct (IH lc x0 s0); clear IH; [ok|trivial|].
+   remember (Node lc ll ly lr) as l.
+   simpl min_elt in *.
+   intros E.
+   replace x0 with x in * by (destruct lc; now injection E).
+   split.
+   * subst l; intuition.
+   * assert (X.lt x y).
+     { inversion_clear O.
+       assert (InT x l) by now apply min_elt_spec1. auto. }
+     simpl. case X.compare_spec; try order.
+     destruct lc; injection E; clear E; intros; subst l s0; auto.
+Qed.
+
+Lemma remove_min_spec1 s x s' `{Ok s}:
+ remove_min s = Some (x,s') ->
+  min_elt s = Some x /\ remove x s = s'.
+Proof.
+ unfold remove_min.
+ destruct s as [|c l y r]; try easy.
+ generalize (delmin_spec l y r c).
+ destruct delmin as (x0,s0). intros D.
+ destruct (D x0 s0) as (->,<-); auto.
+ fold (remove x0 (Node c l y r)).
+ inversion_clear 1; auto.
+Qed.
+
+Lemma remove_min_spec2 s : remove_min s = None -> Empty s.
+Proof.
+ unfold remove_min.
+ destruct s as [|c l y r].
+ - easy.
+ - now destruct delmin.
+Qed.
+
+Lemma remove_min_ok (s:t) `{Ok s}:
+ match remove_min s with
+ | Some (_,s') => Ok s'
+ | None => True
+ end.
+Proof.
+ generalize (remove_min_spec1 s).
+ destruct remove_min as [(x0,s0)|]; auto.
+ intros R. destruct (R x0 s0); auto. subst s0. auto_tc.
+Qed.
+
+(** ** Treeify *)
+
+Notation ifpred p n := (if p then pred n else n%nat).
+
+Definition treeify_invariant size (f:treeify_t) :=
+ forall acc,
+ size <= length acc ->
+ let (t,acc') := f acc in
+ cardinal t = size /\ acc = elements t ++ acc'.
+
+Lemma treeify_zero_spec : treeify_invariant 0 treeify_zero.
+Proof.
+ intro. simpl. auto.
+Qed.
+
+Lemma treeify_one_spec : treeify_invariant 1 treeify_one.
+Proof.
+ intros [|x acc]; simpl; auto; inversion 1.
+Qed.
+
+Lemma treeify_cont_spec f g size1 size2 size :
+ treeify_invariant size1 f ->
+ treeify_invariant size2 g ->
+ size = S (size1 + size2) ->
+ treeify_invariant size (treeify_cont f g).
+Proof.
+ intros Hf Hg EQ acc LE. unfold treeify_cont.
+ specialize (Hf acc).
+ destruct (f acc) as (t1,acc1).
+ destruct Hf as (Hf1,Hf2).
+  { transitivity size; trivial. subst. auto with arith. }
+ destruct acc1 as [|x acc1].
+  { exfalso. revert LE. apply Nat.lt_nge. subst.
+    rewrite <- app_nil_end, <- elements_cardinal; auto with arith. }
+ specialize (Hg acc1).
+ destruct (g acc1) as (t2,acc2).
+ destruct Hg as (Hg1,Hg2).
+  { revert LE. subst.
+    rewrite app_length, <- elements_cardinal. simpl.
+    rewrite Nat.add_succ_r, <- Nat.succ_le_mono.
+    apply Nat.add_le_mono_l. }
+ simpl. rewrite elements_node, app_ass. now subst.
+Qed.
+
+Lemma treeify_aux_spec n (p:bool) :
+ treeify_invariant (ifpred p (Pos.to_nat n)) (treeify_aux p n).
+Proof.
+ revert p.
+ induction n as [n|n|]; intros p; simpl treeify_aux.
+ - eapply treeify_cont_spec; [ apply (IHn false) | apply (IHn p) | ].
+   rewrite Pos2Nat.inj_xI.
+   assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H.
+   destruct p; simpl; intros; rewrite Nat.add_0_r; trivial.
+   now rewrite <- Nat.add_succ_r, Nat.succ_pred; trivial.
+ - eapply treeify_cont_spec; [ apply (IHn p) | apply (IHn true) | ].
+   rewrite Pos2Nat.inj_xO.
+   assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H.
+   rewrite <- Nat.add_succ_r, Nat.succ_pred by trivial.
+   destruct p; simpl; intros; rewrite Nat.add_0_r; trivial.
+   symmetry. now apply Nat.add_pred_l.
+ - destruct p; [ apply treeify_zero_spec | apply treeify_one_spec ].
+Qed.
+
+Lemma plength_aux_spec l p :
+  Pos.to_nat (plength_aux l p) = length l + Pos.to_nat p.
+Proof.
+ revert p. induction l; simpl; trivial.
+ intros. now rewrite IHl, Pos2Nat.inj_succ, Nat.add_succ_r.
+Qed.
+
+Lemma plength_spec l : Pos.to_nat (plength l) = S (length l).
+Proof.
+ unfold plength. rewrite plength_aux_spec. apply Nat.add_1_r.
+Qed.
+
+Lemma treeify_elements l : elements (treeify l) = l.
+Proof.
+ assert (H := treeify_aux_spec (plength l) true l).
+ unfold treeify. destruct treeify_aux as (t,acc); simpl in *.
+ destruct H as (H,H'). { now rewrite plength_spec. }
+ subst l. rewrite plength_spec, app_length, <- elements_cardinal in *.
+ destruct acc.
+ * now rewrite app_nil_r.
+ * exfalso. revert H. simpl.
+   rewrite Nat.add_succ_r, Nat.add_comm.
+   apply Nat.succ_add_discr.
+Qed.
+
+Lemma treeify_spec x l : InT x (treeify l) <-> InA X.eq x l.
+Proof.
+ intros. now rewrite <- elements_spec1, treeify_elements.
+Qed.
+
+Lemma treeify_ok l : sort X.lt l -> Ok (treeify l).
+Proof.
+ intros. apply elements_sort_ok. rewrite treeify_elements; auto.
+Qed.
+
+
+(** ** Filter *)
+
+Lemma filter_app A f (l l':list A) :
+ List.filter f (l ++ l') = List.filter f l ++ List.filter f l'.
+Proof.
+ induction l as [|x l IH]; simpl; trivial.
+ destruct (f x); simpl; now rewrite IH.
+Qed.
+
+Lemma filter_aux_elements s f acc :
+ filter_aux f s acc = List.filter f (elements s) ++ acc.
+Proof.
+ revert acc.
+ induction s as [|c l IHl x r IHr]; simpl; trivial.
+ intros acc.
+ rewrite elements_node, filter_app. simpl.
+ destruct (f x); now rewrite IHl, IHr, app_ass.
+Qed.
+
+Lemma filter_elements s f :
+ elements (filter f s) = List.filter f (elements s).
+Proof.
+ unfold filter.
+ now rewrite treeify_elements, filter_aux_elements, app_nil_r.
+Qed.
+
+Lemma filter_spec s x f :
+ Proper (X.eq==>Logic.eq) f ->
+ (InT x (filter f s) <-> InT x s /\ f x = true).
+Proof.
+ intros Hf.
+ rewrite <- elements_spec1, filter_elements, filter_InA, elements_spec1;
+  now auto_tc.
+Qed.
+
+Instance filter_ok s f `(Ok s) : Ok (filter f s).
+Proof.
+ apply elements_sort_ok.
+ rewrite filter_elements.
+ apply filter_sort with X.eq; auto_tc.
+Qed.
+
+(** ** Partition *)
+
+Lemma partition_aux_spec s f acc1 acc2 :
+ partition_aux f s acc1 acc2 =
+  (filter_aux f s acc1, filter_aux (fun x => negb (f x)) s acc2).
+Proof.
+ revert acc1 acc2.
+ induction s as [ | c l Hl x r Hr ]; simpl.
+ - trivial.
+ - intros acc1 acc2.
+   destruct (f x); simpl; now rewrite Hr, Hl.
+Qed.
+
+Lemma partition_spec s f :
+ partition f s = (filter f s, filter (fun x => negb (f x)) s).
+Proof.
+ unfold partition, filter. now rewrite partition_aux_spec.
+Qed.
+
+Lemma partition_spec1 s f :
+ Proper (X.eq==>Logic.eq) f ->
+ Equal (fst (partition f s)) (filter f s).
+Proof. now rewrite partition_spec. Qed.
+
+Lemma partition_spec2 s f :
+ Proper (X.eq==>Logic.eq) f ->
+ Equal (snd (partition f s)) (filter (fun x => negb (f x)) s).
+Proof. now rewrite partition_spec. Qed.
+
+Instance partition_ok1 s f `(Ok s) : Ok (fst (partition f s)).
+Proof. rewrite partition_spec; now apply filter_ok. Qed.
+
+Instance partition_ok2 s f `(Ok s) : Ok (snd (partition f s)).
+Proof. rewrite partition_spec; now apply filter_ok. Qed.
+
+
+(** ** An invariant for binary list functions with accumulator. *)
+
+Ltac inA :=
+ rewrite ?InA_app_iff, ?InA_cons, ?InA_nil, ?InA_rev in *; auto_tc.
+
+Record INV l1 l2 acc : Prop := {
+ l1_sorted : sort X.lt (rev l1);
+ l2_sorted : sort X.lt (rev l2);
+ acc_sorted : sort X.lt acc;
+ l1_lt_acc x y : InA X.eq x l1 -> InA X.eq y acc -> X.lt x y;
+ l2_lt_acc x y : InA X.eq x l2 -> InA X.eq y acc -> X.lt x y}.
+Local Hint Resolve l1_sorted l2_sorted acc_sorted.
+
+Lemma INV_init s1 s2 `(Ok s1, Ok s2) :
+ INV (rev_elements s1) (rev_elements s2) nil.
+Proof.
+ rewrite !rev_elements_rev.
+ split; rewrite ?rev_involutive; auto; intros; now inA.
+Qed.
+
+Lemma INV_sym l1 l2 acc : INV l1 l2 acc -> INV l2 l1 acc.
+Proof.
+ destruct 1; now split.
+Qed.
+
+Lemma INV_drop x1 l1 l2 acc :
+  INV (x1 :: l1) l2 acc -> INV l1 l2 acc.
+Proof.
+ intros (l1s,l2s,accs,l1a,l2a). simpl in *.
+ destruct (sorted_app_inv _ _ l1s) as (U & V & W); auto.
+ split; auto.
+Qed.
+
+Lemma INV_eq x1 x2 l1 l2 acc :
+  INV (x1 :: l1) (x2 :: l2) acc -> X.eq x1 x2 ->
+  INV l1 l2 (x1 :: acc).
+Proof.
+ intros (U,V,W,X,Y) EQ. simpl in *.
+ destruct (sorted_app_inv _ _ U) as (U1 & U2 & U3); auto.
+ destruct (sorted_app_inv _ _ V) as (V1 & V2 & V3); auto.
+ split; auto.
+ - constructor; auto. apply InA_InfA with X.eq; auto_tc.
+ - intros x y; inA; intros Hx [Hy|Hy].
+   + apply U3; inA.
+   + apply X; inA.
+ - intros x y; inA; intros Hx [Hy|Hy].
+   + rewrite Hy, EQ; apply V3; inA.
+   + apply Y; inA.
+Qed.
+
+Lemma INV_lt x1 x2 l1 l2 acc :
+  INV (x1 :: l1) (x2 :: l2) acc -> X.lt x1 x2 ->
+  INV (x1 :: l1) l2 (x2 :: acc).
+Proof.
+ intros (U,V,W,X,Y) EQ. simpl in *.
+ destruct (sorted_app_inv _ _ U) as (U1 & U2 & U3); auto.
+ destruct (sorted_app_inv _ _ V) as (V1 & V2 & V3); auto.
+ split; auto.
+ - constructor; auto. apply InA_InfA with X.eq; auto_tc.
+ - intros x y; inA; intros Hx [Hy|Hy].
+   + rewrite Hy; clear Hy. destruct Hx; [order|].
+     transitivity x1; auto. apply U3; inA.
+   + apply X; inA.
+ - intros x y; inA; intros Hx [Hy|Hy].
+   + rewrite Hy. apply V3; inA.
+   + apply Y; inA.
+Qed.
+
+Lemma INV_rev l1 l2 acc :
+ INV l1 l2 acc -> Sorted X.lt (rev_append l1 acc).
+Proof.
+ intros. rewrite rev_append_rev.
+ apply SortA_app with X.eq; eauto with *.
+ intros x y. inA. eapply l1_lt_acc; eauto.
+Qed.
+
+(** ** union *)
+
+Lemma union_list_ok l1 l2 acc :
+ INV l1 l2 acc -> sort X.lt (union_list l1 l2 acc).
+Proof.
+ revert l2 acc.
+ induction l1 as [|x1 l1 IH1];
+  [intro l2|induction l2 as [|x2 l2 IH2]];
+   intros acc inv.
+ - eapply INV_rev, INV_sym; eauto.
+ - eapply INV_rev; eauto.
+ - simpl. case X.compare_spec; intro C.
+   * apply IH1. eapply INV_eq; eauto.
+   * apply (IH2 (x2::acc)). eapply INV_lt; eauto.
+   * apply IH1. eapply INV_sym, INV_lt; eauto. now apply INV_sym.
+Qed.
+
+Instance linear_union_ok s1 s2 `(Ok s1, Ok s2) :
+ Ok (linear_union s1 s2).
+Proof.
+ unfold linear_union. now apply treeify_ok, union_list_ok, INV_init.
+Qed.
+
+Instance fold_add_ok s1 s2 `(Ok s1, Ok s2) :
+ Ok (fold add s1 s2).
+Proof.
+ rewrite fold_spec, <- fold_left_rev_right.
+ unfold elt in *.
+ induction (rev (elements s1)); simpl; unfold flip in *; auto_tc.
+Qed.
+
+Instance union_ok s1 s2 `(Ok s1, Ok s2) : Ok (union s1 s2).
+Proof.
+ unfold union. destruct compare_height; auto_tc.
+Qed.
+
+Lemma union_list_spec x l1 l2 acc :
+ InA X.eq x (union_list l1 l2 acc) <->
+  InA X.eq x l1 \/ InA X.eq x l2 \/ InA X.eq x acc.
+Proof.
+ revert l2 acc.
+ induction l1 as [|x1 l1 IH1].
+ - intros l2 acc; simpl. rewrite rev_append_rev. inA. tauto.
+ - induction l2 as [|x2 l2 IH2]; intros acc; simpl.
+   * rewrite rev_append_rev. inA. tauto.
+   * case X.compare_spec; intro C.
+     + rewrite IH1, !InA_cons, C; tauto.
+     + rewrite (IH2 (x2::acc)), !InA_cons. tauto.
+     + rewrite IH1, !InA_cons; tauto.
+Qed.
+
+Lemma linear_union_spec s1 s2 x :
+ InT x (linear_union s1 s2) <-> InT x s1 \/ InT x s2.
+Proof.
+ unfold linear_union.
+ rewrite treeify_spec, union_list_spec, !rev_elements_rev.
+ rewrite !InA_rev, InA_nil, !elements_spec1 by auto_tc.
+ tauto.
+Qed.
+
+Lemma fold_add_spec s1 s2 x :
+ InT x (fold add s1 s2) <-> InT x s1 \/ InT x s2.
+Proof.
+ rewrite fold_spec, <- fold_left_rev_right.
+ rewrite <- (elements_spec1 s1), <- InA_rev by auto_tc.
+ unfold elt in *.
+ induction (rev (elements s1)); simpl.
+ - rewrite InA_nil. tauto.
+ - unfold flip. rewrite add_spec', IHl, InA_cons. tauto.
+Qed.
+
+Lemma union_spec' s1 s2 x :
+ InT x (union s1 s2) <-> InT x s1 \/ InT x s2.
+Proof.
+ unfold union. destruct compare_height.
+ - apply linear_union_spec.
+ - apply fold_add_spec.
+ - rewrite fold_add_spec. tauto.
+Qed.
+
+Lemma union_spec : forall s1 s2 y `{Ok s1, Ok s2},
+ (InT y (union s1 s2) <-> InT y s1 \/ InT y s2).
+Proof.
+ intros; apply union_spec'.
+Qed.
+
+(** ** inter *)
+
+Lemma inter_list_ok l1 l2 acc :
+ INV l1 l2 acc -> sort X.lt (inter_list l1 l2 acc).
+Proof.
+ revert l2 acc.
+ induction l1 as [|x1 l1 IH1]; [|induction l2 as [|x2 l2 IH2]]; simpl.
+ - eauto.
+ - eauto.
+ - intros acc inv.
+   case X.compare_spec; intro C.
+   * apply IH1. eapply INV_eq; eauto.
+   * apply (IH2 acc). eapply INV_sym, INV_drop, INV_sym; eauto.
+   * apply IH1. eapply INV_drop; eauto.
+Qed.
+
+Instance linear_inter_ok s1 s2 `(Ok s1, Ok s2) :
+ Ok (linear_inter s1 s2).
+Proof.
+ unfold linear_inter. now apply treeify_ok, inter_list_ok, INV_init.
+Qed.
+
+Instance inter_ok s1 s2 `(Ok s1, Ok s2) : Ok (inter s1 s2).
+Proof.
+ unfold inter. destruct compare_height; auto_tc.
+Qed.
+
+Lemma inter_list_spec x l1 l2 acc :
+ sort X.lt (rev l1) ->
+ sort X.lt (rev l2) ->
+ (InA X.eq x (inter_list l1 l2 acc) <->
+   (InA X.eq x l1 /\ InA X.eq x l2) \/ InA X.eq x acc).
+Proof.
+ revert l2 acc.
+ induction l1 as [|x1 l1 IH1].
+ - intros l2 acc; simpl. inA. tauto.
+ - induction l2 as [|x2 l2 IH2]; intros acc.
+   * simpl. inA. tauto.
+   * simpl. intros U V.
+     destruct (sorted_app_inv _ _ U) as (U1 & U2 & U3); auto.
+     destruct (sorted_app_inv _ _ V) as (V1 & V2 & V3); auto.
+     case X.compare_spec; intro C.
+     + rewrite IH1, !InA_cons, C; tauto.
+     + rewrite (IH2 acc); auto. inA. intuition; try order.
+       assert (X.lt x x1) by (apply U3; inA). order.
+     + rewrite IH1; auto. inA. intuition; try order.
+       assert (X.lt x x2) by (apply V3; inA). order.
+Qed.
+
+Lemma linear_inter_spec s1 s2 x `(Ok s1, Ok s2) :
+ InT x (linear_inter s1 s2) <-> InT x s1 /\ InT x s2.
+Proof.
+ unfold linear_inter.
+ rewrite !rev_elements_rev, treeify_spec, inter_list_spec
+  by (rewrite rev_involutive; auto_tc).
+ rewrite !InA_rev, InA_nil, !elements_spec1 by auto_tc. tauto.
+Qed.
+
+Local Instance mem_proper s `(Ok s) :
+ Proper (X.eq ==> Logic.eq) (fun k => mem k s).
+Proof.
+ intros x y EQ. apply Bool.eq_iff_eq_true; rewrite !mem_spec; auto.
+ now rewrite EQ.
+Qed.
+
+Lemma inter_spec s1 s2 y `{Ok s1, Ok s2} :
+ InT y (inter s1 s2) <-> InT y s1 /\ InT y s2.
+Proof.
+ unfold inter. destruct compare_height.
+ - now apply linear_inter_spec.
+ - rewrite filter_spec, mem_spec by auto_tc; tauto.
+ - rewrite filter_spec, mem_spec by auto_tc; tauto.
+Qed.
+
+(** ** difference *)
+
+Lemma diff_list_ok l1 l2 acc :
+ INV l1 l2 acc -> sort X.lt (diff_list l1 l2 acc).
+Proof.
+ revert l2 acc.
+ induction l1 as [|x1 l1 IH1];
+  [intro l2|induction l2 as [|x2 l2 IH2]];
+    intros acc inv.
+ - eauto.
+ - unfold diff_list. eapply INV_rev; eauto.
+ - simpl. case X.compare_spec; intro C.
+   * apply IH1. eapply INV_drop, INV_sym, INV_drop, INV_sym; eauto.
+   * apply (IH2 acc). eapply INV_sym, INV_drop, INV_sym; eauto.
+   * apply IH1. eapply INV_sym, INV_lt; eauto. now apply INV_sym.
+Qed.
+
+Instance diff_inter_ok s1 s2 `(Ok s1, Ok s2) :
+ Ok (linear_diff s1 s2).
+Proof.
+ unfold linear_inter. now apply treeify_ok, diff_list_ok, INV_init.
+Qed.
+
+Instance fold_remove_ok s1 s2 `(Ok s2) :
+ Ok (fold remove s1 s2).
+Proof.
+ rewrite fold_spec, <- fold_left_rev_right.
+ unfold elt in *.
+ induction (rev (elements s1)); simpl; unfold flip in *; auto_tc.
+Qed.
+
+Instance diff_ok s1 s2 `(Ok s1, Ok s2) : Ok (diff s1 s2).
+Proof.
+ unfold diff. destruct compare_height; auto_tc.
+Qed.
+
+Lemma diff_list_spec x l1 l2 acc :
+ sort X.lt (rev l1) ->
+ sort X.lt (rev l2) ->
+ (InA X.eq x (diff_list l1 l2 acc) <->
+   (InA X.eq x l1 /\ ~InA X.eq x l2) \/ InA X.eq x acc).
+Proof.
+ revert l2 acc.
+ induction l1 as [|x1 l1 IH1].
+ - intros l2 acc; simpl. inA. tauto.
+ - induction l2 as [|x2 l2 IH2]; intros acc.
+   * intros; simpl. rewrite rev_append_rev. inA. tauto.
+   * simpl. intros U V.
+     destruct (sorted_app_inv _ _ U) as (U1 & U2 & U3); auto.
+     destruct (sorted_app_inv _ _ V) as (V1 & V2 & V3); auto.
+     case X.compare_spec; intro C.
+     + rewrite IH1; auto. f_equiv. inA. intuition; try order.
+       assert (X.lt x x1) by (apply U3; inA). order.
+     + rewrite (IH2 acc); auto. f_equiv. inA. intuition; try order.
+       assert (X.lt x x1) by (apply U3; inA). order.
+     + rewrite IH1; auto. inA. intuition; try order.
+       left; split; auto. destruct 1. order.
+       assert (X.lt x x2) by (apply V3; inA). order.
+Qed.
+
+Lemma linear_diff_spec s1 s2 x `(Ok s1, Ok s2) :
+ InT x (linear_diff s1 s2) <-> InT x s1 /\ ~InT x s2.
+Proof.
+ unfold linear_diff.
+ rewrite !rev_elements_rev, treeify_spec, diff_list_spec
+  by (rewrite rev_involutive; auto_tc).
+ rewrite !InA_rev, InA_nil, !elements_spec1 by auto_tc. tauto.
+Qed.
+
+Lemma fold_remove_spec s1 s2 x `(Ok s2) :
+  InT x (fold remove s1 s2) <-> InT x s2 /\ ~InT x s1.
+Proof.
+ rewrite fold_spec, <- fold_left_rev_right.
+ rewrite <- (elements_spec1 s1), <- InA_rev by auto_tc.
+ unfold elt in *.
+ induction (rev (elements s1)); simpl; intros.
+ - rewrite InA_nil. intuition.
+ - unfold flip in *. rewrite remove_spec, IHl, InA_cons. tauto.
+   clear IHl. induction l; simpl; auto_tc.
+Qed.
+
+Lemma diff_spec s1 s2 y `{Ok s1, Ok s2} :
+ InT y (diff s1 s2) <-> InT y s1 /\ ~InT y s2.
+Proof.
+ unfold diff. destruct compare_height.
+ - now apply linear_diff_spec.
+ - rewrite filter_spec, Bool.negb_true_iff,
+     <- Bool.not_true_iff_false, mem_spec;
+    intuition.
+    intros x1 x2 EQ. f_equal. now apply mem_proper.
+ - now apply fold_remove_spec.
+Qed.
+
+End MakeRaw.
+
+(** * Balancing properties
+
+    We now prove that all operations preserve a red-black invariant,
+    and that trees have hence a logarithmic depth.
+*)
+
+Module BalanceProps(X:Orders.OrderedType)(Import M : MakeRaw X).
+
+Local Notation Rd := (Node Red).
+Local Notation Bk := (Node Black).
+Import M.MX.
+
+(** ** Red-Black invariants *)
+
+(** In a red-black tree :
+    - a red node has no red children
+    - the black depth at each node is the same along all paths.
+    The black depth is here an argument of the predicate. *)
+
+Inductive rbt : nat -> tree -> Prop :=
+ | RB_Leaf : rbt 0 Leaf
+ | RB_Rd n l k r :
+   notred l -> notred r -> rbt n l -> rbt n r -> rbt n (Rd l k r)
+ | RB_Bk n l k r : rbt n l -> rbt n r -> rbt (S n) (Bk l k r).
+
+(** A red-red tree is almost a red-black tree, except that it has
+    a _red_ root node which _may_ have red children. Note that a
+    red-red tree is hence non-empty, and all its strict subtrees
+    are red-black. *)
+
+Inductive rrt (n:nat) : tree -> Prop :=
+ | RR_Rd l k r : rbt n l -> rbt n r -> rrt n (Rd l k r).
+
+(** An almost-red-black tree is almost a red-black tree, except that
+    it's permitted to have two red nodes in a row at the very root (only).
+    We implement this notion by saying that a quasi-red-black tree
+    is either a red-black tree or a red-red tree. *)
+
+Inductive arbt (n:nat)(t:tree) : Prop :=
+ | ARB_RB : rbt n t -> arbt n t
+ | ARB_RR : rrt n t -> arbt n t.
+
+(** The main exported invariant : being a red-black tree for some
+    black depth. *)
+
+Class Rbt (t:tree) :=  RBT : exists d, rbt d t.
+
+(** ** Basic tactics and results about red-black *)
+
+Scheme rbt_ind := Induction for rbt Sort Prop.
+Local Hint Constructors rbt rrt arbt.
+Local Hint Extern 0 (notred _) => (exact I).
+Ltac invrb := intros; invtree rrt; invtree rbt; try contradiction.
+Ltac desarb := match goal with H:arbt _ _ |- _ => destruct H end.
+Ltac nonzero n := destruct n as [|n]; [try split; invrb|].
+
+Lemma rr_nrr_rb n t :
+ rrt n t -> notredred t -> rbt n t.
+Proof.
+ destruct 1 as [l x r Hl Hr].
+ destruct l, r; descolor; invrb; auto.
+Qed.
+
+Local Hint Resolve rr_nrr_rb.
+
+Lemma arb_nrr_rb n t :
+ arbt n t -> notredred t -> rbt n t.
+Proof.
+ destruct 1; auto.
+Qed.
+
+Lemma arb_nr_rb n t :
+ arbt n t -> notred t -> rbt n t.
+Proof.
+ destruct 1; destruct t; descolor; invrb; auto.
+Qed.
+
+Local Hint Resolve arb_nrr_rb arb_nr_rb.
+
+(** ** A Red-Black tree has indeed a logarithmic depth *)
+
+Definition redcarac s := rcase (fun _ _ _ => 1) (fun _ => 0) s.
+
+Lemma rb_maxdepth s n : rbt n s -> maxdepth s <= 2*n + redcarac s.
+Proof.
+ induction 1.
+ - simpl; auto.
+ - replace (redcarac l) with 0 in * by now destree l.
+   replace (redcarac r) with 0 in * by now destree r.
+   simpl maxdepth. simpl redcarac.
+   rewrite Nat.add_succ_r, <- Nat.succ_le_mono.
+   now apply Nat.max_lub.
+ - simpl. rewrite <- Nat.succ_le_mono.
+   apply Nat.max_lub; eapply Nat.le_trans; eauto;
+   [destree l | destree r]; simpl;
+   rewrite !Nat.add_0_r, ?Nat.add_1_r; auto with arith.
+Qed.
+
+Lemma rb_mindepth s n : rbt n s -> n + redcarac s <= mindepth s.
+Proof.
+ induction 1; simpl.
+ - trivial.
+ - rewrite Nat.add_succ_r.
+   apply -> Nat.succ_le_mono.
+   replace (redcarac l) with 0 in * by now destree l.
+   replace (redcarac r) with 0 in * by now destree r.
+   now apply Nat.min_glb.
+ - apply -> Nat.succ_le_mono. rewrite Nat.add_0_r.
+   apply Nat.min_glb; eauto with arith.
+Qed.
+
+Lemma maxdepth_upperbound s : Rbt s ->
+ maxdepth s <= 2 * log2 (S (cardinal s)).
+Proof.
+ intros (n,H).
+ eapply Nat.le_trans; [eapply rb_maxdepth; eauto|].
+ transitivity (2*(n+redcarac s)).
+ - rewrite Nat.mul_add_distr_l. apply Nat.add_le_mono_l.
+   rewrite <- Nat.mul_1_l at 1. apply Nat.mul_le_mono_r.
+   auto with arith.
+ - apply Nat.mul_le_mono_l.
+   transitivity (mindepth s).
+   + now apply rb_mindepth.
+   + apply mindepth_log_cardinal.
+Qed.
+
+Lemma maxdepth_lowerbound s : s<>Leaf ->
+ log2 (cardinal s) < maxdepth s.
+Proof.
+ apply maxdepth_log_cardinal.
+Qed.
+
+
+(** ** Singleton *)
+
+Lemma singleton_rb x : Rbt (singleton x).
+Proof.
+ unfold singleton. exists 1; auto.
+Qed.
+
+(** ** [makeBlack] and [makeRed] *)
+
+Lemma makeBlack_rb n t : arbt n t -> Rbt (makeBlack t).
+Proof.
+ destruct t as [|[|] l x r].
+ - exists 0; auto.
+ - destruct 1; invrb; exists (S n); simpl; auto.
+ - exists n; auto.
+Qed.
+
+Lemma makeRed_rr t n :
+ rbt (S n) t -> notred t -> rrt n (makeRed t).
+Proof.
+ destruct t as [|[|] l x r]; invrb; simpl; auto.
+Qed.
+
+(** ** Balancing *)
+
+Lemma lbal_rb n l k r :
+ arbt n l -> rbt n r -> rbt (S n) (lbal l k r).
+Proof.
+case lbal_match; intros; desarb; invrb; auto.
+Qed.
+
+Lemma rbal_rb n l k r :
+ rbt n l -> arbt n r -> rbt (S n) (rbal l k r).
+Proof.
+case rbal_match; intros; desarb; invrb; auto.
+Qed.
+
+Lemma rbal'_rb n l k r :
+ rbt n l -> arbt n r -> rbt (S n) (rbal' l k r).
+Proof.
+case rbal'_match; intros; desarb; invrb; auto.
+Qed.
+
+Lemma lbalS_rb n l x r :
+ arbt n l -> rbt (S n) r -> notred r -> rbt (S n) (lbalS l x r).
+Proof.
+ intros Hl Hr Hr'.
+ destruct r as [|[|] rl rx rr]; invrb. clear Hr'.
+ revert Hl.
+ case lbalS_match.
+ - destruct 1; invrb; auto.
+ - intros. apply rbal'_rb; auto.
+Qed.
+
+Lemma lbalS_arb n l x r :
+ arbt n l -> rbt (S n) r -> arbt (S n) (lbalS l x r).
+Proof.
+ case lbalS_match.
+ - destruct 1; invrb; auto.
+ - clear l. intros l Hl Hl' Hr.
+   destruct r as [|[|] rl rx rr]; invrb.
+   * destruct rl as [|[|] rll rlx rlr]; invrb.
+     right; auto using rbal'_rb, makeRed_rr.
+   * left; apply rbal'_rb; auto.
+Qed.
+
+Lemma rbalS_rb n l x r :
+ rbt (S n) l -> notred l -> arbt n r -> rbt (S n) (rbalS l x r).
+Proof.
+ intros Hl Hl' Hr.
+ destruct l as [|[|] ll lx lr]; invrb. clear Hl'.
+ revert Hr.
+ case rbalS_match.
+ - destruct 1; invrb; auto.
+ - intros. apply lbal_rb; auto.
+Qed.
+
+Lemma rbalS_arb n l x r :
+ rbt (S n) l -> arbt n r -> arbt (S n) (rbalS l x r).
+Proof.
+ case rbalS_match.
+ - destruct 2; invrb; auto.
+ - clear r. intros r Hr Hr' Hl.
+   destruct l as [|[|] ll lx lr]; invrb.
+   * destruct lr as [|[|] lrl lrx lrr]; invrb.
+     right; auto using lbal_rb, makeRed_rr.
+   * left; apply lbal_rb; auto.
+Qed.
+
+
+(** ** Insertion *)
+
+(** The next lemmas combine simultaneous results about rbt and arbt.
+    A first solution here: statement with [if ... then ... else] *)
+
+Definition ifred s (A B:Prop) := rcase (fun _ _ _ => A) (fun _ => B) s.
+
+Lemma ifred_notred s A B : notred s -> (ifred s A B <-> B).
+Proof.
+ destruct s; descolor; simpl; intuition.
+Qed.
+
+Lemma ifred_or s A B : ifred s A B -> A\/B.
+Proof.
+ destruct s; descolor; simpl; intuition.
+Qed.
+
+Lemma ins_rr_rb x s n : rbt n s ->
+ ifred s (rrt n (ins x s)) (rbt n (ins x s)).
+Proof.
+induction 1 as [ | n l k r | n l k r Hl IHl Hr IHr ].
+- simpl; auto.
+- simpl. rewrite ifred_notred in * by trivial.
+  elim_compare x k; auto.
+- rewrite ifred_notred by trivial.
+  unfold ins; fold ins. (* simpl is too much here ... *)
+  elim_compare x k.
+  * auto.
+  * apply lbal_rb; trivial. apply ifred_or in IHl; intuition.
+  * apply rbal_rb; trivial. apply ifred_or in IHr; intuition.
+Qed.
+
+Lemma ins_arb x s n : rbt n s -> arbt n (ins x s).
+Proof.
+ intros H. apply (ins_rr_rb x), ifred_or in H. intuition.
+Qed.
+
+Instance add_rb x s : Rbt s -> Rbt (add x s).
+Proof.
+ intros (n,H). unfold add. now apply (makeBlack_rb n), ins_arb.
+Qed.
+
+(** ** Deletion *)
+
+(** A second approach here: statement with ... /\ ... *)
+
+Lemma append_arb_rb n l r : rbt n l -> rbt n r ->
+ (arbt n (append l r)) /\
+ (notred l -> notred r -> rbt n (append l r)).
+Proof.
+revert r n.
+append_tac l r.
+- split; auto.
+- split; auto.
+- (* Red / Red *)
+  intros n. invrb.
+  case (IHlr n); auto; clear IHlr.
+  case append_rr_match.
+  + intros a x b _ H; split; invrb.
+    assert (rbt n (Rd a x b)) by auto. invrb. auto.
+  + split; invrb; auto.
+- (* Red / Black *)
+  split; invrb. destruct (IHlr n) as (_,IH); auto.
+- (* Black / Red *)
+  split; invrb. destruct (IHrl n) as (_,IH); auto.
+- (* Black / Black *)
+  nonzero n.
+  invrb.
+  destruct (IHlr n) as (IH,_); auto; clear IHlr.
+  revert IH.
+  case append_bb_match.
+  + intros a x b IH; split; destruct IH; invrb; auto.
+  + split; [left | invrb]; auto using lbalS_rb.
+Qed.
+
+(** A third approach : Lemma ... with ... *)
+
+Lemma del_arb s x n : rbt (S n) s -> isblack s -> arbt n (del x s)
+with del_rb s x n : rbt n s -> notblack s -> rbt n (del x s).
+Proof.
+{ revert n.
+  induct s x; try destruct c; try contradiction; invrb.
+  - apply append_arb_rb; assumption.
+  - assert (IHl' := del_rb l x). clear IHr del_arb del_rb.
+    destruct l as [|[|] ll lx lr]; auto.
+    nonzero n. apply lbalS_arb; auto.
+  - assert (IHr' := del_rb r x). clear IHl del_arb del_rb.
+    destruct r as [|[|] rl rx rr]; auto.
+    nonzero n. apply rbalS_arb; auto. }
+{ revert n.
+  induct s x; try assumption; try destruct c; try contradiction; invrb.
+  - apply append_arb_rb; assumption.
+  - assert (IHl' := del_arb l x). clear IHr del_arb del_rb.
+    destruct l as [|[|] ll lx lr]; auto.
+    nonzero n. destruct n as [|n]; [invrb|]; apply lbalS_rb; auto.
+  - assert (IHr' := del_arb r x). clear IHl del_arb del_rb.
+    destruct r as [|[|] rl rx rr]; auto.
+    nonzero n. apply rbalS_rb; auto. }
+Qed.
+
+Instance remove_rb s x : Rbt s -> Rbt (remove x s).
+Proof.
+ intros (n,H). unfold remove.
+ destruct s as [|[|] l y r].
+ - apply (makeBlack_rb n). auto.
+ - apply (makeBlack_rb n). left. apply del_rb; simpl; auto.
+ - nonzero n. apply (makeBlack_rb n). apply del_arb; simpl; auto.
+Qed.
+
+(** ** Treeify *)
+
+Definition treeify_rb_invariant size depth (f:treeify_t) :=
+ forall acc,
+ size <= length acc ->
+  rbt depth (fst (f acc)) /\
+  size + length (snd (f acc)) = length acc.
+
+Lemma treeify_zero_rb : treeify_rb_invariant 0 0 treeify_zero.
+Proof.
+ intros acc _; simpl; auto.
+Qed.
+
+Lemma treeify_one_rb : treeify_rb_invariant 1 0 treeify_one.
+Proof.
+ intros [|x acc]; simpl; auto; inversion 1.
+Qed.
+
+Lemma treeify_cont_rb f g size1 size2 size d :
+ treeify_rb_invariant size1 d f ->
+ treeify_rb_invariant size2 d g ->
+ size = S (size1 + size2) ->
+ treeify_rb_invariant size (S d) (treeify_cont f g).
+Proof.
+ intros Hf Hg H acc Hacc.
+ unfold treeify_cont.
+ specialize (Hf acc).
+ destruct (f acc) as (l, acc1). simpl in *.
+ destruct Hf as (Hf1, Hf2). { subst. eauto with arith. }
+ destruct acc1 as [|x acc2]; simpl in *.
+ - exfalso. revert Hacc. apply Nat.lt_nge. rewrite H, <- Hf2.
+   auto with arith.
+ - specialize (Hg acc2).
+   destruct (g acc2) as (r, acc3). simpl in *.
+   destruct Hg as (Hg1, Hg2).
+   { revert Hacc.
+     rewrite H, <- Hf2, Nat.add_succ_r, <- Nat.succ_le_mono.
+     apply Nat.add_le_mono_l. }
+   split; auto.
+   now rewrite H, <- Hf2, <- Hg2, Nat.add_succ_r, Nat.add_assoc.
+Qed.
+
+Lemma treeify_aux_rb n :
+ exists d, forall (b:bool),
+  treeify_rb_invariant (ifpred b (Pos.to_nat n)) d (treeify_aux b n).
+Proof.
+ induction n as [n (d,IHn)|n (d,IHn)| ].
+ - exists (S d). intros b.
+   eapply treeify_cont_rb; [ apply (IHn false) | apply (IHn b) | ].
+   rewrite Pos2Nat.inj_xI.
+   assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H.
+   destruct b; simpl; intros; rewrite Nat.add_0_r; trivial.
+   now rewrite <- Nat.add_succ_r, Nat.succ_pred; trivial.
+ - exists (S d). intros b.
+   eapply treeify_cont_rb; [ apply (IHn b) | apply (IHn true) | ].
+   rewrite Pos2Nat.inj_xO.
+   assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H.
+   rewrite <- Nat.add_succ_r, Nat.succ_pred by trivial.
+   destruct b; simpl; intros; rewrite Nat.add_0_r; trivial.
+   symmetry. now apply Nat.add_pred_l.
+ - exists 0; destruct b;
+    [ apply treeify_zero_rb | apply treeify_one_rb ].
+Qed.
+
+(** The black depth of [treeify l] is actually a log2, but
+    we don't need to mention that. *)
+
+Instance treeify_rb l : Rbt (treeify l).
+Proof.
+ unfold treeify.
+ destruct (treeify_aux_rb (plength l)) as (d,H).
+ exists d.
+ apply H.
+ now rewrite plength_spec.
+Qed.
+
+(** ** Filtering *)
+
+Instance filter_rb f s : Rbt (filter f s).
+Proof.
+ unfold filter; auto_tc.
+Qed.
+
+Instance partition_rb1 f s : Rbt (fst (partition f s)).
+Proof.
+ unfold partition. destruct partition_aux. simpl. auto_tc.
+Qed.
+
+Instance partition_rb2 f s : Rbt (snd (partition f s)).
+Proof.
+ unfold partition. destruct partition_aux. simpl. auto_tc.
+Qed.
+
+(** ** Union, intersection, difference *)
+
+Instance fold_add_rb s1 s2 : Rbt s2 -> Rbt (fold add s1 s2).
+Proof.
+ intros. rewrite fold_spec, <- fold_left_rev_right. unfold elt in *.
+ induction (rev (elements s1)); simpl; unfold flip in *; auto_tc.
+Qed.
+
+Instance fold_remove_rb s1 s2 : Rbt s2 -> Rbt (fold remove s1 s2).
+Proof.
+ intros. rewrite fold_spec, <- fold_left_rev_right. unfold elt in *.
+ induction (rev (elements s1)); simpl; unfold flip in *; auto_tc.
+Qed.
+
+Lemma union_rb s1 s2 : Rbt s1 -> Rbt s2 -> Rbt (union s1 s2).
+Proof.
+ intros. unfold union, linear_union. destruct compare_height; auto_tc.
+Qed.
+
+Lemma inter_rb s1 s2 : Rbt s1 -> Rbt s2 -> Rbt (inter s1 s2).
+Proof.
+ intros. unfold inter, linear_inter. destruct compare_height; auto_tc.
+Qed.
+
+Lemma diff_rb s1 s2 : Rbt s1 -> Rbt s2 -> Rbt (diff s1 s2).
+Proof.
+ intros. unfold diff, linear_diff. destruct compare_height; auto_tc.
+Qed.
+
+End BalanceProps.
+
+(** * Final Encapsulation
+
+   Now, in order to really provide a functor implementing [S], we
+   need to encapsulate everything into a type of binary search trees.
+   They also happen to be well-balanced, but this has no influence
+   on the correctness of operations, so we won't state this here,
+   see [BalanceProps] if you need more than just the MSet interface.
+*)
+
+Module Type MSetInterface_S_Ext := MSetInterface.S <+ MSetRemoveMin.
+
+Module Make (X: Orders.OrderedType) <:
+ MSetInterface_S_Ext with Module E := X.
+ Module Raw. Include MakeRaw X. End Raw.
+ Include MSetInterface.Raw2Sets X Raw.
+
+ Definition opt_ok (x:option (elt * Raw.t)) :=
+  match x with Some (_,s) => Raw.Ok s | None => True end.
+
+ Definition mk_opt_t (x: option (elt * Raw.t))(P: opt_ok x) :
+   option (elt * t) :=
+ match x as o return opt_ok o -> option (elt * t) with
+ | Some (k,s') => fun P : Raw.Ok s' => Some (k, Mkt s')
+ | None => fun _ => None
+ end P.
+
+ Definition remove_min s : option (elt * t) :=
+  mk_opt_t (Raw.remove_min (this s)) (Raw.remove_min_ok s).
+
+ Lemma remove_min_spec1 s x s' :
+  remove_min s = Some (x,s') ->
+   min_elt s = Some x /\ Equal (remove x s) s'.
+ Proof.
+ destruct s as (s,Hs).
+ unfold remove_min, mk_opt_t, min_elt, remove, Equal, In; simpl.
+ generalize (fun x s' => @Raw.remove_min_spec1 s x s' Hs).
+ set (P := Raw.remove_min_ok s). clearbody P.
+ destruct (Raw.remove_min s) as [(x0,s0)|]; try easy.
+ intros H U. injection U. clear U; intros; subst. simpl.
+ destruct (H x s0); auto. subst; intuition.
+ Qed.
+
+ Lemma remove_min_spec2 s : remove_min s = None -> Empty s.
+ Proof.
+ destruct s as (s,Hs).
+ unfold remove_min, mk_opt_t, Empty, In; simpl.
+ generalize (Raw.remove_min_spec2 s).
+ set (P := Raw.remove_min_ok s). clearbody P.
+ destruct (Raw.remove_min s) as [(x0,s0)|]; now intuition.
+ Qed.
+
+End Make.
diff --git a/theories/MSets/MSetToFiniteSet.v b/theories/MSets/MSetToFiniteSet.v
index f0b964cf..e8087bc5 100644
--- a/theories/MSets/MSetToFiniteSet.v
+++ b/theories/MSets/MSetToFiniteSet.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 (** * Finite sets library : conversion to old [Finite_sets] *)
 
 Require Import Ensembles Finite_sets.
diff --git a/theories/MSets/MSetWeakList.v b/theories/MSets/MSetWeakList.v
index 945cb2dd..fd4114cd 100644
--- a/theories/MSets/MSetWeakList.v
+++ b/theories/MSets/MSetWeakList.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 (** * Finite sets library *)
 
 (** This file proposes an implementation of the non-dependant
@@ -398,7 +396,7 @@ Module MakeRaw (X:DecidableType) <: WRawSets X.
   induction s; simpl.
   intuition; inv.
   intros.
-  destruct (f a) as [ ]_eqn:E; rewrite ?InA_cons, IHs; intuition.
+  destruct (f a) eqn:E; rewrite ?InA_cons, IHs; intuition.
   setoid_replace x with a; auto.
   setoid_replace a with x in E; auto. congruence.
   Qed.
@@ -422,7 +420,7 @@ Module MakeRaw (X:DecidableType) <: WRawSets X.
   unfold For_all; induction s; simpl.
   intuition. inv.
   intros; inv.
-  destruct (f a) as [ ]_eqn:F.
+  destruct (f a) eqn:F.
   rewrite IHs; intuition. inv; auto.
   setoid_replace x with a; auto.
   split; intros H'; try discriminate.
@@ -438,7 +436,7 @@ Module MakeRaw (X:DecidableType) <: WRawSets X.
   unfold Exists; induction s; simpl.
   split; [discriminate| intros (x & Hx & _); inv].
   intros.
-  destruct (f a) as [ ]_eqn:F.
+  destruct (f a) eqn:F.
   split; auto.
   exists a; auto.
   rewrite IHs; firstorder.
@@ -517,7 +515,7 @@ Module MakeRaw (X:DecidableType) <: WRawSets X.
 
   Definition In := InA X.eq.
   Definition eq := Equal.
-  Instance eq_equiv : Equivalence eq.
+  Instance eq_equiv : Equivalence eq := _.
 
 End MakeRaw.
 
diff --git a/theories/MSets/MSets.v b/theories/MSets/MSets.v
index 958e9861..f179bcd1 100644
--- a/theories/MSets/MSets.v
+++ b/theories/MSets/MSets.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id$ *)
-
 Require Export Orders.
 Require Export OrdersEx.
 Require Export OrdersAlt.
diff --git a/theories/MSets/vo.itarget b/theories/MSets/vo.itarget
index 14429b81..7c5b6899 100644
--- a/theories/MSets/vo.itarget
+++ b/theories/MSets/vo.itarget
@@ -1,4 +1,6 @@
+MSetGenTree.vo
 MSetAVL.vo
+MSetRBT.vo
 MSetDecide.vo
 MSetEqProperties.vo
 MSetFacts.vo
diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v
index 8695acca..5b1e83e6 100644
--- a/theories/NArith/BinNat.v
+++ b/theories/NArith/BinNat.v
@@ -1,500 +1,1123 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: BinNat.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import BinPos.
-Unset Boxed Definitions.
+Require Export BinNums.
+Require Import BinPos RelationClasses Morphisms Setoid
+ Equalities OrdersFacts GenericMinMax Bool NAxioms NProperties.
+Require BinNatDef.
 
 (**********************************************************************)
-(** Binary natural numbers *)
+(** * Binary natural numbers, operations and properties *)
+(**********************************************************************)
 
-Inductive N : Set :=
-  | N0 : N
-  | Npos : positive -> N.
+(** The type [N] and its constructors [N0] and [Npos] are now
+    defined in [BinNums.v] *)
 
-(** Declare binding key for scope positive_scope *)
+(** Every definitions and properties about binary natural numbers
+    are placed in a module [N] for qualification purpose. *)
 
-Delimit Scope N_scope with N.
+Local Open Scope N_scope.
 
-(** Automatically open scope positive_scope for the constructors of N *)
+(** Every definitions and early properties about positive numbers
+    are placed in a module [N] for qualification purpose. *)
 
-Bind Scope N_scope with N.
-Arguments Scope Npos [positive_scope].
+Module N
+ <: NAxiomsSig
+ <: UsualOrderedTypeFull
+ <: UsualDecidableTypeFull
+ <: TotalOrder.
 
-Open Local Scope N_scope.
+(** Definitions of operations, now in a separate file *)
 
-Definition Ndiscr : forall n:N, { p:positive | n = Npos p } + { n = N0 }.
-Proof.
- destruct n; auto.
- left; exists p; auto.
-Defined.
+Include BinNatDef.N.
 
-(** Operation x -> 2*x+1 *)
+(** When including property functors, only inline t eq zero one two *)
 
-Definition Ndouble_plus_one x :=
-  match x with
-  | N0 => Npos 1
-  | Npos p => Npos (xI p)
-  end.
+Set Inline Level 30.
 
-(** Operation x -> 2*x *)
+(** Logical predicates *)
 
-Definition Ndouble n :=
-  match n with
-  | N0 => N0
-  | Npos p => Npos (xO p)
-  end.
+Definition eq := @Logic.eq N.
+Definition eq_equiv := @eq_equivalence N.
 
-(** Successor *)
+Definition lt x y := (x ?= y) = Lt.
+Definition gt x y := (x ?= y) = Gt.
+Definition le x y := (x ?= y) <> Gt.
+Definition ge x y := (x ?= y) <> Lt.
 
-Definition Nsucc n :=
-  match n with
-  | N0 => Npos 1
-  | Npos p => Npos (Psucc p)
-  end.
+Infix "<=" := le : N_scope.
+Infix "<" := lt : N_scope.
+Infix ">=" := ge : N_scope.
+Infix ">" := gt : N_scope.
 
-(** Predecessor *)
+Notation "x <= y <= z" := (x <= y /\ y <= z) : N_scope.
+Notation "x <= y < z" := (x <= y /\ y < z) : N_scope.
+Notation "x < y < z" := (x < y /\ y < z) : N_scope.
+Notation "x < y <= z" := (x < y /\ y <= z) : N_scope.
 
-Definition Npred (n : N) := match n with
-| N0 => N0
-| Npos p => match p with
-  | xH => N0
-  | _ => Npos (Ppred p)
-  end
-end.
+Definition divide p q := exists r, q = r*p.
+Notation "( p | q )" := (divide p q) (at level 0) : N_scope.
 
-(** Addition *)
+Definition Even n := exists m, n = 2*m.
+Definition Odd n := exists m, n = 2*m+1.
 
-Definition Nplus n m :=
-  match n, m with
-  | N0, _ => m
-  | _, N0 => n
-  | Npos p, Npos q => Npos (p + q)
-  end.
+(** Decidability of equality. *)
 
-Infix "+" := Nplus : N_scope.
+Definition eq_dec : forall n m : N, { n = m } + { n <> m }.
+Proof.
+ decide equality.
+ apply Pos.eq_dec.
+Defined.
 
-(** Subtraction *)
+(** Discrimination principle *)
 
-Definition Nminus (n m : N) :=
-match n, m with
-| N0, _ => N0
-| n, N0 => n
-| Npos n', Npos m' =>
-  match Pminus_mask n' m' with
-  | IsPos p => Npos p
-  | _ => N0
-  end
-end.
+Definition discr n : { p:positive | n = pos p } + { n = 0 }.
+Proof.
+ destruct n; auto.
+ left; exists p; auto.
+Defined.
 
-Infix "-" := Nminus : N_scope.
+(** Convenient induction principles *)
+
+Definition binary_rect (P:N -> Type) (f0 : P 0)
+  (f2 : forall n, P n -> P (double n))
+  (fS2 : forall n, P n -> P (succ_double n)) (n : N) : P n :=
+ let P' p := P (pos p) in
+ let f2' p := f2 (pos p) in
+ let fS2' p := fS2 (pos p) in
+ match n with
+ | 0 => f0
+ | pos p => positive_rect P' fS2' f2' (fS2 0 f0) p
+ end.
 
-(** Multiplication *)
+Definition binary_rec (P:N -> Set) := binary_rect P.
+Definition binary_ind (P:N -> Prop) := binary_rect P.
 
-Definition Nmult n m :=
-  match n, m with
-  | N0, _ => N0
-  | _, N0 => N0
-  | Npos p, Npos q => Npos (p * q)
-  end.
+(** Peano induction on binary natural numbers *)
 
-Infix "*" := Nmult : N_scope.
+Definition peano_rect
+  (P : N -> Type) (f0 : P 0)
+    (f : forall n : N, P n -> P (succ n)) (n : N) : P n :=
+let P' p := P (pos p) in
+let f' p := f (pos p) in
+match n with
+| 0 => f0
+| pos p => Pos.peano_rect P' (f 0 f0) f' p
+end.
 
-(** Boolean Equality *)
+Theorem peano_rect_base P a f : peano_rect P a f 0 = a.
+Proof.
+reflexivity.
+Qed.
 
-Definition Neqb n m :=
- match n, m with
-  | N0, N0 => true
-  | Npos n, Npos m => Peqb n m
-  | _,_ => false
- end.
+Theorem peano_rect_succ P a f n :
+ peano_rect P a f (succ n) = f n (peano_rect P a f n).
+Proof.
+destruct n; simpl.
+trivial.
+now rewrite Pos.peano_rect_succ.
+Qed.
 
-(** Order *)
+Definition peano_ind (P : N -> Prop) := peano_rect P.
 
-Definition Ncompare n m :=
-  match n, m with
-  | N0, N0 => Eq
-  | N0, Npos m' => Lt
-  | Npos n', N0 => Gt
-  | Npos n', Npos m' => (n' ?= m')%positive Eq
-  end.
+Definition peano_rec (P : N -> Set) := peano_rect P.
 
-Infix "?=" := Ncompare (at level 70, no associativity) : N_scope.
+Theorem peano_rec_base P a f : peano_rec P a f 0 = a.
+Proof.
+apply peano_rect_base.
+Qed.
 
-Definition Nlt (x y:N) := (x ?= y) = Lt.
-Definition Ngt (x y:N) := (x ?= y) = Gt.
-Definition Nle (x y:N) := (x ?= y) <> Gt.
-Definition Nge (x y:N) := (x ?= y) <> Lt.
+Theorem peano_rec_succ P a f n :
+ peano_rec P a f (succ n) = f n (peano_rec P a f n).
+Proof.
+apply peano_rect_succ.
+Qed.
 
-Infix "<=" := Nle : N_scope.
-Infix "<" := Nlt : N_scope.
-Infix ">=" := Nge : N_scope.
-Infix ">" := Ngt : N_scope.
+(** Properties of mixed successor and predecessor. *)
 
-(** Min and max *)
+Lemma pos_pred_spec p : Pos.pred_N p = pred (pos p).
+Proof.
+ now destruct p.
+Qed.
 
-Definition Nmin (n n' : N) := match Ncompare n n' with
- | Lt | Eq => n
- | Gt => n'
- end.
+Lemma succ_pos_spec n : pos (succ_pos n) = succ n.
+Proof.
+ now destruct n.
+Qed.
 
-Definition Nmax (n n' : N) := match Ncompare n n' with
- | Lt | Eq => n'
- | Gt => n
- end.
+Lemma pos_pred_succ n : Pos.pred_N (succ_pos n) = n.
+Proof.
+ destruct n. trivial. apply Pos.pred_N_succ.
+Qed.
 
-(** Decidability of equality. *)
+Lemma succ_pos_pred p : succ (Pos.pred_N p) = pos p.
+Proof.
+ destruct p; simpl; trivial. f_equal. apply Pos.succ_pred_double.
+Qed.
+
+(** Properties of successor and predecessor *)
 
-Definition N_eq_dec : forall n m : N, { n = m } + { n <> m }.
+Theorem pred_succ n : pred (succ n) = n.
 Proof.
- decide equality.
- apply positive_eq_dec.
-Defined.
+destruct n; trivial. simpl. apply Pos.pred_N_succ.
+Qed.
 
-(** convenient induction principles *)
+Theorem pred_sub n : pred n = sub n 1.
+Proof.
+ now destruct n as [|[p|p|]].
+Qed.
 
-Lemma N_ind_double :
- forall (a:N) (P:N -> Prop),
-   P N0 ->
-   (forall a, P a -> P (Ndouble a)) ->
-   (forall a, P a -> P (Ndouble_plus_one a)) -> P a.
+Theorem succ_0_discr n : succ n <> 0.
 Proof.
-  intros; elim a. trivial.
-  simple induction p. intros.
-  apply (H1 (Npos p0)); trivial.
-  intros; apply (H0 (Npos p0)); trivial.
-  intros; apply (H1 N0); assumption.
+now destruct n.
 Qed.
 
-Lemma N_rec_double :
- forall (a:N) (P:N -> Set),
-   P N0 ->
-   (forall a, P a -> P (Ndouble a)) ->
-   (forall a, P a -> P (Ndouble_plus_one a)) -> P a.
+(** Specification of addition *)
+
+Theorem add_0_l n : 0 + n = n.
 Proof.
-  intros; elim a. trivial.
-  simple induction p. intros.
-  apply (H1 (Npos p0)); trivial.
-  intros; apply (H0 (Npos p0)); trivial.
-  intros; apply (H1 N0); assumption.
+reflexivity.
 Qed.
 
-(** Peano induction on binary natural numbers *)
+Theorem add_succ_l n m : succ n + m = succ (n + m).
+Proof.
+destruct n, m; unfold succ, add; now rewrite ?Pos.add_1_l, ?Pos.add_succ_l.
+Qed.
 
-Definition Nrect
-  (P : N -> Type) (a : P N0)
-    (f : forall n : N, P n -> P (Nsucc n)) (n : N) : P n :=
-let f' (p : positive) (x : P (Npos p)) := f (Npos p) x in
-let P' (p : positive) := P (Npos p) in
-match n return (P n) with
-| N0 => a
-| Npos p => Prect P' (f N0 a) f' p
-end.
+(** Specification of subtraction. *)
+
+Theorem sub_0_r n : n - 0 = n.
+Proof.
+now destruct n.
+Qed.
 
-Theorem Nrect_base : forall P a f, Nrect P a f N0 = a.
+Theorem sub_succ_r n m : n - succ m = pred (n - m).
 Proof.
-intros P a f; simpl; reflexivity.
+destruct n as [|p], m as [|q]; trivial.
+now destruct p.
+simpl. rewrite Pos.sub_mask_succ_r, Pos.sub_mask_carry_spec.
+now destruct (Pos.sub_mask p q) as [|[r|r|]|].
 Qed.
 
-Theorem Nrect_step : forall P a f n, Nrect P a f (Nsucc n) = f n (Nrect P a f n).
+(** Specification of multiplication *)
+
+Theorem mul_0_l n : 0 * n = 0.
 Proof.
-intros P a f; destruct n as [| p]; simpl;
-[rewrite Prect_base | rewrite Prect_succ]; reflexivity.
+reflexivity.
 Qed.
 
-Definition Nind (P : N -> Prop) := Nrect P.
+Theorem mul_succ_l n m : (succ n) * m = n * m + m.
+Proof.
+destruct n, m; simpl; trivial. f_equal. rewrite Pos.add_comm.
+apply Pos.mul_succ_l.
+Qed.
 
-Definition Nrec (P : N -> Set) := Nrect P.
+(** Specification of boolean comparisons. *)
 
-Theorem Nrec_base : forall P a f, Nrec P a f N0 = a.
+Lemma eqb_eq n m : eqb n m = true <-> n=m.
 Proof.
-intros P a f; unfold Nrec; apply Nrect_base.
+destruct n as [|n], m as [|m]; simpl; try easy'.
+rewrite Pos.eqb_eq. split; intro H. now subst. now destr_eq H.
 Qed.
 
-Theorem Nrec_step : forall P a f n, Nrec P a f (Nsucc n) = f n (Nrec P a f n).
+Lemma ltb_lt n m : (n <? m) = true <-> n < m.
 Proof.
-intros P a f; unfold Nrec; apply Nrect_step.
+  unfold ltb, lt. destruct compare; easy'.
 Qed.
 
-(** Properties of successor and predecessor *)
+Lemma leb_le n m : (n <=? m) = true <-> n <= m.
+Proof.
+  unfold leb, le. destruct compare; easy'.
+Qed.
 
-Theorem Npred_succ : forall n : N, Npred (Nsucc n) = n.
+(** Basic properties of comparison *)
+
+Theorem compare_eq_iff n m : (n ?= m) = Eq <-> n = m.
 Proof.
-destruct n as [| p]; simpl. reflexivity.
-case_eq (Psucc p); try (intros q H; rewrite <- H; now rewrite Ppred_succ).
-intro H; false_hyp H Psucc_not_one.
+destruct n, m; simpl; rewrite ?Pos.compare_eq_iff; split; congruence.
 Qed.
 
-(** Properties of addition *)
+Theorem compare_lt_iff n m : (n ?= m) = Lt <-> n < m.
+Proof.
+reflexivity.
+Qed.
 
-Theorem Nplus_0_l : forall n:N, N0 + n = n.
+Theorem compare_le_iff n m : (n ?= m) <> Gt <-> n <= m.
 Proof.
 reflexivity.
 Qed.
 
-Theorem Nplus_0_r : forall n:N, n + N0 = n.
+Theorem compare_antisym n m : (m ?= n) = CompOpp (n ?= m).
 Proof.
-destruct n; reflexivity.
+destruct n, m; simpl; trivial. apply Pos.compare_antisym.
 Qed.
 
-Theorem Nplus_comm : forall n m:N, n + m = m + n.
+(** Some more advanced properties of comparison and orders,
+    including [compare_spec] and [lt_irrefl] and [lt_eq_cases]. *)
+
+Include BoolOrderFacts.
+
+(** We regroup here some results used for proving the correctness
+    of more advanced functions. These results will also be provided
+    by the generic functor of properties about natural numbers
+    instantiated at the end of the file. *)
+
+Module Import Private_BootStrap.
+
+Theorem add_0_r n : n + 0 = n.
 Proof.
-intros.
-destruct n; destruct m; simpl in |- *; try reflexivity.
-rewrite Pplus_comm; reflexivity.
+now destruct n.
 Qed.
 
-Theorem Nplus_assoc : forall n m p:N, n + (m + p) = n + m + p.
+Theorem add_comm n m : n + m = m + n.
+Proof.
+destruct n, m; simpl; try reflexivity. simpl. f_equal. apply Pos.add_comm.
+Qed.
+
+Theorem add_assoc n m p : n + (m + p) = n + m + p.
 Proof.
-intros.
 destruct n; try reflexivity.
 destruct m; try reflexivity.
 destruct p; try reflexivity.
-simpl in |- *; rewrite Pplus_assoc; reflexivity.
+simpl. f_equal. apply Pos.add_assoc.
+Qed.
+
+Lemma sub_add n m : n <= m -> m - n + n = m.
+Proof.
+ destruct n as [|p], m as [|q]; simpl; try easy'. intros H.
+ case Pos.sub_mask_spec; intros; simpl; subst; trivial.
+ now rewrite Pos.add_comm.
+ apply Pos.le_nlt in H. elim H. apply Pos.lt_add_r.
+Qed.
+
+Theorem mul_comm n m : n * m = m * n.
+Proof.
+destruct n, m; simpl; trivial. f_equal. apply Pos.mul_comm.
+Qed.
+
+Lemma le_0_l n : 0<=n.
+Proof.
+now destruct n.
+Qed.
+
+Lemma leb_spec n m : BoolSpec (n<=m) (m<n) (n <=? m).
+Proof.
+ unfold le, lt, leb. rewrite (compare_antisym n m).
+ case compare; now constructor.
+Qed.
+
+Lemma add_lt_cancel_l n m p : p+n < p+m -> n<m.
+Proof.
+ intro H. destruct p. simpl; auto.
+ destruct n; destruct m.
+ elim (Pos.lt_irrefl _ H).
+ red; auto.
+ rewrite add_0_r in H. simpl in H.
+ red in H. simpl in H.
+ elim (Pos.lt_not_add_l _ _ H).
+ now apply (Pos.add_lt_mono_l p).
+Qed.
+
+End Private_BootStrap.
+
+(** Specification of lt and le. *)
+
+Lemma lt_succ_r n m : n < succ m <-> n<=m.
+Proof.
+destruct n as [|p], m as [|q]; simpl; try easy'.
+split. now destruct p. now destruct 1.
+apply Pos.lt_succ_r.
 Qed.
 
-Theorem Nplus_succ : forall n m:N, Nsucc n + m = Nsucc (n + m).
+(** Properties of [double] and [succ_double] *)
+
+Lemma double_spec n : double n = 2 * n.
 Proof.
-destruct n; destruct m.
-  simpl in |- *; reflexivity.
-  unfold Nsucc, Nplus in |- *; rewrite <- Pplus_one_succ_l; reflexivity.
-  simpl in |- *; reflexivity.
-  simpl in |- *; rewrite Pplus_succ_permute_l; reflexivity.
+ reflexivity.
 Qed.
 
-Theorem Nsucc_0 : forall n : N, Nsucc n <> N0.
+Lemma succ_double_spec n : succ_double n = 2 * n + 1.
 Proof.
-intro n; elim n; simpl Nsucc; intros; discriminate.
+ now destruct n.
 Qed.
 
-Theorem Nsucc_inj : forall n m:N, Nsucc n = Nsucc m -> n = m.
+Lemma double_add n m : double (n+m) = double n + double m.
 Proof.
-destruct n; destruct m; simpl in |- *; intro H; reflexivity || injection H;
- clear H; intro H.
-  symmetry  in H; contradiction Psucc_not_one with p.
-  contradiction Psucc_not_one with p.
-  rewrite Psucc_inj with (1 := H); reflexivity.
+ now destruct n, m.
 Qed.
 
-Theorem Nplus_reg_l : forall n m p:N, n + m = n + p -> m = p.
+Lemma succ_double_add n m : succ_double (n+m) = double n + succ_double m.
 Proof.
-intro n; pattern n in |- *; apply Nind; clear n; simpl in |- *.
-  trivial.
-  intros n IHn m p H0; do 2 rewrite Nplus_succ in H0.
-  apply IHn; apply Nsucc_inj; assumption.
+ now destruct n, m.
 Qed.
 
-(** Properties of subtraction. *)
+Lemma double_mul n m : double (n*m) = double n * m.
+Proof.
+ now destruct n, m.
+Qed.
 
-Lemma Nminus_N0_Nle : forall n n' : N, n - n' = N0 <-> n <= n'.
+Lemma succ_double_mul n m :
+ succ_double n * m = double n * m + m.
 Proof.
-destruct n as [| p]; destruct n' as [| q]; unfold Nle; simpl;
-split; intro H; try discriminate; try reflexivity.
-now elim H.
-intro H1; apply Pminus_mask_Gt in H1. destruct H1 as [h [H1 _]].
-rewrite H1 in H; discriminate.
-case_eq (Pcompare p q Eq); intro H1; rewrite H1 in H; try now elim H.
-assert (H2 : p = q); [now apply Pcompare_Eq_eq |]. now rewrite H2, Pminus_mask_diag.
-now rewrite Pminus_mask_Lt.
+ destruct n; simpl; destruct m; trivial.
+ now rewrite Pos.add_comm.
 Qed.
 
-Theorem Nminus_0_r : forall n : N, n - N0 = n.
+Lemma div2_double n : div2 (double n) = n.
 Proof.
 now destruct n.
 Qed.
 
-Theorem Nminus_succ_r : forall n m : N, n - (Nsucc m) = Npred (n - m).
+Lemma div2_succ_double n : div2 (succ_double n) = n.
 Proof.
-destruct n as [| p]; destruct m as [| q]; try reflexivity.
-now destruct p.
-simpl. rewrite Pminus_mask_succ_r, Pminus_mask_carry_spec.
-now destruct (Pminus_mask p q) as [| r |]; [| destruct r |].
+now destruct n.
 Qed.
 
-(** Properties of multiplication *)
+Lemma double_inj n m : double n = double m -> n = m.
+Proof.
+intro H. rewrite <- (div2_double n), H. apply div2_double.
+Qed.
 
-Theorem Nmult_0_l : forall n:N, N0 * n = N0.
+Lemma succ_double_inj n m : succ_double n = succ_double m -> n = m.
 Proof.
-reflexivity.
+intro H. rewrite <- (div2_succ_double n), H. apply div2_succ_double.
 Qed.
 
-Theorem Nmult_1_l : forall n:N, Npos 1 * n = n.
+Lemma succ_double_lt n m : n<m -> succ_double n < double m.
 Proof.
-destruct n; reflexivity.
+ destruct n as [|n], m as [|m]; intros H; try easy.
+ unfold lt in *; simpl in *. now rewrite Pos.compare_xI_xO, H.
 Qed.
 
-Theorem Nmult_Sn_m : forall n m : N, (Nsucc n) * m = m + n * m.
+
+(** Specification of minimum and maximum *)
+
+Theorem min_l n m : n <= m -> min n m = n.
 Proof.
-destruct n as [| n]; destruct m as [| m]; simpl; auto.
-rewrite Pmult_Sn_m; reflexivity.
+unfold min, le. case compare; trivial. now destruct 1.
 Qed.
 
-Theorem Nmult_1_r : forall n:N, n * Npos 1%positive = n.
+Theorem min_r n m : m <= n -> min n m = m.
 Proof.
-destruct n; simpl in |- *; try reflexivity.
-rewrite Pmult_1_r; reflexivity.
+unfold min, le. rewrite compare_antisym.
+case compare_spec; trivial. now destruct 2.
 Qed.
 
-Theorem Nmult_comm : forall n m:N, n * m = m * n.
+Theorem max_l n m : m <= n -> max n m = n.
 Proof.
-intros.
-destruct n; destruct m; simpl in |- *; try reflexivity.
-rewrite Pmult_comm; reflexivity.
+unfold max, le. rewrite compare_antisym.
+case compare_spec; auto. now destruct 2.
 Qed.
 
-Theorem Nmult_assoc : forall n m p:N, n * (m * p) = n * m * p.
+Theorem max_r n m : n <= m -> max n m = m.
 Proof.
-intros.
-destruct n; try reflexivity.
-destruct m; try reflexivity.
-destruct p; try reflexivity.
-simpl in |- *; rewrite Pmult_assoc; reflexivity.
+unfold max, le. case compare; trivial. now destruct 1.
 Qed.
 
-Theorem Nmult_plus_distr_r : forall n m p:N, (n + m) * p = n * p + m * p.
+(** 0 is the least natural number *)
+
+Theorem compare_0_r n : (n ?= 0) <> Lt.
 Proof.
-intros.
-destruct n; try reflexivity.
-destruct m; destruct p; try reflexivity.
-simpl in |- *; rewrite Pmult_plus_distr_r; reflexivity.
+now destruct n.
 Qed.
 
-Theorem Nmult_reg_r : forall n m p:N, p <> N0 -> n * p = m * p -> n = m.
+(** Specifications of power *)
+
+Lemma pow_0_r n : n ^ 0 = 1.
+Proof. reflexivity. Qed.
+
+Lemma pow_succ_r n p : 0<=p -> n^(succ p) = n * n^p.
+Proof.
+ intros _.
+ destruct n, p; simpl; trivial; f_equal. apply Pos.pow_succ_r.
+Qed.
+
+Lemma pow_neg_r n p : p<0 -> n^p = 0.
 Proof.
-destruct p; intros Hp H.
-contradiction Hp; reflexivity.
-destruct n; destruct m; reflexivity || (try discriminate H).
-injection H; clear H; intro H; rewrite Pmult_reg_r with (1 := H); reflexivity.
+ now destruct p.
 Qed.
 
-(** Properties of boolean order. *)
+(** Specification of square *)
 
-Lemma Neqb_eq : forall n m, Neqb n m = true <-> n=m.
+Lemma square_spec n : square n = n * n.
 Proof.
-destruct n as [|n], m as [|m]; simpl; split; auto; try discriminate.
-intros; f_equal. apply (Peqb_eq n m); auto.
-intros. apply (Peqb_eq n m). congruence.
+ destruct n; trivial. simpl. f_equal. apply Pos.square_spec.
 Qed.
 
-(** Properties of comparison *)
+(** Specification of Base-2 logarithm *)
 
-Lemma Ncompare_refl : forall n, (n ?= n) = Eq.
+Lemma size_log2 n : n<>0 -> size n = succ (log2 n).
 Proof.
-destruct n; simpl; auto.
-apply Pcompare_refl.
+ destruct n as [|[n|n| ]]; trivial. now destruct 1.
 Qed.
 
-Theorem Ncompare_Eq_eq : forall n m:N, (n ?= m) = Eq -> n = m.
+Lemma size_gt n : n < 2^(size n).
 Proof.
-destruct n as [| n]; destruct m as [| m]; simpl in |- *; intro H;
- reflexivity || (try discriminate H).
-  rewrite (Pcompare_Eq_eq n m H); reflexivity.
+ destruct n. reflexivity. simpl. apply Pos.size_gt.
 Qed.
 
-Theorem Ncompare_eq_correct : forall n m:N, (n ?= m) = Eq <-> n = m.
+Lemma size_le n : 2^(size n) <= succ_double n.
 Proof.
-split; intros;
- [ apply Ncompare_Eq_eq; auto | subst; apply Ncompare_refl ].
+ destruct n. discriminate. simpl.
+ change (2^Pos.size p <= Pos.succ (p~0))%positive.
+ apply Pos.lt_le_incl, Pos.lt_succ_r, Pos.size_le.
 Qed.
 
-Lemma Ncompare_antisym : forall n m, CompOpp (n ?= m) = (m ?= n).
+Lemma log2_spec n : 0 < n ->
+ 2^(log2 n) <= n < 2^(succ (log2 n)).
 Proof.
-destruct n; destruct m; simpl; auto.
-exact (Pcompare_antisym p p0 Eq).
+ destruct n as [|[p|p|]]; discriminate || intros _; simpl; split.
+ apply (size_le (pos p)).
+ apply Pos.size_gt.
+ apply Pos.size_le.
+ apply Pos.size_gt.
+ discriminate.
+ reflexivity.
 Qed.
 
-Lemma Ngt_Nlt : forall n m, n > m -> m < n.
+Lemma log2_nonpos n : n<=0 -> log2 n = 0.
 Proof.
-unfold Ngt, Nlt; intros n m GT.
-rewrite <- Ncompare_antisym, GT; reflexivity.
+ destruct n; intros Hn. reflexivity. now destruct Hn.
 Qed.
 
-Theorem Nlt_irrefl : forall n : N, ~ n < n.
+(** Specification of parity functions *)
+
+Lemma even_spec n : even n = true <-> Even n.
 Proof.
-intro n; unfold Nlt; now rewrite Ncompare_refl.
+ destruct n.
+ split. now exists 0.
+ trivial.
+ destruct p; simpl; split; try easy.
+ intros (m,H). now destruct m.
+ now exists (pos p).
+ intros (m,H). now destruct m.
 Qed.
 
-Theorem Nlt_trans : forall n m q, n < m -> m < q -> n < q.
+Lemma odd_spec n : odd n = true <-> Odd n.
 Proof.
-destruct n;
- destruct m; try discriminate;
- destruct q; try discriminate; auto.
-eapply Plt_trans; eauto.
+ destruct n.
+ split. discriminate.
+ intros (m,H). now destruct m.
+ destruct p; simpl; split; try easy.
+ now exists (pos p).
+ intros (m,H). now destruct m.
+ now exists 0.
 Qed.
 
-Theorem Nlt_not_eq : forall n m, n < m -> ~ n = m.
+(** Specification of the euclidean division *)
+
+Theorem pos_div_eucl_spec (a:positive)(b:N) :
+  let (q,r) := pos_div_eucl a b in pos a = q * b + r.
 Proof.
- intros n m LT EQ. subst m. elim (Nlt_irrefl n); auto.
+  induction a; cbv beta iota delta [pos_div_eucl]; fold pos_div_eucl; cbv zeta.
+  (* a~1 *)
+  destruct pos_div_eucl as (q,r).
+  change (pos a~1) with (succ_double (pos a)).
+  rewrite IHa, succ_double_add, double_mul.
+  case leb_spec; intros H; trivial.
+  rewrite succ_double_mul, <- add_assoc. f_equal.
+  now rewrite (add_comm b), sub_add.
+  (* a~0 *)
+  destruct pos_div_eucl as (q,r).
+  change (pos a~0) with (double (pos a)).
+  rewrite IHa, double_add, double_mul.
+  case leb_spec; intros H; trivial.
+  rewrite succ_double_mul, <- add_assoc. f_equal.
+  now rewrite (add_comm b), sub_add.
+  (* 1 *)
+  now destruct b as [|[ | | ]].
 Qed.
 
-Theorem Ncompare_n_Sm :
-  forall n m : N, Ncompare n (Nsucc m) = Lt <-> Ncompare n m = Lt \/ n = m.
+Theorem div_eucl_spec a b :
+ let (q,r) := div_eucl a b in a = b * q + r.
 Proof.
-intros n m; split; destruct n as [| p]; destruct m as [| q]; simpl; auto.
-destruct p; simpl; intros; discriminate.
-pose proof (Pcompare_p_Sq p q) as (?,_).
-assert (p = q <-> Npos p = Npos q); [split; congruence | tauto].
-intros H; destruct H; discriminate.
-pose proof (Pcompare_p_Sq p q) as (_,?);
-assert (p = q <-> Npos p = Npos q); [split; congruence | tauto].
+  destruct a as [|a], b as [|b]; unfold div_eucl; trivial.
+  generalize (pos_div_eucl_spec a (pos b)).
+  destruct pos_div_eucl. now rewrite mul_comm.
 Qed.
 
-Lemma Nle_lteq : forall x y, x <= y <-> x < y \/ x=y.
+Theorem div_mod' a b : a = b * (a/b) + (a mod b).
 Proof.
-unfold Nle, Nlt; intros.
-generalize (Ncompare_eq_correct x y).
-destruct (x ?= y); intuition; discriminate.
+  generalize (div_eucl_spec a b).
+  unfold div, modulo. now destruct div_eucl.
 Qed.
 
-Lemma Ncompare_spec : forall x y, CompSpec eq Nlt x y (Ncompare x y).
+Definition div_mod a b : b<>0 -> a = b * (a/b) + (a mod b).
 Proof.
-intros.
-destruct (Ncompare x y) as [ ]_eqn; constructor; auto.
-apply Ncompare_Eq_eq; auto.
-apply Ngt_Nlt; auto.
+ intros _. apply div_mod'.
 Qed.
 
-(** 0 is the least natural number *)
+Theorem pos_div_eucl_remainder (a:positive) (b:N) :
+  b<>0 -> snd (pos_div_eucl a b) < b.
+Proof.
+  intros Hb.
+  induction a; cbv beta iota delta [pos_div_eucl]; fold pos_div_eucl; cbv zeta.
+  (* a~1 *)
+  destruct pos_div_eucl as (q,r); simpl in *.
+  case leb_spec; intros H; simpl; trivial.
+  apply add_lt_cancel_l with b. rewrite add_comm, sub_add by trivial.
+  destruct b as [|b]; [now destruct Hb| simpl; rewrite Pos.add_diag ].
+  apply (succ_double_lt _ _ IHa).
+  (* a~0 *)
+  destruct pos_div_eucl as (q,r); simpl in *.
+  case leb_spec; intros H; simpl; trivial.
+  apply add_lt_cancel_l with b. rewrite add_comm, sub_add by trivial.
+  destruct b as [|b]; [now destruct Hb| simpl; rewrite Pos.add_diag ].
+  now destruct r.
+  (* 1 *)
+  destruct b as [|[ | | ]]; easy || (now destruct Hb).
+Qed.
+
+Theorem mod_lt a b : b<>0 -> a mod b < b.
+Proof.
+  destruct b as [ |b]. now destruct 1.
+  destruct a as [ |a]. reflexivity.
+  unfold modulo. simpl. apply pos_div_eucl_remainder.
+Qed.
+
+Theorem mod_bound_pos a b : 0<=a -> 0<b -> 0 <= a mod b < b.
+Proof.
+ intros _ H. split. apply le_0_l. apply mod_lt. now destruct b.
+Qed.
 
-Theorem Ncompare_0 : forall n : N, Ncompare n N0 <> Lt.
+(** Specification of square root *)
+
+Lemma sqrtrem_sqrt n : fst (sqrtrem n) = sqrt n.
+Proof.
+ destruct n. reflexivity.
+ unfold sqrtrem, sqrt, Pos.sqrt.
+ destruct (Pos.sqrtrem p) as (s,r). now destruct r.
+Qed.
+
+Lemma sqrtrem_spec n :
+ let (s,r) := sqrtrem n in n = s*s + r /\ r <= 2*s.
+Proof.
+ destruct n. now split.
+ generalize (Pos.sqrtrem_spec p). simpl.
+ destruct 1; simpl; subst; now split.
+Qed.
+
+Lemma sqrt_spec n : 0<=n ->
+ let s := sqrt n in s*s <= n < (succ s)*(succ s).
+Proof.
+ intros _. destruct n. now split. apply (Pos.sqrt_spec p).
+Qed.
+
+Lemma sqrt_neg n : n<0 -> sqrt n = 0.
+Proof.
+ now destruct n.
+Qed.
+
+(** Specification of gcd *)
+
+(** The first component of ggcd is gcd *)
+
+Lemma ggcd_gcd a b : fst (ggcd a b) = gcd a b.
+Proof.
+ destruct a as [|p], b as [|q]; simpl; auto.
+ assert (H := Pos.ggcd_gcd p q).
+ destruct Pos.ggcd as (g,(aa,bb)); simpl; now f_equal.
+Qed.
+
+(** The other components of ggcd are indeed the correct factors. *)
+
+Lemma ggcd_correct_divisors a b :
+  let '(g,(aa,bb)) := ggcd a b in
+  a=g*aa /\ b=g*bb.
+Proof.
+ destruct a as [|p], b as [|q]; simpl; auto.
+ now rewrite Pos.mul_1_r.
+ now rewrite Pos.mul_1_r.
+ generalize (Pos.ggcd_correct_divisors p q).
+ destruct Pos.ggcd as (g,(aa,bb)); simpl.
+ destruct 1; split; now f_equal.
+Qed.
+
+(** We can use this fact to prove a part of the gcd correctness *)
+
+Lemma gcd_divide_l a b : (gcd a b | a).
+Proof.
+ rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b).
+ destruct ggcd as (g,(aa,bb)); simpl. intros (H,_). exists aa.
+  now rewrite mul_comm.
+Qed.
+
+Lemma gcd_divide_r a b : (gcd a b | b).
+Proof.
+ rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b).
+ destruct ggcd as (g,(aa,bb)); simpl. intros (_,H). exists bb.
+  now rewrite mul_comm.
+Qed.
+
+(** We now prove directly that gcd is the greatest amongst common divisors *)
+
+Lemma gcd_greatest a b c : (c|a) -> (c|b) -> (c|gcd a b).
+Proof.
+ destruct a as [ |p], b as [ |q]; simpl; trivial.
+ destruct c as [ |r]. intros (s,H). destruct s; discriminate.
+ intros ([ |s],Hs) ([ |t],Ht); try discriminate; simpl in *.
+ destruct (Pos.gcd_greatest p q r) as (u,H).
+ exists s. now inversion Hs.
+ exists t. now inversion Ht.
+ exists (pos u). simpl; now f_equal.
+Qed.
+
+Lemma gcd_nonneg a b : 0 <= gcd a b.
+Proof. apply le_0_l. Qed.
+
+(** Specification of bitwise functions *)
+
+(** Correctness proofs for [testbit]. *)
+
+Lemma testbit_even_0 a : testbit (2*a) 0 = false.
+Proof.
+ now destruct a.
+Qed.
+
+Lemma testbit_odd_0 a : testbit (2*a+1) 0 = true.
+Proof.
+ now destruct a.
+Qed.
+
+Lemma testbit_succ_r_div2 a n : 0<=n ->
+ testbit a (succ n) = testbit (div2 a) n.
+Proof.
+ intros _. destruct a as [|[a|a| ]], n as [|n]; simpl; trivial;
+  f_equal; apply Pos.pred_N_succ.
+Qed.
+
+Lemma testbit_odd_succ a n : 0<=n ->
+ testbit (2*a+1) (succ n) = testbit a n.
+Proof.
+ intros H. rewrite testbit_succ_r_div2 by trivial. f_equal. now destruct a.
+Qed.
+
+Lemma testbit_even_succ a n : 0<=n ->
+ testbit (2*a) (succ n) = testbit a n.
+Proof.
+ intros H. rewrite testbit_succ_r_div2 by trivial. f_equal. now destruct a.
+Qed.
+
+Lemma testbit_neg_r a n : n<0 -> testbit a n = false.
+Proof.
+ now destruct n.
+Qed.
+
+(** Correctness proofs for shifts *)
+
+Lemma shiftr_succ_r a n :
+ shiftr a (succ n) = div2 (shiftr a n).
+Proof.
+ destruct n; simpl; trivial. apply Pos.iter_succ.
+Qed.
+
+Lemma shiftl_succ_r a n :
+ shiftl a (succ n) = double (shiftl a n).
+Proof.
+ destruct n, a; simpl; trivial. f_equal. apply Pos.iter_succ.
+Qed.
+
+Lemma shiftr_spec a n m : 0<=m ->
+ testbit (shiftr a n) m = testbit a (m+n).
+Proof.
+ intros _. revert a m.
+ induction n using peano_ind; intros a m. now rewrite add_0_r.
+ rewrite add_comm, add_succ_l, add_comm, <- add_succ_l.
+ now rewrite <- IHn, testbit_succ_r_div2, shiftr_succ_r by apply le_0_l.
+Qed.
+
+Lemma shiftl_spec_high a n m : 0<=m -> n<=m ->
+ testbit (shiftl a n) m = testbit a (m-n).
+Proof.
+ intros _ H.
+ rewrite <- (sub_add n m H) at 1.
+ set (m' := m-n). clearbody m'. clear H m. revert a m'.
+ induction n using peano_ind; intros a m.
+ rewrite add_0_r; now destruct a.
+ rewrite shiftl_succ_r.
+ rewrite add_comm, add_succ_l, add_comm.
+ now rewrite testbit_succ_r_div2, div2_double by apply le_0_l.
+Qed.
+
+Lemma shiftl_spec_low a n m : m<n ->
+ testbit (shiftl a n) m = false.
+Proof.
+ revert a m.
+ induction n using peano_ind; intros a m H.
+ elim (le_0_l m). now rewrite compare_antisym, H.
+ rewrite shiftl_succ_r.
+ destruct m. now destruct (shiftl a n).
+ rewrite <- (succ_pos_pred p), testbit_succ_r_div2, div2_double by apply le_0_l.
+ apply IHn.
+ apply add_lt_cancel_l with 1. rewrite 2 (add_succ_l 0). simpl.
+ now rewrite succ_pos_pred.
+Qed.
+
+Definition div2_spec a : div2 a = shiftr a 1.
+Proof.
+ reflexivity.
+Qed.
+
+(** Semantics of bitwise operations *)
+
+Lemma pos_lxor_spec p p' n :
+ testbit (Pos.lxor p p') n = xorb (Pos.testbit p n) (Pos.testbit p' n).
+Proof.
+ revert p' n.
+ induction p as [p IH|p IH|]; intros [p'|p'|] [|n]; trivial; simpl;
+ (specialize (IH p'); destruct Pos.lxor; trivial; now rewrite <-IH) ||
+ (now destruct Pos.testbit).
+Qed.
+
+Lemma lxor_spec a a' n :
+ testbit (lxor a a') n = xorb (testbit a n) (testbit a' n).
+Proof.
+ destruct a, a'; simpl; trivial.
+ now destruct Pos.testbit.
+ now destruct Pos.testbit.
+ apply pos_lxor_spec.
+Qed.
+
+Lemma pos_lor_spec p p' n :
+ Pos.testbit (Pos.lor p p') n = (Pos.testbit p n) || (Pos.testbit p' n).
+Proof.
+ revert p' n.
+ induction p as [p IH|p IH|]; intros [p'|p'|] [|n]; trivial; simpl;
+  apply IH || now rewrite orb_false_r.
+Qed.
+
+Lemma lor_spec a a' n :
+ testbit (lor a a') n = (testbit a n) || (testbit a' n).
+Proof.
+ destruct a, a'; simpl; trivial.
+ now rewrite orb_false_r.
+ apply pos_lor_spec.
+Qed.
+
+Lemma pos_land_spec p p' n :
+ testbit (Pos.land p p') n = (Pos.testbit p n) && (Pos.testbit p' n).
+Proof.
+ revert p' n.
+ induction p as [p IH|p IH|]; intros [p'|p'|] [|n]; trivial; simpl;
+ (specialize (IH p'); destruct Pos.land; trivial; now rewrite <-IH) ||
+ (now rewrite andb_false_r).
+Qed.
+
+Lemma land_spec a a' n :
+ testbit (land a a') n = (testbit a n) && (testbit a' n).
+Proof.
+ destruct a, a'; simpl; trivial.
+ now rewrite andb_false_r.
+ apply pos_land_spec.
+Qed.
+
+Lemma pos_ldiff_spec p p' n :
+ testbit (Pos.ldiff p p') n = (Pos.testbit p n) && negb (Pos.testbit p' n).
+Proof.
+ revert p' n.
+ induction p as [p IH|p IH|]; intros [p'|p'|] [|n]; trivial; simpl;
+ (specialize (IH p'); destruct Pos.ldiff; trivial; now rewrite <-IH) ||
+ (now rewrite andb_true_r).
+Qed.
+
+Lemma ldiff_spec a a' n :
+ testbit (ldiff a a') n = (testbit a n) && negb (testbit a' n).
+Proof.
+ destruct a, a'; simpl; trivial.
+ now rewrite andb_true_r.
+ apply pos_ldiff_spec.
+Qed.
+
+(** Specification of constants *)
+
+Lemma one_succ : 1 = succ 0.
+Proof. reflexivity. Qed.
+
+Lemma two_succ : 2 = succ 1.
+Proof. reflexivity. Qed.
+
+Definition pred_0 : pred 0 = 0.
+Proof. reflexivity. Qed.
+
+(** Proofs of morphisms, obvious since eq is Leibniz *)
+
+Local Obligation Tactic := simpl_relation.
+Program Definition succ_wd : Proper (eq==>eq) succ := _.
+Program Definition pred_wd : Proper (eq==>eq) pred := _.
+Program Definition add_wd : Proper (eq==>eq==>eq) add := _.
+Program Definition sub_wd : Proper (eq==>eq==>eq) sub := _.
+Program Definition mul_wd : Proper (eq==>eq==>eq) mul := _.
+Program Definition lt_wd : Proper (eq==>eq==>iff) lt := _.
+Program Definition div_wd : Proper (eq==>eq==>eq) div := _.
+Program Definition mod_wd : Proper (eq==>eq==>eq) modulo := _.
+Program Definition pow_wd : Proper (eq==>eq==>eq) pow := _.
+Program Definition testbit_wd : Proper (eq==>eq==>Logic.eq) testbit := _.
+
+(** Generic induction / recursion *)
+
+Theorem bi_induction :
+  forall A : N -> Prop, Proper (Logic.eq==>iff) A ->
+    A 0 -> (forall n, A n <-> A (succ n)) -> forall n : N, A n.
 Proof.
-destruct n; discriminate.
+intros A A_wd A0 AS. apply peano_rect. assumption. intros; now apply -> AS.
 Qed.
 
-(** Dividing by 2 *)
+Definition recursion {A} : A -> (N -> A -> A) -> N -> A :=
+  peano_rect (fun _ => A).
+
+Instance recursion_wd {A} (Aeq : relation A) :
+ Proper (Aeq==>(Logic.eq==>Aeq==>Aeq)==>Logic.eq==>Aeq) recursion.
+Proof.
+intros a a' Ea f f' Ef x x' Ex. subst x'.
+induction x using peano_ind.
+trivial.
+unfold recursion in *. rewrite 2 peano_rect_succ. now apply Ef.
+Qed.
 
-Definition Ndiv2 (n:N) :=
-  match n with
-  | N0 => N0
-  | Npos 1 => N0
-  | Npos (xO p) => Npos p
-  | Npos (xI p) => Npos p
-  end.
+Theorem recursion_0 {A} (a:A) (f:N->A->A) : recursion a f 0 = a.
+Proof. reflexivity. Qed.
 
-Lemma Ndouble_div2 : forall n:N, Ndiv2 (Ndouble n) = n.
+Theorem recursion_succ {A} (Aeq : relation A) (a : A) (f : N -> A -> A):
+ Aeq a a -> Proper (Logic.eq==>Aeq==>Aeq) f ->
+  forall n : N, Aeq (recursion a f (succ n)) (f n (recursion a f n)).
 Proof.
-  destruct n; trivial.
+unfold recursion; intros a_wd f_wd n. induction n using peano_ind.
+rewrite peano_rect_succ. now apply f_wd.
+rewrite !peano_rect_succ in *. now apply f_wd.
 Qed.
 
-Lemma Ndouble_plus_one_div2 :
- forall n:N, Ndiv2 (Ndouble_plus_one n) = n.
+(** Instantiation of generic properties of natural numbers *)
+
+(** The Bind Scope prevents N to stay associated with abstract_scope.
+    (TODO FIX) *)
+
+Include NProp. Bind Scope N_scope with N.
+Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
+
+(** In generic statements, the predicates [lt] and [le] have been
+  favored, whereas [gt] and [ge] don't even exist in the abstract
+  layers. The use of [gt] and [ge] is hence not recommended. We provide
+  here the bare minimal results to related them with [lt] and [le]. *)
+
+Lemma gt_lt_iff n m : n > m <-> m < n.
 Proof.
-  destruct n; trivial.
+ unfold lt, gt. now rewrite compare_antisym, CompOpp_iff.
 Qed.
 
-Lemma Ndouble_inj : forall n m, Ndouble n = Ndouble m -> n = m.
+Lemma gt_lt n m : n > m -> m < n.
 Proof.
-  intros. rewrite <- (Ndouble_div2 n). rewrite H. apply Ndouble_div2.
+ apply gt_lt_iff.
 Qed.
 
-Lemma Ndouble_plus_one_inj :
- forall n m, Ndouble_plus_one n = Ndouble_plus_one m -> n = m.
+Lemma lt_gt n m : n < m -> m > n.
 Proof.
-  intros. rewrite <- (Ndouble_plus_one_div2 n). rewrite H. apply Ndouble_plus_one_div2.
+ apply gt_lt_iff.
 Qed.
+
+Lemma ge_le_iff n m : n >= m <-> m <= n.
+Proof.
+ unfold le, ge. now rewrite compare_antisym, CompOpp_iff.
+Qed.
+
+Lemma ge_le n m : n >= m -> m <= n.
+Proof.
+ apply ge_le_iff.
+Qed.
+
+Lemma le_ge n m : n <= m -> m >= n.
+Proof.
+ apply ge_le_iff.
+Qed.
+
+(** Auxiliary results about right shift on positive numbers,
+    used in BinInt *)
+
+Lemma pos_pred_shiftl_low : forall p n m, m<n ->
+ testbit (Pos.pred_N (Pos.shiftl p n)) m = true.
+Proof.
+ induction n using peano_ind.
+ now destruct m.
+ intros m H. unfold Pos.shiftl.
+ destruct n as [|n]; simpl in *.
+ destruct m. now destruct p. elim (Pos.nlt_1_r _ H).
+ rewrite Pos.iter_succ. simpl.
+ set (u:=Pos.iter n xO p) in *; clearbody u.
+ destruct m as [|m]. now destruct u.
+ rewrite <- (IHn (Pos.pred_N m)).
+ rewrite <- (testbit_odd_succ _ (Pos.pred_N m)).
+ rewrite succ_pos_pred. now destruct u.
+ apply le_0_l.
+ apply succ_lt_mono. now rewrite succ_pos_pred.
+Qed.
+
+Lemma pos_pred_shiftl_high : forall p n m, n<=m ->
+ testbit (Pos.pred_N (Pos.shiftl p n)) m =
+ testbit (shiftl (Pos.pred_N p) n) m.
+Proof.
+ induction n using peano_ind; intros m H.
+ unfold shiftl. simpl. now destruct (Pos.pred_N p).
+ rewrite shiftl_succ_r.
+ destruct n as [|n].
+ destruct m as [|m]. now destruct H. now destruct p.
+ destruct m as [|m]. now destruct H.
+ rewrite <- (succ_pos_pred m).
+ rewrite double_spec, testbit_even_succ by apply le_0_l.
+ rewrite <- IHn.
+ rewrite testbit_succ_r_div2 by apply le_0_l.
+ f_equal. simpl. rewrite Pos.iter_succ.
+ now destruct (Pos.iter n xO p).
+ apply succ_le_mono. now rewrite succ_pos_pred.
+Qed.
+
+Lemma pred_div2_up p : Pos.pred_N (Pos.div2_up p) = div2 (Pos.pred_N p).
+Proof.
+ destruct p as [p|p| ]; trivial.
+ simpl. apply Pos.pred_N_succ.
+ destruct p; simpl; trivial.
+Qed.
+
+End N.
+
+(** Exportation of notations *)
+
+Infix "+" := N.add : N_scope.
+Infix "-" := N.sub : N_scope.
+Infix "*" := N.mul : N_scope.
+Infix "^" := N.pow : N_scope.
+
+Infix "?=" := N.compare (at level 70, no associativity) : N_scope.
+
+Infix "<=" := N.le : N_scope.
+Infix "<" := N.lt : N_scope.
+Infix ">=" := N.ge : N_scope.
+Infix ">" := N.gt : N_scope.
+
+Notation "x <= y <= z" := (x <= y /\ y <= z) : N_scope.
+Notation "x <= y < z" := (x <= y /\ y < z) : N_scope.
+Notation "x < y < z" := (x < y /\ y < z) : N_scope.
+Notation "x < y <= z" := (x < y /\ y <= z) : N_scope.
+
+Infix "=?" := N.eqb (at level 70, no associativity) : N_scope.
+Infix "<=?" := N.leb (at level 70, no associativity) : N_scope.
+Infix "<?" := N.ltb (at level 70, no associativity) : N_scope.
+
+Infix "/" := N.div : N_scope.
+Infix "mod" := N.modulo (at level 40, no associativity) : N_scope.
+
+Notation "( p | q )" := (N.divide p q) (at level 0) : N_scope.
+
+(** Compatibility notations *)
+
+(*Notation N := N (compat "8.3").*) (*hidden by module N above *)
+Notation N_rect := N_rect (only parsing).
+Notation N_rec := N_rec (only parsing).
+Notation N_ind := N_ind (only parsing).
+Notation N0 := N0 (only parsing).
+Notation Npos := N.pos (only parsing).
+
+Notation Ndiscr := N.discr (compat "8.3").
+Notation Ndouble_plus_one := N.succ_double (compat "8.3").
+Notation Ndouble := N.double (compat "8.3").
+Notation Nsucc := N.succ (compat "8.3").
+Notation Npred := N.pred (compat "8.3").
+Notation Nsucc_pos := N.succ_pos (compat "8.3").
+Notation Ppred_N := Pos.pred_N (compat "8.3").
+Notation Nplus := N.add (compat "8.3").
+Notation Nminus := N.sub (compat "8.3").
+Notation Nmult := N.mul (compat "8.3").
+Notation Neqb := N.eqb (compat "8.3").
+Notation Ncompare := N.compare (compat "8.3").
+Notation Nlt := N.lt (compat "8.3").
+Notation Ngt := N.gt (compat "8.3").
+Notation Nle := N.le (compat "8.3").
+Notation Nge := N.ge (compat "8.3").
+Notation Nmin := N.min (compat "8.3").
+Notation Nmax := N.max (compat "8.3").
+Notation Ndiv2 := N.div2 (compat "8.3").
+Notation Neven := N.even (compat "8.3").
+Notation Nodd := N.odd (compat "8.3").
+Notation Npow := N.pow (compat "8.3").
+Notation Nlog2 := N.log2 (compat "8.3").
+
+Notation nat_of_N := N.to_nat (compat "8.3").
+Notation N_of_nat := N.of_nat (compat "8.3").
+Notation N_eq_dec := N.eq_dec (compat "8.3").
+Notation Nrect := N.peano_rect (compat "8.3").
+Notation Nrect_base := N.peano_rect_base (compat "8.3").
+Notation Nrect_step := N.peano_rect_succ (compat "8.3").
+Notation Nind := N.peano_ind (compat "8.3").
+Notation Nrec := N.peano_rec (compat "8.3").
+Notation Nrec_base := N.peano_rec_base (compat "8.3").
+Notation Nrec_succ := N.peano_rec_succ (compat "8.3").
+
+Notation Npred_succ := N.pred_succ (compat "8.3").
+Notation Npred_minus := N.pred_sub (compat "8.3").
+Notation Nsucc_pred := N.succ_pred (compat "8.3").
+Notation Ppred_N_spec := N.pos_pred_spec (compat "8.3").
+Notation Nsucc_pos_spec := N.succ_pos_spec (compat "8.3").
+Notation Ppred_Nsucc := N.pos_pred_succ (compat "8.3").
+Notation Nplus_0_l := N.add_0_l (compat "8.3").
+Notation Nplus_0_r := N.add_0_r (compat "8.3").
+Notation Nplus_comm := N.add_comm (compat "8.3").
+Notation Nplus_assoc := N.add_assoc (compat "8.3").
+Notation Nplus_succ := N.add_succ_l (compat "8.3").
+Notation Nsucc_0 := N.succ_0_discr (compat "8.3").
+Notation Nsucc_inj := N.succ_inj (compat "8.3").
+Notation Nminus_N0_Nle := N.sub_0_le (compat "8.3").
+Notation Nminus_0_r := N.sub_0_r (compat "8.3").
+Notation Nminus_succ_r:= N.sub_succ_r (compat "8.3").
+Notation Nmult_0_l := N.mul_0_l (compat "8.3").
+Notation Nmult_1_l := N.mul_1_l (compat "8.3").
+Notation Nmult_1_r := N.mul_1_r (compat "8.3").
+Notation Nmult_comm := N.mul_comm (compat "8.3").
+Notation Nmult_assoc := N.mul_assoc (compat "8.3").
+Notation Nmult_plus_distr_r := N.mul_add_distr_r (compat "8.3").
+Notation Neqb_eq := N.eqb_eq (compat "8.3").
+Notation Nle_0 := N.le_0_l (compat "8.3").
+Notation Ncompare_refl := N.compare_refl (compat "8.3").
+Notation Ncompare_Eq_eq := N.compare_eq (compat "8.3").
+Notation Ncompare_eq_correct := N.compare_eq_iff (compat "8.3").
+Notation Nlt_irrefl := N.lt_irrefl (compat "8.3").
+Notation Nlt_trans := N.lt_trans (compat "8.3").
+Notation Nle_lteq := N.lt_eq_cases (compat "8.3").
+Notation Nlt_succ_r := N.lt_succ_r (compat "8.3").
+Notation Nle_trans := N.le_trans (compat "8.3").
+Notation Nle_succ_l := N.le_succ_l (compat "8.3").
+Notation Ncompare_spec := N.compare_spec (compat "8.3").
+Notation Ncompare_0 := N.compare_0_r (compat "8.3").
+Notation Ndouble_div2 := N.div2_double (compat "8.3").
+Notation Ndouble_plus_one_div2 := N.div2_succ_double (compat "8.3").
+Notation Ndouble_inj := N.double_inj (compat "8.3").
+Notation Ndouble_plus_one_inj := N.succ_double_inj (compat "8.3").
+Notation Npow_0_r := N.pow_0_r (compat "8.3").
+Notation Npow_succ_r := N.pow_succ_r (compat "8.3").
+Notation Nlog2_spec := N.log2_spec (compat "8.3").
+Notation Nlog2_nonpos := N.log2_nonpos (compat "8.3").
+Notation Neven_spec := N.even_spec (compat "8.3").
+Notation Nodd_spec := N.odd_spec (compat "8.3").
+Notation Nlt_not_eq := N.lt_neq (compat "8.3").
+Notation Ngt_Nlt := N.gt_lt (compat "8.3").
+
+(** More complex compatibility facts, expressed as lemmas
+    (to preserve scopes for instance) *)
+
+Lemma Nplus_reg_l n m p : n + m = n + p -> m = p.
+Proof (proj1 (N.add_cancel_l m p n)).
+Lemma Nmult_Sn_m n m : N.succ n * m = m + n * m.
+Proof (eq_trans (N.mul_succ_l n m) (N.add_comm _ _)).
+Lemma Nmult_plus_distr_l n m p : p * (n + m) = p * n + p * m.
+Proof (N.mul_add_distr_l p n m).
+Lemma Nmult_reg_r n m p : p <> 0 -> n * p = m * p -> n = m.
+Proof (fun H => proj1 (N.mul_cancel_r n m p H)).
+Lemma Ncompare_antisym n m : CompOpp (n ?= m) = (m ?= n).
+Proof (eq_sym (N.compare_antisym n m)).
+
+Definition N_ind_double a P f0 f2 fS2 := N.binary_ind P f0 f2 fS2 a.
+Definition N_rec_double a P f0 f2 fS2 := N.binary_rec P f0 f2 fS2 a.
+
+(** Not kept : Ncompare_n_Sm Nplus_lt_cancel_l *)
diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v
new file mode 100644
index 00000000..08e1138f
--- /dev/null
+++ b/theories/NArith/BinNatDef.v
@@ -0,0 +1,381 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Export BinNums.
+Require Import BinPos.
+
+Local Open Scope N_scope.
+
+(**********************************************************************)
+(** * Binary natural numbers, definitions of operations *)
+(**********************************************************************)
+
+Module N.
+
+Definition t := N.
+
+(** ** Nicer name [N.pos] for contructor [Npos] *)
+
+Notation pos := Npos.
+
+(** ** Constants *)
+
+Definition zero := 0.
+Definition one := 1.
+Definition two := 2.
+
+(** ** Operation [x -> 2*x+1] *)
+
+Definition succ_double x :=
+  match x with
+  | 0 => 1
+  | pos p => pos p~1
+  end.
+
+(** ** Operation [x -> 2*x] *)
+
+Definition double n :=
+  match n with
+  | 0 => 0
+  | pos p => pos p~0
+  end.
+
+(** ** Successor *)
+
+Definition succ n :=
+  match n with
+  | 0 => 1
+  | pos p => pos (Pos.succ p)
+  end.
+
+(** ** Predecessor *)
+
+Definition pred n :=
+  match n with
+  | 0 => 0
+  | pos p => Pos.pred_N p
+  end.
+
+(** ** The successor of a [N] can be seen as a [positive] *)
+
+Definition succ_pos (n : N) : positive :=
+ match n with
+   | 0 => 1%positive
+   | pos p => Pos.succ p
+ end.
+
+(** ** Addition *)
+
+Definition add n m :=
+  match n, m with
+  | 0, _ => m
+  | _, 0 => n
+  | pos p, pos q => pos (p + q)
+  end.
+
+Infix "+" := add : N_scope.
+
+(** Subtraction *)
+
+Definition sub n m :=
+match n, m with
+| 0, _ => 0
+| n, 0 => n
+| pos n', pos m' =>
+  match Pos.sub_mask n' m' with
+  | IsPos p => pos p
+  | _ => 0
+  end
+end.
+
+Infix "-" := sub : N_scope.
+
+(** Multiplication *)
+
+Definition mul n m :=
+  match n, m with
+  | 0, _ => 0
+  | _, 0 => 0
+  | pos p, pos q => pos (p * q)
+  end.
+
+Infix "*" := mul : N_scope.
+
+(** Order *)
+
+Definition compare n m :=
+  match n, m with
+  | 0, 0 => Eq
+  | 0, pos m' => Lt
+  | pos n', 0 => Gt
+  | pos n', pos m' => (n' ?= m')%positive
+  end.
+
+Infix "?=" := compare (at level 70, no associativity) : N_scope.
+
+(** Boolean equality and comparison *)
+
+Fixpoint eqb n m :=
+  match n, m with
+    | 0, 0 => true
+    | pos p, pos q => Pos.eqb p q
+    | _, _ => false
+  end.
+
+Definition leb x y :=
+ match x ?= y with Gt => false | _ => true end.
+
+Definition ltb x y :=
+ match x ?= y with Lt => true | _ => false end.
+
+Infix "=?" := eqb (at level 70, no associativity) : N_scope.
+Infix "<=?" := leb (at level 70, no associativity) : N_scope.
+Infix "<?" := ltb (at level 70, no associativity) : N_scope.
+
+(** Min and max *)
+
+Definition min n n' := match n ?= n' with
+ | Lt | Eq => n
+ | Gt => n'
+ end.
+
+Definition max n n' := match n ?= n' with
+ | Lt | Eq => n'
+ | Gt => n
+ end.
+
+(** Dividing by 2 *)
+
+Definition div2 n :=
+  match n with
+  | 0 => 0
+  | 1 => 0
+  | pos (p~0) => pos p
+  | pos (p~1) => pos p
+  end.
+
+(** Parity *)
+
+Definition even n :=
+  match n with
+    | 0 => true
+    | pos (xO _) => true
+    | _ => false
+  end.
+
+Definition odd n := negb (even n).
+
+(** Power *)
+
+Definition pow n p :=
+  match p, n with
+    | 0, _ => 1
+    | _, 0 => 0
+    | pos p, pos q => pos (q^p)
+  end.
+
+Infix "^" := pow : N_scope.
+
+(** Square *)
+
+Definition square n :=
+  match n with
+    | 0 => 0
+    | pos p => pos (Pos.square p)
+  end.
+
+(** Base-2 logarithm *)
+
+Definition log2 n :=
+ match n with
+   | 0 => 0
+   | 1 => 0
+   | pos (p~0) => pos (Pos.size p)
+   | pos (p~1) => pos (Pos.size p)
+ end.
+
+(** How many digits in a number ?
+    Number 0 is said to have no digits at all.
+*)
+
+Definition size n :=
+ match n with
+  | 0 => 0
+  | pos p => pos (Pos.size p)
+ end.
+
+Definition size_nat n :=
+ match n with
+  | 0 => O
+  | pos p => Pos.size_nat p
+ end.
+
+(** Euclidean division *)
+
+Fixpoint pos_div_eucl (a:positive)(b:N) : N * N :=
+  match a with
+    | xH =>
+       match b with 1 => (1,0) | _ => (0,1) end
+    | xO a' =>
+       let (q, r) := pos_div_eucl a' b in
+       let r' := double r in
+       if b <=? r' then (succ_double q, r' - b)
+        else (double q, r')
+    | xI a' =>
+       let (q, r) := pos_div_eucl a' b in
+       let r' := succ_double r in
+       if b <=? r' then (succ_double q, r' - b)
+        else  (double q, r')
+  end.
+
+Definition div_eucl (a b:N) : N * N :=
+  match a, b with
+   | 0,  _ => (0, 0)
+   | _, 0  => (0, a)
+   | pos na, _ => pos_div_eucl na b
+  end.
+
+Definition div a b := fst (div_eucl a b).
+Definition modulo a b := snd (div_eucl a b).
+
+Infix "/" := div : N_scope.
+Infix "mod" := modulo (at level 40, no associativity) : N_scope.
+
+(** Greatest common divisor *)
+
+Definition gcd a b :=
+ match a, b with
+  | 0, _ => b
+  | _, 0 => a
+  | pos p, pos q => pos (Pos.gcd p q)
+ end.
+
+(** Generalized Gcd, also computing rests of [a] and [b] after
+    division by gcd. *)
+
+Definition ggcd a b :=
+ match a, b with
+  | 0, _ => (b,(0,1))
+  | _, 0 => (a,(1,0))
+  | pos p, pos q =>
+     let '(g,(aa,bb)) := Pos.ggcd p q in
+     (pos g, (pos aa, pos bb))
+ end.
+
+(** Square root *)
+
+Definition sqrtrem n :=
+ match n with
+  | 0 => (0, 0)
+  | pos p =>
+    match Pos.sqrtrem p with
+     | (s, IsPos r) => (pos s, pos r)
+     | (s, _) => (pos s, 0)
+    end
+ end.
+
+Definition sqrt n :=
+ match n with
+  | 0 => 0
+  | pos p => pos (Pos.sqrt p)
+ end.
+
+(** Operation over bits of a [N] number. *)
+
+(** Logical [or] *)
+
+Definition lor n m :=
+ match n, m with
+   | 0, _ => m
+   | _, 0 => n
+   | pos p, pos q => pos (Pos.lor p q)
+ end.
+
+(** Logical [and] *)
+
+Definition land n m :=
+ match n, m with
+  | 0, _ => 0
+  | _, 0 => 0
+  | pos p, pos q => Pos.land p q
+ end.
+
+(** Logical [diff] *)
+
+Fixpoint ldiff n m :=
+ match n, m with
+  | 0, _ => 0
+  | _, 0 => n
+  | pos p, pos q => Pos.ldiff p q
+ end.
+
+(** [xor] *)
+
+Definition lxor n m :=
+  match n, m with
+    | 0, _ => m
+    | _, 0 => n
+    | pos p, pos q => Pos.lxor p q
+  end.
+
+(** Shifts *)
+
+Definition shiftl_nat (a:N)(n:nat) := nat_iter n double a.
+Definition shiftr_nat (a:N)(n:nat) := nat_iter n div2 a.
+
+Definition shiftl a n :=
+  match a with
+    | 0 => 0
+    | pos a => pos (Pos.shiftl a n)
+  end.
+
+Definition shiftr a n :=
+  match n with
+    | 0 => a
+    | pos p => Pos.iter p div2 a
+  end.
+
+(** Checking whether a particular bit is set or not *)
+
+Definition testbit_nat (a:N) :=
+  match a with
+    | 0 => fun _ => false
+    | pos p => Pos.testbit_nat p
+  end.
+
+(** Same, but with index in N *)
+
+Definition testbit a n :=
+  match a with
+    | 0 => false
+    | pos p => Pos.testbit p n
+  end.
+
+(** Translation from [N] to [nat] and back. *)
+
+Definition to_nat (a:N) :=
+  match a with
+    | 0 => O
+    | pos p => Pos.to_nat p
+  end.
+
+Definition of_nat (n:nat) :=
+  match n with
+    | O => 0
+    | S n' => pos (Pos.of_succ_nat n')
+  end.
+
+(** Iteration of a function *)
+
+Definition iter (n:N) {A} (f:A->A) (x:A) : A :=
+  match n with
+    | 0 => x
+    | pos p => Pos.iter p f x
+  end.
+
+End N.
\ No newline at end of file
diff --git a/theories/NArith/BinPos.v b/theories/NArith/BinPos.v
deleted file mode 100644
index 62bd57c0..00000000
--- a/theories/NArith/BinPos.v
+++ /dev/null
@@ -1,1172 +0,0 @@
-(* -*- coding: utf-8 -*- *)
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(*i $Id: BinPos.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Unset Boxed Definitions.
-
-Declare ML Module "z_syntax_plugin".
-
-(**********************************************************************)
-(** Binary positive numbers *)
-
-(** Original development by Pierre Crégut, CNET, Lannion, France *)
-
-Inductive positive : Set :=
-| xI : positive -> positive
-| xO : positive -> positive
-| xH : positive.
-
-(** Declare binding key for scope positive_scope *)
-
-Delimit Scope positive_scope with positive.
-
-(** Automatically open scope positive_scope for type positive, xO and xI *)
-
-Bind Scope positive_scope with positive.
-Arguments Scope xO [positive_scope].
-Arguments Scope xI [positive_scope].
-
-(** Postfix notation for positive numbers, allowing to mimic
-    the position of bits in a big-endian representation.
-    For instance, we can write 1~1~0 instead of (xO (xI xH))
-    for the number 6 (which is 110 in binary notation).
-*)
-
-Notation "p ~ 1" := (xI p)
- (at level 7, left associativity, format "p '~' '1'") : positive_scope.
-Notation "p ~ 0" := (xO p)
- (at level 7, left associativity, format "p '~' '0'") : positive_scope.
-
-Open Local Scope positive_scope.
-
-(* In the current file, [xH] cannot yet be written as [1], since the
-   interpretation of positive numerical constants is not available
-   yet. We fix this here with an ad-hoc temporary notation. *)
-
-Notation Local "1" := xH (at level 7).
-
-(** Successor *)
-
-Fixpoint Psucc (x:positive) : positive :=
-  match x with
-    | p~1 => (Psucc p)~0
-    | p~0 => p~1
-    | 1 => 1~0
-  end.
-
-(** Addition *)
-
-Set Boxed Definitions.
-
-Fixpoint Pplus (x y:positive) : positive :=
-  match x, y with
-    | p~1, q~1 => (Pplus_carry p q)~0
-    | p~1, q~0 => (Pplus p q)~1
-    | p~1, 1 => (Psucc p)~0
-    | p~0, q~1 => (Pplus p q)~1
-    | p~0, q~0 => (Pplus p q)~0
-    | p~0, 1 => p~1
-    | 1, q~1 => (Psucc q)~0
-    | 1, q~0 => q~1
-    | 1, 1 => 1~0
-  end
-
-with Pplus_carry (x y:positive) : positive :=
-  match x, y with
-    | p~1, q~1 => (Pplus_carry p q)~1
-    | p~1, q~0 => (Pplus_carry p q)~0
-    | p~1, 1 => (Psucc p)~1
-    | p~0, q~1 => (Pplus_carry p q)~0
-    | p~0, q~0 => (Pplus p q)~1
-    | p~0, 1 => (Psucc p)~0
-    | 1, q~1 => (Psucc q)~1
-    | 1, q~0 => (Psucc q)~0
-    | 1, 1 => 1~1
-  end.
-
-Unset Boxed Definitions.
-
-Infix "+" := Pplus : positive_scope.
-
-(** From binary positive numbers to Peano natural numbers *)
-
-Fixpoint Pmult_nat (x:positive) (pow2:nat) : nat :=
-  match x with
-    | p~1 => (pow2 + Pmult_nat p (pow2 + pow2))%nat
-    | p~0 => Pmult_nat p (pow2 + pow2)%nat
-    | 1 => pow2
-  end.
-
-Definition nat_of_P (x:positive) := Pmult_nat x (S O).
-
-(** From Peano natural numbers to binary positive numbers *)
-
-Fixpoint P_of_succ_nat (n:nat) : positive :=
-  match n with
-    | O => 1
-    | S x => Psucc (P_of_succ_nat x)
-  end.
-
-(** Operation x -> 2*x-1 *)
-
-Fixpoint Pdouble_minus_one (x:positive) : positive :=
-  match x with
-    | p~1 => p~0~1
-    | p~0 => (Pdouble_minus_one p)~1
-    | 1 => 1
-  end.
-
-(** Predecessor *)
-
-Definition Ppred (x:positive) :=
-  match x with
-    | p~1 => p~0
-    | p~0 => Pdouble_minus_one p
-    | 1 => 1
-  end.
-
-(** An auxiliary type for subtraction *)
-
-Inductive positive_mask : Set :=
-| IsNul : positive_mask
-| IsPos : positive -> positive_mask
-| IsNeg : positive_mask.
-
-(** Operation x -> 2*x+1 *)
-
-Definition Pdouble_plus_one_mask (x:positive_mask) :=
-  match x with
-    | IsNul => IsPos 1
-    | IsNeg => IsNeg
-    | IsPos p => IsPos p~1
-  end.
-
-(** Operation x -> 2*x *)
-
-Definition Pdouble_mask (x:positive_mask) :=
-  match x with
-    | IsNul => IsNul
-    | IsNeg => IsNeg
-    | IsPos p => IsPos p~0
-  end.
-
-(** Operation x -> 2*x-2 *)
-
-Definition Pdouble_minus_two (x:positive) :=
-  match x with
-    | p~1 => IsPos p~0~0
-    | p~0 => IsPos (Pdouble_minus_one p)~0
-    | 1 => IsNul
-  end.
-
-(** Subtraction of binary positive numbers into a positive numbers mask *)
-
-Fixpoint Pminus_mask (x y:positive) {struct y} : positive_mask :=
-  match x, y with
-    | p~1, q~1 => Pdouble_mask (Pminus_mask p q)
-    | p~1, q~0 => Pdouble_plus_one_mask (Pminus_mask p q)
-    | p~1, 1 => IsPos p~0
-    | p~0, q~1 => Pdouble_plus_one_mask (Pminus_mask_carry p q)
-    | p~0, q~0 => Pdouble_mask (Pminus_mask p q)
-    | p~0, 1 => IsPos (Pdouble_minus_one p)
-    | 1, 1 => IsNul
-    | 1, _ => IsNeg
-  end
-
-with Pminus_mask_carry (x y:positive) {struct y} : positive_mask :=
-  match x, y with
-    | p~1, q~1 => Pdouble_plus_one_mask (Pminus_mask_carry p q)
-    | p~1, q~0 => Pdouble_mask (Pminus_mask p q)
-    | p~1, 1 => IsPos (Pdouble_minus_one p)
-    | p~0, q~1 => Pdouble_mask (Pminus_mask_carry p q)
-    | p~0, q~0 => Pdouble_plus_one_mask (Pminus_mask_carry p q)
-    | p~0, 1 => Pdouble_minus_two p
-    | 1, _ => IsNeg
-  end.
-
-(** Subtraction of binary positive numbers x and y, returns 1 if x<=y *)
-
-Definition Pminus (x y:positive) :=
-  match Pminus_mask x y with
-    | IsPos z => z
-    | _ => 1
-  end.
-
-Infix "-" := Pminus : positive_scope.
-
-(** Multiplication on binary positive numbers *)
-
-Fixpoint Pmult (x y:positive) : positive :=
-  match x with
-    | p~1 => y + (Pmult p y)~0
-    | p~0 => (Pmult p y)~0
-    | 1 => y
-  end.
-
-Infix "*" := Pmult : positive_scope.
-
-(** Division by 2 rounded below but for 1 *)
-
-Definition Pdiv2 (z:positive) :=
-  match z with
-    | 1 => 1
-    | p~0 => p
-    | p~1 => p
-  end.
-
-Infix "/" := Pdiv2 : positive_scope.
-
-(** Comparison on binary positive numbers *)
-
-Fixpoint Pcompare (x y:positive) (r:comparison) {struct y} : comparison :=
-  match x, y with
-    | p~1, q~1 => Pcompare p q r
-    | p~1, q~0 => Pcompare p q Gt
-    | p~1, 1 => Gt
-    | p~0, q~1 => Pcompare p q Lt
-    | p~0, q~0 => Pcompare p q r
-    | p~0, 1 => Gt
-    | 1, q~1 => Lt
-    | 1, q~0 => Lt
-    | 1, 1 => r
-  end.
-
-Infix "?=" := Pcompare (at level 70, no associativity) : positive_scope.
-
-Definition Plt (x y:positive) := (Pcompare x y Eq) = Lt.
-Definition Pgt (x y:positive) := (Pcompare x y Eq) = Gt.
-Definition Ple (x y:positive) := (Pcompare x y Eq) <> Gt.
-Definition Pge (x y:positive) := (Pcompare x y Eq) <> Lt.
-
-Infix "<=" := Ple : positive_scope.
-Infix "<" := Plt : positive_scope.
-Infix ">=" := Pge : positive_scope.
-Infix ">" := Pgt : positive_scope.
-
-Notation "x <= y <= z" := (x <= y /\ y <= z) : positive_scope.
-Notation "x <= y < z" := (x <= y /\ y < z) : positive_scope.
-Notation "x < y < z" := (x < y /\ y < z) : positive_scope.
-Notation "x < y <= z" := (x < y /\ y <= z) : positive_scope.
-
-
-Definition Pmin (p p' : positive) := match Pcompare p p' Eq with
- | Lt | Eq => p
- | Gt => p'
- end.
-
-Definition Pmax (p p' : positive) := match Pcompare p p' Eq with
- | Lt | Eq => p'
- | Gt => p
- end.
-
-(********************************************************************)
-(** Boolean equality *)
-
-Fixpoint Peqb (x y : positive) {struct y} : bool :=
- match x, y with
- | 1, 1 => true
- | p~1, q~1 => Peqb p q
- | p~0, q~0 => Peqb p q
- | _, _ => false
- end.
-
-(**********************************************************************)
-(** Decidability of equality on binary positive numbers *)
-
-Lemma positive_eq_dec : forall x y: positive, {x = y} + {x <> y}.
-Proof.
-  decide equality.
-Defined.
-
-(* begin hide *)
-Corollary ZL11 : forall p:positive, p = 1 \/ p <> 1.
-Proof.
-  intro; edestruct positive_eq_dec; eauto.
-Qed.
-(* end hide *)
-
-(**********************************************************************)
-(** Properties of successor on binary positive numbers *)
-
-(** Specification of [xI] in term of [Psucc] and [xO] *)
-
-Lemma xI_succ_xO : forall p:positive, p~1 = Psucc p~0.
-Proof.
-  reflexivity.
-Qed.
-
-Lemma Psucc_discr : forall p:positive, p <> Psucc p.
-Proof.
-  destruct p; discriminate.
-Qed.
-
-(** Successor and double *)
-
-Lemma Psucc_o_double_minus_one_eq_xO :
-  forall p:positive, Psucc (Pdouble_minus_one p) = p~0.
-Proof.
-  induction p; simpl; f_equal; auto.
-Qed.
-
-Lemma Pdouble_minus_one_o_succ_eq_xI :
-  forall p:positive, Pdouble_minus_one (Psucc p) = p~1.
-Proof.
-  induction p; simpl; f_equal; auto.
-Qed.
-
-Lemma xO_succ_permute :
-  forall p:positive, (Psucc p)~0 = Psucc (Psucc p~0).
-Proof.
-  induction p; simpl; auto.
-Qed.
-
-Lemma double_moins_un_xO_discr :
-  forall p:positive, Pdouble_minus_one p <> p~0.
-Proof.
-  destruct p; discriminate.
-Qed.
-
-(** Successor and predecessor *)
-
-Lemma Psucc_not_one : forall p:positive, Psucc p <> 1.
-Proof.
-  destruct p; discriminate.
-Qed.
-
-Lemma Ppred_succ : forall p:positive, Ppred (Psucc p) = p.
-Proof.
-  intros [[p|p| ]|[p|p| ]| ]; simpl; auto.
-  f_equal; apply Pdouble_minus_one_o_succ_eq_xI.
-Qed.
-
-Lemma Psucc_pred : forall p:positive, p = 1 \/ Psucc (Ppred p) = p.
-Proof.
-  induction p; simpl; auto.
-  right; apply Psucc_o_double_minus_one_eq_xO.
-Qed.
-
-Ltac destr_eq H := discriminate H || (try (injection H; clear H; intro H)).
-
-(** Injectivity of successor *)
-
-Lemma Psucc_inj : forall p q:positive, Psucc p = Psucc q -> p = q.
-Proof.
-  induction p; intros [q|q| ] H; simpl in *; destr_eq H; f_equal; auto.
-  elim (Psucc_not_one p); auto.
-  elim (Psucc_not_one q); auto.
-Qed.
-
-(**********************************************************************)
-(** Properties of addition on binary positive numbers *)
-
-(** Specification of [Psucc] in term of [Pplus] *)
-
-Lemma Pplus_one_succ_r : forall p:positive, Psucc p = p + 1.
-Proof.
-  destruct p; reflexivity.
-Qed.
-
-Lemma Pplus_one_succ_l : forall p:positive, Psucc p = 1 + p.
-Proof.
-  destruct p; reflexivity.
-Qed.
-
-(** Specification of [Pplus_carry] *)
-
-Theorem Pplus_carry_spec :
-  forall p q:positive, Pplus_carry p q = Psucc (p + q).
-Proof.
-  induction p; destruct q; simpl; f_equal; auto.
-Qed.
-
-(** Commutativity *)
-
-Theorem Pplus_comm : forall p q:positive, p + q = q + p.
-Proof.
-  induction p; destruct q; simpl; f_equal; auto.
-  rewrite 2 Pplus_carry_spec; f_equal; auto.
-Qed.
-
-(** Permutation of [Pplus] and [Psucc] *)
-
-Theorem Pplus_succ_permute_r :
-  forall p q:positive, p + Psucc q = Psucc (p + q).
-Proof.
-  induction p; destruct q; simpl; f_equal;
-   auto using Pplus_one_succ_r; rewrite Pplus_carry_spec; auto.
-Qed.
-
-Theorem Pplus_succ_permute_l :
-  forall p q:positive, Psucc p + q = Psucc (p + q).
-Proof.
-  intros p q; rewrite Pplus_comm, (Pplus_comm p);
-    apply Pplus_succ_permute_r.
-Qed.
-
-Theorem Pplus_carry_pred_eq_plus :
-  forall p q:positive, q <> 1 -> Pplus_carry p (Ppred q) = p + q.
-Proof.
-  intros p q H; rewrite Pplus_carry_spec, <- Pplus_succ_permute_r; f_equal.
-  destruct (Psucc_pred q); [ elim H; assumption | assumption ].
-Qed.
-
-(** No neutral for addition on strictly positive numbers *)
-
-Lemma Pplus_no_neutral : forall p q:positive, q + p <> p.
-Proof.
-  induction p as [p IHp|p IHp| ]; intros [q|q| ] H;
-   destr_eq H; apply (IHp q H).
-Qed.
-
-Lemma Pplus_carry_no_neutral :
-  forall p q:positive, Pplus_carry q p <> Psucc p.
-Proof.
-  intros p q H; elim (Pplus_no_neutral p q).
-  apply Psucc_inj; rewrite <- Pplus_carry_spec; assumption.
-Qed.
-
-(** Simplification *)
-
-Lemma Pplus_carry_plus :
-  forall p q r s:positive, Pplus_carry p r = Pplus_carry q s -> p + r = q + s.
-Proof.
-  intros p q r s H; apply Psucc_inj; do 2 rewrite <- Pplus_carry_spec;
-    assumption.
-Qed.
-
-Lemma Pplus_reg_r : forall p q r:positive, p + r = q + r -> p = q.
-Proof.
-  intros p q r; revert p q; induction r.
-  intros [p|p| ] [q|q| ] H; simpl; destr_eq H;
-    f_equal; auto using Pplus_carry_plus;
-    contradict H; auto using Pplus_carry_no_neutral.
-  intros [p|p| ] [q|q| ] H; simpl; destr_eq H; f_equal; auto;
-    contradict H; auto using Pplus_no_neutral.
-  intros p q H; apply Psucc_inj; do 2 rewrite Pplus_one_succ_r; assumption.
-Qed.
-
-Lemma Pplus_reg_l : forall p q r:positive, p + q = p + r -> q = r.
-Proof.
-  intros p q r H; apply Pplus_reg_r with (r:=p).
-  rewrite (Pplus_comm r), (Pplus_comm q); assumption.
-Qed.
-
-Lemma Pplus_carry_reg_r :
-  forall p q r:positive, Pplus_carry p r = Pplus_carry q r -> p = q.
-Proof.
-  intros p q r H; apply Pplus_reg_r with (r:=r); apply Pplus_carry_plus;
-    assumption.
-Qed.
-
-Lemma Pplus_carry_reg_l :
-  forall p q r:positive, Pplus_carry p q = Pplus_carry p r -> q = r.
-Proof.
-  intros p q r H; apply Pplus_reg_r with (r:=p);
-  rewrite (Pplus_comm r), (Pplus_comm q); apply Pplus_carry_plus; assumption.
-Qed.
-
-(** Addition on positive is associative *)
-
-Theorem Pplus_assoc : forall p q r:positive, p + (q + r) = p + q + r.
-Proof.
-  induction p.
-  intros [q|q| ] [r|r| ]; simpl; f_equal; auto;
-    rewrite ?Pplus_carry_spec, ?Pplus_succ_permute_r,
-     ?Pplus_succ_permute_l, ?Pplus_one_succ_r; f_equal; auto.
-  intros [q|q| ] [r|r| ]; simpl; f_equal; auto;
-    rewrite ?Pplus_carry_spec, ?Pplus_succ_permute_r,
-     ?Pplus_succ_permute_l, ?Pplus_one_succ_r; f_equal; auto.
-  intros p r; rewrite <- 2 Pplus_one_succ_l, Pplus_succ_permute_l; auto.
-Qed.
-
-(** Commutation of addition with the double of a positive number *)
-
-Lemma Pplus_xO : forall m n : positive, (m + n)~0 = m~0 + n~0.
-Proof.
-  destruct n; destruct m; simpl; auto.
-Qed.
-
-Lemma Pplus_xI_double_minus_one :
-  forall p q:positive, (p + q)~0 = p~1 + Pdouble_minus_one q.
-Proof.
-  intros; change (p~1) with (p~0 + 1).
-  rewrite <- Pplus_assoc, <- Pplus_one_succ_l, Psucc_o_double_minus_one_eq_xO.
-  reflexivity.
-Qed.
-
-Lemma Pplus_xO_double_minus_one :
-  forall p q:positive, Pdouble_minus_one (p + q) = p~0 + Pdouble_minus_one q.
-Proof.
-  induction p as [p IHp| p IHp| ]; destruct q; simpl;
-  rewrite ?Pplus_carry_spec, ?Pdouble_minus_one_o_succ_eq_xI,
-    ?Pplus_xI_double_minus_one; try reflexivity.
-  rewrite IHp; auto.
-  rewrite <- Psucc_o_double_minus_one_eq_xO, Pplus_one_succ_l; reflexivity.
-Qed.
-
-(** Misc *)
-
-Lemma Pplus_diag : forall p:positive, p + p = p~0.
-Proof.
-  induction p as [p IHp| p IHp| ]; simpl;
-   try rewrite ?Pplus_carry_spec, ?IHp; reflexivity.
-Qed.
-
-(**********************************************************************)
-(** Peano induction and recursion on binary positive positive numbers *)
-(** (a nice proof from Conor McBride, see "The view from the left")   *)
-
-Inductive PeanoView : positive -> Type :=
-| PeanoOne : PeanoView 1
-| PeanoSucc : forall p, PeanoView p -> PeanoView (Psucc p).
-
-Fixpoint peanoView_xO p (q:PeanoView p) : PeanoView (p~0) :=
-  match q in PeanoView x return PeanoView (x~0) with
-    | PeanoOne => PeanoSucc _ PeanoOne
-    | PeanoSucc _ q => PeanoSucc _ (PeanoSucc _ (peanoView_xO _ q))
-  end.
-
-Fixpoint peanoView_xI p (q:PeanoView p) : PeanoView (p~1) :=
-  match q in PeanoView x return PeanoView (x~1) with
-    | PeanoOne => PeanoSucc _ (PeanoSucc _ PeanoOne)
-    | PeanoSucc _ q => PeanoSucc _ (PeanoSucc _ (peanoView_xI _ q))
-  end.
-
-Fixpoint peanoView p : PeanoView p :=
-  match p return PeanoView p with
-    | 1 => PeanoOne
-    | p~0 => peanoView_xO p (peanoView p)
-    | p~1 => peanoView_xI p (peanoView p)
-  end.
-
-Definition PeanoView_iter (P:positive->Type)
-  (a:P 1) (f:forall p, P p -> P (Psucc p)) :=
-  (fix iter p (q:PeanoView p) : P p :=
-    match q in PeanoView p return P p with
-      | PeanoOne => a
-      | PeanoSucc _ q => f _ (iter _ q)
-    end).
-
-Require Import Eqdep_dec EqdepFacts.
-
-Theorem eq_dep_eq_positive :
-  forall (P:positive->Type) (p:positive) (x y:P p),
-    eq_dep positive P p x p y -> x = y.
-Proof.
-  apply eq_dep_eq_dec.
-  decide equality.
-Qed.
-
-Theorem PeanoViewUnique : forall p (q q':PeanoView p), q = q'.
-Proof.
-  intros.
-  induction q as [ | p q IHq ].
-  apply eq_dep_eq_positive.
-  cut (1=1). pattern 1 at 1 2 5, q'. destruct q'. trivial.
-  destruct p0; intros; discriminate.
-  trivial.
-  apply eq_dep_eq_positive.
-  cut (Psucc p=Psucc p). pattern (Psucc p) at 1 2 5, q'. destruct q'.
-  intro. destruct p; discriminate.
-  intro. unfold p0 in H. apply Psucc_inj in H.
-  generalize q'. rewrite H. intro.
-  rewrite (IHq q'0).
-  trivial.
-  trivial.
-Qed.
-
-Definition Prect (P:positive->Type) (a:P 1) (f:forall p, P p -> P (Psucc p))
-  (p:positive) :=
-  PeanoView_iter P a f p (peanoView p).
-
-Theorem Prect_succ : forall (P:positive->Type) (a:P 1)
-  (f:forall p, P p -> P (Psucc p)) (p:positive),
-  Prect P a f (Psucc p) = f _ (Prect P a f p).
-Proof.
-  intros.
-  unfold Prect.
-  rewrite (PeanoViewUnique _ (peanoView (Psucc p)) (PeanoSucc _ (peanoView p))).
-  trivial.
-Qed.
-
-Theorem Prect_base : forall (P:positive->Type) (a:P 1)
-  (f:forall p, P p -> P (Psucc p)), Prect P a f 1 = a.
-Proof.
-  trivial.
-Qed.
-
-Definition Prec (P:positive->Set) := Prect P.
-
-(** Peano induction *)
-
-Definition Pind (P:positive->Prop) := Prect P.
-
-(** Peano case analysis *)
-
-Theorem Pcase :
-  forall P:positive -> Prop,
-    P 1 -> (forall n:positive, P (Psucc n)) -> forall p:positive, P p.
-Proof.
-  intros; apply Pind; auto.
-Qed.
-
-(**********************************************************************)
-(** Properties of multiplication on binary positive numbers *)
-
-(** One is right neutral for multiplication *)
-
-Lemma Pmult_1_r : forall p:positive, p * 1 = p.
-Proof.
-  induction p; simpl; f_equal; auto.
-Qed.
-
-(** Successor and multiplication *)
-
-Lemma Pmult_Sn_m : forall n m : positive, (Psucc n) * m = m + n * m.
-Proof.
-  induction n as [n IHn | n IHn | ]; simpl; intro m.
-  rewrite IHn, Pplus_assoc, Pplus_diag, <-Pplus_xO; reflexivity.
-  reflexivity.
-  symmetry; apply Pplus_diag.
-Qed.
-
-(** Right reduction properties for multiplication *)
-
-Lemma Pmult_xO_permute_r : forall p q:positive, p * q~0 = (p * q)~0.
-Proof.
-  intros p q; induction p; simpl; do 2 (f_equal; auto).
-Qed.
-
-Lemma Pmult_xI_permute_r : forall p q:positive, p * q~1 = p + (p * q)~0.
-Proof.
-  intros p q; induction p as [p IHp|p IHp| ]; simpl; f_equal; auto.
-  rewrite IHp, 2 Pplus_assoc, (Pplus_comm p); reflexivity.
-Qed.
-
-(** Commutativity of multiplication *)
-
-Theorem Pmult_comm : forall p q:positive, p * q = q * p.
-Proof.
-  intros p q; induction q as [q IHq|q IHq| ]; simpl; try rewrite <- IHq;
-   auto using Pmult_xI_permute_r, Pmult_xO_permute_r, Pmult_1_r.
-Qed.
-
-(** Distributivity of multiplication over addition *)
-
-Theorem Pmult_plus_distr_l :
-  forall p q r:positive, p * (q + r) = p * q + p * r.
-Proof.
-  intros p q r; induction p as [p IHp|p IHp| ]; simpl.
-  rewrite IHp. set (m:=(p*q)~0). set (n:=(p*r)~0).
-  change ((p*q+p*r)~0) with (m+n).
-  rewrite 2 Pplus_assoc; f_equal.
-  rewrite <- 2 Pplus_assoc; f_equal.
-  apply Pplus_comm.
-  f_equal; auto.
-  reflexivity.
-Qed.
-
-Theorem Pmult_plus_distr_r :
-  forall p q r:positive, (p + q) * r = p * r + q * r.
-Proof.
-  intros p q r; do 3 rewrite Pmult_comm with (q:=r); apply Pmult_plus_distr_l.
-Qed.
-
-(** Associativity of multiplication *)
-
-Theorem Pmult_assoc : forall p q r:positive, p * (q * r) = p * q * r.
-Proof.
-  induction p as [p IHp| p IHp | ]; simpl; intros q r.
-  rewrite IHp; rewrite Pmult_plus_distr_r; reflexivity.
-  rewrite IHp; reflexivity.
-  reflexivity.
-Qed.
-
-(** Parity properties of multiplication *)
-
-Lemma Pmult_xI_mult_xO_discr : forall p q r:positive, p~1 * r <> q~0 * r.
-Proof.
-  intros p q r; induction r; try discriminate.
-  rewrite 2 Pmult_xO_permute_r; intro H; destr_eq H; auto.
-Qed.
-
-Lemma Pmult_xO_discr : forall p q:positive, p~0 * q <> q.
-Proof.
-  intros p q; induction q; try discriminate.
-  rewrite Pmult_xO_permute_r; injection; assumption.
-Qed.
-
-(** Simplification properties of multiplication *)
-
-Theorem Pmult_reg_r : forall p q r:positive, p * r = q * r -> p = q.
-Proof.
-  induction p as [p IHp| p IHp| ]; intros [q|q| ] r H;
-    reflexivity || apply (f_equal (A:=positive)) || apply False_ind.
-  apply IHp with (r~0); simpl in *;
-    rewrite 2 Pmult_xO_permute_r; apply Pplus_reg_l with (1:=H).
-  apply Pmult_xI_mult_xO_discr with (1:=H).
-  simpl in H; rewrite Pplus_comm in H; apply Pplus_no_neutral with (1:=H).
-  symmetry in H; apply Pmult_xI_mult_xO_discr with (1:=H).
-  apply IHp with (r~0); simpl; rewrite 2 Pmult_xO_permute_r; assumption.
-  apply Pmult_xO_discr with (1:= H).
-  simpl in H; symmetry in H; rewrite Pplus_comm in H;
-    apply Pplus_no_neutral with (1:=H).
-  symmetry in H; apply Pmult_xO_discr with (1:=H).
-Qed.
-
-Theorem Pmult_reg_l : forall p q r:positive, r * p = r * q -> p = q.
-Proof.
-  intros p q r H; apply Pmult_reg_r with (r:=r).
-  rewrite (Pmult_comm p), (Pmult_comm q); assumption.
-Qed.
-
-(** Inversion of multiplication *)
-
-Lemma Pmult_1_inversion_l : forall p q:positive, p * q = 1 -> p = 1.
-Proof.
-  intros [p|p| ] [q|q| ] H; destr_eq H; auto.
-Qed.
-
-(*********************************************************************)
-(** Properties of boolean equality *)
-
-Theorem Peqb_refl : forall x:positive, Peqb x x = true.
-Proof.
- induction x; auto.
-Qed.
-
-Theorem Peqb_true_eq : forall x y:positive, Peqb x y = true -> x=y.
-Proof.
- induction x; destruct y; simpl; intros; try discriminate.
- f_equal; auto.
- f_equal; auto.
- reflexivity.
-Qed.
-
-Theorem Peqb_eq : forall x y : positive, Peqb x y = true <-> x=y.
-Proof.
- split. apply Peqb_true_eq.
- intros; subst; apply Peqb_refl.
-Qed.
-
-
-(**********************************************************************)
-(** Properties of comparison on binary positive numbers *)
-
-Theorem Pcompare_refl : forall p:positive, (p ?= p) Eq = Eq.
-  induction p; auto.
-Qed.
-
-(* A generalization of Pcompare_refl *)
-
-Theorem Pcompare_refl_id : forall (p : positive) (r : comparison), (p ?= p) r = r.
-  induction p; auto.
-Qed.
-
-Theorem Pcompare_not_Eq :
-  forall p q:positive, (p ?= q) Gt <> Eq /\ (p ?= q) Lt <> Eq.
-Proof.
-  induction p as [p IHp| p IHp| ]; intros [q| q| ]; split; simpl; auto;
-    discriminate || (elim (IHp q); auto).
-Qed.
-
-Theorem Pcompare_Eq_eq : forall p q:positive, (p ?= q) Eq = Eq -> p = q.
-Proof.
-  induction p; intros [q| q| ] H; simpl in *; auto;
-   try discriminate H; try (f_equal; auto; fail).
-  destruct (Pcompare_not_Eq p q) as (H',_); elim H'; auto.
-  destruct (Pcompare_not_Eq p q) as (_,H'); elim H'; auto.
-Qed.
-
-Lemma Pcompare_eq_iff : forall p q:positive, (p ?= q) Eq = Eq <-> p = q.
-Proof.
-  split.
-  apply Pcompare_Eq_eq.
-  intros; subst; apply Pcompare_refl.
-Qed.
-
-Lemma Pcompare_Gt_Lt :
-  forall p q:positive, (p ?= q) Gt = Lt -> (p ?= q) Eq = Lt.
-Proof.
-  induction p; intros [q|q| ] H; simpl; auto; discriminate.
-Qed.
-
-Lemma Pcompare_eq_Lt :
-  forall p q : positive, (p ?= q) Eq = Lt <-> (p ?= q) Gt = Lt.
-Proof.
-  intros p q; split; [| apply Pcompare_Gt_Lt].
-  revert q; induction p; intros [q|q| ] H; simpl; auto; discriminate.
-Qed.
-
-Lemma Pcompare_Lt_Gt :
-  forall p q:positive, (p ?= q) Lt = Gt -> (p ?= q) Eq = Gt.
-Proof.
-  induction p; intros [q|q| ] H; simpl; auto; discriminate.
-Qed.
-
-Lemma Pcompare_eq_Gt :
-  forall p q : positive, (p ?= q) Eq = Gt <-> (p ?= q) Lt = Gt.
-Proof.
-  intros p q; split; [| apply Pcompare_Lt_Gt].
-  revert q; induction p; intros [q|q| ] H; simpl; auto; discriminate.
-Qed.
-
-Lemma Pcompare_Lt_Lt :
-  forall p q:positive, (p ?= q) Lt = Lt -> (p ?= q) Eq = Lt \/ p = q.
-Proof.
-  induction p as [p IHp| p IHp| ]; intros [q|q| ] H; simpl in *; auto;
-   destruct (IHp q H); subst; auto.
-Qed.
-
-Lemma Pcompare_Lt_eq_Lt :
-  forall p q:positive, (p ?= q) Lt = Lt <-> (p ?= q) Eq = Lt \/ p = q.
-Proof.
-  intros p q; split; [apply Pcompare_Lt_Lt |].
-  intros [H|H]; [|subst; apply Pcompare_refl_id].
-  revert q H; induction p; intros [q|q| ] H; simpl in *;
-  auto; discriminate.
-Qed.
-
-Lemma Pcompare_Gt_Gt :
-  forall p q:positive, (p ?= q) Gt = Gt -> (p ?= q) Eq = Gt \/ p = q.
-Proof.
-  induction p as [p IHp|p IHp| ]; intros [q|q| ] H; simpl in *; auto;
-    destruct (IHp q H); subst; auto.
-Qed.
-
-Lemma Pcompare_Gt_eq_Gt :
-  forall p q:positive, (p ?= q) Gt = Gt <-> (p ?= q) Eq = Gt \/ p = q.
-Proof.
-  intros p q; split; [apply Pcompare_Gt_Gt |].
-  intros [H|H]; [|subst; apply Pcompare_refl_id].
-  revert q H; induction p; intros [q|q| ] H; simpl in *;
-  auto; discriminate.
-Qed.
-
-Lemma Dcompare : forall r:comparison, r = Eq \/ r = Lt \/ r = Gt.
-Proof.
-  destruct r; auto.
-Qed.
-
-Ltac ElimPcompare c1 c2 :=
-  elim (Dcompare ((c1 ?= c2) Eq));
-    [ idtac | let x := fresh "H" in (intro x; case x; clear x) ].
-
-Lemma Pcompare_antisym :
-  forall (p q:positive) (r:comparison),
-    CompOpp ((p ?= q) r) = (q ?= p) (CompOpp r).
-Proof.
-  induction p as [p IHp|p IHp| ]; intros [q|q| ] r; simpl; auto;
-   rewrite IHp; auto.
-Qed.
-
-Lemma ZC1 : forall p q:positive, (p ?= q) Eq = Gt -> (q ?= p) Eq = Lt.
-Proof.
-  intros p q H; change Eq with (CompOpp Eq).
-  rewrite <- Pcompare_antisym, H; reflexivity.
-Qed.
-
-Lemma ZC2 : forall p q:positive, (p ?= q) Eq = Lt -> (q ?= p) Eq = Gt.
-Proof.
-  intros p q H; change Eq with (CompOpp Eq).
-  rewrite <- Pcompare_antisym, H; reflexivity.
-Qed.
-
-Lemma ZC3 : forall p q:positive, (p ?= q) Eq = Eq -> (q ?= p) Eq = Eq.
-Proof.
-  intros p q H; change Eq with (CompOpp Eq).
-  rewrite <- Pcompare_antisym, H; reflexivity.
-Qed.
-
-Lemma ZC4 : forall p q:positive, (p ?= q) Eq = CompOpp ((q ?= p) Eq).
-Proof.
-  intros; change Eq at 1 with (CompOpp Eq).
-  symmetry; apply Pcompare_antisym.
-Qed.
-
-Lemma Pcompare_spec : forall p q, CompSpec eq Plt p q ((p ?= q) Eq).
-Proof.
-  intros. destruct ((p ?= q) Eq) as [ ]_eqn; constructor.
-  apply Pcompare_Eq_eq; auto.
-  auto.
-  apply ZC1; auto.
-Qed.
-
-
-(** Comparison and the successor *)
-
-Lemma Pcompare_p_Sp : forall p : positive, (p ?= Psucc p) Eq = Lt.
-Proof.
-  induction p; simpl in *;
-    [ elim (Pcompare_eq_Lt p (Psucc p)); auto |
-      apply Pcompare_refl_id | reflexivity].
-Qed.
-
-Theorem Pcompare_p_Sq : forall p q : positive,
-  (p ?= Psucc q) Eq = Lt <-> (p ?= q) Eq = Lt \/ p = q.
-Proof.
-  intros p q; split.
-  (* -> *)
-  revert p q; induction p as [p IHp|p IHp| ]; intros [q|q| ] H; simpl in *;
-   try (left; reflexivity); try (right; reflexivity).
-  destruct (IHp q (Pcompare_Gt_Lt _ _ H)); subst; auto.
-  destruct (Pcompare_eq_Lt p q); auto.
-  destruct p; discriminate.
-  left; destruct (IHp q H);
-   [ elim (Pcompare_Lt_eq_Lt p q); auto | subst; apply Pcompare_refl_id].
-  destruct (Pcompare_Lt_Lt p q H); subst; auto.
-  destruct p; discriminate.
-  (* <- *)
-  intros [H|H]; [|subst; apply Pcompare_p_Sp].
-  revert q H; induction p; intros [q|q| ] H; simpl in *;
-   auto; try discriminate.
-  destruct (Pcompare_eq_Lt p (Psucc q)); auto.
-  apply Pcompare_Gt_Lt; auto.
-  destruct (Pcompare_Lt_Lt p q H); subst; auto using Pcompare_p_Sp.
-  destruct (Pcompare_Lt_eq_Lt p q); auto.
-Qed.
-
-(** 1 is the least positive number *)
-
-Lemma Pcompare_1 : forall p, ~ (p ?= 1) Eq = Lt.
-Proof.
-  destruct p; discriminate.
-Qed.
-
-(** Properties of the strict order on positive numbers *)
-
-Lemma Plt_1 : forall p, ~ p < 1.
-Proof.
- exact Pcompare_1.
-Qed.
-
-Lemma Plt_lt_succ : forall n m : positive, n < m -> n < Psucc m.
-Proof.
-  unfold Plt; intros n m H; apply <- Pcompare_p_Sq; auto.
-Qed.
-
-Lemma Plt_irrefl : forall p : positive, ~ p < p.
-Proof.
-  unfold Plt; intro p; rewrite Pcompare_refl; discriminate.
-Qed.
-
-Lemma Plt_trans : forall n m p : positive, n < m -> m < p -> n < p.
-Proof.
-  intros n m p; induction p using Pind; intros H H0.
-  elim (Plt_1 _ H0).
-  apply Plt_lt_succ.
-  destruct (Pcompare_p_Sq m p) as (H',_); destruct (H' H0); subst; auto.
-Qed.
-
-Theorem Plt_ind : forall (A : positive -> Prop) (n : positive),
-  A (Psucc n) ->
-    (forall m : positive, n < m -> A m -> A (Psucc m)) ->
-      forall m : positive, n < m -> A m.
-Proof.
-  intros A n AB AS m. induction m using Pind; intros H.
-  elim (Plt_1 _ H).
-  destruct (Pcompare_p_Sq n m) as (H',_); destruct (H' H); subst; auto.
-Qed.
-
-Lemma Ple_lteq : forall p q, p <= q <-> p < q \/ p = q.
-Proof.
-  unfold Ple, Plt. intros.
-  generalize (Pcompare_eq_iff p q).
-  destruct ((p ?= q) Eq); intuition; discriminate.
-Qed.
-
-
-(**********************************************************************)
-(** Properties of subtraction on binary positive numbers *)
-
-Lemma Ppred_minus : forall p, Ppred p = Pminus p 1.
-Proof.
-  destruct p; auto.
-Qed.
-
-Definition Ppred_mask (p : positive_mask) :=
-match p with
-| IsPos 1 => IsNul
-| IsPos q => IsPos (Ppred q)
-| IsNul => IsNeg
-| IsNeg => IsNeg
-end.
-
-Lemma Pminus_mask_succ_r :
-  forall p q : positive, Pminus_mask p (Psucc q) = Pminus_mask_carry p q.
-Proof.
-  induction p ; destruct q; simpl; f_equal; auto; destruct p; auto.
-Qed.
-
-Theorem Pminus_mask_carry_spec :
-  forall p q : positive, Pminus_mask_carry p q = Ppred_mask (Pminus_mask p q).
-Proof.
-  induction p as [p IHp|p IHp| ]; destruct q; simpl;
-   try reflexivity; try rewrite IHp;
-   destruct (Pminus_mask p q) as [|[r|r| ]|] || destruct p; auto.
-Qed.
-
-Theorem Pminus_succ_r : forall p q : positive, p - (Psucc q) = Ppred (p - q).
-Proof.
-  intros p q; unfold Pminus;
-  rewrite Pminus_mask_succ_r, Pminus_mask_carry_spec.
-  destruct (Pminus_mask p q) as [|[r|r| ]|]; auto.
-Qed.
-
-Lemma double_eq_zero_inversion :
-  forall p:positive_mask, Pdouble_mask p = IsNul -> p = IsNul.
-Proof.
-  destruct p; simpl; intros; trivial; discriminate.
-Qed.
-
-Lemma double_plus_one_zero_discr :
-  forall p:positive_mask, Pdouble_plus_one_mask p <> IsNul.
-Proof.
-  destruct p; discriminate.
-Qed.
-
-Lemma double_plus_one_eq_one_inversion :
-  forall p:positive_mask, Pdouble_plus_one_mask p = IsPos 1 -> p = IsNul.
-Proof.
-  destruct p; simpl; intros; trivial; discriminate.
-Qed.
-
-Lemma double_eq_one_discr :
-  forall p:positive_mask, Pdouble_mask p <> IsPos 1.
-Proof.
-  destruct p; discriminate.
-Qed.
-
-Theorem Pminus_mask_diag : forall p:positive, Pminus_mask p p = IsNul.
-Proof.
-  induction p as [p IHp| p IHp| ]; simpl; try rewrite IHp; auto.
-Qed.
-
-Lemma Pminus_mask_carry_diag : forall p, Pminus_mask_carry p p = IsNeg.
-Proof.
-  induction p as [p IHp| p IHp| ]; simpl; try rewrite IHp; auto.
-Qed.
-
-Lemma Pminus_mask_IsNeg : forall p q:positive,
- Pminus_mask p q = IsNeg -> Pminus_mask_carry p q = IsNeg.
-Proof.
-  induction p as [p IHp|p IHp| ]; intros [q|q| ] H; simpl in *; auto;
-   try discriminate; unfold Pdouble_mask, Pdouble_plus_one_mask in H;
-   specialize IHp with q.
-  destruct (Pminus_mask p q); try discriminate; rewrite IHp; auto.
-  destruct (Pminus_mask p q); simpl; auto; try discriminate.
-  destruct (Pminus_mask_carry p q); simpl; auto; try discriminate.
-  destruct (Pminus_mask p q); try discriminate; rewrite IHp; auto.
-Qed.
-
-Lemma ZL10 :
-  forall p q:positive,
-    Pminus_mask p q = IsPos 1 -> Pminus_mask_carry p q = IsNul.
-Proof.
-  induction p; intros [q|q| ] H; simpl in *; try discriminate.
-  elim (double_eq_one_discr _ H).
-  rewrite (double_plus_one_eq_one_inversion _ H); auto.
-  rewrite (double_plus_one_eq_one_inversion _ H); auto.
-  elim (double_eq_one_discr _ H).
-  destruct p; simpl; auto; discriminate.
-Qed.
-
-(** Properties of subtraction valid only for x>y *)
-
-Lemma Pminus_mask_Gt :
-  forall p q:positive,
-    (p ?= q) Eq = Gt ->
-    exists h : positive,
-      Pminus_mask p q = IsPos h /\
-      q + h = p /\ (h = 1 \/ Pminus_mask_carry p q = IsPos (Ppred h)).
-Proof.
-  induction p as [p IHp| p IHp| ]; intros [q| q| ] H; simpl in *;
-   try discriminate H.
-  (* p~1, q~1 *)
-  destruct (IHp q H) as (r & U & V & W); exists (r~0); rewrite ?U, ?V; auto.
-  repeat split; auto; right.
-  destruct (ZL11 r) as [EQ|NE]; [|destruct W as [|W]; [elim NE; auto|]].
-  rewrite ZL10; subst; auto.
-  rewrite W; simpl; destruct r; auto; elim NE; auto.
-  (* p~1, q~0 *)
-  destruct (Pcompare_Gt_Gt _ _ H) as [H'|H']; clear H; rename H' into H.
-  destruct (IHp q H) as (r & U & V & W); exists (r~1); rewrite ?U, ?V; auto.
-  exists 1; subst; rewrite Pminus_mask_diag; auto.
-  (* p~1, 1 *)
-  exists (p~0); auto.
-  (* p~0, q~1 *)
-  destruct (IHp q (Pcompare_Lt_Gt _ _ H)) as (r & U & V & W).
-  destruct (ZL11 r) as [EQ|NE]; [|destruct W as [|W]; [elim NE; auto|]].
-  exists 1; subst; rewrite ZL10, Pplus_one_succ_r; auto.
-  exists ((Ppred r)~1); rewrite W, Pplus_carry_pred_eq_plus, V; auto.
-  (* p~0, q~0 *)
-  destruct (IHp q H) as (r & U & V & W); exists (r~0); rewrite ?U, ?V; auto.
-  repeat split; auto; right.
-  destruct (ZL11 r) as [EQ|NE]; [|destruct W as [|W]; [elim NE; auto|]].
-  rewrite ZL10; subst; auto.
-  rewrite W; simpl; destruct r; auto; elim NE; auto.
-  (* p~0, 1 *)
-  exists (Pdouble_minus_one p); repeat split; destruct p; simpl; auto.
-  rewrite Psucc_o_double_minus_one_eq_xO; auto.
-Qed.
-
-Theorem Pplus_minus :
-  forall p q:positive, (p ?= q) Eq = Gt -> q + (p - q) = p.
-Proof.
-  intros p q H; destruct (Pminus_mask_Gt p q H) as (r & U & V & _).
-  unfold Pminus; rewrite U; simpl; auto.
-Qed.
-
-(** When x<y, the substraction of x by y returns 1 *)
-
-Lemma Pminus_mask_Lt : forall p q:positive, p<q -> Pminus_mask p q = IsNeg.
-Proof.
-  unfold Plt; induction p as [p IHp|p IHp| ]; destruct q; simpl; intros;
-   try discriminate; try rewrite IHp; auto.
-  apply Pcompare_Gt_Lt; auto.
-  destruct (Pcompare_Lt_Lt _ _ H).
-  rewrite Pminus_mask_IsNeg; simpl; auto.
-  subst; rewrite Pminus_mask_carry_diag; auto.
-Qed.
-
-Lemma Pminus_Lt : forall p q:positive, p<q -> p-q = 1.
-Proof.
-  intros; unfold Plt, Pminus; rewrite Pminus_mask_Lt; auto.
-Qed.
-
-(** The substraction of x by x returns 1 *)
-
-Lemma Pminus_Eq : forall p:positive, p-p = 1.
-Proof.
- intros; unfold Pminus; rewrite Pminus_mask_diag; auto.
-Qed.
-
-(** Number of digits in a number *)
-
-Fixpoint Psize (p:positive) : nat :=
-  match p with
-    | 1 => S O
-    | p~1 => S (Psize p)
-    | p~0 => S (Psize p)
-  end.
-
-Lemma Psize_monotone : forall p q, (p?=q) Eq = Lt -> (Psize p <= Psize q)%nat.
-Proof.
-  assert (le0 : forall n, (0<=n)%nat) by (induction n; auto).
-  assert (leS : forall n m, (n<=m -> S n <= S m)%nat) by (induction 1; auto).
-  induction p; destruct q; simpl; auto; intros; try discriminate.
-  intros; generalize (Pcompare_Gt_Lt _ _ H); auto.
-  intros; destruct (Pcompare_Lt_Lt _ _ H); auto; subst; auto.
-Qed.
-
-
-
-
-
diff --git a/theories/NArith/NArith.v b/theories/NArith/NArith.v
index 48f78c50..d0664d37 100644
--- a/theories/NArith/NArith.v
+++ b/theories/NArith/NArith.v
@@ -1,18 +1,33 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: NArith.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Library for binary natural numbers *)
 
+Require Export BinNums.
 Require Export BinPos.
 Require Export BinNat.
 Require Export Nnat.
+Require Export Ndiv_def.
+Require Export Nsqrt_def.
+Require Export Ngcd_def.
 Require Export Ndigits.
-
 Require Export NArithRing.
+
+(** [N] contains an [order] tactic for natural numbers *)
+
+(** Note that [N.order] is domain-agnostic: it will not prove
+    [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
+
+Local Open Scope N_scope.
+
+Section TestOrder.
+ Let test : forall x y, x<=y -> y<=x -> x=y.
+ Proof.
+ N.order.
+ Qed.
+End TestOrder.
diff --git a/theories/NArith/NOrderedType.v b/theories/NArith/NOrderedType.v
deleted file mode 100644
index f1ab4b23..00000000
--- a/theories/NArith/NOrderedType.v
+++ /dev/null
@@ -1,60 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-Require Import BinNat Equalities Orders OrdersTac.
-
-Local Open Scope N_scope.
-
-(** * DecidableType structure for [N] binary natural numbers *)
-
-Module N_as_UBE <: UsualBoolEq.
- Definition t := N.
- Definition eq := @eq N.
- Definition eqb := Neqb.
- Definition eqb_eq := Neqb_eq.
-End N_as_UBE.
-
-Module N_as_DT <: UsualDecidableTypeFull := Make_UDTF N_as_UBE.
-
-(** Note that the last module fulfills by subtyping many other
-    interfaces, such as [DecidableType] or [EqualityType]. *)
-
-
-
-(** * OrderedType structure for [N] numbers *)
-
-Module N_as_OT <: OrderedTypeFull.
- Include N_as_DT.
- Definition lt := Nlt.
- Definition le := Nle.
- Definition compare := Ncompare.
-
- Instance lt_strorder : StrictOrder Nlt.
- Proof. split; [ exact Nlt_irrefl | exact Nlt_trans ]. Qed.
-
- Instance lt_compat : Proper (Logic.eq==>Logic.eq==>iff) Nlt.
- Proof. repeat red; intros; subst; auto. Qed.
-
- Definition le_lteq := Nle_lteq.
- Definition compare_spec := Ncompare_spec.
-
-End N_as_OT.
-
-(** Note that [N_as_OT] can also be seen as a [UsualOrderedType]
-   and a [OrderedType] (and also as a [DecidableType]). *)
-
-
-
-(** * An [order] tactic for [N] numbers *)
-
-Module NOrder := OTF_to_OrderTac N_as_OT.
-Ltac n_order := NOrder.order.
-
-(** Note that [n_order] is domain-agnostic: it will not prove
-    [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
-
diff --git a/theories/NArith/Ndec.v b/theories/NArith/Ndec.v
index 0e1c3de0..f8db7548 100644
--- a/theories/NArith/Ndec.v
+++ b/theories/NArith/Ndec.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ndec.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Bool.
 Require Import Sumbool.
 Require Import Arith.
@@ -17,315 +15,238 @@ Require Import Pnat.
 Require Import Nnat.
 Require Import Ndigits.
 
-(** A boolean equality over [N] *)
+Local Open Scope N_scope.
 
-Notation Peqb := Peqb (only parsing). (* Now in [BinPos] *)
-Notation Neqb := Neqb (only parsing). (* Now in [BinNat] *)
+(** Obsolete results about boolean comparisons over [N],
+    kept for compatibility with IntMap and SMC. *)
 
-Notation Peqb_correct := Peqb_refl (only parsing).
+Notation Peqb := Pos.eqb (compat "8.3").
+Notation Neqb := N.eqb (compat "8.3").
+Notation Peqb_correct := Pos.eqb_refl (compat "8.3").
+Notation Neqb_correct := N.eqb_refl (compat "8.3").
+Notation Neqb_comm := N.eqb_sym (compat "8.3").
 
-Lemma Peqb_complete : forall p p', Peqb p p' = true -> p = p'.
-Proof.
-  intros. now apply (Peqb_eq p p').
-Qed.
+Lemma Peqb_complete p p' : Pos.eqb p p' = true -> p = p'.
+Proof. now apply Pos.eqb_eq. Qed.
 
-Lemma Peqb_Pcompare : forall p p', Peqb p p' = true -> Pcompare p p' Eq = Eq.
-Proof.
-  intros. now rewrite Pcompare_eq_iff, <- Peqb_eq.
-Qed.
-
-Lemma Pcompare_Peqb : forall p p', Pcompare p p' Eq = Eq -> Peqb p p' = true.
-Proof.
-  intros; now rewrite Peqb_eq, <- Pcompare_eq_iff.
-Qed.
+Lemma Peqb_Pcompare p p' : Pos.eqb p p' = true -> Pos.compare p p' = Eq.
+Proof. now rewrite Pos.compare_eq_iff, <- Pos.eqb_eq. Qed.
 
-Lemma Neqb_correct : forall n, Neqb n n = true.
-Proof.
-  intros; now rewrite Neqb_eq.
-Qed.
+Lemma Pcompare_Peqb p p' : Pos.compare p p' = Eq -> Pos.eqb p p' = true.
+Proof. now rewrite Pos.eqb_eq, <- Pos.compare_eq_iff. Qed.
 
-Lemma Neqb_Ncompare : forall n n', Neqb n n' = true -> Ncompare n n' = Eq.
-Proof.
-  intros; now rewrite Ncompare_eq_correct, <- Neqb_eq.
-Qed.
+Lemma Neqb_Ncompare n n' : N.eqb n n' = true -> N.compare n n' = Eq.
+Proof. now rewrite N.compare_eq_iff, <- N.eqb_eq. Qed.
 
-Lemma Ncompare_Neqb : forall n n', Ncompare n n' = Eq -> Neqb n n' = true.
-Proof.
-  intros; now rewrite Neqb_eq, <- Ncompare_eq_correct.
-Qed.
+Lemma Ncompare_Neqb n n' : N.compare n n' = Eq -> N.eqb n n' = true.
+Proof. now rewrite N.eqb_eq, <- N.compare_eq_iff. Qed.
 
-Lemma Neqb_complete : forall a a', Neqb a a' = true -> a = a'.
-Proof.
-  intros; now rewrite <- Neqb_eq.
-Qed.
+Lemma Neqb_complete n n' : N.eqb n n' = true -> n = n'.
+Proof. now apply N.eqb_eq. Qed.
 
-Lemma Neqb_comm : forall a a', Neqb a a' = Neqb a' a.
+Lemma Nxor_eq_true n n' : N.lxor n n' = 0 -> N.eqb n n' = true.
 Proof.
-  intros; apply eq_true_iff_eq. rewrite 2 Neqb_eq; auto with *.
+  intro H. apply N.lxor_eq in H. subst. apply N.eqb_refl.
 Qed.
 
-Lemma Nxor_eq_true :
- forall a a', Nxor a a' = N0 -> Neqb a a' = true.
-Proof.
-  intros. rewrite (Nxor_eq a a' H). apply Neqb_correct.
-Qed.
+Ltac eqb2eq := rewrite <- ?not_true_iff_false in *; rewrite ?N.eqb_eq in *.
 
-Lemma Nxor_eq_false :
- forall a a' p, Nxor a a' = Npos p -> Neqb a a' = false.
+Lemma Nxor_eq_false n n' p :
+  N.lxor n n' = N.pos p -> N.eqb n n' = false.
 Proof.
-  intros. elim (sumbool_of_bool (Neqb a a')). intro H0.
-  rewrite (Neqb_complete a a' H0) in H.
-  rewrite (Nxor_nilpotent a') in H. discriminate H.
-  trivial.
+  intros. eqb2eq. intro. subst. now rewrite N.lxor_nilpotent in *.
 Qed.
 
-Lemma Nodd_not_double :
- forall a,
-   Nodd a -> forall a0, Neqb (Ndouble a0) a = false.
+Lemma Nodd_not_double a :
+  Nodd a -> forall a0, N.eqb (N.double a0) a = false.
 Proof.
-  intros. elim (sumbool_of_bool (Neqb (Ndouble a0) a)). intro H0.
-  rewrite <- (Neqb_complete _ _ H0) in H.
-  unfold Nodd in H.
-  rewrite (Ndouble_bit0 a0) in H. discriminate H.
-  trivial.
+  intros. eqb2eq. intros <-.
+  unfold Nodd in *. now rewrite Ndouble_bit0 in *.
 Qed.
 
-Lemma Nnot_div2_not_double :
- forall a a0,
-   Neqb (Ndiv2 a) a0 = false -> Neqb a (Ndouble a0) = false.
+Lemma Nnot_div2_not_double a a0 :
+  N.eqb (N.div2 a) a0 = false -> N.eqb a (N.double a0) = false.
 Proof.
-  intros. elim (sumbool_of_bool (Neqb (Ndouble a0) a)). intro H0.
-  rewrite <- (Neqb_complete _ _ H0) in H. rewrite (Ndouble_div2 a0) in H.
-  rewrite (Neqb_correct a0) in H. discriminate H.
-  intro. rewrite Neqb_comm. assumption.
+  intros H. eqb2eq. contradict H. subst. apply N.div2_double.
 Qed.
 
-Lemma Neven_not_double_plus_one :
- forall a,
-   Neven a -> forall a0, Neqb (Ndouble_plus_one a0) a = false.
+Lemma Neven_not_double_plus_one a :
+  Neven a -> forall a0, N.eqb (N.succ_double a0) a = false.
 Proof.
-  intros. elim (sumbool_of_bool (Neqb (Ndouble_plus_one a0) a)). intro H0.
-  rewrite <- (Neqb_complete _ _ H0) in H.
-  unfold Neven in H.
-  rewrite (Ndouble_plus_one_bit0 a0) in H.
-  discriminate H.
-  trivial.
+  intros. eqb2eq. intros <-.
+  unfold Neven in *. now rewrite Ndouble_plus_one_bit0 in *.
 Qed.
 
-Lemma Nnot_div2_not_double_plus_one :
- forall a a0,
-   Neqb (Ndiv2 a) a0 = false -> Neqb (Ndouble_plus_one a0) a = false.
+Lemma Nnot_div2_not_double_plus_one a a0 :
+  N.eqb (N.div2 a) a0 = false -> N.eqb (N.succ_double a0) a = false.
 Proof.
-  intros. elim (sumbool_of_bool (Neqb a (Ndouble_plus_one a0))). intro H0.
-  rewrite (Neqb_complete _ _ H0) in H. rewrite (Ndouble_plus_one_div2 a0) in H.
-  rewrite (Neqb_correct a0) in H. discriminate H.
-  intro H0. rewrite Neqb_comm. assumption.
+  intros H. eqb2eq. contradict H. subst. apply N.div2_succ_double.
 Qed.
 
-Lemma Nbit0_neq :
- forall a a',
-   Nbit0 a = false -> Nbit0 a' = true -> Neqb a a' = false.
+Lemma Nbit0_neq a a' :
+  N.odd a = false -> N.odd a' = true -> N.eqb a a' = false.
 Proof.
-  intros. elim (sumbool_of_bool (Neqb a a')). intro H1.
-  rewrite (Neqb_complete _ _ H1) in H.
-  rewrite H in H0. discriminate H0.
-  trivial.
+  intros. eqb2eq. now intros <-.
 Qed.
 
-Lemma Ndiv2_eq :
- forall a a', Neqb a a' = true -> Neqb (Ndiv2 a) (Ndiv2 a') = true.
+Lemma Ndiv2_eq a a' :
+  N.eqb a a' = true -> N.eqb (N.div2 a) (N.div2 a') = true.
 Proof.
-  intros. cut (a = a'). intros. rewrite H0. apply Neqb_correct.
-  apply Neqb_complete. exact H.
+  intros. eqb2eq. now subst.
 Qed.
 
-Lemma Ndiv2_neq :
- forall a a',
-   Neqb (Ndiv2 a) (Ndiv2 a') = false -> Neqb a a' = false.
+Lemma Ndiv2_neq a a' :
+  N.eqb (N.div2 a) (N.div2 a') = false -> N.eqb a a' = false.
 Proof.
-  intros. elim (sumbool_of_bool (Neqb a a')). intro H0.
-  rewrite (Neqb_complete _ _ H0) in H.
-  rewrite (Neqb_correct (Ndiv2 a')) in H. discriminate H.
-  trivial.
+  intros H. eqb2eq. contradict H. now subst.
 Qed.
 
-Lemma Ndiv2_bit_eq :
- forall a a',
-   Nbit0 a = Nbit0 a' -> Ndiv2 a = Ndiv2 a' -> a = a'.
+Lemma Ndiv2_bit_eq a a' :
+  N.odd a = N.odd a' -> N.div2 a = N.div2 a' -> a = a'.
 Proof.
-  intros. apply Nbit_faithful. unfold eqf in |- *. destruct n.
-  rewrite Nbit0_correct. rewrite Nbit0_correct. assumption.
-  rewrite <- Ndiv2_correct. rewrite <- Ndiv2_correct.
-  rewrite H0. reflexivity.
+  intros H H'; now rewrite (N.div2_odd a), (N.div2_odd a'), H, H'.
 Qed.
 
-Lemma Ndiv2_bit_neq :
- forall a a',
-   Neqb a a' = false ->
-   Nbit0 a = Nbit0 a' -> Neqb (Ndiv2 a) (Ndiv2 a') = false.
+Lemma Ndiv2_bit_neq a a' :
+  N.eqb a a' = false ->
+   N.odd a = N.odd a' -> N.eqb (N.div2 a) (N.div2 a') = false.
 Proof.
-  intros. elim (sumbool_of_bool (Neqb (Ndiv2 a) (Ndiv2 a'))). intro H1.
-  rewrite (Ndiv2_bit_eq _ _ H0 (Neqb_complete _ _ H1)) in H.
-  rewrite (Neqb_correct a') in H. discriminate H.
-  trivial.
+  intros H H'. eqb2eq. contradict H. now apply Ndiv2_bit_eq.
 Qed.
 
-Lemma Nneq_elim :
- forall a a',
-   Neqb a a' = false ->
-   Nbit0 a = negb (Nbit0 a') \/
-   Neqb (Ndiv2 a) (Ndiv2 a') = false.
+Lemma Nneq_elim a a' :
+   N.eqb a a' = false ->
+   N.odd a = negb (N.odd a') \/
+   N.eqb (N.div2 a) (N.div2 a') = false.
 Proof.
-  intros. cut (Nbit0 a = Nbit0 a' \/ Nbit0 a = negb (Nbit0 a')).
+  intros. cut (N.odd a = N.odd a' \/ N.odd a = negb (N.odd a')).
   intros. elim H0. intro. right. apply Ndiv2_bit_neq. assumption.
   assumption.
   intro. left. assumption.
-  case (Nbit0 a); case (Nbit0 a'); auto.
+  case (N.odd a), (N.odd a'); auto.
 Qed.
 
-Lemma Ndouble_or_double_plus_un :
- forall a,
-   {a0 : N | a = Ndouble a0} + {a1 : N | a = Ndouble_plus_one a1}.
+Lemma Ndouble_or_double_plus_un a :
+   {a0 : N | a = N.double a0} + {a1 : N | a = N.succ_double a1}.
 Proof.
-  intro. elim (sumbool_of_bool (Nbit0 a)). intro H. right. split with (Ndiv2 a).
-  rewrite (Ndiv2_double_plus_one a H). reflexivity.
-  intro H. left. split with (Ndiv2 a). rewrite (Ndiv2_double a H). reflexivity.
+  elim (sumbool_of_bool (N.odd a)); intros H; [right|left];
+    exists (N.div2 a); symmetry;
+    apply Ndiv2_double_plus_one || apply Ndiv2_double; auto.
 Qed.
 
-(** A boolean order on [N] *)
+(** An inefficient boolean order on [N]. Please use [N.leb] instead now. *)
 
-Definition Nleb (a b:N) := leb (nat_of_N a) (nat_of_N b).
+Definition Nleb (a b:N) := leb (N.to_nat a) (N.to_nat b).
 
-Lemma Nleb_Nle : forall a b, Nleb a b = true <-> Nle a b.
+Lemma Nleb_alt a b : Nleb a b = N.leb a b.
 Proof.
- intros; unfold Nle; rewrite nat_of_Ncompare.
- unfold Nleb; apply leb_compare.
+ unfold Nleb.
+ now rewrite eq_iff_eq_true, N.leb_le, leb_compare, <- N2Nat.inj_compare.
 Qed.
 
-Lemma Nleb_refl : forall a, Nleb a a = true.
-Proof.
-  intro. unfold Nleb in |- *. apply leb_correct. apply le_n.
-Qed.
+Lemma Nleb_Nle a b : Nleb a b = true <-> a <= b.
+Proof. now rewrite Nleb_alt, N.leb_le. Qed.
 
-Lemma Nleb_antisym :
- forall a b, Nleb a b = true -> Nleb b a = true -> a = b.
-Proof.
-  unfold Nleb in |- *. intros. rewrite <- (N_of_nat_of_N a). rewrite <- (N_of_nat_of_N b).
-  rewrite (le_antisym _ _ (leb_complete _ _ H) (leb_complete _ _ H0)). reflexivity.
-Qed.
+Lemma Nleb_refl a : Nleb a a = true.
+Proof. rewrite Nleb_Nle; apply N.le_refl. Qed.
 
-Lemma Nleb_trans :
- forall a b c, Nleb a b = true -> Nleb b c = true -> Nleb a c = true.
-Proof.
-  unfold Nleb in |- *. intros. apply leb_correct. apply le_trans with (m := nat_of_N b).
-  apply leb_complete. assumption.
-  apply leb_complete. assumption.
-Qed.
+Lemma Nleb_antisym a b : Nleb a b = true -> Nleb b a = true -> a = b.
+Proof. rewrite !Nleb_Nle. apply N.le_antisymm. Qed.
 
-Lemma Nleb_ltb_trans :
- forall a b c,
-   Nleb a b = true -> Nleb c b = false -> Nleb c a = false.
+Lemma Nleb_trans a b c : Nleb a b = true -> Nleb b c = true -> Nleb a c = true.
+Proof. rewrite !Nleb_Nle. apply N.le_trans. Qed.
+
+Lemma Nleb_ltb_trans a b c :
+  Nleb a b = true -> Nleb c b = false -> Nleb c a = false.
 Proof.
-  unfold Nleb in |- *. intros. apply leb_correct_conv. apply le_lt_trans with (m := nat_of_N b).
+  unfold Nleb. intros. apply leb_correct_conv.
+  apply le_lt_trans with (m := N.to_nat b).
   apply leb_complete. assumption.
   apply leb_complete_conv. assumption.
 Qed.
 
-Lemma Nltb_leb_trans :
- forall a b c,
-   Nleb b a = false -> Nleb b c = true -> Nleb c a = false.
+Lemma Nltb_leb_trans a b c :
+  Nleb b a = false -> Nleb b c = true -> Nleb c a = false.
 Proof.
-  unfold Nleb in |- *. intros. apply leb_correct_conv. apply lt_le_trans with (m := nat_of_N b).
+  unfold Nleb. intros. apply leb_correct_conv.
+  apply lt_le_trans with (m := N.to_nat b).
   apply leb_complete_conv. assumption.
   apply leb_complete. assumption.
 Qed.
 
-Lemma Nltb_trans :
- forall a b c,
-   Nleb b a = false -> Nleb c b = false -> Nleb c a = false.
+Lemma Nltb_trans a b c :
+  Nleb b a = false -> Nleb c b = false -> Nleb c a = false.
 Proof.
-  unfold Nleb in |- *. intros. apply leb_correct_conv. apply lt_trans with (m := nat_of_N b).
+  unfold Nleb. intros. apply leb_correct_conv.
+  apply lt_trans with (m := N.to_nat b).
   apply leb_complete_conv. assumption.
   apply leb_complete_conv. assumption.
 Qed.
 
-Lemma Nltb_leb_weak : forall a b:N, Nleb b a = false -> Nleb a b = true.
+Lemma Nltb_leb_weak a b : Nleb b a = false -> Nleb a b = true.
 Proof.
-  unfold Nleb in |- *. intros. apply leb_correct. apply lt_le_weak.
+  unfold Nleb. intros. apply leb_correct. apply lt_le_weak.
   apply leb_complete_conv. assumption.
 Qed.
 
-Lemma Nleb_double_mono :
- forall a b,
-   Nleb a b = true -> Nleb (Ndouble a) (Ndouble b) = true.
+Lemma Nleb_double_mono a b :
+  Nleb a b = true -> Nleb (N.double a) (N.double b) = true.
 Proof.
-  unfold Nleb in |- *. intros. rewrite nat_of_Ndouble. rewrite nat_of_Ndouble. apply leb_correct.
-  simpl in |- *. apply plus_le_compat. apply leb_complete. assumption.
-  apply plus_le_compat. apply leb_complete. assumption.
-  apply le_n.
+  unfold Nleb. intros. rewrite !N2Nat.inj_double. apply leb_correct.
+  apply mult_le_compat_l. now apply leb_complete.
 Qed.
 
-Lemma Nleb_double_plus_one_mono :
- forall a b,
-   Nleb a b = true ->
-   Nleb (Ndouble_plus_one a) (Ndouble_plus_one b) = true.
+Lemma Nleb_double_plus_one_mono a b :
+  Nleb a b = true ->
+   Nleb (N.succ_double a) (N.succ_double b) = true.
 Proof.
-  unfold Nleb in |- *. intros. rewrite nat_of_Ndouble_plus_one. rewrite nat_of_Ndouble_plus_one.
-  apply leb_correct. apply le_n_S. simpl in |- *. apply plus_le_compat. apply leb_complete.
-  assumption.
-  apply plus_le_compat. apply leb_complete. assumption.
-  apply le_n.
+  unfold Nleb. intros. rewrite !N2Nat.inj_succ_double. apply leb_correct.
+  apply le_n_S, mult_le_compat_l. now apply leb_complete.
 Qed.
 
-Lemma Nleb_double_mono_conv :
- forall a b,
-   Nleb (Ndouble a) (Ndouble b) = true -> Nleb a b = true.
+Lemma Nleb_double_mono_conv a b :
+  Nleb (N.double a) (N.double b) = true -> Nleb a b = true.
 Proof.
-  unfold Nleb in |- *. intros a b. rewrite nat_of_Ndouble. rewrite nat_of_Ndouble. intro.
-  apply leb_correct. apply (mult_S_le_reg_l 1). apply leb_complete. assumption.
+  unfold Nleb. rewrite !N2Nat.inj_double. intro. apply leb_correct.
+  apply (mult_S_le_reg_l 1). now apply leb_complete.
 Qed.
 
-Lemma Nleb_double_plus_one_mono_conv :
- forall a b,
-   Nleb (Ndouble_plus_one a) (Ndouble_plus_one b) = true ->
+Lemma Nleb_double_plus_one_mono_conv a b :
+  Nleb (N.succ_double a) (N.succ_double b) = true ->
    Nleb a b = true.
 Proof.
-  unfold Nleb in |- *. intros a b. rewrite nat_of_Ndouble_plus_one. rewrite nat_of_Ndouble_plus_one.
-  intro. apply leb_correct. apply (mult_S_le_reg_l 1). apply le_S_n. apply leb_complete.
-  assumption.
+  unfold Nleb. rewrite !N2Nat.inj_succ_double. intro. apply leb_correct.
+  apply (mult_S_le_reg_l 1). apply le_S_n. now apply leb_complete.
 Qed.
 
-Lemma Nltb_double_mono :
- forall a b,
-   Nleb a b = false -> Nleb (Ndouble a) (Ndouble b) = false.
+Lemma Nltb_double_mono a b :
+   Nleb a b = false -> Nleb (N.double a) (N.double b) = false.
 Proof.
-  intros. elim (sumbool_of_bool (Nleb (Ndouble a) (Ndouble b))). intro H0.
+  intros. elim (sumbool_of_bool (Nleb (N.double a) (N.double b))). intro H0.
   rewrite (Nleb_double_mono_conv _ _ H0) in H. discriminate H.
   trivial.
 Qed.
 
-Lemma Nltb_double_plus_one_mono :
- forall a b,
-   Nleb a b = false ->
-   Nleb (Ndouble_plus_one a) (Ndouble_plus_one b) = false.
+Lemma Nltb_double_plus_one_mono a b :
+  Nleb a b = false ->
+   Nleb (N.succ_double a) (N.succ_double b) = false.
 Proof.
-  intros. elim (sumbool_of_bool (Nleb (Ndouble_plus_one a) (Ndouble_plus_one b))). intro H0.
+  intros. elim (sumbool_of_bool (Nleb (N.succ_double a) (N.succ_double b))).
+  intro H0.
   rewrite (Nleb_double_plus_one_mono_conv _ _ H0) in H. discriminate H.
   trivial.
 Qed.
 
-Lemma Nltb_double_mono_conv :
- forall a b,
-   Nleb (Ndouble a) (Ndouble b) = false -> Nleb a b = false.
+Lemma Nltb_double_mono_conv a b :
+  Nleb (N.double a) (N.double b) = false -> Nleb a b = false.
 Proof.
-  intros. elim (sumbool_of_bool (Nleb a b)). intro H0. rewrite (Nleb_double_mono _ _ H0) in H.
-  discriminate H.
+  intros. elim (sumbool_of_bool (Nleb a b)). intro H0.
+  rewrite (Nleb_double_mono _ _ H0) in H. discriminate H.
   trivial.
 Qed.
 
-Lemma Nltb_double_plus_one_mono_conv :
- forall a b,
-   Nleb (Ndouble_plus_one a) (Ndouble_plus_one b) = false ->
+Lemma Nltb_double_plus_one_mono_conv a b :
+  Nleb (N.succ_double a) (N.succ_double b) = false ->
    Nleb a b = false.
 Proof.
   intros. elim (sumbool_of_bool (Nleb a b)). intro H0.
@@ -333,110 +254,52 @@ Proof.
   trivial.
 Qed.
 
-(* Nleb and Ncompare *)
+(* Nleb and N.compare *)
 
-(* NB: No need to prove that Nleb a b = true <-> Ncompare a b <> Gt,
+(* NB: No need to prove that Nleb a b = true <-> N.compare a b <> Gt,
    this statement is in fact Nleb_Nle! *)
 
-Lemma Nltb_Ncompare : forall a b,
- Nleb a b = false <-> Ncompare a b = Gt.
+Lemma Nltb_Ncompare a b : Nleb a b = false <-> N.compare a b = Gt.
 Proof.
- intros.
- assert (IFF : forall x:bool, x = false <-> ~ x = true)
-   by (destruct x; intuition).
- rewrite IFF, Nleb_Nle; unfold Nle.
- destruct (Ncompare a b); split; intro H; auto;
-  elim H; discriminate.
+  now rewrite N.compare_nle_iff, <- Nleb_Nle, not_true_iff_false.
 Qed.
 
-Lemma Ncompare_Gt_Nltb : forall a b,
- Ncompare a b = Gt -> Nleb a b = false.
-Proof.
- intros; apply <- Nltb_Ncompare; auto.
-Qed.
+Lemma Ncompare_Gt_Nltb a b : N.compare a b = Gt -> Nleb a b = false.
+Proof. apply <- Nltb_Ncompare; auto. Qed.
 
-Lemma Ncompare_Lt_Nltb : forall a b,
- Ncompare a b = Lt -> Nleb b a = false.
+Lemma Ncompare_Lt_Nltb a b : N.compare a b = Lt -> Nleb b a = false.
 Proof.
- intros a b H.
- rewrite Nltb_Ncompare, <- Ncompare_antisym, H; auto.
+ intros H. rewrite Nltb_Ncompare, N.compare_antisym, H; auto.
 Qed.
 
-(* An alternate [min] function over [N] *)
-
-Definition Nmin' (a b:N) := if Nleb a b then a else b.
-
-Lemma Nmin_Nmin' : forall a b, Nmin a b = Nmin' a b.
-Proof.
- unfold Nmin, Nmin', Nleb; intros.
- rewrite nat_of_Ncompare.
- generalize (leb_compare (nat_of_N a) (nat_of_N b));
- destruct (nat_compare (nat_of_N a) (nat_of_N b));
- destruct (leb (nat_of_N a) (nat_of_N b)); intuition.
- lapply H1; intros; discriminate.
- lapply H1; intros; discriminate.
-Qed.
+(* Old results about [N.min] *)
 
-Lemma Nmin_choice : forall a b, {Nmin a b = a} + {Nmin a b = b}.
-Proof.
-  unfold Nmin in *; intros; destruct (Ncompare a b); auto.
-Qed.
+Notation Nmin_choice := N.min_dec (compat "8.3").
 
-Lemma Nmin_le_1 : forall a b, Nleb (Nmin a b) a = true.
-Proof.
-  intros; rewrite Nmin_Nmin'.
-  unfold Nmin'; elim (sumbool_of_bool (Nleb a b)). intro H. rewrite H.
-  apply Nleb_refl.
-  intro H. rewrite H. apply Nltb_leb_weak. assumption.
-Qed.
+Lemma Nmin_le_1 a b : Nleb (N.min a b) a = true.
+Proof. rewrite Nleb_Nle. apply N.le_min_l. Qed.
 
-Lemma Nmin_le_2 : forall a b, Nleb (Nmin a b) b = true.
-Proof.
-  intros; rewrite Nmin_Nmin'.
-  unfold Nmin'; elim (sumbool_of_bool (Nleb a b)). intro H. rewrite H. assumption.
-  intro H. rewrite H. apply Nleb_refl.
-Qed.
+Lemma Nmin_le_2 a b : Nleb (N.min a b) b = true.
+Proof. rewrite Nleb_Nle. apply N.le_min_r. Qed.
 
-Lemma Nmin_le_3 :
- forall a b c, Nleb a (Nmin b c) = true -> Nleb a b = true.
-Proof.
-  intros; rewrite Nmin_Nmin' in *.
-  unfold Nmin' in *; elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H.
-  assumption.
-  intro H0. rewrite H0 in H. apply Nltb_leb_weak. apply Nleb_ltb_trans with (b := c); assumption.
-Qed.
+Lemma Nmin_le_3 a b c : Nleb a (N.min b c) = true -> Nleb a b = true.
+Proof. rewrite !Nleb_Nle. apply N.min_glb_l. Qed.
 
-Lemma Nmin_le_4 :
- forall a b c, Nleb a (Nmin b c) = true -> Nleb a c = true.
-Proof.
-  intros; rewrite Nmin_Nmin' in *.
-  unfold Nmin' in *; elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H.
-  apply Nleb_trans with (b := b); assumption.
-  intro H0. rewrite H0 in H. assumption.
-Qed.
+Lemma Nmin_le_4 a b c : Nleb a (N.min b c) = true -> Nleb a c = true.
+Proof. rewrite !Nleb_Nle. apply N.min_glb_r. Qed.
 
-Lemma Nmin_le_5 :
- forall a b c,
-   Nleb a b = true -> Nleb a c = true -> Nleb a (Nmin b c) = true.
-Proof.
-  intros. elim (Nmin_choice b c). intro H1. rewrite H1. assumption.
-  intro H1. rewrite H1. assumption.
-Qed.
+Lemma Nmin_le_5 a b c :
+   Nleb a b = true -> Nleb a c = true -> Nleb a (N.min b c) = true.
+Proof. rewrite !Nleb_Nle. apply N.min_glb. Qed.
 
-Lemma Nmin_lt_3 :
- forall a b c, Nleb (Nmin b c) a = false -> Nleb b a = false.
+Lemma Nmin_lt_3 a b c : Nleb (N.min b c) a = false -> Nleb b a = false.
 Proof.
-  intros; rewrite Nmin_Nmin' in *.
-  unfold Nmin' in *. intros. elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H.
-  assumption.
-  intro H0. rewrite H0 in H. apply Nltb_trans with (b := c); assumption.
+  rewrite <- !not_true_iff_false, !Nleb_Nle.
+  rewrite N.min_le_iff; auto.
 Qed.
 
-Lemma Nmin_lt_4 :
- forall a b c, Nleb (Nmin b c) a = false -> Nleb c a = false.
+Lemma Nmin_lt_4 a b c : Nleb (N.min b c) a = false -> Nleb c a = false.
 Proof.
-  intros; rewrite Nmin_Nmin' in *.
-  unfold Nmin' in *. elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H.
-  apply Nltb_leb_trans with (b := b); assumption.
-  intro H0. rewrite H0 in H. assumption.
+  rewrite <- !not_true_iff_false, !Nleb_Nle.
+  rewrite N.min_le_iff; auto.
 Qed.
diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v
index 6b490dfc..4ea8e1d4 100644
--- a/theories/NArith/Ndigits.v
+++ b/theories/NArith/Ndigits.v
@@ -1,343 +1,276 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ndigits.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+Require Import Bool Morphisms Setoid Bvector BinPos BinNat Wf_nat
+ Pnat Nnat Compare_dec Lt Minus.
 
-Require Import Bool.
-Require Import Bvector.
-Require Import BinPos.
-Require Import BinNat.
+Local Open Scope N_scope.
 
-(** Operation over bits of a [N] number. *)
+(** This file is mostly obsolete, see directly [BinNat] now. *)
 
-(** [xor] *)
+(** Compatibility names for some bitwise operations *)
 
-Fixpoint Pxor (p1 p2:positive) : N :=
-  match p1, p2 with
-  | xH, xH => N0
-  | xH, xO p2 => Npos (xI p2)
-  | xH, xI p2 => Npos (xO p2)
-  | xO p1, xH => Npos (xI p1)
-  | xO p1, xO p2 => Ndouble (Pxor p1 p2)
-  | xO p1, xI p2 => Ndouble_plus_one (Pxor p1 p2)
-  | xI p1, xH => Npos (xO p1)
-  | xI p1, xO p2 => Ndouble_plus_one (Pxor p1 p2)
-  | xI p1, xI p2 => Ndouble (Pxor p1 p2)
-  end.
+Notation Pxor := Pos.lxor (compat "8.3").
+Notation Nxor := N.lxor (compat "8.3").
+Notation Pbit := Pos.testbit_nat (compat "8.3").
+Notation Nbit := N.testbit_nat (compat "8.3").
 
-Definition Nxor (n n':N) :=
-  match n, n' with
-  | N0, _ => n'
-  | _, N0 => n
-  | Npos p, Npos p' => Pxor p p'
-  end.
+Notation Nxor_eq := N.lxor_eq (compat "8.3").
+Notation Nxor_comm := N.lxor_comm (compat "8.3").
+Notation Nxor_assoc := N.lxor_assoc (compat "8.3").
+Notation Nxor_neutral_left := N.lxor_0_l (compat "8.3").
+Notation Nxor_neutral_right := N.lxor_0_r (compat "8.3").
+Notation Nxor_nilpotent := N.lxor_nilpotent (compat "8.3").
 
-Lemma Nxor_neutral_left : forall n:N, Nxor N0 n = n.
+(** Equivalence of bit-testing functions,
+    either with index in [N] or in [nat]. *)
+
+Lemma Ptestbit_Pbit :
+ forall p n, Pos.testbit p (N.of_nat n) = Pos.testbit_nat p n.
 Proof.
-  trivial.
+ induction p as [p IH|p IH| ]; intros [|n]; simpl; trivial;
+  rewrite <- IH; f_equal; rewrite (pred_Sn n) at 2; now rewrite Nat2N.inj_pred.
 Qed.
 
-Lemma Nxor_neutral_right : forall n:N, Nxor n N0 = n.
+Lemma Ntestbit_Nbit : forall a n, N.testbit a (N.of_nat n) = N.testbit_nat a n.
 Proof.
-  destruct n; trivial.
+ destruct a. trivial. apply Ptestbit_Pbit.
 Qed.
 
-Lemma Nxor_comm : forall n n':N, Nxor n n' = Nxor n' n.
+Lemma Pbit_Ptestbit :
+ forall p n, Pos.testbit_nat p (N.to_nat n) = Pos.testbit p n.
 Proof.
-  destruct n; destruct n'; simpl; auto.
-  generalize p0; clear p0; induction p as [p Hrecp| p Hrecp| ]; simpl;
-   auto.
-  destruct p0; trivial; rewrite Hrecp; trivial.
-  destruct p0; trivial; rewrite Hrecp; trivial.
-  destruct p0 as [p| p| ]; simpl; auto.
+ intros; now rewrite <- Ptestbit_Pbit, N2Nat.id.
 Qed.
 
-Lemma Nxor_nilpotent : forall n:N, Nxor n n = N0.
+Lemma Nbit_Ntestbit :
+ forall a n, N.testbit_nat a (N.to_nat n) = N.testbit a n.
 Proof.
-  destruct n; trivial.
-  simpl. induction p as [p IHp| p IHp| ]; trivial.
-  simpl. rewrite IHp; reflexivity.
-  simpl. rewrite IHp; reflexivity.
+ destruct a. trivial. apply Pbit_Ptestbit.
 Qed.
 
-(** Checking whether a particular bit is set on not *)
-
-Fixpoint Pbit (p:positive) : nat -> bool :=
-  match p with
-  | xH => fun n:nat => match n with
-                       | O => true
-                       | S _ => false
-                       end
-  | xO p =>
-      fun n:nat => match n with
-                   | O => false
-                   | S n' => Pbit p n'
-                   end
-  | xI p => fun n:nat => match n with
-                         | O => true
-                         | S n' => Pbit p n'
-                         end
-  end.
+(** Equivalence of shifts, index in [N] or [nat] *)
 
-Definition Nbit (a:N) :=
-  match a with
-  | N0 => fun _ => false
-  | Npos p => Pbit p
-  end.
+Lemma Nshiftr_nat_S : forall a n,
+ N.shiftr_nat a (S n) = N.div2 (N.shiftr_nat a n).
+Proof.
+ reflexivity.
+Qed.
 
-(** Auxiliary results about streams of bits *)
+Lemma Nshiftl_nat_S : forall a n,
+ N.shiftl_nat a (S n) = N.double (N.shiftl_nat a n).
+Proof.
+ reflexivity.
+Qed.
 
-Definition eqf (f g:nat -> bool) := forall n:nat, f n = g n.
+Lemma Nshiftr_nat_equiv :
+ forall a n, N.shiftr_nat a (N.to_nat n) = N.shiftr a n.
+Proof.
+ intros a [|n]; simpl. unfold N.shiftr_nat.
+ trivial.
+ symmetry. apply Pos2Nat.inj_iter.
+Qed.
 
-Lemma eqf_sym : forall f f':nat -> bool, eqf f f' -> eqf f' f.
+Lemma Nshiftr_equiv_nat :
+ forall a n, N.shiftr a (N.of_nat n) = N.shiftr_nat a n.
 Proof.
-  unfold eqf. intros. rewrite H. reflexivity.
+ intros. now rewrite <- Nshiftr_nat_equiv, Nat2N.id.
 Qed.
 
-Lemma eqf_refl : forall f:nat -> bool, eqf f f.
+Lemma Nshiftl_nat_equiv :
+ forall a n, N.shiftl_nat a (N.to_nat n) = N.shiftl a n.
 Proof.
-  unfold eqf. trivial.
+ intros [|a] [|n]; simpl; unfold N.shiftl_nat; trivial.
+ apply nat_iter_invariant; intros; now subst.
+ rewrite <- Pos2Nat.inj_iter. symmetry. now apply Pos.iter_swap_gen.
 Qed.
 
-Lemma eqf_trans :
- forall f f' f'':nat -> bool, eqf f f' -> eqf f' f'' -> eqf f f''.
+Lemma Nshiftl_equiv_nat :
+ forall a n, N.shiftl a (N.of_nat n) = N.shiftl_nat a n.
 Proof.
-  unfold eqf. intros. rewrite H. exact (H0 n).
+ intros. now rewrite <- Nshiftl_nat_equiv, Nat2N.id.
 Qed.
 
-Definition xorf (f g:nat -> bool) (n:nat) := xorb (f n) (g n).
+(** Correctness proofs for shifts, nat version *)
 
-Lemma xorf_eq :
- forall f f', eqf (xorf f f') (fun n => false) -> eqf f f'.
+Lemma Nshiftr_nat_spec : forall a n m,
+  N.testbit_nat (N.shiftr_nat a n) m = N.testbit_nat a (m+n).
 Proof.
-  unfold eqf, xorf. intros. apply xorb_eq, H.
+ induction n; intros m.
+ now rewrite <- plus_n_O.
+ simpl. rewrite <- plus_n_Sm, <- plus_Sn_m, <- IHn, Nshiftr_nat_S.
+ destruct (N.shiftr_nat a n) as [|[p|p|]]; simpl; trivial.
 Qed.
 
-Lemma xorf_assoc :
- forall f f' f'',
-   eqf (xorf (xorf f f') f'') (xorf f (xorf f' f'')).
+Lemma Nshiftl_nat_spec_high : forall a n m, (n<=m)%nat ->
+  N.testbit_nat (N.shiftl_nat a n) m = N.testbit_nat a (m-n).
 Proof.
-  unfold eqf, xorf. intros. apply xorb_assoc.
+ induction n; intros m H.
+ now rewrite <- minus_n_O.
+ destruct m. inversion H. apply le_S_n in H.
+ simpl. rewrite <- IHn, Nshiftl_nat_S; trivial.
+ destruct (N.shiftl_nat a n) as [|[p|p|]]; simpl; trivial.
 Qed.
 
-Lemma eqf_xorf :
- forall f f' f'' f''',
-   eqf f f' -> eqf f'' f''' -> eqf (xorf f f'') (xorf f' f''').
+Lemma Nshiftl_nat_spec_low : forall a n m, (m<n)%nat ->
+ N.testbit_nat (N.shiftl_nat a n) m = false.
 Proof.
-  unfold eqf, xorf. intros. rewrite H. rewrite H0. reflexivity.
+ induction n; intros m H. inversion H.
+ rewrite Nshiftl_nat_S.
+ destruct m.
+ destruct (N.shiftl_nat a n); trivial.
+ specialize (IHn m (lt_S_n _ _ H)).
+ destruct (N.shiftl_nat a n); trivial.
 Qed.
 
-(** End of auxilliary results *)
+(** A left shift for positive numbers (used in BigN) *)
+
+Lemma Pshiftl_nat_0 : forall p, Pos.shiftl_nat p 0 = p.
+Proof. reflexivity. Qed.
 
-(** This part is aimed at proving that if two numbers produce
-  the same stream of bits, then they are equal. *)
+Lemma Pshiftl_nat_S :
+ forall p n, Pos.shiftl_nat p (S n) = xO (Pos.shiftl_nat p n).
+Proof. reflexivity. Qed.
 
-Lemma Nbit_faithful_1 : forall a:N, eqf (Nbit N0) (Nbit a) -> N0 = a.
+Lemma Pshiftl_nat_N :
+ forall p n, Npos (Pos.shiftl_nat p n) = N.shiftl_nat (Npos p) n.
 Proof.
-  destruct a. trivial.
-  induction p as [p IHp| p IHp| ]; intro H.
-  absurd (N0 = Npos p). discriminate.
-  exact (IHp (fun n => H (S n))).
-  absurd (N0 = Npos p). discriminate.
-  exact (IHp (fun n => H (S n))).
-  absurd (false = true). discriminate.
-  exact (H 0).
+ unfold Pos.shiftl_nat, N.shiftl_nat.
+ induction n; simpl; auto. now rewrite <- IHn.
 Qed.
 
-Lemma Nbit_faithful_2 :
- forall a:N, eqf (Nbit (Npos 1)) (Nbit a) -> Npos 1 = a.
+Lemma Pshiftl_nat_plus : forall n m p,
+  Pos.shiftl_nat p (m + n) = Pos.shiftl_nat (Pos.shiftl_nat p n) m.
 Proof.
-  destruct a. intros. absurd (true = false). discriminate.
-  exact (H 0).
-  destruct p. intro H. absurd (N0 = Npos p). discriminate.
-  exact (Nbit_faithful_1 (Npos p) (fun n:nat => H (S n))).
-  intros. absurd (true = false). discriminate.
-  exact (H 0).
-  trivial.
+ induction m; simpl; intros. reflexivity.
+ rewrite 2 Pshiftl_nat_S. now f_equal.
+Qed.
+
+(** Semantics of bitwise operations with respect to [N.testbit_nat] *)
+
+Lemma Pxor_semantics p p' n :
+ N.testbit_nat (Pos.lxor p p') n = xorb (Pos.testbit_nat p n) (Pos.testbit_nat p' n).
+Proof.
+ rewrite <- Ntestbit_Nbit, <- !Ptestbit_Pbit. apply N.pos_lxor_spec.
 Qed.
 
-Lemma Nbit_faithful_3 :
- forall (a:N) (p:positive),
-   (forall p':positive, eqf (Nbit (Npos p)) (Nbit (Npos p')) -> p = p') ->
-   eqf (Nbit (Npos (xO p))) (Nbit a) -> Npos (xO p) = a.
+Lemma Nxor_semantics a a' n :
+ N.testbit_nat (N.lxor a a') n = xorb (N.testbit_nat a n) (N.testbit_nat a' n).
 Proof.
-  destruct a; intros. cut (eqf (Nbit N0) (Nbit (Npos (xO p)))).
-  intro. rewrite (Nbit_faithful_1 (Npos (xO p)) H1). reflexivity.
-  unfold eqf. intro. unfold eqf in H0. rewrite H0. reflexivity.
-  destruct p. discriminate (H0 O).
-  rewrite (H p (fun n => H0 (S n))). reflexivity.
-  discriminate (H0 0).
+ rewrite <- !Ntestbit_Nbit. apply N.lxor_spec.
 Qed.
 
-Lemma Nbit_faithful_4 :
- forall (a:N) (p:positive),
-   (forall p':positive, eqf (Nbit (Npos p)) (Nbit (Npos p')) -> p = p') ->
-   eqf (Nbit (Npos (xI p))) (Nbit a) -> Npos (xI p) = a.
+Lemma Por_semantics p p' n :
+ Pos.testbit_nat (Pos.lor p p') n = (Pos.testbit_nat p n) || (Pos.testbit_nat p' n).
 Proof.
-  destruct a; intros. cut (eqf (Nbit N0) (Nbit (Npos (xI p)))).
-  intro. rewrite (Nbit_faithful_1 (Npos (xI p)) H1). reflexivity.
-  intro. rewrite H0. reflexivity.
-  destruct p. rewrite (H p (fun n:nat => H0 (S n))). reflexivity.
-  discriminate (H0 0).
-  cut (eqf (Nbit (Npos 1)) (Nbit (Npos (xI p0)))).
-  intro. discriminate (Nbit_faithful_1 (Npos p0) (fun n:nat => H1 (S n))).
-  intro. rewrite H0. reflexivity.
+ rewrite <- !Ptestbit_Pbit. apply N.pos_lor_spec.
 Qed.
 
-Lemma Nbit_faithful : forall a a':N, eqf (Nbit a) (Nbit a') -> a = a'.
+Lemma Nor_semantics a a' n :
+ N.testbit_nat (N.lor a a') n = (N.testbit_nat a n) || (N.testbit_nat a' n).
 Proof.
-  destruct a. exact Nbit_faithful_1.
-  induction p. intros a' H. apply Nbit_faithful_4. intros.
-  assert (Npos p = Npos p') by exact (IHp (Npos p') H0).
-  inversion H1. reflexivity.
-  assumption.
-  intros. apply Nbit_faithful_3. intros.
-  assert (Npos p = Npos p') by exact (IHp (Npos p') H0).
-  inversion H1. reflexivity.
-  assumption.
-  exact Nbit_faithful_2.
+ rewrite <- !Ntestbit_Nbit. apply N.lor_spec.
 Qed.
 
-(** We now describe the semantics of [Nxor] in terms of bit streams. *)
+Lemma Pand_semantics p p' n :
+ N.testbit_nat (Pos.land p p') n = (Pos.testbit_nat p n) && (Pos.testbit_nat p' n).
+Proof.
+ rewrite <- Ntestbit_Nbit, <- !Ptestbit_Pbit. apply N.pos_land_spec.
+Qed.
 
-Lemma Nxor_sem_1 : forall a':N, Nbit (Nxor N0 a') 0 = Nbit a' 0.
+Lemma Nand_semantics a a' n :
+ N.testbit_nat (N.land a a') n = (N.testbit_nat a n) && (N.testbit_nat a' n).
 Proof.
-  trivial.
+ rewrite <- !Ntestbit_Nbit. apply N.land_spec.
 Qed.
 
-Lemma Nxor_sem_2 :
- forall a':N, Nbit (Nxor (Npos 1) a') 0 = negb (Nbit a' 0).
+Lemma Pdiff_semantics p p' n :
+ N.testbit_nat (Pos.ldiff p p') n = (Pos.testbit_nat p n) && negb (Pos.testbit_nat p' n).
 Proof.
-  intro. destruct a'. trivial.
-  destruct p; trivial.
+ rewrite <- Ntestbit_Nbit, <- !Ptestbit_Pbit. apply N.pos_ldiff_spec.
+Qed.
+
+Lemma Ndiff_semantics a a' n :
+ N.testbit_nat (N.ldiff a a') n = (N.testbit_nat a n) && negb (N.testbit_nat a' n).
+Proof.
+ rewrite <- !Ntestbit_Nbit. apply N.ldiff_spec.
 Qed.
 
-Lemma Nxor_sem_3 :
- forall (p:positive) (a':N),
-   Nbit (Nxor (Npos (xO p)) a') 0 = Nbit a' 0.
+(** Equality over functional streams of bits *)
+
+Definition eqf (f g:nat -> bool) := forall n:nat, f n = g n.
+
+Program Instance eqf_equiv : Equivalence eqf.
+
+Local Infix "==" := eqf (at level 70, no associativity).
+
+(** If two numbers produce the same stream of bits, they are equal. *)
+
+Local Notation Step H := (fun n => H (S n)).
+
+Lemma Pbit_faithful_0 : forall p, ~(Pos.testbit_nat p == (fun _ => false)).
 Proof.
-  intros. destruct a'. trivial.
-  simpl. destruct p0; trivial.
-  destruct (Pxor p p0); trivial.
-  destruct (Pxor p p0); trivial.
+ induction p as [p IHp|p IHp| ]; intros H; try discriminate (H O).
+  apply (IHp (Step H)).
 Qed.
 
-Lemma Nxor_sem_4 :
- forall (p:positive) (a':N),
-   Nbit (Nxor (Npos (xI p)) a') 0 = negb (Nbit a' 0).
+Lemma Pbit_faithful : forall p p', Pos.testbit_nat p == Pos.testbit_nat p' -> p = p'.
 Proof.
-  intros. destruct a'. trivial.
-  simpl. destruct p0; trivial.
-  destruct (Pxor p p0); trivial.
-  destruct (Pxor p p0); trivial.
+ induction p as [p IHp|p IHp| ]; intros [p'|p'|] H; trivial;
+  try discriminate (H O).
+ f_equal. apply (IHp _ (Step H)).
+ destruct (Pbit_faithful_0 _ (Step H)).
+ f_equal. apply (IHp _ (Step H)).
+ symmetry in H. destruct (Pbit_faithful_0 _ (Step H)).
 Qed.
 
-Lemma Nxor_sem_5 :
- forall a a':N, Nbit (Nxor a a') 0 = xorf (Nbit a) (Nbit a') 0.
+Lemma Nbit_faithful : forall n n', N.testbit_nat n == N.testbit_nat n' -> n = n'.
 Proof.
-  destruct a; intro. change (Nbit a' 0 = xorb false (Nbit a' 0)). rewrite false_xorb. trivial.
-  destruct p. apply Nxor_sem_4.
-  change (Nbit (Nxor (Npos (xO p)) a') 0 = xorb false (Nbit a' 0)).
-  rewrite false_xorb. apply Nxor_sem_3. apply Nxor_sem_2.
+ intros [|p] [|p'] H; trivial.
+ symmetry in H. destruct (Pbit_faithful_0 _ H).
+ destruct (Pbit_faithful_0 _ H).
+ f_equal. apply Pbit_faithful, H.
 Qed.
 
-Lemma Nxor_sem_6 :
- forall n:nat,
-   (forall a a':N, Nbit (Nxor a a') n = xorf (Nbit a) (Nbit a') n) ->
-   forall a a':N,
-     Nbit (Nxor a a') (S n) = xorf (Nbit a) (Nbit a') (S n).
+Lemma Nbit_faithful_iff : forall n n', N.testbit_nat n == N.testbit_nat n' <-> n = n'.
 Proof.
-  intros.
-(* pose proof (fun p1 p2 => H (Npos p1) (Npos p2)) as H'. clear H. rename H' into H.*)
-  generalize (fun p1 p2 => H (Npos p1) (Npos p2)); clear H; intro H.
-  unfold xorf in *.
-  destruct a as [|p]. simpl Nbit; rewrite false_xorb. reflexivity.
-  destruct a' as [|p0].
-  simpl Nbit; rewrite xorb_false. reflexivity.
-  destruct p. destruct p0; simpl Nbit in *.
-  rewrite <- H; simpl; case (Pxor p p0); trivial.
-  rewrite <- H; simpl; case (Pxor p p0); trivial.
-  rewrite xorb_false. reflexivity.
-  destruct p0; simpl Nbit in *.
-  rewrite <- H; simpl; case (Pxor p p0); trivial.
-  rewrite <- H; simpl; case (Pxor p p0); trivial.
-  rewrite xorb_false. reflexivity.
-  simpl Nbit. rewrite false_xorb. destruct p0; trivial.
-Qed.
-
-Lemma Nxor_semantics :
- forall a a':N, eqf (Nbit (Nxor a a')) (xorf (Nbit a) (Nbit a')).
-Proof.
-  unfold eqf. intros; generalize a, a'. induction n.
-  apply Nxor_sem_5. apply Nxor_sem_6; assumption.
-Qed.
-
-(** Consequences:
-       - only equal numbers lead to a null xor
-       - xor is associative
-*)
-
-Lemma Nxor_eq : forall a a':N, Nxor a a' = N0 -> a = a'.
-Proof.
-  intros. apply Nbit_faithful, xorf_eq. apply eqf_trans with (f' := Nbit (Nxor a a')).
-  apply eqf_sym, Nxor_semantics.
-  rewrite H. unfold eqf. trivial.
-Qed.
-
-Lemma Nxor_assoc :
- forall a a' a'':N, Nxor (Nxor a a') a'' = Nxor a (Nxor a' a'').
-Proof.
-  intros. apply Nbit_faithful.
-  apply eqf_trans with (xorf (xorf (Nbit a) (Nbit a')) (Nbit a'')).
-  apply eqf_trans with (xorf (Nbit (Nxor a a')) (Nbit a'')).
-  apply Nxor_semantics.
-  apply eqf_xorf. apply Nxor_semantics.
-  apply eqf_refl.
-  apply eqf_trans with (xorf (Nbit a) (xorf (Nbit a') (Nbit a''))).
-  apply xorf_assoc.
-  apply eqf_trans with (xorf (Nbit a) (Nbit (Nxor a' a''))).
-  apply eqf_xorf. apply eqf_refl.
-  apply eqf_sym, Nxor_semantics.
-  apply eqf_sym, Nxor_semantics.
+ split. apply Nbit_faithful. intros; now subst.
 Qed.
 
+Local Close Scope N_scope.
+
 (** Checking whether a number is odd, i.e.
    if its lower bit is set. *)
 
-Definition Nbit0 (n:N) :=
-  match n with
-  | N0 => false
-  | Npos (xO _) => false
-  | _ => true
-  end.
+Notation Nbit0 := N.odd (compat "8.3").
 
-Definition Nodd (n:N) := Nbit0 n = true.
-Definition Neven (n:N) := Nbit0 n = false.
+Definition Nodd (n:N) := N.odd n = true.
+Definition Neven (n:N) := N.odd n = false.
 
-Lemma Nbit0_correct : forall n:N, Nbit n 0 = Nbit0 n.
+Lemma Nbit0_correct : forall n:N, N.testbit_nat n 0 = N.odd n.
 Proof.
   destruct n; trivial.
   destruct p; trivial.
 Qed.
 
-Lemma Ndouble_bit0 : forall n:N, Nbit0 (Ndouble n) = false.
+Lemma Ndouble_bit0 : forall n:N, N.odd (N.double n) = false.
 Proof.
   destruct n; trivial.
 Qed.
 
 Lemma Ndouble_plus_one_bit0 :
- forall n:N, Nbit0 (Ndouble_plus_one n) = true.
+ forall n:N, N.odd (N.succ_double n) = true.
 Proof.
   destruct n; trivial.
 Qed.
 
 Lemma Ndiv2_double :
- forall n:N, Neven n -> Ndouble (Ndiv2 n) = n.
+ forall n:N, Neven n -> N.double (N.div2 n) = n.
 Proof.
   destruct n. trivial. destruct p. intro H. discriminate H.
   intros. reflexivity.
@@ -345,7 +278,7 @@ Proof.
 Qed.
 
 Lemma Ndiv2_double_plus_one :
- forall n:N, Nodd n -> Ndouble_plus_one (Ndiv2 n) = n.
+ forall n:N, Nodd n -> N.succ_double (N.div2 n) = n.
 Proof.
   destruct n. intro. discriminate H.
   destruct p. intros. reflexivity.
@@ -354,134 +287,136 @@ Proof.
 Qed.
 
 Lemma Ndiv2_correct :
- forall (a:N) (n:nat), Nbit (Ndiv2 a) n = Nbit a (S n).
+ forall (a:N) (n:nat), N.testbit_nat (N.div2 a) n = N.testbit_nat a (S n).
 Proof.
   destruct a; trivial.
   destruct p; trivial.
 Qed.
 
 Lemma Nxor_bit0 :
- forall a a':N, Nbit0 (Nxor a a') = xorb (Nbit0 a) (Nbit0 a').
+ forall a a':N, N.odd (N.lxor a a') = xorb (N.odd a) (N.odd a').
 Proof.
-  intros. rewrite <- Nbit0_correct, (Nxor_semantics a a' 0).
-  unfold xorf. rewrite Nbit0_correct, Nbit0_correct. reflexivity.
+  intros. rewrite <- Nbit0_correct, (Nxor_semantics a a' O).
+  rewrite Nbit0_correct, Nbit0_correct. reflexivity.
 Qed.
 
 Lemma Nxor_div2 :
- forall a a':N, Ndiv2 (Nxor a a') = Nxor (Ndiv2 a) (Ndiv2 a').
+ forall a a':N, N.div2 (N.lxor a a') = N.lxor (N.div2 a) (N.div2 a').
 Proof.
   intros. apply Nbit_faithful. unfold eqf. intro.
-  rewrite (Nxor_semantics (Ndiv2 a) (Ndiv2 a') n), Ndiv2_correct, (Nxor_semantics a a' (S n)).
-  unfold xorf. rewrite 2! Ndiv2_correct.
+  rewrite (Nxor_semantics (N.div2 a) (N.div2 a') n), Ndiv2_correct, (Nxor_semantics a a' (S n)).
+  rewrite 2! Ndiv2_correct.
   reflexivity.
 Qed.
 
 Lemma Nneg_bit0 :
  forall a a':N,
-   Nbit0 (Nxor a a') = true -> Nbit0 a = negb (Nbit0 a').
+   N.odd (N.lxor a a') = true -> N.odd a = negb (N.odd a').
 Proof.
   intros.
-  rewrite <- true_xorb, <- H, Nxor_bit0, xorb_assoc, xorb_nilpotent, xorb_false.
+  rewrite <- true_xorb, <- H, Nxor_bit0, xorb_assoc, 
+    xorb_nilpotent, xorb_false.
   reflexivity.
 Qed.
 
 Lemma Nneg_bit0_1 :
- forall a a':N, Nxor a a' = Npos 1 -> Nbit0 a = negb (Nbit0 a').
+ forall a a':N, N.lxor a a' = Npos 1 -> N.odd a = negb (N.odd a').
 Proof.
   intros. apply Nneg_bit0. rewrite H. reflexivity.
 Qed.
 
 Lemma Nneg_bit0_2 :
  forall (a a':N) (p:positive),
-   Nxor a a' = Npos (xI p) -> Nbit0 a = negb (Nbit0 a').
+   N.lxor a a' = Npos (xI p) -> N.odd a = negb (N.odd a').
 Proof.
   intros. apply Nneg_bit0. rewrite H. reflexivity.
 Qed.
 
 Lemma Nsame_bit0 :
  forall (a a':N) (p:positive),
-   Nxor a a' = Npos (xO p) -> Nbit0 a = Nbit0 a'.
+   N.lxor a a' = Npos (xO p) -> N.odd a = N.odd a'.
 Proof.
-  intros. rewrite <- (xorb_false (Nbit0 a)).
-  assert (H0: Nbit0 (Npos (xO p)) = false) by reflexivity.
-  rewrite <- H0, <- H, Nxor_bit0, <- xorb_assoc, xorb_nilpotent, false_xorb. reflexivity.
+  intros. rewrite <- (xorb_false (N.odd a)).
+  assert (H0: N.odd (Npos (xO p)) = false) by reflexivity.
+  rewrite <- H0, <- H, Nxor_bit0, <- xorb_assoc, xorb_nilpotent, false_xorb.
+    reflexivity.
 Qed.
 
 (** a lexicographic order on bits, starting from the lowest bit *)
 
 Fixpoint Nless_aux (a a':N) (p:positive) : bool :=
   match p with
-  | xO p' => Nless_aux (Ndiv2 a) (Ndiv2 a') p'
-  | _ => andb (negb (Nbit0 a)) (Nbit0 a')
+  | xO p' => Nless_aux (N.div2 a) (N.div2 a') p'
+  | _ => andb (negb (N.odd a)) (N.odd a')
   end.
 
 Definition Nless (a a':N) :=
-  match Nxor a a' with
+  match N.lxor a a' with
   | N0 => false
   | Npos p => Nless_aux a a' p
   end.
 
 Lemma Nbit0_less :
  forall a a',
-   Nbit0 a = false -> Nbit0 a' = true -> Nless a a' = true.
+   N.odd a = false -> N.odd a' = true -> Nless a a' = true.
 Proof.
-  intros. destruct (Ndiscr (Nxor a a')) as [(p,H2)|H1]. unfold Nless.
+  intros. destruct (N.discr (N.lxor a a')) as [(p,H2)|H1]. unfold Nless.
   rewrite H2. destruct p. simpl. rewrite H, H0. reflexivity.
-  assert (H1: Nbit0 (Nxor a a') = false) by (rewrite H2; reflexivity).
+  assert (H1: N.odd (N.lxor a a') = false) by (rewrite H2; reflexivity).
   rewrite (Nxor_bit0 a a'), H, H0 in H1. discriminate H1.
   simpl. rewrite H, H0. reflexivity.
-  assert (H2: Nbit0 (Nxor a a') = false) by (rewrite H1; reflexivity).
+  assert (H2: N.odd (N.lxor a a') = false) by (rewrite H1; reflexivity).
   rewrite (Nxor_bit0 a a'), H, H0 in H2. discriminate H2.
 Qed.
 
 Lemma Nbit0_gt :
  forall a a',
-   Nbit0 a = true -> Nbit0 a' = false -> Nless a a' = false.
+   N.odd a = true -> N.odd a' = false -> Nless a a' = false.
 Proof.
-  intros. destruct (Ndiscr (Nxor a a')) as [(p,H2)|H1]. unfold Nless.
+  intros. destruct (N.discr (N.lxor a a')) as [(p,H2)|H1]. unfold Nless.
   rewrite H2. destruct p. simpl. rewrite H, H0. reflexivity.
-  assert (H1: Nbit0 (Nxor a a') = false) by (rewrite H2; reflexivity).
+  assert (H1: N.odd (N.lxor a a') = false) by (rewrite H2; reflexivity).
   rewrite (Nxor_bit0 a a'), H, H0 in H1. discriminate H1.
   simpl. rewrite H, H0. reflexivity.
-  assert (H2: Nbit0 (Nxor a a') = false) by (rewrite H1; reflexivity).
+  assert (H2: N.odd (N.lxor a a') = false) by (rewrite H1; reflexivity).
   rewrite (Nxor_bit0 a a'), H, H0 in H2. discriminate H2.
 Qed.
 
 Lemma Nless_not_refl : forall a, Nless a a = false.
 Proof.
-  intro. unfold Nless. rewrite (Nxor_nilpotent a). reflexivity.
+  intro. unfold Nless. rewrite (N.lxor_nilpotent a). reflexivity.
 Qed.
 
 Lemma Nless_def_1 :
- forall a a', Nless (Ndouble a) (Ndouble a') = Nless a a'.
+ forall a a', Nless (N.double a) (N.double a') = Nless a a'.
 Proof.
   destruct a; destruct a'. reflexivity.
   trivial.
   unfold Nless. simpl. destruct p; trivial.
-  unfold Nless. simpl. destruct (Pxor p p0). reflexivity.
+  unfold Nless. simpl. destruct (Pos.lxor p p0). reflexivity.
   trivial.
 Qed.
 
 Lemma Nless_def_2 :
  forall a a',
-   Nless (Ndouble_plus_one a) (Ndouble_plus_one a') = Nless a a'.
+   Nless (N.succ_double a) (N.succ_double a') = Nless a a'.
 Proof.
   destruct a; destruct a'. reflexivity.
   trivial.
   unfold Nless. simpl. destruct p; trivial.
-  unfold Nless. simpl. destruct (Pxor p p0). reflexivity.
+  unfold Nless. simpl. destruct (Pos.lxor p p0). reflexivity.
   trivial.
 Qed.
 
 Lemma Nless_def_3 :
- forall a a', Nless (Ndouble a) (Ndouble_plus_one a') = true.
+ forall a a', Nless (N.double a) (N.succ_double a') = true.
 Proof.
   intros. apply Nbit0_less. apply Ndouble_bit0.
   apply Ndouble_plus_one_bit0.
 Qed.
 
 Lemma Nless_def_4 :
- forall a a', Nless (Ndouble_plus_one a) (Ndouble a') = false.
+ forall a a', Nless (N.succ_double a) (N.double a') = false.
 Proof.
   intros. apply Nbit0_gt. apply Ndouble_plus_one_bit0.
   apply Ndouble_bit0.
@@ -490,7 +425,7 @@ Qed.
 Lemma Nless_z : forall a, Nless a N0 = false.
 Proof.
   induction a. reflexivity.
-  unfold Nless. rewrite (Nxor_neutral_right (Npos p)). induction p; trivial.
+  unfold Nless. rewrite (N.lxor_0_r (Npos p)). induction p; trivial.
 Qed.
 
 Lemma N0_less_1 :
@@ -510,26 +445,26 @@ Lemma Nless_trans :
  forall a a' a'',
    Nless a a' = true -> Nless a' a'' = true -> Nless a a'' = true.
 Proof.
-  induction a as [|a IHa|a IHa] using N_ind_double; intros a' a'' H H0.
-    destruct (Nless N0 a'') as []_eqn:Heqb. trivial.
-     rewrite (N0_less_2 a'' Heqb), (Nless_z a') in H0. discriminate H0.
-    induction a' as [|a' _|a' _] using N_ind_double.
-      rewrite (Nless_z (Ndouble a)) in H. discriminate H.
+  induction a as [|a IHa|a IHa] using N.binary_ind; intros a' a'' H H0.
+    case_eq (Nless N0 a'') ; intros Heqn. trivial.
+     rewrite (N0_less_2 a'' Heqn), (Nless_z a') in H0. discriminate H0.
+    induction a' as [|a' _|a' _] using N.binary_ind.
+      rewrite (Nless_z (N.double a)) in H. discriminate H.
       rewrite (Nless_def_1 a a') in H.
-       induction a'' using N_ind_double.
-         rewrite (Nless_z (Ndouble a')) in H0. discriminate H0.
+       induction a'' using N.binary_ind.
+         rewrite (Nless_z (N.double a')) in H0. discriminate H0.
          rewrite (Nless_def_1 a' a'') in H0. rewrite (Nless_def_1 a a'').
           exact (IHa _ _ H H0).
          apply Nless_def_3.
-      induction a'' as [|a'' _|a'' _] using N_ind_double.
-        rewrite (Nless_z (Ndouble_plus_one a')) in H0. discriminate H0.
+      induction a'' as [|a'' _|a'' _] using N.binary_ind.
+        rewrite (Nless_z (N.succ_double a')) in H0. discriminate H0.
         rewrite (Nless_def_4 a' a'') in H0. discriminate H0.
         apply Nless_def_3.
-    induction a' as [|a' _|a' _] using N_ind_double.
-      rewrite (Nless_z (Ndouble_plus_one a)) in H. discriminate H.
+    induction a' as [|a' _|a' _] using N.binary_ind.
+      rewrite (Nless_z (N.succ_double a)) in H. discriminate H.
       rewrite (Nless_def_4 a a') in H. discriminate H.
-      induction a'' using N_ind_double.
-        rewrite (Nless_z (Ndouble_plus_one a')) in H0. discriminate H0.
+      induction a'' using N.binary_ind.
+        rewrite (Nless_z (N.succ_double a')) in H0. discriminate H0.
         rewrite (Nless_def_4 a' a'') in H0. discriminate H0.
         rewrite (Nless_def_2 a' a'') in H0. rewrite (Nless_def_2 a a') in H.
           rewrite (Nless_def_2 a a''). exact (IHa _ _ H H0).
@@ -538,17 +473,17 @@ Qed.
 Lemma Nless_total :
  forall a a', {Nless a a' = true} + {Nless a' a = true} + {a = a'}.
 Proof.
-  induction a using N_rec_double; intro a'.
-    destruct (Nless N0 a') as []_eqn:Heqb. left. left. auto.
+  induction a using N.binary_rec; intro a'.
+    case_eq (Nless N0 a') ; intros Heqb. left. left. auto.
      right. rewrite (N0_less_2 a' Heqb). reflexivity.
-    induction a' as [|a' _|a' _] using N_rec_double.
-      destruct (Nless N0 (Ndouble a)) as []_eqn:Heqb. left. right. auto.
+    induction a' as [|a' _|a' _] using N.binary_rec.
+      case_eq (Nless N0 (N.double a)) ; intros Heqb. left. right. auto.
        right. exact (N0_less_2 _  Heqb).
       rewrite 2!Nless_def_1. destruct (IHa a') as [ | ->].
         left. assumption.
         right. reflexivity.
     left. left. apply Nless_def_3.
-    induction a' as [|a' _|a' _] using N_rec_double.
+    induction a' as [|a' _|a' _] using N.binary_rec.
       left. right. destruct a; reflexivity.
       left. right. apply Nless_def_3.
       rewrite 2!Nless_def_2. destruct (IHa a') as [ | ->].
@@ -558,32 +493,28 @@ Qed.
 
 (** Number of digits in a number *)
 
-Definition Nsize (n:N) : nat := match n with
-  | N0 => 0%nat
-  | Npos p => Psize p
- end.
-
+Notation Nsize := N.size_nat (compat "8.3").
 
 (** conversions between N and bit vectors. *)
 
-Fixpoint P2Bv (p:positive) : Bvector (Psize p) :=
- match p return Bvector (Psize p) with
+Fixpoint P2Bv (p:positive) : Bvector (Pos.size_nat p) :=
+ match p return Bvector (Pos.size_nat p) with
    | xH => Bvect_true 1%nat
-   | xO p => Bcons false (Psize p) (P2Bv p)
-   | xI p => Bcons true (Psize p) (P2Bv p)
+   | xO p => Bcons false (Pos.size_nat p) (P2Bv p)
+   | xI p => Bcons true (Pos.size_nat p) (P2Bv p)
  end.
 
-Definition N2Bv (n:N) : Bvector (Nsize n) :=
-  match n as n0 return Bvector (Nsize n0) with
+Definition N2Bv (n:N) : Bvector (N.size_nat n) :=
+  match n as n0 return Bvector (N.size_nat n0) with
     | N0 => Bnil
     | Npos p => P2Bv p
   end.
 
 Fixpoint Bv2N (n:nat)(bv:Bvector n) : N :=
   match bv with
-    | Vnil => N0
-    | Vcons false n bv => Ndouble (Bv2N n bv)
-    | Vcons true n bv => Ndouble_plus_one (Bv2N n bv)
+    | Vector.nil => N0
+    | Vector.cons false n bv => N.double (Bv2N n bv)
+    | Vector.cons true n bv => N.succ_double (Bv2N n bv)
   end.
 
 Lemma Bv2N_N2Bv : forall n, Bv2N _ (N2Bv n) = n.
@@ -597,15 +528,14 @@ Qed.
   bit vector has some zeros on its right, they will disappear during
   the return [Bv2N] translation: *)
 
-Lemma Bv2N_Nsize : forall n (bv:Bvector n), Nsize (Bv2N n bv) <= n.
+Lemma Bv2N_Nsize : forall n (bv:Bvector n), N.size_nat (Bv2N n bv) <= n.
 Proof.
-induction n; intros.
-rewrite (V0_eq _ bv); simpl; auto.
-rewrite (VSn_eq _ _ bv); simpl.
-specialize IHn with (Vtail _ _ bv).
-destruct (Vhead _ _ bv);
- destruct (Bv2N n (Vtail bool n bv));
-  simpl; auto with arith.
+induction bv; intros.
+auto.
+simpl.
+destruct h;
+ destruct (Bv2N n bv);
+ simpl ; auto with arith.
 Qed.
 
 (** In the previous lemma, we can only replace the inequality by
@@ -613,17 +543,12 @@ Qed.
 
 Lemma Bv2N_Nsize_1 : forall n (bv:Bvector (S n)),
   Bsign _ bv = true <->
-  Nsize (Bv2N _ bv) = (S n).
+  N.size_nat (Bv2N _ bv) = (S n).
 Proof.
-induction n; intro.
-rewrite (VSn_eq _ _ bv); simpl.
-rewrite (V0_eq _ (Vtail _ _ bv)); simpl.
-destruct (Vhead _ _ bv); simpl; intuition; try discriminate.
-rewrite (VSn_eq _ _ bv); simpl.
-generalize (IHn (Vtail _ _ bv)); clear IHn.
-destruct (Vhead _ _ bv);
- destruct (Bv2N (S n) (Vtail bool (S n) bv));
-  simpl; intuition; try discriminate.
+apply Vector.rectS ; intros ; simpl.
+destruct a ; compute ; split ; intros x ; now inversion x.
+ destruct a, (Bv2N (S n) v) ;
+  simpl ;intuition ; try discriminate.
 Qed.
 
 (** To state nonetheless a second result about composition of
@@ -642,7 +567,7 @@ Fixpoint N2Bv_gen (n:nat)(a:N) : Bvector n :=
 
 (** The first [N2Bv] is then a special case of [N2Bv_gen] *)
 
-Lemma N2Bv_N2Bv_gen : forall (a:N), N2Bv a = N2Bv_gen (Nsize a) a.
+Lemma N2Bv_N2Bv_gen : forall (a:N), N2Bv a = N2Bv_gen (N.size_nat a) a.
 Proof.
 destruct a; simpl.
 auto.
@@ -653,7 +578,7 @@ Qed.
    [a] plus some zeros. *)
 
 Lemma N2Bv_N2Bv_gen_above : forall (a:N)(k:nat),
- N2Bv_gen (Nsize a + k) a = Vextend _ _ _ (N2Bv a) (Bvect_false k).
+ N2Bv_gen (N.size_nat a + k) a = Vector.append (N2Bv a) (Bvect_false k).
 Proof.
 destruct a; simpl.
 destruct k; simpl; auto.
@@ -665,49 +590,43 @@ Qed.
 Lemma N2Bv_Bv2N : forall n (bv:Bvector n),
    N2Bv_gen n (Bv2N n bv) = bv.
 Proof.
-induction n; intros.
-rewrite (V0_eq _ bv); simpl; auto.
-rewrite (VSn_eq _ _ bv); simpl.
-generalize (IHn (Vtail _ _ bv)); clear IHn.
+induction bv; intros.
+auto.
+simpl.
+generalize IHbv; clear IHbv.
 unfold Bcons.
-destruct (Bv2N _ (Vtail _ _ bv));
- destruct (Vhead _ _ bv); intro H; rewrite <- H; simpl; trivial;
+destruct (Bv2N _ bv);
+ destruct h; intro H; rewrite <- H; simpl; trivial;
   induction n; simpl; auto.
 Qed.
 
 (** accessing some precise bits. *)
 
 Lemma Nbit0_Blow : forall n, forall (bv:Bvector (S n)),
-  Nbit0 (Bv2N _ bv) = Blow _ bv.
+  N.odd (Bv2N _ bv) = Blow _ bv.
 Proof.
+apply Vector.caseS.
 intros.
 unfold Blow.
-rewrite (VSn_eq _ _ bv) at 1.
 simpl.
-destruct (Bv2N n (Vtail bool n bv)); simpl;
- destruct (Vhead bool n bv); auto.
+destruct (Bv2N n t); simpl;
+ destruct h; auto.
 Qed.
 
-Definition Bnth (n:nat)(bv:Bvector n)(p:nat) : p<n -> bool.
-Proof.
- induction bv in p |- *.
- intros.
- exfalso; inversion H.
- intros.
- destruct p.
- exact a.
- apply (IHbv p); auto with arith.
-Defined.
+Notation Bnth := (@Vector.nth_order bool).
 
 Lemma Bnth_Nbit : forall n (bv:Bvector n) p (H:p<n),
-  Bnth _ bv p H = Nbit (Bv2N _ bv) p.
+  Bnth bv H = N.testbit_nat (Bv2N _ bv) p.
 Proof.
 induction bv; intros.
 inversion H.
-destruct p; simpl; destruct (Bv2N n bv); destruct a; simpl in *; auto.
+destruct p ; simpl.
+  destruct (Bv2N n bv); destruct h; simpl in *; auto.
+  specialize IHbv with p (lt_S_n _ _ H).
+    simpl in * ; destruct (Bv2N n bv); destruct h; simpl in *; auto.
 Qed.
 
-Lemma Nbit_Nsize : forall n p, Nsize n <= p -> Nbit n p = false.
+Lemma Nbit_Nsize : forall n p, N.size_nat n <= p -> N.testbit_nat n p = false.
 Proof.
 destruct n as [|n].
 simpl; auto.
@@ -716,26 +635,31 @@ inversion H.
 inversion H.
 Qed.
 
-Lemma Nbit_Bth: forall n p (H:p < Nsize n), Nbit n p = Bnth _ (N2Bv n) p H.
+Lemma Nbit_Bth: forall n p (H:p < N.size_nat n),
+  N.testbit_nat n p = Bnth (N2Bv n) H.
 Proof.
 destruct n as [|n].
 inversion H.
-induction n; simpl in *; intros; destruct p; auto with arith.
-inversion H; inversion H1.
+induction n ; destruct p ; unfold Vector.nth_order in *; simpl in * ; auto.
+intros H ; destruct (lt_n_O _ (lt_S_n _ _ H)).
 Qed.
 
-(** Xor is the same in the two worlds. *)
+(** Binary bitwise operations are the same in the two worlds. *)
 
 Lemma Nxor_BVxor : forall n (bv bv' : Bvector n),
-  Bv2N _ (BVxor _ bv bv') = Nxor (Bv2N _ bv) (Bv2N _ bv').
+  Bv2N _ (BVxor _ bv bv') = N.lxor (Bv2N _ bv) (Bv2N _ bv').
 Proof.
-induction n.
-intros.
-rewrite (V0_eq _ bv), (V0_eq _ bv'); simpl; auto.
-intros.
-rewrite (VSn_eq _ _ bv), (VSn_eq _ _ bv'); simpl; auto.
-rewrite IHn.
-destruct (Vhead bool n bv); destruct (Vhead bool n bv');
- destruct (Bv2N n (Vtail bool n bv)); destruct (Bv2N n (Vtail bool n bv')); simpl; auto.
+apply Vector.rect2 ; intros.
+now simpl.
+simpl.
+destruct a, b, (Bv2N n v1), (Bv2N n v2); simpl in *; rewrite H ; now simpl.
 Qed.
 
+Lemma Nand_BVand : forall n (bv bv' : Bvector n),
+  Bv2N _ (BVand _ bv bv') = N.land (Bv2N _ bv) (Bv2N _ bv').
+Proof.
+refine (@Vector.rect2 _ _ _ _ _); simpl; intros; auto.
+rewrite H.
+destruct a, b, (Bv2N n v1), (Bv2N n v2);
+ simpl; auto.
+Qed.
diff --git a/theories/NArith/Ndist.v b/theories/NArith/Ndist.v
index 586c1114..ce4f7663 100644
--- a/theories/NArith/Ndist.v
+++ b/theories/NArith/Ndist.v
@@ -1,12 +1,10 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	     $Id: Ndist.v 14641 2011-11-06 11:59:10Z herbelin $	      i*)
-
 Require Import Arith.
 Require Import Min.
 Require Import BinPos.
@@ -35,12 +33,12 @@ Definition Nplength (a:N) :=
 Lemma Nplength_infty : forall a:N, Nplength a = infty -> a = N0.
 Proof.
   simple induction a; trivial.
-  unfold Nplength in |- *; intros; discriminate H.
+  unfold Nplength; intros; discriminate H.
 Qed.
 
 Lemma Nplength_zeros :
  forall (a:N) (n:nat),
-   Nplength a = ni n -> forall k:nat, k < n -> Nbit a k = false.
+   Nplength a = ni n -> forall k:nat, k < n -> N.testbit_nat a k = false.
 Proof.
   simple induction a; trivial.
   simple induction p. simple induction n. intros. inversion H1.
@@ -48,33 +46,33 @@ Proof.
   intros. simpl in H1. discriminate H1.
   simple induction k. trivial.
   generalize H0. case n. intros. inversion H3.
-  intros. simpl in |- *. unfold Nbit in H. apply (H n0). simpl in H1. inversion H1. reflexivity.
+  intros. simpl. unfold N.testbit_nat in H. apply (H n0). simpl in H1. inversion H1. reflexivity.
   exact (lt_S_n n1 n0 H3).
-  simpl in |- *. intros n H. inversion H. intros. inversion H0.
+  simpl. intros n H. inversion H. intros. inversion H0.
 Qed.
 
 Lemma Nplength_one :
- forall (a:N) (n:nat), Nplength a = ni n -> Nbit a n = true.
+ forall (a:N) (n:nat), Nplength a = ni n -> N.testbit_nat a n = true.
 Proof.
   simple induction a. intros. inversion H.
   simple induction p. intros. simpl in H0. inversion H0. reflexivity.
-  intros. simpl in H0. inversion H0. simpl in |- *. unfold Nbit in H. apply H. reflexivity.
+  intros. simpl in H0. inversion H0. simpl. unfold N.testbit_nat in H. apply H. reflexivity.
   intros. simpl in H. inversion H. reflexivity.
 Qed.
 
 Lemma Nplength_first_one :
  forall (a:N) (n:nat),
-   (forall k:nat, k < n -> Nbit a k = false) ->
-   Nbit a n = true -> Nplength a = ni n.
+   (forall k:nat, k < n -> N.testbit_nat a k = false) ->
+   N.testbit_nat a n = true -> Nplength a = ni n.
 Proof.
   simple induction a. intros. simpl in H0. discriminate H0.
   simple induction p. intros. generalize H0. case n. intros. reflexivity.
-  intros. absurd (Nbit (Npos (xI p0)) 0 = false). trivial with bool.
+  intros. absurd (N.testbit_nat (Npos (xI p0)) 0 = false). trivial with bool.
   auto with bool arith.
   intros. generalize H0 H1. case n. intros. simpl in H3. discriminate H3.
-  intros. simpl in |- *. unfold Nplength in H.
+  intros. simpl. unfold Nplength in H.
   cut (ni (Pplength p0) = ni n0). intro. inversion H4. reflexivity.
-  apply H. intros. change (Nbit (Npos (xO p0)) (S k) = false) in |- *. apply H2. apply lt_n_S. exact H4.
+  apply H. intros. change (N.testbit_nat (Npos (xO p0)) (S k) = false). apply H2. apply lt_n_S. exact H4.
   exact H3.
   intro. case n. trivial.
   intros. simpl in H0. discriminate H0.
@@ -92,10 +90,10 @@ Definition ni_min (d d':natinf) :=
 Lemma ni_min_idemp : forall d:natinf, ni_min d d = d.
 Proof.
   simple induction d; trivial.
-  unfold ni_min in |- *.
+  unfold ni_min.
   simple induction n; trivial.
   intros.
-  simpl in |- *.
+  simpl.
   inversion H.
   rewrite H1.
   rewrite H1.
@@ -107,7 +105,7 @@ Proof.
   simple induction d. simple induction d'; trivial.
   simple induction d'; trivial. elim n. simple induction n0; trivial.
   intros. elim n1; trivial. intros. unfold ni_min in H. cut (min n0 n2 = min n2 n0).
-  intro. unfold ni_min in |- *. simpl in |- *. rewrite H1. reflexivity.
+  intro. unfold ni_min. simpl. rewrite H1. reflexivity.
   cut (ni (min n0 n2) = ni (min n2 n0)). intros.
   inversion H1; trivial.
   exact (H n2).
@@ -118,11 +116,11 @@ Lemma ni_min_assoc :
 Proof.
   simple induction d; trivial. simple induction d'; trivial.
   simple induction d''; trivial.
-  unfold ni_min in |- *. intro. cut (min (min n n0) n1 = min n (min n0 n1)).
+  unfold ni_min. intro. cut (min (min n n0) n1 = min n (min n0 n1)).
   intro. rewrite H. reflexivity.
   generalize n0 n1. elim n; trivial.
   simple induction n3; trivial. simple induction n5; trivial.
-  intros. simpl in |- *. auto.
+  intros. simpl. auto.
 Qed.
 
 Lemma ni_min_O_l : forall d:natinf, ni_min (ni 0) d = ni 0.
@@ -154,42 +152,42 @@ Qed.
 
 Lemma ni_le_antisym : forall d d':natinf, ni_le d d' -> ni_le d' d -> d = d'.
 Proof.
-  unfold ni_le in |- *. intros d d'. rewrite ni_min_comm. intro H. rewrite H. trivial.
+  unfold ni_le. intros d d'. rewrite ni_min_comm. intro H. rewrite H. trivial.
 Qed.
 
 Lemma ni_le_trans :
  forall d d' d'':natinf, ni_le d d' -> ni_le d' d'' -> ni_le d d''.
 Proof.
-  unfold ni_le in |- *. intros. rewrite <- H. rewrite ni_min_assoc. rewrite H0. reflexivity.
+  unfold ni_le. intros. rewrite <- H. rewrite ni_min_assoc. rewrite H0. reflexivity.
 Qed.
 
 Lemma ni_le_min_1 : forall d d':natinf, ni_le (ni_min d d') d.
 Proof.
-  unfold ni_le in |- *. intros. rewrite (ni_min_comm d d'). rewrite ni_min_assoc.
+  unfold ni_le. intros. rewrite (ni_min_comm d d'). rewrite ni_min_assoc.
   rewrite ni_min_idemp. reflexivity.
 Qed.
 
 Lemma ni_le_min_2 : forall d d':natinf, ni_le (ni_min d d') d'.
 Proof.
-  unfold ni_le in |- *. intros. rewrite ni_min_assoc. rewrite ni_min_idemp. reflexivity.
+  unfold ni_le. intros. rewrite ni_min_assoc. rewrite ni_min_idemp. reflexivity.
 Qed.
 
 Lemma ni_min_case : forall d d':natinf, ni_min d d' = d \/ ni_min d d' = d'.
 Proof.
   simple induction d. intro. right. exact (ni_min_inf_l d').
   simple induction d'. left. exact (ni_min_inf_r (ni n)).
-  unfold ni_min in |- *. cut (forall n0:nat, min n n0 = n \/ min n n0 = n0).
+  unfold ni_min. cut (forall n0:nat, min n n0 = n \/ min n n0 = n0).
   intros. case (H n0). intro. left. rewrite H0. reflexivity.
   intro. right. rewrite H0. reflexivity.
   elim n. intro. left. reflexivity.
   simple induction n1. right. reflexivity.
-  intros. case (H n2). intro. left. simpl in |- *. rewrite H1. reflexivity.
-  intro. right. simpl in |- *. rewrite H1. reflexivity.
+  intros. case (H n2). intro. left. simpl. rewrite H1. reflexivity.
+  intro. right. simpl. rewrite H1. reflexivity.
 Qed.
 
 Lemma ni_le_total : forall d d':natinf, ni_le d d' \/ ni_le d' d.
 Proof.
-  unfold ni_le in |- *. intros. rewrite (ni_min_comm d' d). apply ni_min_case.
+  unfold ni_le. intros. rewrite (ni_min_comm d' d). apply ni_min_case.
 Qed.
 
 Lemma ni_le_min_induc :
@@ -203,7 +201,7 @@ Proof.
   apply ni_le_antisym. apply H1. apply ni_le_refl.
   exact H2.
   exact H.
-  intro. rewrite H2. apply ni_le_antisym. apply H1. unfold ni_le in |- *. rewrite ni_min_comm. exact H2.
+  intro. rewrite H2. apply ni_le_antisym. apply H1. unfold ni_le. rewrite ni_min_comm. exact H2.
   apply ni_le_refl.
   exact H0.
 Qed.
@@ -211,40 +209,40 @@ Qed.
 Lemma le_ni_le : forall m n:nat, m <= n -> ni_le (ni m) (ni n).
 Proof.
   cut (forall m n:nat, m <= n -> min m n = m).
-  intros. unfold ni_le, ni_min in |- *. rewrite (H m n H0). reflexivity.
+  intros. unfold ni_le, ni_min. rewrite (H m n H0). reflexivity.
   simple induction m. trivial.
   simple induction n0. intro. inversion H0.
-  intros. simpl in |- *. rewrite (H n1 (le_S_n n n1 H1)). reflexivity.
+  intros. simpl. rewrite (H n1 (le_S_n n n1 H1)). reflexivity.
 Qed.
 
 Lemma ni_le_le : forall m n:nat, ni_le (ni m) (ni n) -> m <= n.
 Proof.
-  unfold ni_le in |- *. unfold ni_min in |- *. intros. inversion H. apply le_min_r.
+  unfold ni_le. unfold ni_min. intros. inversion H. apply le_min_r.
 Qed.
 
 Lemma Nplength_lb :
  forall (a:N) (n:nat),
-   (forall k:nat, k < n -> Nbit a k = false) -> ni_le (ni n) (Nplength a).
+   (forall k:nat, k < n -> N.testbit_nat a k = false) -> ni_le (ni n) (Nplength a).
 Proof.
   simple induction a. intros. exact (ni_min_inf_r (ni n)).
-  intros. unfold Nplength in |- *. apply le_ni_le. case (le_or_lt n (Pplength p)). trivial.
-  intro. absurd (Nbit (Npos p) (Pplength p) = false).
+  intros. unfold Nplength. apply le_ni_le. case (le_or_lt n (Pplength p)). trivial.
+  intro. absurd (N.testbit_nat (Npos p) (Pplength p) = false).
   rewrite
    (Nplength_one (Npos p) (Pplength p)
-      (refl_equal (Nplength (Npos p)))).
+      (eq_refl (Nplength (Npos p)))).
   discriminate.
   apply H. exact H0.
 Qed.
 
 Lemma Nplength_ub :
- forall (a:N) (n:nat), Nbit a n = true -> ni_le (Nplength a) (ni n).
+ forall (a:N) (n:nat), N.testbit_nat a n = true -> ni_le (Nplength a) (ni n).
 Proof.
   simple induction a. intros. discriminate H.
-  intros. unfold Nplength in |- *. apply le_ni_le. case (le_or_lt (Pplength p) n). trivial.
-  intro. absurd (Nbit (Npos p) n = true).
+  intros. unfold Nplength. apply le_ni_le. case (le_or_lt (Pplength p) n). trivial.
+  intro. absurd (N.testbit_nat (Npos p) n = true).
   rewrite
    (Nplength_zeros (Npos p) (Pplength p)
-      (refl_equal (Nplength (Npos p))) n H0).
+      (eq_refl (Nplength (Npos p))) n H0).
   discriminate.
   exact H.
 Qed.
@@ -257,26 +255,26 @@ Qed.
     Instead of working with $d$, we work with $pd$, namely
     [Npdist]: *)
 
-Definition Npdist (a a':N) := Nplength (Nxor a a').
+Definition Npdist (a a':N) := Nplength (N.lxor a a').
 
 (** d is a distance, so $d(a,a')=0$ iff $a=a'$; this means that
     $pd(a,a')=infty$ iff $a=a'$: *)
 
 Lemma Npdist_eq_1 : forall a:N, Npdist a a = infty.
 Proof.
-  intros. unfold Npdist in |- *. rewrite Nxor_nilpotent. reflexivity.
+  intros. unfold Npdist. rewrite N.lxor_nilpotent. reflexivity.
 Qed.
 
 Lemma Npdist_eq_2 : forall a a':N, Npdist a a' = infty -> a = a'.
 Proof.
-  intros. apply Nxor_eq. apply Nplength_infty. exact H.
+  intros. apply N.lxor_eq. apply Nplength_infty. exact H.
 Qed.
 
 (** $d$ is a distance, so $d(a,a')=d(a',a)$: *)
 
 Lemma Npdist_comm : forall a a':N, Npdist a a' = Npdist a' a.
 Proof.
-  unfold Npdist in |- *. intros. rewrite Nxor_comm. reflexivity.
+  unfold Npdist. intros. rewrite N.lxor_comm. reflexivity.
 Qed.
 
 (** $d$ is an ultrametric distance, that is, not only $d(a,a')\leq
@@ -294,21 +292,21 @@ Qed.
 Lemma Nplength_ultra_1 :
  forall a a':N,
    ni_le (Nplength a) (Nplength a') ->
-   ni_le (Nplength a) (Nplength (Nxor a a')).
+   ni_le (Nplength a) (Nplength (N.lxor a a')).
 Proof.
   simple induction a. intros. unfold ni_le in H. unfold Nplength at 1 3 in H.
   rewrite (ni_min_inf_l (Nplength a')) in H.
-  rewrite (Nplength_infty a' H). simpl in |- *. apply ni_le_refl.
-  intros. unfold Nplength at 1 in |- *. apply Nplength_lb. intros.
-  cut (forall a'':N, Nxor (Npos p) a' = a'' -> Nbit a'' k = false).
+  rewrite (Nplength_infty a' H). simpl. apply ni_le_refl.
+  intros. unfold Nplength at 1. apply Nplength_lb. intros.
+  cut (forall a'':N, N.lxor (Npos p) a' = a'' -> N.testbit_nat a'' k = false).
   intros. apply H1. reflexivity.
   intro a''. case a''. intro. reflexivity.
-  intros. rewrite <- H1. rewrite (Nxor_semantics (Npos p) a' k). unfold xorf in |- *.
+  intros. rewrite <- H1. rewrite (Nxor_semantics (Npos p) a' k).
   rewrite
    (Nplength_zeros (Npos p) (Pplength p)
-      (refl_equal (Nplength (Npos p))) k H0).
+      (eq_refl (Nplength (Npos p))) k H0).
   generalize H. case a'. trivial.
-  intros. cut (Nbit (Npos p1) k = false). intros. rewrite H3. reflexivity.
+  intros. cut (N.testbit_nat (Npos p1) k = false). intros. rewrite H3. reflexivity.
   apply Nplength_zeros with (n := Pplength p1). reflexivity.
   apply (lt_le_trans k (Pplength p) (Pplength p1)). exact H0.
   apply ni_le_le. exact H2.
@@ -316,14 +314,14 @@ Qed.
 
 Lemma Nplength_ultra :
  forall a a':N,
-   ni_le (ni_min (Nplength a) (Nplength a')) (Nplength (Nxor a a')).
+   ni_le (ni_min (Nplength a) (Nplength a')) (Nplength (N.lxor a a')).
 Proof.
   intros. case (ni_le_total (Nplength a) (Nplength a')). intro.
   cut (ni_min (Nplength a) (Nplength a') = Nplength a).
   intro. rewrite H0. apply Nplength_ultra_1. exact H.
   exact H.
   intro. cut (ni_min (Nplength a) (Nplength a') = Nplength a').
-  intro. rewrite H0. rewrite Nxor_comm. apply Nplength_ultra_1. exact H.
+  intro. rewrite H0. rewrite N.lxor_comm. apply Nplength_ultra_1. exact H.
   rewrite ni_min_comm. exact H.
 Qed.
 
@@ -331,8 +329,8 @@ Lemma Npdist_ultra :
  forall a a' a'':N,
    ni_le (ni_min (Npdist a a'') (Npdist a'' a')) (Npdist a a').
 Proof.
-  intros. unfold Npdist in |- *. cut (Nxor (Nxor a a'') (Nxor a'' a') = Nxor a a').
+  intros. unfold Npdist. cut (N.lxor (N.lxor a a'') (N.lxor a'' a') = N.lxor a a').
   intro. rewrite <- H. apply Nplength_ultra.
-  rewrite Nxor_assoc. rewrite <- (Nxor_assoc a'' a'' a'). rewrite Nxor_nilpotent.
-  rewrite Nxor_neutral_left. reflexivity.
-Qed.
\ No newline at end of file
+  rewrite N.lxor_assoc. rewrite <- (N.lxor_assoc a'' a'' a'). rewrite N.lxor_nilpotent.
+  rewrite N.lxor_0_l. reflexivity.
+Qed.
diff --git a/theories/NArith/Ndiv_def.v b/theories/NArith/Ndiv_def.v
new file mode 100644
index 00000000..0b220f5d
--- /dev/null
+++ b/theories/NArith/Ndiv_def.v
@@ -0,0 +1,31 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import BinNat.
+Local Open Scope N_scope.
+
+(** Obsolete file, see [BinNat] now,
+    only compatibility notations remain here. *)
+
+Definition Pdiv_eucl a b := N.pos_div_eucl a (Npos b).
+
+Definition Pdiv_eucl_correct a b :
+  let (q,r) := Pdiv_eucl a b in Npos a = q * Npos b + r
+ := N.pos_div_eucl_spec a (Npos b).
+
+Lemma Pdiv_eucl_remainder a b :
+  snd (Pdiv_eucl a b) < Npos b.
+Proof. now apply (N.pos_div_eucl_remainder a (Npos b)). Qed.
+
+Notation Ndiv_eucl := N.div_eucl (compat "8.3").
+Notation Ndiv := N.div (compat "8.3").
+Notation Nmod := N.modulo (compat "8.3").
+
+Notation Ndiv_eucl_correct := N.div_eucl_spec (compat "8.3").
+Notation Ndiv_mod_eq := N.div_mod' (compat "8.3").
+Notation Nmod_lt := N.mod_lt (compat "8.3").
diff --git a/theories/NArith/Ngcd_def.v b/theories/NArith/Ngcd_def.v
new file mode 100644
index 00000000..737cd450
--- /dev/null
+++ b/theories/NArith/Ngcd_def.v
@@ -0,0 +1,22 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import BinPos BinNat.
+Local Open Scope N_scope.
+
+(** Obsolete file, see [BinNat] now,
+    only compatibility notations remain here. *)
+
+Notation Ndivide := N.divide (only parsing).
+Notation Ngcd := N.gcd (only parsing).
+Notation Nggcd := N.ggcd (only parsing).
+Notation Nggcd_gcd := N.ggcd_gcd (only parsing).
+Notation Nggcd_correct_divisors := N.ggcd_correct_divisors (only parsing).
+Notation Ngcd_divide_l := N.gcd_divide_l (only parsing).
+Notation Ngcd_divide_r := N.gcd_divide_r (only parsing).
+Notation Ngcd_greatest := N.gcd_greatest (only parsing).
diff --git a/theories/NArith/Nminmax.v b/theories/NArith/Nminmax.v
deleted file mode 100644
index 58184a4f..00000000
--- a/theories/NArith/Nminmax.v
+++ /dev/null
@@ -1,126 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-Require Import Orders BinNat Nnat NOrderedType GenericMinMax.
-
-(** * Maximum and Minimum of two [N] numbers *)
-
-Local Open Scope N_scope.
-
-(** The functions [Nmax] and [Nmin] implement indeed
-    a maximum and a minimum *)
-
-Lemma Nmax_l : forall x y, y<=x -> Nmax x y = x.
-Proof.
- unfold Nle, Nmax. intros x y.
- generalize (Ncompare_eq_correct x y). rewrite <- (Ncompare_antisym x y).
- destruct (x ?= y); intuition.
-Qed.
-
-Lemma Nmax_r : forall x y, x<=y -> Nmax x y = y.
-Proof.
- unfold Nle, Nmax. intros x y. destruct (x ?= y); intuition.
-Qed.
-
-Lemma Nmin_l : forall x y, x<=y -> Nmin x y = x.
-Proof.
- unfold Nle, Nmin. intros x y. destruct (x ?= y); intuition.
-Qed.
-
-Lemma Nmin_r : forall x y, y<=x -> Nmin x y = y.
-Proof.
- unfold Nle, Nmin. intros x y.
- generalize (Ncompare_eq_correct x y). rewrite <- (Ncompare_antisym x y).
- destruct (x ?= y); intuition.
-Qed.
-
-Module NHasMinMax <: HasMinMax N_as_OT.
- Definition max := Nmax.
- Definition min := Nmin.
- Definition max_l := Nmax_l.
- Definition max_r := Nmax_r.
- Definition min_l := Nmin_l.
- Definition min_r := Nmin_r.
-End NHasMinMax.
-
-Module N.
-
-(** We obtain hence all the generic properties of max and min. *)
-
-Include UsualMinMaxProperties N_as_OT NHasMinMax.
-
-(** * Properties specific to the [positive] domain *)
-
-(** Simplifications *)
-
-Lemma max_0_l : forall n, Nmax 0 n = n.
-Proof.
- intros. unfold Nmax. rewrite <- Ncompare_antisym. generalize (Ncompare_0 n).
- destruct (n ?= 0); intuition.
-Qed.
-
-Lemma max_0_r : forall n, Nmax n 0 = n.
-Proof. intros. rewrite N.max_comm. apply max_0_l. Qed.
-
-Lemma min_0_l : forall n, Nmin 0 n = 0.
-Proof.
- intros. unfold Nmin. rewrite <- Ncompare_antisym. generalize (Ncompare_0 n).
- destruct (n ?= 0); intuition.
-Qed.
-
-Lemma min_0_r : forall n, Nmin n 0 = 0.
-Proof. intros. rewrite N.min_comm. apply min_0_l. Qed.
-
-(** Compatibilities (consequences of monotonicity) *)
-
-Lemma succ_max_distr :
- forall n m, Nsucc (Nmax n m) = Nmax (Nsucc n) (Nsucc m).
-Proof.
- intros. symmetry. apply max_monotone.
- intros x x'. unfold Nle.
- rewrite 2 nat_of_Ncompare, 2 nat_of_Nsucc.
- simpl; auto.
-Qed.
-
-Lemma succ_min_distr : forall n m, Nsucc (Nmin n m) = Nmin (Nsucc n) (Nsucc m).
-Proof.
- intros. symmetry. apply min_monotone.
- intros x x'. unfold Nle.
- rewrite 2 nat_of_Ncompare, 2 nat_of_Nsucc.
- simpl; auto.
-Qed.
-
-Lemma plus_max_distr_l : forall n m p, Nmax (p + n) (p + m) = p + Nmax n m.
-Proof.
- intros. apply max_monotone.
- intros x x'. unfold Nle.
- rewrite 2 nat_of_Ncompare, 2 nat_of_Nplus.
- rewrite <- 2 Compare_dec.nat_compare_le. auto with arith.
-Qed.
-
-Lemma plus_max_distr_r : forall n m p, Nmax (n + p) (m + p) = Nmax n m + p.
-Proof.
- intros. rewrite (Nplus_comm n p), (Nplus_comm m p), (Nplus_comm _ p).
- apply plus_max_distr_l.
-Qed.
-
-Lemma plus_min_distr_l : forall n m p, Nmin (p + n) (p + m) = p + Nmin n m.
-Proof.
- intros. apply min_monotone.
- intros x x'. unfold Nle.
- rewrite 2 nat_of_Ncompare, 2 nat_of_Nplus.
- rewrite <- 2 Compare_dec.nat_compare_le. auto with arith.
-Qed.
-
-Lemma plus_min_distr_r : forall n m p, Nmin (n + p) (m + p) = Nmin n m + p.
-Proof.
- intros. rewrite (Nplus_comm n p), (Nplus_comm m p), (Nplus_comm _ p).
- apply plus_min_distr_l.
-Qed.
-
-End N.
\ No newline at end of file
diff --git a/theories/NArith/Nnat.v b/theories/NArith/Nnat.v
index f57fab0f..1b7e2f24 100644
--- a/theories/NArith/Nnat.v
+++ b/theories/NArith/Nnat.v
@@ -1,370 +1,232 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Nnat.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import Arith_base.
-Require Import Compare_dec.
-Require Import Sumbool.
-Require Import Div2.
-Require Import Min.
-Require Import Max.
-Require Import BinPos.
-Require Import BinNat.
-Require Import BinInt.
-Require Import Pnat.
-Require Import Zmax.
-Require Import Zmin.
-Require Import Znat.
-
-(** Translation from [N] to [nat] and back. *)
-
-Definition nat_of_N (a:N) :=
-  match a with
-  | N0 => 0%nat
-  | Npos p => nat_of_P p
-  end.
-
-Definition N_of_nat (n:nat) :=
-  match n with
-  | O => N0
-  | S n' => Npos (P_of_succ_nat n')
-  end.
-
-Lemma N_of_nat_of_N : forall a:N, N_of_nat (nat_of_N a) = a.
-Proof.
-  destruct a as [| p]. reflexivity.
-  simpl in |- *. elim (ZL4 p). intros n H. rewrite H. simpl in |- *.
-  rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H.
-  rewrite nat_of_P_inj with (1 := H). reflexivity.
-Qed.
-
-Lemma nat_of_N_of_nat : forall n:nat, nat_of_N (N_of_nat n) = n.
-Proof.
-  induction n. trivial.
-  intros. simpl in |- *. apply nat_of_P_o_P_of_succ_nat_eq_succ.
-Qed.
-
-(** Interaction of this translation and usual operations. *)
-
-Lemma nat_of_Ndouble : forall a, nat_of_N (Ndouble a) = 2*(nat_of_N a).
-Proof.
-  destruct a; simpl nat_of_N; auto.
-  apply nat_of_P_xO.
-Qed.
-
-Lemma N_of_double : forall n, N_of_nat (2*n) = Ndouble (N_of_nat n).
-Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  rewrite <- nat_of_Ndouble.
-  apply N_of_nat_of_N.
-Qed.
-
-Lemma nat_of_Ndouble_plus_one :
-  forall a, nat_of_N (Ndouble_plus_one a) = S (2*(nat_of_N a)).
-Proof.
-  destruct a; simpl nat_of_N; auto.
-  apply nat_of_P_xI.
-Qed.
-
-Lemma N_of_double_plus_one :
-  forall n, N_of_nat (S (2*n)) = Ndouble_plus_one (N_of_nat n).
-Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  rewrite <- nat_of_Ndouble_plus_one.
-  apply N_of_nat_of_N.
-Qed.
-
-Lemma nat_of_Nsucc : forall a, nat_of_N (Nsucc a) = S (nat_of_N a).
-Proof.
-  destruct a; simpl.
-  apply nat_of_P_xH.
-  apply nat_of_P_succ_morphism.
-Qed.
-
-Lemma N_of_S : forall n, N_of_nat (S n) = Nsucc (N_of_nat n).
-Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  rewrite <- nat_of_Nsucc.
-  apply N_of_nat_of_N.
-Qed.
-
-Lemma nat_of_Nplus :
-  forall a a', nat_of_N (Nplus a a') = (nat_of_N a)+(nat_of_N a').
-Proof.
-  destruct a; destruct a'; simpl; auto.
-  apply nat_of_P_plus_morphism.
-Qed.
-
-Lemma N_of_plus :
-  forall n n', N_of_nat (n+n') = Nplus (N_of_nat n) (N_of_nat n').
-Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  pattern n' at 1; rewrite <- (nat_of_N_of_nat n').
-  rewrite <- nat_of_Nplus.
-  apply N_of_nat_of_N.
-Qed.
-
-Lemma nat_of_Nminus :
-  forall a a', nat_of_N (Nminus a a') = ((nat_of_N a)-(nat_of_N a'))%nat.
-Proof.
-  destruct a; destruct a'; simpl; auto with arith.
-  case_eq (Pcompare p p0 Eq); simpl; intros.
-  rewrite (Pcompare_Eq_eq _ _ H); auto with arith.
-  rewrite Pminus_mask_diag. simpl. apply minus_n_n.
-  rewrite Pminus_mask_Lt. pose proof (nat_of_P_lt_Lt_compare_morphism _ _ H). simpl.
-  symmetry; apply not_le_minus_0. auto with arith. assumption.
-  pose proof (Pminus_mask_Gt p p0 H) as H1. destruct H1 as [q [H1 _]]. rewrite H1; simpl.
-  replace q with (Pminus p p0) by (unfold Pminus; now rewrite H1).
-  apply nat_of_P_minus_morphism; auto.
-Qed.
-
-Lemma N_of_minus :
-  forall n n', N_of_nat (n-n') = Nminus (N_of_nat n) (N_of_nat n').
-Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  pattern n' at 1; rewrite <- (nat_of_N_of_nat n').
-  rewrite <- nat_of_Nminus.
-  apply N_of_nat_of_N.
-Qed.
-
-Lemma nat_of_Nmult :
-  forall a a', nat_of_N (Nmult a a') = (nat_of_N a)*(nat_of_N a').
-Proof.
-  destruct a; destruct a'; simpl; auto.
-  apply nat_of_P_mult_morphism.
-Qed.
+Require Import Arith_base Compare_dec Sumbool Div2 Min Max.
+Require Import BinPos BinNat Pnat.
 
-Lemma N_of_mult :
-  forall n n', N_of_nat (n*n') = Nmult (N_of_nat n) (N_of_nat n').
-Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  pattern n' at 1; rewrite <- (nat_of_N_of_nat n').
-  rewrite <- nat_of_Nmult.
-  apply N_of_nat_of_N.
-Qed.
-
-Lemma nat_of_Ndiv2 :
-  forall a, nat_of_N (Ndiv2 a) = div2 (nat_of_N a).
-Proof.
-  destruct a; simpl in *; auto.
-  destruct p; auto.
-  rewrite nat_of_P_xI.
-  rewrite div2_double_plus_one; auto.
-  rewrite nat_of_P_xO.
-  rewrite div2_double; auto.
-Qed.
-
-Lemma N_of_div2 :
-  forall n, N_of_nat (div2 n) = Ndiv2 (N_of_nat n).
-Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  rewrite <- nat_of_Ndiv2.
-  apply N_of_nat_of_N.
-Qed.
-
-Lemma nat_of_Ncompare :
- forall a a', Ncompare a a' = nat_compare (nat_of_N a) (nat_of_N a').
-Proof.
-  destruct a; destruct a'; simpl.
-  reflexivity.
-  assert (NZ : 0 < nat_of_P p) by auto using lt_O_nat_of_P.
-  destruct nat_of_P; [inversion NZ|auto].
-  assert (NZ : 0 < nat_of_P p) by auto using lt_O_nat_of_P.
-  destruct nat_of_P; [inversion NZ|auto].
-  apply nat_of_P_compare_morphism.
-Qed.
+(** * Conversions from [N] to [nat] *)
 
-Lemma N_of_nat_compare :
- forall n n', nat_compare n n' = Ncompare (N_of_nat n) (N_of_nat n').
-Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  pattern n' at 1; rewrite <- (nat_of_N_of_nat n').
-  symmetry; apply nat_of_Ncompare.
-Qed.
+Module N2Nat.
 
-Lemma nat_of_Nmin :
-  forall a a', nat_of_N (Nmin a a') = min (nat_of_N a) (nat_of_N a').
-Proof.
-  intros; unfold Nmin; rewrite nat_of_Ncompare.
-  rewrite nat_compare_equiv; unfold nat_compare_alt.
-  destruct (lt_eq_lt_dec (nat_of_N a) (nat_of_N a')) as [[|]|];
-    simpl; intros; symmetry; auto with arith.
-  apply min_l; rewrite e; auto with arith.
-Qed.
+(** [N.to_nat] is a bijection between [N] and [nat],
+    with [Pos.of_nat] as reciprocal.
+    See [Nat2N.id] below for the dual equation. *)
 
-Lemma N_of_min :
-  forall n n', N_of_nat (min n n') = Nmin (N_of_nat n) (N_of_nat n').
+Lemma id a : N.of_nat (N.to_nat a) = a.
 Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  pattern n' at 1; rewrite <- (nat_of_N_of_nat n').
-  rewrite <- nat_of_Nmin.
-  apply N_of_nat_of_N.
+ destruct a as [| p]; simpl; trivial.
+ destruct (Pos2Nat.is_succ p) as (n,H). rewrite H. simpl. f_equal.
+ apply Pos2Nat.inj. rewrite H. apply SuccNat2Pos.id_succ.
 Qed.
 
-Lemma nat_of_Nmax :
-  forall a a', nat_of_N (Nmax a a') = max (nat_of_N a) (nat_of_N a').
-Proof.
-  intros; unfold Nmax; rewrite nat_of_Ncompare.
-  rewrite nat_compare_equiv; unfold nat_compare_alt.
-  destruct (lt_eq_lt_dec (nat_of_N a) (nat_of_N a')) as [[|]|];
-    simpl; intros; symmetry; auto with arith.
-  apply max_r; rewrite e; auto with arith.
-Qed.
+(** [N.to_nat] is hence injective *)
 
-Lemma N_of_max :
-  forall n n', N_of_nat (max n n') = Nmax (N_of_nat n) (N_of_nat n').
+Lemma inj a a' : N.to_nat a = N.to_nat a' -> a = a'.
 Proof.
-  intros.
-  pattern n at 1; rewrite <- (nat_of_N_of_nat n).
-  pattern n' at 1; rewrite <- (nat_of_N_of_nat n').
-  rewrite <- nat_of_Nmax.
-  apply N_of_nat_of_N.
+ intro H. rewrite <- (id a), <- (id a'). now f_equal.
 Qed.
 
-(** Properties concerning [Z_of_N] *)
-
-Lemma Z_of_nat_of_N : forall n:N, Z_of_nat (nat_of_N n) = Z_of_N n.
+Lemma inj_iff a a' : N.to_nat a = N.to_nat a' <-> a = a'.
 Proof.
-  destruct n; simpl; auto; symmetry; apply Zpos_eq_Z_of_nat_o_nat_of_P.
+ split. apply inj. intros; now subst.
 Qed.
 
-Lemma Z_of_N_eq : forall n m, n = m -> Z_of_N n = Z_of_N m.
-Proof.
- intros; f_equal; assumption.
-Qed.
+(** Interaction of this translation and usual operations. *)
 
-Lemma Z_of_N_eq_rev : forall n m, Z_of_N n = Z_of_N m -> n = m.
+Lemma inj_double a : N.to_nat (N.double a) = 2*(N.to_nat a).
 Proof.
- intros [|n] [|m]; simpl; intros; try discriminate; congruence.
+ destruct a; simpl N.to_nat; trivial. apply Pos2Nat.inj_xO.
 Qed.
 
-Lemma Z_of_N_eq_iff : forall n m, n = m <-> Z_of_N n = Z_of_N m.
+Lemma inj_succ_double a : N.to_nat (N.succ_double a) = S (2*(N.to_nat a)).
 Proof.
- split; [apply Z_of_N_eq | apply Z_of_N_eq_rev].
+ destruct a; simpl N.to_nat; trivial. apply Pos2Nat.inj_xI.
 Qed.
 
-Lemma Z_of_N_le : forall n m, (n<=m)%N -> (Z_of_N n <= Z_of_N m)%Z.
+Lemma inj_succ a : N.to_nat (N.succ a) = S (N.to_nat a).
 Proof.
- intros [|n] [|m]; simpl; auto.
+ destruct a; simpl; trivial. apply Pos2Nat.inj_succ.
 Qed.
 
-Lemma Z_of_N_le_rev : forall n m, (Z_of_N n <= Z_of_N m)%Z -> (n<=m)%N.
+Lemma inj_add a a' :
+  N.to_nat (a + a') = N.to_nat a + N.to_nat a'.
 Proof.
- intros [|n] [|m]; simpl; auto.
+ destruct a, a'; simpl; trivial. apply Pos2Nat.inj_add.
 Qed.
 
-Lemma Z_of_N_le_iff : forall n m, (n<=m)%N <-> (Z_of_N n <= Z_of_N m)%Z.
+Lemma inj_mul a a' :
+  N.to_nat (a * a') = N.to_nat a * N.to_nat a'.
 Proof.
- split; [apply Z_of_N_le | apply Z_of_N_le_rev].
+ destruct a, a'; simpl; trivial. apply Pos2Nat.inj_mul.
 Qed.
 
-Lemma Z_of_N_lt : forall n m, (n<m)%N -> (Z_of_N n < Z_of_N m)%Z.
+Lemma inj_sub a a' :
+  N.to_nat (a - a') = N.to_nat a - N.to_nat a'.
 Proof.
- intros [|n] [|m]; simpl; auto.
+ destruct a as [|a], a' as [|a']; simpl; auto with arith.
+ destruct (Pos.compare_spec a a').
+ subst. now rewrite Pos.sub_mask_diag, <- minus_n_n.
+ rewrite Pos.sub_mask_neg; trivial. apply Pos2Nat.inj_lt in H.
+ simpl; symmetry; apply not_le_minus_0; auto with arith.
+ destruct (Pos.sub_mask_pos' _ _ H) as (q & -> & Hq).
+ simpl. apply plus_minus. now rewrite <- Hq, Pos2Nat.inj_add.
 Qed.
 
-Lemma Z_of_N_lt_rev : forall n m, (Z_of_N n < Z_of_N m)%Z -> (n<m)%N.
+Lemma inj_pred a : N.to_nat (N.pred a) = pred (N.to_nat a).
 Proof.
- intros [|n] [|m]; simpl; auto.
+ intros. rewrite pred_of_minus, N.pred_sub. apply inj_sub.
 Qed.
 
-Lemma Z_of_N_lt_iff : forall n m, (n<m)%N <-> (Z_of_N n < Z_of_N m)%Z.
+Lemma inj_div2 a : N.to_nat (N.div2 a) = div2 (N.to_nat a).
 Proof.
- split; [apply Z_of_N_lt | apply Z_of_N_lt_rev].
+ destruct a as [|[p|p| ]]; trivial.
+ simpl N.to_nat. now rewrite Pos2Nat.inj_xI, div2_double_plus_one.
+ simpl N.to_nat. now rewrite Pos2Nat.inj_xO, div2_double.
 Qed.
 
-Lemma Z_of_N_ge : forall n m, (n>=m)%N -> (Z_of_N n >= Z_of_N m)%Z.
+Lemma inj_compare a a' :
+ (a ?= a')%N = nat_compare (N.to_nat a) (N.to_nat a').
 Proof.
- intros [|n] [|m]; simpl; auto.
+ destruct a, a'; simpl; trivial.
+ now destruct (Pos2Nat.is_succ p) as (n,->).
+ now destruct (Pos2Nat.is_succ p) as (n,->).
+ apply Pos2Nat.inj_compare.
 Qed.
 
-Lemma Z_of_N_ge_rev : forall n m, (Z_of_N n >= Z_of_N m)%Z -> (n>=m)%N.
+Lemma inj_max a a' :
+  N.to_nat (N.max a a') = max (N.to_nat a) (N.to_nat a').
 Proof.
- intros [|n] [|m]; simpl; auto.
+ unfold N.max. rewrite inj_compare; symmetry.
+ case nat_compare_spec; intros H; try rewrite H; auto with arith.
 Qed.
 
-Lemma Z_of_N_ge_iff : forall n m, (n>=m)%N <-> (Z_of_N n >= Z_of_N m)%Z.
+Lemma inj_min a a' :
+  N.to_nat (N.min a a') = min (N.to_nat a) (N.to_nat a').
 Proof.
- split; [apply Z_of_N_ge | apply Z_of_N_ge_rev].
+  unfold N.min; rewrite inj_compare. symmetry.
+  case nat_compare_spec; intros H; try rewrite H; auto with arith.
 Qed.
 
-Lemma Z_of_N_gt : forall n m, (n>m)%N -> (Z_of_N n > Z_of_N m)%Z.
+Lemma inj_iter a {A} (f:A->A) (x:A) :
+  N.iter a f x = nat_iter (N.to_nat a) f x.
 Proof.
- intros [|n] [|m]; simpl; auto.
+ destruct a as [|a]. trivial. apply Pos2Nat.inj_iter.
 Qed.
 
-Lemma Z_of_N_gt_rev : forall n m, (Z_of_N n > Z_of_N m)%Z -> (n>m)%N.
-Proof.
- intros [|n] [|m]; simpl; auto.
-Qed.
+End N2Nat.
 
-Lemma Z_of_N_gt_iff : forall n m, (n>m)%N <-> (Z_of_N n > Z_of_N m)%Z.
-Proof.
- split; [apply Z_of_N_gt | apply Z_of_N_gt_rev].
-Qed.
+Hint Rewrite N2Nat.inj_double N2Nat.inj_succ_double
+ N2Nat.inj_succ N2Nat.inj_add N2Nat.inj_mul N2Nat.inj_sub
+ N2Nat.inj_pred N2Nat.inj_div2 N2Nat.inj_max N2Nat.inj_min
+ N2Nat.id
+ : Nnat.
 
-Lemma Z_of_N_of_nat : forall n:nat, Z_of_N (N_of_nat n) = Z_of_nat n.
-Proof.
- destruct n; simpl; auto.
-Qed.
 
-Lemma Z_of_N_pos : forall p:positive, Z_of_N (Npos p) = Zpos p.
-Proof.
- destruct p; simpl; auto.
-Qed.
+(** * Conversions from [nat] to [N] *)
 
-Lemma Z_of_N_abs : forall z:Z, Z_of_N (Zabs_N z) = Zabs z.
-Proof.
- destruct z; simpl; auto.
-Qed.
+Module Nat2N.
 
-Lemma Z_of_N_le_0 : forall n, (0 <= Z_of_N n)%Z.
-Proof.
- destruct n; intro; discriminate.
-Qed.
+(** [N.of_nat] is an bijection between [nat] and [N],
+    with [Pos.to_nat] as reciprocal.
+    See [N2Nat.id] above for the dual equation. *)
 
-Lemma Z_of_N_plus : forall n m:N, Z_of_N (n+m) = (Z_of_N n + Z_of_N m)%Z.
+Lemma id n : N.to_nat (N.of_nat n) = n.
 Proof.
- destruct n; destruct m; auto.
+ induction n; simpl; trivial. apply SuccNat2Pos.id_succ.
 Qed.
 
-Lemma Z_of_N_mult : forall n m:N, Z_of_N (n*m) = (Z_of_N n * Z_of_N m)%Z.
-Proof.
- destruct n; destruct m; auto.
-Qed.
+Hint Rewrite id : Nnat.
+Ltac nat2N := apply N2Nat.inj; now autorewrite with Nnat.
 
-Lemma Z_of_N_minus : forall n m:N, Z_of_N (n-m) = Zmax 0 (Z_of_N n - Z_of_N m).
-Proof.
- intros; do 3 rewrite <- Z_of_nat_of_N; rewrite nat_of_Nminus; apply inj_minus.
-Qed.
+(** [N.of_nat] is hence injective *)
 
-Lemma Z_of_N_succ : forall n:N, Z_of_N (Nsucc n) = Zsucc (Z_of_N n).
+Lemma inj n n' : N.of_nat n = N.of_nat n' -> n = n'.
 Proof.
- intros; do 2 rewrite <- Z_of_nat_of_N; rewrite nat_of_Nsucc; apply inj_S.
+ intros H. rewrite <- (id n), <- (id n'). now f_equal.
 Qed.
 
-Lemma Z_of_N_min : forall n m:N, Z_of_N (Nmin n m) = Zmin (Z_of_N n) (Z_of_N m).
+Lemma inj_iff n n' : N.of_nat n = N.of_nat n' <-> n = n'.
 Proof.
- intros; do 3 rewrite <- Z_of_nat_of_N; rewrite nat_of_Nmin; apply inj_min.
+ split. apply inj. intros; now subst.
 Qed.
 
-Lemma Z_of_N_max : forall n m:N, Z_of_N (Nmax n m) = Zmax (Z_of_N n) (Z_of_N m).
-Proof.
- intros; do 3 rewrite <- Z_of_nat_of_N; rewrite nat_of_Nmax; apply inj_max.
-Qed.
+(** Interaction of this translation and usual operations. *)
 
+Lemma inj_double n : N.of_nat (2*n) = N.double (N.of_nat n).
+Proof. nat2N. Qed.
+
+Lemma inj_succ_double n : N.of_nat (S (2*n)) = N.succ_double (N.of_nat n).
+Proof. nat2N. Qed.
+
+Lemma inj_succ n : N.of_nat (S n) = N.succ (N.of_nat n).
+Proof. nat2N. Qed.
+
+Lemma inj_pred n : N.of_nat (pred n) = N.pred (N.of_nat n).
+Proof. nat2N. Qed.
+
+Lemma inj_add n n' : N.of_nat (n+n') = (N.of_nat n + N.of_nat n')%N.
+Proof. nat2N. Qed.
+
+Lemma inj_sub n n' : N.of_nat (n-n') = (N.of_nat n - N.of_nat n')%N.
+Proof. nat2N. Qed.
+
+Lemma inj_mul n n' : N.of_nat (n*n') = (N.of_nat n * N.of_nat n')%N.
+Proof. nat2N. Qed.
+
+Lemma inj_div2 n : N.of_nat (div2 n) = N.div2 (N.of_nat n).
+Proof. nat2N. Qed.
+
+Lemma inj_compare n n' :
+  nat_compare n n' = (N.of_nat n ?= N.of_nat n')%N.
+Proof. now rewrite N2Nat.inj_compare, !id. Qed.
+
+Lemma inj_min n n' :
+  N.of_nat (min n n') = N.min (N.of_nat n) (N.of_nat n').
+Proof. nat2N. Qed.
+
+Lemma inj_max n n' :
+  N.of_nat (max n n') = N.max (N.of_nat n) (N.of_nat n').
+Proof. nat2N. Qed.
+
+Lemma inj_iter n {A} (f:A->A) (x:A) :
+  nat_iter n f x = N.iter (N.of_nat n) f x.
+Proof. now rewrite N2Nat.inj_iter, !id. Qed.
+
+End Nat2N.
+
+Hint Rewrite Nat2N.id : Nnat.
+
+(** Compatibility notations *)
+
+Notation nat_of_N_inj := N2Nat.inj (compat "8.3").
+Notation N_of_nat_of_N := N2Nat.id (compat "8.3").
+Notation nat_of_Ndouble := N2Nat.inj_double (compat "8.3").
+Notation nat_of_Ndouble_plus_one := N2Nat.inj_succ_double (compat "8.3").
+Notation nat_of_Nsucc := N2Nat.inj_succ (compat "8.3").
+Notation nat_of_Nplus := N2Nat.inj_add (compat "8.3").
+Notation nat_of_Nmult := N2Nat.inj_mul (compat "8.3").
+Notation nat_of_Nminus := N2Nat.inj_sub (compat "8.3").
+Notation nat_of_Npred := N2Nat.inj_pred (compat "8.3").
+Notation nat_of_Ndiv2 := N2Nat.inj_div2 (compat "8.3").
+Notation nat_of_Ncompare := N2Nat.inj_compare (compat "8.3").
+Notation nat_of_Nmax := N2Nat.inj_max (compat "8.3").
+Notation nat_of_Nmin := N2Nat.inj_min (compat "8.3").
+
+Notation nat_of_N_of_nat := Nat2N.id (compat "8.3").
+Notation N_of_nat_inj := Nat2N.inj (compat "8.3").
+Notation N_of_double := Nat2N.inj_double (compat "8.3").
+Notation N_of_double_plus_one := Nat2N.inj_succ_double (compat "8.3").
+Notation N_of_S := Nat2N.inj_succ (compat "8.3").
+Notation N_of_pred := Nat2N.inj_pred (compat "8.3").
+Notation N_of_plus := Nat2N.inj_add (compat "8.3").
+Notation N_of_minus := Nat2N.inj_sub (compat "8.3").
+Notation N_of_mult := Nat2N.inj_mul (compat "8.3").
+Notation N_of_div2 := Nat2N.inj_div2 (compat "8.3").
+Notation N_of_nat_compare := Nat2N.inj_compare (compat "8.3").
+Notation N_of_min := Nat2N.inj_min (compat "8.3").
+Notation N_of_max := Nat2N.inj_max (compat "8.3").
diff --git a/theories/NArith/Nsqrt_def.v b/theories/NArith/Nsqrt_def.v
new file mode 100644
index 00000000..240d7469
--- /dev/null
+++ b/theories/NArith/Nsqrt_def.v
@@ -0,0 +1,18 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import BinNat.
+
+(** Obsolete file, see [BinNat] now,
+    only compatibility notations remain here. *)
+
+Notation Nsqrtrem := N.sqrtrem (compat "8.3").
+Notation Nsqrt := N.sqrt (compat "8.3").
+Notation Nsqrtrem_spec := N.sqrtrem_spec (compat "8.3").
+Notation Nsqrt_spec := (fun n => N.sqrt_spec n (N.le_0_l n)) (compat "8.3").
+Notation Nsqrtrem_sqrt := N.sqrtrem_sqrt (compat "8.3").
diff --git a/theories/NArith/Pminmax.v b/theories/NArith/Pminmax.v
deleted file mode 100644
index 6bac033c..00000000
--- a/theories/NArith/Pminmax.v
+++ /dev/null
@@ -1,126 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-Require Import Orders BinPos Pnat POrderedType GenericMinMax.
-
-(** * Maximum and Minimum of two positive numbers *)
-
-Local Open Scope positive_scope.
-
-(** The functions [Pmax] and [Pmin] implement indeed
-    a maximum and a minimum *)
-
-Lemma Pmax_l : forall x y, y<=x -> Pmax x y = x.
-Proof.
- unfold Ple, Pmax. intros x y.
- rewrite (ZC4 y x). generalize (Pcompare_eq_iff x y).
- destruct ((x ?= y) Eq); intuition.
-Qed.
-
-Lemma Pmax_r : forall x y, x<=y -> Pmax x y = y.
-Proof.
- unfold Ple, Pmax. intros x y. destruct ((x ?= y) Eq); intuition.
-Qed.
-
-Lemma Pmin_l : forall x y, x<=y -> Pmin x y = x.
-Proof.
- unfold Ple, Pmin. intros x y. destruct ((x ?= y) Eq); intuition.
-Qed.
-
-Lemma Pmin_r : forall x y, y<=x -> Pmin x y = y.
-Proof.
- unfold Ple, Pmin. intros x y.
- rewrite (ZC4 y x). generalize (Pcompare_eq_iff x y).
- destruct ((x ?= y) Eq); intuition.
-Qed.
-
-Module PositiveHasMinMax <: HasMinMax Positive_as_OT.
- Definition max := Pmax.
- Definition min := Pmin.
- Definition max_l := Pmax_l.
- Definition max_r := Pmax_r.
- Definition min_l := Pmin_l.
- Definition min_r := Pmin_r.
-End PositiveHasMinMax.
-
-
-Module P.
-(** We obtain hence all the generic properties of max and min. *)
-
-Include UsualMinMaxProperties Positive_as_OT PositiveHasMinMax.
-
-(** * Properties specific to the [positive] domain *)
-
-(** Simplifications *)
-
-Lemma max_1_l : forall n, Pmax 1 n = n.
-Proof.
- intros. unfold Pmax. rewrite ZC4. generalize (Pcompare_1 n).
- destruct (n ?= 1); intuition.
-Qed.
-
-Lemma max_1_r : forall n, Pmax n 1 = n.
-Proof. intros. rewrite P.max_comm. apply max_1_l. Qed.
-
-Lemma min_1_l : forall n, Pmin 1 n = 1.
-Proof.
- intros. unfold Pmin. rewrite ZC4. generalize (Pcompare_1 n).
- destruct (n ?= 1); intuition.
-Qed.
-
-Lemma min_1_r : forall n, Pmin n 1 = 1.
-Proof. intros. rewrite P.min_comm. apply min_1_l. Qed.
-
-(** Compatibilities (consequences of monotonicity) *)
-
-Lemma succ_max_distr :
- forall n m, Psucc (Pmax n m) = Pmax (Psucc n) (Psucc m).
-Proof.
- intros. symmetry. apply max_monotone.
- intros x x'. unfold Ple.
- rewrite 2 nat_of_P_compare_morphism, 2 nat_of_P_succ_morphism.
- simpl; auto.
-Qed.
-
-Lemma succ_min_distr : forall n m, Psucc (Pmin n m) = Pmin (Psucc n) (Psucc m).
-Proof.
- intros. symmetry. apply min_monotone.
- intros x x'. unfold Ple.
- rewrite 2 nat_of_P_compare_morphism, 2 nat_of_P_succ_morphism.
- simpl; auto.
-Qed.
-
-Lemma plus_max_distr_l : forall n m p, Pmax (p + n) (p + m) = p + Pmax n m.
-Proof.
- intros. apply max_monotone.
- intros x x'. unfold Ple.
- rewrite 2 nat_of_P_compare_morphism, 2 nat_of_P_plus_morphism.
- rewrite <- 2 Compare_dec.nat_compare_le. auto with arith.
-Qed.
-
-Lemma plus_max_distr_r : forall n m p, Pmax (n + p) (m + p) = Pmax n m + p.
-Proof.
- intros. rewrite (Pplus_comm n p), (Pplus_comm m p), (Pplus_comm _ p).
- apply plus_max_distr_l.
-Qed.
-
-Lemma plus_min_distr_l : forall n m p, Pmin (p + n) (p + m) = p + Pmin n m.
-Proof.
- intros. apply min_monotone.
- intros x x'. unfold Ple.
- rewrite 2 nat_of_P_compare_morphism, 2 nat_of_P_plus_morphism.
- rewrite <- 2 Compare_dec.nat_compare_le. auto with arith.
-Qed.
-
-Lemma plus_min_distr_r : forall n m p, Pmin (n + p) (m + p) = Pmin n m + p.
-Proof.
- intros. rewrite (Pplus_comm n p), (Pplus_comm m p), (Pplus_comm _ p).
- apply plus_min_distr_l.
-Qed.
-
-End P.
\ No newline at end of file
diff --git a/theories/NArith/Pnat.v b/theories/NArith/Pnat.v
deleted file mode 100644
index 29641dbe..00000000
--- a/theories/NArith/Pnat.v
+++ /dev/null
@@ -1,462 +0,0 @@
-(* -*- coding: utf-8 -*- *)
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(*i $Id: Pnat.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import BinPos.
-
-(**********************************************************************)
-(** Properties of the injection from binary positive numbers to Peano
-    natural numbers *)
-
-(** Original development by Pierre Crégut, CNET, Lannion, France *)
-
-Require Import Le.
-Require Import Lt.
-Require Import Gt.
-Require Import Plus.
-Require Import Mult.
-Require Import Minus.
-Require Import Compare_dec.
-
-Local Open Scope positive_scope.
-Local Open Scope nat_scope.
-
-(** [nat_of_P] is a morphism for addition *)
-
-Lemma Pmult_nat_succ_morphism :
- forall (p:positive) (n:nat), Pmult_nat (Psucc p) n = n + Pmult_nat p n.
-Proof.
-intro x; induction x as [p IHp| p IHp| ]; simpl in |- *; auto; intro m;
- rewrite IHp; rewrite plus_assoc; trivial.
-Qed.
-
-Lemma nat_of_P_succ_morphism :
- forall p:positive, nat_of_P (Psucc p) = S (nat_of_P p).
-Proof.
-  intro; change (S (nat_of_P p)) with (1 + nat_of_P p) in |- *;
-   unfold nat_of_P in |- *; apply Pmult_nat_succ_morphism.
-Qed.
-
-Theorem Pmult_nat_plus_carry_morphism :
- forall (p q:positive) (n:nat),
-   Pmult_nat (Pplus_carry p q) n = n + Pmult_nat (p + q) n.
-Proof.
-intro x; induction x as [p IHp| p IHp| ]; intro y;
- [ destruct y as [p0| p0| ]
- | destruct y as [p0| p0| ]
- | destruct y as [p| p| ] ]; simpl in |- *; auto with arith;
- intro m;
- [ rewrite IHp; rewrite plus_assoc; trivial with arith
- | rewrite IHp; rewrite plus_assoc; trivial with arith
- | rewrite Pmult_nat_succ_morphism; rewrite plus_assoc; trivial with arith
- | rewrite Pmult_nat_succ_morphism; apply plus_assoc_reverse ].
-Qed.
-
-Theorem nat_of_P_plus_carry_morphism :
- forall p q:positive, nat_of_P (Pplus_carry p q) = S (nat_of_P (p + q)).
-Proof.
-intros; unfold nat_of_P in |- *; rewrite Pmult_nat_plus_carry_morphism;
- simpl in |- *; trivial with arith.
-Qed.
-
-Theorem Pmult_nat_l_plus_morphism :
- forall (p q:positive) (n:nat),
-   Pmult_nat (p + q) n = Pmult_nat p n + Pmult_nat q n.
-Proof.
-intro x; induction x as [p IHp| p IHp| ]; intro y;
- [ destruct y as [p0| p0| ]
- | destruct y as [p0| p0| ]
- | destruct y as [p| p| ] ]; simpl in |- *; auto with arith;
- [ intros m; rewrite Pmult_nat_plus_carry_morphism; rewrite IHp;
-    rewrite plus_assoc_reverse; rewrite plus_assoc_reverse;
-    rewrite (plus_permute m (Pmult_nat p (m + m)));
-    trivial with arith
- | intros m; rewrite IHp; apply plus_assoc
- | intros m; rewrite Pmult_nat_succ_morphism;
-    rewrite (plus_comm (m + Pmult_nat p (m + m)));
-    apply plus_assoc_reverse
- | intros m; rewrite IHp; apply plus_permute
- | intros m; rewrite Pmult_nat_succ_morphism; apply plus_assoc_reverse ].
-Qed.
-
-Theorem nat_of_P_plus_morphism :
- forall p q:positive, nat_of_P (p + q) = nat_of_P p + nat_of_P q.
-Proof.
-intros x y; exact (Pmult_nat_l_plus_morphism x y 1).
-Qed.
-
-(** [Pmult_nat] is a morphism for addition *)
-
-Lemma Pmult_nat_r_plus_morphism :
- forall (p:positive) (n:nat),
-   Pmult_nat p (n + n) = Pmult_nat p n + Pmult_nat p n.
-Proof.
-intro y; induction y as [p H| p H| ]; intro m;
- [ simpl in |- *; rewrite H; rewrite plus_assoc_reverse;
-    rewrite (plus_permute m (Pmult_nat p (m + m)));
-    rewrite plus_assoc_reverse; auto with arith
- | simpl in |- *; rewrite H; auto with arith
- | simpl in |- *; trivial with arith ].
-Qed.
-
-Lemma ZL6 : forall p:positive, Pmult_nat p 2 = nat_of_P p + nat_of_P p.
-Proof.
-intro p; change 2 with (1 + 1) in |- *; rewrite Pmult_nat_r_plus_morphism;
- trivial.
-Qed.
-
-(** [nat_of_P] is a morphism for multiplication *)
-
-Theorem nat_of_P_mult_morphism :
- forall p q:positive, nat_of_P (p * q) = nat_of_P p * nat_of_P q.
-Proof.
-intros x y; induction x as [x' H| x' H| ];
- [ change (xI x' * y)%positive with (y + xO (x' * y))%positive in |- *;
-    rewrite nat_of_P_plus_morphism; unfold nat_of_P at 2 3 in |- *;
-    simpl in |- *; do 2 rewrite ZL6; rewrite H; rewrite mult_plus_distr_r;
-    reflexivity
- | unfold nat_of_P at 1 2 in |- *; simpl in |- *; do 2 rewrite ZL6; rewrite H;
-    rewrite mult_plus_distr_r; reflexivity
- | simpl in |- *; rewrite <- plus_n_O; reflexivity ].
-Qed.
-
-(** [nat_of_P] maps to the strictly positive subset of [nat] *)
-
-Lemma ZL4 : forall p:positive,  exists h : nat, nat_of_P p = S h.
-Proof.
-intro y; induction y as [p H| p H| ];
- [ destruct H as [x H1]; exists (S x + S x); unfold nat_of_P in |- *;
-    simpl in |- *; change 2 with (1 + 1) in |- *;
-    rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H1;
-    rewrite H1; auto with arith
- | destruct H as [x H2]; exists (x + S x); unfold nat_of_P in |- *;
-    simpl in |- *; change 2 with (1 + 1) in |- *;
-    rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H2;
-    rewrite H2; auto with arith
- | exists 0; auto with arith ].
-Qed.
-
-(** Extra lemmas on [lt] on Peano natural numbers *)
-
-Lemma ZL7 : forall n m:nat, n < m -> n + n < m + m.
-Proof.
-intros m n H; apply lt_trans with (m := m + n);
- [ apply plus_lt_compat_l with (1 := H)
- | rewrite (plus_comm m n); apply plus_lt_compat_l with (1 := H) ].
-Qed.
-
-Lemma ZL8 : forall n m:nat, n < m -> S (n + n) < m + m.
-Proof.
-intros m n H; apply le_lt_trans with (m := m + n);
- [ change (m + m < m + n) in |- *; apply plus_lt_compat_l with (1 := H)
- | rewrite (plus_comm m n); apply plus_lt_compat_l with (1 := H) ].
-Qed.
-
-(** [nat_of_P] is a morphism from [positive] to [nat] for [lt] (expressed
-    from [compare] on [positive])
-
-    Part 1: [lt] on [positive] is finer than [lt] on [nat]
-*)
-
-Lemma nat_of_P_lt_Lt_compare_morphism :
- forall p q:positive, (p ?= q) Eq = Lt -> nat_of_P p < nat_of_P q.
-Proof.
-intro x; induction x as [p H| p H| ]; intro y; destruct y as [q| q| ];
- intro H2;
- [ unfold nat_of_P in |- *; simpl in |- *; apply lt_n_S; do 2 rewrite ZL6;
-    apply ZL7; apply H; simpl in H2; assumption
- | unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6; apply ZL8;
-    apply H; simpl in H2; apply Pcompare_Gt_Lt; assumption
- | simpl in |- *; discriminate H2
- | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6;
-    elim (Pcompare_Lt_Lt p q H2);
-    [ intros H3; apply lt_S; apply ZL7; apply H; apply H3
-    | intros E; rewrite E; apply lt_n_Sn ]
- | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6;
-    apply ZL7; apply H; assumption
- | simpl in |- *; discriminate H2
- | unfold nat_of_P in |- *; simpl in |- *; apply lt_n_S; rewrite ZL6;
-    elim (ZL4 q); intros h H3; rewrite H3; simpl in |- *;
-    apply lt_O_Sn
- | unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; elim (ZL4 q);
-    intros h H3; rewrite H3; simpl in |- *; rewrite <- plus_n_Sm;
-    apply lt_n_S; apply lt_O_Sn
- | simpl in |- *; discriminate H2 ].
-Qed.
-
-(** [nat_of_P] is a morphism from [positive] to [nat] for [gt] (expressed
-    from [compare] on [positive])
-
-    Part 1: [gt] on [positive] is finer than [gt] on [nat]
-*)
-
-Lemma nat_of_P_gt_Gt_compare_morphism :
- forall p q:positive, (p ?= q) Eq = Gt -> nat_of_P p > nat_of_P q.
-Proof.
-intros p q GT. unfold gt.
-apply nat_of_P_lt_Lt_compare_morphism.
-change ((q ?= p) (CompOpp Eq) = CompOpp Gt).
-rewrite <- Pcompare_antisym, GT; auto.
-Qed.
-
-(** [nat_of_P] is a morphism for [Pcompare] and [nat_compare] *)
-
-Lemma nat_of_P_compare_morphism : forall p q,
- (p ?= q) Eq = nat_compare (nat_of_P p) (nat_of_P q).
-Proof.
- intros p q; symmetry.
- destruct ((p ?= q) Eq) as [ | | ]_eqn.
- rewrite (Pcompare_Eq_eq p q); auto.
- apply <- nat_compare_eq_iff; auto.
- apply -> nat_compare_lt. apply nat_of_P_lt_Lt_compare_morphism; auto.
- apply -> nat_compare_gt. apply nat_of_P_gt_Gt_compare_morphism; auto.
-Qed.
-
-(** [nat_of_P] is hence injective. *)
-
-Lemma nat_of_P_inj : forall p q:positive, nat_of_P p = nat_of_P q -> p = q.
-Proof.
-intros.
-apply Pcompare_Eq_eq.
-rewrite nat_of_P_compare_morphism.
-apply <- nat_compare_eq_iff; auto.
-Qed.
-
-(** [nat_of_P] is a morphism from [positive] to [nat] for [lt] (expressed
-    from [compare] on [positive])
-
-    Part 2: [lt] on [nat] is finer than [lt] on [positive]
-*)
-
-Lemma nat_of_P_lt_Lt_compare_complement_morphism :
- forall p q:positive, nat_of_P p < nat_of_P q -> (p ?= q) Eq = Lt.
-Proof.
- intros. rewrite nat_of_P_compare_morphism.
- apply -> nat_compare_lt; auto.
-Qed.
-
-(** [nat_of_P] is a morphism from [positive] to [nat] for [gt] (expressed
-    from [compare] on [positive])
-
-    Part 2: [gt] on [nat] is finer than [gt] on [positive]
-*)
-
-Lemma nat_of_P_gt_Gt_compare_complement_morphism :
- forall p q:positive, nat_of_P p > nat_of_P q -> (p ?= q) Eq = Gt.
-Proof.
- intros. rewrite nat_of_P_compare_morphism.
- apply -> nat_compare_gt; auto.
-Qed.
-
-
-(** [nat_of_P] is strictly positive *)
-
-Lemma le_Pmult_nat : forall (p:positive) (n:nat), n <= Pmult_nat p n.
-induction p; simpl in |- *; auto with arith.
-intro m; apply le_trans with (m + m); auto with arith.
-Qed.
-
-Lemma lt_O_nat_of_P : forall p:positive, 0 < nat_of_P p.
-intro; unfold nat_of_P in |- *; apply lt_le_trans with 1; auto with arith.
-apply le_Pmult_nat.
-Qed.
-
-(** Pmult_nat permutes with multiplication *)
-
-Lemma Pmult_nat_mult_permute :
- forall (p:positive) (n m:nat), Pmult_nat p (m * n) = m * Pmult_nat p n.
-Proof.
-  simple induction p. intros. simpl in |- *. rewrite mult_plus_distr_l. rewrite <- (mult_plus_distr_l m n n).
-  rewrite (H (n + n) m). reflexivity.
-  intros. simpl in |- *. rewrite <- (mult_plus_distr_l m n n). apply H.
-  trivial.
-Qed.
-
-Lemma Pmult_nat_2_mult_2_permute :
- forall p:positive, Pmult_nat p 2 = 2 * Pmult_nat p 1.
-Proof.
-  intros. rewrite <- Pmult_nat_mult_permute. reflexivity.
-Qed.
-
-Lemma Pmult_nat_4_mult_2_permute :
- forall p:positive, Pmult_nat p 4 = 2 * Pmult_nat p 2.
-Proof.
-  intros. rewrite <- Pmult_nat_mult_permute. reflexivity.
-Qed.
-
-(** Mapping of xH, xO and xI through [nat_of_P] *)
-
-Lemma nat_of_P_xH : nat_of_P 1 = 1.
-Proof.
-  reflexivity.
-Qed.
-
-Lemma nat_of_P_xO : forall p:positive, nat_of_P (xO p) = 2 * nat_of_P p.
-Proof.
-  intros.
-  change 2 with (nat_of_P 2).
-  rewrite <- nat_of_P_mult_morphism.
-  f_equal.
-Qed.
-
-Lemma nat_of_P_xI : forall p:positive, nat_of_P (xI p) = S (2 * nat_of_P p).
-Proof.
-  intros.
-  change 2 with (nat_of_P 2).
-  rewrite <- nat_of_P_mult_morphism, <- nat_of_P_succ_morphism.
-  f_equal.
-Qed.
-
-(**********************************************************************)
-(** Properties of the shifted injection from Peano natural numbers to
-    binary positive numbers *)
-
-(** Composition of [P_of_succ_nat] and [nat_of_P] is successor on [nat] *)
-
-Theorem nat_of_P_o_P_of_succ_nat_eq_succ :
- forall n:nat, nat_of_P (P_of_succ_nat n) = S n.
-Proof.
-induction n as [|n H].
-reflexivity.
-simpl; rewrite nat_of_P_succ_morphism, H; auto.
-Qed.
-
-(** Miscellaneous lemmas on [P_of_succ_nat] *)
-
-Lemma ZL3 :
- forall n:nat, Psucc (P_of_succ_nat (n + n)) = xO (P_of_succ_nat n).
-Proof.
-induction n as [| n H]; simpl;
- [ auto with arith
- | rewrite plus_comm; simpl; rewrite H;
-    rewrite xO_succ_permute; auto with arith ].
-Qed.
-
-Lemma ZL5 : forall n:nat, P_of_succ_nat (S n + S n) = xI (P_of_succ_nat n).
-Proof.
-induction n as [| n H]; simpl;
- [ auto with arith
- | rewrite <- plus_n_Sm; simpl; simpl in H; rewrite H;
-    auto with arith ].
-Qed.
-
-(** Composition of [nat_of_P] and [P_of_succ_nat] is successor on [positive] *)
-
-Theorem P_of_succ_nat_o_nat_of_P_eq_succ :
- forall p:positive, P_of_succ_nat (nat_of_P p) = Psucc p.
-Proof.
-intros.
-apply nat_of_P_inj.
-rewrite nat_of_P_o_P_of_succ_nat_eq_succ, nat_of_P_succ_morphism; auto.
-Qed.
-
-(** Composition of [nat_of_P], [P_of_succ_nat] and [Ppred] is identity
-    on [positive] *)
-
-Theorem pred_o_P_of_succ_nat_o_nat_of_P_eq_id :
- forall p:positive, Ppred (P_of_succ_nat (nat_of_P p)) = p.
-Proof.
-intros; rewrite P_of_succ_nat_o_nat_of_P_eq_succ, Ppred_succ; auto.
-Qed.
-
-(**********************************************************************)
-(** Extra properties of the injection from binary positive numbers to Peano
-    natural numbers *)
-
-(** [nat_of_P] is a morphism for subtraction on positive numbers *)
-
-Theorem nat_of_P_minus_morphism :
- forall p q:positive,
-   (p ?= q) Eq = Gt -> nat_of_P (p - q) = nat_of_P p - nat_of_P q.
-Proof.
-intros x y H; apply plus_reg_l with (nat_of_P y); rewrite le_plus_minus_r;
- [ rewrite <- nat_of_P_plus_morphism; rewrite Pplus_minus; auto with arith
- | apply lt_le_weak; exact (nat_of_P_gt_Gt_compare_morphism x y H) ].
-Qed.
-
-
-Lemma ZL16 : forall p q:positive, nat_of_P p - nat_of_P q < nat_of_P p.
-Proof.
-intros p q; elim (ZL4 p); elim (ZL4 q); intros h H1 i H2; rewrite H1;
- rewrite H2; simpl in |- *; unfold lt in |- *; apply le_n_S;
- apply le_minus.
-Qed.
-
-Lemma ZL17 : forall p q:positive, nat_of_P p < nat_of_P (p + q).
-Proof.
-intros p q; rewrite nat_of_P_plus_morphism; unfold lt in |- *; elim (ZL4 q);
- intros k H; rewrite H; rewrite plus_comm; simpl in |- *;
- apply le_n_S; apply le_plus_r.
-Qed.
-
-(** Comparison and subtraction *)
-
-Lemma Pcompare_minus_r :
- forall p q r:positive,
-   (q ?= p) Eq = Lt ->
-   (r ?= p) Eq = Gt ->
-   (r ?= q) Eq = Gt -> (r - p ?= r - q) Eq = Lt.
-Proof.
-intros; apply nat_of_P_lt_Lt_compare_complement_morphism;
- rewrite nat_of_P_minus_morphism;
- [ rewrite nat_of_P_minus_morphism;
-    [ apply plus_lt_reg_l with (p := nat_of_P q); rewrite le_plus_minus_r;
-       [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p);
-          rewrite plus_assoc; rewrite le_plus_minus_r;
-          [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l;
-             apply nat_of_P_lt_Lt_compare_morphism;
-             assumption
-          | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-             apply ZC1; assumption ]
-       | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
-          assumption ]
-    | assumption ]
- | assumption ].
-Qed.
-
-Lemma Pcompare_minus_l :
- forall p q r:positive,
-   (q ?= p) Eq = Lt ->
-   (p ?= r) Eq = Gt ->
-   (q ?= r) Eq = Gt -> (q - r ?= p - r) Eq = Lt.
-Proof.
-intros p q z; intros; apply nat_of_P_lt_Lt_compare_complement_morphism;
- rewrite nat_of_P_minus_morphism;
- [ rewrite nat_of_P_minus_morphism;
-    [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z);
-       rewrite le_plus_minus_r;
-       [ rewrite le_plus_minus_r;
-          [ apply nat_of_P_lt_Lt_compare_morphism; assumption
-          | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-             apply ZC1; assumption ]
-       | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
-          assumption ]
-    | assumption ]
- | assumption ].
-Qed.
-
-(** Distributivity of multiplication over subtraction *)
-
-Theorem Pmult_minus_distr_l :
- forall p q r:positive,
-   (q ?= r) Eq = Gt ->
-   (p * (q - r) = p * q - p * r)%positive.
-Proof.
-intros x y z H; apply nat_of_P_inj; rewrite nat_of_P_mult_morphism;
- rewrite nat_of_P_minus_morphism;
- [ rewrite nat_of_P_minus_morphism;
-    [ do 2 rewrite nat_of_P_mult_morphism;
-       do 3 rewrite (mult_comm (nat_of_P x)); apply mult_minus_distr_r
-    | apply nat_of_P_gt_Gt_compare_complement_morphism;
-       do 2 rewrite nat_of_P_mult_morphism; unfold gt in |- *;
-       elim (ZL4 x); intros h H1; rewrite H1; apply mult_S_lt_compat_l;
-       exact (nat_of_P_gt_Gt_compare_morphism y z H) ]
- | assumption ].
-Qed.
diff --git a/theories/NArith/intro.tex b/theories/NArith/intro.tex
index 83eed970..bf39bc36 100644
--- a/theories/NArith/intro.tex
+++ b/theories/NArith/intro.tex
@@ -1,4 +1,4 @@
-\section{Binary positive and non negative integers : NArith}\label{NArith}
+\section{Binary natural numbers : NArith}\label{NArith}
 
 Here are defined various arithmetical notions and their properties,
 similar to those of {\tt Arith}.
diff --git a/theories/NArith/vo.itarget b/theories/NArith/vo.itarget
index 32f94f01..e76033f7 100644
--- a/theories/NArith/vo.itarget
+++ b/theories/NArith/vo.itarget
@@ -1,12 +1,10 @@
+BinNatDef.vo
 BinNat.vo
-BinPos.vo
 NArith.vo
 Ndec.vo
 Ndigits.vo
 Ndist.vo
 Nnat.vo
-Pnat.vo
-POrderedType.vo
-Pminmax.vo
-NOrderedType.vo
-Nminmax.vo
+Ndiv_def.vo
+Nsqrt_def.vo
+Ngcd_def.vo
\ No newline at end of file
diff --git a/theories/Numbers/BigNumPrelude.v b/theories/Numbers/BigNumPrelude.v
index 510b6888..56d48eb5 100644
--- a/theories/Numbers/BigNumPrelude.v
+++ b/theories/Numbers/BigNumPrelude.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: BigNumPrelude.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** * BigNumPrelude *)
 
 (** Auxillary functions & theorems used for arbitrary precision efficient
@@ -32,7 +30,7 @@ Declare ML Module "numbers_syntax_plugin".
 
 Local Open Scope Z_scope.
 
-(* For compatibility of scripts, weaker version of some lemmas of Zdiv *)
+(* For compatibility of scripts, weaker version of some lemmas of Z.div *)
 
 Lemma Zlt0_not_eq : forall n, 0<n -> n<>0.
 Proof.
@@ -45,22 +43,22 @@ Definition Z_div_plus_l a b c H := Zdiv.Z_div_plus_full_l a b c (Zlt0_not_eq _ H
 
 (* Automation *)
 
-Hint  Extern 2 (Zle _ _) =>
+Hint  Extern 2 (Z.le _ _) =>
  (match goal with
-   |- Zpos _ <= Zpos _ => exact (refl_equal _)
-|   H: _ <=  ?p |- _ <= ?p => apply Zle_trans with (2 := H)
-|   H: _ <  ?p |- _ <= ?p => apply Zlt_le_weak; apply Zle_lt_trans with (2 := H)
+   |- Zpos _ <= Zpos _ => exact (eq_refl _)
+|   H: _ <=  ?p |- _ <= ?p => apply Z.le_trans with (2 := H)
+|   H: _ <  ?p |- _ <= ?p => apply Z.lt_le_incl; apply Z.le_lt_trans with (2 := H)
   end).
 
-Hint  Extern 2 (Zlt _ _) =>
+Hint  Extern 2 (Z.lt _ _) =>
  (match goal with
-   |- Zpos _ < Zpos _ => exact (refl_equal _)
-|      H: _ <=  ?p |- _ <= ?p => apply Zlt_le_trans with (2 := H)
-|   H: _ <  ?p |- _ <= ?p => apply Zle_lt_trans with (2 := H)
+   |- Zpos _ < Zpos _ => exact (eq_refl _)
+|      H: _ <=  ?p |- _ <= ?p => apply Z.lt_le_trans with (2 := H)
+|   H: _ <  ?p |- _ <= ?p => apply Z.le_lt_trans with (2 := H)
   end).
 
 
-Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith.
+Hint Resolve Z.lt_gt Z.le_ge Z_div_pos: zarith.
 
 (**************************************
    Properties of order and product
@@ -73,9 +71,9 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith.
  Proof.
   intros a b c d beta H1 (H3, H4) (H5, H6).
   assert (a - c < 1); auto with zarith.
-  apply Zmult_lt_reg_r with beta; auto with zarith.
-  apply Zle_lt_trans with (d  - b); auto with zarith.
-  rewrite Zmult_minus_distr_r; auto with zarith.
+  apply Z.mul_lt_mono_pos_r with beta; auto with zarith.
+  apply Z.le_lt_trans with (d  - b); auto with zarith.
+  rewrite Z.mul_sub_distr_r; auto with zarith.
  Qed.
 
  Theorem beta_lex_inv: forall a b c d beta,
@@ -84,15 +82,15 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith.
       a * beta + b < c * beta  + d.
  Proof.
   intros a b c d beta H1 (H3, H4) (H5, H6).
-  case (Zle_or_lt (c * beta + d) (a * beta + b)); auto with zarith.
-  intros H7; contradict H1;apply Zle_not_lt;apply beta_lex with (1 := H7);auto.
+  case (Z.le_gt_cases (c * beta + d) (a * beta + b)); auto with zarith.
+  intros H7. contradict H1. apply Z.le_ngt. apply beta_lex with (1 := H7); auto.
  Qed.
 
  Lemma beta_mult : forall h l beta,
    0 <= h < beta -> 0 <= l < beta -> 0 <= h*beta+l < beta^2.
  Proof.
   intros h l beta H1 H2;split. auto with zarith.
-  rewrite <- (Zplus_0_r (beta^2)); rewrite Zpower_2;
+  rewrite <- (Z.add_0_r (beta^2)); rewrite Z.pow_2_r;
    apply beta_lex_inv;auto with zarith.
  Qed.
 
@@ -100,9 +98,9 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith.
    forall b x y, 0 <= x < b -> 0 <= y < b -> 0 <= x * y <= b^2 - 2*b + 1.
  Proof.
   intros b x y (Hx1,Hx2) (Hy1,Hy2);split;auto with zarith.
-  apply Zle_trans with ((b-1)*(b-1)).
-  apply Zmult_le_compat;auto with zarith.
-  apply Zeq_le;ring.
+  apply Z.le_trans with ((b-1)*(b-1)).
+  apply Z.mul_le_mono_nonneg;auto with zarith.
+  apply Z.eq_le_incl; ring.
  Qed.
 
  Lemma sum_mul_carry : forall xh xl yh yl wc cc beta,
@@ -131,11 +129,10 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith.
  Proof.
   intros x y cross beta HH HH1 HH2.
   split; auto with zarith.
-  apply Zle_lt_trans with  ((beta-1)*(beta-1)+(beta-1)); auto with zarith.
-  apply Zplus_le_compat; auto with zarith.
-  apply Zmult_le_compat; auto with zarith.
-  repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r);
-  rewrite Zpower_2; auto with zarith.
+  apply Z.le_lt_trans with  ((beta-1)*(beta-1)+(beta-1)); auto with zarith.
+  apply Z.add_le_mono; auto with zarith.
+  apply Z.mul_le_mono_nonneg; auto with zarith.
+  rewrite ?Z.mul_sub_distr_l, ?Z.mul_sub_distr_r, Z.pow_2_r; auto with zarith.
  Qed.
 
  Theorem mult_add_ineq2: forall x y c cross beta,
@@ -146,11 +143,10 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith.
  Proof.
   intros x y c cross beta HH HH1 HH2.
   split; auto with zarith.
-  apply Zle_lt_trans with ((beta-1)*(beta-1)+(2*beta-2));auto with zarith.
-  apply Zplus_le_compat; auto with zarith.
-  apply Zmult_le_compat; auto with zarith.
-  repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r);
-   rewrite Zpower_2; auto with zarith.
+  apply Z.le_lt_trans with ((beta-1)*(beta-1)+(2*beta-2));auto with zarith.
+  apply Z.add_le_mono; auto with zarith.
+  apply Z.mul_le_mono_nonneg; auto with zarith.
+  rewrite ?Z.mul_sub_distr_l, ?Z.mul_sub_distr_r, Z.pow_2_r; auto with zarith.
  Qed.
 
 Theorem mult_add_ineq3: forall x y c cross beta,
@@ -163,20 +159,20 @@ Theorem mult_add_ineq3: forall x y c cross beta,
   intros x y c cross beta HH HH1 HH2 HH3.
   apply mult_add_ineq2;auto with zarith.
   split;auto with zarith.
-  apply Zle_trans with (1*beta+cross);auto with zarith.
+  apply Z.le_trans with (1*beta+cross);auto with zarith.
  Qed.
 
-Hint Rewrite Zmult_1_r Zmult_0_r Zmult_1_l Zmult_0_l Zplus_0_l Zplus_0_r Zminus_0_r: rm10.
+Hint Rewrite Z.mul_1_r Z.mul_0_r Z.mul_1_l Z.mul_0_l Z.add_0_l Z.add_0_r Z.sub_0_r: rm10.
 
 
 (**************************************
- Properties of Zdiv and Zmod
+ Properties of Z.div and Z.modulo
 **************************************)
 
 Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
  Proof.
   intros a b H H1;case (Z_mod_lt a b);auto with zarith;intros H2 H3;split;auto.
-  case (Zle_or_lt b a); intros H4; auto with zarith.
+  case (Z.le_gt_cases b a); intros H4; auto with zarith.
   rewrite Zmod_small; auto with zarith.
  Qed.
 
@@ -186,26 +182,26 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
  Proof.
   intros a b r t (H1, H2) H3 (H4, H5).
   assert (t < 2 ^ b).
-  apply Zlt_le_trans with (1:= H5); auto with zarith.
+  apply Z.lt_le_trans with (1:= H5); auto with zarith.
   apply Zpower_le_monotone; auto with zarith.
   rewrite Zplus_mod; auto with zarith.
   rewrite Zmod_small with (a := t); auto with zarith.
   apply Zmod_small; auto with zarith.
   split; auto with zarith.
   assert (0 <= 2 ^a * r); auto with zarith.
-  apply Zplus_le_0_compat; auto with zarith.
+  apply Z.add_nonneg_nonneg; auto with zarith.
   match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
    auto with zarith.
   pattern (2 ^ b) at 2; replace (2 ^ b) with ((2 ^ b - 2 ^a) + 2 ^ a);
     try ring.
-  apply Zplus_le_lt_compat; auto with zarith.
+  apply Z.add_le_lt_mono; auto with zarith.
   replace b with ((b - a) + a); try ring.
   rewrite Zpower_exp; auto with zarith.
-  pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a));
-   try rewrite <- Zmult_minus_distr_r.
-  rewrite (Zmult_comm (2 ^(b - a))); rewrite  Zmult_mod_distr_l;
+  pattern (2 ^a) at 4; rewrite <- (Z.mul_1_l (2 ^a));
+   try rewrite <- Z.mul_sub_distr_r.
+  rewrite (Z.mul_comm (2 ^(b - a))); rewrite  Zmult_mod_distr_l;
    auto with zarith.
-  rewrite (Zmult_comm (2 ^a)); apply Zmult_le_compat_r; auto with zarith.
+  rewrite (Z.mul_comm (2 ^a)); apply Z.mul_le_mono_nonneg_r; auto with zarith.
   match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
    auto with zarith.
  Qed.
@@ -216,25 +212,25 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
  Proof.
   intros a b r t (H1, H2) H3 (H4, H5).
   assert (t < 2 ^ b).
-  apply Zlt_le_trans with (1:= H5); auto with zarith.
+  apply Z.lt_le_trans with (1:= H5); auto with zarith.
   apply Zpower_le_monotone; auto with zarith.
   rewrite Zplus_mod; auto with zarith.
   rewrite Zmod_small with (a := t); auto with zarith.
   apply Zmod_small; auto with zarith.
   split; auto with zarith.
   assert (0 <= 2 ^a * r); auto with zarith.
-  apply Zplus_le_0_compat; auto with zarith.
+  apply Z.add_nonneg_nonneg; auto with zarith.
   match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
    auto with zarith.
   pattern (2 ^ b) at 2;replace (2 ^ b) with ((2 ^ b - 2 ^a) + 2 ^ a); try ring.
-  apply Zplus_le_lt_compat; auto with zarith.
+  apply Z.add_le_lt_mono; auto with zarith.
   replace b with ((b - a) + a); try ring.
   rewrite Zpower_exp; auto with zarith.
-  pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a));
-   try rewrite <- Zmult_minus_distr_r.
-  repeat rewrite (fun x => Zmult_comm x (2 ^ a)); rewrite Zmult_mod_distr_l;
+  pattern (2 ^a) at 4; rewrite <- (Z.mul_1_l (2 ^a));
+   try rewrite <- Z.mul_sub_distr_r.
+  repeat rewrite (fun x => Z.mul_comm x (2 ^ a)); rewrite Zmult_mod_distr_l;
    auto with zarith.
-  apply Zmult_le_compat_l; auto with zarith.
+  apply Z.mul_le_mono_nonneg_l; auto with zarith.
   match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
    auto with zarith.
  Qed.
@@ -245,13 +241,13 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
   Proof.
    intros a b r t (H1, H2) H3 (H4, H5).
    assert (Eq: t < 2 ^ b); auto with zarith.
-   apply Zlt_le_trans with (1 := H5); auto with zarith.
+   apply Z.lt_le_trans with (1 := H5); auto with zarith.
    apply Zpower_le_monotone; auto with zarith.
    pattern (r * 2 ^ a) at 1; rewrite Z_div_mod_eq with (b := 2 ^ b);
     auto with zarith.
-   rewrite <- Zplus_assoc.
+   rewrite <- Z.add_assoc.
    rewrite <- Zmod_shift_r; auto with zarith.
-   rewrite (Zmult_comm (2 ^ b)); rewrite Z_div_plus_full_l; auto with zarith.
+   rewrite (Z.mul_comm (2 ^ b)); rewrite Z_div_plus_full_l; auto with zarith.
    rewrite (fun x y => @Zdiv_small (x mod y)); auto with zarith.
    match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end;
     auto with zarith.
@@ -266,7 +262,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
   intros n p a H1 H2.
   pattern (a*2^p) at 1;replace (a*2^p) with
      (a*2^p/2^n * 2^n + a*2^p mod 2^n).
-  2:symmetry;rewrite (Zmult_comm (a*2^p/2^n));apply Z_div_mod_eq.
+  2:symmetry;rewrite (Z.mul_comm (a*2^p/2^n));apply Z_div_mod_eq.
   replace (a * 2 ^ p / 2 ^ n) with (a / 2 ^ (n - p));trivial.
   replace (2^n) with (2^(n-p)*2^p).
   symmetry;apply Zdiv_mult_cancel_r.
@@ -275,7 +271,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
   rewrite <- Zpower_exp.
   replace (n-p+p) with n;trivial. ring.
   omega. omega.
-  apply Zlt_gt. apply Zpower_gt_0;auto with zarith.
+  apply Z.lt_gt. apply Z.pow_pos_nonneg;auto with zarith.
  Qed.
 
 
@@ -286,15 +282,15 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
  intros.
  rewrite Zmod_small.
  rewrite Zmod_eq by (auto with zarith).
- unfold Zminus at 1.
+ unfold Z.sub at 1.
  rewrite Z_div_plus_l by (auto with zarith).
  assert (2^n = 2^(n-p)*2^p).
   rewrite <- Zpower_exp by (auto with zarith).
   replace (n-p+p) with n; auto with zarith.
  rewrite H0.
  rewrite <- Zdiv_Zdiv, Z_div_mult by (auto with zarith).
- rewrite (Zmult_comm (2^(n-p))), Zmult_assoc.
- rewrite Zopp_mult_distr_l.
+ rewrite (Z.mul_comm (2^(n-p))), Z.mul_assoc.
+ rewrite <- Z.mul_opp_l.
  rewrite Z_div_mult by (auto with zarith).
  symmetry; apply Zmod_eq; auto with zarith.
 
@@ -303,9 +299,9 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
  split.
  apply Z_div_pos; auto with zarith.
  apply Zdiv_lt_upper_bound; auto with zarith.
- apply Zlt_le_trans with (2^n); auto with zarith.
- rewrite <- (Zmult_1_r (2^n)) at 1.
- apply Zmult_le_compat; auto with zarith.
+ apply Z.lt_le_trans with (2^n); auto with zarith.
+ rewrite <- (Z.mul_1_r (2^n)) at 1.
+ apply Z.mul_le_mono_nonneg; auto with zarith.
  cut (0 < 2 ^ (n-p)); auto with zarith.
  Qed.
 
@@ -315,31 +311,29 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
   apply  Zdiv_le_lower_bound;auto with zarith.
   replace (2^p) with 0.
   destruct x;compute;intro;discriminate.
-  destruct p;trivial;discriminate z.
+  destruct p;trivial;discriminate.
  Qed.
 
  Lemma div_lt : forall p x y, 0 <= x < y -> x / 2^p < y.
  Proof.
   intros p x y H;destruct (Z_le_gt_dec 0 p).
   apply Zdiv_lt_upper_bound;auto with zarith.
-  apply Zlt_le_trans with y;auto with zarith.
-  rewrite <- (Zmult_1_r y);apply Zmult_le_compat;auto with zarith.
+  apply Z.lt_le_trans with y;auto with zarith.
+  rewrite <- (Z.mul_1_r y);apply Z.mul_le_mono_nonneg;auto with zarith.
   assert (0 < 2^p);auto with zarith.
   replace (2^p) with 0.
   destruct x;change (0<y);auto with zarith.
-  destruct p;trivial;discriminate z.
+  destruct p;trivial;discriminate.
  Qed.
 
  Theorem Zgcd_div_pos a b:
-   0 < b -> 0 < Zgcd a b -> 0 < b / Zgcd a b.
+   0 < b -> 0 < Z.gcd a b -> 0 < b / Z.gcd a b.
  Proof.
- intros Ha Hg.
- case (Zle_lt_or_eq 0 (b/Zgcd a b)); auto.
- apply Z_div_pos; auto with zarith.
- intros H; generalize Ha.
- pattern b at 1; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
- rewrite <- H; auto with zarith.
- assert (F := (Zgcd_is_gcd a b)); inversion F; auto.
+ intros Hb Hg.
+ assert (H : 0 <= b / Z.gcd a b) by (apply Z.div_pos; auto with zarith).
+ Z.le_elim H; trivial.
+ rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b), <- H, Z.mul_0_r in Hb;
+  auto using Z.gcd_divide_r with zarith.
  Qed.
 
  Theorem Zdiv_neg a b:
@@ -349,7 +343,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
  assert (b > 0) by omega.
  generalize (Z_mult_div_ge a _ H); intros.
  assert (b * (a / b) < 0)%Z.
-  apply Zle_lt_trans with a; auto with zarith.
+  apply Z.le_lt_trans with a; auto with zarith.
  destruct b; try (compute in Hb; discriminate).
  destruct (a/Zpos p)%Z.
  compute in H1; discriminate.
@@ -357,20 +351,20 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
  compute; auto.
  Qed.
 
- Lemma Zdiv_gcd_zero : forall a b, b / Zgcd a b = 0 -> b <> 0 ->
-  Zgcd a b = 0.
+ Lemma Zdiv_gcd_zero : forall a b, b / Z.gcd a b = 0 -> b <> 0 ->
+  Z.gcd a b = 0.
  Proof.
  intros.
  generalize (Zgcd_is_gcd a b); destruct 1.
  destruct H2 as (k,Hk).
  generalize H; rewrite Hk at 1.
- destruct (Z_eq_dec (Zgcd a b) 0) as [H'|H']; auto.
+ destruct (Z.eq_dec (Z.gcd a b) 0) as [H'|H']; auto.
  rewrite Z_div_mult_full; auto.
  intros; subst k; simpl in *; subst b; elim H0; auto.
  Qed.
 
  Lemma Zgcd_mult_rel_prime : forall a b c,
-  Zgcd a c = 1 -> Zgcd b c = 1 -> Zgcd (a*b) c = 1.
+  Z.gcd a c = 1 -> Z.gcd b c = 1 -> Z.gcd (a*b) c = 1.
  Proof.
  intros.
  rewrite Zgcd_1_rel_prime in *.
@@ -398,23 +392,20 @@ intros Q b Q0 QS.
 set (Q' := fun n => (n < b /\ Q n) \/ (b <= n)).
 assert (H : forall n, 0 <= n -> Q' n).
 apply natlike_rec2; unfold Q'.
-destruct (Zle_or_lt b 0) as [H | H]. now right. left; now split.
+destruct (Z.le_gt_cases b 0) as [H | H]. now right. left; now split.
 intros n H IH. destruct IH as [[IH1 IH2] | IH].
-destruct (Zle_or_lt (b - 1) n) as [H1 | H1].
+destruct (Z.le_gt_cases (b - 1) n) as [H1 | H1].
 right; auto with zarith.
 left. split; [auto with zarith | now apply (QS n)].
 right; auto with zarith.
 unfold Q' in *; intros n H1 H2. destruct (H n H1) as [[H3 H4] | H3].
-assumption. apply Zle_not_lt in H3. false_hyp H2 H3.
+assumption. now apply Z.le_ngt in H3.
 Qed.
 
-Lemma Zsquare_le : forall x, x <= x*x.
+Lemma Zsquare_le x : x <= x*x.
 Proof.
-intros.
-destruct (Z_lt_le_dec 0 x).
-pattern x at 1; rewrite <- (Zmult_1_l x).
-apply Zmult_le_compat; auto with zarith.
-apply Zle_trans with 0; auto with zarith.
-rewrite <- Zmult_opp_opp.
-apply Zmult_le_0_compat; auto with zarith.
+destruct (Z.lt_ge_cases 0 x).
+- rewrite <- Z.mul_1_l at 1.
+  rewrite <- Z.mul_le_mono_pos_r; auto with zarith.
+- pose proof (Z.square_nonneg x); auto with zarith.
 Qed.
diff --git a/theories/Numbers/BinNums.v b/theories/Numbers/BinNums.v
new file mode 100644
index 00000000..aab2c14f
--- /dev/null
+++ b/theories/Numbers/BinNums.v
@@ -0,0 +1,61 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** * Binary Numerical Datatypes *)
+
+Set Implicit Arguments.
+(* For compatibility, we will not use generic equality functions *)
+Local Unset Boolean Equality Schemes.
+
+Declare ML Module "z_syntax_plugin".
+
+(** [positive] is a datatype representing the strictly positive integers
+   in a binary way. Starting from 1 (represented by [xH]), one can
+   add a new least significant digit via [xO] (digit 0) or [xI] (digit 1).
+   Numbers in [positive] can also be denoted using a decimal notation;
+   e.g. [6%positive] abbreviates [xO (xI xH)] *)
+
+Inductive positive : Set :=
+  | xI : positive -> positive
+  | xO : positive -> positive
+  | xH : positive.
+
+Delimit Scope positive_scope with positive.
+Bind Scope positive_scope with positive.
+Arguments xO _%positive.
+Arguments xI _%positive.
+
+(** [N] is a datatype representing natural numbers in a binary way,
+    by extending the [positive] datatype with a zero.
+    Numbers in [N] can also be denoted using a decimal notation;
+    e.g. [6%N] abbreviates [Npos (xO (xI xH))] *)
+
+Inductive N : Set :=
+  | N0 : N
+  | Npos : positive -> N.
+
+Delimit Scope N_scope with N.
+Bind Scope N_scope with N.
+Arguments Npos _%positive.
+
+(** [Z] is a datatype representing the integers in a binary way.
+    An integer is either zero or a strictly positive number
+    (coded as a [positive]) or a strictly negative number
+    (whose opposite is stored as a [positive] value).
+    Numbers in [Z] can also be denoted using a decimal notation;
+    e.g. [(-6)%Z] abbreviates [Zneg (xO (xI xH))] *)
+
+Inductive Z : Set :=
+  | Z0 : Z
+  | Zpos : positive -> Z
+  | Zneg : positive -> Z.
+
+Delimit Scope Z_scope with Z.
+Bind Scope Z_scope with Z.
+Arguments Zpos _%positive.
+Arguments Zneg _%positive.
diff --git a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
index fa097802..9a8a7691 100644
--- a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
+++ b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(* $Id: CyclicAxioms.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** * Signature and specification of a bounded integer structure *)
 
 (** This file specifies how to represent [Z/nZ] when [n=2^d],
@@ -26,352 +24,300 @@ Local Open Scope Z_scope.
 
 (** First, a description via an operator record and a spec record. *)
 
-Section Z_nZ_Op.
-
- Variable znz : Type.
+Module ZnZ.
 
- Record znz_op := mk_znz_op {
+ Class Ops (t:Type) := MkOps {
 
     (* Conversion functions with Z *)
-    znz_digits : positive;
-    znz_zdigits: znz;
-    znz_to_Z   : znz -> Z;
-    znz_of_pos : positive -> N * znz; (* Euclidean division by [2^digits] *)
-    znz_head0  : znz -> znz; (* number of digits 0 in front of the number *)
-    znz_tail0  : znz -> znz; (* number of digits 0 at the bottom of the number *)
+    digits : positive;
+    zdigits: t;
+    to_Z   : t -> Z;
+    of_pos : positive -> N * t; (* Euclidean division by [2^digits] *)
+    head0  : t -> t; (* number of digits 0 in front of the number *)
+    tail0  : t -> t; (* number of digits 0 at the bottom of the number *)
 
     (* Basic numbers *)
-    znz_0   : znz;
-    znz_1   : znz;
-    znz_Bm1 : znz;  (* [2^digits-1], which is equivalent to [-1] *)
+    zero : t;
+    one  : t;
+    minus_one : t;  (* [2^digits-1], which is equivalent to [-1] *)
 
     (* Comparison *)
-    znz_compare     : znz -> znz -> comparison;
-    znz_eq0         : znz -> bool;
+    compare     : t -> t -> comparison;
+    eq0         : t -> bool;
 
     (* Basic arithmetic operations *)
-    znz_opp_c       : znz -> carry znz;
-    znz_opp         : znz -> znz;
-    znz_opp_carry   : znz -> znz; (* the carry is known to be -1 *)
-
-    znz_succ_c      : znz -> carry znz;
-    znz_add_c       : znz -> znz -> carry znz;
-    znz_add_carry_c : znz -> znz -> carry znz;
-    znz_succ        : znz -> znz;
-    znz_add         : znz -> znz -> znz;
-    znz_add_carry   : znz -> znz -> znz;
-
-    znz_pred_c      : znz -> carry znz;
-    znz_sub_c       : znz -> znz -> carry znz;
-    znz_sub_carry_c : znz -> znz -> carry znz;
-    znz_pred        : znz -> znz;
-    znz_sub         : znz -> znz -> znz;
-    znz_sub_carry   : znz -> znz -> znz;
-
-    znz_mul_c       : znz -> znz -> zn2z znz;
-    znz_mul         : znz -> znz -> znz;
-    znz_square_c    : znz -> zn2z znz;
+    opp_c       : t -> carry t;
+    opp         : t -> t;
+    opp_carry   : t -> t; (* the carry is known to be -1 *)
+
+    succ_c      : t -> carry t;
+    add_c       : t -> t -> carry t;
+    add_carry_c : t -> t -> carry t;
+    succ        : t -> t;
+    add         : t -> t -> t;
+    add_carry   : t -> t -> t;
+
+    pred_c      : t -> carry t;
+    sub_c       : t -> t -> carry t;
+    sub_carry_c : t -> t -> carry t;
+    pred        : t -> t;
+    sub         : t -> t -> t;
+    sub_carry   : t -> t -> t;
+
+    mul_c       : t -> t -> zn2z t;
+    mul         : t -> t -> t;
+    square_c    : t -> zn2z t;
 
     (* Special divisions operations *)
-    znz_div21       : znz -> znz -> znz -> znz*znz;
-    znz_div_gt      : znz -> znz -> znz * znz; (* specialized version of [znz_div] *)
-    znz_div         : znz -> znz -> znz * znz;
+    div21       : t -> t -> t -> t*t;
+    div_gt      : t -> t -> t * t; (* specialized version of [div] *)
+    div         : t -> t -> t * t;
 
-    znz_mod_gt      : znz -> znz -> znz; (* specialized version of [znz_mod] *)
-    znz_mod         : znz -> znz -> znz;
+    modulo_gt   : t -> t -> t; (* specialized version of [mod] *)
+    modulo      : t -> t -> t;
 
-    znz_gcd_gt      : znz -> znz -> znz; (* specialized version of [znz_gcd] *)
-    znz_gcd         : znz -> znz -> znz;
-    (* [znz_add_mul_div p i j] is a combination of the [(digits-p)]
+    gcd_gt      : t -> t -> t; (* specialized version of [gcd] *)
+    gcd         : t -> t -> t;
+    (* [add_mul_div p i j] is a combination of the [(digits-p)]
        low bits of [i] above the [p] high bits of [j]:
-       [znz_add_mul_div p i j = i*2^p+j/2^(digits-p)] *)
-    znz_add_mul_div : znz -> znz -> znz -> znz;
-    (* [znz_pos_mod p i] is [i mod 2^p] *)
-    znz_pos_mod     : znz -> znz -> znz;
+       [add_mul_div p i j = i*2^p+j/2^(digits-p)] *)
+    add_mul_div : t -> t -> t -> t;
+    (* [pos_mod p i] is [i mod 2^p] *)
+    pos_mod     : t -> t -> t;
 
-    znz_is_even     : znz -> bool;
+    is_even     : t -> bool;
     (* square root *)
-    znz_sqrt2       : znz -> znz -> znz * carry znz;
-    znz_sqrt        : znz -> znz  }.
-
-End Z_nZ_Op.
-
-Section Z_nZ_Spec.
- Variable w : Type.
- Variable w_op : znz_op w.
-
- Let w_digits      := w_op.(znz_digits).
- Let w_zdigits     := w_op.(znz_zdigits).
- Let w_to_Z        := w_op.(znz_to_Z).
- Let w_of_pos      := w_op.(znz_of_pos).
- Let w_head0       := w_op.(znz_head0).
- Let w_tail0       := w_op.(znz_tail0).
-
- Let w0            := w_op.(znz_0).
- Let w1            := w_op.(znz_1).
- Let wBm1          := w_op.(znz_Bm1).
-
- Let w_compare     := w_op.(znz_compare).
- Let w_eq0         := w_op.(znz_eq0).
-
- Let w_opp_c       := w_op.(znz_opp_c).
- Let w_opp         := w_op.(znz_opp).
- Let w_opp_carry   := w_op.(znz_opp_carry).
-
- Let w_succ_c      := w_op.(znz_succ_c).
- Let w_add_c       := w_op.(znz_add_c).
- Let w_add_carry_c := w_op.(znz_add_carry_c).
- Let w_succ        := w_op.(znz_succ).
- Let w_add         := w_op.(znz_add).
- Let w_add_carry   := w_op.(znz_add_carry).
-
- Let w_pred_c      := w_op.(znz_pred_c).
- Let w_sub_c       := w_op.(znz_sub_c).
- Let w_sub_carry_c := w_op.(znz_sub_carry_c).
- Let w_pred        := w_op.(znz_pred).
- Let w_sub         := w_op.(znz_sub).
- Let w_sub_carry   := w_op.(znz_sub_carry).
-
- Let w_mul_c       := w_op.(znz_mul_c).
- Let w_mul         := w_op.(znz_mul).
- Let w_square_c    := w_op.(znz_square_c).
-
- Let w_div21       := w_op.(znz_div21).
- Let w_div_gt      := w_op.(znz_div_gt).
- Let w_div         := w_op.(znz_div).
-
- Let w_mod_gt      := w_op.(znz_mod_gt).
- Let w_mod         := w_op.(znz_mod).
-
- Let w_gcd_gt      := w_op.(znz_gcd_gt).
- Let w_gcd         := w_op.(znz_gcd).
-
- Let w_add_mul_div := w_op.(znz_add_mul_div).
-
- Let w_pos_mod     := w_op.(znz_pos_mod).
+    sqrt2       : t -> t -> t * carry t;
+    sqrt        : t -> t  }.
 
- Let w_is_even     := w_op.(znz_is_even).
- Let w_sqrt2       := w_op.(znz_sqrt2).
- Let w_sqrt        := w_op.(znz_sqrt).
+ Section Specs.
+ Context {t : Type}{ops : Ops t}.
 
- Notation "[| x |]" := (w_to_Z x)  (at level 0, x at level 99).
+ Notation "[| x |]" := (to_Z x)  (at level 0, x at level 99).
 
- Let wB := base w_digits.
+ Let wB := base digits.
 
  Notation "[+| c |]" :=
-   (interp_carry 1 wB w_to_Z c)  (at level 0, x at level 99).
+   (interp_carry 1 wB to_Z c)  (at level 0, x at level 99).
 
  Notation "[-| c |]" :=
-   (interp_carry (-1) wB w_to_Z c)  (at level 0, x at level 99).
+   (interp_carry (-1) wB to_Z c)  (at level 0, x at level 99).
 
  Notation "[|| x ||]" :=
-   (zn2z_to_Z wB w_to_Z x)  (at level 0, x at level 99).
+   (zn2z_to_Z wB to_Z x)  (at level 0, x at level 99).
 
- Record znz_spec := mk_znz_spec {
+ Class Specs := MkSpecs {
 
     (* Conversion functions with Z *)
     spec_to_Z   : forall x, 0 <= [| x |] < wB;
     spec_of_pos : forall p,
-           Zpos p = (Z_of_N (fst (w_of_pos p)))*wB + [|(snd (w_of_pos p))|];
-    spec_zdigits : [| w_zdigits |] = Zpos w_digits;
-    spec_more_than_1_digit: 1 < Zpos w_digits;
+           Zpos p = (Z.of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|];
+    spec_zdigits : [| zdigits |] = Zpos digits;
+    spec_more_than_1_digit: 1 < Zpos digits;
 
     (* Basic numbers *)
-    spec_0   : [|w0|] = 0;
-    spec_1   : [|w1|] = 1;
-    spec_Bm1 : [|wBm1|] = wB - 1;
+    spec_0   : [|zero|] = 0;
+    spec_1   : [|one|] = 1;
+    spec_m1 : [|minus_one|] = wB - 1;
 
     (* Comparison *)
-    spec_compare :
-     forall x y,
-       match w_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end;
-    spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0;
+    spec_compare : forall x y, compare x y = ([|x|] ?= [|y|]);
+    (* NB: the spec of [eq0] is deliberately partial,
+       see DoubleCyclic where [eq0 x = true <-> x = W0] *)
+    spec_eq0 : forall x, eq0 x = true -> [|x|] = 0;
     (* Basic arithmetic operations *)
-    spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|];
-    spec_opp : forall x, [|w_opp x|] = (-[|x|]) mod wB;
-    spec_opp_carry : forall x, [|w_opp_carry x|] = wB - [|x|] - 1;
-
-    spec_succ_c : forall x, [+|w_succ_c x|] = [|x|] + 1;
-    spec_add_c  : forall x y, [+|w_add_c x y|] = [|x|] + [|y|];
-    spec_add_carry_c : forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1;
-    spec_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB;
-    spec_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB;
+    spec_opp_c : forall x, [-|opp_c x|] = -[|x|];
+    spec_opp : forall x, [|opp x|] = (-[|x|]) mod wB;
+    spec_opp_carry : forall x, [|opp_carry x|] = wB - [|x|] - 1;
+
+    spec_succ_c : forall x, [+|succ_c x|] = [|x|] + 1;
+    spec_add_c  : forall x y, [+|add_c x y|] = [|x|] + [|y|];
+    spec_add_carry_c : forall x y, [+|add_carry_c x y|] = [|x|] + [|y|] + 1;
+    spec_succ : forall x, [|succ x|] = ([|x|] + 1) mod wB;
+    spec_add : forall x y, [|add x y|] = ([|x|] + [|y|]) mod wB;
     spec_add_carry :
-	 forall x y, [|w_add_carry x y|] = ([|x|] + [|y|] + 1) mod wB;
+	 forall x y, [|add_carry x y|] = ([|x|] + [|y|] + 1) mod wB;
 
-    spec_pred_c : forall x, [-|w_pred_c x|] = [|x|] - 1;
-    spec_sub_c : forall x y, [-|w_sub_c x y|] = [|x|] - [|y|];
-    spec_sub_carry_c : forall x y, [-|w_sub_carry_c x y|] = [|x|] - [|y|] - 1;
-    spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB;
-    spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB;
+    spec_pred_c : forall x, [-|pred_c x|] = [|x|] - 1;
+    spec_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|];
+    spec_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|] - [|y|] - 1;
+    spec_pred : forall x, [|pred x|] = ([|x|] - 1) mod wB;
+    spec_sub : forall x y, [|sub x y|] = ([|x|] - [|y|]) mod wB;
     spec_sub_carry :
-	 forall x y, [|w_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB;
+	 forall x y, [|sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB;
 
-    spec_mul_c : forall x y, [|| w_mul_c x y ||] = [|x|] * [|y|];
-    spec_mul : forall x y, [|w_mul x y|] = ([|x|] * [|y|]) mod wB;
-    spec_square_c : forall x, [|| w_square_c x||] = [|x|] * [|x|];
+    spec_mul_c : forall x y, [|| mul_c x y ||] = [|x|] * [|y|];
+    spec_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wB;
+    spec_square_c : forall x, [|| square_c x||] = [|x|] * [|x|];
 
     (* Special divisions operations *)
     spec_div21 : forall a1 a2 b,
       wB/2 <= [|b|] ->
       [|a1|] < [|b|] ->
-      let (q,r) := w_div21 a1 a2 b in
+      let (q,r) := div21 a1 a2 b in
       [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\
       0 <= [|r|] < [|b|];
     spec_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] ->
-      let (q,r) := w_div_gt a b in
+      let (q,r) := div_gt a b in
       [|a|] = [|q|] * [|b|] + [|r|] /\
       0 <= [|r|] < [|b|];
     spec_div : forall a b, 0 < [|b|] ->
-      let (q,r) := w_div a b in
+      let (q,r) := div a b in
       [|a|] = [|q|] * [|b|] + [|r|] /\
       0 <= [|r|] < [|b|];
 
-    spec_mod_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] ->
-      [|w_mod_gt a b|] = [|a|] mod [|b|];
-    spec_mod :  forall a b, 0 < [|b|] ->
-      [|w_mod a b|] = [|a|] mod [|b|];
+    spec_modulo_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] ->
+      [|modulo_gt a b|] = [|a|] mod [|b|];
+    spec_modulo :  forall a b, 0 < [|b|] ->
+      [|modulo a b|] = [|a|] mod [|b|];
 
     spec_gcd_gt : forall a b, [|a|] > [|b|] ->
-      Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|];
-    spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|w_gcd a b|];
+      Zis_gcd [|a|] [|b|] [|gcd_gt a b|];
+    spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|];
 
 
     (* shift operations *)
-    spec_head00:  forall x, [|x|] = 0 -> [|w_head0 x|] = Zpos w_digits;
+    spec_head00:  forall x, [|x|] = 0 -> [|head0 x|] = Zpos digits;
     spec_head0  : forall x,  0 < [|x|] ->
-	 wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB;
-    spec_tail00:  forall x, [|x|] = 0 -> [|w_tail0 x|] = Zpos w_digits;
+	 wB/ 2 <= 2 ^ ([|head0 x|]) * [|x|] < wB;
+    spec_tail00:  forall x, [|x|] = 0 -> [|tail0 x|] = Zpos digits;
     spec_tail0  : forall x, 0 < [|x|] ->
-         exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|w_tail0 x|]) ;
+         exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|tail0 x|]) ;
     spec_add_mul_div : forall x y p,
-       [|p|] <= Zpos w_digits ->
-       [| w_add_mul_div p x y |] =
+       [|p|] <= Zpos digits ->
+       [| add_mul_div p x y |] =
          ([|x|] * (2 ^ [|p|]) +
-          [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB;
+          [|y|] / (2 ^ ((Zpos digits) - [|p|]))) mod wB;
     spec_pos_mod : forall w p,
-       [|w_pos_mod p w|] = [|w|] mod (2 ^ [|p|]);
+       [|pos_mod p w|] = [|w|] mod (2 ^ [|p|]);
     (* sqrt *)
     spec_is_even : forall x,
-      if w_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1;
+      if is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1;
     spec_sqrt2 : forall x y,
        wB/ 4 <= [|x|] ->
-       let (s,r) := w_sqrt2 x y in
+       let (s,r) := sqrt2 x y in
           [||WW x y||] = [|s|] ^ 2 + [+|r|] /\
           [+|r|] <= 2 * [|s|];
     spec_sqrt : forall x,
-       [|w_sqrt x|] ^ 2 <= [|x|] < ([|w_sqrt x|] + 1) ^ 2
+       [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2
   }.
 
-End Z_nZ_Spec.
+ End Specs.
 
-(** Generic construction of double words *)
+ Arguments Specs {t} ops.
 
-Section WW.
+ (** Generic construction of double words *)
 
- Variable w : Type.
- Variable w_op : znz_op w.
- Variable op_spec : znz_spec w_op.
+ Section WW.
 
- Let wB := base w_op.(znz_digits).
- Let w_to_Z := w_op.(znz_to_Z).
- Let w_eq0 := w_op.(znz_eq0).
- Let w_0 := w_op.(znz_0).
+ Context {t : Type}{ops : Ops t}{specs : Specs ops}.
 
- Definition znz_W0 h :=
-  if w_eq0 h then W0 else WW h w_0.
+ Let wB := base digits.
 
- Definition znz_0W l :=
-  if w_eq0 l then W0 else WW w_0 l.
+ Definition WO' (eq0:t->bool) zero h :=
+  if eq0 h then W0 else WW h zero.
 
- Definition znz_WW h l :=
-  if w_eq0 h then znz_0W l else WW h l.
+ Definition WO := Eval lazy beta delta [WO'] in
+   let eq0 := ZnZ.eq0 in
+   let zero := ZnZ.zero in
+   WO' eq0 zero.
 
- Lemma spec_W0 : forall h,
-   zn2z_to_Z wB w_to_Z (znz_W0 h) = (w_to_Z h)*wB.
+ Definition OW' (eq0:t->bool) zero l :=
+  if eq0 l then W0 else WW zero l.
+
+ Definition OW := Eval lazy beta delta [OW'] in
+   let eq0 := ZnZ.eq0 in
+   let zero := ZnZ.zero in
+   OW' eq0 zero.
+
+ Definition WW'  (eq0:t->bool) zero h l :=
+  if eq0 h then OW' eq0 zero l else WW h l.
+
+ Definition WW := Eval lazy beta delta [WW' OW'] in
+   let eq0 := ZnZ.eq0 in
+   let zero := ZnZ.zero in
+   WW' eq0 zero.
+
+ Lemma spec_WO : forall h,
+   zn2z_to_Z wB to_Z (WO h) = (to_Z h)*wB.
  Proof.
- unfold zn2z_to_Z, znz_W0, w_to_Z; simpl; intros.
- case_eq (w_eq0 h); intros.
- rewrite (op_spec.(spec_eq0) _ H); auto.
- unfold w_0; rewrite op_spec.(spec_0); auto with zarith.
+ unfold zn2z_to_Z, WO; simpl; intros.
+ case_eq (eq0 h); intros.
+ rewrite (spec_eq0 _ H); auto.
+ rewrite spec_0; auto with zarith.
  Qed.
 
- Lemma spec_0W : forall l,
-   zn2z_to_Z wB w_to_Z (znz_0W l) = w_to_Z l.
+ Lemma spec_OW : forall l,
+   zn2z_to_Z wB to_Z (OW l) = to_Z l.
  Proof.
- unfold zn2z_to_Z, znz_0W, w_to_Z; simpl; intros.
- case_eq (w_eq0 l); intros.
- rewrite (op_spec.(spec_eq0) _ H); auto.
- unfold w_0; rewrite op_spec.(spec_0); auto with zarith.
+ unfold zn2z_to_Z, OW; simpl; intros.
+ case_eq (eq0 l); intros.
+ rewrite (spec_eq0 _ H); auto.
+ rewrite spec_0; auto with zarith.
  Qed.
 
  Lemma spec_WW : forall h l,
-  zn2z_to_Z wB w_to_Z (znz_WW h l) = (w_to_Z h)*wB + w_to_Z l.
+  zn2z_to_Z wB to_Z (WW h l) = (to_Z h)*wB + to_Z l.
  Proof.
- unfold znz_WW, w_to_Z; simpl; intros.
- case_eq (w_eq0 h); intros.
- rewrite (op_spec.(spec_eq0) _ H); auto.
- rewrite spec_0W; auto.
+ unfold WW; simpl; intros.
+ case_eq (eq0 h); intros.
+ rewrite (spec_eq0 _ H); auto.
+ fold (OW l).
+ rewrite spec_OW; auto.
  simpl; auto.
  Qed.
 
-End WW.
+ End WW.
 
-(** Injecting [Z] numbers into a cyclic structure *)
+ (** Injecting [Z] numbers into a cyclic structure *)
 
-Section znz_of_pos.
+ Section Of_Z.
 
- Variable w : Type.
- Variable w_op : znz_op w.
- Variable op_spec : znz_spec w_op.
+ Context {t : Type}{ops : Ops t}{specs : Specs ops}.
 
- Notation "[| x |]" := (znz_to_Z w_op x)  (at level 0, x at level 99).
+ Notation "[| x |]" := (to_Z x)  (at level 0, x at level 99).
 
- Definition znz_of_Z (w:Type) (op:znz_op w) z :=
- match z with
- | Zpos p => snd (op.(znz_of_pos) p)
- | _ => op.(znz_0)
- end.
-
- Theorem znz_of_pos_correct:
-   forall p, Zpos p < base (znz_digits w_op) -> [|(snd (znz_of_pos w_op p))|] = Zpos p.
+ Theorem of_pos_correct:
+   forall p, Zpos p < base digits -> [|(snd (of_pos p))|] = Zpos p.
+ Proof.
  intros p Hp.
- generalize (spec_of_pos op_spec p).
- case (znz_of_pos w_op p); intros n w1; simpl.
+ generalize (spec_of_pos p).
+ case (of_pos p); intros n w1; simpl.
  case n; simpl Npos; auto with zarith.
- intros p1 Hp1; contradict Hp; apply Zle_not_lt.
- rewrite Hp1; auto with zarith.
- match goal with |- _ <= ?X + ?Y =>
-  apply Zle_trans with X; auto with zarith
- end.
- match goal with |- ?X <= _ =>
-  pattern X at 1; rewrite <- (Zmult_1_l);
-  apply Zmult_le_compat_r; auto with zarith
- end.
+ intros p1 Hp1; contradict Hp; apply Z.le_ngt.
+ replace (base digits) with (1 * base digits + 0) by ring.
+ rewrite Hp1.
+ apply Z.add_le_mono.
+ apply Z.mul_le_mono_nonneg; auto with zarith.
  case p1; simpl; intros; red; simpl; intros; discriminate.
  unfold base; auto with zarith.
- case (spec_to_Z op_spec w1); auto with zarith.
+ case (spec_to_Z w1); auto with zarith.
  Qed.
 
- Theorem znz_of_Z_correct:
-   forall p, 0 <= p < base (znz_digits w_op) -> [|znz_of_Z w_op p|] = p.
+ Definition of_Z z :=
+ match z with
+ | Zpos p => snd (of_pos p)
+ | _ => zero
+ end.
+
+ Theorem of_Z_correct:
+   forall p, 0 <= p < base digits -> [|of_Z p|] = p.
+ Proof.
  intros p; case p; simpl; try rewrite spec_0; auto.
- intros; rewrite znz_of_pos_correct; auto with zarith.
- intros p1 (H1, _); contradict H1; apply Zlt_not_le; red; simpl; auto.
+ intros; rewrite of_pos_correct; auto with zarith.
+ intros p1 (H1, _); contradict H1; apply Z.lt_nge; red; simpl; auto.
  Qed.
-End znz_of_pos.
 
+ End Of_Z.
+
+End ZnZ.
 
 (** A modular specification grouping the earlier records. *)
 
 Module Type CyclicType.
- Parameter w : Type.
- Parameter w_op : znz_op w.
- Parameter w_spec : znz_spec w_op.
+ Parameter t : Type.
+ Declare Instance ops : ZnZ.Ops t.
+ Declare Instance specs : ZnZ.Specs ops.
 End CyclicType.
 
 
@@ -379,87 +325,78 @@ End CyclicType.
 
 Module CyclicRing (Import Cyclic : CyclicType).
 
-Definition t := w.
-
-Local Notation "[| x |]" := (w_op.(znz_to_Z) x) (at level 0, x at level 99).
+Local Notation "[| x |]" := (ZnZ.to_Z x) (at level 0, x at level 99).
 
 Definition eq (n m : t) := [| n |] = [| m |].
-Definition zero : t := w_op.(znz_0).
-Definition one := w_op.(znz_1).
-Definition add := w_op.(znz_add).
-Definition sub := w_op.(znz_sub).
-Definition mul := w_op.(znz_mul).
-Definition opp := w_op.(znz_opp).
 
 Local Infix "=="  := eq (at level 70).
-Local Notation "0" := zero.
-Local Notation "1" := one.
-Local Infix "+" := add.
-Local Infix "-" := sub.
-Local Infix "*" := mul.
-Local Notation "!!" := (base (znz_digits w_op)).
-
-Hint Rewrite
- w_spec.(spec_0) w_spec.(spec_1)
- w_spec.(spec_add) w_spec.(spec_mul) w_spec.(spec_opp) w_spec.(spec_sub)
+Local Notation "0" := ZnZ.zero.
+Local Notation "1" := ZnZ.one.
+Local Infix "+" := ZnZ.add.
+Local Infix "-" := ZnZ.sub.
+Local Notation "- x" := (ZnZ.opp x).
+Local Infix "*" := ZnZ.mul.
+Local Notation wB := (base ZnZ.digits).
+
+Hint Rewrite ZnZ.spec_0 ZnZ.spec_1 ZnZ.spec_add ZnZ.spec_mul
+ ZnZ.spec_opp ZnZ.spec_sub
  : cyclic.
 
-Ltac zify :=
- unfold eq, zero, one, add, sub, mul, opp in *; autorewrite with cyclic.
+Ltac zify := unfold eq in *; autorewrite with cyclic.
 
 Lemma add_0_l : forall x, 0 + x == x.
 Proof.
-intros. zify. rewrite Zplus_0_l.
-apply Zmod_small. apply w_spec.(spec_to_Z).
+intros. zify. rewrite Z.add_0_l.
+apply Zmod_small. apply ZnZ.spec_to_Z.
 Qed.
 
 Lemma add_comm : forall x y, x + y == y + x.
 Proof.
-intros. zify. now rewrite Zplus_comm.
+intros. zify. now rewrite Z.add_comm.
 Qed.
 
 Lemma add_assoc : forall x y z, x + (y + z) == x + y + z.
 Proof.
-intros. zify. now rewrite Zplus_mod_idemp_r, Zplus_mod_idemp_l, Zplus_assoc.
+intros. zify. now rewrite Zplus_mod_idemp_r, Zplus_mod_idemp_l, Z.add_assoc.
 Qed.
 
 Lemma mul_1_l : forall x, 1 * x == x.
 Proof.
-intros. zify. rewrite Zmult_1_l.
-apply Zmod_small. apply w_spec.(spec_to_Z).
+intros. zify. rewrite Z.mul_1_l.
+apply Zmod_small. apply ZnZ.spec_to_Z.
 Qed.
 
 Lemma mul_comm : forall x y, x * y == y * x.
 Proof.
-intros. zify. now rewrite Zmult_comm.
+intros. zify. now rewrite Z.mul_comm.
 Qed.
 
 Lemma mul_assoc : forall x y z, x * (y * z) == x * y * z.
 Proof.
-intros. zify. now rewrite Zmult_mod_idemp_r, Zmult_mod_idemp_l, Zmult_assoc.
+intros. zify. now rewrite Zmult_mod_idemp_r, Zmult_mod_idemp_l, Z.mul_assoc.
 Qed.
 
 Lemma mul_add_distr_r : forall x y z, (x+y)*z == x*z + y*z.
 Proof.
-intros. zify. now rewrite <- Zplus_mod, Zmult_mod_idemp_l, Zmult_plus_distr_l.
+intros. zify. now rewrite <- Zplus_mod, Zmult_mod_idemp_l, Z.mul_add_distr_r.
 Qed.
 
-Lemma add_opp_r : forall x y, x + opp y == x-y.
+Lemma add_opp_r : forall x y, x + - y == x-y.
 Proof.
-intros. zify. rewrite <- Zminus_mod_idemp_r. unfold Zminus.
-destruct (Z_eq_dec ([|y|] mod !!) 0) as [EQ|NEQ].
-rewrite Z_mod_zero_opp_full, EQ, 2 Zplus_0_r; auto.
+intros. zify. rewrite <- Zminus_mod_idemp_r. unfold Z.sub.
+destruct (Z.eq_dec ([|y|] mod wB) 0) as [EQ|NEQ].
+rewrite Z_mod_zero_opp_full, EQ, 2 Z.add_0_r; auto.
 rewrite Z_mod_nz_opp_full by auto.
 rewrite <- Zplus_mod_idemp_r, <- Zminus_mod_idemp_l.
 rewrite Z_mod_same_full. simpl. now rewrite Zplus_mod_idemp_r.
 Qed.
 
-Lemma add_opp_diag_r : forall x, x + opp x == 0.
+Lemma add_opp_diag_r : forall x, x + - x == 0.
 Proof.
-intros. red. rewrite add_opp_r. zify. now rewrite Zminus_diag, Zmod_0_l.
+intros. red. rewrite add_opp_r. zify. now rewrite Z.sub_diag, Zmod_0_l.
 Qed.
 
-Lemma CyclicRing : ring_theory 0 1 add mul sub opp eq.
+Lemma CyclicRing : ring_theory 0 1 ZnZ.add ZnZ.mul ZnZ.sub ZnZ.opp eq.
 Proof.
 constructor.
 exact add_0_l. exact add_comm. exact add_assoc.
@@ -470,15 +407,16 @@ exact add_opp_diag_r.
 Qed.
 
 Definition eqb x y :=
- match w_op.(znz_compare) x y with Eq => true | _ => false end.
+ match ZnZ.compare x y with Eq => true | _ => false end.
 
 Lemma eqb_eq : forall x y, eqb x y = true <-> x == y.
 Proof.
- intros. unfold eqb, eq. generalize (w_spec.(spec_compare) x y).
- destruct (w_op.(znz_compare) x y); intuition; try discriminate.
+ intros. unfold eqb, eq.
+ rewrite ZnZ.spec_compare.
+ case Z.compare_spec; intuition; try discriminate.
 Qed.
 
 Lemma eqb_correct : forall x y, eqb x y = true -> x==y.
 Proof. now apply eqb_eq. Qed.
 
-End CyclicRing.
\ No newline at end of file
+End CyclicRing.
diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v
index 92215ba9..1d5b78ec 100644
--- a/theories/Numbers/Cyclic/Abstract/NZCyclic.v
+++ b/theories/Numbers/Cyclic/Abstract/NZCyclic.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NZCyclic.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NZAxioms.
 Require Import BigNumPrelude.
 Require Import DoubleType.
@@ -27,21 +25,19 @@ Module NZCyclicAxiomsMod (Import Cyclic : CyclicType) <: NZAxiomsSig.
 
 Local Open Scope Z_scope.
 
-Definition t := w.
-
-Definition NZ_to_Z : t -> Z := znz_to_Z w_op.
-Definition Z_to_NZ : Z -> t := znz_of_Z w_op.
-Local Notation wB := (base w_op.(znz_digits)).
+Local Notation wB := (base ZnZ.digits).
 
-Local Notation "[| x |]" := (w_op.(znz_to_Z) x) (at level 0, x at level 99).
+Local Notation "[| x |]" := (ZnZ.to_Z x) (at level 0, x at level 99).
 
 Definition eq (n m : t) := [| n |] = [| m |].
-Definition zero := w_op.(znz_0).
-Definition succ := w_op.(znz_succ).
-Definition pred := w_op.(znz_pred).
-Definition add := w_op.(znz_add).
-Definition sub := w_op.(znz_sub).
-Definition mul := w_op.(znz_mul).
+Definition zero := ZnZ.zero.
+Definition one := ZnZ.one.
+Definition two := ZnZ.succ ZnZ.one.
+Definition succ := ZnZ.succ.
+Definition pred := ZnZ.pred.
+Definition add := ZnZ.add.
+Definition sub := ZnZ.sub.
+Definition mul := ZnZ.mul.
 
 Local Infix "=="  := eq (at level 70).
 Local Notation "0" := zero.
@@ -51,45 +47,29 @@ Local Infix "+" := add.
 Local Infix "-" := sub.
 Local Infix "*" := mul.
 
-Hint Rewrite w_spec.(spec_0) w_spec.(spec_succ) w_spec.(spec_pred)
- w_spec.(spec_add) w_spec.(spec_mul) w_spec.(spec_sub) : w.
-Ltac wsimpl :=
- unfold eq, zero, succ, pred, add, sub, mul; autorewrite with w.
-Ltac wcongruence := repeat red; intros; wsimpl; congruence.
+Hint Rewrite ZnZ.spec_0 ZnZ.spec_1 ZnZ.spec_succ ZnZ.spec_pred
+ ZnZ.spec_add ZnZ.spec_mul ZnZ.spec_sub : cyclic.
+Ltac zify :=
+ unfold eq, zero, one, two, succ, pred, add, sub, mul in *;
+ autorewrite with cyclic.
+Ltac zcongruence := repeat red; intros; zify; congruence.
 
 Instance eq_equiv : Equivalence eq.
 Proof.
 unfold eq. firstorder.
 Qed.
 
-Instance succ_wd : Proper (eq ==> eq) succ.
-Proof.
-wcongruence.
-Qed.
-
-Instance pred_wd : Proper (eq ==> eq) pred.
-Proof.
-wcongruence.
-Qed.
-
-Instance add_wd : Proper (eq ==> eq ==> eq) add.
-Proof.
-wcongruence.
-Qed.
-
-Instance sub_wd : Proper (eq ==> eq ==> eq) sub.
-Proof.
-wcongruence.
-Qed.
+Local Obligation Tactic := zcongruence.
 
-Instance mul_wd : Proper (eq ==> eq ==> eq) mul.
-Proof.
-wcongruence.
-Qed.
+Program Instance succ_wd : Proper (eq ==> eq) succ.
+Program Instance pred_wd : Proper (eq ==> eq) pred.
+Program Instance add_wd : Proper (eq ==> eq ==> eq) add.
+Program Instance sub_wd : Proper (eq ==> eq ==> eq) sub.
+Program Instance mul_wd : Proper (eq ==> eq ==> eq) mul.
 
 Theorem gt_wB_1 : 1 < wB.
 Proof.
-unfold base. apply Zpower_gt_1; unfold Zlt; auto with zarith.
+unfold base. apply Zpower_gt_1; unfold Z.lt; auto with zarith.
 Qed.
 
 Theorem gt_wB_0 : 0 < wB.
@@ -97,39 +77,41 @@ Proof.
 pose proof gt_wB_1; auto with zarith.
 Qed.
 
+Lemma one_mod_wB : 1 mod wB = 1.
+Proof.
+rewrite Zmod_small. reflexivity. split. auto with zarith. apply gt_wB_1.
+Qed.
+
 Lemma succ_mod_wB : forall n : Z, (n + 1) mod wB = ((n mod wB) + 1) mod wB.
 Proof.
-intro n.
-pattern 1 at 2. replace 1 with (1 mod wB). rewrite <- Zplus_mod.
-reflexivity.
-now rewrite Zmod_small; [ | split; [auto with zarith | apply gt_wB_1]].
+intro n. rewrite <- one_mod_wB at 2. now rewrite <- Zplus_mod.
 Qed.
 
 Lemma pred_mod_wB : forall n : Z, (n - 1) mod wB = ((n mod wB) - 1) mod wB.
 Proof.
-intro n.
-pattern 1 at 2. replace 1 with (1 mod wB). rewrite <- Zminus_mod.
-reflexivity.
-now rewrite Zmod_small; [ | split; [auto with zarith | apply gt_wB_1]].
+intro n. rewrite <- one_mod_wB at 2. now rewrite Zminus_mod.
 Qed.
 
 Lemma NZ_to_Z_mod : forall n, [| n |] mod wB = [| n |].
 Proof.
-intro n; rewrite Zmod_small. reflexivity. apply w_spec.(spec_to_Z).
+intro n; rewrite Zmod_small. reflexivity. apply ZnZ.spec_to_Z.
 Qed.
 
 Theorem pred_succ : forall n, P (S n) == n.
 Proof.
-intro n. wsimpl.
+intro n. zify.
 rewrite <- pred_mod_wB.
-replace ([| n |] + 1 - 1)%Z with [| n |] by auto with zarith. apply NZ_to_Z_mod.
+replace ([| n |] + 1 - 1)%Z with [| n |] by ring. apply NZ_to_Z_mod.
 Qed.
 
-Lemma Z_to_NZ_0 : Z_to_NZ 0%Z == 0.
+Theorem one_succ : one == succ zero.
 Proof.
-unfold NZ_to_Z, Z_to_NZ. wsimpl.
-rewrite znz_of_Z_correct; auto.
-exact w_spec. split; [auto with zarith |apply gt_wB_0].
+zify; simpl. now rewrite one_mod_wB.
+Qed.
+
+Theorem two_succ : two == succ one.
+Proof.
+reflexivity.
 Qed.
 
 Section Induction.
@@ -140,21 +122,22 @@ Hypothesis A0 : A 0.
 Hypothesis AS : forall n, A n <-> A (S n).
  (* Below, we use only -> direction *)
 
-Let B (n : Z) := A (Z_to_NZ n).
+Let B (n : Z) := A (ZnZ.of_Z n).
 
 Lemma B0 : B 0.
 Proof.
-unfold B. now rewrite Z_to_NZ_0.
+unfold B.
+setoid_replace (ZnZ.of_Z 0) with zero. assumption.
+red; zify. apply ZnZ.of_Z_correct. auto using gt_wB_0 with zarith.
 Qed.
 
 Lemma BS : forall n : Z, 0 <= n -> n < wB - 1 -> B n -> B (n + 1).
 Proof.
 intros n H1 H2 H3.
-unfold B in *. apply -> AS in H3.
-setoid_replace (Z_to_NZ (n + 1)) with (S (Z_to_NZ n)). assumption.
-wsimpl.
-unfold NZ_to_Z, Z_to_NZ.
-do 2 (rewrite znz_of_Z_correct; [ | exact w_spec | auto with zarith]).
+unfold B in *. apply AS in H3.
+setoid_replace (ZnZ.of_Z (n + 1)) with (S (ZnZ.of_Z n)). assumption.
+zify.
+rewrite 2 ZnZ.of_Z_correct; auto with zarith.
 symmetry; apply Zmod_small; auto with zarith.
 Qed.
 
@@ -167,51 +150,51 @@ Qed.
 
 Theorem bi_induction : forall n, A n.
 Proof.
-intro n. setoid_replace n with (Z_to_NZ (NZ_to_Z n)).
-apply B_holds. apply w_spec.(spec_to_Z).
-unfold eq, NZ_to_Z, Z_to_NZ; rewrite znz_of_Z_correct.
-reflexivity.
-exact w_spec.
-apply w_spec.(spec_to_Z).
+intro n. setoid_replace n with (ZnZ.of_Z (ZnZ.to_Z n)).
+apply B_holds. apply ZnZ.spec_to_Z.
+red. symmetry. apply ZnZ.of_Z_correct.
+apply ZnZ.spec_to_Z.
 Qed.
 
 End Induction.
 
 Theorem add_0_l : forall n, 0 + n == n.
 Proof.
-intro n. wsimpl.
-rewrite Zplus_0_l. rewrite Zmod_small; [reflexivity | apply w_spec.(spec_to_Z)].
+intro n. zify.
+rewrite Z.add_0_l. apply Zmod_small. apply ZnZ.spec_to_Z.
 Qed.
 
 Theorem add_succ_l : forall n m, (S n) + m == S (n + m).
 Proof.
-intros n m. wsimpl.
+intros n m. zify.
 rewrite succ_mod_wB. repeat rewrite Zplus_mod_idemp_l; try apply gt_wB_0.
-rewrite <- (Zplus_assoc ([| n |] mod wB) 1 [| m |]). rewrite Zplus_mod_idemp_l.
-rewrite (Zplus_comm 1 [| m |]); now rewrite Zplus_assoc.
+rewrite <- (Z.add_assoc ([| n |] mod wB) 1 [| m |]). rewrite Zplus_mod_idemp_l.
+rewrite (Z.add_comm 1 [| m |]); now rewrite Z.add_assoc.
 Qed.
 
 Theorem sub_0_r : forall n, n - 0 == n.
 Proof.
-intro n. wsimpl. rewrite Zminus_0_r. apply NZ_to_Z_mod.
+intro n. zify. rewrite Z.sub_0_r. apply NZ_to_Z_mod.
 Qed.
 
 Theorem sub_succ_r : forall n m, n - (S m) == P (n - m).
 Proof.
-intros n m. wsimpl. rewrite Zminus_mod_idemp_r, Zminus_mod_idemp_l.
+intros n m. zify. rewrite Zminus_mod_idemp_r, Zminus_mod_idemp_l.
 now replace ([|n|] - ([|m|] + 1))%Z with ([|n|] - [|m|] - 1)%Z
-     by auto with zarith.
+     by ring.
 Qed.
 
 Theorem mul_0_l : forall n, 0 * n == 0.
 Proof.
-intro n. wsimpl. now rewrite Zmult_0_l.
+intro n. now zify.
 Qed.
 
 Theorem mul_succ_l : forall n m, (S n) * m == n * m + m.
 Proof.
-intros n m. wsimpl. rewrite Zplus_mod_idemp_l, Zmult_mod_idemp_l.
-now rewrite Zmult_plus_distr_l, Zmult_1_l.
+intros n m. zify. rewrite Zplus_mod_idemp_l, Zmult_mod_idemp_l.
+now rewrite Z.mul_add_distr_r, Z.mul_1_l.
 Qed.
 
+Definition t := t.
+
 End NZCyclicAxiomsMod.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v
index 305d77a9..35d8b595 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: DoubleAdd.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import ZArith.
@@ -184,7 +182,7 @@ Section DoubleAdd.
    destruct x as [ |xh xl];simpl. apply spec_ww_1.
    generalize (spec_w_succ_c xl);destruct (w_succ_c xl) as [l|l];
     intro H;unfold interp_carry in H. simpl;rewrite H;ring.
-   rewrite <- Zplus_assoc;rewrite <- H;rewrite Zmult_1_l.
+   rewrite <- Z.add_assoc;rewrite <- H;rewrite Z.mul_1_l.
    assert ([|l|] = 0). generalize (spec_to_Z xl)(spec_to_Z l);omega.
    rewrite H0;generalize (spec_w_succ_c xh);destruct (w_succ_c xh) as [h|h];
     intro H1;unfold interp_carry in H1.
@@ -197,19 +195,19 @@ Section DoubleAdd.
   Lemma spec_ww_add_c  : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]].
   Proof.
    destruct x as [ |xh xl];simpl;trivial.
-   destruct y as [ |yh yl];simpl. rewrite Zplus_0_r;trivial.
+   destruct y as [ |yh yl];simpl. rewrite Z.add_0_r;trivial.
    replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]))
    with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|])). 2:ring.
    generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l];
     intros H;unfold interp_carry in H;rewrite <- H.
    generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h];
     intros H1;unfold interp_carry in *;rewrite <- H1. trivial.
-   repeat rewrite Zmult_1_l;rewrite spec_w_WW;rewrite wwB_wBwB; ring.
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   repeat rewrite Z.mul_1_l;rewrite spec_w_WW;rewrite wwB_wBwB; ring.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh)
     as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1.
    simpl;ring.
-   repeat rewrite Zmult_1_l;rewrite wwB_wBwB;rewrite spec_w_WW;ring.
+   repeat rewrite Z.mul_1_l;rewrite wwB_wBwB;rewrite spec_w_WW;ring.
   Qed.
 
   Section Cont.
@@ -223,23 +221,23 @@ Section DoubleAdd.
     destruct x as [ |xh xl];simpl;trivial.
     apply spec_f0;trivial.
     destruct y as [ |yh yl];simpl.
-    apply spec_f0;simpl;rewrite Zplus_0_r;trivial.
+    apply spec_f0;simpl;rewrite Z.add_0_r;trivial.
     generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l];
      intros H;unfold interp_carry in H.
     generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h];
      intros H1;unfold interp_carry in *.
     apply spec_f0. simpl;rewrite H;rewrite H1;ring.
     apply spec_f1. simpl;rewrite spec_w_WW;rewrite H.
-    rewrite Zplus_assoc;rewrite wwB_wBwB. rewrite Zpower_2; rewrite <- Zmult_plus_distr_l.
-    rewrite Zmult_1_l in H1;rewrite H1;ring.
+    rewrite Z.add_assoc;rewrite wwB_wBwB. rewrite Z.pow_2_r; rewrite <- Z.mul_add_distr_r.
+    rewrite Z.mul_1_l in H1;rewrite H1;ring.
     generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh)
      as [h|h]; intros H1;unfold interp_carry in *.
-    apply spec_f0;simpl;rewrite H1. rewrite Zmult_plus_distr_l.
-    rewrite <- Zplus_assoc;rewrite H;ring.
+    apply spec_f0;simpl;rewrite H1. rewrite Z.mul_add_distr_r.
+    rewrite <- Z.add_assoc;rewrite H;ring.
     apply spec_f1.  simpl;rewrite spec_w_WW;rewrite wwB_wBwB.
-    rewrite Zplus_assoc; rewrite Zpower_2; rewrite <- Zmult_plus_distr_l.
-    rewrite Zmult_1_l in H1;rewrite H1. rewrite Zmult_plus_distr_l.
-    rewrite <- Zplus_assoc;rewrite H;ring.
+    rewrite Z.add_assoc; rewrite Z.pow_2_r; rewrite <- Z.mul_add_distr_r.
+    rewrite Z.mul_1_l in H1;rewrite H1. rewrite Z.mul_add_distr_r.
+    rewrite <- Z.add_assoc;rewrite H;ring.
    Qed.
 
   End Cont.
@@ -250,19 +248,19 @@ Section DoubleAdd.
    destruct x as [ |xh xl];intro y;simpl.
    exact (spec_ww_succ_c y).
    destruct y as [ |yh yl];simpl.
-   rewrite Zplus_0_r;exact (spec_ww_succ_c (WW xh xl)).
+   rewrite Z.add_0_r;exact (spec_ww_succ_c (WW xh xl)).
    replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1)
    with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring.
    generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl)
     as [l|l];intros H;unfold interp_carry in H;rewrite <- H.
    generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h];
     intros H1;unfold interp_carry in H1;rewrite <- H1. trivial.
-   unfold interp_carry;repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring.
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   unfold interp_carry;repeat rewrite Z.mul_1_l;simpl;rewrite wwB_wBwB;ring.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh)
     as [h|h];intros H1;unfold interp_carry in H1;rewrite <- H1. trivial.
    unfold interp_carry;rewrite spec_w_WW;
-   repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring.
+   repeat rewrite Z.mul_1_l;simpl;rewrite wwB_wBwB;ring.
   Qed.
 
   Lemma spec_ww_succ : forall x, [[ww_succ x]] = ([[x]] + 1) mod wwB.
@@ -270,14 +268,14 @@ Section DoubleAdd.
    destruct x as [ |xh xl];simpl.
    rewrite spec_ww_1;rewrite Zmod_small;trivial.
    split;[intro;discriminate|apply wwB_pos].
-   rewrite <- Zplus_assoc;generalize (spec_w_succ_c xl);
+   rewrite <- Z.add_assoc;generalize (spec_w_succ_c xl);
    destruct (w_succ_c xl) as[l|l];intro H;unfold interp_carry in H;rewrite <-H.
    rewrite Zmod_small;trivial.
    rewrite wwB_wBwB;apply beta_mult;apply spec_to_Z.
    assert ([|l|] = 0). clear spec_ww_1 spec_w_1 spec_w_0.
     assert (H1:= spec_to_Z l); assert (H2:= spec_to_Z xl); omega.
-   rewrite H0;rewrite Zplus_0_r;rewrite <- Zmult_plus_distr_l;rewrite wwB_wBwB.
-   rewrite Zpower_2; rewrite Zmult_mod_distr_r;try apply lt_0_wB.
+   rewrite H0;rewrite Z.add_0_r;rewrite <- Z.mul_add_distr_r;rewrite wwB_wBwB.
+   rewrite Z.pow_2_r; rewrite Zmult_mod_distr_r;try apply lt_0_wB.
    rewrite spec_w_W0;rewrite spec_w_succ;trivial.
   Qed.
 
@@ -286,7 +284,7 @@ Section DoubleAdd.
    destruct x as [ |xh xl];intros y;simpl.
    rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial.
    destruct y as [ |yh yl].
-   change [[W0]] with 0;rewrite Zplus_0_r.
+   change [[W0]] with 0;rewrite Z.add_0_r.
    rewrite Zmod_small;trivial.
     exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)).
    simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]))
@@ -294,7 +292,7 @@ Section DoubleAdd.
    generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l];
    unfold interp_carry;intros H;simpl;rewrite <- H.
    rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial.
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial.
   Qed.
 
@@ -304,13 +302,13 @@ Section DoubleAdd.
    destruct x as [ |xh xl];intros y;simpl.
    exact (spec_ww_succ y).
    destruct y as [ |yh yl].
-   change [[W0]] with 0;rewrite Zplus_0_r. exact (spec_ww_succ (WW xh xl)).
+   change [[W0]] with 0;rewrite Z.add_0_r. exact (spec_ww_succ (WW xh xl)).
    simpl;replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1)
    with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring.
    generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl)
    as [l|l];unfold interp_carry;intros H;rewrite <- H;simpl ww_to_Z.
    rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial.
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial.
   Qed.
 
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v
index 3d44f96b..ed69a8f5 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,16 +8,16 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: DoubleBase.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
-Require Import ZArith.
+Require Import ZArith Ndigits.
 Require Import BigNumPrelude.
 Require Import DoubleType.
 
 Local Open Scope Z_scope.
 
+Local Infix "<<" := Pos.shiftl_nat (at level 30).
+
 Section DoubleBase.
  Variable w : Type.
  Variable w_0   : w.
@@ -70,13 +70,7 @@ Section DoubleBase.
      end
   end.
 
- Fixpoint double_digits (n:nat) : positive :=
-  match n with
-  | O => w_digits
-  | S n => xO (double_digits n)
-  end.
-
- Definition double_wB n := base (double_digits n).
+ Definition double_wB n := base (w_digits << n).
 
  Fixpoint double_to_Z (n:nat) : word w n -> Z :=
   match n return word w n -> Z with
@@ -167,17 +161,13 @@ Section DoubleBase.
   Variable spec_w_0W  : forall l, [[w_0W l]] = [|l|].
   Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
   Variable spec_w_compare : forall x y,
-       match w_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
+     w_compare x y = Z.compare [|x|] [|y|].
 
   Lemma wwB_wBwB : wwB = wB^2.
   Proof.
-   unfold base, ww_digits;rewrite Zpower_2; rewrite (Zpos_xO w_digits).
+   unfold base, ww_digits;rewrite Z.pow_2_r; rewrite (Pos2Z.inj_xO w_digits).
    replace (2 * Zpos w_digits) with (Zpos w_digits + Zpos w_digits).
-   apply Zpower_exp; unfold Zge;simpl;intros;discriminate.
+   apply Zpower_exp; unfold Z.ge;simpl;intros;discriminate.
    ring.
   Qed.
 
@@ -189,28 +179,28 @@ Section DoubleBase.
 
   Lemma lt_0_wB : 0 < wB.
   Proof.
-   unfold base;apply Zpower_gt_0. unfold Zlt;reflexivity.
-   unfold Zle;intros H;discriminate H.
+   unfold base;apply Z.pow_pos_nonneg. unfold Z.lt;reflexivity.
+   unfold Z.le;intros H;discriminate H.
   Qed.
 
   Lemma lt_0_wwB : 0 < wwB.
-  Proof. rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_lt_0_compat;apply lt_0_wB. Qed.
+  Proof. rewrite wwB_wBwB; rewrite Z.pow_2_r; apply Z.mul_pos_pos;apply lt_0_wB. Qed.
 
   Lemma wB_pos: 1 < wB.
   Proof.
-   unfold base;apply Zlt_le_trans with (2^1).  unfold Zlt;reflexivity.
-   apply Zpower_le_monotone.  unfold Zlt;reflexivity.
-   split;unfold Zle;intros H. discriminate H.
+   unfold base;apply Z.lt_le_trans with (2^1).  unfold Z.lt;reflexivity.
+   apply Zpower_le_monotone.  unfold Z.lt;reflexivity.
+   split;unfold Z.le;intros H. discriminate H.
    clear spec_w_0W w_0W spec_w_Bm1 spec_to_Z spec_w_WW w_WW.
    destruct w_digits; discriminate H.
   Qed.
 
   Lemma wwB_pos: 1 < wwB.
   Proof.
-   assert (H:= wB_pos);rewrite wwB_wBwB;rewrite <-(Zmult_1_r 1).
-   rewrite Zpower_2.
-   apply Zmult_lt_compat2;(split;[unfold Zlt;reflexivity|trivial]).
-   apply Zlt_le_weak;trivial.
+   assert (H:= wB_pos);rewrite wwB_wBwB;rewrite <-(Z.mul_1_r 1).
+   rewrite Z.pow_2_r.
+   apply Zmult_lt_compat2;(split;[unfold Z.lt;reflexivity|trivial]).
+   apply Z.lt_le_incl;trivial.
   Qed.
 
   Theorem wB_div_2:  2 * (wB / 2) = wB.
@@ -218,22 +208,22 @@ Section DoubleBase.
    clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W
     spec_to_Z;unfold base.
    assert (2 ^ Zpos w_digits = 2 * (2 ^ (Zpos w_digits - 1))).
-   pattern 2 at 2; rewrite <- Zpower_1_r.
+   pattern 2 at 2; rewrite <- Z.pow_1_r.
    rewrite <- Zpower_exp; auto with zarith.
    f_equal; auto with zarith.
    case w_digits; compute; intros; discriminate.
    rewrite H; f_equal; auto with zarith.
-   rewrite Zmult_comm; apply Z_div_mult; auto with zarith.
+   rewrite Z.mul_comm; apply Z_div_mult; auto with zarith.
   Qed.
 
   Theorem wwB_div_2 : wwB / 2 = wB / 2 * wB.
   Proof.
    clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W
     spec_to_Z.
-   rewrite wwB_wBwB; rewrite Zpower_2.
+   rewrite wwB_wBwB; rewrite Z.pow_2_r.
    pattern wB at 1; rewrite <- wB_div_2; auto.
-   rewrite <- Zmult_assoc.
-   repeat (rewrite (Zmult_comm 2); rewrite Z_div_mult); auto with zarith.
+   rewrite <- Z.mul_assoc.
+   repeat (rewrite (Z.mul_comm 2); rewrite Z_div_mult); auto with zarith.
   Qed.
 
   Lemma mod_wwB : forall z x,
@@ -241,15 +231,15 @@ Section DoubleBase.
   Proof.
    intros z x.
    rewrite Zplus_mod.
-   pattern wwB at 1;rewrite wwB_wBwB; rewrite Zpower_2.
+   pattern wwB at 1;rewrite wwB_wBwB; rewrite Z.pow_2_r.
    rewrite Zmult_mod_distr_r;try apply lt_0_wB.
    rewrite (Zmod_small [|x|]).
    apply Zmod_small;rewrite wwB_wBwB;apply beta_mult;try apply spec_to_Z.
-   apply Z_mod_lt;apply Zlt_gt;apply lt_0_wB.
+   apply Z_mod_lt;apply Z.lt_gt;apply lt_0_wB.
    destruct (spec_to_Z x);split;trivial.
    change [|x|] with (0*wB+[|x|]). rewrite wwB_wBwB.
-   rewrite Zpower_2;rewrite <- (Zplus_0_r (wB*wB));apply beta_lex_inv.
-   apply lt_0_wB. apply spec_to_Z. split;[apply Zle_refl | apply lt_0_wB].
+   rewrite Z.pow_2_r;rewrite <- (Z.add_0_r (wB*wB));apply beta_lex_inv.
+   apply lt_0_wB. apply spec_to_Z. split;[apply Z.le_refl | apply lt_0_wB].
  Qed.
 
   Lemma wB_div : forall x y, ([|x|] * wB + [|y|]) / wB = [|x|].
@@ -275,33 +265,32 @@ Section DoubleBase.
    clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1.
    unfold base;apply Zpower_lt_monotone;auto with zarith.
    assert (0 < Zpos w_digits). compute;reflexivity.
-   unfold ww_digits;rewrite Zpos_xO;auto with zarith.
+   unfold ww_digits;rewrite Pos2Z.inj_xO;auto with zarith.
   Qed.
 
   Lemma w_to_Z_wwB : forall x, x < wB -> x < wwB.
   Proof.
-   intros x H;apply Zlt_trans with wB;trivial;apply lt_wB_wwB.
+   intros x H;apply Z.lt_trans with wB;trivial;apply lt_wB_wwB.
   Qed.
 
   Lemma spec_ww_to_Z : forall x, 0 <= [[x]] < wwB.
   Proof.
    clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1.
    destruct x as [ |h l];simpl.
-   split;[apply Zle_refl|apply lt_0_wwB].
+   split;[apply Z.le_refl|apply lt_0_wwB].
    assert (H:=spec_to_Z h);assert (L:=spec_to_Z l);split.
-   apply Zplus_le_0_compat;auto with zarith.
-   rewrite <- (Zplus_0_r wwB);rewrite wwB_wBwB; rewrite Zpower_2;
+   apply Z.add_nonneg_nonneg;auto with zarith.
+   rewrite <- (Z.add_0_r wwB);rewrite wwB_wBwB; rewrite Z.pow_2_r;
     apply beta_lex_inv;auto with zarith.
   Qed.
 
   Lemma double_wB_wwB : forall n, double_wB n * double_wB n = double_wB (S n).
   Proof.
    intros n;unfold double_wB;simpl.
-   unfold base;rewrite (Zpos_xO (double_digits n)).
-   replace  (2 * Zpos (double_digits n)) with
-     (Zpos (double_digits n) + Zpos (double_digits n)).
+   unfold base. rewrite Pshiftl_nat_S, (Pos2Z.inj_xO (_ << _)).
+   replace  (2 * Zpos (w_digits << n)) with
+     (Zpos (w_digits << n) + Zpos (w_digits << n)) by ring.
    symmetry; apply Zpower_exp;intro;discriminate.
-   ring.
   Qed.
 
   Lemma double_wB_pos:
@@ -315,16 +304,16 @@ Section DoubleBase.
   Proof.
   clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1.
   intros n; elim n; clear n; auto.
-    unfold double_wB, double_digits; auto with zarith.
+    unfold double_wB, "<<"; auto with zarith.
   intros n H1; rewrite <- double_wB_wwB.
-  apply Zle_trans with (wB * 1).
-    rewrite Zmult_1_r; apply Zle_refl.
-  apply Zmult_le_compat; auto with zarith.
-  apply Zle_trans with wB; auto with zarith.
-  unfold base.
-  rewrite <- (Zpower_0_r 2).
-  apply Zpower_le_monotone2; auto with zarith.
+  apply Z.le_trans with (wB * 1).
+    rewrite Z.mul_1_r; apply Z.le_refl.
   unfold base; auto with zarith.
+  apply Z.mul_le_mono_nonneg; auto with zarith.
+  apply Z.le_trans with wB; auto with zarith.
+  unfold base.
+  rewrite <- (Z.pow_0_r 2).
+  apply Z.pow_le_mono_r; auto with zarith.
   Qed.
 
   Lemma spec_double_to_Z :
@@ -337,9 +326,9 @@ Section DoubleBase.
   unfold double_wB,base;split;auto with zarith.
   assert (U0:= IHn w0);assert (U1:= IHn w1).
   split;auto with zarith.
-  apply Zlt_le_trans with ((double_wB n - 1) * double_wB n + double_wB n).
+  apply Z.lt_le_trans with ((double_wB n - 1) * double_wB n + double_wB n).
   assert (double_to_Z n w0*double_wB n <= (double_wB n - 1)*double_wB n).
-  apply Zmult_le_compat_r;auto with zarith.
+  apply Z.mul_le_mono_nonneg_r;auto with zarith.
   auto with zarith.
   rewrite <- double_wB_wwB.
   replace ((double_wB n - 1) * double_wB n + double_wB n) with (double_wB n * double_wB n);
@@ -353,22 +342,19 @@ Section DoubleBase.
   clear spec_w_1 spec_w_Bm1.
   intros n; elim n; auto; clear n.
   intros n Hrec x; case x; clear x; auto.
-  intros xx yy H1; simpl in H1.
-  assert (F1: [!n | xx!] = 0).
-    case (Zle_lt_or_eq 0 ([!n | xx!])); auto.
-      case (spec_double_to_Z n xx); auto.
-     intros F2.
-     assert (F3 := double_wB_more_digits n).
-    assert (F4: 0 <= [!n | yy!]).
-      case (spec_double_to_Z n yy); auto.
+  intros xx yy; simpl.
+  destruct (spec_double_to_Z n xx) as [F1 _]. Z.le_elim F1.
+  - (* 0 < [!n | xx!] *)
+    intros; exfalso.
+    assert (F3 := double_wB_more_digits n).
+    destruct (spec_double_to_Z n yy) as [F4 _].
     assert (F5: 1 * wB <=  [!n | xx!] * double_wB n);
      auto with zarith.
-    apply Zmult_le_compat; auto with zarith.
+    apply Z.mul_le_mono_nonneg; auto with zarith.
     unfold base; auto with zarith.
-  simpl get_low; simpl double_to_Z.
-  generalize H1; clear H1.
-  rewrite F1; rewrite Zmult_0_l; rewrite Zplus_0_l.
-  intros H1; apply Hrec; auto.
+  - (* 0 = [!n | xx!] *)
+    rewrite <- F1; rewrite Z.mul_0_l, Z.add_0_l.
+    intros; apply Hrec; auto.
   Qed.
 
   Lemma spec_double_WW : forall n (h l : word w n),
@@ -408,35 +394,40 @@ Section DoubleBase.
    intros a b c d H1; apply beta_lex_inv with (1 := H1); auto.
   Qed.
 
+  Ltac comp2ord := match goal with
+   | |- Lt = (?x ?= ?y) => symmetry; change (x < y)
+   | |- Gt = (?x ?= ?y) => symmetry; change (x > y); apply Z.lt_gt
+  end.
+
   Lemma spec_ww_compare : forall x y,
-       match ww_compare x y with
-       | Eq => [[x]] = [[y]]
-       | Lt => [[x]] < [[y]]
-       | Gt => [[x]] > [[y]]
-       end.
+    ww_compare x y = Z.compare [[x]] [[y]].
   Proof.
    destruct x as [ |xh xl];destruct y as [ |yh yl];simpl;trivial.
-   generalize (spec_w_compare w_0 yh);destruct (w_compare w_0 yh);
-    intros H;rewrite spec_w_0 in H.
-   rewrite <- H;simpl;rewrite <- spec_w_0;apply spec_w_compare.
-   change 0 with (0*wB+0);pattern 0 at 2;rewrite <- spec_w_0.
+   (* 1st case *)
+   rewrite 2 spec_w_compare, spec_w_0.
+   destruct (Z.compare_spec 0 [|yh|]) as [H|H|H].
+   rewrite <- H;simpl. reflexivity.
+   symmetry. change (0 < [|yh|]*wB+[|yl|]).
+   change 0 with (0*wB+0). rewrite <- spec_w_0 at 2.
    apply wB_lex_inv;trivial.
-   absurd (0 <= [|yh|]). apply Zgt_not_le;trivial.
+   absurd (0 <= [|yh|]). apply Z.lt_nge; trivial.
    destruct (spec_to_Z yh);trivial.
-   generalize (spec_w_compare xh w_0);destruct (w_compare xh w_0);
-    intros H;rewrite spec_w_0 in H.
-   rewrite H;simpl;rewrite <- spec_w_0;apply spec_w_compare.
-   absurd (0 <= [|xh|]). apply Zgt_not_le;apply Zlt_gt;trivial.
+   (* 2nd case *)
+   rewrite 2 spec_w_compare, spec_w_0.
+   destruct (Z.compare_spec [|xh|] 0) as [H|H|H].
+   rewrite H;simpl;reflexivity.
+   absurd (0 <= [|xh|]). apply Z.lt_nge; trivial.
    destruct (spec_to_Z xh);trivial.
-   apply Zlt_gt;change 0 with (0*wB+0);pattern 0 at 2;rewrite <- spec_w_0.
-   apply wB_lex_inv;apply Zgt_lt;trivial.
-
-   generalize (spec_w_compare xh yh);destruct (w_compare xh yh);intros H.
-   rewrite H;generalize (spec_w_compare xl yl);destruct (w_compare xl yl);
-   intros H1;[rewrite H1|apply Zplus_lt_compat_l|apply Zplus_gt_compat_l];
-   trivial.
+   comp2ord.
+   change 0 with (0*wB+0). rewrite <- spec_w_0 at 2.
    apply wB_lex_inv;trivial.
-   apply Zlt_gt;apply wB_lex_inv;apply Zgt_lt;trivial.
+   (* 3rd case *)
+   rewrite 2 spec_w_compare.
+   destruct (Z.compare_spec [|xh|] [|yh|]) as [H|H|H].
+   rewrite H.
+   symmetry. apply Z.add_compare_mono_l.
+   comp2ord. apply wB_lex_inv;trivial.
+   comp2ord. apply wB_lex_inv;trivial.
   Qed.
 
 
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v
index 006da1b3..35fe948e 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: DoubleCyclic.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import ZArith.
@@ -30,65 +28,65 @@ Local Open Scope Z_scope.
 
 Section Z_2nZ.
 
- Variable w : Type.
- Variable w_op : znz_op w.
- Let w_digits      := w_op.(znz_digits).
- Let w_zdigits      := w_op.(znz_zdigits).
+ Context {t : Type}{ops : ZnZ.Ops t}.
+
+ Let w_digits      := ZnZ.digits.
+ Let w_zdigits      := ZnZ.zdigits.
 
- Let w_to_Z        := w_op.(znz_to_Z).
- Let w_of_pos      := w_op.(znz_of_pos).
- Let w_head0       := w_op.(znz_head0).
- Let w_tail0       := w_op.(znz_tail0).
+ Let w_to_Z        := ZnZ.to_Z.
+ Let w_of_pos      := ZnZ.of_pos.
+ Let w_head0       := ZnZ.head0.
+ Let w_tail0       := ZnZ.tail0.
 
- Let w_0            := w_op.(znz_0).
- Let w_1            := w_op.(znz_1).
- Let w_Bm1          := w_op.(znz_Bm1).
+ Let w_0            := ZnZ.zero.
+ Let w_1            := ZnZ.one.
+ Let w_Bm1          := ZnZ.minus_one.
 
- Let w_compare     := w_op.(znz_compare).
- Let w_eq0         := w_op.(znz_eq0).
+ Let w_compare     := ZnZ.compare.
+ Let w_eq0         := ZnZ.eq0.
 
- Let w_opp_c       := w_op.(znz_opp_c).
- Let w_opp         := w_op.(znz_opp).
- Let w_opp_carry   := w_op.(znz_opp_carry).
+ Let w_opp_c       := ZnZ.opp_c.
+ Let w_opp         := ZnZ.opp.
+ Let w_opp_carry   := ZnZ.opp_carry.
 
- Let w_succ_c      := w_op.(znz_succ_c).
- Let w_add_c       := w_op.(znz_add_c).
- Let w_add_carry_c := w_op.(znz_add_carry_c).
- Let w_succ        := w_op.(znz_succ).
- Let w_add         := w_op.(znz_add).
- Let w_add_carry   := w_op.(znz_add_carry).
+ Let w_succ_c      := ZnZ.succ_c.
+ Let w_add_c       := ZnZ.add_c.
+ Let w_add_carry_c := ZnZ.add_carry_c.
+ Let w_succ        := ZnZ.succ.
+ Let w_add         := ZnZ.add.
+ Let w_add_carry   := ZnZ.add_carry.
 
- Let w_pred_c      := w_op.(znz_pred_c).
- Let w_sub_c       := w_op.(znz_sub_c).
- Let w_sub_carry_c := w_op.(znz_sub_carry_c).
- Let w_pred        := w_op.(znz_pred).
- Let w_sub         := w_op.(znz_sub).
- Let w_sub_carry   := w_op.(znz_sub_carry).
+ Let w_pred_c      := ZnZ.pred_c.
+ Let w_sub_c       := ZnZ.sub_c.
+ Let w_sub_carry_c := ZnZ.sub_carry_c.
+ Let w_pred        := ZnZ.pred.
+ Let w_sub         := ZnZ.sub.
+ Let w_sub_carry   := ZnZ.sub_carry.
 
 
- Let w_mul_c       := w_op.(znz_mul_c).
- Let w_mul         := w_op.(znz_mul).
- Let w_square_c    := w_op.(znz_square_c).
+ Let w_mul_c       := ZnZ.mul_c.
+ Let w_mul         := ZnZ.mul.
+ Let w_square_c    := ZnZ.square_c.
 
- Let w_div21       := w_op.(znz_div21).
- Let w_div_gt      := w_op.(znz_div_gt).
- Let w_div         := w_op.(znz_div).
+ Let w_div21       := ZnZ.div21.
+ Let w_div_gt      := ZnZ.div_gt.
+ Let w_div         := ZnZ.div.
 
- Let w_mod_gt      := w_op.(znz_mod_gt).
- Let w_mod         := w_op.(znz_mod).
+ Let w_mod_gt      := ZnZ.modulo_gt.
+ Let w_mod         := ZnZ.modulo.
 
- Let w_gcd_gt      := w_op.(znz_gcd_gt).
- Let w_gcd         := w_op.(znz_gcd).
+ Let w_gcd_gt      := ZnZ.gcd_gt.
+ Let w_gcd         := ZnZ.gcd.
 
- Let w_add_mul_div := w_op.(znz_add_mul_div).
+ Let w_add_mul_div := ZnZ.add_mul_div.
 
- Let w_pos_mod := w_op.(znz_pos_mod).
+ Let w_pos_mod := ZnZ.pos_mod.
 
- Let w_is_even     := w_op.(znz_is_even).
- Let w_sqrt2       := w_op.(znz_sqrt2).
- Let w_sqrt        := w_op.(znz_sqrt).
+ Let w_is_even     := ZnZ.is_even.
+ Let w_sqrt2       := ZnZ.sqrt2.
+ Let w_sqrt        := ZnZ.sqrt.
 
- Let _zn2z := zn2z w.
+ Let _zn2z := zn2z t.
 
  Let wB := base w_digits.
 
@@ -105,9 +103,9 @@ Section Z_2nZ.
 
  Let to_Z := zn2z_to_Z wB w_to_Z.
 
- Let w_W0 := znz_W0 w_op.
- Let w_0W := znz_0W w_op.
- Let w_WW := znz_WW w_op.
+ Let w_W0 := ZnZ.WO.
+ Let w_0W := ZnZ.OW.
+ Let w_WW := ZnZ.WW.
 
  Let ww_of_pos p :=
   match w_of_pos p with
@@ -124,15 +122,15 @@ Section Z_2nZ.
   Eval lazy beta delta [ww_tail0] in
   ww_tail0 w_0 w_0W w_compare w_tail0 w_add2 w_zdigits _ww_zdigits.
 
- Let ww_WW := Eval lazy beta delta [ww_WW] in (@ww_WW w).
- Let ww_0W := Eval lazy beta delta [ww_0W] in (@ww_0W w).
- Let ww_W0 := Eval lazy beta delta [ww_W0] in (@ww_W0 w).
+ Let ww_WW := Eval lazy beta delta [ww_WW] in (@ww_WW t).
+ Let ww_0W := Eval lazy beta delta [ww_0W] in (@ww_0W t).
+ Let ww_W0 := Eval lazy beta delta [ww_W0] in (@ww_W0 t).
 
  (* ** Comparison ** *)
  Let compare :=
   Eval lazy beta delta[ww_compare] in ww_compare w_0 w_compare.
 
- Let eq0 (x:zn2z w) :=
+ Let eq0 (x:zn2z t) :=
   match x with
   | W0 => true
   | _ => false
@@ -226,7 +224,7 @@ Section Z_2nZ.
   Eval lazy beta iota delta [ww_div21] in
    ww_div21 w_0 w_0W div32 ww_1 compare sub.
 
- Let low (p: zn2z w) := match p with WW _ p1 => p1 | _ => w_0 end.
+ Let low (p: zn2z t) := match p with WW _ p1 => p1 | _ => w_0 end.
 
  Let add_mul_div :=
   Eval lazy beta delta [ww_add_mul_div] in
@@ -287,8 +285,8 @@ Section Z_2nZ.
 
  (* ** Record of operators on 2 words *)
 
- Definition mk_zn2z_op :=
-  mk_znz_op _ww_digits _ww_zdigits
+ Global Instance mk_zn2z_ops : ZnZ.Ops (zn2z t) | 1 :=
+  ZnZ.MkOps _ww_digits _ww_zdigits
     to_Z ww_of_pos head0 tail0
     W0 ww_1 ww_Bm1
     compare eq0
@@ -307,8 +305,8 @@ Section Z_2nZ.
     sqrt2
     sqrt.
 
- Definition mk_zn2z_op_karatsuba :=
-   mk_znz_op _ww_digits _ww_zdigits
+ Global Instance mk_zn2z_ops_karatsuba : ZnZ.Ops (zn2z t) | 2 :=
+   ZnZ.MkOps _ww_digits _ww_zdigits
     to_Z ww_of_pos head0 tail0
     W0 ww_1 ww_Bm1
     compare eq0
@@ -328,51 +326,51 @@ Section Z_2nZ.
     sqrt.
 
  (* Proof *)
- Variable op_spec : znz_spec w_op.
+ Context {specs : ZnZ.Specs ops}.
 
  Hint Resolve
-    (spec_to_Z op_spec)
-    (spec_of_pos op_spec)
-    (spec_0 op_spec)
-    (spec_1 op_spec)
-    (spec_Bm1 op_spec)
-    (spec_compare op_spec)
-    (spec_eq0 op_spec)
-    (spec_opp_c op_spec)
-    (spec_opp op_spec)
-    (spec_opp_carry op_spec)
-    (spec_succ_c op_spec)
-    (spec_add_c op_spec)
-    (spec_add_carry_c op_spec)
-    (spec_succ op_spec)
-    (spec_add op_spec)
-    (spec_add_carry op_spec)
-    (spec_pred_c op_spec)
-    (spec_sub_c op_spec)
-    (spec_sub_carry_c op_spec)
-    (spec_pred op_spec)
-    (spec_sub op_spec)
-    (spec_sub_carry op_spec)
-    (spec_mul_c op_spec)
-    (spec_mul op_spec)
-    (spec_square_c op_spec)
-    (spec_div21 op_spec)
-    (spec_div_gt op_spec)
-    (spec_div op_spec)
-    (spec_mod_gt op_spec)
-    (spec_mod op_spec)
-    (spec_gcd_gt op_spec)
-    (spec_gcd op_spec)
-    (spec_head0 op_spec)
-    (spec_tail0 op_spec)
-    (spec_add_mul_div op_spec)
-    (spec_pos_mod)
-    (spec_is_even)
-    (spec_sqrt2)
-    (spec_sqrt)
-    (spec_W0 op_spec)
-    (spec_0W op_spec)
-    (spec_WW op_spec).
+    ZnZ.spec_to_Z
+    ZnZ.spec_of_pos
+    ZnZ.spec_0
+    ZnZ.spec_1
+    ZnZ.spec_m1
+    ZnZ.spec_compare
+    ZnZ.spec_eq0
+    ZnZ.spec_opp_c
+    ZnZ.spec_opp
+    ZnZ.spec_opp_carry
+    ZnZ.spec_succ_c
+    ZnZ.spec_add_c
+    ZnZ.spec_add_carry_c
+    ZnZ.spec_succ
+    ZnZ.spec_add
+    ZnZ.spec_add_carry
+    ZnZ.spec_pred_c
+    ZnZ.spec_sub_c
+    ZnZ.spec_sub_carry_c
+    ZnZ.spec_pred
+    ZnZ.spec_sub
+    ZnZ.spec_sub_carry
+    ZnZ.spec_mul_c
+    ZnZ.spec_mul
+    ZnZ.spec_square_c
+    ZnZ.spec_div21
+    ZnZ.spec_div_gt
+    ZnZ.spec_div
+    ZnZ.spec_modulo_gt
+    ZnZ.spec_modulo
+    ZnZ.spec_gcd_gt
+    ZnZ.spec_gcd
+    ZnZ.spec_head0
+    ZnZ.spec_tail0
+    ZnZ.spec_add_mul_div
+    ZnZ.spec_pos_mod
+    ZnZ.spec_is_even
+    ZnZ.spec_sqrt2
+    ZnZ.spec_sqrt
+    ZnZ.spec_WO
+    ZnZ.spec_OW
+    ZnZ.spec_WW.
 
  Ltac wwauto := unfold ww_to_Z; auto.
 
@@ -392,20 +390,21 @@ Section Z_2nZ.
  Proof. refine (spec_ww_to_Z w_digits w_to_Z _);auto. Qed.
 
  Let spec_ww_of_pos : forall p,
-     Zpos p = (Z_of_N (fst (ww_of_pos p)))*wwB + [|(snd (ww_of_pos p))|].
+     Zpos p = (Z.of_N (fst (ww_of_pos p)))*wwB + [|(snd (ww_of_pos p))|].
  Proof.
   unfold ww_of_pos;intros.
-  assert (H:= spec_of_pos op_spec p);unfold w_of_pos;
-   destruct (znz_of_pos w_op p). simpl in H.
-  rewrite H;clear H;destruct n;simpl to_Z.
-  simpl;unfold w_to_Z,w_0;rewrite (spec_0 op_spec);trivial.
-  unfold Z_of_N; assert (H:= spec_of_pos op_spec p0);
-  destruct (znz_of_pos w_op p0). simpl in H.
-  rewrite H;unfold fst, snd,Z_of_N, to_Z.
-  rewrite (spec_WW op_spec).
+  rewrite (ZnZ.spec_of_pos p). unfold w_of_pos.
+  case (ZnZ.of_pos p); intros. simpl.
+  destruct n; simpl ZnZ.to_Z.
+  simpl;unfold w_to_Z,w_0; rewrite ZnZ.spec_0;trivial.
+  unfold Z.of_N.
+  rewrite (ZnZ.spec_of_pos p0).
+  case (ZnZ.of_pos p0); intros. simpl.
+  unfold fst, snd,Z.of_N, to_Z, wB, w_digits, w_to_Z, w_WW.
+  rewrite ZnZ.spec_WW.
   replace wwB with (wB*wB).
-  unfold wB,w_to_Z,w_digits;clear H;destruct n;ring.
-  symmetry. rewrite <- Zpower_2; exact (wwB_wBwB w_digits).
+  unfold wB,w_to_Z,w_digits;destruct n;ring.
+  symmetry. rewrite <- Z.pow_2_r; exact (wwB_wBwB w_digits).
  Qed.
 
  Let spec_ww_0 : [|W0|] = 0.
@@ -418,15 +417,9 @@ Section Z_2nZ.
  Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed.
 
  Let spec_ww_compare :
-     forall x y,
-       match compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
+  forall x y, compare x y = Z.compare [|x|] [|y|].
  Proof.
   refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);auto.
-  exact (spec_compare op_spec).
  Qed.
 
  Let spec_ww_eq0 : forall x, eq0 x = true -> [|x|] = 0.
@@ -531,8 +524,7 @@ Section Z_2nZ.
  Proof.
  refine (spec_ww_karatsuba_c _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
           _ _ _ _ _ _ _ _ _ _ _ _); wwauto.
-  unfold w_digits; apply spec_more_than_1_digit; auto.
-  exact (spec_compare op_spec).
+  unfold w_digits; apply ZnZ.spec_more_than_1_digit; auto.
  Qed.
 
  Let spec_ww_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wwB.
@@ -559,11 +551,10 @@ Section Z_2nZ.
    w_add w_add_carry w_pred w_sub w_mul_c w_div21 sub_c w_digits w_to_Z
    _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto.
   unfold w_Bm2, w_to_Z, w_pred, w_Bm1.
-  rewrite (spec_pred op_spec);rewrite (spec_Bm1 op_spec).
+  rewrite ZnZ.spec_pred, ZnZ.spec_m1.
   unfold w_digits;rewrite Zmod_small. ring.
-  assert (H:= wB_pos(znz_digits w_op)). omega.
-  exact (spec_compare op_spec).
-  exact (spec_div21 op_spec).
+  assert (H:= wB_pos(ZnZ.digits)). omega.
+  exact ZnZ.spec_div21.
  Qed.
 
  Let spec_ww_div21 : forall a1 a2 b,
@@ -580,24 +571,21 @@ Section Z_2nZ.
  Let spec_add2: forall x y,
   [|w_add2 x y|] = w_to_Z x + w_to_Z y.
   unfold w_add2.
-  intros xh xl; generalize (spec_add_c op_spec xh xl).
-  unfold w_add_c; case znz_add_c; unfold interp_carry; simpl ww_to_Z.
+  intros xh xl; generalize (ZnZ.spec_add_c xh xl).
+  unfold w_add_c; case ZnZ.add_c; unfold interp_carry; simpl ww_to_Z.
     intros w0 Hw0; simpl; unfold w_to_Z; rewrite Hw0.
-  unfold w_0; rewrite spec_0; simpl; auto with zarith.
-  intros w0; rewrite Zmult_1_l; simpl.
-  unfold w_to_Z, w_1; rewrite spec_1; auto with zarith.
-  rewrite Zmult_1_l; auto.
+  unfold w_0; rewrite ZnZ.spec_0; simpl; auto with zarith.
+  intros w0; rewrite Z.mul_1_l; simpl.
+  unfold w_to_Z, w_1; rewrite ZnZ.spec_1; auto with zarith.
+  rewrite Z.mul_1_l; auto.
  Qed.
 
  Let spec_low: forall x,
   w_to_Z (low x) = [|x|] mod wB.
   intros x; case x; simpl low.
-    unfold ww_to_Z, w_to_Z, w_0; rewrite (spec_0 op_spec); simpl.
-    rewrite Zmod_small; auto with zarith.
-    split; auto with zarith.
-    unfold wB, base; auto with zarith.
+    unfold ww_to_Z, w_to_Z, w_0; rewrite ZnZ.spec_0; simpl; auto.
   intros xh xl; simpl.
-  rewrite Zplus_comm; rewrite Z_mod_plus; auto with zarith.
+  rewrite Z.add_comm; rewrite Z_mod_plus; auto with zarith.
   rewrite Zmod_small; auto with zarith.
   unfold wB, base; auto with zarith.
  Qed.
@@ -608,8 +596,8 @@ Section Z_2nZ.
  unfold w_to_Z, _ww_zdigits.
  rewrite spec_add2.
  unfold w_to_Z, w_zdigits, w_digits.
- rewrite spec_zdigits; auto.
- rewrite Zpos_xO; auto with zarith.
+ rewrite ZnZ.spec_zdigits; auto.
+ rewrite Pos2Z.inj_xO; auto with zarith.
  Qed.
 
 
@@ -617,10 +605,9 @@ Section Z_2nZ.
  Proof.
  refine (spec_ww_head00 w_0 w_0W
                 w_compare w_head0 w_add2 w_zdigits _ww_zdigits
-                w_to_Z _ _ _ (refl_equal _ww_digits) _ _ _ _); auto.
- exact (spec_compare op_spec).
- exact (spec_head00 op_spec).
- exact (spec_zdigits op_spec).
+                w_to_Z _ _ _ (eq_refl _ww_digits) _ _ _ _); auto.
+ exact ZnZ.spec_head00.
+ exact ZnZ.spec_zdigits.
  Qed.
 
  Let spec_ww_head0  : forall x,  0 < [|x|] ->
@@ -629,18 +616,16 @@ Section Z_2nZ.
   refine (spec_ww_head0 w_0 w_0W w_compare w_head0
            w_add2 w_zdigits _ww_zdigits
    w_to_Z _ _ _ _ _ _ _);wwauto.
-  exact (spec_compare op_spec).
-  exact (spec_zdigits op_spec).
+  exact ZnZ.spec_zdigits.
  Qed.
 
  Let spec_ww_tail00  : forall x,  [|x|] = 0 -> [|tail0 x|] = Zpos _ww_digits.
  Proof.
  refine (spec_ww_tail00 w_0 w_0W
                 w_compare w_tail0 w_add2 w_zdigits _ww_zdigits
-                w_to_Z _ _ _ (refl_equal _ww_digits) _ _ _ _); wwauto.
- exact (spec_compare op_spec).
- exact (spec_tail00 op_spec).
- exact (spec_zdigits op_spec).
+                w_to_Z _ _ _ (eq_refl _ww_digits) _ _ _ _); wwauto.
+ exact ZnZ.spec_tail00.
+ exact ZnZ.spec_zdigits.
  Qed.
 
 
@@ -649,8 +634,7 @@ Section Z_2nZ.
  Proof.
   refine (spec_ww_tail0 (w_digits := w_digits) w_0 w_0W w_compare w_tail0
            w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ _ _ _ _);wwauto.
-  exact (spec_compare op_spec).
-  exact (spec_zdigits op_spec).
+  exact ZnZ.spec_zdigits.
  Qed.
 
  Lemma spec_ww_add_mul_div : forall x y p,
@@ -659,10 +643,10 @@ Section Z_2nZ.
          ([|x|] * (2 ^ [|p|]) +
           [|y|] / (2 ^ ((Zpos _ww_digits) - [|p|]))) mod wwB.
  Proof.
- refine (@spec_ww_add_mul_div w w_0 w_WW w_W0 w_0W compare w_add_mul_div
+ refine (@spec_ww_add_mul_div t w_0 w_WW w_W0 w_0W compare w_add_mul_div
               sub w_digits w_zdigits low w_to_Z
            _ _ _ _ _ _ _ _ _ _ _);wwauto.
-  exact (spec_zdigits op_spec).
+  exact ZnZ.spec_zdigits.
  Qed.
 
  Let spec_ww_div_gt : forall a b,
@@ -671,29 +655,29 @@ Section Z_2nZ.
       [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|].
  Proof.
 refine
-(@spec_ww_div_gt w w_digits w_0 w_WW w_0W w_compare w_eq0
+(@spec_ww_div_gt t w_digits w_0 w_WW w_0W w_compare w_eq0
    w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt
    w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z
  _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
 ).
-  exact (spec_0 op_spec).
-  exact (spec_to_Z op_spec).
+  exact ZnZ.spec_0.
+  exact ZnZ.spec_to_Z.
   wwauto.
   wwauto.
-  exact (spec_compare op_spec).
-  exact (spec_eq0 op_spec).
-  exact (spec_opp_c op_spec).
-  exact (spec_opp op_spec).
-  exact (spec_opp_carry op_spec).
-  exact (spec_sub_c op_spec).
-  exact (spec_sub op_spec).
-  exact (spec_sub_carry op_spec).
-  exact (spec_div_gt op_spec).
-  exact (spec_add_mul_div op_spec).
-  exact (spec_head0 op_spec).
-  exact (spec_div21 op_spec).
+  exact ZnZ.spec_compare.
+  exact ZnZ.spec_eq0.
+  exact ZnZ.spec_opp_c.
+  exact ZnZ.spec_opp.
+  exact ZnZ.spec_opp_carry.
+  exact ZnZ.spec_sub_c.
+  exact ZnZ.spec_sub.
+  exact ZnZ.spec_sub_carry.
+  exact ZnZ.spec_div_gt.
+  exact ZnZ.spec_add_mul_div.
+  exact ZnZ.spec_head0.
+  exact ZnZ.spec_div21.
   exact spec_w_div32.
-  exact (spec_zdigits op_spec).
+  exact ZnZ.spec_zdigits.
   exact spec_ww_digits.
   exact spec_ww_1.
   exact spec_ww_add_mul_div.
@@ -711,15 +695,14 @@ refine
       [|a|] > [|b|] -> 0 < [|b|] ->
       [|mod_gt a b|] = [|a|] mod [|b|].
  Proof.
-  refine (@spec_ww_mod_gt w w_digits w_0 w_WW w_0W w_compare w_eq0
+  refine (@spec_ww_mod_gt t w_digits w_0 w_WW w_0W w_compare w_eq0
    w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt w_mod_gt
    w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div
    w_zdigits w_to_Z
    _ _ _ _ _   _ _ _ _ _   _ _ _ _ _   _ _ _ _ _ _ _);wwauto.
-  exact (spec_compare op_spec).
-  exact (spec_div_gt op_spec).
-  exact (spec_div21 op_spec).
-  exact (spec_zdigits op_spec).
+  exact ZnZ.spec_div_gt.
+  exact ZnZ.spec_div21.
+  exact ZnZ.spec_zdigits.
   exact spec_ww_add_mul_div.
  Qed.
 
@@ -731,37 +714,33 @@ refine
  Let spec_ww_gcd_gt : forall a b, [|a|] > [|b|] ->
       Zis_gcd [|a|] [|b|] [|gcd_gt a b|].
  Proof.
-  refine (@spec_ww_gcd_gt w w_digits W0 w_to_Z _
+  refine (@spec_ww_gcd_gt t w_digits W0 w_to_Z _
     w_0 w_0 w_eq0 w_gcd_gt _ww_digits
   _ gcd_gt_fix _ _ _ _ gcd_cont _);auto.
-  refine (@spec_ww_gcd_gt_aux w w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp
+  refine (@spec_ww_gcd_gt_aux t w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp
    w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0
    w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z
    _ _ _ _ _   _ _ _ _ _   _ _ _ _ _   _ _ _ _ _);wwauto.
-  exact (spec_compare op_spec).
-  exact (spec_div21 op_spec).
-  exact (spec_zdigits op_spec).
+  exact ZnZ.spec_div21.
+  exact ZnZ.spec_zdigits.
   exact spec_ww_add_mul_div.
-  refine (@spec_gcd_cont w w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare
+  refine (@spec_gcd_cont t w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare
    _ _);auto.
- exact (spec_compare op_spec).
  Qed.
 
  Let spec_ww_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|].
  Proof.
-  refine (@spec_ww_gcd w w_digits W0 compare w_to_Z _ _ w_0 w_0 w_eq0 w_gcd_gt
+  refine (@spec_ww_gcd t w_digits W0 compare w_to_Z _ _ w_0 w_0 w_eq0 w_gcd_gt
   _ww_digits _ gcd_gt_fix _ _ _ _ gcd_cont _);auto.
-  refine (@spec_ww_gcd_gt_aux w w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp
+  refine (@spec_ww_gcd_gt_aux t w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp
    w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0
    w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z
    _ _ _ _ _   _ _ _ _ _   _ _ _ _ _   _ _ _ _ _);wwauto.
-  exact (spec_compare op_spec).
-  exact (spec_div21 op_spec).
-  exact (spec_zdigits op_spec).
+  exact ZnZ.spec_div21.
+  exact ZnZ.spec_zdigits.
   exact spec_ww_add_mul_div.
-  refine (@spec_gcd_cont w w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare
+  refine (@spec_gcd_cont t w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare
    _ _);auto.
-  exact (spec_compare op_spec).
  Qed.
 
  Let spec_ww_is_even : forall x,
@@ -770,8 +749,8 @@ refine
       | false => [|x|] mod 2 = 1
       end.
  Proof.
- refine (@spec_ww_is_even w w_is_even w_0 w_1 w_Bm1 w_digits _ _ _ _ _); auto.
- exact (spec_is_even op_spec).
+ refine (@spec_ww_is_even t w_is_even w_digits _ _ ).
+ exact ZnZ.spec_is_even.
  Qed.
 
  Let spec_ww_sqrt2 : forall x y,
@@ -781,78 +760,72 @@ refine
           [+|r|] <= 2 * [|s|].
  Proof.
  intros x y H.
- refine (@spec_ww_sqrt2 w w_is_even w_compare w_0 w_1 w_Bm1
+ refine (@spec_ww_sqrt2 t w_is_even w_compare w_0 w_1 w_Bm1
                w_0W w_sub w_square_c w_div21 w_add_mul_div w_digits w_zdigits
                _ww_zdigits
                w_add_c w_sqrt2 w_pred pred_c pred add_c add sub_c add_mul_div
                 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto.
- exact (spec_zdigits op_spec).
- exact (spec_more_than_1_digit op_spec).
- exact (spec_is_even op_spec).
- exact (spec_compare op_spec).
- exact (spec_div21 op_spec).
- exact (spec_ww_add_mul_div).
- exact (spec_sqrt2 op_spec).
+ exact ZnZ.spec_zdigits.
+ exact ZnZ.spec_more_than_1_digit.
+ exact ZnZ.spec_is_even.
+ exact ZnZ.spec_div21.
+ exact spec_ww_add_mul_div.
+ exact ZnZ.spec_sqrt2.
  Qed.
 
  Let spec_ww_sqrt : forall x,
        [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2.
  Proof.
- refine (@spec_ww_sqrt w w_is_even w_0 w_1 w_Bm1
+ refine (@spec_ww_sqrt t w_is_even w_0 w_1 w_Bm1
            w_sub w_add_mul_div w_digits w_zdigits _ww_zdigits
                w_sqrt2 pred add_mul_div head0 compare
             _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto.
- exact (spec_zdigits op_spec).
- exact (spec_more_than_1_digit op_spec).
- exact (spec_is_even op_spec).
- exact (spec_ww_add_mul_div).
- exact (spec_sqrt2 op_spec).
+ exact ZnZ.spec_zdigits.
+ exact ZnZ.spec_more_than_1_digit.
+ exact ZnZ.spec_is_even.
+ exact spec_ww_add_mul_div.
+ exact ZnZ.spec_sqrt2.
  Qed.
 
- Lemma mk_znz2_spec : znz_spec mk_zn2z_op.
+ Global Instance mk_zn2z_specs : ZnZ.Specs mk_zn2z_ops.
  Proof.
-  apply mk_znz_spec;auto.
+  apply ZnZ.MkSpecs; auto.
   exact spec_ww_add_mul_div.
 
-  refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW
+  refine (@spec_ww_pos_mod t w_0 w_digits w_zdigits w_WW
            w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z
        _ _ _ _ _ _ _ _ _ _ _ _);wwauto.
-  exact (spec_pos_mod op_spec).
-  exact (spec_zdigits op_spec).
+  exact ZnZ.spec_zdigits.
   unfold w_to_Z, w_zdigits.
-  rewrite (spec_zdigits op_spec).
-  rewrite <- Zpos_xO; exact spec_ww_digits.
+  rewrite ZnZ.spec_zdigits.
+  rewrite <- Pos2Z.inj_xO; exact spec_ww_digits.
  Qed.
 
- Lemma mk_znz2_karatsuba_spec : znz_spec mk_zn2z_op_karatsuba.
+ Global Instance mk_zn2z_specs_karatsuba : ZnZ.Specs mk_zn2z_ops_karatsuba.
  Proof.
-  apply mk_znz_spec;auto.
+  apply ZnZ.MkSpecs; auto.
   exact spec_ww_add_mul_div.
-  refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW
+  refine (@spec_ww_pos_mod t w_0 w_digits w_zdigits w_WW
            w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z
        _ _ _ _ _ _ _ _ _ _ _ _);wwauto.
-  exact (spec_pos_mod op_spec).
-  exact (spec_zdigits op_spec).
+  exact ZnZ.spec_zdigits.
   unfold w_to_Z, w_zdigits.
-  rewrite (spec_zdigits op_spec).
-  rewrite <- Zpos_xO; exact spec_ww_digits.
+  rewrite ZnZ.spec_zdigits.
+  rewrite <- Pos2Z.inj_xO; exact spec_ww_digits.
  Qed.
 
 End Z_2nZ.
 
 Section MulAdd.
 
-  Variable w: Type.
-  Variable op: znz_op w.
-  Variable sop: znz_spec op.
+  Context {t : Type}{ops : ZnZ.Ops t}{specs : ZnZ.Specs ops}.
 
-  Definition mul_add:= w_mul_add (znz_0 op) (znz_succ op) (znz_add_c op) (znz_mul_c op).
+  Definition mul_add:= w_mul_add ZnZ.zero ZnZ.succ ZnZ.add_c ZnZ.mul_c.
 
-  Notation "[| x |]" := (znz_to_Z op x)  (at level 0, x at level 99).
+  Notation "[| x |]" := (ZnZ.to_Z x)  (at level 0, x at level 99).
 
   Notation "[|| x ||]" :=
-   (zn2z_to_Z (base (znz_digits op)) (znz_to_Z op) x)  (at level 0, x at level 99).
-
+   (zn2z_to_Z (base ZnZ.digits) ZnZ.to_Z x)  (at level 0, x at level 99).
 
   Lemma spec_mul_add: forall x y z,
      let (zh, zl) := mul_add x y z in
@@ -860,11 +833,11 @@ Section MulAdd.
   Proof.
   intros x y z.
    refine (spec_w_mul_add _ _ _ _ _ _ _ _ _ _ _ _ x y z); auto.
-  exact (spec_0 sop).
-  exact (spec_to_Z sop).
-  exact (spec_succ sop).
-  exact (spec_add_c sop).
-  exact (spec_mul_c sop).
+  exact ZnZ.spec_0.
+  exact ZnZ.spec_to_Z.
+  exact ZnZ.spec_succ.
+  exact ZnZ.spec_add_c.
+  exact ZnZ.spec_mul_c.
   Qed.
 
 End MulAdd.
@@ -873,13 +846,13 @@ End MulAdd.
 (** Modular versions of DoubleCyclic *)
 
 Module DoubleCyclic (C:CyclicType) <: CyclicType.
- Definition w := zn2z C.w.
- Definition w_op := mk_zn2z_op C.w_op.
- Definition w_spec := mk_znz2_spec C.w_spec.
+ Definition t := zn2z C.t.
+ Instance ops : ZnZ.Ops t := mk_zn2z_ops.
+ Instance specs : ZnZ.Specs ops := mk_zn2z_specs.
 End DoubleCyclic.
 
 Module DoubleCyclicKaratsuba (C:CyclicType) <: CyclicType.
- Definition w := zn2z C.w.
- Definition w_op := mk_zn2z_op_karatsuba C.w_op.
- Definition w_spec := mk_znz2_karatsuba_spec C.w_spec.
+ Definition t := zn2z C.t.
+ Definition ops : ZnZ.Ops t := mk_zn2z_ops_karatsuba.
+ Definition specs : ZnZ.Specs ops := mk_zn2z_specs_karatsuba.
 End DoubleCyclicKaratsuba.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v
index 4e6eccea..8525b0e1 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*         Benjamin Gregoire, Laurent Thery, INRIA, 2007                *)
 (************************************************************************)
 
-(*i $Id: DoubleDiv.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import ZArith.
@@ -82,11 +80,7 @@ Section POS_MOD.
 
   Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
   Variable spec_ww_compare : forall x y,
-       match ww_compare x y with
-       | Eq => [[x]] = [[y]]
-       | Lt => [[x]] < [[y]]
-       | Gt => [[x]] > [[y]]
-       end.
+    ww_compare x y = Z.compare [[x]] [[y]].
  Variable spec_ww_sub: forall x y,
    [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB.
 
@@ -105,8 +99,8 @@ Section POS_MOD.
  intros w1 p; case (spec_to_w_Z p); intros HH1 HH2.
  unfold ww_pos_mod; case w1.
  simpl; rewrite Zmod_small; split; auto with zarith.
- intros xh xl; generalize (spec_ww_compare p (w_0W w_zdigits));
-    case ww_compare;
+ intros xh xl; rewrite spec_ww_compare.
+    case Z.compare_spec;
     rewrite spec_w_0W; rewrite spec_zdigits; fold wB;
     intros H1.
    rewrite H1; simpl ww_to_Z.
@@ -123,19 +117,19 @@ Section POS_MOD.
      rewrite spec_low.
      apply Zmod_small; auto with zarith.
      case (spec_to_w_Z p); intros HHH1 HHH2; split; auto with zarith.
-     apply Zlt_le_trans with (1 := H1).
+     apply Z.lt_le_trans with (1 := H1).
      unfold base; apply Zpower2_le_lin; auto with zarith.
    rewrite HH0.
    rewrite Zplus_mod; auto with zarith.
    unfold base.
    rewrite <- (F0 (Zpos w_digits) [[p]]).
    rewrite Zpower_exp; auto with zarith.
-   rewrite Zmult_assoc.
+   rewrite Z.mul_assoc.
    rewrite Z_mod_mult; auto with zarith.
    autorewrite with w_rewrite rm10.
    rewrite Zmod_mod; auto with zarith.
-generalize (spec_ww_compare p ww_zdigits);
-    case ww_compare; rewrite spec_ww_zdigits;
+  rewrite spec_ww_compare.
+    case Z.compare_spec; rewrite spec_ww_zdigits;
                      rewrite spec_zdigits; intros H2.
   replace (2^[[p]]) with wwB.
     rewrite Zmod_small; auto with zarith.
@@ -149,52 +143,52 @@ generalize (spec_ww_compare p ww_zdigits);
     rewrite <- Zmod_div_mod; auto with zarith.
     rewrite Zmod_small; auto with zarith.
     split; auto with zarith.
-    apply Zlt_le_trans with (Zpos w_digits); auto with zarith.
+    apply Z.lt_le_trans with (Zpos w_digits); auto with zarith.
     unfold base; apply Zpower2_le_lin; auto with zarith.
     exists wB; unfold base; rewrite <- Zpower_exp; auto with zarith.
     rewrite spec_ww_digits;
-      apply f_equal with (f := Zpower 2); rewrite Zpos_xO; auto with zarith.
+      apply f_equal with (f := Z.pow 2); rewrite Pos2Z.inj_xO; auto with zarith.
    simpl ww_to_Z; autorewrite with w_rewrite.
    rewrite spec_pos_mod; rewrite HH0.
    pattern [|xh|] at 2;
      rewrite Z_div_mod_eq with (b := 2 ^ ([[p]] - Zpos w_digits));
      auto with zarith.
-   rewrite (fun x => (Zmult_comm (2 ^ x))); rewrite Zmult_plus_distr_l.
-   unfold base; rewrite <- Zmult_assoc; rewrite <- Zpower_exp;
+   rewrite (fun x => (Z.mul_comm (2 ^ x))); rewrite Z.mul_add_distr_r.
+   unfold base; rewrite <- Z.mul_assoc; rewrite <- Zpower_exp;
     auto with zarith.
    rewrite F0; auto with zarith.
-   rewrite <- Zplus_assoc; rewrite Zplus_mod; auto with zarith.
+   rewrite <- Z.add_assoc; rewrite Zplus_mod; auto with zarith.
    rewrite Z_mod_mult; auto with zarith.
    autorewrite with rm10.
    rewrite Zmod_mod; auto with zarith.
-   apply sym_equal; apply Zmod_small; auto with zarith.
+   symmetry; apply Zmod_small; auto with zarith.
    case (spec_to_Z xh); intros U1 U2.
    case (spec_to_Z xl); intros U3 U4.
    split; auto with zarith.
-   apply Zplus_le_0_compat; auto with zarith.
-   apply Zmult_le_0_compat; auto with zarith.
+   apply Z.add_nonneg_nonneg; auto with zarith.
+   apply Z.mul_nonneg_nonneg; auto with zarith.
    match goal with |- 0 <= ?X mod ?Y =>
     case (Z_mod_lt X Y); auto with zarith
    end.
    match goal with |- ?X mod ?Y * ?U + ?Z < ?T =>
-    apply Zle_lt_trans with ((Y - 1) * U + Z );
+    apply Z.le_lt_trans with ((Y - 1) * U + Z );
      [case (Z_mod_lt X Y); auto with zarith | idtac]
    end.
    match goal with |- ?X * ?U + ?Y < ?Z =>
-    apply Zle_lt_trans with (X * U + (U - 1))
+    apply Z.le_lt_trans with (X * U + (U - 1))
    end.
-   apply Zplus_le_compat_l; auto with zarith.
+   apply Z.add_le_mono_l; auto with zarith.
    case (spec_to_Z xl); unfold base; auto with zarith.
-   rewrite Zmult_minus_distr_r; rewrite <- Zpower_exp; auto with zarith.
+   rewrite Z.mul_sub_distr_r; rewrite <- Zpower_exp; auto with zarith.
    rewrite F0; auto with zarith.
   rewrite Zmod_small; auto with zarith.
   case (spec_to_w_Z (WW xh xl)); intros U1 U2.
   split; auto with zarith.
-  apply Zlt_le_trans with (1:= U2).
+  apply Z.lt_le_trans with (1:= U2).
   unfold base; rewrite spec_ww_digits.
   apply Zpower_le_monotone; auto with zarith.
   split; auto with zarith.
-  rewrite Zpos_xO; auto with zarith.
+  rewrite Pos2Z.inj_xO; auto with zarith.
  Qed.
 
 End POS_MOD.
@@ -266,12 +260,7 @@ Section DoubleDiv32.
 
   Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
   Variable spec_compare :
-     forall x y,
-       match w_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
+     forall x y, w_compare x y = Z.compare [|x|] [|y|].
   Variable spec_w_add_c  : forall x y, [+|w_add_c x y|] = [|x|] + [|y|].
   Variable spec_w_add_carry_c :
          forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1.
@@ -301,14 +290,14 @@ Section DoubleDiv32.
    assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x).
 
   Theorem wB_div2: forall x, wB/2  <= x -> wB <= 2 * x.
-   intros x H; rewrite <- wB_div_2; apply Zmult_le_compat_l; auto with zarith.
+   intros x H; rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; auto with zarith.
   Qed.
 
   Lemma Zmult_lt_0_reg_r_2 : forall n m : Z, 0 <= n -> 0 < m * n -> 0 < m.
   Proof.
-   intros n m H1 H2;apply Zmult_lt_0_reg_r with n;trivial.
-   destruct (Zle_lt_or_eq _ _ H1);trivial.
-   subst;rewrite Zmult_0_r in H2;discriminate H2.
+   intros n m H1 H2;apply Z.mul_pos_cancel_r with n;trivial.
+   Z.le_elim H1; trivial.
+   subst;rewrite Z.mul_0_r in H2;discriminate H2.
   Qed.
 
   Theorem spec_w_div32 : forall a1 a2 a3 b1 b2,
@@ -322,7 +311,7 @@ Section DoubleDiv32.
    intros a1 a2 a3 b1 b2 Hle Hlt.
    assert (U:= lt_0_wB w_digits); assert (U1:= lt_0_wwB w_digits).
    Spec_w_to_Z a1;Spec_w_to_Z a2;Spec_w_to_Z a3;Spec_w_to_Z b1;Spec_w_to_Z b2.
-   rewrite wwB_wBwB; rewrite Zpower_2; rewrite Zmult_assoc;rewrite <- Zmult_plus_distr_l.
+   rewrite wwB_wBwB; rewrite Z.pow_2_r; rewrite Z.mul_assoc;rewrite <- Z.mul_add_distr_r.
    change (w_div32 a1 a2 a3 b1 b2) with
     match w_compare a1 b1 with
     | Lt =>
@@ -343,7 +332,7 @@ Section DoubleDiv32.
      (WW (w_sub a2 b2) a3) (WW b1 b2)
     | Gt => (w_0, W0) (* cas absurde *)
     end.
-   assert (Hcmp:=spec_compare a1 b1);destruct (w_compare a1 b1).
+   rewrite spec_compare. case Z.compare_spec; intro Hcmp.
    simpl in Hlt.
    rewrite Hcmp in Hlt;assert ([|a2|] < [|b2|]). omega.
    assert ([[WW (w_sub a2 b2) a3]] = ([|a2|]-[|b2|])*wB + [|a3|] + wwB).
@@ -362,17 +351,17 @@ Section DoubleDiv32.
    rewrite H0;intros r.
    repeat
     (rewrite spec_ww_add;eauto || rewrite spec_w_Bm1 || rewrite spec_w_Bm2);
-   simpl ww_to_Z;try rewrite Zmult_1_l;intros H1.
+   simpl ww_to_Z;try rewrite Z.mul_1_l;intros H1.
    assert (0<= ([[r]] + ([|b1|] * wB + [|b2|])) - wwB < [|b1|] * wB + [|b2|]).
    Spec_ww_to_Z r;split;zarith.
    rewrite H1.
    assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB).
-   rewrite wwB_wBwB; rewrite Zpower_2; zarith.
+   rewrite wwB_wBwB; rewrite Z.pow_2_r; zarith.
    assert (-wwB < ([|a2|] - [|b2|]) * wB + [|a3|] < 0).
-   split. apply Zlt_le_trans with (([|a2|] - [|b2|]) * wB);zarith.
+   split. apply Z.lt_le_trans with (([|a2|] - [|b2|]) * wB);zarith.
    rewrite wwB_wBwB;replace (-(wB^2)) with (-wB*wB);[zarith | ring].
-   apply Zmult_lt_compat_r;zarith.
-   apply Zle_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith.
+   apply Z.mul_lt_mono_pos_r;zarith.
+   apply Z.le_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith.
    replace ( ([|a2|] - [|b2|]) * wB + (wB - 1)) with
      (([|a2|] - [|b2|] + 1) * wB + - 1);[zarith | ring].
    assert (([|a2|] - [|b2|] + 1) * wB <= 0);zarith.
@@ -387,13 +376,13 @@ Section DoubleDiv32.
    Spec_ww_to_Z (WW b1 b2). simpl in HH4;zarith.
    rewrite H0;intros r;repeat
     (rewrite spec_w_Bm1 || rewrite spec_w_Bm2);
-   simpl ww_to_Z;try rewrite Zmult_1_l;intros H1.
+   simpl ww_to_Z;try rewrite Z.mul_1_l;intros H1.
    assert ([[r]]=([|a2|]-[|b2|])*wB+[|a3|]+([|b1|]*wB+[|b2|])). zarith.
    split. rewrite H2;rewrite Hcmp;ring.
    split. Spec_ww_to_Z r;zarith.
    rewrite H2.
    assert (([|a2|] - [|b2|]) * wB + [|a3|] < 0);zarith.
-   apply Zle_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith.
+   apply Z.le_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith.
    replace ( ([|a2|] - [|b2|]) * wB + (wB - 1)) with
      (([|a2|] - [|b2|] + 1) * wB + - 1);[zarith|ring].
    assert (([|a2|] - [|b2|] + 1) * wB <= 0);zarith.
@@ -411,7 +400,7 @@ Section DoubleDiv32.
     rewrite H1.
    split. ring. split.
    rewrite <- H1;destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z r1);trivial.
-   apply Zle_lt_trans with ([|r|] * wB + [|a3|]).
+   apply Z.le_lt_trans with ([|r|] * wB + [|a3|]).
    assert ( 0 <= [|q|] * [|b2|]);zarith.
    apply beta_lex_inv;zarith.
    assert ([[r1]] = [|r|] * wB + [|a3|] - [|q|] * [|b2|] + wwB).
@@ -429,10 +418,10 @@ Section DoubleDiv32.
    intros r2;repeat (rewrite spec_pred || rewrite spec_ww_add;eauto);
    simpl ww_to_Z;intros H7.
    assert (0 < [|q|] - 1).
-   assert (1 <= [|q|]). zarith.
-   destruct (Zle_lt_or_eq _ _ H6);zarith.
-   rewrite <- H8 in H2;rewrite H2 in H7.
-   assert (0 < [|b1|]*wB). apply Zmult_lt_0_compat;zarith.
+   assert (H6 : 1 <= [|q|]) by zarith.
+   Z.le_elim H6;zarith.
+   rewrite <- H6 in H2;rewrite H2 in H7.
+   assert (0 < [|b1|]*wB). apply Z.mul_pos_pos;zarith.
    Spec_ww_to_Z r2. zarith.
    rewrite (Zmod_small ([|q|] -1));zarith.
    rewrite (Zmod_small ([|q|] -1 -1));zarith.
@@ -450,7 +439,7 @@ Section DoubleDiv32.
        < wwB). split;try omega.
    replace (2*([|b1|]*wB+[|b2|])) with ((2*[|b1|])*wB+2*[|b2|]). 2:ring.
    assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB).
-   rewrite wwB_wBwB; rewrite Zpower_2; zarith. omega.
+   rewrite wwB_wBwB; rewrite Z.pow_2_r; zarith. omega.
    rewrite <- (Zmod_unique
             ([[r2]] + ([|b1|] * wB + [|b2|]))
             wwB
@@ -545,17 +534,13 @@ Section DoubleDiv21.
      0 <= [[r]] < [|b1|] * wB + [|b2|].
   Variable spec_ww_1 : [[ww_1]] = 1.
   Variable spec_ww_compare :  forall x y,
-       match ww_compare x y with
-       | Eq => [[x]] = [[y]]
-       | Lt => [[x]] < [[y]]
-       | Gt => [[x]] > [[y]]
-       end.
+    ww_compare x y = Z.compare [[x]] [[y]].
   Variable spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB.
 
   Theorem wwB_div: wwB  = 2 * (wwB / 2).
   Proof.
-   rewrite wwB_div_2; rewrite  Zmult_assoc; rewrite  wB_div_2; auto.
-   rewrite <- Zpower_2; apply wwB_wBwB.
+   rewrite wwB_div_2; rewrite  Z.mul_assoc; rewrite  wB_div_2; auto.
+   rewrite <- Z.pow_2_r; apply wwB_wBwB.
   Qed.
 
   Ltac Spec_w_to_Z x :=
@@ -576,42 +561,41 @@ Section DoubleDiv21.
    intros a1 a2 b H Hlt; unfold ww_div21.
    Spec_ww_to_Z b; assert (Eq: 0 < [[b]]).    Spec_ww_to_Z a1;omega.
    generalize Hlt H ;clear Hlt H;case a1.
-   intros H1 H2;simpl in H1;Spec_ww_to_Z a2;
-   match goal with |-context [ww_compare ?Y ?Z] =>
-     generalize (spec_ww_compare Y Z); case (ww_compare Y Z)
-   end; simpl;try rewrite spec_ww_1;autorewrite with rm10; intros;zarith.
+   intros H1 H2;simpl in H1;Spec_ww_to_Z a2.
+   rewrite spec_ww_compare. case Z.compare_spec;
+   simpl;try rewrite spec_ww_1;autorewrite with rm10; intros;zarith.
    rewrite spec_ww_sub;simpl. rewrite Zmod_small;zarith.
    split. ring.
    assert (wwB <= 2*[[b]]);zarith.
    rewrite wwB_div;zarith.
    intros a1h a1l.  Spec_w_to_Z a1h;Spec_w_to_Z a1l. Spec_ww_to_Z a2.
    destruct a2 as [ |a3 a4];
-    (destruct b as [ |b1 b2];[unfold Zle in Eq;discriminate Eq|idtac]);
+    (destruct b as [ |b1 b2];[unfold Z.le in Eq;discriminate Eq|idtac]);
    try (Spec_w_to_Z a3; Spec_w_to_Z a4); Spec_w_to_Z b1; Spec_w_to_Z b2;
    intros Hlt H;  match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] =>
      generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U);
      intros q1 r H0
    end; (assert (Eq1: wB / 2 <= [|b1|]);[
     apply (@beta_lex (wB / 2) 0 [|b1|] [|b2|] wB); auto with zarith;
-    autorewrite with rm10;repeat rewrite (Zmult_comm wB);
+    autorewrite with rm10;repeat rewrite (Z.mul_comm wB);
     rewrite <- wwB_div_2; trivial
    | generalize (H0 Eq1 Hlt);clear H0;destruct r as [ |r1 r2];simpl;
-     try rewrite spec_w_0; try rewrite spec_w_0W;repeat rewrite Zplus_0_r;
+     try rewrite spec_w_0; try rewrite spec_w_0W;repeat rewrite Z.add_0_r;
      intros (H1,H2) ]).
-   split;[rewrite wwB_wBwB; rewrite Zpower_2 | trivial].
-   rewrite Zmult_assoc;rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc;
-   rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H1;ring.
+   split;[rewrite wwB_wBwB; rewrite Z.pow_2_r | trivial].
+   rewrite Z.mul_assoc;rewrite Z.mul_add_distr_r;rewrite <- Z.mul_assoc;
+   rewrite <- Z.pow_2_r; rewrite <- wwB_wBwB;rewrite H1;ring.
    destruct H2 as (H2,H3);match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] =>
      generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U);
      intros q r H0;generalize (H0 Eq1 H3);clear H0;intros (H4,H5) end.
    split;[rewrite wwB_wBwB | trivial].
-   rewrite Zpower_2.
-   rewrite Zmult_assoc;rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc;
-   rewrite <- Zpower_2.
+   rewrite Z.pow_2_r.
+   rewrite Z.mul_assoc;rewrite Z.mul_add_distr_r;rewrite <- Z.mul_assoc;
+   rewrite <- Z.pow_2_r.
    rewrite <- wwB_wBwB;rewrite H1.
-   rewrite spec_w_0 in H4;rewrite Zplus_0_r in H4.
-   repeat rewrite Zmult_plus_distr_l. rewrite <- (Zmult_assoc [|r1|]).
-   rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H4;simpl;ring.
+   rewrite spec_w_0 in H4;rewrite Z.add_0_r in H4.
+   repeat rewrite Z.mul_add_distr_r. rewrite <- (Z.mul_assoc [|r1|]).
+   rewrite <- Z.pow_2_r; rewrite <- wwB_wBwB;rewrite H4;simpl;ring.
    split;[rewrite wwB_wBwB | split;zarith].
    replace (([|a1h|] * wB + [|a1l|]) * wB^2 + ([|a3|] * wB + [|a4|]))
    with (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB+ [|a4|]).
@@ -809,12 +793,7 @@ Section DoubleDivGt.
   Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|].
   Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
   Variable spec_compare :
-     forall x y,
-       match w_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
+     forall x y, w_compare x y = Z.compare [|x|] [|y|].
   Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0.
 
   Variable spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|].
@@ -914,42 +893,42 @@ Section DoubleDivGt.
     end in [[WW ah al]]=[[q]]*[[WW bh bl]]+[[r]] /\ 0 <=[[r]]< [[WW bh bl]]).
    assert (Hh := spec_head0 Hpos).
    lazy zeta.
-   generalize (spec_compare (w_head0 bh) w_0); case w_compare;
+   rewrite spec_compare; case Z.compare_spec;
     rewrite spec_w_0; intros HH.
-   generalize Hh; rewrite HH; simpl Zpower;
-        rewrite Zmult_1_l; intros (HH1, HH2); clear HH.
+   generalize Hh; rewrite HH; simpl Z.pow;
+        rewrite Z.mul_1_l; intros (HH1, HH2); clear HH.
    assert (wwB <= 2*[[WW bh bl]]).
-    apply Zle_trans with (2*[|bh|]*wB).
-    rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_le_compat_r; zarith.
-    rewrite <- wB_div_2; apply Zmult_le_compat_l; zarith.
-    simpl ww_to_Z;rewrite Zmult_plus_distr_r;rewrite Zmult_assoc.
+    apply Z.le_trans with (2*[|bh|]*wB).
+    rewrite wwB_wBwB; rewrite Z.pow_2_r; apply Z.mul_le_mono_nonneg_r; zarith.
+    rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; zarith.
+    simpl ww_to_Z;rewrite Z.mul_add_distr_l;rewrite Z.mul_assoc.
     Spec_w_to_Z bl;zarith.
    Spec_ww_to_Z (WW ah al).
    rewrite spec_ww_sub;eauto.
-   simpl;rewrite spec_ww_1;rewrite Zmult_1_l;simpl.
+   simpl;rewrite spec_ww_1;rewrite Z.mul_1_l;simpl.
    simpl ww_to_Z in Hgt, H, HH;rewrite Zmod_small;split;zarith.
    case (spec_to_Z (w_head0 bh)); auto with zarith.
    assert ([|w_head0 bh|] < Zpos w_digits).
     destruct (Z_lt_ge_dec [|w_head0 bh|]  (Zpos w_digits));trivial.
     exfalso.
     assert (2 ^ [|w_head0 bh|] * [|bh|] >= wB);auto with zarith.
-    apply Zle_ge; replace wB with (wB * 1);try ring.
-    Spec_w_to_Z bh;apply Zmult_le_compat;zarith.
+    apply Z.le_ge; replace wB with (wB * 1);try ring.
+    Spec_w_to_Z bh;apply Z.mul_le_mono_nonneg;zarith.
     unfold base;apply Zpower_le_monotone;zarith.
    assert (HHHH : 0 < [|w_head0 bh|] < Zpos w_digits); auto with zarith.
-   assert (Hb:= Zlt_le_weak _ _ H).
+   assert (Hb:= Z.lt_le_incl _ _ H).
    generalize (spec_add_mul_div w_0 ah Hb)
     (spec_add_mul_div ah al Hb)
     (spec_add_mul_div al w_0 Hb)
     (spec_add_mul_div bh bl Hb)
     (spec_add_mul_div bl w_0  Hb);
-   rewrite spec_w_0; repeat rewrite Zmult_0_l;repeat rewrite Zplus_0_l;
-   rewrite Zdiv_0_l;repeat rewrite Zplus_0_r.
+   rewrite spec_w_0; repeat rewrite Z.mul_0_l;repeat rewrite Z.add_0_l;
+   rewrite Zdiv_0_l;repeat rewrite Z.add_0_r.
    Spec_w_to_Z ah;Spec_w_to_Z bh.
    unfold base;repeat rewrite Zmod_shift_r;zarith.
    assert (H3:=to_Z_div_minus_p ah HHHH);assert(H4:=to_Z_div_minus_p al HHHH);
    assert (H5:=to_Z_div_minus_p bl HHHH).
-   rewrite Zmult_comm in Hh.
+   rewrite Z.mul_comm in Hh.
    assert (2^[|w_head0 bh|] < wB). unfold base;apply Zpower_lt_monotone;zarith.
    unfold base in H0;rewrite Zmod_small;zarith.
    fold wB; rewrite (Zmod_small ([|bh|] * 2 ^ [|w_head0 bh|]));zarith.
@@ -964,15 +943,15 @@ Section DoubleDivGt.
               (w_add_mul_div (w_head0 bh) al w_0)
               (w_add_mul_div (w_head0 bh) bh bl)
               (w_add_mul_div (w_head0 bh) bl w_0)) as (q,r).
-   rewrite V1;rewrite V2. rewrite Zmult_plus_distr_l.
-   rewrite <- (Zplus_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)).
+   rewrite V1;rewrite V2. rewrite Z.mul_add_distr_r.
+   rewrite <- (Z.add_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)).
    unfold base;rewrite <- shift_unshift_mod;zarith. fold wB.
    replace ([|bh|] * 2 ^ [|w_head0 bh|] * wB + [|bl|] * 2 ^ [|w_head0 bh|]) with
     ([[WW bh bl]] * 2^[|w_head0 bh|]). 2:simpl;ring.
-   fold wwB. rewrite wwB_wBwB. rewrite Zpower_2. rewrite U1;rewrite U2;rewrite U3.
-   rewrite Zmult_assoc. rewrite Zmult_plus_distr_l.
-   rewrite (Zplus_assoc ([|ah|] / 2^(Zpos(w_digits) - [|w_head0 bh|])*wB * wB)).
-   rewrite <- Zmult_plus_distr_l.  rewrite <- Zplus_assoc.
+   fold wwB. rewrite wwB_wBwB. rewrite Z.pow_2_r. rewrite U1;rewrite U2;rewrite U3.
+   rewrite Z.mul_assoc. rewrite Z.mul_add_distr_r.
+   rewrite (Z.add_assoc ([|ah|] / 2^(Zpos(w_digits) - [|w_head0 bh|])*wB * wB)).
+   rewrite <- Z.mul_add_distr_r.  rewrite <- Z.add_assoc.
    unfold base;repeat rewrite <- shift_unshift_mod;zarith. fold wB.
    replace ([|ah|] * 2 ^ [|w_head0 bh|] * wB + [|al|] * 2 ^ [|w_head0 bh|]) with
     ([[WW ah al]] * 2^[|w_head0 bh|]). 2:simpl;ring.
@@ -983,42 +962,42 @@ Section DoubleDivGt.
    unfold base.
    replace (2^Zpos (w_digits)) with (2^(Zpos (w_digits) - 1)*2).
    rewrite Z_div_mult;zarith.  rewrite <- Zpower_exp;zarith.
-   apply Zlt_le_trans with wB;zarith.
+   apply Z.lt_le_trans with wB;zarith.
    unfold base;apply Zpower_le_monotone;zarith.
    pattern 2 at 2;replace 2 with (2^1);trivial.
    rewrite <- Zpower_exp;zarith. ring_simplify (Zpos (w_digits) - 1 + 1);trivial.
    change [[WW w_0 q]] with ([|w_0|]*wB+[|q|]);rewrite spec_w_0;rewrite
-   Zmult_0_l;rewrite Zplus_0_l.
+   Z.mul_0_l;rewrite Z.add_0_l.
    replace [[ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry
        _ww_zdigits (w_0W (w_head0 bh))) W0 r]] with ([[r]]/2^[|w_head0 bh|]).
-   assert (0 < 2^[|w_head0 bh|]). apply Zpower_gt_0;zarith.
+   assert (0 < 2^[|w_head0 bh|]). apply Z.pow_pos_nonneg;zarith.
    split.
    rewrite <- (Z_div_mult [[WW ah al]] (2^[|w_head0 bh|]));zarith.
-   rewrite H1;rewrite Zmult_assoc;apply Z_div_plus_l;trivial.
+   rewrite H1;rewrite Z.mul_assoc;apply Z_div_plus_l;trivial.
    split;[apply Zdiv_le_lower_bound| apply Zdiv_lt_upper_bound];zarith.
    rewrite spec_ww_add_mul_div.
    rewrite spec_ww_sub; auto with zarith.
    rewrite spec_ww_digits_.
    change (Zpos (xO (w_digits))) with (2*Zpos (w_digits));zarith.
-   simpl ww_to_Z;rewrite Zmult_0_l;rewrite Zplus_0_l.
+   simpl ww_to_Z;rewrite Z.mul_0_l;rewrite Z.add_0_l.
    rewrite spec_w_0W.
    rewrite (fun x y => Zmod_small (x-y)); auto with zarith.
    ring_simplify (2 * Zpos w_digits - (2 * Zpos w_digits - [|w_head0 bh|])).
    rewrite Zmod_small;zarith.
    split;[apply Zdiv_le_lower_bound| apply Zdiv_lt_upper_bound];zarith.
    Spec_ww_to_Z r.
-   apply Zlt_le_trans with wwB;zarith.
-   rewrite <- (Zmult_1_r wwB);apply Zmult_le_compat;zarith.
+   apply Z.lt_le_trans with wwB;zarith.
+   rewrite <- (Z.mul_1_r wwB);apply Z.mul_le_mono_nonneg;zarith.
    split; auto with zarith.
-   apply Zle_lt_trans with (2 * Zpos w_digits); auto with zarith.
-   unfold base, ww_digits; rewrite (Zpos_xO w_digits).
+   apply Z.le_lt_trans with (2 * Zpos w_digits); auto with zarith.
+   unfold base, ww_digits; rewrite (Pos2Z.inj_xO w_digits).
    apply Zpower2_lt_lin; auto with zarith.
    rewrite spec_ww_sub; auto with zarith.
    rewrite spec_ww_digits_; rewrite spec_w_0W.
    rewrite Zmod_small;zarith.
-   rewrite Zpos_xO; split; auto with zarith.
-   apply Zle_lt_trans with (2 * Zpos w_digits); auto with zarith.
-   unfold base, ww_digits; rewrite (Zpos_xO w_digits).
+   rewrite Pos2Z.inj_xO; split; auto with zarith.
+   apply Z.le_lt_trans with (2 * Zpos w_digits); auto with zarith.
+   unfold base, ww_digits; rewrite (Pos2Z.inj_xO w_digits).
    apply Zpower2_lt_lin; auto with zarith.
    Qed.
 
@@ -1058,14 +1037,13 @@ Section DoubleDivGt.
    assert (H2:=spec_div_gt Hgt Hpos);destruct (w_div_gt al bl).
    repeat rewrite spec_w_0W;simpl;rewrite spec_w_0;simpl;trivial.
    clear H.
-   assert (Hcmp := spec_compare w_0 bh); destruct (w_compare w_0 bh).
+   rewrite spec_compare; case Z.compare_spec; intros Hcmp.
    rewrite spec_w_0 in Hcmp. change [[WW bh bl]] with ([|bh|]*wB+[|bl|]).
-   rewrite <- Hcmp;rewrite Zmult_0_l;rewrite Zplus_0_l.
+   rewrite <- Hcmp;rewrite Z.mul_0_l;rewrite Z.add_0_l.
    simpl in Hpos;rewrite <- Hcmp in Hpos;simpl in Hpos.
    assert (H2:= @spec_double_divn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div
     w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0
     spec_add_mul_div spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hpos).
-   unfold double_to_Z,double_wB,double_digits in H2.
    destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21
               w_compare w_sub 1
              (WW ah al) bl).
@@ -1101,7 +1079,7 @@ Section DoubleDivGt.
    rewrite spec_mod_gt;trivial.
    assert (H:=spec_div_gt Hgt Hpos).
    destruct (w_div_gt a b) as (q,r);simpl.
-   rewrite Zmult_comm in H;destruct H.
+   rewrite Z.mul_comm in H;destruct H.
    symmetry;apply Zmod_unique with [|q|];trivial.
   Qed.
 
@@ -1154,7 +1132,7 @@ Section DoubleDivGt.
    rewrite spec_w_0W;rewrite spec_w_mod_gt_eq;trivial.
    destruct (w_div_gt al bl);simpl;rewrite spec_w_0W;trivial.
    clear H.
-   assert (H2 := spec_compare w_0 bh);destruct (w_compare w_0 bh).
+   rewrite spec_compare; case Z.compare_spec; intros H2.
    rewrite (@spec_double_modn1_aux w w_zdigits w_0 w_WW w_head0 w_add_mul_div
             w_div21 w_compare w_sub w_to_Z spec_w_0 spec_compare 1 (WW ah al) bl).
    destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1
@@ -1171,7 +1149,7 @@ Section DoubleDivGt.
    rewrite (spec_ww_mod_gt_eq a b Hgt Hpos).
    destruct (ww_div_gt a b)as(q,r);destruct H.
    apply Zmod_unique with[[q]];simpl;trivial.
-   rewrite Zmult_comm;trivial.
+   rewrite Z.mul_comm;trivial.
   Qed.
 
   Lemma Zis_gcd_mod : forall a b d,
@@ -1227,13 +1205,14 @@ Section DoubleDivGt.
       end
     | Gt => W0 (* absurde *)
     end).
-   assert (Hbh := spec_compare w_0 bh);destruct (w_compare w_0 bh).
-   simpl ww_to_Z in *. rewrite spec_w_0 in Hbh;rewrite <- Hbh;
-   rewrite Zmult_0_l;rewrite Zplus_0_l.
-   assert (Hbl := spec_compare w_0 bl); destruct (w_compare w_0 bl).
-   rewrite spec_w_0 in Hbl;rewrite <- Hbl;apply Zis_gcd_0.
-   simpl;rewrite spec_w_0;rewrite Zmult_0_l;rewrite Zplus_0_l.
-   rewrite spec_w_0 in Hbl.
+   rewrite spec_compare, spec_w_0.
+   case Z.compare_spec; intros Hbh.
+   simpl ww_to_Z in *. rewrite <- Hbh.
+   rewrite Z.mul_0_l;rewrite Z.add_0_l.
+   rewrite spec_compare, spec_w_0.
+   case Z.compare_spec; intros Hbl.
+   rewrite <- Hbl;apply Zis_gcd_0.
+   simpl;rewrite spec_w_0;rewrite Z.mul_0_l;rewrite Z.add_0_l.
    apply Zis_gcd_mod;zarith.
    change ([|ah|] * wB + [|al|]) with (double_to_Z w_digits w_to_Z 1 (WW ah al)).
    rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div
@@ -1241,67 +1220,67 @@ Section DoubleDivGt.
     spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hbl).
    apply spec_gcd_gt.
    rewrite  (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial.
-   apply Zlt_gt;match goal with | |- ?x mod ?y < ?y =>
+   apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y =>
     destruct (Z_mod_lt x y);zarith end.
-   rewrite spec_w_0 in Hbl;Spec_w_to_Z bl;exfalso;omega.
-   rewrite spec_w_0 in Hbh;assert (H:= spec_ww_mod_gt_aux _ _ _ Hgt Hbh).
+   Spec_w_to_Z bl;exfalso;omega.
+   assert (H:= spec_ww_mod_gt_aux _ _ _ Hgt Hbh).
    assert (H2 : 0 < [[WW bh bl]]).
-   simpl;Spec_w_to_Z bl. apply Zlt_le_trans with ([|bh|]*wB);zarith.
-   apply Zmult_lt_0_compat;zarith.
+   simpl;Spec_w_to_Z bl. apply Z.lt_le_trans with ([|bh|]*wB);zarith.
+   apply Z.mul_pos_pos;zarith.
    apply Zis_gcd_mod;trivial. rewrite <- H.
    simpl in *;destruct (ww_mod_gt_aux ah al bh bl) as [ |mh ml].
    simpl;apply Zis_gcd_0;zarith.
-   assert (Hmh := spec_compare w_0 mh);destruct (w_compare w_0 mh).
-   simpl;rewrite spec_w_0 in Hmh; rewrite <- Hmh;simpl.
-   assert (Hml := spec_compare w_0 ml);destruct (w_compare w_0 ml).
-   rewrite <- Hml;rewrite spec_w_0;simpl;apply Zis_gcd_0.
-   simpl;rewrite spec_w_0;simpl.
-   rewrite spec_w_0 in Hml. apply Zis_gcd_mod;zarith.
+   rewrite spec_compare, spec_w_0; case Z.compare_spec; intros Hmh.
+   simpl;rewrite <- Hmh;simpl.
+   rewrite spec_compare, spec_w_0; case Z.compare_spec; intros Hml.
+   rewrite <- Hml;simpl;apply Zis_gcd_0.
+   simpl; rewrite spec_w_0; simpl.
+   apply Zis_gcd_mod;zarith.
    change ([|bh|] * wB + [|bl|]) with (double_to_Z w_digits w_to_Z 1 (WW bh bl)).
    rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div
    w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div
    spec_div21 spec_compare spec_sub 1 (WW bh bl) ml Hml).
    apply spec_gcd_gt.
    rewrite  (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial.
-   apply Zlt_gt;match goal with | |- ?x mod ?y < ?y =>
+   apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y =>
    destruct (Z_mod_lt x y);zarith end.
-   rewrite spec_w_0 in Hml;Spec_w_to_Z ml;exfalso;omega.
-   rewrite spec_w_0 in Hmh. assert ([[WW bh bl]] > [[WW mh ml]]).
-   rewrite H;simpl; apply Zlt_gt;match goal with | |- ?x mod ?y < ?y =>
+   Spec_w_to_Z ml;exfalso;omega.
+   assert ([[WW bh bl]] > [[WW mh ml]]).
+   rewrite H;simpl; apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y =>
    destruct (Z_mod_lt x y);zarith end.
    assert (H1:= spec_ww_mod_gt_aux _ _ _ H0 Hmh).
    assert (H3 : 0 < [[WW mh ml]]).
-   simpl;Spec_w_to_Z ml. apply Zlt_le_trans with ([|mh|]*wB);zarith.
-   apply Zmult_lt_0_compat;zarith.
+   simpl;Spec_w_to_Z ml. apply Z.lt_le_trans with ([|mh|]*wB);zarith.
+   apply Z.mul_pos_pos;zarith.
    apply Zis_gcd_mod;zarith. simpl in *;rewrite <- H1.
    destruct (ww_mod_gt_aux bh bl mh ml) as [ |rh rl]. simpl; apply Zis_gcd_0.
    simpl;apply Hcont. simpl in H1;rewrite H1.
-   apply Zlt_gt;match goal with | |- ?x mod ?y < ?y =>
+   apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y =>
    destruct (Z_mod_lt x y);zarith end.
-   apply Zle_trans with (2^n/2).
+   apply Z.le_trans with (2^n/2).
    apply Zdiv_le_lower_bound;zarith.
-   apply Zle_trans with ([|bh|] * wB + [|bl|]);zarith.
-   assert (H3' := Z_div_mod_eq [[WW bh bl]] [[WW mh ml]] (Zlt_gt _ _ H3)).
-   assert (H4' : 0 <= [[WW bh bl]]/[[WW mh ml]]).
-   apply Zge_le;apply Z_div_ge0;zarith. simpl in *;rewrite H1.
+   apply Z.le_trans with ([|bh|] * wB + [|bl|]);zarith.
+   assert (H3' := Z_div_mod_eq [[WW bh bl]] [[WW mh ml]] (Z.lt_gt _ _ H3)).
+   assert (H4 : 0 <= [[WW bh bl]]/[[WW mh ml]]).
+   apply Z.ge_le;apply Z_div_ge0;zarith. simpl in *;rewrite H1.
    pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3'.
-   destruct (Zle_lt_or_eq _ _ H4').
+   Z.le_elim H4.
    assert (H6' : [[WW bh bl]] mod [[WW mh ml]] =
                   [[WW bh bl]] - [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])).
    simpl;pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3';ring. simpl in H6'.
    assert ([[WW mh ml]] <= [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])).
-   simpl;pattern ([|mh|]*wB+[|ml|]) at 1;rewrite <- Zmult_1_r;zarith.
+   simpl;pattern ([|mh|]*wB+[|ml|]) at 1;rewrite <- Z.mul_1_r;zarith.
    simpl in *;assert (H8 := Z_mod_lt [[WW bh bl]] [[WW mh ml]]);simpl in H8;
     zarith.
    assert (H8 := Z_mod_lt [[WW bh bl]] [[WW mh ml]]);simpl in *;zarith.
-   rewrite <- H4 in H3';rewrite Zmult_0_r in H3';simpl in H3';zarith.
+   rewrite <- H4 in H3';rewrite Z.mul_0_r in H3';simpl in H3';zarith.
    pattern n at 1;replace n with (n-1+1);try ring.
    rewrite Zpower_exp;zarith. change (2^1) with 2.
    rewrite Z_div_mult;zarith.
    assert (2^1 <= 2^n). change (2^1) with 2;zarith.
    assert (H7 := @Zpower_le_monotone_inv 2 1 n);zarith.
-   rewrite spec_w_0 in Hmh;Spec_w_to_Z mh;exfalso;zarith.
-   rewrite spec_w_0 in Hbh;Spec_w_to_Z bh;exfalso;zarith.
+   Spec_w_to_Z mh;exfalso;zarith.
+   Spec_w_to_Z bh;exfalso;zarith.
   Qed.
 
   Lemma spec_ww_gcd_gt_aux :
@@ -1316,27 +1295,27 @@ Section DoubleDivGt.
         [[ww_gcd_gt_aux p cont ah al bh bl]].
   Proof.
    induction p;intros cont n Hcont ah al bh bl Hgt Hs;simpl ww_gcd_gt_aux.
-   assert (0 < Zpos p). unfold Zlt;reflexivity.
+   assert (0 < Zpos p). unfold Z.lt;reflexivity.
    apply spec_ww_gcd_gt_aux_body with (n := Zpos (xI p) + n);
-   trivial;rewrite Zpos_xI.
+   trivial;rewrite Pos2Z.inj_xI.
    intros. apply IHp with (n := Zpos p + n);zarith.
    intros. apply IHp with (n := n );zarith.
-   apply Zle_trans with (2 ^ (2* Zpos p + 1+ n -1));zarith.
-   apply Zpower_le_monotone2;zarith.
-   assert (0 < Zpos p). unfold Zlt;reflexivity.
+   apply Z.le_trans with (2 ^ (2* Zpos p + 1+ n -1));zarith.
+   apply Z.pow_le_mono_r;zarith.
+   assert (0 < Zpos p). unfold Z.lt;reflexivity.
    apply spec_ww_gcd_gt_aux_body with (n := Zpos (xO p) + n );trivial.
-   rewrite (Zpos_xO p).
+   rewrite (Pos2Z.inj_xO p).
    intros. apply IHp with (n := Zpos p + n - 1);zarith.
    intros. apply IHp with (n := n -1 );zarith.
    intros;apply Hcont;zarith.
-   apply Zle_trans with (2^(n-1));zarith.
-   apply Zpower_le_monotone2;zarith.
-   apply Zle_trans with (2 ^ (Zpos p + n -1));zarith.
-   apply Zpower_le_monotone2;zarith.
-   apply Zle_trans with (2 ^ (2*Zpos p + n -1));zarith.
-   apply Zpower_le_monotone2;zarith.
+   apply Z.le_trans with (2^(n-1));zarith.
+   apply Z.pow_le_mono_r;zarith.
+   apply Z.le_trans with (2 ^ (Zpos p + n -1));zarith.
+   apply Z.pow_le_mono_r;zarith.
+   apply Z.le_trans with (2 ^ (2*Zpos p + n -1));zarith.
+   apply Z.pow_le_mono_r;zarith.
    apply spec_ww_gcd_gt_aux_body with (n := n+1);trivial.
-   rewrite Zplus_comm;trivial.
+   rewrite Z.add_comm;trivial.
    ring_simplify (n + 1 - 1);trivial.
   Qed.
 
@@ -1374,11 +1353,7 @@ Section DoubleDiv.
   Variable spec_to_Z  : forall x, 0 <= [|x|] < wB.
   Variable spec_ww_1 : [[ww_1]] = 1.
   Variable spec_ww_compare :  forall x y,
-       match ww_compare x y with
-       | Eq => [[x]] = [[y]]
-       | Lt => [[x]] < [[y]]
-       | Gt => [[x]] > [[y]]
-       end.
+    ww_compare x y = Z.compare [[x]] [[y]].
   Variable spec_ww_div_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] ->
       let (q,r) := ww_div_gt a b in
       [[a]] = [[q]] * [[b]] + [[r]] /\
@@ -1400,20 +1375,20 @@ Section DoubleDiv.
       0 <= [[r]] < [[b]].
   Proof.
    intros a b Hpos;unfold ww_div.
-   assert (H:=spec_ww_compare a b);destruct (ww_compare a b).
+   rewrite spec_ww_compare; case Z.compare_spec; intros.
    simpl;rewrite spec_ww_1;split;zarith.
    simpl;split;[ring|Spec_ww_to_Z a;zarith].
-   apply spec_ww_div_gt;trivial.
+   apply spec_ww_div_gt;auto with zarith.
   Qed.
 
   Lemma  spec_ww_mod :  forall a b, 0 < [[b]] ->
       [[ww_mod a b]] = [[a]] mod [[b]].
   Proof.
    intros a b Hpos;unfold ww_mod.
-   assert (H := spec_ww_compare a b);destruct (ww_compare a b).
+   rewrite spec_ww_compare; case Z.compare_spec; intros.
    simpl;apply Zmod_unique with 1;try rewrite H;zarith.
    Spec_ww_to_Z a;symmetry;apply Zmod_small;zarith.
-   apply spec_ww_mod_gt;trivial.
+   apply spec_ww_mod_gt;auto with zarith.
   Qed.
 
 
@@ -1431,12 +1406,7 @@ Section DoubleDiv.
   Variable spec_w_0   : [|w_0|] = 0.
   Variable spec_w_1   : [|w_1|] = 1.
   Variable spec_compare :
-     forall x y,
-       match w_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
+    forall x y, w_compare x y = Z.compare [|x|] [|y|].
   Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0.
   Variable spec_gcd_gt : forall a b, [|a|] > [|b|] ->
       Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|].
@@ -1468,14 +1438,14 @@ Section DoubleDiv.
     assert (0 <= 1 < wB). split;zarith. apply wB_pos.
     assert (H1:= beta_lex _ _ _ _ _ Hle (spec_to_Z yl) H).
     Spec_w_to_Z yh;zarith.
-   unfold gcd_cont;assert (Hcmpy:=spec_compare w_1 yl);
-   rewrite spec_w_1 in Hcmpy.
-   simpl;rewrite H;simpl;destruct (w_compare w_1 yl).
+   unfold gcd_cont; rewrite spec_compare, spec_w_1.
+   case Z.compare_spec; intros Hcmpy.
+   simpl;rewrite H;simpl;
    rewrite spec_ww_1;rewrite <- Hcmpy;apply Zis_gcd_mod;zarith.
    rewrite <- (Zmod_unique ([|xh|]*wB+[|xl|]) 1 ([|xh|]*wB+[|xl|]) 0);zarith.
    rewrite H in Hle; exfalso;zarith.
-   assert ([|yl|] = 0). Spec_w_to_Z yl;zarith.
-   rewrite H0;simpl;apply Zis_gcd_0;trivial.
+   assert (H0 : [|yl|] = 0) by (Spec_w_to_Z yl;zarith).
+   simpl. rewrite H0, H;simpl;apply Zis_gcd_0;trivial.
   Qed.
 
 
@@ -1515,7 +1485,7 @@ Section DoubleDiv.
    Spec_w_to_Z bh;assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt.
    rewrite H1;simpl;auto. clear H.
    apply spec_gcd_gt_fix with (n:= 0);trivial.
-   rewrite Zplus_0_r;rewrite spec_ww_digits_.
+   rewrite Z.add_0_r;rewrite spec_ww_digits_.
    change (2 ^ Zpos (xO w_digits)) with wwB. Spec_ww_to_Z (WW bh bl);zarith.
   Qed.
 
@@ -1528,7 +1498,7 @@ Section DoubleDiv.
      | Eq => a
      | Lt => ww_gcd_gt b a
      end).
-   assert (Hcmp := spec_ww_compare a b);destruct (ww_compare a b).
+   rewrite spec_ww_compare; case Z.compare_spec; intros Hcmp.
    Spec_ww_to_Z b;rewrite Hcmp.
    apply Zis_gcd_for_euclid with 1;zarith.
    ring_simplify ([[b]] - 1 * [[b]]). apply Zis_gcd_0;zarith.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v
index 4bdb75d6..5cb7405a 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,17 +8,17 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: DoubleDivn1.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
-Require Import ZArith.
+Require Import ZArith Ndigits.
 Require Import BigNumPrelude.
 Require Import DoubleType.
 Require Import DoubleBase.
 
 Local Open Scope Z_scope.
 
+Local Infix "<<" := Pos.shiftl_nat (at level 30).
+
 Section GENDIVN1.
 
  Variable w             : Type.
@@ -62,12 +62,7 @@ Section GENDIVN1.
      [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\
      0 <= [|r|] < [|b|].
  Variable spec_compare :
-     forall x y,
-       match w_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
+   forall x y, w_compare x y = Z.compare [|x|] [|y|].
  Variable spec_sub: forall x y,
    [|w_sub x y|] = ([|x|] - [|y|]) mod wB.
 
@@ -112,8 +107,8 @@ Section GENDIVN1.
    destruct H4;split;trivial.
    rewrite spec_double_WW;trivial.
    rewrite <- double_wB_wwB.
-   rewrite Zmult_assoc;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
-   rewrite H0;rewrite Zmult_plus_distr_l;rewrite <- Zplus_assoc.
+   rewrite Z.mul_assoc;rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
+   rewrite H0;rewrite Z.mul_add_distr_r;rewrite <- Z.add_assoc.
    rewrite H4;ring.
   Qed.
 
@@ -162,14 +157,10 @@ Section GENDIVN1.
    | S n => double_divn1_p_aux n (double_divn1_p n)
    end.
 
-  Lemma p_lt_double_digits : forall n, [|p|] <= Zpos (double_digits w_digits n).
+  Lemma p_lt_double_digits : forall n, [|p|] <= Zpos (w_digits << n).
   Proof.
-(*
-   induction n;simpl. destruct p_bounded;trivial.
-   case (spec_to_Z p); rewrite Zpos_xO;auto with zarith.
-*)
    induction n;simpl. trivial.
-   case (spec_to_Z p); rewrite Zpos_xO;auto with zarith.
+   case (spec_to_Z p); rewrite Pshiftl_nat_S, Pos2Z.inj_xO;auto with zarith.
   Qed.
 
   Lemma spec_double_divn1_p : forall n r h l,
@@ -177,14 +168,14 @@ Section GENDIVN1.
     let (q,r') := double_divn1_p n r h l in
     [|r|] * double_wB w_digits n +
       ([!n|h!]*2^[|p|] +
-        [!n|l!] / (2^(Zpos(double_digits w_digits n) - [|p|])))
+        [!n|l!] / (2^(Zpos(w_digits << n) - [|p|])))
         mod double_wB w_digits n = [!n|q!] * [|b2p|] + [|r'|] /\
     0 <= [|r'|] < [|b2p|].
   Proof.
    case (spec_to_Z p); intros HH0 HH1.
    induction n;intros.
    simpl (double_divn1_p 0 r h l).
-   unfold double_to_Z, double_wB, double_digits.
+   unfold double_to_Z, double_wB, "<<".
    rewrite <- spec_add_mul_divp.
    exact (spec_div21 (w_add_mul_div p h l) b2p_le H).
    simpl (double_divn1_p (S n) r h l).
@@ -196,24 +187,24 @@ Section GENDIVN1.
    replace ([|r|] * (double_wB w_digits n * double_wB w_digits n) +
     (([!n|hh!] * double_wB w_digits n + [!n|hl!]) * 2 ^ [|p|] +
     ([!n|lh!] * double_wB w_digits n + [!n|ll!]) /
-     2^(Zpos (double_digits w_digits (S n)) - [|p|])) mod
+     2^(Zpos (w_digits << (S n)) - [|p|])) mod
       (double_wB w_digits n * double_wB w_digits n)) with
     (([|r|] * double_wB w_digits n + ([!n|hh!] * 2^[|p|] +
-      [!n|hl!] / 2^(Zpos (double_digits w_digits n) - [|p|])) mod
+      [!n|hl!] / 2^(Zpos (w_digits << n) - [|p|])) mod
                       double_wB w_digits n) * double_wB w_digits n +
      ([!n|hl!] * 2^[|p|] +
-      [!n|lh!] / 2^(Zpos (double_digits w_digits n) - [|p|])) mod
+      [!n|lh!] / 2^(Zpos (w_digits << n) - [|p|])) mod
               double_wB w_digits n).
    generalize (IHn r hh hl H);destruct (double_divn1_p n r hh hl) as (qh,rh);
    intros (H3,H4);rewrite H3.
    assert ([|rh|] < [|b2p|]). omega.
    replace (([!n|qh!] * [|b2p|] + [|rh|]) * double_wB w_digits n +
      ([!n|hl!] * 2 ^ [|p|] +
-      [!n|lh!] / 2 ^ (Zpos (double_digits w_digits n) - [|p|])) mod
+      [!n|lh!] / 2 ^ (Zpos (w_digits << n) - [|p|])) mod
       double_wB w_digits n)  with
     ([!n|qh!] * [|b2p|] *double_wB w_digits n + ([|rh|]*double_wB w_digits n +
       ([!n|hl!] * 2 ^ [|p|] +
-       [!n|lh!] / 2 ^ (Zpos (double_digits w_digits n) - [|p|])) mod
+       [!n|lh!] / 2 ^ (Zpos (w_digits << n) - [|p|])) mod
       double_wB w_digits n)). 2:ring.
    generalize (IHn rh hl lh H0);destruct (double_divn1_p n rh hl lh) as (ql,rl);
    intros (H5,H6);rewrite H5.
@@ -229,52 +220,52 @@ Section GENDIVN1.
    unfold double_wB,base.
    assert (UU:=p_lt_double_digits n).
    rewrite Zdiv_shift_r;auto with zarith.
-   2:change (Zpos (double_digits w_digits (S n)))
-     with (2*Zpos (double_digits w_digits n));auto with zarith.
-   replace (2 ^ (Zpos (double_digits w_digits (S n)) - [|p|])) with
-    (2^(Zpos (double_digits w_digits n) - [|p|])*2^Zpos (double_digits w_digits n)).
+   2:change (Zpos (w_digits << (S n)))
+     with (2*Zpos (w_digits << n));auto with zarith.
+   replace (2 ^ (Zpos (w_digits << (S n)) - [|p|])) with
+    (2^(Zpos (w_digits << n) - [|p|])*2^Zpos (w_digits << n)).
    rewrite Zdiv_mult_cancel_r;auto with zarith.
-   rewrite Zmult_plus_distr_l with (p:=  2^[|p|]).
+   rewrite Z.mul_add_distr_r with (p:=  2^[|p|]).
    pattern  ([!n|hl!] * 2^[|p|]) at 2;
-   rewrite (shift_unshift_mod (Zpos(double_digits w_digits n))([|p|])([!n|hl!]));
+   rewrite (shift_unshift_mod (Zpos(w_digits << n))([|p|])([!n|hl!]));
     auto with zarith.
-   rewrite Zplus_assoc.
+   rewrite Z.add_assoc.
    replace
-    ([!n|hh!] * 2^Zpos (double_digits w_digits n)* 2^[|p|] +
-      ([!n|hl!] / 2^(Zpos (double_digits w_digits n)-[|p|])*
-       2^Zpos(double_digits w_digits n)))
+    ([!n|hh!] * 2^Zpos (w_digits << n)* 2^[|p|] +
+      ([!n|hl!] / 2^(Zpos (w_digits << n)-[|p|])*
+       2^Zpos(w_digits << n)))
    with
     (([!n|hh!] *2^[|p|] + double_to_Z w_digits w_to_Z n hl /
-       2^(Zpos (double_digits w_digits n)-[|p|]))
-      * 2^Zpos(double_digits w_digits n));try (ring;fail).
-   rewrite <- Zplus_assoc.
+       2^(Zpos (w_digits << n)-[|p|]))
+      * 2^Zpos(w_digits << n));try (ring;fail).
+   rewrite <- Z.add_assoc.
    rewrite <- (Zmod_shift_r ([|p|]));auto with zarith.
    replace
-     (2 ^ Zpos (double_digits w_digits n) * 2 ^ Zpos (double_digits w_digits n)) with
-     (2 ^ (Zpos (double_digits w_digits n) + Zpos (double_digits w_digits n))).
-   rewrite (Zmod_shift_r (Zpos (double_digits w_digits n)));auto with zarith.
-   replace (2 ^ (Zpos (double_digits w_digits n) + Zpos (double_digits w_digits n)))
-   with (2^Zpos(double_digits w_digits n) *2^Zpos(double_digits w_digits n)).
-   rewrite (Zmult_comm (([!n|hh!] * 2 ^ [|p|] +
-      [!n|hl!] / 2 ^ (Zpos (double_digits w_digits n) - [|p|])))).
+     (2 ^ Zpos (w_digits << n) * 2 ^ Zpos (w_digits << n)) with
+     (2 ^ (Zpos (w_digits << n) + Zpos (w_digits << n))).
+   rewrite (Zmod_shift_r (Zpos (w_digits << n)));auto with zarith.
+   replace (2 ^ (Zpos (w_digits << n) + Zpos (w_digits << n)))
+   with (2^Zpos(w_digits << n) *2^Zpos(w_digits << n)).
+   rewrite (Z.mul_comm (([!n|hh!] * 2 ^ [|p|] +
+      [!n|hl!] / 2 ^ (Zpos (w_digits << n) - [|p|])))).
    rewrite  Zmult_mod_distr_l;auto with zarith.
    ring.
    rewrite Zpower_exp;auto with zarith.
-   assert (0 < Zpos (double_digits w_digits n)). unfold Zlt;reflexivity.
+   assert (0 < Zpos (w_digits << n)). unfold Z.lt;reflexivity.
    auto with zarith.
    apply Z_mod_lt;auto with zarith.
    rewrite Zpower_exp;auto with zarith.
    split;auto with zarith.
    apply Zdiv_lt_upper_bound;auto with zarith.
    rewrite <- Zpower_exp;auto with zarith.
-   replace ([|p|] + (Zpos (double_digits w_digits n) - [|p|])) with
-     (Zpos(double_digits w_digits n));auto with zarith.
+   replace ([|p|] + (Zpos (w_digits << n) - [|p|])) with
+     (Zpos(w_digits << n));auto with zarith.
    rewrite <- Zpower_exp;auto with zarith.
-   replace (Zpos (double_digits w_digits (S n)) - [|p|]) with
-       (Zpos (double_digits w_digits n) - [|p|] +
-         Zpos (double_digits w_digits n));trivial.
-   change (Zpos (double_digits w_digits (S n))) with
-    (2*Zpos (double_digits w_digits n)). ring.
+   replace (Zpos (w_digits << (S n)) - [|p|]) with
+       (Zpos (w_digits << n) - [|p|] +
+         Zpos (w_digits << n));trivial.
+   change (Zpos (w_digits << (S n))) with
+    (2*Zpos (w_digits << n)). ring.
   Qed.
 
   Definition double_modn1_p_aux n (modn1 : w -> word w n -> word w n -> w) r h l:=
@@ -311,24 +302,25 @@ Section GENDIVN1.
      end
   end.
 
- Lemma spec_double_digits:forall n, Zpos w_digits <= Zpos (double_digits w_digits n).
+ Lemma spec_double_digits:forall n, Zpos w_digits <= Zpos (w_digits << n).
  Proof.
   induction n;simpl;auto with zarith.
-  change (Zpos (xO (double_digits w_digits n))) with
-    (2*Zpos (double_digits w_digits n)).
-  assert (0 < Zpos w_digits);auto with zarith.
-  exact (refl_equal Lt).
+  rewrite Pshiftl_nat_S.
+  change (Zpos (xO (w_digits << n))) with
+    (2*Zpos (w_digits << n)).
+  assert (0 < Zpos w_digits) by reflexivity.
+  auto with zarith.
  Qed.
 
  Lemma spec_high : forall n (x:word w n),
-   [|high n x|] = [!n|x!] / 2^(Zpos (double_digits w_digits n) - Zpos w_digits).
+   [|high n x|] = [!n|x!] / 2^(Zpos (w_digits << n) - Zpos w_digits).
  Proof.
   induction n;intros.
-  unfold high,double_digits,double_to_Z.
+  unfold high,double_to_Z. rewrite Pshiftl_nat_0.
   replace (Zpos w_digits - Zpos w_digits) with 0;try ring.
   simpl. rewrite <- (Zdiv_unique [|x|] 1 [|x|] 0);auto with zarith.
   assert (U2 := spec_double_digits n).
-  assert (U3 : 0 < Zpos w_digits). exact (refl_equal Lt).
+  assert (U3 : 0 < Zpos w_digits). exact (eq_refl Lt).
   destruct x;unfold high;fold high.
   unfold double_to_Z,zn2z_to_Z;rewrite spec_0.
   rewrite Zdiv_0_l;trivial.
@@ -336,18 +328,18 @@ Section GENDIVN1.
    assert (U1 := spec_double_to_Z w_digits w_to_Z spec_to_Z n w1).
   simpl [!S n|WW w0 w1!].
   unfold double_wB,base;rewrite Zdiv_shift_r;auto with zarith.
-  replace (2 ^ (Zpos (double_digits w_digits (S n)) - Zpos w_digits)) with
-   (2^(Zpos (double_digits w_digits n) - Zpos w_digits) *
-        2^Zpos (double_digits w_digits n)).
+  replace (2 ^ (Zpos (w_digits << (S n)) - Zpos w_digits)) with
+   (2^(Zpos (w_digits << n) - Zpos w_digits) *
+        2^Zpos (w_digits << n)).
   rewrite Zdiv_mult_cancel_r;auto with zarith.
   rewrite <- Zpower_exp;auto with zarith.
-  replace (Zpos (double_digits w_digits n) - Zpos w_digits +
-    Zpos (double_digits w_digits n)) with
-   (Zpos (double_digits w_digits (S n)) - Zpos w_digits);trivial.
-  change (Zpos (double_digits w_digits (S n))) with
-     (2*Zpos (double_digits w_digits n));ring.
-  change (Zpos (double_digits w_digits (S n))) with
-  (2*Zpos (double_digits w_digits n)); auto with zarith.
+  replace (Zpos (w_digits << n) - Zpos w_digits +
+    Zpos (w_digits << n)) with
+   (Zpos (w_digits << (S n)) - Zpos w_digits);trivial.
+  change (Zpos (w_digits << (S n))) with
+     (2*Zpos (w_digits << n));ring.
+  change (Zpos (w_digits << (S n))) with
+  (2*Zpos (w_digits << n)); auto with zarith.
  Qed.
 
  Definition double_divn1 (n:nat) (a:word w n) (b:w) :=
@@ -373,30 +365,30 @@ Section GENDIVN1.
    intros n a b H. unfold double_divn1.
    case (spec_head0 H); intros H0 H1.
    case (spec_to_Z (w_head0 b)); intros HH1 HH2.
-   generalize (spec_compare (w_head0 b) w_0); case w_compare;
+   rewrite spec_compare; case Z.compare_spec;
      rewrite spec_0; intros H2; auto with zarith.
    assert (Hv1: wB/2 <= [|b|]).
-     generalize H0; rewrite H2; rewrite Zpower_0_r;
-       rewrite Zmult_1_l; auto.
+     generalize H0; rewrite H2; rewrite Z.pow_0_r;
+       rewrite Z.mul_1_l; auto.
    assert (Hv2: [|w_0|] < [|b|]).
      rewrite spec_0; auto.
    generalize (spec_double_divn1_0 Hv1 n a Hv2).
-   rewrite spec_0;rewrite Zmult_0_l; rewrite Zplus_0_l; auto.
+   rewrite spec_0;rewrite Z.mul_0_l; rewrite Z.add_0_l; auto.
    contradict H2; auto with zarith.
    assert (HHHH : 0 < [|w_head0 b|]); auto with zarith.
    assert ([|w_head0 b|] < Zpos w_digits).
-    case (Zle_or_lt (Zpos w_digits) [|w_head0 b|]); auto; intros HH.
+    case (Z.le_gt_cases (Zpos w_digits) [|w_head0 b|]); auto; intros HH.
     assert (2 ^ [|w_head0 b|] < wB).
-     apply Zle_lt_trans with (2 ^ [|w_head0 b|] * [|b|]);auto with zarith.
+     apply Z.le_lt_trans with (2 ^ [|w_head0 b|] * [|b|]);auto with zarith.
      replace (2 ^ [|w_head0 b|]) with (2^[|w_head0 b|] * 1);try (ring;fail).
-     apply Zmult_le_compat;auto with zarith.
+     apply Z.mul_le_mono_nonneg;auto with zarith.
      assert (wB <= 2^[|w_head0 b|]).
      unfold base;apply Zpower_le_monotone;auto with zarith. omega.
    assert ([|w_add_mul_div (w_head0 b) b w_0|] =
                2 ^ [|w_head0 b|] * [|b|]).
     rewrite (spec_add_mul_div b w_0); auto with zarith.
     rewrite spec_0;rewrite Zdiv_0_l; try omega.
-    rewrite Zplus_0_r; rewrite Zmult_comm.
+    rewrite Z.add_0_r; rewrite Z.mul_comm.
     rewrite Zmod_small; auto with zarith.
    assert (H5 := spec_to_Z (high n a)).
    assert
@@ -404,21 +396,21 @@ Section GENDIVN1.
           <[|w_add_mul_div (w_head0 b) b w_0|]).
     rewrite H4.
     rewrite spec_add_mul_div;auto with zarith.
-    rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l.
+    rewrite spec_0;rewrite Z.mul_0_l;rewrite Z.add_0_l.
     assert (([|high n a|]/2^(Zpos w_digits - [|w_head0 b|])) < wB).
      apply Zdiv_lt_upper_bound;auto with zarith.
-     apply Zlt_le_trans with wB;auto with zarith.
+     apply Z.lt_le_trans with wB;auto with zarith.
      pattern wB at 1;replace wB with (wB*1);try ring.
-     apply Zmult_le_compat;auto with zarith.
-     assert (H6 := Zpower_gt_0 2 (Zpos w_digits - [|w_head0 b|]));
+     apply Z.mul_le_mono_nonneg;auto with zarith.
+     assert (H6 := Z.pow_pos_nonneg 2 (Zpos w_digits - [|w_head0 b|]));
        auto with zarith.
     rewrite Zmod_small;auto with zarith.
     apply Zdiv_lt_upper_bound;auto with zarith.
-    apply Zlt_le_trans with wB;auto with zarith.
-    apply Zle_trans with (2 ^ [|w_head0 b|] * [|b|] * 2).
+    apply Z.lt_le_trans with wB;auto with zarith.
+    apply Z.le_trans with (2 ^ [|w_head0 b|] * [|b|] * 2).
     rewrite <- wB_div_2; try omega.
-    apply Zmult_le_compat;auto with zarith.
-    pattern 2 at 1;rewrite <- Zpower_1_r.
+    apply Z.mul_le_mono_nonneg;auto with zarith.
+    pattern 2 at 1;rewrite <- Z.pow_1_r.
     apply Zpower_le_monotone;split;auto with zarith.
    rewrite <- H4 in H0.
    assert (Hb3: [|w_head0 b|] <= Zpos w_digits); auto with zarith.
@@ -428,40 +420,40 @@ Section GENDIVN1.
              (double_0 w_0 n)) as (q,r).
    assert (U:= spec_double_digits n).
    rewrite spec_double_0 in H7;trivial;rewrite Zdiv_0_l in H7.
-   rewrite Zplus_0_r in H7.
+   rewrite Z.add_0_r in H7.
    rewrite spec_add_mul_div in H7;auto with zarith.
-   rewrite spec_0 in H7;rewrite Zmult_0_l in H7;rewrite Zplus_0_l in H7.
+   rewrite spec_0 in H7;rewrite Z.mul_0_l in H7;rewrite Z.add_0_l in H7.
    assert (([|high n a|] / 2 ^ (Zpos w_digits - [|w_head0 b|])) mod wB
-     = [!n|a!] / 2^(Zpos (double_digits w_digits n) - [|w_head0 b|])).
+     = [!n|a!] / 2^(Zpos (w_digits << n) - [|w_head0 b|])).
    rewrite Zmod_small;auto with zarith.
    rewrite spec_high. rewrite Zdiv_Zdiv;auto with zarith.
    rewrite <- Zpower_exp;auto with zarith.
-   replace (Zpos (double_digits w_digits n) - Zpos w_digits +
+   replace (Zpos (w_digits << n) - Zpos w_digits +
                        (Zpos w_digits - [|w_head0 b|]))
-    with (Zpos (double_digits w_digits n) - [|w_head0 b|]);trivial;ring.
-   assert (H8 := Zpower_gt_0 2  (Zpos w_digits - [|w_head0 b|]));auto with zarith.
+    with (Zpos (w_digits << n) - [|w_head0 b|]);trivial;ring.
+   assert (H8 := Z.pow_pos_nonneg 2  (Zpos w_digits - [|w_head0 b|]));auto with zarith.
    split;auto with zarith.
-   apply Zle_lt_trans with ([|high n a|]);auto with zarith.
+   apply Z.le_lt_trans with ([|high n a|]);auto with zarith.
    apply Zdiv_le_upper_bound;auto with zarith.
-   pattern ([|high n a|]) at 1;rewrite <- Zmult_1_r.
-   apply Zmult_le_compat;auto with zarith.
+   pattern ([|high n a|]) at 1;rewrite <- Z.mul_1_r.
+   apply Z.mul_le_mono_nonneg;auto with zarith.
    rewrite H8 in H7;unfold double_wB,base in H7.
    rewrite <- shift_unshift_mod in H7;auto with zarith.
    rewrite H4 in H7.
    assert ([|w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r|]
                = [|r|]/2^[|w_head0 b|]).
    rewrite spec_add_mul_div.
-   rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l.
+   rewrite spec_0;rewrite Z.mul_0_l;rewrite Z.add_0_l.
    replace (Zpos w_digits - [|w_sub w_zdigits (w_head0 b)|])
       with ([|w_head0 b|]).
    rewrite Zmod_small;auto with zarith.
    assert (H9 := spec_to_Z r).
    split;auto with zarith.
-   apply Zle_lt_trans with ([|r|]);auto with zarith.
+   apply Z.le_lt_trans with ([|r|]);auto with zarith.
    apply Zdiv_le_upper_bound;auto with zarith.
-   pattern ([|r|]) at 1;rewrite <- Zmult_1_r.
-   apply Zmult_le_compat;auto with zarith.
-   assert (H10 := Zpower_gt_0 2  ([|w_head0 b|]));auto with zarith.
+   pattern ([|r|]) at 1;rewrite <- Z.mul_1_r.
+   apply Z.mul_le_mono_nonneg;auto with zarith.
+   assert (H10 := Z.pow_pos_nonneg 2  ([|w_head0 b|]));auto with zarith.
    rewrite spec_sub.
    rewrite Zmod_small; auto with zarith.
    split; auto with zarith.
@@ -483,7 +475,7 @@ Section GENDIVN1.
     auto with zarith.
    rewrite H9.
    apply Zdiv_lt_upper_bound;auto with zarith.
-   rewrite Zmult_comm;auto with zarith.
+   rewrite Z.mul_comm;auto with zarith.
    exact (spec_double_to_Z w_digits w_to_Z spec_to_Z n a).
  Qed.
 
@@ -506,7 +498,7 @@ Section GENDIVN1.
     double_modn1 n a b = snd (double_divn1 n a b).
  Proof.
   intros n a b;unfold double_divn1,double_modn1.
-  generalize (spec_compare (w_head0 b) w_0); case w_compare;
+  rewrite spec_compare; case Z.compare_spec;
      rewrite spec_0; intros H2; auto with zarith.
   apply spec_double_modn1_0.
   apply spec_double_modn1_0.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v
index 36e3da9b..0a70dbf4 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: DoubleLift.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import ZArith.
@@ -106,17 +104,9 @@ Section DoubleLift.
   Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB.
   Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
   Variable spec_compare : forall x y,
-       match w_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
+   w_compare x y = Z.compare [|x|] [|y|].
   Variable spec_ww_compare : forall x y,
-       match ww_compare x y with
-       | Eq => [[x]] = [[y]]
-       | Lt => [[x]] < [[y]]
-       | Gt => [[x]] > [[y]]
-       end.
+   ww_compare x y = Z.compare [[x]] [[y]].
   Variable spec_ww_digits : ww_Digits = xO w_digits.
   Variable spec_w_head00  : forall x, [|x|] = 0 -> [|w_head0 x|] = Zpos w_digits.
   Variable spec_w_head0  : forall x,  0 < [|x|] ->
@@ -150,20 +140,20 @@ Section DoubleLift.
   case (spec_to_Z xh); intros Hx1 Hx2.
   case (spec_to_Z xl); intros Hy1 Hy2.
   assert (F1: [|xh|] = 0).
-    case (Zle_lt_or_eq _ _ Hy1); auto; intros Hy3.
-    absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
-    apply Zlt_le_trans with (1 := Hy3); auto with zarith.
-    pattern [|xl|] at 1; rewrite <- (Zplus_0_l [|xl|]).
-    apply Zplus_le_compat_r; auto with zarith.
-    case (Zle_lt_or_eq _ _ Hx1); auto; intros Hx3.
-    absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
-    rewrite <- Hy3; rewrite Zplus_0_r; auto with zarith.
-    apply Zmult_lt_0_compat; auto with zarith.
-  generalize (spec_compare w_0 xh); case w_compare.
+  { Z.le_elim Hy1; auto.
+    - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
+      apply Z.lt_le_trans with (1 := Hy1); auto with zarith.
+      pattern [|xl|] at 1; rewrite <- (Z.add_0_l [|xl|]).
+      apply Z.add_le_mono_r; auto with zarith.
+    - Z.le_elim Hx1; auto.
+      absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
+      rewrite <- Hy1; rewrite Z.add_0_r; auto with zarith.
+      apply Z.mul_pos_pos; auto with zarith. }
+  rewrite spec_compare. case Z.compare_spec.
     intros H; simpl.
     rewrite spec_w_add; rewrite spec_w_head00.
     rewrite spec_zdigits; rewrite spec_ww_digits.
-    rewrite Zpos_xO; auto with zarith.
+    rewrite Pos2Z.inj_xO; auto with zarith.
   rewrite F1 in Hx; auto with zarith.
   rewrite spec_w_0; auto with zarith.
   rewrite spec_w_0; auto with zarith.
@@ -173,44 +163,43 @@ Section DoubleLift.
 	 wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB.
   Proof.
    clear spec_ww_zdigits.
-   rewrite wwB_div_2;rewrite Zmult_comm;rewrite wwB_wBwB.
+   rewrite wwB_div_2;rewrite Z.mul_comm;rewrite wwB_wBwB.
    assert (U:= lt_0_wB w_digits); destruct x as [ |xh xl];simpl ww_to_Z;intros H.
-   unfold Zlt in H;discriminate H.
-   assert (H0 := spec_compare w_0 xh);rewrite spec_w_0 in H0.
-   destruct (w_compare w_0 xh).
-   rewrite <- H0. simpl Zplus. rewrite <- H0 in H;simpl in H.
+   unfold Z.lt in H;discriminate H.
+   rewrite spec_compare, spec_w_0. case Z.compare_spec; intros H0.
+   rewrite <- H0 in *. simpl Z.add. simpl in H.
    case (spec_to_Z w_zdigits);
      case (spec_to_Z (w_head0 xl)); intros HH1 HH2 HH3 HH4.
    rewrite spec_w_add.
    rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith.
    case (spec_w_head0 H); intros H1 H2.
-   rewrite Zpower_2; fold wB; rewrite <- Zmult_assoc; split.
-     apply Zmult_le_compat_l; auto with zarith.
-   apply Zmult_lt_compat_l; auto with zarith.
+   rewrite Z.pow_2_r; fold wB; rewrite <- Z.mul_assoc; split.
+     apply Z.mul_le_mono_nonneg_l; auto with zarith.
+   apply Z.mul_lt_mono_pos_l; auto with zarith.
    assert (H1 := spec_w_head0 H0).
    rewrite spec_w_0W.
    split.
-   rewrite Zmult_plus_distr_r;rewrite Zmult_assoc.
-   apply Zle_trans with (2 ^ [|w_head0 xh|] * [|xh|] * wB).
-   rewrite Zmult_comm; zarith.
+   rewrite Z.mul_add_distr_l;rewrite Z.mul_assoc.
+   apply Z.le_trans with (2 ^ [|w_head0 xh|] * [|xh|] * wB).
+   rewrite Z.mul_comm; zarith.
    assert (0 <= 2 ^ [|w_head0 xh|] * [|xl|]);zarith.
-   assert (H2:=spec_to_Z xl);apply Zmult_le_0_compat;zarith.
+   assert (H2:=spec_to_Z xl);apply Z.mul_nonneg_nonneg;zarith.
    case (spec_to_Z (w_head0 xh)); intros H2 _.
    generalize ([|w_head0 xh|]) H1 H2;clear H1 H2;
      intros p H1 H2.
    assert (Eq1 : 2^p < wB).
-     rewrite <- (Zmult_1_r (2^p));apply Zle_lt_trans with (2^p*[|xh|]);zarith.
+     rewrite <- (Z.mul_1_r (2^p));apply Z.le_lt_trans with (2^p*[|xh|]);zarith.
    assert (Eq2: p < Zpos w_digits).
-    destruct (Zle_or_lt (Zpos w_digits) p);trivial;contradict  Eq1.
-   apply Zle_not_lt;unfold base;apply Zpower_le_monotone;zarith.
+    destruct (Z.le_gt_cases (Zpos w_digits) p);trivial;contradict  Eq1.
+   apply Z.le_ngt;unfold base;apply Zpower_le_monotone;zarith.
    assert (Zpos w_digits = p + (Zpos w_digits - p)). ring.
-   rewrite Zpower_2.
+   rewrite Z.pow_2_r.
    unfold base at 2;rewrite H3;rewrite Zpower_exp;zarith.
-   rewrite <- Zmult_assoc; apply Zmult_lt_compat_l; zarith.
-   rewrite <- (Zplus_0_r (2^(Zpos w_digits - p)*wB));apply beta_lex_inv;zarith.
-   apply Zmult_lt_reg_r with (2 ^ p); zarith.
+   rewrite <- Z.mul_assoc; apply Z.mul_lt_mono_pos_l; zarith.
+   rewrite <- (Z.add_0_r (2^(Zpos w_digits - p)*wB));apply beta_lex_inv;zarith.
+   apply Z.mul_lt_mono_pos_r with (2 ^ p); zarith.
    rewrite <- Zpower_exp;zarith.
-   rewrite Zmult_comm;ring_simplify (Zpos w_digits - p + p);fold wB;zarith.
+   rewrite Z.mul_comm;ring_simplify (Zpos w_digits - p + p);fold wB;zarith.
    assert (H1 := spec_to_Z xh);zarith.
   Qed.
 
@@ -222,22 +211,22 @@ Section DoubleLift.
   case (spec_to_Z xh); intros Hx1 Hx2.
   case (spec_to_Z xl); intros Hy1 Hy2.
   assert (F1: [|xh|] = 0).
-    case (Zle_lt_or_eq _ _ Hy1); auto; intros Hy3.
-    absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
-    apply Zlt_le_trans with (1 := Hy3); auto with zarith.
-    pattern [|xl|] at 1; rewrite <- (Zplus_0_l [|xl|]).
-    apply Zplus_le_compat_r; auto with zarith.
-    case (Zle_lt_or_eq _ _ Hx1); auto; intros Hx3.
-    absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
-    rewrite <- Hy3; rewrite Zplus_0_r; auto with zarith.
-    apply Zmult_lt_0_compat; auto with zarith.
+  { Z.le_elim Hy1; auto.
+    - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
+      apply Z.lt_le_trans with (1 := Hy1); auto with zarith.
+      pattern [|xl|] at 1; rewrite <- (Z.add_0_l [|xl|]).
+      apply Z.add_le_mono_r; auto with zarith.
+    - Z.le_elim Hx1; auto.
+      absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith.
+      rewrite <- Hy1; rewrite Z.add_0_r; auto with zarith.
+      apply Z.mul_pos_pos; auto with zarith. }
   assert (F2: [|xl|] = 0).
     rewrite F1 in Hx; auto with zarith.
-  generalize (spec_compare w_0 xl); case w_compare.
+  rewrite spec_compare; case Z.compare_spec.
     intros H; simpl.
     rewrite spec_w_add; rewrite spec_w_tail00; auto.
     rewrite spec_zdigits; rewrite spec_ww_digits.
-    rewrite Zpos_xO; auto with zarith.
+    rewrite Pos2Z.inj_xO; auto with zarith.
   rewrite spec_w_0; auto with zarith.
   rewrite spec_w_0; auto with zarith.
   Qed.
@@ -247,52 +236,51 @@ Section DoubleLift.
   Proof.
    clear spec_ww_zdigits.
    destruct x as [ |xh xl];simpl ww_to_Z;intros H.
-   unfold Zlt in H;discriminate H.
-   assert (H0 := spec_compare w_0 xl);rewrite spec_w_0 in H0.
-   destruct (w_compare w_0 xl).
-   rewrite <- H0; rewrite Zplus_0_r.
+   unfold Z.lt in H;discriminate H.
+   rewrite spec_compare, spec_w_0. case Z.compare_spec; intros H0.
+   rewrite <- H0; rewrite Z.add_0_r.
    case (spec_to_Z (w_tail0 xh)); intros HH1 HH2.
-   generalize H; rewrite <- H0; rewrite Zplus_0_r; clear H; intros H.
+   generalize H; rewrite <- H0; rewrite Z.add_0_r; clear H; intros H.
    case (@spec_w_tail0 xh).
-     apply Zmult_lt_reg_r with wB; auto with zarith.
+     apply Z.mul_lt_mono_pos_r with wB; auto with zarith.
      unfold base; auto with zarith.
    intros z (Hz1, Hz2); exists z; split; auto.
-   rewrite spec_w_add; rewrite (fun x => Zplus_comm [|x|]).
+   rewrite spec_w_add; rewrite (fun x => Z.add_comm [|x|]).
    rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith.
-   rewrite Zmult_assoc; rewrite <- Hz2; auto.
+   rewrite Z.mul_assoc; rewrite <- Hz2; auto.
 
    case (spec_to_Z (w_tail0 xh)); intros HH1 HH2.
    case (spec_w_tail0 H0); intros z (Hz1, Hz2).
    assert (Hp: [|w_tail0 xl|] < Zpos w_digits).
-     case (Zle_or_lt (Zpos w_digits) [|w_tail0 xl|]); auto; intros H1.
+     case (Z.le_gt_cases (Zpos w_digits) [|w_tail0 xl|]); auto; intros H1.
      absurd (2 ^  (Zpos w_digits) <= 2 ^ [|w_tail0 xl|]).
-       apply Zlt_not_le.
+       apply Z.lt_nge.
        case (spec_to_Z xl); intros HH3 HH4.
-       apply Zle_lt_trans with (2 := HH4).
-       apply Zle_trans with (1 * 2 ^ [|w_tail0 xl|]); auto with zarith.
+       apply Z.le_lt_trans with (2 := HH4).
+       apply Z.le_trans with (1 * 2 ^ [|w_tail0 xl|]); auto with zarith.
        rewrite Hz2.
-       apply Zmult_le_compat_r; auto with zarith.
+       apply Z.mul_le_mono_nonneg_r; auto with zarith.
      apply Zpower_le_monotone; auto with zarith.
    exists ([|xh|] * (2 ^ ((Zpos w_digits - [|w_tail0 xl|]) - 1)) + z); split.
-     apply Zplus_le_0_compat; auto.
-     apply Zmult_le_0_compat; auto with zarith.
+     apply Z.add_nonneg_nonneg; auto.
+     apply Z.mul_nonneg_nonneg; auto with zarith.
      case (spec_to_Z xh); auto.
    rewrite spec_w_0W.
-   rewrite (Zmult_plus_distr_r 2); rewrite <- Zplus_assoc.
-   rewrite Zmult_plus_distr_l; rewrite <- Hz2.
-   apply f_equal2 with (f := Zplus); auto.
-   rewrite (Zmult_comm 2).
-   repeat rewrite <- Zmult_assoc.
-   apply f_equal2 with (f := Zmult); auto.
+   rewrite (Z.mul_add_distr_l 2); rewrite <- Z.add_assoc.
+   rewrite Z.mul_add_distr_r; rewrite <- Hz2.
+   apply f_equal2 with (f := Z.add); auto.
+   rewrite (Z.mul_comm 2).
+   repeat rewrite <- Z.mul_assoc.
+   apply f_equal2 with (f := Z.mul); auto.
    case (spec_to_Z (w_tail0 xl)); intros HH3 HH4.
-   pattern 2 at 2; rewrite <- Zpower_1_r.
+   pattern 2 at 2; rewrite <- Z.pow_1_r.
    lazy beta; repeat rewrite <- Zpower_exp; auto with zarith.
-   unfold base; apply f_equal with (f := Zpower 2); auto with zarith.
+   unfold base; apply f_equal with (f := Z.pow 2); auto with zarith.
 
    contradict H0; case (spec_to_Z xl); auto with zarith.
   Qed.
 
-  Hint Rewrite Zdiv_0_l Zmult_0_l Zplus_0_l Zmult_0_r Zplus_0_r
+  Hint Rewrite Zdiv_0_l Z.mul_0_l Z.add_0_l Z.mul_0_r Z.add_0_r
     spec_w_W0 spec_w_0W spec_w_WW spec_w_0
     (wB_div w_digits w_to_Z spec_to_Z)
     (wB_div_plus w_digits w_to_Z spec_to_Z) : w_rewrite.
@@ -316,20 +304,20 @@ Section DoubleLift.
    intros xh xl yh yl p zdigits;assert (HwwB := wwB_pos w_digits).
    case (spec_to_w_Z p); intros Hv1 Hv2.
    replace (Zpos (xO w_digits)) with (Zpos w_digits + Zpos w_digits).
-   2 : rewrite Zpos_xO;ring.
+   2 : rewrite Pos2Z.inj_xO;ring.
    replace (Zpos w_digits + Zpos w_digits - [[p]]) with
      (Zpos w_digits + (Zpos w_digits - [[p]])). 2:ring.
    intros Hp; assert (Hxh := spec_to_Z xh);assert (Hxl:=spec_to_Z xl);
    assert (Hx := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl));
    simpl in Hx;assert (Hyh := spec_to_Z yh);assert (Hyl:=spec_to_Z yl);
    assert (Hy:=spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW yh yl));simpl in Hy.
-   generalize (spec_ww_compare p zdigits); case ww_compare; intros H1.
+   rewrite spec_ww_compare; case Z.compare_spec; intros H1.
    rewrite H1; unfold zdigits; rewrite spec_w_0W.
-   rewrite spec_zdigits; rewrite Zminus_diag; rewrite Zplus_0_r.
+   rewrite spec_zdigits; rewrite Z.sub_diag; rewrite Z.add_0_r.
    simpl ww_to_Z; w_rewrite;zarith.
    fold wB.
-   rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc;rewrite <- Zplus_assoc.
-   rewrite <- Zpower_2.
+   rewrite Z.mul_add_distr_r;rewrite <- Z.mul_assoc;rewrite <- Z.add_assoc.
+   rewrite <- Z.pow_2_r.
    rewrite <- wwB_wBwB;apply Zmod_unique with [|xh|].
    exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xl yh)). ring.
    simpl ww_to_Z; w_rewrite;zarith.
@@ -339,7 +327,7 @@ Section DoubleLift.
      case (spec_to_w_Z p); intros HH1 HH2; split; auto.
      generalize H1; unfold zdigits; rewrite spec_w_0W;
       rewrite spec_zdigits; intros tmp.
-     apply Zlt_le_trans with (1 := tmp).
+     apply Z.lt_le_trans with (1 := tmp).
      unfold base.
      apply Zpower2_le_lin; auto with zarith.
    2: generalize H1; unfold zdigits; rewrite spec_w_0W;
@@ -350,22 +338,22 @@ Section DoubleLift.
      rewrite HH0; auto with zarith.
    repeat rewrite spec_w_add_mul_div with (1 := HH).
    rewrite HH0.
-   rewrite Zmult_plus_distr_l.
+   rewrite Z.mul_add_distr_r.
    pattern ([|xl|] * 2 ^ [[p]]) at 2;
    rewrite shift_unshift_mod with (n:= Zpos w_digits);fold wB;zarith.
    replace ([|xh|] * wB * 2^[[p]]) with ([|xh|] * 2^[[p]] * wB). 2:ring.
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. rewrite <- Z.add_assoc.
    unfold base at 5;rewrite <- Zmod_shift_r;zarith.
    unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits));
    fold wB;fold wwB;zarith.
-   rewrite wwB_wBwB;rewrite Zpower_2; rewrite  Zmult_mod_distr_r;zarith.
-   unfold ww_digits;rewrite Zpos_xO;zarith. apply Z_mod_lt;zarith.
+   rewrite wwB_wBwB;rewrite Z.pow_2_r; rewrite  Zmult_mod_distr_r;zarith.
+   unfold ww_digits;rewrite Pos2Z.inj_xO;zarith. apply Z_mod_lt;zarith.
    split;zarith. apply Zdiv_lt_upper_bound;zarith.
    rewrite <- Zpower_exp;zarith.
    ring_simplify ([[p]] + (Zpos w_digits - [[p]]));fold wB;zarith.
    assert (Hv: [[p]] > Zpos w_digits).
      generalize H1; clear H1.
-     unfold zdigits; rewrite spec_w_0W; rewrite spec_zdigits; auto.
+     unfold zdigits; rewrite spec_w_0W; rewrite spec_zdigits; auto with zarith.
    clear H1.
    assert (HH0: [|low (ww_sub p zdigits)|] = [[p]] - Zpos w_digits).
      rewrite spec_low.
@@ -374,10 +362,10 @@ Section DoubleLift.
      rewrite <- Zmod_div_mod; auto with zarith.
      rewrite Zmod_small; auto with zarith.
      split; auto with zarith.
-     apply Zle_lt_trans with (Zpos w_digits); auto with zarith.
+     apply Z.le_lt_trans with (Zpos w_digits); auto with zarith.
      unfold base; apply Zpower2_lt_lin; auto with zarith.
      exists wB; unfold base.
-     unfold ww_digits; rewrite (Zpos_xO w_digits).
+     unfold ww_digits; rewrite (Pos2Z.inj_xO w_digits).
      rewrite <- Zpower_exp; auto with zarith.
      apply f_equal with (f := fun x => 2 ^ x); auto with zarith.
    assert (HH: [|low (ww_sub p zdigits)|] <= Zpos w_digits).
@@ -390,25 +378,25 @@ Section DoubleLift.
    pattern wB at 5;replace wB with
     (2^(([[p]] - Zpos w_digits)
          + (Zpos w_digits - ([[p]] - Zpos w_digits)))).
-   rewrite Zpower_exp;zarith. rewrite Zmult_assoc.
+   rewrite Zpower_exp;zarith. rewrite Z.mul_assoc.
    rewrite Z_div_plus_l;zarith.
    rewrite shift_unshift_mod with (a:= [|yh|]) (p:= [[p]] - Zpos w_digits)
     (n := Zpos w_digits);zarith. fold wB.
    set (u := [[p]] - Zpos w_digits).
    replace [[p]] with (u + Zpos w_digits);zarith.
-   rewrite Zpower_exp;zarith. rewrite Zmult_assoc. fold wB.
-   repeat rewrite Zplus_assoc. rewrite <- Zmult_plus_distr_l.
-   repeat rewrite <- Zplus_assoc.
+   rewrite Zpower_exp;zarith. rewrite Z.mul_assoc. fold wB.
+   repeat rewrite Z.add_assoc. rewrite <- Z.mul_add_distr_r.
+   repeat rewrite <- Z.add_assoc.
    unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits));
    fold wB;fold wwB;zarith.
    unfold base;rewrite Zmod_shift_r with (a:= Zpos w_digits)
    (b:= Zpos w_digits);fold wB;fold wwB;zarith.
-   rewrite wwB_wBwB; rewrite Zpower_2; rewrite  Zmult_mod_distr_r;zarith.
-   rewrite Zmult_plus_distr_l.
+   rewrite wwB_wBwB; rewrite Z.pow_2_r; rewrite  Zmult_mod_distr_r;zarith.
+   rewrite Z.mul_add_distr_r.
    replace ([|xh|] * wB * 2 ^ u) with
      ([|xh|]*2^u*wB). 2:ring.
-   repeat rewrite <- Zplus_assoc.
-   rewrite (Zplus_comm ([|xh|] * 2 ^ u * wB)).
+   repeat rewrite <- Z.add_assoc.
+   rewrite (Z.add_comm ([|xh|] * 2 ^ u * wB)).
    rewrite Z_mod_plus;zarith. rewrite Z_mod_mult;zarith.
    unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith.
    unfold u; split;zarith.
@@ -416,7 +404,7 @@ Section DoubleLift.
    rewrite <- Zpower_exp;zarith.
    fold u.
    ring_simplify (u + (Zpos w_digits - u)); fold
-   wB;zarith. unfold ww_digits;rewrite Zpos_xO;zarith.
+   wB;zarith. unfold ww_digits;rewrite Pos2Z.inj_xO;zarith.
    unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith.
    unfold u; split;zarith.
    unfold u; split;zarith.
@@ -446,15 +434,14 @@ Section DoubleLift.
     clear H1;w_rewrite);simpl ww_add_mul_div.
    replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial].
    intros Heq;rewrite <- Heq;clear Heq; auto.
-   generalize (spec_ww_compare p (w_0W w_zdigits));
-     case ww_compare; intros H1; w_rewrite.
+   rewrite spec_ww_compare. case Z.compare_spec; intros H1; w_rewrite.
    rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith.
    generalize H1; w_rewrite; rewrite spec_zdigits; clear H1; intros H1.
    assert (HH0: [|low p|] = [[p]]).
      rewrite spec_low.
      apply Zmod_small.
      case (spec_to_w_Z p); intros HH1 HH2; split; auto.
-     apply Zlt_le_trans with (1 := H1).
+     apply Z.lt_le_trans with (1 := H1).
      unfold base; apply Zpower2_le_lin; auto with zarith.
    rewrite HH0; auto with zarith.
    replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial].
@@ -462,20 +449,21 @@ Section DoubleLift.
    generalize (spec_ww_compare p (w_0W w_zdigits));
      case ww_compare; intros H1; w_rewrite.
    rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith.
-   rewrite Zpos_xO in H;zarith.
+   rewrite Pos2Z.inj_xO in H;zarith.
    assert (HH: [|low (ww_sub p (w_0W w_zdigits)) |] = [[p]] - Zpos w_digits).
-     generalize H1; clear H1.
+     symmetry in H1; change ([[p]] > [[w_0W w_zdigits]]) in H1.
+     revert H1.
      rewrite spec_low.
      rewrite spec_ww_sub; w_rewrite; intros H1.
      rewrite <- Zmod_div_mod; auto with zarith.
      rewrite Zmod_small; auto with zarith.
      split; auto with zarith.
-     apply Zle_lt_trans with (Zpos w_digits); auto with zarith.
+     apply Z.le_lt_trans with (Zpos w_digits); auto with zarith.
      unfold base; apply Zpower2_lt_lin; auto with zarith.
      unfold base; auto with zarith.
      unfold base; auto with zarith.
      exists wB; unfold base.
-     unfold ww_digits; rewrite (Zpos_xO w_digits).
+     unfold ww_digits; rewrite (Pos2Z.inj_xO w_digits).
      rewrite <- Zpower_exp; auto with zarith.
      apply f_equal with (f := fun x => 2 ^ x); auto with zarith.
   case (spec_to_Z xh); auto with zarith.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v
index 834e85d2..7a92ff0c 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: DoubleMul.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import ZArith.
@@ -248,12 +246,7 @@ Section DoubleMul.
   Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB.
   Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
   Variable spec_w_compare :
-     forall x y,
-       match w_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
+     forall x y, w_compare x y = Z.compare [|x|] [|y|].
   Variable spec_w_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB.
   Variable spec_w_add_c  : forall x y, [+|w_add_c x y|] = [|x|] + [|y|].
   Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB.
@@ -332,7 +325,7 @@ Section DoubleMul.
    destruct cc as [ | cch ccl]; simpl zn2z_to_Z; simpl ww_to_Z.
    rewrite spec_ww_add;rewrite spec_w_W0;rewrite Zmod_small;
     rewrite wwB_wBwB. ring.
-   rewrite <- (Zplus_0_r ([|wc|]*wB));rewrite H;apply mult_add_ineq3;zarith.
+   rewrite <- (Z.add_0_r ([|wc|]*wB));rewrite H;apply mult_add_ineq3;zarith.
    simpl ww_to_Z in H1. assert (U:=spec_to_Z cch).
    assert ([|wc|]*wB + [|cch|] <= 2*wB - 3).
     destruct (Z_le_gt_dec ([|wc|]*wB + [|cch|]) (2*wB - 3));trivial.
@@ -342,21 +335,21 @@ Section DoubleMul.
      assert (H5 := Zmult_lt_b _ _ _ (spec_to_Z xl) (spec_to_Z yh)).
      omega.
    generalize H3;clear H3;rewrite <- H1.
-   rewrite Zplus_assoc; rewrite Zpower_2; rewrite Zmult_assoc;
-     rewrite <- Zmult_plus_distr_l.
+   rewrite Z.add_assoc; rewrite Z.pow_2_r; rewrite Z.mul_assoc;
+     rewrite <- Z.mul_add_distr_r.
     assert (((2 * wB - 4) + 2)*wB <= ([|wc|] * wB + [|cch|])*wB).
-     apply Zmult_le_compat;zarith.
-    rewrite Zmult_plus_distr_l in H3.
+     apply Z.mul_le_mono_nonneg;zarith.
+    rewrite Z.mul_add_distr_r in H3.
     intros. assert (U2 := spec_to_Z ccl);omega.
    generalize (spec_ww_add_c (w_W0 ccl) ll);destruct (ww_add_c (w_W0 ccl) ll)
-   as [l|l];unfold interp_carry;rewrite spec_w_W0;try rewrite Zmult_1_l;
+   as [l|l];unfold interp_carry;rewrite spec_w_W0;try rewrite Z.mul_1_l;
    simpl zn2z_to_Z;
    try rewrite spec_ww_add;try rewrite spec_ww_add_carry;rewrite spec_w_WW;
    rewrite Zmod_small;rewrite wwB_wBwB;intros.
    rewrite H4;ring. rewrite H;apply mult_add_ineq2;zarith.
-   rewrite Zplus_assoc;rewrite Zmult_plus_distr_l.
-   rewrite Zmult_1_l;rewrite <- Zplus_assoc;rewrite H4;ring.
-   repeat rewrite <- Zplus_assoc;rewrite H;apply mult_add_ineq2;zarith.
+   rewrite Z.add_assoc;rewrite Z.mul_add_distr_r.
+   rewrite Z.mul_1_l;rewrite <- Z.add_assoc;rewrite H4;ring.
+   repeat rewrite <- Z.add_assoc;rewrite H;apply mult_add_ineq2;zarith.
   Qed.
 
   Lemma spec_double_mul_c : forall cross:w->w->w->w->zn2z w -> zn2z w -> w*zn2z w,
@@ -368,7 +361,7 @@ Section DoubleMul.
      forall x y, [||double_mul_c cross x y||] = [[x]] * [[y]].
   Proof.
    intros cross Hcross x y;destruct x as [ |xh xl];simpl;trivial.
-   destruct y as [ |yh yl];simpl. rewrite Zmult_0_r;trivial.
+   destruct y as [ |yh yl];simpl. rewrite Z.mul_0_r;trivial.
    assert (H1:= spec_w_mul_c xh yh);assert (H2:= spec_w_mul_c xl yl).
    generalize (Hcross _ _ _ _ _ _ H1 H2).
    destruct (cross xh xl yh yl (w_mul_c xh yh) (w_mul_c xl yl)) as (wc,cc).
@@ -389,7 +382,7 @@ Section DoubleMul.
   Lemma spec_w_2: [|w_2|] = 2.
   unfold w_2; rewrite spec_w_add; rewrite spec_w_1; simpl.
   apply Zmod_small; split; auto with zarith.
-  rewrite <- (Zpower_1_r 2); unfold base; apply Zpower_lt_monotone; auto with zarith.
+  rewrite <- (Z.pow_1_r 2); unfold base; apply Zpower_lt_monotone; auto with zarith.
   Qed.
 
   Lemma kara_prod_aux : forall xh xl yh yl,
@@ -408,19 +401,19 @@ Section DoubleMul.
      assert (Hyh := (spec_to_Z yh)); assert (Hyl := (spec_to_Z yl)).
    generalize (spec_ww_add_c hh ll); case (ww_add_c hh ll);
      intros z Hz; rewrite <- Hz; unfold interp_carry; assert (Hz1 := (spec_ww_to_Z z)).
-   generalize (spec_w_compare xl xh); case (w_compare xl xh); intros Hxlh;
+   rewrite spec_w_compare; case Z.compare_spec; intros Hxlh;
     try rewrite Hxlh; try rewrite spec_w_0; try (ring; fail).
-   generalize (spec_w_compare yl yh); case (w_compare yl yh); intros Hylh.
+   rewrite spec_w_compare; case Z.compare_spec; intros Hylh.
    rewrite Hylh; rewrite spec_w_0; try (ring; fail).
    rewrite spec_w_0; try (ring; fail).
    repeat (rewrite spec_ww_sub || rewrite spec_w_sub || rewrite spec_w_mul_c).
    repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
    split; auto with zarith.
    simpl in Hz; rewrite Hz; rewrite H; rewrite H0.
-   rewrite kara_prod_aux; apply Zplus_le_0_compat; apply Zmult_le_0_compat; auto with zarith.
-   apply Zle_lt_trans with ([[z]]-0); auto with zarith.
-   unfold Zminus; apply Zplus_le_compat_l; apply Zle_left_rev; simpl; rewrite Zopp_involutive.
-   apply Zmult_le_0_compat; auto with zarith.
+   rewrite kara_prod_aux; apply Z.add_nonneg_nonneg; apply Z.mul_nonneg_nonneg; auto with zarith.
+   apply Z.le_lt_trans with ([[z]]-0); auto with zarith.
+   unfold Z.sub; apply Z.add_le_mono_l; apply Z.le_0_sub; simpl; rewrite Z.opp_involutive.
+   apply Z.mul_nonneg_nonneg; auto with zarith.
    match goal with |- context[ww_add_c ?x ?y] =>
      generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_0;
      intros z1 Hz2
@@ -430,7 +423,7 @@ Section DoubleMul.
    rewrite spec_w_1; unfold interp_carry in Hz2; rewrite Hz2;
      repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
    repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   generalize (spec_w_compare yl yh); case (w_compare yl yh); intros Hylh.
+   rewrite spec_w_compare; case Z.compare_spec; intros Hylh.
    rewrite Hylh; rewrite spec_w_0; try (ring; fail).
    match goal with |- context[ww_add_c ?x ?y] =>
      generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_0;
@@ -449,15 +442,15 @@ Section DoubleMul.
      replace ((x - y) * (z - t)) with ((y - x) * (t - z)); [idtac | ring]
    end.
    simpl in Hz; rewrite Hz; rewrite H; rewrite H0.
-   rewrite kara_prod_aux; apply Zplus_le_0_compat; apply Zmult_le_0_compat; auto with zarith.
-   apply Zle_lt_trans with ([[z]]-0); auto with zarith.
-   unfold Zminus; apply Zplus_le_compat_l; apply Zle_left_rev; simpl; rewrite Zopp_involutive.
-   apply Zmult_le_0_compat; auto with zarith.
+   rewrite kara_prod_aux; apply Z.add_nonneg_nonneg; apply Z.mul_nonneg_nonneg; auto with zarith.
+   apply Z.le_lt_trans with ([[z]]-0); auto with zarith.
+   unfold Z.sub; apply Z.add_le_mono_l; apply Z.le_0_sub; simpl; rewrite Z.opp_involutive.
+   apply Z.mul_nonneg_nonneg; auto with zarith.
    (** there is a carry in hh + ll **)
-   rewrite Zmult_1_l.
-   generalize (spec_w_compare xl xh); case (w_compare xl xh); intros Hxlh;
+   rewrite Z.mul_1_l.
+   rewrite spec_w_compare; case Z.compare_spec; intros Hxlh;
     try rewrite Hxlh; try rewrite spec_w_1; try (ring; fail).
-   generalize (spec_w_compare yl yh); case (w_compare yl yh); intros Hylh;
+   rewrite spec_w_compare; case Z.compare_spec; intros Hylh;
      try rewrite Hylh; try rewrite spec_w_1; try (ring; fail).
    match goal with |- context[ww_sub_c ?x ?y] =>
      generalize (spec_ww_sub_c x y); case (ww_sub_c x y); try rewrite spec_w_1;
@@ -465,7 +458,7 @@ Section DoubleMul.
    end.
    simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
    repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_0; rewrite Zmult_0_l; rewrite Zplus_0_l.
+   rewrite spec_w_0; rewrite Z.mul_0_l; rewrite Z.add_0_l.
    generalize Hz2; clear Hz2; unfold interp_carry.
    repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
    repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
@@ -476,11 +469,11 @@ Section DoubleMul.
    simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
    repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
    rewrite spec_w_2; unfold interp_carry in Hz2.
-   apply trans_equal with (wwB + (1 * wwB + [[z1]])).
+   transitivity (wwB + (1 * wwB + [[z1]])).
    ring.
    rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
    repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   generalize (spec_w_compare yl yh); case (w_compare yl yh); intros Hylh;
+   rewrite spec_w_compare; case Z.compare_spec; intros Hylh;
      try rewrite Hylh; try rewrite spec_w_1; try (ring; fail).
    match goal with |- context[ww_add_c ?x ?y] =>
      generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_1;
@@ -489,7 +482,7 @@ Section DoubleMul.
    simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
    repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
    rewrite spec_w_2; unfold interp_carry in Hz2.
-   apply trans_equal with (wwB + (1 * wwB + [[z1]])).
+   transitivity (wwB + (1 * wwB + [[z1]])).
    ring.
    rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
    repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
@@ -499,7 +492,7 @@ Section DoubleMul.
    end.
    simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c).
    repeat rewrite Zmod_small; auto with zarith; try (ring; fail).
-   rewrite spec_w_0; rewrite Zmult_0_l; rewrite Zplus_0_l.
+   rewrite spec_w_0; rewrite Z.mul_0_l; rewrite Z.add_0_l.
    match goal with |- context[(?x - ?y) * (?z - ?t)] =>
      replace ((x - y) * (z - t)) with ((y - x) * (t - z)); [idtac | ring]
    end.
@@ -520,7 +513,7 @@ Section DoubleMul.
    rewrite <- wwB_wBwB;intros H1 H2.
    assert (H3 := wB_pos w_digits).
    assert (2*wB <= wwB).
-    rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_le_compat;zarith.
+    rewrite wwB_wBwB; rewrite Z.pow_2_r; apply Z.mul_le_mono_nonneg;zarith.
    omega.
   Qed.
 
@@ -544,14 +537,14 @@ Section DoubleMul.
    assert (U1:= lt_0_wwB w_digits).
    intros x y; case x; auto; intros xh xl.
    case y; auto.
-   simpl; rewrite Zmult_0_r; rewrite Zmod_small; auto with zarith.
+   simpl; rewrite Z.mul_0_r; rewrite Zmod_small; auto with zarith.
    intros yh yl;simpl.
    repeat (rewrite spec_ww_add || rewrite spec_w_W0 || rewrite spec_w_mul_c
     || rewrite spec_w_add || rewrite spec_w_mul).
    rewrite <- Zplus_mod; auto with zarith.
-   repeat (rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r).
+   repeat (rewrite Z.mul_add_distr_r || rewrite Z.mul_add_distr_l).
    rewrite <- Zmult_mod_distr_r; auto with zarith.
-   rewrite <- Zpower_2; rewrite <- wwB_wBwB; auto with zarith.
+   rewrite <- Z.pow_2_r; rewrite <- wwB_wBwB; auto with zarith.
    rewrite Zplus_mod; auto with zarith.
    rewrite Zmod_mod; auto with zarith.
    rewrite <- Zplus_mod; auto with zarith.
@@ -571,10 +564,10 @@ Section DoubleMul.
    apply (spec_mul_aux xh xl xh xl wc cc);trivial.
    generalize Heq (spec_ww_add_c (w_mul_c xh xl) (w_mul_c xh xl));clear Heq.
    rewrite spec_w_mul_c;destruct (ww_add_c (w_mul_c xh xl) (w_mul_c xh xl));
-   unfold interp_carry;try rewrite Zmult_1_l;intros Heq Heq';inversion Heq;
-   rewrite (Zmult_comm [|xl|]);subst.
-   rewrite spec_w_0;rewrite Zmult_0_l;rewrite Zplus_0_l;trivial.
-   rewrite spec_w_1;rewrite Zmult_1_l;rewrite <- wwB_wBwB;trivial.
+   unfold interp_carry;try rewrite Z.mul_1_l;intros Heq Heq';inversion Heq;
+   rewrite (Z.mul_comm [|xl|]);subst.
+   rewrite spec_w_0;rewrite Z.mul_0_l;rewrite Z.add_0_l;trivial.
+   rewrite spec_w_1;rewrite Z.mul_1_l;rewrite <- wwB_wBwB;trivial.
   Qed.
 
   Section DoubleMulAddn1Proof.
@@ -596,8 +589,8 @@ Section DoubleMul.
     assert(H:=IHn xl y r);destruct (double_mul_add_n1 w_mul_add n xl y r)as(rl,l).
    assert(U:=IHn xh y rl);destruct(double_mul_add_n1 w_mul_add n xh y rl)as(rh,h).
     rewrite <- double_wB_wwB. rewrite spec_double_WW;simpl;trivial.
-    rewrite Zmult_plus_distr_l;rewrite <- Zplus_assoc;rewrite <- H.
-    rewrite Zmult_assoc;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+    rewrite Z.mul_add_distr_r;rewrite <- Z.add_assoc;rewrite <- H.
+    rewrite Z.mul_assoc;rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
     rewrite U;ring.
    Qed.
 
@@ -611,9 +604,9 @@ Section DoubleMul.
    destruct (w_mul_c x y) as [ |h l];simpl;rewrite <- H.
    rewrite spec_w_0;trivial.
    assert (U:=spec_w_add_c l r);destruct (w_add_c l r) as [lr|lr];unfold
-   interp_carry in U;try rewrite Zmult_1_l in H;simpl.
+   interp_carry in U;try rewrite Z.mul_1_l in H;simpl.
    rewrite U;ring. rewrite spec_w_succ. rewrite Zmod_small.
-   rewrite <- Zplus_assoc;rewrite <- U;ring.
+   rewrite <- Z.add_assoc;rewrite <- U;ring.
    simpl in H;assert (H1:= Zmult_lt_b _ _ _ (spec_to_Z x) (spec_to_Z y)).
    rewrite <- H in H1.
    assert (H2:=spec_to_Z h);split;zarith.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v
index 4394178f..40556c4a 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: DoubleSqrt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import ZArith.
@@ -220,12 +218,8 @@ Section DoubleSqrt.
   Variable spec_w_0W : forall l, [[w_0W l]] = [|l|].
   Variable spec_w_is_even : forall x,
       if w_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1.
-   Variable spec_w_compare : forall x y,
-       match w_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
+  Variable spec_w_compare : forall x y,
+       w_compare x y = Z.compare [|x|] [|y|].
  Variable spec_w_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB.
  Variable spec_w_square_c : forall x, [[ w_square_c x]] = [|x|] * [|x|].
  Variable spec_w_div21 : forall a1 a2 b,
@@ -238,7 +232,7 @@ Section DoubleSqrt.
         [|p|] <= Zpos w_digits ->
        [| w_add_mul_div p x y |] =
          ([|x|] * (2 ^ [|p|]) +
-          [|y|] / (Zpower 2 ((Zpos w_digits) - [|p|]))) mod wB.
+          [|y|] / (Z.pow 2 ((Zpos w_digits) - [|p|]))) mod wB.
  Variable spec_ww_add_mul_div : forall x y p,
        [[p]] <= Zpos (xO w_digits) ->
        [[ ww_add_mul_div p x y ]] =
@@ -257,11 +251,7 @@ Section DoubleSqrt.
  Variable spec_ww_pred : forall x, [[ww_pred x]] = ([[x]] - 1) mod wwB.
  Variable spec_ww_add_c  : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]].
  Variable spec_ww_compare : forall x y,
-       match ww_compare x y with
-       | Eq => [[x]] = [[y]]
-       | Lt => [[x]] < [[y]]
-       | Gt => [[x]] > [[y]]
-       end.
+    ww_compare x y = Z.compare [[x]] [[y]].
  Variable spec_ww_head0  : forall x,  0 < [[x]] ->
 	 wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB.
  Variable spec_low: forall x, [|low x|] = [[x]] mod wB.
@@ -282,10 +272,9 @@ intros x; case x; simpl ww_is_even.
  unfold base.
  rewrite Zplus_mod; auto with zarith.
  rewrite (fun x y => (Zdivide_mod (x * y))); auto with zarith.
- rewrite Zplus_0_l; rewrite Zmod_mod; auto with zarith.
+ rewrite Z.add_0_l; rewrite Zmod_mod; auto with zarith.
  apply spec_w_is_even; auto with zarith.
- apply Zdivide_mult_r; apply Zpower_divide; auto with zarith.
- red; simpl; auto.
+ apply Z.divide_mul_r; apply Zpower_divide; auto with zarith.
  Qed.
 
 
@@ -296,13 +285,10 @@ intros x; case x; simpl ww_is_even.
  intros a1 a2 b Hb; unfold w_div21c.
  assert (H: 0 < [|b|]); auto with zarith.
  assert (U := wB_pos w_digits).
- apply Zlt_le_trans with (2 := Hb); auto with zarith.
- apply Zlt_le_trans with 1; auto with zarith.
+ apply Z.lt_le_trans with (2 := Hb); auto with zarith.
+ apply Z.lt_le_trans with 1; auto with zarith.
  apply Zdiv_le_lower_bound; auto with zarith.
- repeat match goal with |- context[w_compare ?y ?z] =>
-   generalize (spec_w_compare y z);
-   case (w_compare y z)
- end.
+ rewrite !spec_w_compare. repeat case Z.compare_spec.
  intros H1 H2; split.
  unfold interp_carry; autorewrite with w_rewrite rm10; auto with zarith.
  rewrite H1; rewrite H2; ring.
@@ -321,7 +307,7 @@ intros x; case x; simpl ww_is_even.
  rewrite Zmod_small; auto with zarith.
  split; auto with zarith.
  assert ([|a2|] < 2 * [|b|]); auto with zarith.
- apply Zlt_le_trans with (2 * (wB / 2)); auto with zarith.
+ apply Z.lt_le_trans with (2 * (wB / 2)); auto with zarith.
  rewrite wB_div_2; auto.
  intros H1.
  match goal with |- context[w_div21 ?y ?z ?t] =>
@@ -334,7 +320,7 @@ intros x; case x; simpl ww_is_even.
  rewrite spec_w_sub; auto with zarith.
  rewrite Zmod_small; auto with zarith.
  assert ([|a1|] < 2 * [|b|]); auto with zarith.
- apply Zlt_le_trans with (2 * (wB / 2)); auto with zarith.
+ apply Z.lt_le_trans with (2 * (wB / 2)); auto with zarith.
  rewrite wB_div_2; auto.
  destruct (spec_to_Z a1);auto with zarith.
  destruct (spec_to_Z a1);auto with zarith.
@@ -346,11 +332,11 @@ intros x; case x; simpl ww_is_even.
  intros w0 w1; replace [+|C1 w0|] with (wB + [|w0|]).
  rewrite Zmod_small; auto with zarith.
  intros (H3, H4); split; auto.
- rewrite Zmult_plus_distr_l.
- rewrite <- Zplus_assoc; rewrite <- H3; ring.
+ rewrite Z.mul_add_distr_r.
+ rewrite <- Z.add_assoc; rewrite <- H3; ring.
  split; auto with zarith.
  assert ([|a1|] < 2 * [|b|]); auto with zarith.
- apply Zlt_le_trans with (2 * (wB / 2)); auto with zarith.
+ apply Z.lt_le_trans with (2 * (wB / 2)); auto with zarith.
  rewrite wB_div_2; auto.
  destruct (spec_to_Z a1);auto with zarith.
  destruct (spec_to_Z a1);auto with zarith.
@@ -368,14 +354,14 @@ intros x; case x; simpl ww_is_even.
    rewrite spec_pred; rewrite spec_w_zdigits.
    rewrite Zmod_small; auto with zarith.
    split; auto with zarith.
-   apply Zlt_le_trans with (Zpos w_digits); auto with zarith.
+   apply Z.lt_le_trans with (Zpos w_digits); auto with zarith.
    unfold base; apply Zpower2_le_lin; auto with zarith.
  rewrite spec_w_add_mul_div; auto with zarith.
  autorewrite with w_rewrite rm10.
  match goal with |- context[?X - ?Y] =>
   replace (X - Y) with 1
  end.
- rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith.
+ rewrite Z.pow_1_r; rewrite Zmod_small; auto with zarith.
  destruct (spec_to_Z w1) as [H1 H2];auto with zarith.
  split; auto with zarith.
  apply Zdiv_lt_upper_bound; auto with zarith.
@@ -390,15 +376,15 @@ intros x; case x; simpl ww_is_even.
    rewrite spec_pred; rewrite spec_w_zdigits.
    rewrite Zmod_small; auto with zarith.
    split; auto with zarith.
-   apply Zlt_le_trans with (Zpos w_digits); auto with zarith.
+   apply Z.lt_le_trans with (Zpos w_digits); auto with zarith.
    unfold base; apply Zpower2_le_lin; auto with zarith.
  autorewrite with w_rewrite rm10; auto with zarith.
  match goal with |- context[?X - ?Y] =>
   replace (X - Y) with 1
  end; rewrite Hp; try ring.
- rewrite Zpos_minus; auto with zarith.
- rewrite Zmax_right; auto with zarith.
- rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith.
+ rewrite Pos2Z.inj_sub_max; auto with zarith.
+ rewrite Z.max_r; auto with zarith.
+ rewrite Z.pow_1_r; rewrite Zmod_small; auto with zarith.
  destruct (spec_to_Z w1) as [H1 H2];auto with zarith.
  split; auto with zarith.
  unfold base.
@@ -406,14 +392,14 @@ intros x; case x; simpl ww_is_even.
  assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
   rewrite <- (tmp X); clear tmp
  end.
- rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith.
+ rewrite Zpower_exp; try rewrite Z.pow_1_r; auto with zarith.
  assert (tmp: forall p, 1 + (p -1) - 1 = p - 1); auto with zarith;
   rewrite tmp; clear tmp; auto with zarith.
  match goal with |- ?X + ?Y < _ =>
  assert (Y < X); auto with zarith
  end.
  apply Zdiv_lt_upper_bound; auto with zarith.
- pattern 2 at 2; rewrite <- Zpower_1_r; rewrite <- Zpower_exp;
+ pattern 2 at 2; rewrite <- Z.pow_1_r; rewrite <- Zpower_exp;
   auto with zarith.
  assert (tmp: forall p, (p - 1) + 1 = p); auto with zarith;
   rewrite tmp; clear tmp; auto with zarith.
@@ -423,8 +409,8 @@ intros x; case x; simpl ww_is_even.
     [|w_add_mul_div w_1 w w_0|] = 2 * [|w|] mod wB.
  intros w1.
  autorewrite with w_rewrite rm10; auto with zarith.
- rewrite Zpower_1_r; auto with zarith.
- rewrite Zmult_comm; auto.
+ rewrite Z.pow_1_r; auto with zarith.
+ rewrite Z.mul_comm; auto.
  Qed.
 
  Theorem ww_add_mult_mult_2: forall w,
@@ -433,8 +419,8 @@ intros x; case x; simpl ww_is_even.
  rewrite spec_ww_add_mul_div; auto with zarith.
  autorewrite with w_rewrite rm10.
  rewrite spec_w_0W; rewrite spec_w_1.
- rewrite Zpower_1_r; auto with zarith.
- rewrite Zmult_comm; auto.
+ rewrite Z.pow_1_r; auto with zarith.
+ rewrite Z.mul_comm; auto.
  rewrite spec_w_0W; rewrite spec_w_1; auto with zarith.
  red; simpl; intros; discriminate.
  Qed.
@@ -445,18 +431,18 @@ intros x; case x; simpl ww_is_even.
  intros w1.
  rewrite spec_ww_add_mul_div; auto with zarith.
  rewrite spec_w_0W; rewrite spec_w_1; auto with zarith.
- rewrite Zpower_1_r; auto with zarith.
+ rewrite Z.pow_1_r; auto with zarith.
  f_equal; auto.
- rewrite Zmult_comm; f_equal; auto.
+ rewrite Z.mul_comm; f_equal; auto.
  autorewrite with w_rewrite rm10.
  unfold ww_digits, base.
- apply sym_equal; apply Zdiv_unique with (r := 2 ^ (Zpos (ww_digits w_digits) - 1) -1);
+ symmetry; apply Zdiv_unique with (r := 2 ^ (Zpos (ww_digits w_digits) - 1) -1);
   auto with zarith.
  unfold ww_digits; split; auto with zarith.
  match goal with  |- 0 <= ?X - 1 =>
    assert (0 < X); auto with zarith
  end.
- apply Zpower_gt_0; auto with zarith.
+ apply Z.pow_pos_nonneg; auto with zarith.
  match goal with  |- 0 <= ?X - 1 =>
    assert (0 < X); auto with zarith; red; reflexivity
  end.
@@ -466,7 +452,7 @@ intros x; case x; simpl ww_is_even.
  assert (tmp: forall p, p + p = 2 * p); auto with zarith;
   rewrite tmp; clear tmp.
  f_equal; auto.
- pattern 2 at 2; rewrite <- Zpower_1_r; rewrite <- Zpower_exp;
+ pattern 2 at 2; rewrite <- Z.pow_1_r; rewrite <- Zpower_exp;
   auto with zarith.
  assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
   rewrite tmp; clear tmp; auto.
@@ -479,7 +465,7 @@ intros x; case x; simpl ww_is_even.
 
  Theorem Zplus_mod_one: forall a1 b1, 0 < b1 -> (a1 + b1) mod b1 = a1 mod b1.
  intros a1 b1 H; rewrite Zplus_mod; auto with zarith.
- rewrite Z_mod_same; try rewrite Zplus_0_r; auto with zarith.
+ rewrite Z_mod_same; try rewrite Z.add_0_r; auto with zarith.
  apply Zmod_mod; auto.
  Qed.
 
@@ -494,8 +480,8 @@ intros x; case x; simpl ww_is_even.
  intros a1 a2 b H.
  assert (HH: 0 < [|b|]); auto with zarith.
  assert (U := wB_pos w_digits).
- apply Zlt_le_trans with (2 := H); auto with zarith.
- apply Zlt_le_trans with 1; auto with zarith.
+ apply Z.lt_le_trans with (2 := H); auto with zarith.
+ apply Z.lt_le_trans with 1; auto with zarith.
  apply Zdiv_le_lower_bound; auto with zarith.
  unfold w_div2s; case a1; intros w0 H0.
  match goal with |- context[w_div21c ?y ?z ?t] =>
@@ -541,10 +527,10 @@ intros x; case x; simpl ww_is_even.
  match goal with |- context[_ ^ ?X] =>
  assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
   rewrite <- (tmp X); clear tmp; rewrite Zpower_exp;
-  try rewrite Zpower_1_r; auto with zarith
+  try rewrite Z.pow_1_r; auto with zarith
  end.
- rewrite Zpos_minus; auto with zarith.
- rewrite Zmax_right; auto with zarith.
+ rewrite Pos2Z.inj_sub_max; auto with zarith.
+ rewrite Z.max_r; auto with zarith.
  ring.
  repeat rewrite C0_id.
  rewrite spec_w_add_c; auto with zarith.
@@ -558,10 +544,10 @@ intros x; case x; simpl ww_is_even.
  match goal with |- context[_ ^ ?X] =>
  assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
   rewrite <- (tmp X); clear tmp; rewrite Zpower_exp;
-  try rewrite Zpower_1_r; auto with zarith
+  try rewrite Z.pow_1_r; auto with zarith
  end.
- rewrite Zpos_minus; auto with zarith.
- rewrite Zmax_right; auto with zarith.
+ rewrite Pos2Z.inj_sub_max; auto with zarith.
+ rewrite Z.max_r; auto with zarith.
  ring.
  repeat rewrite C1_plus_wB in H0.
  rewrite C1_plus_wB.
@@ -583,7 +569,7 @@ intros x; case x; simpl ww_is_even.
  rewrite add_mult_div_2_plus_1.
  replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB));
   auto with zarith.
- rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc.
+ rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc.
  rewrite Hw1.
  pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
   auto with zarith.
@@ -591,10 +577,10 @@ intros x; case x; simpl ww_is_even.
  match goal with |- context[_ ^ ?X] =>
  assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
   rewrite <- (tmp X); clear tmp; rewrite Zpower_exp;
-  try rewrite Zpower_1_r; auto with zarith
+  try rewrite Z.pow_1_r; auto with zarith
  end.
- rewrite Zpos_minus; auto with zarith.
- rewrite Zmax_right; auto with zarith.
+ rewrite Pos2Z.inj_sub_max; auto with zarith.
+ rewrite Z.max_r; auto with zarith.
  ring.
  repeat rewrite C0_id.
  rewrite add_mult_div_2_plus_1.
@@ -602,7 +588,7 @@ intros x; case x; simpl ww_is_even.
  intros H1; split; auto with zarith.
  replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB));
   auto with zarith.
- rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc.
+ rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc.
  rewrite Hw1.
  pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
   auto with zarith.
@@ -610,10 +596,10 @@ intros x; case x; simpl ww_is_even.
  match goal with |- context[_ ^ ?X] =>
  assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith;
   rewrite <- (tmp X); clear tmp; rewrite Zpower_exp;
-  try rewrite Zpower_1_r; auto with zarith
+  try rewrite Z.pow_1_r; auto with zarith
  end.
- rewrite Zpos_minus; auto with zarith.
- rewrite Zmax_right; auto with zarith.
+ rewrite Pos2Z.inj_sub_max; auto with zarith.
+ rewrite Z.max_r; auto with zarith.
  ring.
  split; auto with zarith.
  destruct (spec_to_Z b);auto with zarith.
@@ -633,7 +619,7 @@ intros x; case x; simpl ww_is_even.
  rewrite add_mult_div_2.
  replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB));
   auto with zarith.
- rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc.
+ rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc.
  rewrite Hw1.
  pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
   auto with zarith.
@@ -644,7 +630,7 @@ intros x; case x; simpl ww_is_even.
  rewrite add_mult_div_2.
  replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB));
   auto with zarith.
- rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc.
+ rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc.
  rewrite Hw1.
  pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2);
   auto with zarith.
@@ -665,20 +651,20 @@ intros x; case x; simpl ww_is_even.
   rewrite <- Zpower_exp; auto with zarith.
   f_equal; auto with zarith.
   rewrite H.
-  rewrite (fun x => (Zmult_comm 4 (2 ^x))).
+  rewrite (fun x => (Z.mul_comm 4 (2 ^x))).
   rewrite Z_div_mult; auto with zarith.
  Qed.
 
  Theorem Zsquare_mult: forall p, p ^ 2 = p * p.
  intros p; change 2 with (1 + 1); rewrite Zpower_exp;
-  try rewrite Zpower_1_r; auto with zarith.
+  try rewrite Z.pow_1_r; auto with zarith.
  Qed.
 
  Theorem Zsquare_pos: forall p, 0 <= p ^ 2.
- intros p; case (Zle_or_lt 0 p); intros H1.
- rewrite Zsquare_mult; apply Zmult_le_0_compat; auto with zarith.
+ intros p; case (Z.le_gt_cases 0 p); intros H1.
+ rewrite Zsquare_mult; apply Z.mul_nonneg_nonneg; auto with zarith.
  rewrite Zsquare_mult; replace (p * p) with ((- p) * (- p)); try ring.
- apply Zmult_le_0_compat; auto with zarith.
+ apply Z.mul_nonneg_nonneg; auto with zarith.
  Qed.
 
  Lemma spec_split: forall x,
@@ -689,13 +675,12 @@ intros x; case x; simpl ww_is_even.
 
  Theorem mult_wwB: forall x y, [|x|] * [|y|] < wwB.
  Proof.
-  intros x y; rewrite wwB_wBwB; rewrite Zpower_2.
+  intros x y; rewrite wwB_wBwB; rewrite Z.pow_2_r.
   generalize (spec_to_Z x); intros U.
   generalize (spec_to_Z y); intros U1.
-  apply Zle_lt_trans with ((wB -1 ) * (wB - 1)); auto with zarith.
-  apply Zmult_le_compat; auto with zarith.
-  repeat (rewrite Zmult_minus_distr_r || rewrite Zmult_minus_distr_l);
-        auto with zarith.
+  apply Z.le_lt_trans with ((wB -1 ) * (wB - 1)); auto with zarith.
+  apply Z.mul_le_mono_nonneg; auto with zarith.
+  rewrite ?Z.mul_sub_distr_l, ?Z.mul_sub_distr_r; auto with zarith.
  Qed.
  Hint Resolve mult_wwB.
 
@@ -710,22 +695,22 @@ intros x; case x; simpl ww_is_even.
  end; simpl fst; simpl snd.
  intros w0 w1 Hw0 w2 w3 Hw1.
  assert (U: wB/4 <= [|w2|]).
- case (Zle_or_lt (wB / 4) [|w2|]); auto; intros H1.
- contradict H; apply Zlt_not_le.
- rewrite wwB_wBwB; rewrite Zpower_2.
- pattern wB at 1; rewrite <- wB_div_4; rewrite <- Zmult_assoc;
-   rewrite Zmult_comm.
+ case (Z.le_gt_cases (wB / 4) [|w2|]); auto; intros H1.
+ contradict H; apply Z.lt_nge.
+ rewrite wwB_wBwB; rewrite Z.pow_2_r.
+ pattern wB at 1; rewrite <- wB_div_4; rewrite <- Z.mul_assoc;
+   rewrite Z.mul_comm.
  rewrite Z_div_mult; auto with zarith.
  rewrite <- Hw1.
  match goal with |- _  < ?X =>
-  pattern X; rewrite <- Zplus_0_r; apply beta_lex_inv;
+  pattern X; rewrite <- Z.add_0_r; apply beta_lex_inv;
   auto with zarith
  end.
  destruct (spec_to_Z w3);auto with zarith.
  generalize (@spec_w_sqrt2 w2 w3 U); case (w_sqrt2 w2 w3).
  intros w4 c (H1, H2).
  assert (U1: wB/2 <= [|w4|]).
- case (Zle_or_lt (wB/2) [|w4|]); auto with zarith.
+ case (Z.le_gt_cases (wB/2) [|w4|]); auto with zarith.
  intros U1.
  assert (U2 : [|w4|] <= wB/2 -1); auto with zarith.
  assert (U3 : [|w4|] ^ 2 <= wB/4 * wB - wB + 1); auto with zarith.
@@ -733,19 +718,19 @@ intros x; case x; simpl ww_is_even.
   rewrite Zsquare_mult;
   replace Y with ((wB/2 - 1) * (wB/2 -1))
  end.
- apply Zmult_le_compat; auto with zarith.
+ apply Z.mul_le_mono_nonneg; auto with zarith.
  destruct (spec_to_Z w4);auto with zarith.
  destruct (spec_to_Z w4);auto with zarith.
  pattern wB at 4 5; rewrite <- wB_div_2.
- rewrite Zmult_assoc.
+ rewrite Z.mul_assoc.
  replace ((wB / 4) * 2) with (wB / 2).
  ring.
  pattern wB at 1; rewrite <- wB_div_4.
  change 4 with (2 * 2).
- rewrite <- Zmult_assoc; rewrite (Zmult_comm 2).
+ rewrite <- Z.mul_assoc; rewrite (Z.mul_comm 2).
  rewrite Z_div_mult; try ring; auto with zarith.
  assert (U4 : [+|c|]  <= wB -2); auto with zarith.
- apply Zle_trans with (1 := H2).
+ apply Z.le_trans with (1 := H2).
  match goal with |- ?X <= ?Y =>
   replace Y with (2 * (wB/ 2 - 1)); auto with zarith
  end.
@@ -754,10 +739,10 @@ intros x; case x; simpl ww_is_even.
   assert (U5: X < wB / 4 * wB)
  end.
  rewrite H1; auto with zarith.
- contradict U; apply Zlt_not_le.
- apply Zmult_lt_reg_r with wB; auto with zarith.
+ contradict U; apply Z.lt_nge.
+ apply Z.mul_lt_mono_pos_r with wB; auto with zarith.
  destruct (spec_to_Z w4);auto with zarith.
- apply Zle_lt_trans with (2 := U5).
+ apply Z.le_lt_trans with (2 := U5).
  unfold ww_to_Z, zn2z_to_Z.
  destruct (spec_to_Z w3);auto with zarith.
  generalize (@spec_w_div2s c w0 w4 U1 H2).
@@ -779,7 +764,7 @@ intros x; case x; simpl ww_is_even.
  unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1.
  rewrite <- Hw0.
  match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
+  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
  end.
  repeat rewrite Zsquare_mult.
  rewrite wwB_wBwB; ring.
@@ -792,17 +777,17 @@ intros x; case x; simpl ww_is_even.
  match goal with |- ?X - ?Y * ?Y <= _ =>
   assert (V := Zsquare_pos Y);
   rewrite Zsquare_mult in V;
-  apply Zle_trans with X; auto with zarith;
+  apply Z.le_trans with X; auto with zarith;
   clear V
  end.
  match goal with |- ?X * wB + ?Y <= 2 * (?Z * wB + ?T) =>
-  apply Zle_trans with ((2 * Z - 1) * wB + wB); auto with zarith
+  apply Z.le_trans with ((2 * Z - 1) * wB + wB); auto with zarith
  end.
  destruct (spec_to_Z w1);auto with zarith.
  match goal with |- ?X <= _ =>
   replace X with (2 * [|w4|] * wB); auto with zarith
  end.
- rewrite Zmult_plus_distr_r; rewrite Zmult_assoc.
+ rewrite Z.mul_add_distr_l; rewrite Z.mul_assoc.
  destruct (spec_to_Z w5); auto with zarith.
  ring.
  intros z; replace [-[C1 z]] with (- wwB + [[z]]).
@@ -828,7 +813,7 @@ intros x; case x; simpl ww_is_even.
  unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1.
  rewrite <- Hw0.
  match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
+  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
  end.
  repeat rewrite Zsquare_mult.
  rewrite wwB_wBwB; ring.
@@ -841,11 +826,11 @@ intros x; case x; simpl ww_is_even.
  destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith.
  assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)).
  assert (0 <  [[WW w4 w5]]); auto with zarith.
- apply Zlt_le_trans with (wB/ 2 * wB + 0); auto with zarith.
- autorewrite with rm10; apply Zmult_lt_0_compat; auto with zarith.
- apply Zmult_lt_reg_r with 2; auto with zarith.
+ apply Z.lt_le_trans with (wB/ 2 * wB + 0); auto with zarith.
+ autorewrite with rm10; apply Z.mul_pos_pos; auto with zarith.
+ apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
  autorewrite with rm10.
- rewrite Zmult_comm; rewrite wB_div_2; auto with zarith.
+ rewrite Z.mul_comm; rewrite wB_div_2; auto with zarith.
  case (spec_to_Z w5);auto with zarith.
  case (spec_to_Z w5);auto with zarith.
  simpl.
@@ -853,11 +838,11 @@ intros x; case x; simpl ww_is_even.
  assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)); auto with zarith.
  split; auto with zarith.
  assert (wwB <= 2 * [[WW w4 w5]]); auto with zarith.
- apply Zle_trans with (2 * ([|w4|] * wB)).
- rewrite wwB_wBwB; rewrite Zpower_2.
- rewrite Zmult_assoc; apply Zmult_le_compat_r; auto with zarith.
- rewrite <- wB_div_2; auto with zarith.
+ apply Z.le_trans with (2 * ([|w4|] * wB)).
+ rewrite wwB_wBwB; rewrite Z.pow_2_r.
+ rewrite Z.mul_assoc; apply Z.mul_le_mono_nonneg_r; auto with zarith.
  assert (V2 := spec_to_Z w5);auto with zarith.
+ rewrite <- wB_div_2; auto with zarith.
  simpl ww_to_Z; assert (V2 := spec_to_Z w5);auto with zarith.
  assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)); auto with zarith.
  intros z1; change [-[C1 z1]] with (-wwB + [[z1]]).
@@ -869,21 +854,21 @@ intros x; case x; simpl ww_is_even.
  rewrite ww_add_mult_mult_2.
  rename V1 into VV1.
  assert (VV2: 0 <  [[WW w4 w5]]); auto with zarith.
- apply Zlt_le_trans with (wB/ 2 * wB + 0); auto with zarith.
- autorewrite with rm10; apply Zmult_lt_0_compat; auto with zarith.
- apply Zmult_lt_reg_r with 2; auto with zarith.
+ apply Z.lt_le_trans with (wB/ 2 * wB + 0); auto with zarith.
+ autorewrite with rm10; apply Z.mul_pos_pos; auto with zarith.
+ apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
  autorewrite with rm10.
- rewrite Zmult_comm; rewrite wB_div_2; auto with zarith.
+ rewrite Z.mul_comm; rewrite wB_div_2; auto with zarith.
  assert (VV3 := spec_to_Z w5);auto with zarith.
  assert (VV3 := spec_to_Z w5);auto with zarith.
  simpl.
  assert (VV3 := spec_to_Z w5);auto with zarith.
  assert (VV3: wwB <= 2 * [[WW w4 w5]]); auto with zarith.
- apply Zle_trans with (2 * ([|w4|] * wB)).
- rewrite wwB_wBwB; rewrite Zpower_2.
- rewrite Zmult_assoc; apply Zmult_le_compat_r; auto with zarith.
- rewrite <- wB_div_2; auto with zarith.
+ apply Z.le_trans with (2 * ([|w4|] * wB)).
+ rewrite wwB_wBwB; rewrite Z.pow_2_r.
+ rewrite Z.mul_assoc; apply Z.mul_le_mono_nonneg_r; auto with zarith.
  case (spec_to_Z w5);auto with zarith.
+ rewrite <- wB_div_2; auto with zarith.
  simpl ww_to_Z; assert (V4 := spec_to_Z w5);auto with zarith.
  rewrite <- Zmod_unique with (q := 1) (r := -wwB + 2 * [[WW w4 w5]]);
   auto with zarith.
@@ -905,7 +890,7 @@ intros x; case x; simpl ww_is_even.
  rewrite <- Hw0.
  split.
  match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
+  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
  end.
  repeat rewrite Zsquare_mult.
  rewrite wwB_wBwB; ring.
@@ -918,17 +903,17 @@ intros x; case x; simpl ww_is_even.
  assert (V2 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith.
  assert (V3 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z1);auto with zarith.
  split; auto with zarith.
- rewrite (Zplus_comm (-wwB)); rewrite <- Zplus_assoc.
+ rewrite (Z.add_comm (-wwB)); rewrite <- Z.add_assoc.
  rewrite H5.
  match goal with |- 0 <= ?X + (?Y - ?Z)  =>
-  apply Zle_trans with (X - Z); auto with zarith
+  apply Z.le_trans with (X - Z); auto with zarith
  end.
  2: generalize (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w6 w1)); unfold ww_to_Z; auto with zarith.
  rewrite V1.
  match goal with |- 0 <= ?X - 1 - ?Y =>
    assert (Y < X); auto with zarith
  end.
- apply Zlt_le_trans with wwB; auto with zarith.
+ apply Z.lt_le_trans with wwB; auto with zarith.
  intros (H3, H4).
  match goal with |- context [ww_sub_c ?y ?z] =>
   generalize (spec_ww_sub_c y z); case (ww_sub_c y z)
@@ -946,7 +931,7 @@ intros x; case x; simpl ww_is_even.
  unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1.
  rewrite <- Hw0.
  match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
+  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
  end.
  repeat rewrite Zsquare_mult.
  rewrite wwB_wBwB; ring.
@@ -958,27 +943,27 @@ intros x; case x; simpl ww_is_even.
  simpl ww_to_Z.
  rewrite H5.
  simpl ww_to_Z.
- rewrite wwB_wBwB; rewrite Zpower_2.
+ rewrite wwB_wBwB; rewrite Z.pow_2_r.
  match goal with |- ?X * ?Y + (?Z * ?Y + ?T - ?U) <= _ =>
-  apply Zle_trans with (X * Y + (Z * Y + T - 0));
+  apply Z.le_trans with (X * Y + (Z * Y + T - 0));
   auto with zarith
  end.
  assert (V := Zsquare_pos [|w5|]);
  rewrite Zsquare_mult in V; auto with zarith.
  autorewrite with rm10.
  match goal with |- _ <= 2 * (?U * ?V + ?W) =>
-  apply Zle_trans with (2 * U * V + 0);
+  apply Z.le_trans with (2 * U * V + 0);
   auto with zarith
  end.
  match goal with |- ?X * ?Y + (?Z * ?Y + ?T) <= _ =>
   replace (X * Y + (Z * Y + T)) with ((X + Z) * Y + T);
   try ring
  end.
- apply Zlt_le_weak; apply beta_lex_inv; auto with zarith.
+ apply Z.lt_le_incl; apply beta_lex_inv; auto with zarith.
  destruct (spec_to_Z w1);auto with zarith.
  destruct (spec_to_Z w5);auto with zarith.
- rewrite Zmult_plus_distr_r; auto with zarith.
- rewrite Zmult_assoc; auto with zarith.
+ rewrite Z.mul_add_distr_l; auto with zarith.
+ rewrite Z.mul_assoc; auto with zarith.
  intros z; replace [-[C1 z]] with (- wwB + [[z]]).
  2: simpl; case wwB; auto with zarith.
  intros H5; rewrite spec_w_square_c in H5;
@@ -997,7 +982,7 @@ intros x; case x; simpl ww_is_even.
  rewrite <- Hw0.
  split.
  match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
+  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
  end.
  repeat rewrite Zsquare_mult.
  rewrite wwB_wBwB; ring.
@@ -1008,40 +993,38 @@ intros x; case x; simpl ww_is_even.
  repeat rewrite Zsquare_mult; ring.
  rewrite V.
  simpl ww_to_Z.
- rewrite wwB_wBwB; rewrite Zpower_2.
+ rewrite wwB_wBwB; rewrite Z.pow_2_r.
  match goal with |- (?Z * ?Y + ?T - ?U) + ?X * ?Y <= _ =>
-  apply Zle_trans with ((Z * Y + T - 0) + X * Y);
+  apply Z.le_trans with ((Z * Y + T - 0) + X * Y);
   auto with zarith
  end.
  assert (V1 := Zsquare_pos [|w5|]);
  rewrite Zsquare_mult in V1; auto with zarith.
  autorewrite with rm10.
  match goal with |- _ <= 2 * (?U * ?V + ?W) =>
-  apply Zle_trans with (2 * U * V + 0);
+  apply Z.le_trans with (2 * U * V + 0);
   auto with zarith
  end.
  match goal with |- (?Z * ?Y + ?T) + ?X * ?Y  <= _ =>
   replace ((Z * Y + T) + X * Y) with ((X + Z) * Y + T);
   try ring
  end.
- apply Zlt_le_weak; apply beta_lex_inv; auto with zarith.
+ apply Z.lt_le_incl; apply beta_lex_inv; auto with zarith.
  destruct (spec_to_Z w1);auto with zarith.
  destruct (spec_to_Z w5);auto with zarith.
- rewrite Zmult_plus_distr_r; auto with zarith.
- rewrite Zmult_assoc; auto with zarith.
- case Zle_lt_or_eq with (1 := H2); clear H2; intros H2.
+ rewrite Z.mul_add_distr_l; auto with zarith.
+ rewrite Z.mul_assoc; auto with zarith.
+ Z.le_elim H2.
  intros c1 (H3, H4).
- match type of H3 with ?X = ?Y =>
-   absurd (X < Y)
- end.
- apply Zle_not_lt; rewrite <- H3; auto with zarith.
- rewrite Zmult_plus_distr_l.
- apply Zlt_le_trans with ((2 * [|w4|]) * wB + 0);
+ match type of H3 with ?X = ?Y => absurd (X < Y) end.
+ apply Z.le_ngt; rewrite <- H3; auto with zarith.
+ rewrite Z.mul_add_distr_r.
+ apply Z.lt_le_trans with ((2 * [|w4|]) * wB + 0);
   auto with zarith.
  apply beta_lex_inv; auto with zarith.
  destruct (spec_to_Z w0);auto with zarith.
  assert (V1 := spec_to_Z w5);auto with zarith.
- rewrite (Zmult_comm wB); auto with zarith.
+ rewrite (Z.mul_comm wB); auto with zarith.
  assert (0 <= [|w5|] * (2 * [|w4|])); auto with zarith.
  intros c1 (H3, H4); rewrite H2 in H3.
  match type of H3 with ?X + ?Y = (?Z + ?T) * ?U + ?V =>
@@ -1051,20 +1034,19 @@ intros x; case x; simpl ww_is_even.
  end.
  assert (V1 := spec_to_Z w0);auto with zarith.
  assert (V2 := spec_to_Z w5);auto with zarith.
- case (Zle_lt_or_eq 0 [|w5|]); auto with zarith; intros V3.
- match type of VV with ?X = ?Y =>
-   absurd (X < Y)
- end.
- apply Zle_not_lt; rewrite <- VV; auto with zarith.
- apply Zlt_le_trans with wB; auto with zarith.
+ case V2; intros V3 _.
+ Z.le_elim V3; auto with zarith.
+ match type of VV with ?X = ?Y => absurd (X < Y) end.
+ apply Z.le_ngt; rewrite <- VV; auto with zarith.
+ apply Z.lt_le_trans with wB; auto with zarith.
  match goal with |- _ <= ?X + _ =>
-  apply Zle_trans with X; auto with zarith
+  apply Z.le_trans with X; auto with zarith
  end.
  match goal with |- _ <= _ * ?X =>
-  apply Zle_trans with (1 * X); auto with zarith
+  apply Z.le_trans with (1 * X); auto with zarith
  end.
  autorewrite with rm10.
- rewrite <- wB_div_2; apply Zmult_le_compat_l; auto with zarith.
+ rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; auto with zarith.
  rewrite <- V3 in VV; generalize VV; autorewrite with rm10;
  clear VV; intros VV.
  rewrite spec_ww_add_c; auto with zarith.
@@ -1080,7 +1062,7 @@ intros x; case x; simpl ww_is_even.
  simpl ww_to_Z in H1; rewrite H1.
  rewrite <- Hw0.
  match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
-  apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
+  transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
  end.
  repeat rewrite Zsquare_mult.
  rewrite wwB_wBwB; ring.
@@ -1092,41 +1074,41 @@ intros x; case x; simpl ww_is_even.
  simpl ww_to_Z; unfold ww_to_Z.
  rewrite spec_w_Bm1; auto with zarith.
  split.
- rewrite wwB_wBwB; rewrite Zpower_2.
+ rewrite wwB_wBwB; rewrite Z.pow_2_r.
  match goal with |- _ <= -?X + (2 * (?Z * ?T + ?U) + ?V) =>
   assert (X <= 2 * Z * T); auto with zarith
  end.
- apply Zmult_le_compat_r; auto with zarith.
- rewrite <- wB_div_2; apply Zmult_le_compat_l; auto with zarith.
- rewrite Zmult_plus_distr_r; auto with zarith.
- rewrite Zmult_assoc; auto with zarith.
+ apply Z.mul_le_mono_nonneg_r; auto with zarith.
+ rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; auto with zarith.
+ rewrite Z.mul_add_distr_l; auto with zarith.
+ rewrite Z.mul_assoc; auto with zarith.
  match goal with |- _ + ?X  < _ =>
   replace X with ((2 * (([|w4|]) + 1) * wB) - 1); try ring
  end.
  assert (2 * ([|w4|] + 1) * wB <= 2 * wwB); auto with zarith.
- rewrite <- Zmult_assoc; apply Zmult_le_compat_l; auto with zarith.
- rewrite wwB_wBwB; rewrite Zpower_2.
- apply Zmult_le_compat_r; auto with zarith.
+ rewrite <- Z.mul_assoc; apply Z.mul_le_mono_nonneg_l; auto with zarith.
+ rewrite wwB_wBwB; rewrite Z.pow_2_r.
+ apply Z.mul_le_mono_nonneg_r; auto with zarith.
  case (spec_to_Z w4);auto with zarith.
- Qed.
+Qed.
 
  Lemma spec_ww_is_zero: forall x,
    if ww_is_zero x then [[x]] = 0 else 0 < [[x]].
   intro x; unfold ww_is_zero.
-  generalize (spec_ww_compare W0 x); case (ww_compare W0 x);
+  rewrite spec_ww_compare. case Z.compare_spec;
    auto with zarith.
   simpl ww_to_Z.
   assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z x);auto with zarith.
   Qed.
 
   Lemma wwB_4_2: 2 * (wwB / 4) = wwB/ 2.
-  pattern wwB at 1; rewrite wwB_wBwB; rewrite Zpower_2.
+  pattern wwB at 1; rewrite wwB_wBwB; rewrite Z.pow_2_r.
   rewrite <- wB_div_2.
   match goal with |- context[(2 * ?X) * (2 * ?Z)] =>
     replace ((2 * X) * (2 * Z)) with ((X * Z) * 4); try ring
   end.
   rewrite Z_div_mult; auto with zarith.
-  rewrite Zmult_assoc; rewrite wB_div_2.
+  rewrite Z.mul_assoc; rewrite wB_div_2.
   rewrite wwB_div_2; ring.
   Qed.
 
@@ -1142,10 +1124,10 @@ intros x; case x; simpl ww_is_even.
   intros H2.
   generalize (spec_ww_head0 x H2); case (ww_head0 x);  autorewrite with rm10.
   intros (H3, H4); split; auto with zarith.
-  apply Zle_trans with (2 := H3).
+  apply Z.le_trans with (2 := H3).
   apply Zdiv_le_compat_l; auto with zarith.
   intros xh xl (H3, H4); split; auto with zarith.
-  apply Zle_trans with (2 := H3).
+  apply Z.le_trans with (2 := H3).
   apply Zdiv_le_compat_l; auto with zarith.
   intros H1.
   case (spec_to_w_Z (ww_head0 x)); intros Hv1 Hv2.
@@ -1169,24 +1151,24 @@ intros x; case x; simpl ww_is_even.
   case (spec_ww_head0 x); auto; intros Hv3 Hv4.
   assert (Hu: forall u, 0 < u -> 2 *  2 ^ (u - 1) = 2 ^u).
     intros u Hu.
-    pattern 2 at 1; rewrite <- Zpower_1_r.
+    pattern 2 at 1; rewrite <- Z.pow_1_r.
     rewrite <- Zpower_exp; auto with zarith.
     ring_simplify (1 + (u - 1)); auto with zarith.
   split; auto with zarith.
-  apply Zmult_le_reg_r with 2; auto with zarith.
-  repeat rewrite (fun x => Zmult_comm x 2).
+  apply Z.mul_le_mono_pos_r with 2; auto with zarith.
+  repeat rewrite (fun x => Z.mul_comm x 2).
   rewrite wwB_4_2.
-  rewrite Zmult_assoc; rewrite Hu; auto with zarith.
-  apply Zle_lt_trans with (2 * 2 ^ ([[ww_head0 x]] - 1) * [[x]]); auto with zarith;
+  rewrite Z.mul_assoc; rewrite Hu; auto with zarith.
+  apply Z.le_lt_trans with (2 * 2 ^ ([[ww_head0 x]] - 1) * [[x]]); auto with zarith;
     rewrite Hu; auto with zarith.
-  apply Zmult_le_compat_r; auto with zarith.
+  apply Z.mul_le_mono_nonneg_r; auto with zarith.
   apply Zpower_le_monotone; auto with zarith.
   Qed.
 
   Theorem wwB_4_wB_4: wwB / 4 = wB / 4 * wB.
-  apply sym_equal; apply Zdiv_unique with 0;
-    auto with zarith.
-  rewrite Zmult_assoc; rewrite wB_div_4; auto with zarith.
+  Proof.
+  symmetry; apply Zdiv_unique with 0; auto with zarith.
+  rewrite Z.mul_assoc; rewrite wB_div_4; auto with zarith.
   rewrite wwB_wBwB; ring.
   Qed.
 
@@ -1195,10 +1177,10 @@ intros x; case x; simpl ww_is_even.
   assert (U := wB_pos w_digits).
   intro x; unfold ww_sqrt.
   generalize (spec_ww_is_zero x); case (ww_is_zero x).
-  simpl ww_to_Z; simpl Zpower; unfold Zpower_pos; simpl;
+  simpl ww_to_Z; simpl Z.pow; unfold Z.pow_pos; simpl;
     auto with zarith.
   intros H1.
-  generalize (spec_ww_compare (ww_head1 x) W0); case ww_compare;
+  rewrite spec_ww_compare. case Z.compare_spec;
     simpl ww_to_Z; autorewrite with rm10.
   generalize H1; case x.
   intros HH; contradict HH; simpl ww_to_Z; auto with zarith.
@@ -1216,7 +1198,7 @@ intros x; case x; simpl ww_is_even.
   intros w3 (H6, H7); rewrite H6.
   assert (V1 := spec_to_Z w3);auto with zarith.
   split; auto with zarith.
-  apply Zle_lt_trans with ([|w2|] ^2  + 2 * [|w2|]); auto with zarith.
+  apply Z.le_lt_trans with ([|w2|] ^2  + 2 * [|w2|]); auto with zarith.
   match goal with |- ?X < ?Z =>
     replace Z with (X + 1); auto with zarith
   end.
@@ -1224,7 +1206,7 @@ intros x; case x; simpl ww_is_even.
   intros w3 (H6, H7); rewrite H6.
   assert (V1 := spec_to_Z w3);auto with zarith.
   split; auto with zarith.
-  apply Zle_lt_trans with ([|w2|] ^2  + 2 * [|w2|]); auto with zarith.
+  apply Z.le_lt_trans with ([|w2|] ^2  + 2 * [|w2|]); auto with zarith.
   match goal with |- ?X < ?Z =>
     replace Z with (X + 1); auto with zarith
   end.
@@ -1234,42 +1216,42 @@ intros x; case x; simpl ww_is_even.
   case (spec_ww_head1 x); intros Hp1 Hp2.
   generalize (Hp2 H1); clear Hp2; intros Hp2.
   assert (Hv2: [[ww_head1 x]] <= Zpos (xO w_digits)).
-    case (Zle_or_lt (Zpos (xO w_digits)) [[ww_head1 x]]); auto with zarith; intros HH1.
+    case (Z.le_gt_cases (Zpos (xO w_digits)) [[ww_head1 x]]); auto with zarith; intros HH1.
     case Hp2; intros _ HH2; contradict HH2.
-    apply Zle_not_lt; unfold base.
-    apply Zle_trans with (2 ^ [[ww_head1 x]]).
+    apply Z.le_ngt; unfold base.
+    apply Z.le_trans with (2 ^ [[ww_head1 x]]).
       apply Zpower_le_monotone; auto with zarith.
     pattern (2 ^ [[ww_head1 x]]) at 1;
-      rewrite <- (Zmult_1_r (2 ^ [[ww_head1 x]])).
-    apply Zmult_le_compat_l; auto with zarith.
+      rewrite <- (Z.mul_1_r (2 ^ [[ww_head1 x]])).
+    apply Z.mul_le_mono_nonneg_l; auto with zarith.
   generalize (spec_ww_add_mul_div x W0 (ww_head1 x) Hv2);
      case ww_add_mul_div.
   simpl ww_to_Z; autorewrite with w_rewrite rm10.
   rewrite Zmod_small; auto with zarith.
-  intros H2; case (Zmult_integral _ _ (sym_equal H2)); clear H2; intros H2.
-  rewrite H2; unfold Zpower, Zpower_pos; simpl; auto with zarith.
+  intros H2. symmetry in H2. rewrite Z.mul_eq_0 in H2. destruct H2 as [H2|H2].
+  rewrite H2; unfold Z.pow, Z.pow_pos; simpl; auto with zarith.
   match type of H2 with ?X = ?Y =>
    absurd (Y < X); try (rewrite H2; auto with zarith; fail)
   end.
-  apply Zpower_gt_0; auto with zarith.
+  apply Z.pow_pos_nonneg; auto with zarith.
   split; auto with zarith.
-  case Hp2; intros _ tmp; apply Zle_lt_trans with (2 := tmp);
+  case Hp2; intros _ tmp; apply Z.le_lt_trans with (2 := tmp);
    clear tmp.
-  rewrite Zmult_comm; apply Zmult_le_compat_r; auto with zarith.
+  rewrite Z.mul_comm; apply Z.mul_le_mono_nonneg_r; auto with zarith.
   assert (Hv0: [[ww_head1 x]] = 2 * ([[ww_head1 x]]/2)).
     pattern [[ww_head1 x]] at 1; rewrite (Z_div_mod_eq [[ww_head1 x]] 2);
       auto with zarith.
     generalize (spec_ww_is_even (ww_head1 x)); rewrite Hp1;
-      intros tmp; rewrite tmp; rewrite Zplus_0_r; auto.
+      intros tmp; rewrite tmp; rewrite Z.add_0_r; auto.
   intros w0 w1; autorewrite with w_rewrite rm10.
   rewrite Zmod_small; auto with zarith.
-  2: rewrite Zmult_comm; auto with zarith.
+  2: rewrite Z.mul_comm; auto with zarith.
   intros H2.
   assert (V: wB/4 <= [|w0|]).
   apply beta_lex with 0 [|w1|] wB; auto with zarith; autorewrite with rm10.
   simpl ww_to_Z in H2; rewrite H2.
   rewrite <- wwB_4_wB_4; auto with zarith.
-  rewrite Zmult_comm; auto with zarith.
+  rewrite Z.mul_comm; auto with zarith.
   assert (V1 := spec_to_Z w1);auto with zarith.
   generalize (@spec_w_sqrt2 w0 w1 V);auto with zarith.
   case (w_sqrt2 w0 w1); intros w2 c.
@@ -1280,13 +1262,13 @@ intros x; case x; simpl ww_is_even.
     rewrite spec_ww_pred; rewrite spec_ww_zdigits.
     rewrite Zmod_small; auto with zarith.
     split; auto with zarith.
-    apply Zlt_le_trans with (Zpos (xO w_digits)); auto with zarith.
+    apply Z.lt_le_trans with (Zpos (xO w_digits)); auto with zarith.
     unfold base; apply Zpower2_le_lin; auto with zarith.
   assert (Hv4: [[ww_head1 x]]/2 < wB).
-    apply Zle_lt_trans with (Zpos w_digits).
-    apply Zmult_le_reg_r with 2; auto with zarith.
-    repeat rewrite (fun x => Zmult_comm x 2).
-    rewrite <- Hv0;  rewrite <- Zpos_xO; auto.
+    apply Z.le_lt_trans with (Zpos w_digits).
+    apply Z.mul_le_mono_pos_r with 2; auto with zarith.
+    repeat rewrite (fun x => Z.mul_comm x 2).
+    rewrite <- Hv0;  rewrite <- Pos2Z.inj_xO; auto.
     unfold base; apply Zpower2_lt_lin; auto with zarith.
   assert (Hv5: [[(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))]]
                  = [[ww_head1 x]]/2).
@@ -1294,12 +1276,12 @@ intros x; case x; simpl ww_is_even.
     simpl ww_to_Z; autorewrite with rm10.
     rewrite Hv3.
     ring_simplify (Zpos (xO w_digits) - (Zpos (xO w_digits) - 1)).
-    rewrite Zpower_1_r.
+    rewrite Z.pow_1_r.
     rewrite Zmod_small; auto with zarith.
     split; auto with zarith.
-    apply Zlt_le_trans with (1 := Hv4); auto with zarith.
+    apply Z.lt_le_trans with (1 := Hv4); auto with zarith.
     unfold base; apply Zpower_le_monotone; auto with zarith.
-    split; unfold ww_digits; try rewrite Zpos_xO; auto with zarith.
+    split; unfold ww_digits; try rewrite Pos2Z.inj_xO; auto with zarith.
     rewrite Hv3; auto with zarith.
   assert (Hv6: [|low(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))|]
                  = [[ww_head1 x]]/2).
@@ -1315,13 +1297,13 @@ intros x; case x; simpl ww_is_even.
   rewrite Zmod_small.
   simpl ww_to_Z in H2; rewrite H2; auto with zarith.
   intros (H4, H5); split.
-  apply Zmult_le_reg_r with (2 ^ [[ww_head1 x]]); auto with zarith.
+  apply Z.mul_le_mono_pos_r with (2 ^ [[ww_head1 x]]); auto with zarith.
   rewrite H4.
-  apply Zle_trans with ([|w2|] ^ 2); auto with zarith.
-  rewrite Zmult_comm.
+  apply Z.le_trans with ([|w2|] ^ 2); auto with zarith.
+  rewrite Z.mul_comm.
   pattern [[ww_head1 x]] at 1;
     rewrite Hv0; auto with zarith.
-  rewrite (Zmult_comm 2); rewrite Zpower_mult;
+  rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r;
     auto with zarith.
   assert (tmp: forall p q, p ^ 2 * q ^ 2 = (p * q) ^2);
    try (intros; repeat rewrite Zsquare_mult; ring);
@@ -1337,17 +1319,17 @@ intros x; case x; simpl ww_is_even.
   case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]] / 2))); auto with zarith.
   case c; unfold interp_carry; autorewrite with rm10;
     intros w3; assert (V3 := spec_to_Z w3);auto with zarith.
-  apply Zmult_lt_reg_r with (2 ^ [[ww_head1 x]]); auto with zarith.
+  apply Z.mul_lt_mono_pos_r with (2 ^ [[ww_head1 x]]); auto with zarith.
   rewrite H4.
-  apply Zle_lt_trans with ([|w2|] ^ 2 + 2 * [|w2|]); auto with zarith.
-  apply Zlt_le_trans with (([|w2|] + 1) ^ 2); auto with zarith.
+  apply Z.le_lt_trans with ([|w2|] ^ 2 + 2 * [|w2|]); auto with zarith.
+  apply Z.lt_le_trans with (([|w2|] + 1) ^ 2); auto with zarith.
   match goal with |- ?X < ?Y =>
     replace Y with (X + 1); auto with zarith
   end.
   repeat rewrite (Zsquare_mult); ring.
-  rewrite Zmult_comm.
+  rewrite Z.mul_comm.
   pattern [[ww_head1 x]] at 1; rewrite Hv0.
-  rewrite (Zmult_comm 2); rewrite Zpower_mult;
+  rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r;
    auto with zarith.
   assert (tmp: forall p q, p ^ 2 * q ^ 2 = (p * q) ^2);
    try (intros; repeat rewrite Zsquare_mult; ring);
@@ -1356,20 +1338,20 @@ intros x; case x; simpl ww_is_even.
   split; auto with zarith.
   pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] (2 ^ ([[ww_head1 x]]/2)));
     auto with zarith.
-  rewrite <- Zplus_assoc; rewrite Zmult_plus_distr_r.
-  autorewrite with rm10; apply Zplus_le_compat_l; auto with zarith.
+  rewrite <- Z.add_assoc; rewrite Z.mul_add_distr_l.
+  autorewrite with rm10; apply Z.add_le_mono_l; auto with zarith.
   case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]]/2))); auto with zarith.
   split; auto with zarith.
-  apply Zle_lt_trans with ([|w2|]); auto with zarith.
+  apply Z.le_lt_trans with ([|w2|]); auto with zarith.
   apply Zdiv_le_upper_bound; auto with zarith.
   pattern [|w2|] at 1; replace [|w2|] with ([|w2|] * 2 ^0);
     auto with zarith.
-  apply Zmult_le_compat_l; auto with zarith.
+  apply Z.mul_le_mono_nonneg_l; auto with zarith.
   apply Zpower_le_monotone; auto with zarith.
-  rewrite Zpower_0_r; autorewrite with rm10; auto.
+  rewrite Z.pow_0_r; autorewrite with rm10; auto.
   split; auto with zarith.
-  rewrite Hv0 in Hv2; rewrite (Zpos_xO w_digits) in Hv2; auto with zarith.
-  apply Zle_lt_trans with (Zpos w_digits); auto with zarith.
+  rewrite Hv0 in Hv2; rewrite (Pos2Z.inj_xO w_digits) in Hv2; auto with zarith.
+  apply Z.le_lt_trans with (Zpos w_digits); auto with zarith.
   unfold base; apply Zpower2_lt_lin; auto with zarith.
   rewrite spec_w_sub; auto with zarith.
   rewrite Hv6; rewrite spec_w_zdigits; auto with zarith.
@@ -1377,10 +1359,10 @@ intros x; case x; simpl ww_is_even.
   rewrite Zmod_small; auto with zarith.
   split; auto with zarith.
   assert ([[ww_head1 x]]/2 <= Zpos w_digits); auto with zarith.
-  apply Zmult_le_reg_r with 2; auto with zarith.
-  repeat rewrite (fun x => Zmult_comm x 2).
-  rewrite <- Hv0; rewrite <- Zpos_xO; auto with zarith.
-  apply Zle_lt_trans with (Zpos w_digits); auto with zarith.
+  apply Z.mul_le_mono_pos_r with 2; auto with zarith.
+  repeat rewrite (fun x => Z.mul_comm x 2).
+  rewrite <- Hv0; rewrite <- Pos2Z.inj_xO; auto with zarith.
+  apply Z.le_lt_trans with (Zpos w_digits); auto with zarith.
   unfold base; apply Zpower2_lt_lin; auto with zarith.
   Qed.
 
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v
index 3167f4c7..799c4e42 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: DoubleSub.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import ZArith.
@@ -197,9 +195,9 @@ Section DoubleSub.
   Lemma spec_ww_opp_c : forall x, [-[ww_opp_c x]] = -[[x]].
   Proof.
    destruct x as [ |xh xl];simpl. reflexivity.
-   rewrite Zopp_plus_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl)
+   rewrite Z.opp_add_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl)
    as [l|l];intros H;unfold interp_carry in H;rewrite <- H;
-   rewrite Zopp_mult_distr_l.
+   rewrite <- Z.mul_opp_l.
    assert ([|l|] = 0).
     assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega.
    rewrite H0;generalize (spec_opp_c xh);destruct (w_opp_c xh)
@@ -215,13 +213,13 @@ Section DoubleSub.
   Lemma spec_ww_opp : forall x, [[ww_opp x]] = (-[[x]]) mod wwB.
   Proof.
    destruct x as [ |xh xl];simpl. reflexivity.
-   rewrite Zopp_plus_distr;rewrite Zopp_mult_distr_l.
+   rewrite Z.opp_add_distr, <- Z.mul_opp_l.
    generalize (spec_opp_c xl);destruct (w_opp_c xl)
    as [l|l];intros H;unfold interp_carry in H;rewrite <- H;simpl ww_to_Z.
-   rewrite spec_w_0;rewrite Zplus_0_r;rewrite wwB_wBwB.
+   rewrite spec_w_0;rewrite Z.add_0_r;rewrite wwB_wBwB.
    assert ([|l|] = 0).
     assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega.
-   rewrite H0;rewrite Zplus_0_r; rewrite Zpower_2;
+   rewrite H0;rewrite Z.add_0_r; rewrite Z.pow_2_r;
     rewrite Zmult_mod_distr_r;try apply lt_0_wB.
    rewrite spec_opp;trivial.
    apply Zmod_unique with (q:= -1).
@@ -242,7 +240,7 @@ Section DoubleSub.
    simpl ww_to_Z;replace (([|xh|]*wB+[|xl|])-1) with ([|xh|]*wB+([|xl|]-1)).
    2:ring. generalize (spec_pred_c xl);destruct (w_pred_c xl) as [l|l];
    intros H;unfold interp_carry in H;rewrite <- H. simpl;apply spec_w_WW.
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    assert ([|l|] = wB - 1).
      assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega.
    rewrite H0;change ([|xh|] + -1) with ([|xh|] - 1).
@@ -265,7 +263,7 @@ Section DoubleSub.
    generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1;
    unfold interp_carry in H1;rewrite <- H1;unfold interp_carry;
    try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring.
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1).
    generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h];
    intros H1;unfold interp_carry in *;rewrite <- H1;simpl ww_to_Z;
@@ -276,7 +274,7 @@ Section DoubleSub.
      forall x y, [-[ww_sub_carry_c x y]] = [[x]] - [[y]] - 1.
   Proof.
    destruct y as [ |yh yl];simpl.
-   unfold Zminus;simpl;rewrite Zplus_0_r;exact (spec_ww_pred_c x).
+   unfold Z.sub;simpl;rewrite Z.add_0_r;exact (spec_ww_pred_c x).
    destruct x as [ |xh xl].
    unfold interp_carry;rewrite spec_w_WW;simpl ww_to_Z;rewrite wwB_wBwB;
    repeat rewrite spec_opp_carry;ring.
@@ -288,7 +286,7 @@ Section DoubleSub.
    generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1;
    unfold interp_carry in H1;rewrite <- H1;unfold interp_carry;
    try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring.
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1).
    generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h];
    intros H1;unfold interp_carry in *;rewrite <- H1;try rewrite spec_w_WW;
@@ -305,7 +303,7 @@ Section DoubleSub.
    unfold interp_carry in H;rewrite <- H;simpl ww_to_Z.
    rewrite Zmod_small. apply spec_w_WW.
    exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh l)).
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    change ([|xh|] + -1) with ([|xh|] - 1).
    assert ([|l|] = wB - 1).
     assert (H1:= spec_to_Z l);assert (H2:= spec_to_Z xl);omega.
@@ -324,7 +322,7 @@ Section DoubleSub.
    unfold interp_carry in H;rewrite <- H.
    rewrite spec_w_WW;rewrite (mod_wwB w_digits w_to_Z spec_to_Z).
    rewrite spec_sub;trivial.
-   simpl ww_to_Z;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   simpl ww_to_Z;rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub_carry;trivial.
   Qed.
 
@@ -343,7 +341,7 @@ Section DoubleSub.
    generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl)as[l|l];
    intros H;unfold interp_carry in H;rewrite <- H;rewrite spec_w_WW.
    rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub;trivial.
-   rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l.
+   rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r.
    rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub_carry;trivial.
   Qed.
 
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v
index eb1132d4..ce1c0bef 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,14 +8,12 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: DoubleType.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Set Implicit Arguments.
 
 Require Import ZArith.
 Local Open Scope Z_scope.
 
-Definition base digits := Zpower 2 (Zpos digits).
+Definition base digits := Z.pow 2 (Zpos digits).
 
 Section Carry.
 
@@ -55,7 +53,7 @@ Section Zn2Z.
 
 End Zn2Z.
 
-Implicit Arguments W0 [znz].
+Arguments W0 [znz].
 
 (** From a cyclic representation [w], we iterate the [zn2z] construct
     [n] times, gaining the type of binary trees of depth at most [n],
diff --git a/theories/Numbers/Cyclic/Int31/Cyclic31.v b/theories/Numbers/Cyclic/Int31/Cyclic31.v
index 36a1157d..385217d0 100644
--- a/theories/Numbers/Cyclic/Int31/Cyclic31.v
+++ b/theories/Numbers/Cyclic/Int31/Cyclic31.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Cyclic31.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** * Int31 numbers defines indeed a cyclic structure : Z/(2^31)Z *)
 
 (**
@@ -370,7 +368,7 @@ Section Basics.
  (** Variant of [phi] via [recrbis] *)
 
  Let Phi := fun b (_:int31) =>
-       match b with D0 => Zdouble | D1 => Zdouble_plus_one end.
+       match b with D0 => Z.double | D1 => Z.succ_double end.
 
  Definition phibis_aux n x := recrbis_aux n _ Z0 Phi x.
 
@@ -383,7 +381,7 @@ Section Basics.
  (** Recursive equations satisfied by [phi] *)
 
  Lemma phi_eqn1 : forall x, firstr x = D0 ->
-  phi x = Zdouble (phi (shiftr x)).
+  phi x = Z.double (phi (shiftr x)).
  Proof.
  intros.
  case_eq (iszero x); intros.
@@ -393,7 +391,7 @@ Section Basics.
  Qed.
 
  Lemma phi_eqn2 : forall x, firstr x = D1 ->
-  phi x = Zdouble_plus_one (phi (shiftr x)).
+  phi x = Z.succ_double (phi (shiftr x)).
  Proof.
  intros.
  case_eq (iszero x); intros.
@@ -403,7 +401,7 @@ Section Basics.
  Qed.
 
  Lemma phi_twice_firstl : forall x, firstl x = D0 ->
-  phi (twice x) = Zdouble (phi x).
+  phi (twice x) = Z.double (phi x).
  Proof.
  intros.
  rewrite phi_eqn1; auto; [ | destruct x; auto ].
@@ -412,7 +410,7 @@ Section Basics.
  Qed.
 
  Lemma phi_twice_plus_one_firstl : forall x, firstl x = D0 ->
-  phi (twice_plus_one x) = Zdouble_plus_one (phi x).
+  phi (twice_plus_one x) = Z.succ_double (phi x).
  Proof.
  intros.
  rewrite phi_eqn2; auto; [ | destruct x; auto ].
@@ -432,13 +430,13 @@ Section Basics.
  unfold phibis_aux, recrbis_aux; fold recrbis_aux;
   fold (phibis_aux n (shiftr x)).
  destruct (firstr x).
- specialize IHn with (shiftr x); rewrite Zdouble_mult; omega.
- specialize IHn with (shiftr x); rewrite Zdouble_plus_one_mult; omega.
+ specialize IHn with (shiftr x); rewrite Z.double_spec; omega.
+ specialize IHn with (shiftr x); rewrite Z.succ_double_spec; omega.
  Qed.
 
  Lemma phibis_aux_bounded :
   forall n x, n <= size ->
-  (phibis_aux n (nshiftr (size-n) x) < 2 ^ (Z_of_nat n))%Z.
+  (phibis_aux n (nshiftr (size-n) x) < 2 ^ (Z.of_nat n))%Z.
  Proof.
  induction n.
  simpl; unfold phibis_aux; simpl; auto with zarith.
@@ -452,13 +450,13 @@ Section Basics.
  assert (H1 : n <= size) by omega.
  specialize (IHn x H1).
  set (y:=phibis_aux n (nshiftr (size - n) x)) in *.
- rewrite inj_S, Zpower_Zsucc; auto with zarith.
+ rewrite Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith.
  case_eq (firstr (nshiftr (size - S n) x)); intros.
- rewrite Zdouble_mult; auto with zarith.
- rewrite Zdouble_plus_one_mult; auto with zarith.
+ rewrite Z.double_spec; auto with zarith.
+ rewrite Z.succ_double_spec; auto with zarith.
  Qed.
 
- Lemma phi_bounded  : forall x, (0 <= phi x < 2 ^ (Z_of_nat size))%Z.
+ Lemma phi_bounded  : forall x, (0 <= phi x < 2 ^ (Z.of_nat size))%Z.
  Proof.
  intros.
  rewrite <- phibis_aux_equiv.
@@ -470,32 +468,32 @@ Section Basics.
 
  Lemma phibis_aux_lowerbound :
   forall n x, firstr (nshiftr n x) = D1 ->
-  (2 ^ Z_of_nat n <= phibis_aux (S n) x)%Z.
+  (2 ^ Z.of_nat n <= phibis_aux (S n) x)%Z.
  Proof.
  induction n.
  intros.
  unfold nshiftr in H; simpl in *.
  unfold phibis_aux, recrbis_aux.
- rewrite H, Zdouble_plus_one_mult; omega.
+ rewrite H, Z.succ_double_spec; omega.
 
  intros.
  remember (S n) as m.
  unfold phibis_aux, recrbis_aux; fold recrbis_aux;
   fold (phibis_aux m (shiftr x)).
  subst m.
- rewrite inj_S, Zpower_Zsucc; auto with zarith.
- assert (2^(Z_of_nat n) <= phibis_aux (S n) (shiftr x))%Z.
+ rewrite Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith.
+ assert (2^(Z.of_nat n) <= phibis_aux (S n) (shiftr x))%Z.
   apply IHn.
   rewrite <- nshiftr_S_tail; auto.
  destruct (firstr x).
- change (Zdouble (phibis_aux (S n) (shiftr x))) with
+ change (Z.double (phibis_aux (S n) (shiftr x))) with
         (2*(phibis_aux (S n) (shiftr x)))%Z.
  omega.
- rewrite Zdouble_plus_one_mult; omega.
+ rewrite Z.succ_double_spec; omega.
  Qed.
 
  Lemma phi_lowerbound :
-  forall x, firstl x = D1 -> (2^(Z_of_nat (pred size)) <= phi x)%Z.
+  forall x, firstl x = D1 -> (2^(Z.of_nat (pred size)) <= phi x)%Z.
  Proof.
  intros.
  generalize (phibis_aux_lowerbound (pred size) x).
@@ -778,7 +776,7 @@ Section Basics.
  (** First, recursive equations *)
 
  Lemma phi_inv_double_plus_one : forall z,
-   phi_inv (Zdouble_plus_one z) = twice_plus_one (phi_inv z).
+   phi_inv (Z.succ_double z) = twice_plus_one (phi_inv z).
  Proof.
  destruct z; simpl; auto.
  induction p; simpl.
@@ -790,20 +788,20 @@ Section Basics.
  Qed.
 
  Lemma phi_inv_double : forall z,
-   phi_inv (Zdouble z) = twice (phi_inv z).
+   phi_inv (Z.double z) = twice (phi_inv z).
  Proof.
  destruct z; simpl; auto.
  rewrite incr_twice_plus_one; auto.
  Qed.
 
  Lemma phi_inv_incr : forall z,
-  phi_inv (Zsucc z) = incr (phi_inv z).
+  phi_inv (Z.succ z) = incr (phi_inv z).
  Proof.
  destruct z.
  simpl; auto.
  simpl; auto.
  induction p; simpl; auto.
- rewrite Pplus_one_succ_r, IHp, incr_twice_plus_one; auto.
+ rewrite <- Pos.add_1_r, IHp, incr_twice_plus_one; auto.
  rewrite incr_twice; auto.
  simpl; auto.
  destruct p; simpl; auto.
@@ -907,30 +905,32 @@ Section Basics.
  apply nshiftr_n_0.
  Qed.
 
- Lemma p2ibis_spec : forall n p, n<=size ->
-    Zpos p = ((Z_of_N (fst (p2ibis n p)))*2^(Z_of_nat n) +
-             phi (snd (p2ibis n p)))%Z.
+ Local Open Scope Z_scope.
+
+ Lemma p2ibis_spec : forall n p, (n<=size)%nat ->
+    Zpos p = (Z.of_N (fst (p2ibis n p)))*2^(Z.of_nat n) +
+             phi (snd (p2ibis n p)).
  Proof.
  induction n; intros.
- simpl; rewrite Pmult_1_r; auto.
- replace (2^(Z_of_nat (S n)))%Z with (2*2^(Z_of_nat n))%Z by
-  (rewrite <- Zpower_Zsucc, <- Zpos_P_of_succ_nat;
+ simpl; rewrite Pos.mul_1_r; auto.
+ replace (2^(Z.of_nat (S n)))%Z with (2*2^(Z.of_nat n))%Z by
+  (rewrite <- Z.pow_succ_r, <- Zpos_P_of_succ_nat;
    auto with zarith).
- rewrite (Zmult_comm 2).
- assert (n<=size) by omega.
+ rewrite (Z.mul_comm 2).
+ assert (n<=size)%nat by omega.
  destruct p; simpl; [ | | auto];
   specialize (IHn p H0);
   generalize (p2ibis_bounded n p);
   destruct (p2ibis n p) as (r,i); simpl in *; intros.
 
  change (Zpos p~1) with (2*Zpos p + 1)%Z.
- rewrite phi_twice_plus_one_firstl, Zdouble_plus_one_mult.
+ rewrite phi_twice_plus_one_firstl, Z.succ_double_spec.
  rewrite IHn; ring.
  apply (nshiftr_0_firstl n); auto; try omega.
 
  change (Zpos p~0) with (2*Zpos p)%Z.
  rewrite phi_twice_firstl.
- change (Zdouble (phi i)) with (2*(phi i))%Z.
+ change (Z.double (phi i)) with (2*(phi i))%Z.
  rewrite IHn; ring.
  apply (nshiftr_0_firstl n); auto; try omega.
  Qed.
@@ -956,12 +956,12 @@ Section Basics.
      for the positive case. *)
 
  Lemma phi_phi_inv_positive : forall p,
-  phi (phi_inv_positive p) = (Zpos p) mod (2^(Z_of_nat size)).
+  phi (phi_inv_positive p) = (Zpos p) mod (2^(Z.of_nat size)).
  Proof.
  intros.
  replace (phi_inv_positive p) with (snd (p2ibis size p)).
  rewrite (p2ibis_spec size p) by auto.
- rewrite Zplus_comm, Z_mod_plus.
+ rewrite Z.add_comm, Z_mod_plus.
  symmetry; apply Zmod_small.
  apply phi_bounded.
  auto with zarith.
@@ -973,20 +973,21 @@ Section Basics.
  (** Moreover, [p2ibis] is also related with [p2i] and hence with
     [positive_to_int31]. *)
 
- Lemma double_twice_firstl : forall x, firstl x = D0 -> Twon*x = twice x.
+ Lemma double_twice_firstl : forall x, firstl x = D0 ->
+  (Twon*x = twice x)%int31.
  Proof.
  intros.
  unfold mul31.
- rewrite <- Zdouble_mult, <- phi_twice_firstl, phi_inv_phi; auto.
+ rewrite <- Z.double_spec, <- phi_twice_firstl, phi_inv_phi; auto.
  Qed.
 
  Lemma double_twice_plus_one_firstl : forall x, firstl x = D0 ->
-  Twon*x+In = twice_plus_one x.
+  (Twon*x+In = twice_plus_one x)%int31.
  Proof.
  intros.
  rewrite double_twice_firstl; auto.
  unfold add31.
- rewrite phi_twice_firstl, <- Zdouble_plus_one_mult,
+ rewrite phi_twice_firstl, <- Z.succ_double_spec,
    <- phi_twice_plus_one_firstl, phi_inv_phi; auto.
  Qed.
 
@@ -1015,8 +1016,8 @@ Section Basics.
  Qed.
 
  Lemma positive_to_int31_spec : forall p,
-    Zpos p = ((Z_of_N (fst (positive_to_int31 p)))*2^(Z_of_nat size) +
-               phi (snd (positive_to_int31 p)))%Z.
+    Zpos p = (Z.of_N (fst (positive_to_int31 p)))*2^(Z.of_nat size) +
+               phi (snd (positive_to_int31 p)).
  Proof.
  unfold positive_to_int31.
  intros; rewrite p2i_p2ibis; auto.
@@ -1028,43 +1029,43 @@ Section Basics.
      [phi o twice] and so one. *)
 
  Lemma phi_twice : forall x,
-   phi (twice x) = (Zdouble (phi x)) mod 2^(Z_of_nat size).
+   phi (twice x) = (Z.double (phi x)) mod 2^(Z.of_nat size).
  Proof.
  intros.
  pattern x at 1; rewrite <- (phi_inv_phi x).
  rewrite <- phi_inv_double.
- assert (0 <= Zdouble (phi x))%Z.
-  rewrite Zdouble_mult; generalize (phi_bounded x); omega.
- destruct (Zdouble (phi x)).
+ assert (0 <= Z.double (phi x)).
+  rewrite Z.double_spec; generalize (phi_bounded x); omega.
+ destruct (Z.double (phi x)).
  simpl; auto.
  apply phi_phi_inv_positive.
  compute in H; elim H; auto.
  Qed.
 
  Lemma phi_twice_plus_one : forall x,
-   phi (twice_plus_one x) = (Zdouble_plus_one (phi x)) mod 2^(Z_of_nat size).
+   phi (twice_plus_one x) = (Z.succ_double (phi x)) mod 2^(Z.of_nat size).
  Proof.
  intros.
  pattern x at 1; rewrite <- (phi_inv_phi x).
  rewrite <- phi_inv_double_plus_one.
- assert (0 <= Zdouble_plus_one (phi x))%Z.
-  rewrite Zdouble_plus_one_mult; generalize (phi_bounded x); omega.
- destruct (Zdouble_plus_one (phi x)).
+ assert (0 <= Z.succ_double (phi x)).
+  rewrite Z.succ_double_spec; generalize (phi_bounded x); omega.
+ destruct (Z.succ_double (phi x)).
  simpl; auto.
  apply phi_phi_inv_positive.
  compute in H; elim H; auto.
  Qed.
 
  Lemma phi_incr : forall x,
-   phi (incr x) = (Zsucc (phi x)) mod 2^(Z_of_nat size).
+   phi (incr x) = (Z.succ (phi x)) mod 2^(Z.of_nat size).
  Proof.
  intros.
  pattern x at 1; rewrite <- (phi_inv_phi x).
  rewrite <- phi_inv_incr.
- assert (0 <= Zsucc (phi x))%Z.
-  change (Zsucc (phi x)) with ((phi x)+1)%Z;
+ assert (0 <= Z.succ (phi x)).
+  change (Z.succ (phi x)) with ((phi x)+1)%Z;
    generalize (phi_bounded x); omega.
- destruct (Zsucc (phi x)).
+ destruct (Z.succ (phi x)).
  simpl; auto.
  apply phi_phi_inv_positive.
  compute in H; elim H; auto.
@@ -1074,7 +1075,7 @@ Section Basics.
     in the negative case *)
 
  Lemma phi_phi_inv_negative :
-  forall p, phi (incr (complement_negative p)) = (Zneg p) mod 2^(Z_of_nat size).
+  forall p, phi (incr (complement_negative p)) = (Zneg p) mod 2^(Z.of_nat size).
  Proof.
  induction p.
 
@@ -1082,21 +1083,21 @@ Section Basics.
  rewrite phi_incr in IHp.
  rewrite incr_twice, phi_twice_plus_one.
  remember (phi (complement_negative p)) as q.
- rewrite Zdouble_plus_one_mult.
- replace (2*q+1)%Z with (2*(Zsucc q)-1)%Z by omega.
+ rewrite Z.succ_double_spec.
+ replace (2*q+1) with (2*(Z.succ q)-1) by omega.
  rewrite <- Zminus_mod_idemp_l, <- Zmult_mod_idemp_r, IHp.
  rewrite Zmult_mod_idemp_r, Zminus_mod_idemp_l; auto with zarith.
 
  simpl complement_negative.
  rewrite incr_twice_plus_one, phi_twice.
  remember (phi (incr (complement_negative p))) as q.
- rewrite Zdouble_mult, IHp, Zmult_mod_idemp_r; auto with zarith.
+ rewrite Z.double_spec, IHp, Zmult_mod_idemp_r; auto with zarith.
 
  simpl; auto.
  Qed.
 
  Lemma phi_phi_inv :
-  forall z, phi (phi_inv z) = z mod 2 ^ (Z_of_nat size).
+  forall z, phi (phi_inv z) = z mod 2 ^ (Z.of_nat size).
  Proof.
  destruct z.
  simpl; auto.
@@ -1106,87 +1107,67 @@ Section Basics.
 
 End Basics.
 
-
-Section Int31_Op.
-
-(** Nullity test *)
-Let w_iszero i := match i ?= 0 with Eq => true | _ => false end.
-
-(** Modulo [2^p] *)
-Let w_pos_mod p i :=
-  match compare31 p 31 with
+Instance int31_ops : ZnZ.Ops int31 :=
+{
+ digits      := 31%positive; (* number of digits *)
+ zdigits     := 31; (* number of digits *)
+ to_Z        := phi; (* conversion to Z *)
+ of_pos      := positive_to_int31; (* positive -> N*int31 :  p => N,i
+                                      where p = N*2^31+phi i *)
+ head0       := head031;  (* number of head 0 *)
+ tail0       := tail031;  (* number of tail 0 *)
+ zero        := 0;
+ one         := 1;
+ minus_one   := Tn; (* 2^31 - 1 *)
+ compare     := compare31;
+ eq0         := fun i => match i ?= 0 with Eq => true | _ => false end;
+ opp_c       := fun i => 0 -c i;
+ opp         := opp31;
+ opp_carry   := fun i => 0-i-1;
+ succ_c      := fun i => i +c 1;
+ add_c       := add31c;
+ add_carry_c := add31carryc;
+ succ        := fun i => i + 1;
+ add         := add31;
+ add_carry   := fun i j => i + j + 1;
+ pred_c      := fun i => i -c 1;
+ sub_c       := sub31c;
+ sub_carry_c := sub31carryc;
+ pred        := fun i => i - 1;
+ sub         := sub31;
+ sub_carry   := fun i j => i - j - 1;
+ mul_c       := mul31c;
+ mul         := mul31;
+ square_c    := fun x => x *c x;
+ div21       := div3121;
+ div_gt      := div31; (* this is supposed to be the special case of
+                         division a/b where a > b *)
+ div         := div31;
+ modulo_gt   := fun i j => let (_,r) := i/j in r;
+ modulo      := fun i j => let (_,r) := i/j in r;
+ gcd_gt      := gcd31;
+ gcd         := gcd31;
+ add_mul_div := addmuldiv31;
+ pos_mod     := (* modulo 2^p *)
+  fun p i =>
+  match p ?= 31 with
     | Lt => addmuldiv31 p 0 (addmuldiv31 (31-p) i 0)
     | _ => i
-  end.
+  end;
+ is_even      :=
+  fun i => let (_,r) := i/2 in
+  match r ?= 0 with Eq => true | _ => false end;
+ sqrt2       := sqrt312;
+ sqrt        := sqrt31
+}.
 
-(** Parity test *)
-Let w_iseven i :=
- let (_,r) := i/2 in
- match r ?= 0 with Eq => true | _ => false end.
-
-Definition int31_op := (mk_znz_op
- 31%positive (* number of digits *)
- 31 (* number of digits *)
- phi (* conversion to Z *)
- positive_to_int31 (* positive -> N*int31 :  p => N,i where p = N*2^31+phi i *)
- head031  (* number of head 0 *)
- tail031  (* number of tail 0 *)
- (* Basic constructors *)
- 0
- 1
- Tn (* 2^31 - 1 *)
- (* Comparison *)
- compare31
- w_iszero
- (* Basic arithmetic operations *)
- (fun i => 0 -c i)
- opp31
- (fun i => 0-i-1)
- (fun i => i +c 1)
- add31c
- add31carryc
- (fun i => i + 1)
- add31
- (fun i j => i + j + 1)
- (fun i => i -c 1)
- sub31c
- sub31carryc
- (fun i => i - 1)
- sub31
- (fun i j => i - j - 1)
- mul31c
- mul31
- (fun x => x *c x)
- (* special (euclidian) division operations *)
- div3121
- div31 (* this is supposed to be the special case of division a/b where a > b *)
- div31
- (* euclidian division remainder *)
- (* again special case for a > b *)
- (fun i j => let (_,r) := i/j in r)
- (fun i j => let (_,r) := i/j in r)
- gcd31 (*gcd_gt*)
- gcd31 (*gcd*)
- (* shift operations *)
- addmuldiv31 (*add_mul_div  *)
- (* modulo 2^p *)
- w_pos_mod
- (* is i even ? *)
- w_iseven
- (* square root operations *)
- sqrt312 (* sqrt2 *)
- sqrt31 (* sqrt *)
-).
-
-End Int31_Op.
-
-Section Int31_Spec.
+Section Int31_Specs.
 
  Local Open Scope Z_scope.
 
  Notation "[| x |]" := (phi x)  (at level 0, x at level 99).
 
- Local Notation wB := (2 ^ (Z_of_nat size)).
+ Local Notation wB := (2 ^ (Z.of_nat size)).
 
  Lemma wB_pos : wB > 0.
  Proof.
@@ -1222,22 +1203,14 @@ Section Int31_Spec.
   reflexivity.
  Qed.
 
- Lemma spec_Bm1 : [| Tn |] = wB - 1.
+ Lemma spec_m1 : [| Tn |] = wB - 1.
  Proof.
   reflexivity.
  Qed.
 
  Lemma spec_compare : forall x y,
-   match (x ?= y)%int31 with
-     | Eq => [|x|] = [|y|]
-     | Lt => [|x|] < [|y|]
-     | Gt => [|x|] > [|y|]
-   end.
- Proof.
- clear; unfold compare31; simpl; intros.
- case_eq ([|x|] ?= [|y|]); auto.
- intros; apply Zcompare_Eq_eq; auto.
- Qed.
+   (x ?= y)%int31 = ([|x|] ?= [|y|]).
+ Proof. reflexivity. Qed.
 
  (** Addition *)
 
@@ -1248,14 +1221,14 @@ Section Int31_Spec.
  set (X:=[|x|]) in *; set (Y:=[|y|]) in *; clearbody X Y.
 
  assert ((X+Y) mod wB ?= X+Y <> Eq -> [+|C1 (phi_inv (X+Y))|] = X+Y).
-  unfold interp_carry; rewrite phi_phi_inv, Zcompare_Eq_iff_eq; intros.
+  unfold interp_carry; rewrite phi_phi_inv, Z.compare_eq_iff; intros.
   destruct (Z_lt_le_dec (X+Y) wB).
   contradict H1; auto using Zmod_small with zarith.
   rewrite <- (Z_mod_plus_full (X+Y) (-1) wB).
   rewrite Zmod_small; romega.
 
- generalize (Zcompare_Eq_eq ((X+Y) mod wB) (X+Y)); intros Heq.
- destruct Zcompare; intros;
+ generalize (Z.compare_eq ((X+Y) mod wB) (X+Y)); intros Heq.
+ destruct Z.compare; intros;
   [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1].
  Qed.
 
@@ -1272,14 +1245,14 @@ Section Int31_Spec.
  set (X:=[|x|]) in *; set (Y:=[|y|]) in *; clearbody X Y.
 
  assert ((X+Y+1) mod wB ?= X+Y+1 <> Eq -> [+|C1 (phi_inv (X+Y+1))|] = X+Y+1).
-  unfold interp_carry; rewrite phi_phi_inv, Zcompare_Eq_iff_eq; intros.
+  unfold interp_carry; rewrite phi_phi_inv, Z.compare_eq_iff; intros.
   destruct (Z_lt_le_dec (X+Y+1) wB).
   contradict H1; auto using Zmod_small with zarith.
   rewrite <- (Z_mod_plus_full (X+Y+1) (-1) wB).
   rewrite Zmod_small; romega.
 
- generalize (Zcompare_Eq_eq ((X+Y+1) mod wB) (X+Y+1)); intros Heq.
- destruct Zcompare; intros;
+ generalize (Z.compare_eq ((X+Y+1) mod wB) (X+Y+1)); intros Heq.
+ destruct Z.compare; intros;
   [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1].
  Qed.
 
@@ -1311,14 +1284,14 @@ Section Int31_Spec.
  set (X:=[|x|]) in *; set (Y:=[|y|]) in *; clearbody X Y.
 
  assert ((X-Y) mod wB ?= X-Y <> Eq -> [-|C1 (phi_inv (X-Y))|] = X-Y).
-  unfold interp_carry; rewrite phi_phi_inv, Zcompare_Eq_iff_eq; intros.
+  unfold interp_carry; rewrite phi_phi_inv, Z.compare_eq_iff; intros.
   destruct (Z_lt_le_dec (X-Y) 0).
   rewrite <- (Z_mod_plus_full (X-Y) 1 wB).
   rewrite Zmod_small; romega.
   contradict H1; apply Zmod_small; romega.
 
- generalize (Zcompare_Eq_eq ((X-Y) mod wB) (X-Y)); intros Heq.
- destruct Zcompare; intros;
+ generalize (Z.compare_eq ((X-Y) mod wB) (X-Y)); intros Heq.
+ destruct Z.compare; intros;
   [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1].
  Qed.
 
@@ -1330,14 +1303,14 @@ Section Int31_Spec.
  set (X:=[|x|]) in *; set (Y:=[|y|]) in *; clearbody X Y.
 
  assert ((X-Y-1) mod wB ?= X-Y-1 <> Eq -> [-|C1 (phi_inv (X-Y-1))|] = X-Y-1).
-  unfold interp_carry; rewrite phi_phi_inv, Zcompare_Eq_iff_eq; intros.
+  unfold interp_carry; rewrite phi_phi_inv, Z.compare_eq_iff; intros.
   destruct (Z_lt_le_dec (X-Y-1) 0).
   rewrite <- (Z_mod_plus_full (X-Y-1) 1 wB).
   rewrite Zmod_small; romega.
   contradict H1; apply Zmod_small; romega.
 
- generalize (Zcompare_Eq_eq ((X-Y-1) mod wB) (X-Y-1)); intros Heq.
- destruct Zcompare; intros;
+ generalize (Z.compare_eq ((X-Y-1) mod wB) (X-Y-1)); intros Heq.
+ destruct Z.compare; intros;
   [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1].
  Qed.
 
@@ -1413,7 +1386,7 @@ Section Int31_Spec.
  apply Zmod_small.
  generalize (phi_bounded x)(phi_bounded y); intros.
  change (wB^2) with (wB * wB).
- auto using Zmult_lt_compat with zarith.
+ auto using Z.mul_lt_mono_nonneg with zarith.
  Qed.
 
  Lemma spec_mul : forall x y, [|x*y|] = ([|x|] * [|y|]) mod wB.
@@ -1439,29 +1412,26 @@ Section Int31_Spec.
  generalize (phi_bounded a1)(phi_bounded a2)(phi_bounded b); intros.
  assert ([|b|]>0) by (auto with zarith).
  generalize (Z_div_mod (phi2 a1 a2) [|b|] H4) (Z_div_pos (phi2 a1 a2) [|b|] H4).
- unfold Zdiv; destruct (Zdiv_eucl (phi2 a1 a2) [|b|]); simpl.
+ unfold Z.div; destruct (Z.div_eucl (phi2 a1 a2) [|b|]); simpl.
  rewrite ?phi_phi_inv.
  destruct 1; intros.
  unfold phi2 in *.
  change base with wB; change base with wB in H5.
- change (Zpower_pos 2 31) with wB; change (Zpower_pos 2 31) with wB in H.
- rewrite H5, Zmult_comm.
+ change (Z.pow_pos 2 31) with wB; change (Z.pow_pos 2 31) with wB in H.
+ rewrite H5, Z.mul_comm.
  replace (z0 mod wB) with z0 by (symmetry; apply Zmod_small; omega).
  replace (z mod wB) with z; auto with zarith.
   symmetry; apply Zmod_small.
   split.
   apply H7; change base with wB; auto with zarith.
-  apply Zmult_gt_0_lt_reg_r with [|b|].
-  omega.
-  rewrite Zmult_comm.
-  apply Zle_lt_trans with ([|b|]*z+z0).
-  omega.
+  apply Z.mul_lt_mono_pos_r with [|b|]; [omega| ].
+  rewrite Z.mul_comm.
+  apply Z.le_lt_trans with ([|b|]*z+z0); [omega| ].
   rewrite <- H5.
-  apply Zle_lt_trans with ([|a1|]*wB+(wB-1)).
-  omega.
+  apply Z.le_lt_trans with ([|a1|]*wB+(wB-1)); [omega | ].
   replace ([|a1|]*wB+(wB-1)) with (wB*([|a1|]+1)-1) by ring.
   assert (wB*([|a1|]+1) <= wB*[|b|]); try omega.
-  apply Zmult_le_compat; omega.
+  apply Z.mul_le_mono_nonneg; omega.
  Qed.
 
  Lemma spec_div : forall a b, 0 < [|b|] ->
@@ -1472,20 +1442,20 @@ Section Int31_Spec.
  unfold div31; intros.
  assert ([|b|]>0) by (auto with zarith).
  generalize (Z_div_mod [|a|] [|b|] H0) (Z_div_pos [|a|] [|b|] H0).
- unfold Zdiv; destruct (Zdiv_eucl [|a|] [|b|]); simpl.
+ unfold Z.div; destruct (Z.div_eucl [|a|] [|b|]); simpl.
  rewrite ?phi_phi_inv.
  destruct 1; intros.
- rewrite H1, Zmult_comm.
+ rewrite H1, Z.mul_comm.
  generalize (phi_bounded a)(phi_bounded b); intros.
  replace (z0 mod wB) with z0 by (symmetry; apply Zmod_small; omega).
  replace (z mod wB) with z; auto with zarith.
   symmetry; apply Zmod_small.
   split; auto with zarith.
-  apply Zle_lt_trans with [|a|]; auto with zarith.
+  apply Z.le_lt_trans with [|a|]; auto with zarith.
   rewrite H1.
-  apply Zle_trans with ([|b|]*z); try omega.
-  rewrite <- (Zmult_1_l z) at 1.
-  apply Zmult_le_compat; auto with zarith.
+  apply Z.le_trans with ([|b|]*z); try omega.
+  rewrite <- (Z.mul_1_l z) at 1.
+  apply Z.mul_le_mono_nonneg; auto with zarith.
  Qed.
 
  Lemma spec_mod :  forall a b, 0 < [|b|] ->
@@ -1493,9 +1463,9 @@ Section Int31_Spec.
  Proof.
  unfold div31; intros.
  assert ([|b|]>0) by (auto with zarith).
- unfold Zmod.
+ unfold Z.modulo.
  generalize (Z_div_mod [|a|] [|b|] H0).
- destruct (Zdiv_eucl [|a|] [|b|]); simpl.
+ destruct (Z.div_eucl [|a|] [|b|]); simpl.
  rewrite ?phi_phi_inv.
  destruct 1; intros.
  generalize (phi_bounded b); intros.
@@ -1533,12 +1503,12 @@ Section Int31_Spec.
  destruct [|b|].
  unfold size; auto with zarith.
  intros (_,H).
- cut (Psize p <= size)%nat; [ omega | rewrite <- Zpower2_Psize; auto].
+ cut (Pos.size_nat p <= size)%nat; [ omega | rewrite <- Zpower2_Psize; auto].
  intros (H,_); compute in H; elim H; auto.
  Qed.
 
  Lemma iter_int31_iter_nat : forall A f i a,
-  iter_int31 i A f a = iter_nat (Zabs_nat [|i|]) A f a.
+  iter_int31 i A f a = iter_nat (Z.abs_nat [|i|]) A f a.
  Proof.
  intros.
  unfold iter_int31.
@@ -1555,15 +1525,15 @@ Section Int31_Spec.
   rewrite <- iter_nat_plus.
 
  f_equal.
- rewrite Zdouble_mult, Zmult_comm, <- Zplus_diag_eq_mult_2.
- symmetry; apply Zabs_nat_Zplus; auto with zarith.
+ rewrite Z.double_spec, <- Z.add_diag.
+ symmetry; apply Zabs2Nat.inj_add; auto with zarith.
 
- change (iter_nat (S (Zabs_nat z + Zabs_nat z)) A f a =
-         iter_nat (Zabs_nat (Zdouble_plus_one z)) A f a); f_equal.
- rewrite Zdouble_plus_one_mult, Zmult_comm, <- Zplus_diag_eq_mult_2.
- rewrite Zabs_nat_Zplus; auto with zarith.
- rewrite Zabs_nat_Zplus; auto with zarith.
- change (Zabs_nat 1) with 1%nat; omega.
+ change (iter_nat (S (Z.abs_nat z + Z.abs_nat z)) A f a =
+         iter_nat (Z.abs_nat (Z.succ_double z)) A f a); f_equal.
+ rewrite Z.succ_double_spec, <- Z.add_diag.
+ rewrite Zabs2Nat.inj_add; auto with zarith.
+ rewrite Zabs2Nat.inj_add; auto with zarith.
+ change (Z.abs_nat 1) with 1%nat; omega.
  Qed.
 
  Fixpoint addmuldiv31_alt n i j :=
@@ -1573,12 +1543,12 @@ Section Int31_Spec.
   end.
 
  Lemma addmuldiv31_equiv : forall p x y,
-  addmuldiv31 p x y = addmuldiv31_alt (Zabs_nat [|p|]) x y.
+  addmuldiv31 p x y = addmuldiv31_alt (Z.abs_nat [|p|]) x y.
  Proof.
  intros.
  unfold addmuldiv31.
  rewrite iter_int31_iter_nat.
- set (n:=Zabs_nat [|p|]); clearbody n; clear p.
+ set (n:=Z.abs_nat [|p|]); clearbody n; clear p.
  revert x y; induction n.
  simpl; auto.
  intros.
@@ -1593,21 +1563,21 @@ Section Int31_Spec.
  Proof.
  intros.
  rewrite addmuldiv31_equiv.
- assert ([|p|] = Z_of_nat (Zabs_nat [|p|])).
-  rewrite inj_Zabs_nat; symmetry; apply Zabs_eq.
+ assert ([|p|] = Z.of_nat (Z.abs_nat [|p|])).
+  rewrite Zabs2Nat.id_abs; symmetry; apply Z.abs_eq.
   destruct (phi_bounded p); auto.
- rewrite H0; rewrite H0 in H; clear H0; rewrite Zabs_nat_Z_of_nat.
- set (n := Zabs_nat [|p|]) in *; clearbody n.
+ rewrite H0; rewrite H0 in H; clear H0; rewrite Zabs2Nat.id.
+ set (n := Z.abs_nat [|p|]) in *; clearbody n.
  assert (n <= 31)%nat.
-  rewrite inj_le_iff; auto with zarith.
+  rewrite Nat2Z.inj_le; auto with zarith.
  clear p H; revert x y.
 
  induction n.
  simpl; intros.
- change (Zpower_pos 2 31) with (2^31).
- rewrite Zmult_1_r.
+ change (Z.pow_pos 2 31) with (2^31).
+ rewrite Z.mul_1_r.
  replace ([|y|] / 2^31) with 0.
- rewrite Zplus_0_r.
+ rewrite Z.add_0_r.
  symmetry; apply Zmod_small; apply phi_bounded.
  symmetry; apply Zdiv_small; apply phi_bounded.
 
@@ -1615,76 +1585,74 @@ Section Int31_Spec.
  rewrite IHn; [ | omega ].
  case_eq (firstl y); intros.
 
- rewrite phi_twice, Zdouble_mult.
+ rewrite phi_twice, Z.double_spec.
  rewrite phi_twice_firstl; auto.
- change (Zdouble [|y|]) with (2*[|y|]).
- rewrite inj_S, Zpower_Zsucc; auto with zarith.
+ change (Z.double [|y|]) with (2*[|y|]).
+ rewrite Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith.
  rewrite Zplus_mod; rewrite Zmult_mod_idemp_l; rewrite <- Zplus_mod.
  f_equal.
- apply Zplus_eq_compat.
+ f_equal.
  ring.
- replace (31-Z_of_nat n) with (Zsucc(31-Zsucc(Z_of_nat n))) by ring.
- rewrite Zpower_Zsucc, <- Zdiv_Zdiv; auto with zarith.
- rewrite Zmult_comm, Z_div_mult; auto with zarith.
+ replace (31-Z.of_nat n) with (Z.succ(31-Z.succ(Z.of_nat n))) by ring.
+ rewrite Z.pow_succ_r, <- Zdiv_Zdiv; auto with zarith.
+ rewrite Z.mul_comm, Z_div_mult; auto with zarith.
 
- rewrite phi_twice_plus_one, Zdouble_plus_one_mult.
+ rewrite phi_twice_plus_one, Z.succ_double_spec.
  rewrite phi_twice; auto.
- change (Zdouble [|y|]) with (2*[|y|]).
- rewrite inj_S, Zpower_Zsucc; auto with zarith.
+ change (Z.double [|y|]) with (2*[|y|]).
+ rewrite Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith.
  rewrite Zplus_mod; rewrite Zmult_mod_idemp_l; rewrite <- Zplus_mod.
- rewrite Zmult_plus_distr_l, Zmult_1_l, <- Zplus_assoc.
+ rewrite Z.mul_add_distr_r, Z.mul_1_l, <- Z.add_assoc.
+ f_equal.
  f_equal.
- apply Zplus_eq_compat.
  ring.
  assert ((2*[|y|]) mod wB = 2*[|y|] - wB).
   clear - H. symmetry. apply Zmod_unique with 1; [ | ring ].
   generalize (phi_lowerbound  _ H) (phi_bounded y).
-  set (wB' := 2^Z_of_nat (pred size)).
+  set (wB' := 2^Z.of_nat (pred size)).
   replace wB with (2*wB'); [ omega | ].
-  unfold wB'. rewrite <- Zpower_Zsucc, <- inj_S by (auto with zarith).
+  unfold wB'. rewrite <- Z.pow_succ_r, <- Nat2Z.inj_succ by (auto with zarith).
   f_equal.
  rewrite H1.
- replace wB with (2^(Z_of_nat n)*2^(31-Z_of_nat n)) by
+ replace wB with (2^(Z.of_nat n)*2^(31-Z.of_nat n)) by
   (rewrite <- Zpower_exp; auto with zarith; f_equal; unfold size; ring).
- unfold Zminus; rewrite Zopp_mult_distr_l.
+ unfold Z.sub; rewrite <- Z.mul_opp_l.
  rewrite Z_div_plus; auto with zarith.
  ring_simplify.
- replace (31+-Z_of_nat n) with (Zsucc(31-Zsucc(Z_of_nat n))) by ring.
- rewrite Zpower_Zsucc, <- Zdiv_Zdiv; auto with zarith.
- rewrite Zmult_comm, Z_div_mult; auto with zarith.
+ replace (31+-Z.of_nat n) with (Z.succ(31-Z.succ(Z.of_nat n))) by ring.
+ rewrite Z.pow_succ_r, <- Zdiv_Zdiv; auto with zarith.
+ rewrite Z.mul_comm, Z_div_mult; auto with zarith.
  Qed.
 
- Let w_pos_mod     := int31_op.(znz_pos_mod).
-
  Lemma spec_pos_mod : forall w p,
-       [|w_pos_mod p w|] = [|w|] mod (2 ^ [|p|]).
+       [|ZnZ.pos_mod p w|] = [|w|] mod (2 ^ [|p|]).
  Proof.
- unfold w_pos_mod, znz_pos_mod, int31_op, compare31.
+ unfold ZnZ.pos_mod, int31_ops, compare31.
  change [|31|] with 31%Z.
  assert (forall w p, 31<=p -> [|w|] = [|w|] mod 2^p).
   intros.
   generalize (phi_bounded w).
   symmetry; apply Zmod_small.
   split; auto with zarith.
-  apply Zlt_le_trans with wB; auto with zarith.
+  apply Z.lt_le_trans with wB; auto with zarith.
   apply Zpower_le_monotone; auto with zarith.
  intros.
  case_eq ([|p|] ?= 31); intros;
-  [ apply H; rewrite (Zcompare_Eq_eq _ _ H0); auto with zarith | |
+  [ apply H; rewrite (Z.compare_eq _ _ H0); auto with zarith | |
     apply H; change ([|p|]>31)%Z in H0; auto with zarith ].
  change ([|p|]<31) in H0.
  rewrite spec_add_mul_div by auto with zarith.
- change [|0|] with 0%Z; rewrite Zmult_0_l, Zplus_0_l.
+ change [|0|] with 0%Z; rewrite Z.mul_0_l, Z.add_0_l.
  generalize (phi_bounded p)(phi_bounded w); intros.
  assert (31-[|p|]<wB).
-  apply Zle_lt_trans with 31%Z; auto with zarith.
+  apply Z.le_lt_trans with 31%Z; auto with zarith.
   compute; auto.
  assert ([|31-p|]=31-[|p|]).
   unfold sub31; rewrite phi_phi_inv.
   change [|31|] with 31%Z.
   apply Zmod_small; auto with zarith.
  rewrite spec_add_mul_div by (rewrite H4; auto with zarith).
- change [|0|] with 0%Z; rewrite Zdiv_0_l, Zplus_0_r.
+ change [|0|] with 0%Z; rewrite Zdiv_0_l, Z.add_0_r.
  rewrite H4.
  apply shift_unshift_mod_2; auto with zarith.
  Qed.
@@ -1711,7 +1679,7 @@ Section Int31_Spec.
   end.
 
  Lemma head031_equiv :
-   forall x, [|head031 x|] = Z_of_nat (head031_alt size x).
+   forall x, [|head031 x|] = Z.of_nat (head031_alt size x).
  Proof.
  intros.
  case_eq (iszero x); intros.
@@ -1719,9 +1687,9 @@ Section Int31_Spec.
  simpl; auto.
 
  unfold head031, recl.
- change On with (phi_inv (Z_of_nat (31-size))).
+ change On with (phi_inv (Z.of_nat (31-size))).
  replace (head031_alt size x) with
-   (head031_alt size x + (31 - size))%nat by (apply plus_0_r; auto).
+   (head031_alt size x + (31 - size))%nat by auto.
  assert (size <= 31)%nat by auto with arith.
 
  revert x H; induction size; intros.
@@ -1729,12 +1697,12 @@ Section Int31_Spec.
  unfold recl_aux; fold recl_aux.
  unfold head031_alt; fold head031_alt.
  rewrite H.
- assert ([|phi_inv (Z_of_nat (31-S n))|] = Z_of_nat (31 - S n)).
+ assert ([|phi_inv (Z.of_nat (31-S n))|] = Z.of_nat (31 - S n)).
   rewrite phi_phi_inv.
   apply Zmod_small.
   split.
-  change 0 with (Z_of_nat O); apply inj_le; omega.
-  apply Zle_lt_trans with (Z_of_nat 31).
+  change 0 with (Z.of_nat O); apply inj_le; omega.
+  apply Z.le_lt_trans with (Z.of_nat 31).
   apply inj_le; omega.
   compute; auto.
  case_eq (firstl x); intros; auto.
@@ -1747,7 +1715,7 @@ Section Int31_Spec.
  f_equal.
  change [|In|] with 1.
  replace (31-n)%nat with (S (31 - S n))%nat by omega.
- rewrite inj_S; ring.
+ rewrite Nat2Z.inj_succ; ring.
 
  clear - H H2.
  rewrite (sneakr_shiftl x) in H.
@@ -1776,16 +1744,16 @@ Section Int31_Spec.
  revert x H H0.
  unfold size at 2 5.
  induction size.
- simpl Z_of_nat.
+ simpl Z.of_nat.
  intros.
  compute in H0; rewrite H0 in H; discriminate.
 
  intros.
  simpl head031_alt.
  case_eq (firstl x); intros.
- rewrite (inj_S (head031_alt n (shiftl x))), Zpower_Zsucc; auto with zarith.
- rewrite <- Zmult_assoc, Zmult_comm, <- Zmult_assoc, <-(Zmult_comm 2).
- rewrite <- Zdouble_mult, <- (phi_twice_firstl _ H1).
+ rewrite (Nat2Z.inj_succ (head031_alt n (shiftl x))), Z.pow_succ_r; auto with zarith.
+ rewrite <- Z.mul_assoc, Z.mul_comm, <- Z.mul_assoc, <-(Z.mul_comm 2).
+ rewrite <- Z.double_spec, <- (phi_twice_firstl _ H1).
  apply IHn.
 
  rewrite phi_nz; rewrite phi_nz in H; contradict H.
@@ -1794,9 +1762,9 @@ Section Int31_Spec.
 
  rewrite <- nshiftl_S_tail; auto.
 
- change (2^(Z_of_nat 0)) with 1; rewrite Zmult_1_l.
+ change (2^(Z.of_nat 0)) with 1; rewrite Z.mul_1_l.
  generalize (phi_bounded x); unfold size; split; auto with zarith.
- change (2^(Z_of_nat 31)/2) with (2^(Z_of_nat (pred size))).
+ change (2^(Z.of_nat 31)/2) with (2^(Z.of_nat (pred size))).
  apply phi_lowerbound; auto.
  Qed.
 
@@ -1819,7 +1787,7 @@ Section Int31_Spec.
   end.
 
  Lemma tail031_equiv :
-   forall x, [|tail031 x|] = Z_of_nat (tail031_alt size x).
+   forall x, [|tail031 x|] = Z.of_nat (tail031_alt size x).
  Proof.
  intros.
  case_eq (iszero x); intros.
@@ -1827,9 +1795,9 @@ Section Int31_Spec.
  simpl; auto.
 
  unfold tail031, recr.
- change On with (phi_inv (Z_of_nat (31-size))).
+ change On with (phi_inv (Z.of_nat (31-size))).
  replace (tail031_alt size x) with
-   (tail031_alt size x + (31 - size))%nat by (apply plus_0_r; auto).
+   (tail031_alt size x + (31 - size))%nat by auto.
  assert (size <= 31)%nat by auto with arith.
 
  revert x H; induction size; intros.
@@ -1837,12 +1805,12 @@ Section Int31_Spec.
  unfold recr_aux; fold recr_aux.
  unfold tail031_alt; fold tail031_alt.
  rewrite H.
- assert ([|phi_inv (Z_of_nat (31-S n))|] = Z_of_nat (31 - S n)).
+ assert ([|phi_inv (Z.of_nat (31-S n))|] = Z.of_nat (31 - S n)).
   rewrite phi_phi_inv.
   apply Zmod_small.
   split.
-  change 0 with (Z_of_nat O); apply inj_le; omega.
-  apply Zle_lt_trans with (Z_of_nat 31).
+  change 0 with (Z.of_nat O); apply inj_le; omega.
+  apply Z.le_lt_trans with (Z.of_nat 31).
   apply inj_le; omega.
   compute; auto.
  case_eq (firstr x); intros; auto.
@@ -1855,7 +1823,7 @@ Section Int31_Spec.
  f_equal.
  change [|In|] with 1.
  replace (31-n)%nat with (S (31 - S n))%nat by omega.
- rewrite inj_S; ring.
+ rewrite Nat2Z.inj_succ; ring.
 
  clear - H H2.
  rewrite (sneakl_shiftr x) in H.
@@ -1873,14 +1841,14 @@ Section Int31_Spec.
   apply nshiftr_size.
  revert x H H0.
  induction size.
- simpl Z_of_nat.
+ simpl Z.of_nat.
  intros.
  compute in H0; rewrite H0 in H; discriminate.
 
  intros.
  simpl tail031_alt.
  case_eq (firstr x); intros.
- rewrite (inj_S (tail031_alt n (shiftr x))), Zpower_Zsucc; auto with zarith.
+ rewrite (Nat2Z.inj_succ (tail031_alt n (shiftr x))), Z.pow_succ_r; auto with zarith.
  destruct (IHn (shiftr x)) as (y & Hy1 & Hy2).
 
  rewrite phi_nz; rewrite phi_nz in H; contradict H.
@@ -1890,13 +1858,13 @@ Section Int31_Spec.
 
  exists y; split; auto.
  rewrite phi_eqn1; auto.
- rewrite Zdouble_mult, Hy2; ring.
+ rewrite Z.double_spec, Hy2; ring.
 
  exists [|shiftr x|].
  split.
  generalize (phi_bounded (shiftr x)); auto with zarith.
  rewrite phi_eqn2; auto.
- rewrite Zdouble_plus_one_mult; simpl; ring.
+ rewrite Z.succ_double_spec; simpl; ring.
  Qed.
 
  (* Sqrt *)
@@ -1915,30 +1883,30 @@ Section Int31_Spec.
  Proof.
  intros Hj; generalize Hj k; pattern j; apply natlike_ind;
    auto; clear k j Hj.
- intros _ k Hk; repeat rewrite Zplus_0_l.
- apply  Zmult_le_0_compat; generalize (Z_div_pos k 2); auto with zarith.
+ intros _ k Hk; repeat rewrite Z.add_0_l.
+ apply  Z.mul_nonneg_nonneg; generalize (Z_div_pos k 2); auto with zarith.
  intros j Hj Hrec _ k Hk; pattern k; apply natlike_ind; auto; clear k Hk.
- rewrite Zmult_0_r, Zplus_0_r, Zplus_0_l.
- generalize (sqr_pos (Zsucc j / 2)) (quotient_by_2 (Zsucc j));
-   unfold Zsucc.
- rewrite Zpower_2, Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r.
+ rewrite Z.mul_0_r, Z.add_0_r, Z.add_0_l.
+ generalize (sqr_pos (Z.succ j / 2)) (quotient_by_2 (Z.succ j));
+   unfold Z.succ.
+ rewrite Z.pow_2_r, Z.mul_add_distr_r; repeat rewrite Z.mul_add_distr_l.
  auto with zarith.
  intros k Hk _.
- replace ((Zsucc j + Zsucc k) / 2) with ((j + k)/2 + 1).
+ replace ((Z.succ j + Z.succ k) / 2) with ((j + k)/2 + 1).
  generalize (Hrec Hj k Hk) (quotient_by_2 (j + k)).
- unfold Zsucc; repeat rewrite Zpower_2;
-   repeat rewrite Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r.
- repeat rewrite Zmult_1_l; repeat rewrite Zmult_1_r.
+ unfold Z.succ; repeat rewrite Z.pow_2_r;
+   repeat rewrite Z.mul_add_distr_r; repeat rewrite Z.mul_add_distr_l.
+ repeat rewrite Z.mul_1_l; repeat rewrite Z.mul_1_r.
  auto with zarith.
- rewrite Zplus_comm, <- Z_div_plus_full_l; auto with zarith.
- apply f_equal2 with (f := Zdiv); auto with zarith.
+ rewrite Z.add_comm, <- Z_div_plus_full_l; auto with zarith.
+ apply f_equal2 with (f := Z.div); auto with zarith.
  Qed.
 
  Lemma sqrt_main i j: 0 <= i -> 0 < j -> i < ((j + (i/j))/2 + 1) ^ 2.
  Proof.
  intros Hi Hj.
  assert (Hij: 0 <= i/j) by (apply Z_div_pos; auto with zarith).
- apply Zlt_le_trans with (2 := sqrt_main_trick _ _ (Zlt_le_weak _ _ Hj) Hij).
+ apply Z.lt_le_trans with (2 := sqrt_main_trick _ _ (Z.lt_le_incl _ _ Hj) Hij).
  pattern i at 1; rewrite (Z_div_mod_eq i j); case (Z_mod_lt i j); auto with zarith.
  Qed.
 
@@ -1948,48 +1916,34 @@ Section Int31_Spec.
  assert (H1: 0 <= i - 2) by auto with zarith.
  assert (H2: 1 <= (i / 2) ^ 2); auto with zarith.
    replace i with (1* 2 + (i - 2)); auto with zarith.
-   rewrite Zpower_2, Z_div_plus_full_l; auto with zarith.
+   rewrite Z.pow_2_r, Z_div_plus_full_l; auto with zarith.
    generalize (sqr_pos ((i - 2)/ 2)) (Z_div_pos (i - 2) 2).
-   rewrite Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r.
+   rewrite Z.mul_add_distr_r; repeat rewrite Z.mul_add_distr_l.
    auto with zarith.
  generalize (quotient_by_2 i).
- rewrite Zpower_2 in H2 |- *;
-   repeat (rewrite Zmult_plus_distr_l ||
-           rewrite Zmult_plus_distr_r ||
-           rewrite Zmult_1_l || rewrite Zmult_1_r).
+ rewrite Z.pow_2_r in H2 |- *;
+   repeat (rewrite Z.mul_add_distr_r ||
+           rewrite Z.mul_add_distr_l ||
+           rewrite Z.mul_1_l || rewrite Z.mul_1_r).
    auto with zarith.
  Qed.
 
  Lemma sqrt_test_true i j: 0 <= i -> 0 < j -> i/j >= j -> j ^ 2 <= i.
  Proof.
- intros Hi Hj Hd; rewrite Zpower_2.
- apply Zle_trans with (j * (i/j)); auto with zarith.
+ intros Hi Hj Hd; rewrite Z.pow_2_r.
+ apply Z.le_trans with (j * (i/j)); auto with zarith.
  apply Z_mult_div_ge; auto with zarith.
  Qed.
 
  Lemma sqrt_test_false i j: 0 <= i -> 0 < j -> i/j < j ->  (j + (i/j))/2 < j.
  Proof.
- intros Hi Hj H; case (Zle_or_lt j ((j + (i/j))/2)); auto.
- intros H1; contradict H; apply Zle_not_lt.
+ intros Hi Hj H; case (Z.le_gt_cases j ((j + (i/j))/2)); auto.
+ intros H1; contradict H; apply Z.le_ngt.
  assert (2 * j <= j + (i/j)); auto with zarith.
- apply Zle_trans with (2 * ((j + (i/j))/2)); auto with zarith.
+ apply Z.le_trans with (2 * ((j + (i/j))/2)); auto with zarith.
  apply Z_mult_div_ge; auto with zarith.
  Qed.
 
- (* George's trick *)
- Inductive ZcompareSpec (i j: Z): comparison -> Prop :=
-   ZcompareSpecEq: i = j -> ZcompareSpec i j Eq
- | ZcompareSpecLt: i < j -> ZcompareSpec i j Lt
- | ZcompareSpecGt: j < i -> ZcompareSpec i j Gt.
-
- Lemma Zcompare_spec i j: ZcompareSpec i j (i ?= j).
- Proof.
- case_eq (Zcompare i j); intros H.
- apply ZcompareSpecEq; apply Zcompare_Eq_eq; auto.
- apply ZcompareSpecLt; auto.
- apply ZcompareSpecGt; apply Zgt_lt; auto.
- Qed.
-
  Lemma sqrt31_step_def rec i j:
    sqrt31_step rec i j =
    match (fst (i/j) ?= j)%int31 with
@@ -2016,65 +1970,66 @@ Section Int31_Spec.
     [|rec i j1|] ^ 2 <= [|i|] < ([|rec i j1|] + 1) ^ 2) ->
   [|sqrt31_step rec i j|] ^ 2 <= [|i|] < ([|sqrt31_step rec i j|] + 1) ^ 2.
  Proof.
- assert (Hp2: 0 < [|2|]) by exact (refl_equal Lt).
+ assert (Hp2: 0 < [|2|]) by exact (eq_refl Lt).
  intros Hi Hj Hij H31 Hrec; rewrite sqrt31_step_def.
- generalize (spec_compare (fst (i/j)%int31) j); case compare31;
-   rewrite div31_phi; auto; intros Hc;
+ rewrite spec_compare, div31_phi; auto.
+   case Z.compare_spec; auto; intros Hc;
    try (split; auto; apply sqrt_test_true; auto with zarith; fail).
  apply Hrec; repeat rewrite div31_phi; auto with zarith.
  replace [|(j + fst (i / j)%int31)|] with ([|j|] + [|i|] / [|j|]).
  split.
- case (Zle_lt_or_eq 1 [|j|]); auto with zarith; intros Hj1.
+ apply Z.le_succ_l in Hj. change (1 <= [|j|]) in Hj.
+ Z.le_elim Hj.
  replace ([|j|] + [|i|]/[|j|]) with
         (1 * 2 + (([|j|] - 2) + [|i|] / [|j|])); try ring.
  rewrite Z_div_plus_full_l; auto with zarith.
  assert (0 <= [|i|]/ [|j|]) by (apply Z_div_pos; auto with zarith).
  assert (0 <= ([|j|] - 2 + [|i|] / [|j|]) / [|2|]) ; auto with zarith.
- rewrite <- Hj1, Zdiv_1_r.
+ rewrite <- Hj, Zdiv_1_r.
  replace (1 + [|i|])%Z with (1 * 2 + ([|i|] - 1))%Z; try ring.
  rewrite Z_div_plus_full_l; auto with zarith.
  assert (0 <= ([|i|] - 1) /2)%Z by (apply Z_div_pos; auto with zarith).
  change ([|2|]) with 2%Z; auto with zarith.
  apply sqrt_test_false; auto with zarith.
  rewrite spec_add, div31_phi; auto.
- apply sym_equal; apply Zmod_small.
+ symmetry; apply Zmod_small.
  split; auto with zarith.
  replace [|j + fst (i / j)%int31|] with ([|j|] + [|i|] / [|j|]).
  apply sqrt_main; auto with zarith.
  rewrite spec_add, div31_phi; auto.
- apply sym_equal; apply Zmod_small.
+ symmetry; apply Zmod_small.
  split; auto with zarith.
  Qed.
 
  Lemma iter31_sqrt_correct n rec i j: 0 < [|i|] -> 0 < [|j|] ->
-  [|i|] < ([|j|] + 1) ^ 2 -> 2 * [|j|] < 2 ^ (Z_of_nat size) ->
-  (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] ->
-      [|i|] < ([|j1|] + 1) ^ 2 -> 2 * [|j1|] < 2 ^ (Z_of_nat size) ->
+  [|i|] < ([|j|] + 1) ^ 2 -> 2 * [|j|] < 2 ^ (Z.of_nat size) ->
+  (forall j1, 0 < [|j1|] -> 2^(Z.of_nat n) + [|j1|] <= [|j|] ->
+      [|i|] < ([|j1|] + 1) ^ 2 -> 2 * [|j1|] < 2 ^ (Z.of_nat size) ->
        [|rec i j1|] ^ 2 <= [|i|] < ([|rec i j1|] + 1) ^ 2) ->
   [|iter31_sqrt n rec i j|] ^ 2 <= [|i|] < ([|iter31_sqrt n rec i j|] + 1) ^ 2.
  Proof.
  revert rec i j; elim n; unfold iter31_sqrt; fold iter31_sqrt; clear n.
  intros rec i j Hi Hj Hij H31 Hrec; apply sqrt31_step_correct; auto with zarith.
  intros; apply Hrec; auto with zarith.
- rewrite Zpower_0_r; auto with zarith.
+ rewrite Z.pow_0_r; auto with zarith.
  intros n Hrec rec i j Hi Hj Hij H31 HHrec.
  apply sqrt31_step_correct; auto.
  intros j1 Hj1  Hjp1; apply Hrec; auto with zarith.
  intros j2 Hj2 H2j2 Hjp2 Hj31; apply Hrec; auto with zarith.
  intros j3 Hj3 Hpj3.
  apply HHrec; auto.
- rewrite inj_S, Zpower_Zsucc.
- apply Zle_trans with (2 ^Z_of_nat n + [|j2|]); auto with zarith.
- apply Zle_0_nat.
+ rewrite Nat2Z.inj_succ, Z.pow_succ_r.
+ apply Z.le_trans with (2 ^Z.of_nat n + [|j2|]); auto with zarith.
+ apply Nat2Z.is_nonneg.
  Qed.
 
  Lemma spec_sqrt : forall x,
        [|sqrt31 x|] ^ 2 <= [|x|] < ([|sqrt31 x|] + 1) ^ 2.
  Proof.
  intros i; unfold sqrt31.
- generalize (spec_compare 1 i); case compare31; change [|1|] with 1;
+ rewrite spec_compare. case Z.compare_spec; change [|1|] with 1;
    intros Hi; auto with zarith.
- repeat rewrite Zpower_2; auto with zarith.
+ repeat rewrite Z.pow_2_r; auto with zarith.
  apply iter31_sqrt_correct; auto with zarith.
   rewrite div31_phi; change ([|2|]) with 2;  auto with zarith.
   replace ([|i|]) with (1 * 2 + ([|i|] - 2))%Z; try ring.
@@ -2083,18 +2038,18 @@ Section Int31_Spec.
   rewrite div31_phi; change ([|2|]) with 2; auto with zarith.
   apply sqrt_init; auto.
  rewrite div31_phi; change ([|2|]) with 2; auto with zarith.
- apply Zle_lt_trans with ([|i|]).
+ apply Z.le_lt_trans with ([|i|]).
  apply Z_mult_div_ge; auto with zarith.
  case (phi_bounded i); auto.
- intros j2 H1 H2; contradict H2; apply Zlt_not_le.
+ intros j2 H1 H2; contradict H2; apply Z.lt_nge.
  rewrite div31_phi; change ([|2|]) with 2; auto with zarith.
- apply Zle_lt_trans with ([|i|]); auto with zarith.
+ apply Z.le_lt_trans with ([|i|]); auto with zarith.
  assert (0 <= [|i|]/2)%Z by (apply Z_div_pos; auto with zarith).
- apply Zle_trans with (2 * ([|i|]/2)); auto with zarith.
+ apply Z.le_trans with (2 * ([|i|]/2)); auto with zarith.
  apply Z_mult_div_ge; auto with zarith.
  case (phi_bounded i); unfold size; auto with zarith.
  change [|0|] with 0; auto with zarith.
- case (phi_bounded i); repeat rewrite Zpower_2; auto with zarith.
+ case (phi_bounded i); repeat rewrite Z.pow_2_r; auto with zarith.
  Qed.
 
  Lemma sqrt312_step_def rec ih il j:
@@ -2124,10 +2079,10 @@ Section Int31_Spec.
  case (phi_bounded il); intros Hbil _.
  case (phi_bounded ih); intros Hbih Hbih1.
  assert (([|ih|] < [|j|] + 1)%Z); auto with zarith.
- apply Zlt_square_simpl; auto with zarith.
- repeat rewrite <-Zpower_2; apply Zle_lt_trans with (2 := H1).
- apply Zle_trans with ([|ih|] * base)%Z; unfold phi2, base;
-  try rewrite Zpower_2; auto with zarith.
+ apply Z.square_lt_simpl_nonneg; auto with zarith.
+ repeat rewrite <-Z.pow_2_r; apply Z.le_lt_trans with (2 := H1).
+ apply Z.le_trans with ([|ih|] * base)%Z; unfold phi2, base;
+  try rewrite Z.pow_2_r; auto with zarith.
  Qed.
 
  Lemma div312_phi ih il j: (2^30 <= [|j|] -> [|ih|] < [|j|] ->
@@ -2137,7 +2092,7 @@ Section Int31_Spec.
  generalize (spec_div21 ih il j Hj Hj1).
  case div3121; intros q r (Hq, Hr).
  apply Zdiv_unique with (phi r); auto with zarith.
- simpl fst; apply trans_equal with (1 := Hq); ring.
+ simpl fst; apply eq_trans with (1 := Hq); ring.
  Qed.
 
  Lemma sqrt312_step_correct rec ih il j:
@@ -2147,32 +2102,33 @@ Section Int31_Spec.
   [|sqrt312_step rec ih il  j|] ^ 2 <= phi2 ih il
       < ([|sqrt312_step rec ih il j|] + 1) ^  2.
  Proof.
- assert (Hp2: (0 < [|2|])%Z) by exact (refl_equal Lt).
+ assert (Hp2: (0 < [|2|])%Z) by exact (eq_refl Lt).
  intros Hih Hj Hij Hrec; rewrite sqrt312_step_def.
  assert (H1: ([|ih|] <= [|j|])%Z) by (apply sqrt312_lower_bound with il; auto).
  case (phi_bounded ih); intros Hih1 _.
  case (phi_bounded il); intros Hil1 _.
  case (phi_bounded j); intros _ Hj1.
  assert (Hp3: (0 < phi2 ih il)).
- unfold phi2; apply Zlt_le_trans with ([|ih|] * base)%Z; auto with zarith.
- apply Zmult_lt_0_compat; auto with zarith.
- apply Zlt_le_trans with (2:= Hih); auto with zarith.
- generalize (spec_compare ih j); case compare31; intros Hc1.
+ unfold phi2; apply Z.lt_le_trans with ([|ih|] * base)%Z; auto with zarith.
+ apply Z.mul_pos_pos; auto with zarith.
+ apply Z.lt_le_trans with (2:= Hih); auto with zarith.
+ rewrite spec_compare. case Z.compare_spec; intros Hc1.
  split; auto.
  apply sqrt_test_true; auto.
  unfold phi2, base; auto with zarith.
  unfold phi2; rewrite Hc1.
  assert (0 <= [|il|]/[|j|]) by (apply Z_div_pos; auto with zarith).
- rewrite Zmult_comm, Z_div_plus_full_l; unfold base; auto with zarith.
- unfold Zpower, Zpower_pos in Hj1; simpl in Hj1; auto with zarith.
- case (Zle_or_lt (2 ^ 30) [|j|]); intros Hjj.
- generalize (spec_compare (fst (div3121 ih il j)) j); case compare31;
+ rewrite Z.mul_comm, Z_div_plus_full_l; unfold base; auto with zarith.
+ unfold Z.pow, Z.pow_pos in Hj1; simpl in Hj1; auto with zarith.
+ case (Z.le_gt_cases (2 ^ 30) [|j|]); intros Hjj.
+ rewrite spec_compare; case Z.compare_spec;
   rewrite div312_phi; auto; intros Hc;
   try (split; auto; apply sqrt_test_true; auto with zarith; fail).
  apply Hrec.
  assert (Hf1: 0 <= phi2 ih il/ [|j|]) by (apply Z_div_pos; auto with zarith).
- case (Zle_lt_or_eq 1 ([|j|])); auto with zarith; intros Hf2.
- 2: contradict Hc; apply Zle_not_lt; rewrite <- Hf2, Zdiv_1_r; auto with zarith.
+ apply Z.le_succ_l in Hj. change (1 <= [|j|]) in Hj.
+ Z.le_elim Hj.
+ 2: contradict Hc; apply Z.le_ngt; rewrite <- Hj, Zdiv_1_r; auto with zarith.
  assert (Hf3: 0 < ([|j|] + phi2 ih il / [|j|]) / 2).
  replace ([|j|] + phi2 ih il/ [|j|])%Z with
         (1 * 2 + (([|j|] - 2) + phi2 ih il / [|j|])); try ring.
@@ -2186,9 +2142,9 @@ Section Int31_Spec.
  rewrite div31_phi; change [|2|] with 2%Z; auto with zarith.
  intros HH; rewrite HH; clear HH; auto with zarith.
  rewrite spec_add, div31_phi; change [|2|] with 2%Z; auto.
- rewrite Zmult_1_l; intros HH.
- rewrite Zplus_comm, <- Z_div_plus_full_l; auto with zarith.
- change (phi v30 * 2) with (2 ^ Z_of_nat size).
+ rewrite Z.mul_1_l; intros HH.
+ rewrite Z.add_comm, <- Z_div_plus_full_l; auto with zarith.
+ change (phi v30 * 2) with (2 ^ Z.of_nat size).
  rewrite HH, Zmod_small; auto with zarith.
  replace (phi
     match j +c fst (div3121 ih il j) with
@@ -2202,41 +2158,41 @@ Section Int31_Spec.
  rewrite div31_phi; auto with zarith.
  intros HH; rewrite HH; auto with zarith.
  intros HH; rewrite <- HH.
- change (1 * 2 ^ Z_of_nat size) with (phi (v30) * 2).
+ change (1 * 2 ^ Z.of_nat size) with (phi (v30) * 2).
  rewrite Z_div_plus_full_l; auto with zarith.
- rewrite Zplus_comm.
+ rewrite Z.add_comm.
  rewrite spec_add, Zmod_small.
  rewrite div31_phi; auto.
  split; auto with zarith.
  case (phi_bounded (fst (r/2)%int31));
    case (phi_bounded v30); auto with zarith.
  rewrite div31_phi; change (phi 2) with 2%Z; auto.
- change (2 ^Z_of_nat size) with (base/2 + phi v30).
+ change (2 ^Z.of_nat size) with (base/2 + phi v30).
  assert (phi r / 2 < base/2); auto with zarith.
- apply Zmult_gt_0_lt_reg_r with 2; auto with zarith.
+ apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
  change (base/2 * 2) with base.
- apply Zle_lt_trans with (phi r).
- rewrite Zmult_comm; apply Z_mult_div_ge; auto with zarith.
+ apply Z.le_lt_trans with (phi r).
+ rewrite Z.mul_comm; apply Z_mult_div_ge; auto with zarith.
  case (phi_bounded r); auto with zarith.
- contradict Hij; apply Zle_not_lt.
+ contradict Hij; apply Z.le_ngt.
  assert ((1 + [|j|]) <= 2 ^ 30); auto with zarith.
- apply Zle_trans with ((2 ^ 30) * (2 ^ 30)); auto with zarith.
+ apply Z.le_trans with ((2 ^ 30) * (2 ^ 30)); auto with zarith.
  assert (0 <= 1 + [|j|]); auto with zarith.
- apply Zmult_le_compat; auto with zarith.
+ apply Z.mul_le_mono_nonneg; auto with zarith.
  change ((2 ^ 30) * (2 ^ 30)) with ((2 ^ 29) * base).
- apply Zle_trans with ([|ih|] * base); auto with zarith.
+ apply Z.le_trans with ([|ih|] * base); auto with zarith.
  unfold phi2, base; auto with zarith.
  split; auto.
  apply sqrt_test_true; auto.
  unfold phi2, base; auto with zarith.
- apply Zle_ge; apply Zle_trans with (([|j|] * base)/[|j|]).
- rewrite Zmult_comm, Z_div_mult; auto with zarith.
- apply Zge_le; apply Z_div_ge; auto with zarith.
+ apply Z.le_ge; apply Z.le_trans with (([|j|] * base)/[|j|]).
+ rewrite Z.mul_comm, Z_div_mult; auto with zarith.
+ apply Z.ge_le; apply Z_div_ge; auto with zarith.
  Qed.
 
  Lemma iter312_sqrt_correct n rec ih il j:
   2^29 <= [|ih|] ->  0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 ->
-  (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] ->
+  (forall j1, 0 < [|j1|] -> 2^(Z.of_nat n) + [|j1|] <= [|j|] ->
       phi2 ih il < ([|j1|] + 1) ^ 2 ->
        [|rec ih il j1|] ^ 2 <= phi2 ih il < ([|rec ih il j1|] + 1) ^ 2)  ->
   [|iter312_sqrt n rec ih il j|] ^ 2 <= phi2 ih il
@@ -2245,16 +2201,16 @@ Section Int31_Spec.
  revert rec ih il j; elim n; unfold iter312_sqrt; fold iter312_sqrt; clear n.
  intros rec ih il j Hi Hj Hij Hrec; apply sqrt312_step_correct; auto with zarith.
  intros; apply Hrec; auto with zarith.
- rewrite Zpower_0_r; auto with zarith.
+ rewrite Z.pow_0_r; auto with zarith.
  intros n Hrec rec ih il j Hi Hj Hij HHrec.
  apply sqrt312_step_correct; auto.
  intros j1 Hj1  Hjp1; apply Hrec; auto with zarith.
  intros j2 Hj2 H2j2 Hjp2; apply Hrec; auto with zarith.
  intros j3 Hj3 Hpj3.
  apply HHrec; auto.
- rewrite inj_S, Zpower_Zsucc.
- apply Zle_trans with (2 ^Z_of_nat n + [|j2|])%Z; auto with zarith.
- apply Zle_0_nat.
+ rewrite Nat2Z.inj_succ, Z.pow_succ_r.
+ apply Z.le_trans with (2 ^Z.of_nat n + [|j2|])%Z; auto with zarith.
+ apply Nat2Z.is_nonneg.
  Qed.
 
  Lemma spec_sqrt2 : forall x y,
@@ -2269,30 +2225,30 @@ Section Int31_Spec.
   (intros s; ring).
  assert (Hb: 0 <= base) by (red; intros HH; discriminate).
  assert (Hi2: phi2 ih il < (phi Tn + 1) ^ 2).
-   change ((phi Tn + 1) ^ 2) with (2^62).
-  apply Zle_lt_trans with ((2^31 -1) * base + (2^31 - 1)); auto with zarith.
-  2: simpl; unfold Zpower_pos; simpl; auto with zarith.
-  case (phi_bounded ih); case (phi_bounded il); intros H1 H2 H3 H4.
-  unfold base, Zpower, Zpower_pos in H2,H4; simpl in H2,H4.
-  unfold phi2,Zpower, Zpower_pos; simpl iter_pos; auto with zarith.
+ { change ((phi Tn + 1) ^ 2) with (2^62).
+   apply Z.le_lt_trans with ((2^31 -1) * base + (2^31 - 1)); auto with zarith.
+   2: simpl; unfold Z.pow_pos; simpl; auto with zarith.
+   case (phi_bounded ih); case (phi_bounded il); intros H1 H2 H3 H4.
+   unfold base, Z.pow, Z.pow_pos in H2,H4; simpl in H2,H4.
+   unfold phi2,Z.pow, Z.pow_pos. simpl Pos.iter; auto with zarith. }
  case (iter312_sqrt_correct 31 (fun _ _ j => j) ih il Tn); auto with zarith.
  change [|Tn|] with 2147483647; auto with zarith.
  intros j1 _ HH; contradict HH.
- apply Zlt_not_le.
+ apply Z.lt_nge.
  change [|Tn|] with 2147483647; auto with zarith.
- change (2 ^ Z_of_nat 31) with 2147483648; auto with zarith.
+ change (2 ^ Z.of_nat 31) with 2147483648; auto with zarith.
  case (phi_bounded j1); auto with zarith.
  set (s := iter312_sqrt 31 (fun _ _ j : int31 => j) ih il Tn).
  intros Hs1 Hs2.
  generalize (spec_mul_c s s); case mul31c.
  simpl zn2z_to_Z; intros HH.
  assert ([|s|] = 0).
- case (Zmult_integral _ _ (sym_equal HH)); auto.
- contradict Hs2; apply Zle_not_lt; rewrite H.
+ { symmetry in HH. rewrite Z.mul_eq_0 in HH. destruct HH; auto. }
+ contradict Hs2; apply Z.le_ngt; rewrite H.
  change ((0 + 1) ^ 2) with 1.
- apply Zle_trans with (2 ^ Z_of_nat size / 4 * base).
+ apply Z.le_trans with (2 ^ Z.of_nat size / 4 * base).
  simpl; auto with zarith.
- apply Zle_trans with ([|ih|] * base); auto with zarith.
+ apply Z.le_trans with ([|ih|] * base); auto with zarith.
  unfold phi2; case (phi_bounded il); auto with zarith.
  intros ih1 il1.
  change [||WW ih1 il1||] with (phi2 ih1 il1).
@@ -2300,10 +2256,10 @@ Section Int31_Spec.
  generalize (spec_sub_c il il1).
  case sub31c; intros il2 Hil2.
  simpl interp_carry in Hil2.
- generalize (spec_compare ih ih1); case compare31.
+ rewrite spec_compare; case Z.compare_spec.
  unfold interp_carry.
  intros H1; split.
- rewrite Zpower_2, <- Hihl1.
+ rewrite Z.pow_2_r, <- Hihl1.
  unfold phi2; ring[Hil2 H1].
  replace [|il2|] with (phi2 ih il - phi2 ih1 il1).
  rewrite Hihl1.
@@ -2311,132 +2267,130 @@ Section Int31_Spec.
  unfold phi2; rewrite H1, Hil2; ring.
  unfold interp_carry.
  intros H1; contradict Hs1.
- apply Zlt_not_le; rewrite Zpower_2, <-Hihl1.
+ apply Z.lt_nge; rewrite Z.pow_2_r, <-Hihl1.
  unfold phi2.
  case (phi_bounded il); intros _ H2.
- apply Zlt_le_trans with (([|ih|] + 1) * base + 0).
- rewrite Zmult_plus_distr_l, Zplus_0_r; auto with zarith.
+ apply Z.lt_le_trans with (([|ih|] + 1) * base + 0).
+ rewrite Z.mul_add_distr_r, Z.add_0_r; auto with zarith.
  case (phi_bounded il1); intros H3 _.
- apply Zplus_le_compat; auto with zarith.
- unfold interp_carry; change (1 * 2 ^ Z_of_nat size) with base.
- rewrite Zpower_2, <- Hihl1, Hil2.
+ apply Z.add_le_mono; auto with zarith.
+ unfold interp_carry; change (1 * 2 ^ Z.of_nat size) with base.
+ rewrite Z.pow_2_r, <- Hihl1, Hil2.
  intros H1.
- case (Zle_lt_or_eq ([|ih1|] + 1) ([|ih|])); auto with zarith.
- intros H2; contradict Hs2; apply Zle_not_lt.
+ rewrite <- Z.le_succ_l, <- Z.add_1_r in H1.
+ Z.le_elim H1.
+ contradict Hs2; apply Z.le_ngt.
  replace (([|s|] + 1) ^ 2) with (phi2 ih1 il1 + 2 * [|s|] + 1).
  unfold phi2.
  case (phi_bounded il); intros Hpil _.
  assert (Hl1l: [|il1|] <= [|il|]).
-  case (phi_bounded il2); rewrite Hil2; auto with zarith.
+ { case (phi_bounded il2); rewrite Hil2; auto with zarith. }
  assert ([|ih1|] * base + 2 * [|s|] + 1 <= [|ih|] * base); auto with zarith.
- case (phi_bounded s);  change (2 ^ Z_of_nat size) with base; intros _ Hps.
+ case (phi_bounded s);  change (2 ^ Z.of_nat size) with base; intros _ Hps.
  case (phi_bounded ih1); intros Hpih1 _; auto with zarith.
- apply Zle_trans with (([|ih1|] + 2) * base); auto with zarith.
- rewrite Zmult_plus_distr_l.
+ apply Z.le_trans with (([|ih1|] + 2) * base); auto with zarith.
+ rewrite Z.mul_add_distr_r.
  assert (2 * [|s|] + 1 <= 2 * base); auto with zarith.
  rewrite Hihl1, Hbin; auto.
- intros H2; split.
- unfold phi2; rewrite <- H2; ring.
+ split.
+ unfold phi2; rewrite <- H1; ring.
  replace (base + ([|il|] - [|il1|])) with (phi2 ih il - ([|s|] * [|s|])).
  rewrite <-Hbin in Hs2; auto with zarith.
- rewrite <- Hihl1; unfold phi2; rewrite <- H2; ring.
+ rewrite <- Hihl1; unfold phi2; rewrite <- H1; ring.
  unfold interp_carry in Hil2 |- *.
- unfold interp_carry; change (1 * 2 ^ Z_of_nat size) with base.
+ unfold interp_carry; change (1 * 2 ^ Z.of_nat size) with base.
  assert (Hsih: [|ih - 1|] = [|ih|] - 1).
-  rewrite spec_sub, Zmod_small; auto; change [|1|] with 1.
-  case (phi_bounded ih); intros H1 H2.
-  generalize Hih; change (2 ^ Z_of_nat size / 4) with 536870912.
-  split; auto with zarith.
- generalize (spec_compare (ih - 1) ih1); case compare31.
+ { rewrite spec_sub, Zmod_small; auto; change [|1|] with 1.
+   case (phi_bounded ih); intros H1 H2.
+   generalize Hih; change (2 ^ Z.of_nat size / 4) with 536870912.
+   split; auto with zarith. }
+ rewrite spec_compare; case Z.compare_spec.
  rewrite Hsih.
  intros H1; split.
- rewrite Zpower_2, <- Hihl1.
+ rewrite Z.pow_2_r, <- Hihl1.
  unfold phi2; rewrite <-H1.
- apply trans_equal with ([|ih|] * base + [|il1|] + ([|il|] - [|il1|])).
+ transitivity ([|ih|] * base + [|il1|] + ([|il|] - [|il1|])).
  ring.
  rewrite <-Hil2.
- change (2 ^ Z_of_nat size) with base; ring.
+ change (2 ^ Z.of_nat size) with base; ring.
  replace [|il2|] with (phi2 ih il - phi2 ih1 il1).
  rewrite Hihl1.
  rewrite <-Hbin in Hs2; auto with zarith.
  unfold phi2.
  rewrite <-H1.
  ring_simplify.
- apply trans_equal with (base + ([|il|] - [|il1|])).
+ transitivity (base + ([|il|] - [|il1|])).
  ring.
  rewrite <-Hil2.
- change (2 ^ Z_of_nat size) with base; ring.
+ change (2 ^ Z.of_nat size) with base; ring.
  rewrite Hsih; intros H1.
  assert (He: [|ih|] = [|ih1|]).
-   apply Zle_antisym; auto with zarith.
-   case (Zle_or_lt [|ih1|] [|ih|]); auto; intros H2.
-   contradict Hs1; apply Zlt_not_le; rewrite Zpower_2, <-Hihl1.
-  unfold phi2.
-  case (phi_bounded il); change (2 ^ Z_of_nat size) with base;
+ { apply Z.le_antisymm; auto with zarith.
+   case (Z.le_gt_cases [|ih1|] [|ih|]); auto; intros H2.
+   contradict Hs1; apply Z.lt_nge; rewrite Z.pow_2_r, <-Hihl1.
+   unfold phi2.
+   case (phi_bounded il); change (2 ^ Z.of_nat size) with base;
     intros _ Hpil1.
-  apply Zlt_le_trans with (([|ih|] + 1) * base).
-  rewrite Zmult_plus_distr_l, Zmult_1_l; auto with zarith.
-  case (phi_bounded il1); intros Hpil2 _.
-  apply Zle_trans with (([|ih1|]) * base); auto with zarith.
- rewrite Zpower_2, <-Hihl1; unfold phi2; rewrite <-He.
- contradict Hs1; apply Zlt_not_le; rewrite Zpower_2, <-Hihl1.
+   apply Z.lt_le_trans with (([|ih|] + 1) * base).
+   rewrite Z.mul_add_distr_r, Z.mul_1_l; auto with zarith.
+   case (phi_bounded il1); intros Hpil2 _.
+   apply Z.le_trans with (([|ih1|]) * base); auto with zarith. }
+ rewrite Z.pow_2_r, <-Hihl1; unfold phi2; rewrite <-He.
+ contradict Hs1; apply Z.lt_nge; rewrite Z.pow_2_r, <-Hihl1.
  unfold phi2; rewrite He.
  assert (phi il - phi il1 < 0); auto with zarith.
  rewrite <-Hil2.
  case (phi_bounded il2); auto with zarith.
  intros H1.
- rewrite Zpower_2, <-Hihl1.
- case (Zle_lt_or_eq ([|ih1|] + 2) [|ih|]); auto with zarith.
- intros H2; contradict Hs2; apply Zle_not_lt.
+ rewrite Z.pow_2_r, <-Hihl1.
+ assert (H2 : [|ih1|]+2 <= [|ih|]); auto with zarith.
+ Z.le_elim H2.
+ contradict Hs2; apply Z.le_ngt.
  replace (([|s|] + 1) ^ 2) with (phi2 ih1 il1 + 2 * [|s|] + 1).
  unfold phi2.
  assert ([|ih1|] * base + 2 * phi s + 1 <= [|ih|] * base + ([|il|] - [|il1|]));
   auto with zarith.
  rewrite <-Hil2.
- change (-1 * 2 ^ Z_of_nat size) with (-base).
+ change (-1 * 2 ^ Z.of_nat size) with (-base).
  case (phi_bounded il2); intros Hpil2 _.
- apply Zle_trans with ([|ih|] * base + - base); auto with zarith.
- case (phi_bounded s);  change (2 ^ Z_of_nat size) with base; intros _ Hps.
+ apply Z.le_trans with ([|ih|] * base + - base); auto with zarith.
+ case (phi_bounded s);  change (2 ^ Z.of_nat size) with base; intros _ Hps.
  assert (2 * [|s|] + 1 <= 2 * base); auto with zarith.
- apply Zle_trans with ([|ih1|] * base + 2 * base); auto with zarith.
+ apply Z.le_trans with ([|ih1|] * base + 2 * base); auto with zarith.
  assert (Hi: ([|ih1|] + 3) * base <= [|ih|] * base); auto with zarith.
- rewrite Zmult_plus_distr_l in Hi; auto with zarith.
+ rewrite Z.mul_add_distr_r in Hi; auto with zarith.
  rewrite Hihl1, Hbin; auto.
- intros H2; unfold phi2; rewrite <-H2.
+ unfold phi2; rewrite <-H2.
  split.
  replace [|il|] with (([|il|] - [|il1|]) + [|il1|]); try ring.
  rewrite <-Hil2.
- change (-1 * 2 ^ Z_of_nat size) with (-base); ring.
+ change (-1 * 2 ^ Z.of_nat size) with (-base); ring.
  replace (base + [|il2|]) with (phi2 ih il - phi2 ih1 il1).
  rewrite Hihl1.
  rewrite <-Hbin in Hs2; auto with zarith.
  unfold phi2; rewrite <-H2.
  replace [|il|] with (([|il|] - [|il1|]) + [|il1|]); try ring.
  rewrite <-Hil2.
- change (-1 * 2 ^ Z_of_nat size) with (-base); ring.
- Qed.
+ change (-1 * 2 ^ Z.of_nat size) with (-base); ring.
+Qed.
 
  (** [iszero] *)
 
- Let w_eq0         := int31_op.(znz_eq0).
-
- Lemma spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0.
+ Lemma spec_eq0 : forall x, ZnZ.eq0 x = true -> [|x|] = 0.
  Proof.
- clear; unfold w_eq0, znz_eq0; simpl.
+ clear; unfold ZnZ.eq0; simpl.
  unfold compare31; simpl; intros.
  change [|0|] with 0 in H.
- apply Zcompare_Eq_eq.
+ apply Z.compare_eq.
  now destruct ([|x|] ?= 0).
  Qed.
 
  (* Even *)
 
- Let w_is_even     := int31_op.(znz_is_even).
-
  Lemma spec_is_even : forall x,
-      if w_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1.
+      if ZnZ.is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1.
  Proof.
- unfold w_is_even; simpl; intros.
+ unfold ZnZ.is_even; simpl; intros.
  generalize (spec_div x 2).
  destruct (x/2)%int31 as (q,r); intros.
  unfold compare31.
@@ -2445,77 +2399,60 @@ Section Int31_Spec.
  destruct H; auto with zarith.
  replace ([|x|] mod 2) with [|r|].
  destruct H; auto with zarith.
- case_eq ([|r|] ?= 0)%Z; intros.
- apply Zcompare_Eq_eq; auto.
- change ([|r|] < 0)%Z in H; auto with zarith.
- change ([|r|] > 0)%Z in H; auto with zarith.
+ case Z.compare_spec; auto with zarith.
  apply Zmod_unique with [|q|]; auto with zarith.
  Qed.
 
- Definition int31_spec : znz_spec int31_op.
-  split.
-  exact phi_bounded.
-  exact positive_to_int31_spec.
-  exact spec_zdigits.
-  exact spec_more_than_1_digit.
-
-  exact spec_0.
-  exact spec_1.
-  exact spec_Bm1.
-
-  exact spec_compare.
-  exact spec_eq0.
-
-  exact spec_opp_c.
-  exact spec_opp.
-  exact spec_opp_carry.
-
-  exact spec_succ_c.
-  exact spec_add_c.
-  exact spec_add_carry_c.
-  exact spec_succ.
-  exact spec_add.
-  exact spec_add_carry.
-
-  exact spec_pred_c.
-  exact spec_sub_c.
-  exact spec_sub_carry_c.
-  exact spec_pred.
-  exact spec_sub.
-  exact spec_sub_carry.
-
-  exact spec_mul_c.
-  exact spec_mul.
-  exact spec_square_c.
-
-  exact spec_div21.
-  intros; apply spec_div; auto.
-  exact spec_div.
-
-  intros; unfold int31_op; simpl; apply spec_mod; auto.
-  exact spec_mod.
-
-  intros; apply spec_gcd; auto.
-  exact spec_gcd.
-
-  exact spec_head00.
-  exact spec_head0.
-  exact spec_tail00.
-  exact spec_tail0.
-
-  exact spec_add_mul_div.
-  exact spec_pos_mod.
-
-  exact spec_is_even.
-  exact spec_sqrt2.
-  exact spec_sqrt.
- Qed.
-
-End Int31_Spec.
+ Global Instance int31_specs : ZnZ.Specs int31_ops := {
+    spec_to_Z   := phi_bounded;
+    spec_of_pos := positive_to_int31_spec;
+    spec_zdigits := spec_zdigits;
+    spec_more_than_1_digit := spec_more_than_1_digit;
+    spec_0   := spec_0;
+    spec_1   := spec_1;
+    spec_m1  := spec_m1;
+    spec_compare := spec_compare;
+    spec_eq0 := spec_eq0;
+    spec_opp_c := spec_opp_c;
+    spec_opp := spec_opp;
+    spec_opp_carry := spec_opp_carry;
+    spec_succ_c := spec_succ_c;
+    spec_add_c := spec_add_c;
+    spec_add_carry_c := spec_add_carry_c;
+    spec_succ := spec_succ;
+    spec_add := spec_add;
+    spec_add_carry := spec_add_carry;
+    spec_pred_c := spec_pred_c;
+    spec_sub_c := spec_sub_c;
+    spec_sub_carry_c := spec_sub_carry_c;
+    spec_pred := spec_pred;
+    spec_sub := spec_sub;
+    spec_sub_carry := spec_sub_carry;
+    spec_mul_c := spec_mul_c;
+    spec_mul := spec_mul;
+    spec_square_c := spec_square_c;
+    spec_div21 := spec_div21;
+    spec_div_gt := fun a b _ => spec_div a b;
+    spec_div := spec_div;
+    spec_modulo_gt := fun a b _ => spec_mod a b;
+    spec_modulo := spec_mod;
+    spec_gcd_gt := fun a b _ => spec_gcd a b;
+    spec_gcd := spec_gcd;
+    spec_head00 := spec_head00;
+    spec_head0 := spec_head0;
+    spec_tail00 := spec_tail00;
+    spec_tail0 := spec_tail0;
+    spec_add_mul_div := spec_add_mul_div;
+    spec_pos_mod := spec_pos_mod;
+    spec_is_even := spec_is_even;
+    spec_sqrt2 := spec_sqrt2;
+    spec_sqrt := spec_sqrt }.
+
+End Int31_Specs.
 
 
 Module Int31Cyclic <: CyclicType.
-  Definition w := int31.
-  Definition w_op := int31_op.
-  Definition w_spec := int31_spec.
+  Definition t := int31.
+  Definition ops := int31_ops.
+  Definition specs := int31_specs.
 End Int31Cyclic.
diff --git a/theories/Numbers/Cyclic/Int31/Int31.v b/theories/Numbers/Cyclic/Int31/Int31.v
index 5e1cd0e1..f414663a 100644
--- a/theories/Numbers/Cyclic/Int31/Int31.v
+++ b/theories/Numbers/Cyclic/Int31/Int31.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,15 +8,11 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: Int31.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import NaryFunctions.
 Require Import Wf_nat.
 Require Export ZArith.
 Require Export DoubleType.
 
-Unset Boxed Definitions.
-
 (** * 31-bit integers *)
 
 (** This file contains basic definitions of a 31-bit integer
@@ -121,12 +117,12 @@ Definition iszero : int31 -> bool := Eval compute in
    It seems to work, but later "unfold iszero" takes forever. *)
 
 
-(** [base] is [2^31], obtained via iterations of [Zdouble].
+(** [base] is [2^31], obtained via iterations of [Z.double].
    It can also be seen as the smallest b > 0 s.t. phi_inv b = 0
    (see below) *)
 
 Definition base := Eval compute in
- iter_nat size Z Zdouble 1%Z.
+ iter_nat size Z Z.double 1%Z.
 
 (** * Recursors *)
 
@@ -159,11 +155,11 @@ Definition recr := recr_aux size.
 
 (** * Conversions *)
 
-(** From int31 to Z, we simply iterates [Zdouble] or [Zdouble_plus_one]. *)
+(** From int31 to Z, we simply iterates [Z.double] or [Z.succ_double]. *)
 
 Definition phi : int31 -> Z :=
  recr Z (0%Z)
-  (fun b _ => match b with D0 => Zdouble | D1 => Zdouble_plus_one end).
+  (fun b _ => match b with D0 => Z.double | D1 => Z.succ_double end).
 
 (** From positive to int31. An abstract definition could be :
       [ phi_inv (2n) = 2*(phi_inv n) /\
@@ -297,13 +293,13 @@ Notation "n '*c' m" := (mul31c n m) (at level 40, no associativity) : int31_scop
 (** Division of a double size word modulo [2^31] *)
 
 Definition div3121 (nh nl m : int31) :=
-  let (q,r) := Zdiv_eucl (phi2 nh nl) (phi m) in
+  let (q,r) := Z.div_eucl (phi2 nh nl) (phi m) in
   (phi_inv q, phi_inv r).
 
 (** Division modulo [2^31] *)
 
 Definition div31 (n m : int31) :=
-  let (q,r) := Zdiv_eucl (phi n) (phi m) in
+  let (q,r) := Z.div_eucl (phi n) (phi m) in
   (phi_inv q, phi_inv r).
 Notation "n / m" := (div31 n m) : int31_scope.
 
@@ -353,16 +349,16 @@ Register div31 as int31 div in "coq_int31" by True.
 Register compare31 as int31 compare in "coq_int31" by True.
 Register addmuldiv31 as int31 addmuldiv in "coq_int31" by True.
 
-Definition gcd31 (i j:int31) :=
-  (fix euler (guard:nat) (i j:int31) {struct guard} :=
-   match guard with
-   | O => In
-   | S p => match j ?= On with
-            | Eq => i
-            | _ => euler p j (let (_, r ) := i/j in r)
-            end
-   end)
-  (2*size)%nat i j.
+Fixpoint euler (guard:nat) (i j:int31) {struct guard} :=
+  match guard with
+    | O => In
+    | S p => match j ?= On with
+               | Eq => i
+               | _ => euler p j (let (_, r ) := i/j in r)
+             end
+  end.
+
+Definition gcd31 (i j:int31) := euler (2*size)%nat i j.
 
 (** Square root functions using newton iteration
     we use a very naive upper-bound on the iteration
@@ -395,7 +391,7 @@ Eval lazy delta [On In Twon] in
   | Lt => iter31_sqrt 31 (fun i j => j) i (fst (i/Twon))
   end.
 
-Definition v30 := Eval compute in (addmuldiv31 (phi_inv (Z_of_nat size - 1)) In On).
+Definition v30 := Eval compute in (addmuldiv31 (phi_inv (Z.of_nat size - 1)) In On).
 
 Definition sqrt312_step (rec: int31 -> int31 -> int31 -> int31)
    (ih il j: int31)  :=
@@ -456,7 +452,7 @@ Definition positive_to_int31 (p:positive) := p2i size p.
     It is used as default answer for numbers of zeros
     in [head0] and [tail0] *)
 
-Definition T31 : int31 := Eval compute in phi_inv (Z_of_nat size).
+Definition T31 : int31 := Eval compute in phi_inv (Z.of_nat size).
 
 Definition head031 (i:int31) :=
   recl _ (fun _ => T31)
diff --git a/theories/Numbers/Cyclic/Int31/Ring31.v b/theories/Numbers/Cyclic/Int31/Ring31.v
index 37dc0871..f5a08438 100644
--- a/theories/Numbers/Cyclic/Int31/Ring31.v
+++ b/theories/Numbers/Cyclic/Int31/Ring31.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ring31.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** * Int31 numbers defines Z/(2^31)Z, and can hence be equipped
       with a ring structure and a ring tactic *)
 
@@ -83,9 +81,10 @@ Qed.
 Lemma eqb31_eq : forall x y, eqb31 x y = true <-> x=y.
 Proof.
 unfold eqb31. intros x y.
-generalize (Cyclic31.spec_compare x y).
-destruct (x ?= y); intuition; subst; auto with zarith; try discriminate.
-apply Int31_canonic; auto.
+rewrite Cyclic31.spec_compare. case Z.compare_spec.
+intuition. apply Int31_canonic; auto.
+intuition; subst; auto with zarith; try discriminate.
+intuition; subst; auto with zarith; try discriminate.
 Qed.
 
 Lemma eqb31_correct : forall x y, eqb31 x y = true -> x=y.
diff --git a/theories/Numbers/Cyclic/ZModulo/ZModulo.v b/theories/Numbers/Cyclic/ZModulo/ZModulo.v
index aef729bf..9e3f4ef4 100644
--- a/theories/Numbers/Cyclic/ZModulo/ZModulo.v
+++ b/theories/Numbers/Cyclic/ZModulo/ZModulo.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ZModulo.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** * Type [Z] viewed modulo a particular constant corresponds to [Z/nZ]
       as defined abstractly in CyclicAxioms. *)
 
@@ -33,25 +31,23 @@ Section ZModulo.
 
  Definition wB := base digits.
 
- Definition znz := Z.
- Definition znz_digits := digits.
- Definition znz_zdigits := Zpos digits.
- Definition znz_to_Z x := x mod wB.
+ Definition t := Z.
+ Definition zdigits := Zpos digits.
+ Definition to_Z x := x mod wB.
 
- Notation "[| x |]" := (znz_to_Z x)  (at level 0, x at level 99).
+ Notation "[| x |]" := (to_Z x)  (at level 0, x at level 99).
 
  Notation "[+| c |]" :=
-   (interp_carry 1 wB znz_to_Z c)  (at level 0, x at level 99).
+   (interp_carry 1 wB to_Z c)  (at level 0, x at level 99).
 
  Notation "[-| c |]" :=
-   (interp_carry (-1) wB znz_to_Z c)  (at level 0, x at level 99).
+   (interp_carry (-1) wB to_Z c)  (at level 0, x at level 99).
 
  Notation "[|| x ||]" :=
-   (zn2z_to_Z wB znz_to_Z x)  (at level 0, x at level 99).
+   (zn2z_to_Z wB to_Z x)  (at level 0, x at level 99).
 
  Lemma spec_more_than_1_digit: 1 < Zpos digits.
  Proof.
-  unfold znz_digits.
   generalize digits_ne_1; destruct digits; auto.
   destruct 1; auto.
  Qed.
@@ -65,12 +61,12 @@ Section ZModulo.
 
  Lemma spec_to_Z_1 : forall x, 0 <= [|x|].
  Proof.
-  unfold znz_to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto.
+  unfold to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto.
  Qed.
 
  Lemma spec_to_Z_2 : forall x, [|x|] < wB.
  Proof.
-  unfold znz_to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto.
+  unfold to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto.
  Qed.
  Hint Resolve spec_to_Z_1 spec_to_Z_2.
 
@@ -79,111 +75,103 @@ Section ZModulo.
   auto.
  Qed.
 
- Definition znz_of_pos x :=
-   let (q,r) := Zdiv_eucl_POS x wB in (N_of_Z q, r).
+ Definition of_pos x :=
+   let (q,r) := Z.pos_div_eucl x wB in (N_of_Z q, r).
 
  Lemma spec_of_pos : forall p,
-   Zpos p = (Z_of_N (fst (znz_of_pos p)))*wB + [|(snd (znz_of_pos p))|].
+   Zpos p = (Z.of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|].
  Proof.
-  intros; unfold znz_of_pos; simpl.
+  intros; unfold of_pos; simpl.
   generalize (Z_div_mod_POS wB wB_pos p).
-  destruct (Zdiv_eucl_POS p wB); simpl; destruct 1.
-  unfold znz_to_Z; rewrite Zmod_small; auto.
+  destruct (Z.pos_div_eucl p wB); simpl; destruct 1.
+  unfold to_Z; rewrite Zmod_small; auto.
   assert (0 <= z).
    replace z with (Zpos p / wB) by
     (symmetry; apply Zdiv_unique with z0; auto).
    apply Z_div_pos; auto with zarith.
-  replace (Z_of_N (N_of_Z z)) with z by
+  replace (Z.of_N (N_of_Z z)) with z by
     (destruct z; simpl; auto; elim H1; auto).
-  rewrite Zmult_comm; auto.
+  rewrite Z.mul_comm; auto.
  Qed.
 
- Lemma spec_zdigits : [|znz_zdigits|] = Zpos znz_digits.
+ Lemma spec_zdigits : [|zdigits|] = Zpos digits.
  Proof.
-  unfold znz_to_Z, znz_zdigits, znz_digits.
+  unfold to_Z, zdigits.
   apply Zmod_small.
   unfold wB, base.
   split; auto with zarith.
   apply Zpower2_lt_lin; auto with zarith.
  Qed.
 
- Definition znz_0 := 0.
- Definition znz_1 := 1.
- Definition znz_Bm1 := wB - 1.
+ Definition zero := 0.
+ Definition one := 1.
+ Definition minus_one := wB - 1.
 
- Lemma spec_0 : [|znz_0|] = 0.
+ Lemma spec_0 : [|zero|] = 0.
  Proof.
-  unfold znz_to_Z, znz_0.
+  unfold to_Z, zero.
   apply Zmod_small; generalize wB_pos; auto with zarith.
  Qed.
 
- Lemma spec_1 : [|znz_1|] = 1.
+ Lemma spec_1 : [|one|] = 1.
  Proof.
-  unfold znz_to_Z, znz_1.
+  unfold to_Z, one.
   apply Zmod_small; split; auto with zarith.
   unfold wB, base.
-  apply Zlt_trans with (Zpos digits); auto.
+  apply Z.lt_trans with (Zpos digits); auto.
   apply Zpower2_lt_lin; auto with zarith.
  Qed.
 
- Lemma spec_Bm1 : [|znz_Bm1|] = wB - 1.
+ Lemma spec_Bm1 : [|minus_one|] = wB - 1.
  Proof.
-  unfold znz_to_Z, znz_Bm1.
+  unfold to_Z, minus_one.
   apply Zmod_small; split; auto with zarith.
   unfold wB, base.
   cut (1 <= 2 ^ Zpos digits); auto with zarith.
-  apply Zle_trans with (Zpos digits); auto with zarith.
+  apply Z.le_trans with (Zpos digits); auto with zarith.
   apply Zpower2_le_lin; auto with zarith.
  Qed.
 
- Definition znz_compare x y := Zcompare [|x|] [|y|].
+ Definition compare x y := Z.compare [|x|] [|y|].
 
  Lemma spec_compare : forall x y,
-       match znz_compare x y with
-       | Eq => [|x|] = [|y|]
-       | Lt => [|x|] < [|y|]
-       | Gt => [|x|] > [|y|]
-       end.
- Proof.
-  intros; unfold znz_compare, Zlt, Zgt.
-  case_eq (Zcompare [|x|] [|y|]); auto.
-  intros; apply Zcompare_Eq_eq; auto.
- Qed.
+   compare x y = Z.compare [|x|] [|y|].
+ Proof. reflexivity. Qed.
 
- Definition znz_eq0 x :=
+ Definition eq0 x :=
    match [|x|] with Z0 => true | _ => false end.
 
- Lemma spec_eq0 : forall x, znz_eq0 x = true -> [|x|] = 0.
+ Lemma spec_eq0 : forall x, eq0 x = true -> [|x|] = 0.
  Proof.
-  unfold znz_eq0; intros; now destruct [|x|].
+  unfold eq0; intros; now destruct [|x|].
  Qed.
 
- Definition znz_opp_c x :=
-   if znz_eq0 x then C0 0 else C1 (- x).
- Definition znz_opp x := - x.
- Definition znz_opp_carry x := - x - 1.
+ Definition opp_c x :=
+   if eq0 x then C0 0 else C1 (- x).
+ Definition opp x := - x.
+ Definition opp_carry x := - x - 1.
 
- Lemma spec_opp_c : forall x, [-|znz_opp_c x|] = -[|x|].
+ Lemma spec_opp_c : forall x, [-|opp_c x|] = -[|x|].
  Proof.
- intros; unfold znz_opp_c, znz_to_Z; auto.
- case_eq (znz_eq0 x); intros; unfold interp_carry.
+ intros; unfold opp_c, to_Z; auto.
+ case_eq (eq0 x); intros; unfold interp_carry.
  fold [|x|]; rewrite (spec_eq0 x H); auto.
  assert (x mod wB <> 0).
-  unfold znz_eq0, znz_to_Z in H.
+  unfold eq0, to_Z in H.
   intro H0; rewrite H0 in H; discriminate.
  rewrite Z_mod_nz_opp_full; auto with zarith.
  Qed.
 
- Lemma spec_opp : forall x, [|znz_opp x|] = (-[|x|]) mod wB.
+ Lemma spec_opp : forall x, [|opp x|] = (-[|x|]) mod wB.
  Proof.
- intros; unfold znz_opp, znz_to_Z; auto.
+ intros; unfold opp, to_Z; auto.
  change ((- x) mod wB = (0 - (x mod wB)) mod wB).
  rewrite Zminus_mod_idemp_r; simpl; auto.
  Qed.
 
- Lemma spec_opp_carry : forall x, [|znz_opp_carry x|] = wB - [|x|] - 1.
+ Lemma spec_opp_carry : forall x, [|opp_carry x|] = wB - [|x|] - 1.
  Proof.
- intros; unfold znz_opp_carry, znz_to_Z; auto.
+ intros; unfold opp_carry, to_Z; auto.
  replace (- x - 1) with (- 1 - x) by omega.
  rewrite <- Zminus_mod_idemp_r.
  replace ( -1 - x mod wB) with (0 + ( -1 - x mod wB)) by omega.
@@ -194,41 +182,40 @@ Section ZModulo.
  generalize (Z_mod_lt x wB wB_pos); omega.
  Qed.
 
- Definition znz_succ_c x :=
-  let y := Zsucc x in
-  if znz_eq0 y then C1 0 else C0 y.
+ Definition succ_c x :=
+  let y := Z.succ x in
+  if eq0 y then C1 0 else C0 y.
 
- Definition znz_add_c x y :=
+ Definition add_c x y :=
   let z := [|x|] + [|y|] in
   if Z_lt_le_dec z wB then C0 z else C1 (z-wB).
 
- Definition znz_add_carry_c x y :=
+ Definition add_carry_c x y :=
   let z := [|x|]+[|y|]+1 in
   if Z_lt_le_dec z wB then C0 z else C1 (z-wB).
 
- Definition znz_succ := Zsucc.
- Definition znz_add := Zplus.
- Definition znz_add_carry x y := x + y + 1.
+ Definition succ := Z.succ.
+ Definition add := Z.add.
+ Definition add_carry x y := x + y + 1.
 
  Lemma Zmod_equal :
   forall x y z, z>0 -> (x-y) mod z = 0 -> x mod z = y mod z.
  Proof.
  intros.
- generalize (Z_div_mod_eq (x-y) z H); rewrite H0, Zplus_0_r.
+ generalize (Z_div_mod_eq (x-y) z H); rewrite H0, Z.add_0_r.
  remember ((x-y)/z) as k.
- intros H1; symmetry in H1; rewrite <- Zeq_plus_swap in H1.
- subst x.
- rewrite Zplus_comm, Zmult_comm, Z_mod_plus; auto.
+ rewrite Z.sub_move_r, Z.add_comm, Z.mul_comm. intros ->.
+ now apply Z_mod_plus.
  Qed.
 
- Lemma spec_succ_c : forall x, [+|znz_succ_c x|] = [|x|] + 1.
+ Lemma spec_succ_c : forall x, [+|succ_c x|] = [|x|] + 1.
  Proof.
- intros; unfold znz_succ_c, znz_to_Z, Zsucc.
- case_eq (znz_eq0 (x+1)); intros; unfold interp_carry.
+ intros; unfold succ_c, to_Z, Z.succ.
+ case_eq (eq0 (x+1)); intros; unfold interp_carry.
 
- rewrite Zmult_1_l.
+ rewrite Z.mul_1_l.
  replace (wB + 0 mod wB) with wB by auto with zarith.
- symmetry; rewrite Zeq_plus_swap.
+ symmetry. rewrite Z.add_move_r.
  assert ((x+1) mod wB = 0) by (apply spec_eq0; auto).
  replace (wB-1) with ((wB-1) mod wB) by
   (apply Zmod_small; generalize wB_pos; omega).
@@ -236,10 +223,10 @@ Section ZModulo.
  apply Zmod_equal; auto.
 
  assert ((x+1) mod wB <> 0).
-  unfold znz_eq0, znz_to_Z in *; now destruct ((x+1) mod wB).
+  unfold eq0, to_Z in *; now destruct ((x+1) mod wB).
  assert (x mod wB + 1 <> wB).
   contradict H0.
-  rewrite Zeq_plus_swap in H0; simpl in H0.
+  rewrite Z.add_move_r in H0; simpl in H0.
   rewrite <- Zplus_mod_idemp_l; rewrite H0.
   replace (wB-1+1) with wB; auto with zarith; apply Z_mod_same; auto.
  rewrite <- Zplus_mod_idemp_l.
@@ -247,81 +234,81 @@ Section ZModulo.
  generalize (Z_mod_lt x wB wB_pos); omega.
  Qed.
 
- Lemma spec_add_c : forall x y, [+|znz_add_c x y|] = [|x|] + [|y|].
+ Lemma spec_add_c : forall x y, [+|add_c x y|] = [|x|] + [|y|].
  Proof.
- intros; unfold znz_add_c, znz_to_Z, interp_carry.
+ intros; unfold add_c, to_Z, interp_carry.
  destruct Z_lt_le_dec.
  apply Zmod_small;
   generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega.
- rewrite Zmult_1_l, Zplus_comm, Zeq_plus_swap.
+ rewrite Z.mul_1_l, Z.add_comm, Z.add_move_r.
  apply Zmod_small;
   generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega.
  Qed.
 
- Lemma spec_add_carry_c : forall x y, [+|znz_add_carry_c x y|] = [|x|] + [|y|] + 1.
+ Lemma spec_add_carry_c : forall x y, [+|add_carry_c x y|] = [|x|] + [|y|] + 1.
  Proof.
- intros; unfold znz_add_carry_c, znz_to_Z, interp_carry.
+ intros; unfold add_carry_c, to_Z, interp_carry.
  destruct Z_lt_le_dec.
  apply Zmod_small;
   generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega.
- rewrite Zmult_1_l, Zplus_comm, Zeq_plus_swap.
+ rewrite Z.mul_1_l, Z.add_comm, Z.add_move_r.
  apply Zmod_small;
   generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega.
  Qed.
 
- Lemma spec_succ : forall x, [|znz_succ x|] = ([|x|] + 1) mod wB.
+ Lemma spec_succ : forall x, [|succ x|] = ([|x|] + 1) mod wB.
  Proof.
- intros; unfold znz_succ, znz_to_Z, Zsucc.
+ intros; unfold succ, to_Z, Z.succ.
  symmetry; apply Zplus_mod_idemp_l.
  Qed.
 
- Lemma spec_add : forall x y, [|znz_add x y|] = ([|x|] + [|y|]) mod wB.
+ Lemma spec_add : forall x y, [|add x y|] = ([|x|] + [|y|]) mod wB.
  Proof.
- intros; unfold znz_add, znz_to_Z; apply Zplus_mod.
+ intros; unfold add, to_Z; apply Zplus_mod.
  Qed.
 
  Lemma spec_add_carry :
-	 forall x y, [|znz_add_carry x y|] = ([|x|] + [|y|] + 1) mod wB.
+	 forall x y, [|add_carry x y|] = ([|x|] + [|y|] + 1) mod wB.
  Proof.
- intros; unfold znz_add_carry, znz_to_Z.
+ intros; unfold add_carry, to_Z.
  rewrite <- Zplus_mod_idemp_l.
  rewrite (Zplus_mod x y).
  rewrite Zplus_mod_idemp_l; auto.
  Qed.
 
- Definition znz_pred_c x :=
-  if znz_eq0 x then C1 (wB-1) else C0 (x-1).
+ Definition pred_c x :=
+  if eq0 x then C1 (wB-1) else C0 (x-1).
 
- Definition znz_sub_c x y :=
+ Definition sub_c x y :=
   let z := [|x|]-[|y|] in
   if Z_lt_le_dec z 0 then C1 (wB+z) else C0 z.
 
- Definition znz_sub_carry_c x y :=
+ Definition sub_carry_c x y :=
   let z := [|x|]-[|y|]-1 in
   if Z_lt_le_dec z 0 then C1 (wB+z) else C0 z.
 
- Definition znz_pred := Zpred.
- Definition znz_sub := Zminus.
- Definition znz_sub_carry x y := x - y - 1.
+ Definition pred := Z.pred.
+ Definition sub := Z.sub.
+ Definition sub_carry x y := x - y - 1.
 
- Lemma spec_pred_c : forall x, [-|znz_pred_c x|] = [|x|] - 1.
+ Lemma spec_pred_c : forall x, [-|pred_c x|] = [|x|] - 1.
  Proof.
- intros; unfold znz_pred_c, znz_to_Z, interp_carry.
- case_eq (znz_eq0 x); intros.
+ intros; unfold pred_c, to_Z, interp_carry.
+ case_eq (eq0 x); intros.
  fold [|x|]; rewrite spec_eq0; auto.
  replace ((wB-1) mod wB) with (wB-1); auto with zarith.
  symmetry; apply Zmod_small; generalize wB_pos; omega.
 
  assert (x mod wB <> 0).
-  unfold znz_eq0, znz_to_Z in *; now destruct (x mod wB).
+  unfold eq0, to_Z in *; now destruct (x mod wB).
  rewrite <- Zminus_mod_idemp_l.
  apply Zmod_small.
  generalize (Z_mod_lt x wB wB_pos); omega.
  Qed.
 
- Lemma spec_sub_c : forall x y, [-|znz_sub_c x y|] = [|x|] - [|y|].
+ Lemma spec_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|].
  Proof.
- intros; unfold znz_sub_c, znz_to_Z, interp_carry.
+ intros; unfold sub_c, to_Z, interp_carry.
  destruct Z_lt_le_dec.
  replace ((wB + (x mod wB - y mod wB)) mod wB) with
    (wB + (x mod wB - y mod wB)).
@@ -333,9 +320,9 @@ Section ZModulo.
  generalize wB_pos (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega.
  Qed.
 
- Lemma spec_sub_carry_c : forall x y, [-|znz_sub_carry_c x y|] = [|x|] - [|y|] - 1.
+ Lemma spec_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|] - [|y|] - 1.
  Proof.
- intros; unfold znz_sub_carry_c, znz_to_Z, interp_carry.
+ intros; unfold sub_carry_c, to_Z, interp_carry.
  destruct Z_lt_le_dec.
  replace ((wB + (x mod wB - y mod wB - 1)) mod wB) with
    (wB + (x mod wB - y mod wB -1)).
@@ -347,41 +334,41 @@ Section ZModulo.
  generalize wB_pos (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega.
  Qed.
 
- Lemma spec_pred : forall x, [|znz_pred x|] = ([|x|] - 1) mod wB.
+ Lemma spec_pred : forall x, [|pred x|] = ([|x|] - 1) mod wB.
  Proof.
- intros; unfold znz_pred, znz_to_Z, Zpred.
+ intros; unfold pred, to_Z, Z.pred.
  rewrite <- Zplus_mod_idemp_l; auto.
  Qed.
 
- Lemma spec_sub : forall x y, [|znz_sub x y|] = ([|x|] - [|y|]) mod wB.
+ Lemma spec_sub : forall x y, [|sub x y|] = ([|x|] - [|y|]) mod wB.
  Proof.
- intros; unfold znz_sub, znz_to_Z; apply Zminus_mod.
+ intros; unfold sub, to_Z; apply Zminus_mod.
  Qed.
 
  Lemma spec_sub_carry :
-  forall x y, [|znz_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB.
+  forall x y, [|sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB.
  Proof.
- intros; unfold znz_sub_carry, znz_to_Z.
+ intros; unfold sub_carry, to_Z.
  rewrite <- Zminus_mod_idemp_l.
  rewrite (Zminus_mod x y).
  rewrite Zminus_mod_idemp_l.
  auto.
  Qed.
 
- Definition znz_mul_c x y :=
-  let (h,l) := Zdiv_eucl ([|x|]*[|y|]) wB in
-  if znz_eq0 h then if znz_eq0 l then W0 else WW h l else WW h l.
+ Definition mul_c x y :=
+  let (h,l) := Z.div_eucl ([|x|]*[|y|]) wB in
+  if eq0 h then if eq0 l then W0 else WW h l else WW h l.
 
- Definition znz_mul := Zmult.
+ Definition mul := Z.mul.
 
- Definition znz_square_c x := znz_mul_c x x.
+ Definition square_c x := mul_c x x.
 
- Lemma spec_mul_c : forall x y, [|| znz_mul_c x y ||] = [|x|] * [|y|].
+ Lemma spec_mul_c : forall x y, [|| mul_c x y ||] = [|x|] * [|y|].
  Proof.
- intros; unfold znz_mul_c, zn2z_to_Z.
- assert (Zdiv_eucl ([|x|]*[|y|]) wB = (([|x|]*[|y|])/wB,([|x|]*[|y|]) mod wB)).
-  unfold Zmod, Zdiv; destruct Zdiv_eucl; auto.
- generalize (Z_div_mod ([|x|]*[|y|]) wB wB_pos); destruct Zdiv_eucl as (h,l).
+ intros; unfold mul_c, zn2z_to_Z.
+ assert (Z.div_eucl ([|x|]*[|y|]) wB = (([|x|]*[|y|])/wB,([|x|]*[|y|]) mod wB)).
+  unfold Z.modulo, Z.div; destruct Z.div_eucl; auto.
+ generalize (Z_div_mod ([|x|]*[|y|]) wB wB_pos); destruct Z.div_eucl as (h,l).
  destruct 1; injection H; clear H; intros.
  rewrite H0.
  assert ([|l|] = l).
@@ -392,38 +379,38 @@ Section ZModulo.
   split.
   apply Z_div_pos; auto with zarith.
   apply Zdiv_lt_upper_bound; auto with zarith.
-  apply Zmult_lt_compat; auto with zarith.
+  apply Z.mul_lt_mono_nonneg; auto with zarith.
  clear H H0 H1 H2.
- case_eq (znz_eq0 h); simpl; intros.
- case_eq (znz_eq0 l); simpl; intros.
+ case_eq (eq0 h); simpl; intros.
+ case_eq (eq0 l); simpl; intros.
  rewrite <- H3, <- H4, (spec_eq0 h), (spec_eq0 l); auto with zarith.
  rewrite H3, H4; auto with zarith.
  rewrite H3, H4; auto with zarith.
  Qed.
 
- Lemma spec_mul : forall x y, [|znz_mul x y|] = ([|x|] * [|y|]) mod wB.
+ Lemma spec_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wB.
  Proof.
- intros; unfold znz_mul, znz_to_Z; apply Zmult_mod.
+ intros; unfold mul, to_Z; apply Zmult_mod.
  Qed.
 
- Lemma spec_square_c : forall x, [|| znz_square_c x||] = [|x|] * [|x|].
+ Lemma spec_square_c : forall x, [|| square_c x||] = [|x|] * [|x|].
  Proof.
  intros x; exact (spec_mul_c x x).
  Qed.
 
- Definition znz_div x y := Zdiv_eucl [|x|] [|y|].
+ Definition div x y := Z.div_eucl [|x|] [|y|].
 
  Lemma spec_div : forall a b, 0 < [|b|] ->
-      let (q,r) := znz_div a b in
+      let (q,r) := div a b in
       [|a|] = [|q|] * [|b|] + [|r|] /\
       0 <= [|r|] < [|b|].
  Proof.
- intros; unfold znz_div.
+ intros; unfold div.
  assert ([|b|]>0) by auto with zarith.
- assert (Zdiv_eucl [|a|] [|b|] = ([|a|]/[|b|], [|a|] mod [|b|])).
-  unfold Zmod, Zdiv; destruct Zdiv_eucl; auto.
+ assert (Z.div_eucl [|a|] [|b|] = ([|a|]/[|b|], [|a|] mod [|b|])).
+  unfold Z.modulo, Z.div; destruct Z.div_eucl; auto.
  generalize (Z_div_mod [|a|] [|b|] H0).
- destruct Zdiv_eucl as (q,r); destruct 1; intros.
+ destruct Z.div_eucl as (q,r); destruct 1; intros.
  injection H1; clear H1; intros.
  assert ([|r|]=r).
   apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|];
@@ -434,16 +421,16 @@ Section ZModulo.
   split.
   apply Z_div_pos; auto with zarith.
   apply Zdiv_lt_upper_bound; auto with zarith.
-  apply Zlt_le_trans with (wB*1).
-  rewrite Zmult_1_r; auto with zarith.
-  apply Zmult_le_compat; generalize wB_pos; auto with zarith.
- rewrite H5, H6; rewrite Zmult_comm; auto with zarith.
+  apply Z.lt_le_trans with (wB*1).
+  rewrite Z.mul_1_r; auto with zarith.
+  apply Z.mul_le_mono_nonneg; generalize wB_pos; auto with zarith.
+ rewrite H5, H6; rewrite Z.mul_comm; auto with zarith.
  Qed.
 
- Definition znz_div_gt := znz_div.
+ Definition div_gt := div.
 
  Lemma spec_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] ->
-      let (q,r) := znz_div_gt a b in
+      let (q,r) := div_gt a b in
       [|a|] = [|q|] * [|b|] + [|r|] /\
       0 <= [|r|] < [|b|].
  Proof.
@@ -451,90 +438,90 @@ Section ZModulo.
  apply spec_div; auto.
  Qed.
 
- Definition znz_mod x y := [|x|] mod [|y|].
- Definition znz_mod_gt x y := [|x|] mod [|y|].
+ Definition modulo x y := [|x|] mod [|y|].
+ Definition modulo_gt x y := [|x|] mod [|y|].
 
- Lemma spec_mod :  forall a b, 0 < [|b|] ->
-      [|znz_mod a b|] = [|a|] mod [|b|].
+ Lemma spec_modulo :  forall a b, 0 < [|b|] ->
+      [|modulo a b|] = [|a|] mod [|b|].
  Proof.
- intros; unfold znz_mod.
+ intros; unfold modulo.
  apply Zmod_small.
  assert ([|b|]>0) by auto with zarith.
  generalize (Z_mod_lt [|a|] [|b|] H0) (Z_mod_lt b wB wB_pos).
  fold [|b|]; omega.
  Qed.
 
- Lemma spec_mod_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] ->
-      [|znz_mod_gt a b|] = [|a|] mod [|b|].
+ Lemma spec_modulo_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] ->
+      [|modulo_gt a b|] = [|a|] mod [|b|].
  Proof.
- intros; apply spec_mod; auto.
+ intros; apply spec_modulo; auto.
  Qed.
 
- Definition znz_gcd x y := Zgcd [|x|] [|y|].
- Definition znz_gcd_gt x y := Zgcd [|x|] [|y|].
+ Definition gcd x y := Z.gcd [|x|] [|y|].
+ Definition gcd_gt x y := Z.gcd [|x|] [|y|].
 
- Lemma Zgcd_bound : forall a b, 0<=a -> 0<=b -> Zgcd a b <= Zmax a b.
+ Lemma Zgcd_bound : forall a b, 0<=a -> 0<=b -> Z.gcd a b <= Z.max a b.
  Proof.
  intros.
  generalize (Zgcd_is_gcd a b); inversion_clear 1.
- destruct H2; destruct H3; clear H4.
- assert (H3:=Zgcd_is_pos a b).
- destruct (Z_eq_dec (Zgcd a b) 0).
+ destruct H2 as (q,H2); destruct H3 as (q',H3); clear H4.
+ assert (H4:=Z.gcd_nonneg a b).
+ destruct (Z.eq_dec (Z.gcd a b) 0).
  rewrite e; generalize (Zmax_spec a b); omega.
  assert (0 <= q).
-  apply Zmult_le_reg_r with (Zgcd a b); auto with zarith.
- destruct (Z_eq_dec q 0).
+  apply Z.mul_le_mono_pos_r with (Z.gcd a b); auto with zarith.
+ destruct (Z.eq_dec q 0).
 
  subst q; simpl in *; subst a; simpl; auto.
  generalize (Zmax_spec 0 b) (Zabs_spec b); omega.
 
- apply Zle_trans with a.
- rewrite H1 at 2.
- rewrite <- (Zmult_1_l (Zgcd a b)) at 1.
- apply Zmult_le_compat; auto with zarith.
+ apply Z.le_trans with a.
+ rewrite H2 at 2.
+ rewrite <- (Z.mul_1_l (Z.gcd a b)) at 1.
+ apply Z.mul_le_mono_nonneg; auto with zarith.
  generalize (Zmax_spec a b); omega.
  Qed.
 
- Lemma spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|znz_gcd a b|].
+ Lemma spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|].
  Proof.
- intros; unfold znz_gcd.
+ intros; unfold gcd.
  generalize (Z_mod_lt a wB wB_pos)(Z_mod_lt b wB wB_pos); intros.
  fold [|a|] in *; fold [|b|] in *.
- replace ([|Zgcd [|a|] [|b|]|]) with (Zgcd [|a|] [|b|]).
+ replace ([|Z.gcd [|a|] [|b|]|]) with (Z.gcd [|a|] [|b|]).
  apply Zgcd_is_gcd.
  symmetry; apply Zmod_small.
  split.
- apply Zgcd_is_pos.
- apply Zle_lt_trans with (Zmax [|a|] [|b|]).
+ apply Z.gcd_nonneg.
+ apply Z.le_lt_trans with (Z.max [|a|] [|b|]).
  apply Zgcd_bound; auto with zarith.
  generalize (Zmax_spec [|a|] [|b|]); omega.
  Qed.
 
  Lemma spec_gcd_gt : forall a b, [|a|] > [|b|] ->
-      Zis_gcd [|a|] [|b|] [|znz_gcd_gt a b|].
+      Zis_gcd [|a|] [|b|] [|gcd_gt a b|].
  Proof.
   intros. apply spec_gcd; auto.
  Qed.
 
- Definition znz_div21 a1 a2 b :=
-  Zdiv_eucl ([|a1|]*wB+[|a2|]) [|b|].
+ Definition div21 a1 a2 b :=
+  Z.div_eucl ([|a1|]*wB+[|a2|]) [|b|].
 
  Lemma spec_div21 : forall a1 a2 b,
       wB/2 <= [|b|] ->
       [|a1|] < [|b|] ->
-      let (q,r) := znz_div21 a1 a2 b in
+      let (q,r) := div21 a1 a2 b in
       [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\
       0 <= [|r|] < [|b|].
  Proof.
- intros; unfold znz_div21.
+ intros; unfold div21.
  generalize (Z_mod_lt a1 wB wB_pos); fold [|a1|]; intros.
  generalize (Z_mod_lt a2 wB wB_pos); fold [|a2|]; intros.
  assert ([|b|]>0) by auto with zarith.
  remember ([|a1|]*wB+[|a2|]) as a.
- assert (Zdiv_eucl a [|b|] = (a/[|b|], a mod [|b|])).
-  unfold Zmod, Zdiv; destruct Zdiv_eucl; auto.
+ assert (Z.div_eucl a [|b|] = (a/[|b|], a mod [|b|])).
+  unfold Z.modulo, Z.div; destruct Z.div_eucl; auto.
  generalize (Z_div_mod a [|b|] H3).
- destruct Zdiv_eucl as (q,r); destruct 1; intros.
+ destruct Z.div_eucl as (q,r); destruct 1; intros.
  injection H4; clear H4; intros.
  assert ([|r|]=r).
   apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|];
@@ -548,109 +535,102 @@ Section ZModulo.
   apply Zdiv_lt_upper_bound; auto with zarith.
   subst a.
   replace (wB*[|b|]) with (([|b|]-1)*wB + wB) by ring.
-  apply Zlt_le_trans with ([|a1|]*wB+wB); auto with zarith.
- rewrite H8, H9; rewrite Zmult_comm; auto with zarith.
+  apply Z.lt_le_trans with ([|a1|]*wB+wB); auto with zarith.
+ rewrite H8, H9; rewrite Z.mul_comm; auto with zarith.
  Qed.
 
- Definition znz_add_mul_div p x y :=
-   ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos znz_digits) - [|p|]))).
+ Definition add_mul_div p x y :=
+   ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos digits) - [|p|]))).
  Lemma spec_add_mul_div : forall x y p,
-       [|p|] <= Zpos znz_digits ->
-       [| znz_add_mul_div p x y |] =
+       [|p|] <= Zpos digits ->
+       [| add_mul_div p x y |] =
          ([|x|] * (2 ^ [|p|]) +
-          [|y|] / (2 ^ ((Zpos znz_digits) - [|p|]))) mod wB.
+          [|y|] / (2 ^ ((Zpos digits) - [|p|]))) mod wB.
  Proof.
- intros; unfold znz_add_mul_div; auto.
+ intros; unfold add_mul_div; auto.
  Qed.
 
- Definition znz_pos_mod p w := [|w|] mod (2 ^ [|p|]).
+ Definition pos_mod p w := [|w|] mod (2 ^ [|p|]).
  Lemma spec_pos_mod : forall w p,
-       [|znz_pos_mod p w|] = [|w|] mod (2 ^ [|p|]).
+       [|pos_mod p w|] = [|w|] mod (2 ^ [|p|]).
  Proof.
- intros; unfold znz_pos_mod.
+ intros; unfold pos_mod.
  apply Zmod_small.
  generalize (Z_mod_lt [|w|] (2 ^ [|p|])); intros.
  split.
  destruct H; auto with zarith.
- apply Zle_lt_trans with [|w|]; auto with zarith.
+ apply Z.le_lt_trans with [|w|]; auto with zarith.
  apply Zmod_le; auto with zarith.
  Qed.
 
- Definition znz_is_even x :=
-   if Z_eq_dec ([|x|] mod 2) 0 then true else false.
+ Definition is_even x :=
+   if Z.eq_dec ([|x|] mod 2) 0 then true else false.
 
  Lemma spec_is_even : forall x,
-      if znz_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1.
+      if is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1.
  Proof.
- intros; unfold znz_is_even; destruct Z_eq_dec; auto.
+ intros; unfold is_even; destruct Z.eq_dec; auto.
  generalize (Z_mod_lt [|x|] 2); omega.
  Qed.
 
- Definition znz_sqrt x := Zsqrt_plain [|x|].
+ Definition sqrt x := Z.sqrt [|x|].
  Lemma spec_sqrt : forall x,
-       [|znz_sqrt x|] ^ 2 <= [|x|] < ([|znz_sqrt x|] + 1) ^ 2.
+       [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2.
  Proof.
  intros.
- unfold znz_sqrt.
- repeat rewrite Zpower_2.
- replace [|Zsqrt_plain [|x|]|] with (Zsqrt_plain [|x|]).
- apply Zsqrt_interval; auto with zarith.
+ unfold sqrt.
+ repeat rewrite Z.pow_2_r.
+ replace [|Z.sqrt [|x|]|] with (Z.sqrt [|x|]).
+ apply Z.sqrt_spec; auto with zarith.
  symmetry; apply Zmod_small.
- split.
- apply Zsqrt_plain_is_pos; auto with zarith.
-
- cut (Zsqrt_plain [|x|] <= (wB-1)); try omega.
- rewrite <- (Zsqrt_square_id (wB-1)).
- apply Zsqrt_le.
- split; auto.
- apply Zle_trans with (wB-1); auto with zarith.
- generalize (spec_to_Z x); auto with zarith.
- apply Zsquare_le.
- generalize wB_pos; auto with zarith.
+ split. apply Z.sqrt_nonneg; auto.
+ apply Z.le_lt_trans with [|x|]; auto.
+ apply Z.sqrt_le_lin; auto.
  Qed.
 
- Definition znz_sqrt2 x y :=
+ Definition sqrt2 x y :=
   let z := [|x|]*wB+[|y|] in
   match z with
    | Z0 => (0, C0 0)
    | Zpos p =>
-      let (s,r,_,_) := sqrtrempos p in
+      let (s,r) := Z.sqrtrem (Zpos p) in
       (s, if Z_lt_le_dec r wB then C0 r else C1 (r-wB))
    | Zneg _ => (0, C0 0)
   end.
 
  Lemma spec_sqrt2 : forall x y,
        wB/ 4 <= [|x|] ->
-       let (s,r) := znz_sqrt2 x y in
+       let (s,r) := sqrt2 x y in
           [||WW x y||] = [|s|] ^ 2 + [+|r|] /\
           [+|r|] <= 2 * [|s|].
  Proof.
- intros; unfold znz_sqrt2.
+ intros; unfold sqrt2.
  simpl zn2z_to_Z.
  remember ([|x|]*wB+[|y|]) as z.
  destruct z.
  auto with zarith.
- destruct sqrtrempos; intros.
+ generalize (Z.sqrtrem_spec (Zpos p)).
+ destruct Z.sqrtrem as (s,r); intros [U V]; auto with zarith.
  assert (s < wB).
   destruct (Z_lt_le_dec s wB); auto.
   assert (wB * wB <= Zpos p).
-   rewrite e.
-   apply Zle_trans with (s*s); try omega.
-   apply Zmult_le_compat; generalize wB_pos; auto with zarith.
+   rewrite U.
+   apply Z.le_trans with (s*s); try omega.
+   apply Z.mul_le_mono_nonneg; generalize wB_pos; auto with zarith.
   assert (Zpos p < wB*wB).
    rewrite Heqz.
    replace (wB*wB) with ((wB-1)*wB+wB) by ring.
-   apply Zplus_le_lt_compat; auto with zarith.
-   apply Zmult_le_compat; auto with zarith.
+   apply Z.add_le_lt_mono; auto with zarith.
+   apply Z.mul_le_mono_nonneg; auto with zarith.
    generalize (spec_to_Z x); auto with zarith.
    generalize wB_pos; auto with zarith.
   omega.
  replace [|s|] with s by (symmetry; apply Zmod_small; auto with zarith).
  destruct Z_lt_le_dec; unfold interp_carry.
  replace [|r|] with r by (symmetry; apply Zmod_small; auto with zarith).
- rewrite Zpower_2; auto with zarith.
+ rewrite Z.pow_2_r; auto with zarith.
  replace [|r-wB|] with (r-wB) by (symmetry; apply Zmod_small; auto with zarith).
- rewrite Zpower_2; omega.
+ rewrite Z.pow_2_r; omega.
 
  assert (0<=Zneg p).
   rewrite Heqz; generalize wB_pos; auto with zarith.
@@ -665,15 +645,15 @@ Section ZModulo.
  apply two_power_pos_correct.
  Qed.
 
- Definition znz_head0 x := match [|x|] with
-   | Z0 => znz_zdigits
-   | Zpos p => znz_zdigits - log_inf p - 1
+ Definition head0 x := match [|x|] with
+   | Z0 => zdigits
+   | Zpos p => zdigits - log_inf p - 1
    | _ => 0
   end.
 
- Lemma spec_head00:  forall x, [|x|] = 0 -> [|znz_head0 x|] = Zpos znz_digits.
+ Lemma spec_head00:  forall x, [|x|] = 0 -> [|head0 x|] = Zpos digits.
  Proof.
-  unfold znz_head0; intros.
+  unfold head0; intros.
   rewrite H; simpl.
   apply spec_zdigits.
  Qed.
@@ -686,58 +666,58 @@ Section ZModulo.
  cut (log_inf x < p - 1); [omega| ].
  apply IHx.
  change (Zpos x~1) with (2*(Zpos x)+1) in H.
- replace p with (Zsucc (p-1)) in H; auto with zarith.
- rewrite Zpower_Zsucc in H; auto with zarith.
+ replace p with (Z.succ (p-1)) in H; auto with zarith.
+ rewrite Z.pow_succ_r in H; auto with zarith.
 
  assert (0 < p) by (destruct p; compute; auto with zarith; discriminate).
  cut (log_inf x < p - 1); [omega| ].
  apply IHx.
  change (Zpos x~0) with (2*(Zpos x)) in H.
- replace p with (Zsucc (p-1)) in H; auto with zarith.
- rewrite Zpower_Zsucc in H; auto with zarith.
+ replace p with (Z.succ (p-1)) in H; auto with zarith.
+ rewrite Z.pow_succ_r in H; auto with zarith.
 
  simpl; intros; destruct p; compute; auto with zarith.
  Qed.
 
 
  Lemma spec_head0  : forall x,  0 < [|x|] ->
-	 wB/ 2 <= 2 ^ ([|znz_head0 x|]) * [|x|] < wB.
+	 wB/ 2 <= 2 ^ ([|head0 x|]) * [|x|] < wB.
  Proof.
- intros; unfold znz_head0.
+ intros; unfold head0.
  generalize (spec_to_Z x).
  destruct [|x|]; try discriminate.
  intros.
  destruct (log_inf_correct p).
  rewrite 2 two_p_power2 in H2; auto with zarith.
- assert (0 <= znz_zdigits - log_inf p - 1 < wB).
+ assert (0 <= zdigits - log_inf p - 1 < wB).
   split.
-  cut (log_inf p < znz_zdigits); try omega.
-  unfold znz_zdigits.
+  cut (log_inf p < zdigits); try omega.
+  unfold zdigits.
   unfold wB, base in *.
   apply log_inf_bounded; auto with zarith.
-  apply Zlt_trans with znz_zdigits.
+  apply Z.lt_trans with zdigits.
   omega.
-  unfold znz_zdigits, wB, base; apply Zpower2_lt_lin; auto with zarith.
+  unfold zdigits, wB, base; apply Zpower2_lt_lin; auto with zarith.
 
- unfold znz_to_Z; rewrite (Zmod_small _ _ H3).
+ unfold to_Z; rewrite (Zmod_small _ _ H3).
  destruct H2.
  split.
- apply Zle_trans with (2^(znz_zdigits - log_inf p - 1)*(2^log_inf p)).
+ apply Z.le_trans with (2^(zdigits - log_inf p - 1)*(2^log_inf p)).
  apply Zdiv_le_upper_bound; auto with zarith.
  rewrite <- Zpower_exp; auto with zarith.
- rewrite Zmult_comm; rewrite <- Zpower_Zsucc; auto with zarith.
- replace (Zsucc (znz_zdigits - log_inf p -1 +log_inf p)) with znz_zdigits
+ rewrite Z.mul_comm; rewrite <- Z.pow_succ_r; auto with zarith.
+ replace (Z.succ (zdigits - log_inf p -1 +log_inf p)) with zdigits
    by ring.
- unfold wB, base, znz_zdigits; auto with zarith.
- apply Zmult_le_compat; auto with zarith.
+ unfold wB, base, zdigits; auto with zarith.
+ apply Z.mul_le_mono_nonneg; auto with zarith.
 
- apply Zlt_le_trans
-   with (2^(znz_zdigits - log_inf p - 1)*(2^(Zsucc (log_inf p)))).
- apply Zmult_lt_compat_l; auto with zarith.
+ apply Z.lt_le_trans
+   with (2^(zdigits - log_inf p - 1)*(2^(Z.succ (log_inf p)))).
+ apply Z.mul_lt_mono_pos_l; auto with zarith.
  rewrite <- Zpower_exp; auto with zarith.
- replace (znz_zdigits - log_inf p -1 +Zsucc (log_inf p)) with znz_zdigits
+ replace (zdigits - log_inf p -1 +Z.succ (log_inf p)) with zdigits
    by ring.
- unfold wB, base, znz_zdigits; auto with zarith.
+ unfold wB, base, zdigits; auto with zarith.
  Qed.
 
  Fixpoint Ptail p := match p with
@@ -758,120 +738,120 @@ Section ZModulo.
  assert (d <> xH).
   intro; subst.
   compute in H; destruct p; discriminate.
- assert (Zsucc (Zpos (Ppred d)) = Zpos d).
+ assert (Z.succ (Zpos (Pos.pred d)) = Zpos d).
   simpl; f_equal.
-  rewrite <- Pplus_one_succ_r.
-  destruct (Psucc_pred d); auto.
+  rewrite Pos.add_1_r.
+  destruct (Pos.succ_pred_or d); auto.
   rewrite H1 in H0; elim H0; auto.
- assert (Ptail p < Zpos (Ppred d)).
+ assert (Ptail p < Zpos (Pos.pred d)).
   apply IHp.
-  apply Zmult_lt_reg_r with 2; auto with zarith.
-  rewrite (Zmult_comm (Zpos p)).
+  apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
+  rewrite (Z.mul_comm (Zpos p)).
   change (2 * Zpos p) with (Zpos p~0).
-  rewrite Zmult_comm.
-  rewrite <- Zpower_Zsucc; auto with zarith.
+  rewrite Z.mul_comm.
+  rewrite <- Z.pow_succ_r; auto with zarith.
   rewrite H1; auto.
  rewrite <- H1; omega.
  Qed.
 
- Definition znz_tail0 x :=
+ Definition tail0 x :=
   match [|x|] with
-   | Z0 => znz_zdigits
+   | Z0 => zdigits
    | Zpos p => Ptail p
    | Zneg _ => 0
   end.
 
- Lemma spec_tail00:  forall x, [|x|] = 0 -> [|znz_tail0 x|] = Zpos znz_digits.
+ Lemma spec_tail00:  forall x, [|x|] = 0 -> [|tail0 x|] = Zpos digits.
  Proof.
-  unfold znz_tail0; intros.
+  unfold tail0; intros.
   rewrite H; simpl.
   apply spec_zdigits.
  Qed.
 
  Lemma spec_tail0  : forall x, 0 < [|x|] ->
-         exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|znz_tail0 x|]).
+         exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|tail0 x|]).
  Proof.
- intros; unfold znz_tail0.
+ intros; unfold tail0.
  generalize (spec_to_Z x).
  destruct [|x|]; try discriminate; intros.
  assert ([|Ptail p|] = Ptail p).
   apply Zmod_small.
   split; auto.
   unfold wB, base in *.
-  apply Zlt_trans with (Zpos digits).
+  apply Z.lt_trans with (Zpos digits).
   apply Ptail_bounded; auto with zarith.
   apply Zpower2_lt_lin; auto with zarith.
  rewrite H1.
 
  clear; induction p.
- exists (Zpos p); simpl; rewrite Pmult_1_r; auto with zarith.
+ exists (Zpos p); simpl; rewrite Pos.mul_1_r; auto with zarith.
  destruct IHp as (y & Yp & Ye).
  exists y.
  split; auto.
  change (Zpos p~0) with (2*Zpos p).
  rewrite Ye.
- change (Ptail p~0) with (Zsucc (Ptail p)).
- rewrite Zpower_Zsucc; auto; ring.
+ change (Ptail p~0) with (Z.succ (Ptail p)).
+ rewrite Z.pow_succ_r; auto; ring.
 
  exists 0; simpl; auto with zarith.
  Qed.
 
  (** Let's now group everything in two records *)
 
- Definition zmod_op := mk_znz_op
-    (znz_digits : positive)
-    (znz_zdigits: znz)
-    (znz_to_Z   : znz -> Z)
-    (znz_of_pos : positive -> N * znz)
-    (znz_head0  : znz -> znz)
-    (znz_tail0  : znz -> znz)
-
-    (znz_0   : znz)
-    (znz_1   : znz)
-    (znz_Bm1 : znz)
-
-    (znz_compare     : znz -> znz -> comparison)
-    (znz_eq0         : znz -> bool)
-
-    (znz_opp_c       : znz -> carry znz)
-    (znz_opp         : znz -> znz)
-    (znz_opp_carry   : znz -> znz)
-
-    (znz_succ_c      : znz -> carry znz)
-    (znz_add_c       : znz -> znz -> carry znz)
-    (znz_add_carry_c : znz -> znz -> carry znz)
-    (znz_succ        : znz -> znz)
-    (znz_add         : znz -> znz -> znz)
-    (znz_add_carry   : znz -> znz -> znz)
-
-    (znz_pred_c      : znz -> carry znz)
-    (znz_sub_c       : znz -> znz -> carry znz)
-    (znz_sub_carry_c : znz -> znz -> carry znz)
-    (znz_pred        : znz -> znz)
-    (znz_sub         : znz -> znz -> znz)
-    (znz_sub_carry   : znz -> znz -> znz)
-
-    (znz_mul_c       : znz -> znz -> zn2z znz)
-    (znz_mul         : znz -> znz -> znz)
-    (znz_square_c    : znz -> zn2z znz)
-
-    (znz_div21       : znz -> znz -> znz -> znz*znz)
-    (znz_div_gt      : znz -> znz -> znz * znz)
-    (znz_div         : znz -> znz -> znz * znz)
-
-    (znz_mod_gt      : znz -> znz -> znz)
-    (znz_mod         : znz -> znz -> znz)
-
-    (znz_gcd_gt      : znz -> znz -> znz)
-    (znz_gcd         : znz -> znz -> znz)
-    (znz_add_mul_div : znz -> znz -> znz -> znz)
-    (znz_pos_mod     : znz -> znz -> znz)
-
-    (znz_is_even     : znz -> bool)
-    (znz_sqrt2       : znz -> znz -> znz * carry znz)
-    (znz_sqrt        : znz -> znz).
-
- Definition zmod_spec := mk_znz_spec zmod_op
+ Instance zmod_ops : ZnZ.Ops Z := ZnZ.MkOps
+    (digits : positive)
+    (zdigits: t)
+    (to_Z   : t -> Z)
+    (of_pos : positive -> N * t)
+    (head0  : t -> t)
+    (tail0  : t -> t)
+
+    (zero   : t)
+    (one    : t)
+    (minus_one : t)
+
+    (compare     : t -> t -> comparison)
+    (eq0         : t -> bool)
+
+    (opp_c       : t -> carry t)
+    (opp         : t -> t)
+    (opp_carry   : t -> t)
+
+    (succ_c      : t -> carry t)
+    (add_c       : t -> t -> carry t)
+    (add_carry_c : t -> t -> carry t)
+    (succ        : t -> t)
+    (add         : t -> t -> t)
+    (add_carry   : t -> t -> t)
+
+    (pred_c      : t -> carry t)
+    (sub_c       : t -> t -> carry t)
+    (sub_carry_c : t -> t -> carry t)
+    (pred        : t -> t)
+    (sub         : t -> t -> t)
+    (sub_carry   : t -> t -> t)
+
+    (mul_c       : t -> t -> zn2z t)
+    (mul         : t -> t -> t)
+    (square_c    : t -> zn2z t)
+
+    (div21       : t -> t -> t -> t*t)
+    (div_gt      : t -> t -> t * t)
+    (div         : t -> t -> t * t)
+
+    (modulo_gt      : t -> t -> t)
+    (modulo         : t -> t -> t)
+
+    (gcd_gt      : t -> t -> t)
+    (gcd         : t -> t -> t)
+    (add_mul_div : t -> t -> t -> t)
+    (pos_mod     : t -> t -> t)
+
+    (is_even     : t -> bool)
+    (sqrt2       : t -> t -> t * carry t)
+    (sqrt        : t -> t).
+
+ Instance zmod_specs : ZnZ.Specs zmod_ops := ZnZ.MkSpecs
     spec_to_Z
     spec_of_pos
     spec_zdigits
@@ -910,8 +890,8 @@ Section ZModulo.
     spec_div_gt
     spec_div
 
-    spec_mod_gt
-    spec_mod
+    spec_modulo_gt
+    spec_modulo
 
     spec_gcd_gt
     spec_gcd
@@ -934,12 +914,12 @@ End ZModulo.
 
 Module Type PositiveNotOne.
  Parameter p : positive.
- Axiom not_one : p<> 1%positive.
+ Axiom not_one : p <> 1%positive.
 End PositiveNotOne.
 
 Module ZModuloCyclicType (P:PositiveNotOne) <: CyclicType.
- Definition w := Z.
- Definition w_op := zmod_op P.p.
- Definition w_spec := zmod_spec P.not_one.
+ Definition t := Z.
+ Instance ops : ZnZ.Ops t := zmod_ops P.p.
+ Instance specs : ZnZ.Specs ops := zmod_specs P.not_one.
 End ZModuloCyclicType.
 
diff --git a/theories/Numbers/Integer/Abstract/ZAdd.v b/theories/Numbers/Integer/Abstract/ZAdd.v
index d9624ea3..ac113dfd 100644
--- a/theories/Numbers/Integer/Abstract/ZAdd.v
+++ b/theories/Numbers/Integer/Abstract/ZAdd.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,34 +8,33 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: ZAdd.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export ZBase.
 
-Module ZAddPropFunct (Import Z : ZAxiomsSig').
-Include ZBasePropFunct Z.
+Module ZAddProp (Import Z : ZAxiomsMiniSig').
+Include ZBaseProp Z.
 
 (** Theorems that are either not valid on N or have different proofs
     on N and Z *)
 
+Hint Rewrite opp_0 : nz.
+
 Theorem add_pred_l : forall n m, P n + m == P (n + m).
 Proof.
 intros n m.
 rewrite <- (succ_pred n) at 2.
-rewrite add_succ_l. now rewrite pred_succ.
+now rewrite add_succ_l, pred_succ.
 Qed.
 
 Theorem add_pred_r : forall n m, n + P m == P (n + m).
 Proof.
-intros n m; rewrite (add_comm n (P m)), (add_comm n m);
-apply add_pred_l.
+intros n m; rewrite 2 (add_comm n); apply add_pred_l.
 Qed.
 
 Theorem add_opp_r : forall n m, n + (- m) == n - m.
 Proof.
 nzinduct m.
-rewrite opp_0; rewrite sub_0_r; now rewrite add_0_r.
-intro m. rewrite opp_succ, sub_succ_r, add_pred_r; now rewrite pred_inj_wd.
+now nzsimpl.
+intro m. rewrite opp_succ, sub_succ_r, add_pred_r. now rewrite pred_inj_wd.
 Qed.
 
 Theorem sub_0_l : forall n, 0 - n == - n.
@@ -45,7 +44,7 @@ Qed.
 
 Theorem sub_succ_l : forall n m, S n - m == S (n - m).
 Proof.
-intros n m; do 2 rewrite <- add_opp_r; now rewrite add_succ_l.
+intros n m; rewrite <- 2 add_opp_r; now rewrite add_succ_l.
 Qed.
 
 Theorem sub_pred_l : forall n m, P n - m == P (n - m).
@@ -69,7 +68,7 @@ Qed.
 Theorem sub_diag : forall n, n - n == 0.
 Proof.
 nzinduct n.
-now rewrite sub_0_r.
+now nzsimpl.
 intro n. rewrite sub_succ_r, sub_succ_l; now rewrite pred_succ.
 Qed.
 
@@ -90,20 +89,20 @@ Qed.
 
 Theorem add_sub_assoc : forall n m p, n + (m - p) == (n + m) - p.
 Proof.
-intros n m p; do 2 rewrite <- add_opp_r; now rewrite add_assoc.
+intros n m p; rewrite <- 2 add_opp_r; now rewrite add_assoc.
 Qed.
 
 Theorem opp_involutive : forall n, - (- n) == n.
 Proof.
 nzinduct n.
-now do 2 rewrite opp_0.
-intro n. rewrite opp_succ, opp_pred; now rewrite succ_inj_wd.
+now nzsimpl.
+intro n. rewrite opp_succ, opp_pred. now rewrite succ_inj_wd.
 Qed.
 
 Theorem opp_add_distr : forall n m, - (n + m) == - n + (- m).
 Proof.
 intros n m; nzinduct n.
-rewrite opp_0; now do 2 rewrite add_0_l.
+now nzsimpl.
 intro n. rewrite add_succ_l; do 2 rewrite opp_succ; rewrite add_pred_l.
 now rewrite pred_inj_wd.
 Qed.
@@ -116,12 +115,12 @@ Qed.
 
 Theorem opp_inj : forall n m, - n == - m -> n == m.
 Proof.
-intros n m H. apply opp_wd in H. now do 2 rewrite opp_involutive in H.
+intros n m H. apply opp_wd in H. now rewrite 2 opp_involutive in H.
 Qed.
 
 Theorem opp_inj_wd : forall n m, - n == - m <-> n == m.
 Proof.
-intros n m; split; [apply opp_inj | apply opp_wd].
+intros n m; split; [apply opp_inj | intros; now f_equiv].
 Qed.
 
 Theorem eq_opp_l : forall n m, - n == m <-> n == - m.
@@ -137,7 +136,7 @@ Qed.
 Theorem sub_add_distr : forall n m p, n - (m + p) == (n - m) - p.
 Proof.
 intros n m p; rewrite <- add_opp_r, opp_add_distr, add_assoc.
-now do 2 rewrite add_opp_r.
+now rewrite 2 add_opp_r.
 Qed.
 
 Theorem sub_sub_distr : forall n m p, n - (m - p) == (n - m) + p.
@@ -148,7 +147,7 @@ Qed.
 
 Theorem sub_opp_l : forall n m, - n - m == - m - n.
 Proof.
-intros n m. do 2 rewrite <- add_opp_r. now rewrite add_comm.
+intros n m. rewrite <- 2 add_opp_r. now rewrite add_comm.
 Qed.
 
 Theorem sub_opp_r : forall n m, n - (- m) == n + m.
@@ -165,7 +164,7 @@ Qed.
 Theorem sub_cancel_l : forall n m p, n - m == n - p <-> m == p.
 Proof.
 intros n m p. rewrite <- (add_cancel_l (n - m) (n - p) (- n)).
-do 2 rewrite add_sub_assoc. rewrite add_opp_diag_l; do 2 rewrite sub_0_l.
+rewrite 2 add_sub_assoc. rewrite add_opp_diag_l; rewrite 2 sub_0_l.
 apply opp_inj_wd.
 Qed.
 
@@ -252,6 +251,11 @@ Proof.
 intros; now rewrite <- sub_sub_distr, sub_diag, sub_0_r.
 Qed.
 
+Theorem sub_add : forall n m, m - n + n == m.
+Proof.
+ intros. now rewrite <- add_sub_swap, add_simpl_r.
+Qed.
+
 (** Now we have two sums or differences; the name includes the two
     operators and the position of the terms being canceled *)
 
@@ -289,5 +293,5 @@ Qed.
 
 (** Of course, there are many other variants *)
 
-End ZAddPropFunct.
+End ZAddProp.
 
diff --git a/theories/Numbers/Integer/Abstract/ZAddOrder.v b/theories/Numbers/Integer/Abstract/ZAddOrder.v
index 6ce54f88..06ac0ba0 100644
--- a/theories/Numbers/Integer/Abstract/ZAddOrder.v
+++ b/theories/Numbers/Integer/Abstract/ZAddOrder.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,180 +8,173 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: ZAddOrder.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export ZLt.
 
-Module ZAddOrderPropFunct (Import Z : ZAxiomsSig').
-Include ZOrderPropFunct Z.
+Module ZAddOrderProp (Import Z : ZAxiomsMiniSig').
+Include ZOrderProp Z.
 
 (** Theorems that are either not valid on N or have different proofs
     on N and Z *)
 
 Theorem add_neg_neg : forall n m, n < 0 -> m < 0 -> n + m < 0.
 Proof.
-intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_lt_mono.
+intros. rewrite <- (add_0_l 0). now apply add_lt_mono.
 Qed.
 
 Theorem add_neg_nonpos : forall n m, n < 0 -> m <= 0 -> n + m < 0.
 Proof.
-intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_lt_le_mono.
+intros. rewrite <- (add_0_l 0). now apply add_lt_le_mono.
 Qed.
 
 Theorem add_nonpos_neg : forall n m, n <= 0 -> m < 0 -> n + m < 0.
 Proof.
-intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_le_lt_mono.
+intros. rewrite <- (add_0_l 0). now apply add_le_lt_mono.
 Qed.
 
 Theorem add_nonpos_nonpos : forall n m, n <= 0 -> m <= 0 -> n + m <= 0.
 Proof.
-intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_le_mono.
+intros. rewrite <- (add_0_l 0). now apply add_le_mono.
 Qed.
 
 (** Sub and order *)
 
 Theorem lt_0_sub : forall n m, 0 < m - n <-> n < m.
 Proof.
-intros n m. stepl (0 + n < m - n + n) by symmetry; apply add_lt_mono_r.
-rewrite add_0_l; now rewrite sub_simpl_r.
+intros n m. now rewrite (add_lt_mono_r _ _ n), add_0_l, sub_simpl_r.
 Qed.
 
 Notation sub_pos := lt_0_sub (only parsing).
 
 Theorem le_0_sub : forall n m, 0 <= m - n <-> n <= m.
 Proof.
-intros n m; stepl (0 + n <= m - n + n) by symmetry; apply add_le_mono_r.
-rewrite add_0_l; now rewrite sub_simpl_r.
+intros n m. now rewrite (add_le_mono_r _ _ n), add_0_l, sub_simpl_r.
 Qed.
 
 Notation sub_nonneg := le_0_sub (only parsing).
 
 Theorem lt_sub_0 : forall n m, n - m < 0 <-> n < m.
 Proof.
-intros n m. stepl (n - m + m < 0 + m) by symmetry; apply add_lt_mono_r.
-rewrite add_0_l; now rewrite sub_simpl_r.
+intros n m. now rewrite (add_lt_mono_r _ _ m), add_0_l, sub_simpl_r.
 Qed.
 
 Notation sub_neg := lt_sub_0 (only parsing).
 
 Theorem le_sub_0 : forall n m, n - m <= 0 <-> n <= m.
 Proof.
-intros n m. stepl (n - m + m <= 0 + m) by symmetry; apply add_le_mono_r.
-rewrite add_0_l; now rewrite sub_simpl_r.
+intros n m. now rewrite (add_le_mono_r _ _ m), add_0_l, sub_simpl_r.
 Qed.
 
 Notation sub_nonpos := le_sub_0 (only parsing).
 
 Theorem opp_lt_mono : forall n m, n < m <-> - m < - n.
 Proof.
-intros n m. stepr (m + - m < m + - n) by symmetry; apply add_lt_mono_l.
-do 2 rewrite add_opp_r. rewrite sub_diag. symmetry; apply lt_0_sub.
+intros n m. now rewrite <- lt_0_sub, <- add_opp_l, <- sub_opp_r, lt_0_sub.
 Qed.
 
 Theorem opp_le_mono : forall n m, n <= m <-> - m <= - n.
 Proof.
-intros n m. stepr (m + - m <= m + - n) by symmetry; apply add_le_mono_l.
-do 2 rewrite add_opp_r. rewrite sub_diag. symmetry; apply le_0_sub.
+intros n m. now rewrite <- le_0_sub, <- add_opp_l, <- sub_opp_r, le_0_sub.
 Qed.
 
 Theorem opp_pos_neg : forall n, 0 < - n <-> n < 0.
 Proof.
-intro n; rewrite (opp_lt_mono n 0); now rewrite opp_0.
+intro n; now rewrite (opp_lt_mono n 0), opp_0.
 Qed.
 
 Theorem opp_neg_pos : forall n, - n < 0 <-> 0 < n.
 Proof.
-intro n. rewrite (opp_lt_mono 0 n). now rewrite opp_0.
+intro n. now rewrite (opp_lt_mono 0 n), opp_0.
 Qed.
 
 Theorem opp_nonneg_nonpos : forall n, 0 <= - n <-> n <= 0.
 Proof.
-intro n; rewrite (opp_le_mono n 0); now rewrite opp_0.
+intro n; now rewrite (opp_le_mono n 0), opp_0.
 Qed.
 
 Theorem opp_nonpos_nonneg : forall n, - n <= 0 <-> 0 <= n.
 Proof.
-intro n. rewrite (opp_le_mono 0 n). now rewrite opp_0.
+intro n. now rewrite (opp_le_mono 0 n), opp_0.
+Qed.
+
+Theorem lt_m1_0 : -1 < 0.
+Proof.
+apply opp_neg_pos, lt_0_1.
 Qed.
 
 Theorem sub_lt_mono_l : forall n m p, n < m <-> p - m < p - n.
 Proof.
-intros n m p. do 2 rewrite <- add_opp_r. rewrite <- add_lt_mono_l.
-apply opp_lt_mono.
+intros. now rewrite <- 2 add_opp_r, <- add_lt_mono_l, opp_lt_mono.
 Qed.
 
 Theorem sub_lt_mono_r : forall n m p, n < m <-> n - p < m - p.
 Proof.
-intros n m p; do 2 rewrite <- add_opp_r; apply add_lt_mono_r.
+intros. now rewrite <- 2 add_opp_r, add_lt_mono_r.
 Qed.
 
 Theorem sub_lt_mono : forall n m p q, n < m -> q < p -> n - p < m - q.
 Proof.
 intros n m p q H1 H2.
 apply lt_trans with (m - p);
-[now apply -> sub_lt_mono_r | now apply -> sub_lt_mono_l].
+[now apply sub_lt_mono_r | now apply sub_lt_mono_l].
 Qed.
 
 Theorem sub_le_mono_l : forall n m p, n <= m <-> p - m <= p - n.
 Proof.
-intros n m p; do 2 rewrite <- add_opp_r; rewrite <- add_le_mono_l;
-apply opp_le_mono.
+intros. now rewrite <- 2 add_opp_r, <- add_le_mono_l, opp_le_mono.
 Qed.
 
 Theorem sub_le_mono_r : forall n m p, n <= m <-> n - p <= m - p.
 Proof.
-intros n m p; do 2 rewrite <- add_opp_r; apply add_le_mono_r.
+intros. now rewrite <- 2 add_opp_r, add_le_mono_r.
 Qed.
 
 Theorem sub_le_mono : forall n m p q, n <= m -> q <= p -> n - p <= m - q.
 Proof.
 intros n m p q H1 H2.
 apply le_trans with (m - p);
-[now apply -> sub_le_mono_r | now apply -> sub_le_mono_l].
+[now apply sub_le_mono_r | now apply sub_le_mono_l].
 Qed.
 
 Theorem sub_lt_le_mono : forall n m p q, n < m -> q <= p -> n - p < m - q.
 Proof.
 intros n m p q H1 H2.
 apply lt_le_trans with (m - p);
-[now apply -> sub_lt_mono_r | now apply -> sub_le_mono_l].
+[now apply sub_lt_mono_r | now apply sub_le_mono_l].
 Qed.
 
 Theorem sub_le_lt_mono : forall n m p q, n <= m -> q < p -> n - p < m - q.
 Proof.
 intros n m p q H1 H2.
 apply le_lt_trans with (m - p);
-[now apply -> sub_le_mono_r | now apply -> sub_lt_mono_l].
+[now apply sub_le_mono_r | now apply sub_lt_mono_l].
 Qed.
 
 Theorem le_lt_sub_lt : forall n m p q, n <= m -> p - n < q - m -> p < q.
 Proof.
 intros n m p q H1 H2. apply (le_lt_add_lt (- m) (- n));
-[now apply -> opp_le_mono | now do 2 rewrite add_opp_r].
+[now apply -> opp_le_mono | now rewrite 2 add_opp_r].
 Qed.
 
 Theorem lt_le_sub_lt : forall n m p q, n < m -> p - n <= q - m -> p < q.
 Proof.
 intros n m p q H1 H2. apply (lt_le_add_lt (- m) (- n));
-[now apply -> opp_lt_mono | now do 2 rewrite add_opp_r].
+[now apply -> opp_lt_mono | now rewrite 2 add_opp_r].
 Qed.
 
 Theorem le_le_sub_lt : forall n m p q, n <= m -> p - n <= q - m -> p <= q.
 Proof.
 intros n m p q H1 H2. apply (le_le_add_le (- m) (- n));
-[now apply -> opp_le_mono | now do 2 rewrite add_opp_r].
+[now apply -> opp_le_mono | now rewrite 2 add_opp_r].
 Qed.
 
 Theorem lt_add_lt_sub_r : forall n m p, n + p < m <-> n < m - p.
 Proof.
-intros n m p. stepl (n + p - p < m - p) by symmetry; apply sub_lt_mono_r.
-now rewrite add_simpl_r.
+intros n m p. now rewrite (sub_lt_mono_r _ _ p), add_simpl_r.
 Qed.
 
 Theorem le_add_le_sub_r : forall n m p, n + p <= m <-> n <= m - p.
 Proof.
-intros n m p. stepl (n + p - p <= m - p) by symmetry; apply sub_le_mono_r.
-now rewrite add_simpl_r.
+intros n m p. now rewrite (sub_le_mono_r _ _ p), add_simpl_r.
 Qed.
 
 Theorem lt_add_lt_sub_l : forall n m p, n + p < m <-> p < m - n.
@@ -196,14 +189,12 @@ Qed.
 
 Theorem lt_sub_lt_add_r : forall n m p, n - p < m <-> n < m + p.
 Proof.
-intros n m p. stepl (n - p + p < m + p) by symmetry; apply add_lt_mono_r.
-now rewrite sub_simpl_r.
+intros n m p. now rewrite (add_lt_mono_r _ _ p), sub_simpl_r.
 Qed.
 
 Theorem le_sub_le_add_r : forall n m p, n - p <= m <-> n <= m + p.
 Proof.
-intros n m p. stepl (n - p + p <= m + p) by symmetry; apply add_le_mono_r.
-now rewrite sub_simpl_r.
+intros n m p. now rewrite (add_le_mono_r _ _ p), sub_simpl_r.
 Qed.
 
 Theorem lt_sub_lt_add_l : forall n m p, n - m < p <-> n < m + p.
@@ -218,74 +209,68 @@ Qed.
 
 Theorem lt_sub_lt_add : forall n m p q, n - m < p - q <-> n + q < m + p.
 Proof.
-intros n m p q. rewrite lt_sub_lt_add_l. rewrite add_sub_assoc.
-now rewrite <- lt_add_lt_sub_r.
+intros n m p q. now rewrite lt_sub_lt_add_l, add_sub_assoc, <- lt_add_lt_sub_r.
 Qed.
 
 Theorem le_sub_le_add : forall n m p q, n - m <= p - q <-> n + q <= m + p.
 Proof.
-intros n m p q. rewrite le_sub_le_add_l. rewrite add_sub_assoc.
-now rewrite <- le_add_le_sub_r.
+intros n m p q. now rewrite le_sub_le_add_l, add_sub_assoc, <- le_add_le_sub_r.
 Qed.
 
 Theorem lt_sub_pos : forall n m, 0 < m <-> n - m < n.
 Proof.
-intros n m. stepr (n - m < n - 0) by now rewrite sub_0_r. apply sub_lt_mono_l.
+intros n m. now rewrite (sub_lt_mono_l _ _ n), sub_0_r.
 Qed.
 
 Theorem le_sub_nonneg : forall n m, 0 <= m <-> n - m <= n.
 Proof.
-intros n m. stepr (n - m <= n - 0) by now rewrite sub_0_r. apply sub_le_mono_l.
+intros n m. now rewrite (sub_le_mono_l _ _ n), sub_0_r.
 Qed.
 
 Theorem sub_lt_cases : forall n m p q, n - m < p - q -> n < m \/ q < p.
 Proof.
-intros n m p q H. rewrite lt_sub_lt_add in H. now apply add_lt_cases.
+intros. now apply add_lt_cases, lt_sub_lt_add.
 Qed.
 
 Theorem sub_le_cases : forall n m p q, n - m <= p - q -> n <= m \/ q <= p.
 Proof.
-intros n m p q H. rewrite le_sub_le_add in H. now apply add_le_cases.
+intros. now apply add_le_cases, le_sub_le_add.
 Qed.
 
 Theorem sub_neg_cases : forall n m, n - m < 0 -> n < 0 \/ 0 < m.
 Proof.
-intros n m H; rewrite <- add_opp_r in H.
-setoid_replace (0 < m) with (- m < 0) using relation iff by (symmetry; apply opp_neg_pos).
-now apply add_neg_cases.
+intros.
+rewrite <- (opp_neg_pos m). apply add_neg_cases. now rewrite add_opp_r.
 Qed.
 
 Theorem sub_pos_cases : forall n m, 0 < n - m -> 0 < n \/ m < 0.
 Proof.
-intros n m H; rewrite <- add_opp_r in H.
-setoid_replace (m < 0) with (0 < - m) using relation iff by (symmetry; apply opp_pos_neg).
-now apply add_pos_cases.
+intros.
+rewrite <- (opp_pos_neg m). apply add_pos_cases. now rewrite add_opp_r.
 Qed.
 
 Theorem sub_nonpos_cases : forall n m, n - m <= 0 -> n <= 0 \/ 0 <= m.
 Proof.
-intros n m H; rewrite <- add_opp_r in H.
-setoid_replace (0 <= m) with (- m <= 0) using relation iff by (symmetry; apply opp_nonpos_nonneg).
-now apply add_nonpos_cases.
+intros.
+rewrite <- (opp_nonpos_nonneg m). apply add_nonpos_cases. now rewrite add_opp_r.
 Qed.
 
 Theorem sub_nonneg_cases : forall n m, 0 <= n - m -> 0 <= n \/ m <= 0.
 Proof.
-intros n m H; rewrite <- add_opp_r in H.
-setoid_replace (m <= 0) with (0 <= - m) using relation iff by (symmetry; apply opp_nonneg_nonpos).
-now apply add_nonneg_cases.
+intros.
+rewrite <- (opp_nonneg_nonpos m). apply add_nonneg_cases. now rewrite add_opp_r.
 Qed.
 
 Section PosNeg.
 
 Variable P : Z.t -> Prop.
-Hypothesis P_wd : Proper (Z.eq ==> iff) P.
+Hypothesis P_wd : Proper (eq ==> iff) P.
 
 Theorem zero_pos_neg :
   P 0 -> (forall n, 0 < n -> P n /\ P (- n)) -> forall n, P n.
 Proof.
 intros H1 H2 n. destruct (lt_trichotomy n 0) as [H3 | [H3 | H3]].
-apply <- opp_pos_neg in H3. apply H2 in H3. destruct H3 as [_ H3].
+apply opp_pos_neg, H2 in H3. destruct H3 as [_ H3].
 now rewrite opp_involutive in H3.
 now rewrite H3.
 apply H2 in H3; now destruct H3.
@@ -295,6 +280,6 @@ End PosNeg.
 
 Ltac zero_pos_neg n := induction_maker n ltac:(apply zero_pos_neg).
 
-End ZAddOrderPropFunct.
+End ZAddOrderProp.
 
 
diff --git a/theories/Numbers/Integer/Abstract/ZAxioms.v b/theories/Numbers/Integer/Abstract/ZAxioms.v
index fd14cff0..f2947c30 100644
--- a/theories/Numbers/Integer/Abstract/ZAxioms.v
+++ b/theories/Numbers/Integer/Abstract/ZAxioms.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,11 +8,19 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: ZAxioms.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NZAxioms.
+Require Import Bool NZParity NZPow NZSqrt NZLog NZGcd NZDiv NZBits.
+
+(** We obtain integers by postulating that successor of predecessor
+    is identity. *)
+
+Module Type ZAxiom (Import Z : NZAxiomsSig').
+ Axiom succ_pred : forall n, S (P n) == n.
+End ZAxiom.
 
-Set Implicit Arguments.
+(** For historical reasons, ZAxiomsMiniSig isn't just NZ + ZAxiom,
+    we also add an [opp] function, that can be seen as a shortcut
+    for [sub 0]. *)
 
 Module Type Opp (Import T:Typ).
  Parameter Inline opp : t -> t.
@@ -24,15 +32,91 @@ End OppNotation.
 
 Module Type Opp' (T:Typ) := Opp T <+ OppNotation T.
 
-(** We obtain integers by postulating that every number has a predecessor. *)
-
 Module Type IsOpp (Import Z : NZAxiomsSig')(Import O : Opp' Z).
  Declare Instance opp_wd : Proper (eq==>eq) opp.
- Axiom succ_pred : forall n, S (P n) == n.
  Axiom opp_0 : - 0 == 0.
  Axiom opp_succ : forall n, - (S n) == P (- n).
 End IsOpp.
 
-Module Type ZAxiomsSig := NZOrdAxiomsSig <+ Opp <+ IsOpp.
-Module Type ZAxiomsSig' := NZOrdAxiomsSig' <+ Opp' <+ IsOpp.
+Module Type OppCstNotation (Import A : NZAxiomsSig)(Import B : Opp A).
+ Notation "- 1" := (opp one).
+ Notation "- 2" := (opp two).
+End OppCstNotation.
+
+Module Type ZAxiomsMiniSig := NZOrdAxiomsSig <+ ZAxiom <+ Opp <+ IsOpp.
+Module Type ZAxiomsMiniSig' := NZOrdAxiomsSig' <+ ZAxiom <+ Opp' <+ IsOpp
+ <+ OppCstNotation.
+
+
+(** Other functions and their specifications *)
+
+(** Absolute value *)
+
+Module Type HasAbs(Import Z : ZAxiomsMiniSig').
+ Parameter Inline abs : t -> t.
+ Axiom abs_eq : forall n, 0<=n -> abs n == n.
+ Axiom abs_neq : forall n, n<=0 -> abs n == -n.
+End HasAbs.
+
+(** A sign function *)
+
+Module Type HasSgn (Import Z : ZAxiomsMiniSig').
+ Parameter Inline sgn : t -> t.
+ Axiom sgn_null : forall n, n==0 -> sgn n == 0.
+ Axiom sgn_pos : forall n, 0<n -> sgn n == 1.
+ Axiom sgn_neg : forall n, n<0 -> sgn n == -1.
+End HasSgn.
+
+(** Divisions *)
+
+(** First, the usual Coq convention of Truncated-Toward-Bottom
+    (a.k.a Floor). We simply extend the NZ signature. *)
+
+Module Type ZDivSpecific (Import A:ZAxiomsMiniSig')(Import B : DivMod' A).
+ Axiom mod_pos_bound : forall a b, 0 < b -> 0 <= a mod b < b.
+ Axiom mod_neg_bound : forall a b, b < 0 -> b < a mod b <= 0.
+End ZDivSpecific.
+
+Module Type ZDiv (Z:ZAxiomsMiniSig) := NZDiv.NZDiv Z <+ ZDivSpecific Z.
+Module Type ZDiv' (Z:ZAxiomsMiniSig) := NZDiv.NZDiv' Z <+ ZDivSpecific Z.
+
+(** Then, the Truncated-Toward-Zero convention.
+    For not colliding with Floor operations, we use different names
+*)
+
+Module Type QuotRem (Import A : Typ).
+ Parameters Inline quot rem : t -> t -> t.
+End QuotRem.
+
+Module Type QuotRemNotation (A : Typ)(Import B : QuotRem A).
+ Infix "÷" := quot (at level 40, left associativity).
+ Infix "rem" := rem (at level 40, no associativity).
+End QuotRemNotation.
+
+Module Type QuotRem' (A : Typ) := QuotRem A <+ QuotRemNotation A.
+
+Module Type QuotRemSpec (Import A : ZAxiomsMiniSig')(Import B : QuotRem' A).
+ Declare Instance quot_wd : Proper (eq==>eq==>eq) quot.
+ Declare Instance rem_wd : Proper (eq==>eq==>eq) B.rem.
+ Axiom quot_rem : forall a b, b ~= 0 -> a == b*(a÷b) + (a rem b).
+ Axiom rem_bound_pos : forall a b, 0<=a -> 0<b -> 0 <= a rem b < b.
+ Axiom rem_opp_l : forall a b, b ~= 0 -> (-a) rem b == - (a rem b).
+ Axiom rem_opp_r : forall a b, b ~= 0 -> a rem (-b) == a rem b.
+End QuotRemSpec.
+
+Module Type ZQuot (Z:ZAxiomsMiniSig) := QuotRem Z <+ QuotRemSpec Z.
+Module Type ZQuot' (Z:ZAxiomsMiniSig) := QuotRem' Z <+ QuotRemSpec Z.
+
+(** For all other functions, the NZ axiomatizations are enough. *)
+
+(** Let's group everything *)
+
+Module Type ZAxiomsSig := ZAxiomsMiniSig <+ OrderFunctions
+   <+ HasAbs <+ HasSgn <+ NZParity.NZParity
+   <+ NZPow.NZPow <+ NZSqrt.NZSqrt <+ NZLog.NZLog2 <+ NZGcd.NZGcd
+   <+ ZDiv <+ ZQuot <+ NZBits.NZBits <+ NZSquare.
 
+Module Type ZAxiomsSig' := ZAxiomsMiniSig' <+ OrderFunctions'
+   <+ HasAbs <+ HasSgn <+ NZParity.NZParity
+   <+ NZPow.NZPow' <+ NZSqrt.NZSqrt' <+ NZLog.NZLog2 <+ NZGcd.NZGcd'
+   <+ ZDiv' <+ ZQuot' <+ NZBits.NZBits' <+ NZSquare.
diff --git a/theories/Numbers/Integer/Abstract/ZBase.v b/theories/Numbers/Integer/Abstract/ZBase.v
index aa7979ae..bc78a4b9 100644
--- a/theories/Numbers/Integer/Abstract/ZBase.v
+++ b/theories/Numbers/Integer/Abstract/ZBase.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,26 +8,29 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: ZBase.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Decidable.
 Require Export ZAxioms.
 Require Import NZProperties.
 
-Module ZBasePropFunct (Import Z : ZAxiomsSig').
-Include NZPropFunct Z.
+Module ZBaseProp (Import Z : ZAxiomsMiniSig').
+Include NZProp Z.
 
 (* Theorems that are true for integers but not for natural numbers *)
 
 Theorem pred_inj : forall n m, P n == P m -> n == m.
 Proof.
-intros n m H. apply succ_wd in H. now do 2 rewrite succ_pred in H.
+intros n m H. apply succ_wd in H. now rewrite 2 succ_pred in H.
 Qed.
 
 Theorem pred_inj_wd : forall n1 n2, P n1 == P n2 <-> n1 == n2.
 Proof.
-intros n1 n2; split; [apply pred_inj | apply pred_wd].
+intros n1 n2; split; [apply pred_inj | intros; now f_equiv].
+Qed.
+
+Lemma succ_m1 : S (-1) == 0.
+Proof.
+ now rewrite one_succ, opp_succ, opp_0, succ_pred.
 Qed.
 
-End ZBasePropFunct.
+End ZBaseProp.
 
diff --git a/theories/Numbers/Integer/Abstract/ZBits.v b/theories/Numbers/Integer/Abstract/ZBits.v
new file mode 100644
index 00000000..1d410a02
--- /dev/null
+++ b/theories/Numbers/Integer/Abstract/ZBits.v
@@ -0,0 +1,1947 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import
+ Bool ZAxioms ZMulOrder ZPow ZDivFloor ZSgnAbs ZParity NZLog.
+
+(** Derived properties of bitwise operations *)
+
+Module Type ZBitsProp
+ (Import A : ZAxiomsSig')
+ (Import B : ZMulOrderProp A)
+ (Import C : ZParityProp A B)
+ (Import D : ZSgnAbsProp A B)
+ (Import E : ZPowProp A B C D)
+ (Import F : ZDivProp A B D)
+ (Import G : NZLog2Prop A A A B E).
+
+Include BoolEqualityFacts A.
+
+Ltac order_nz := try apply pow_nonzero; order'.
+Ltac order_pos' := try apply abs_nonneg; order_pos.
+Hint Rewrite div_0_l mod_0_l div_1_r mod_1_r : nz.
+
+(** Some properties of power and division *)
+
+Lemma pow_sub_r : forall a b c, a~=0 -> 0<=c<=b -> a^(b-c) == a^b / a^c.
+Proof.
+ intros a b c Ha (H,H'). rewrite <- (sub_simpl_r b c) at 2.
+ rewrite pow_add_r; trivial.
+ rewrite div_mul. reflexivity.
+ now apply pow_nonzero.
+ now apply le_0_sub.
+Qed.
+
+Lemma pow_div_l : forall a b c, b~=0 -> 0<=c -> a mod b == 0 ->
+ (a/b)^c == a^c / b^c.
+Proof.
+ intros a b c Hb Hc H. rewrite (div_mod a b Hb) at 2.
+ rewrite H, add_0_r, pow_mul_l, mul_comm, div_mul. reflexivity.
+ now apply pow_nonzero.
+Qed.
+
+(** An injection from bits [true] and [false] to numbers 1 and 0.
+    We declare it as a (local) coercion for shorter statements. *)
+
+Definition b2z (b:bool) := if b then 1 else 0.
+Local Coercion b2z : bool >-> t.
+
+Instance b2z_wd : Proper (Logic.eq ==> eq) b2z := _.
+
+Lemma exists_div2 a : exists a' (b:bool), a == 2*a' + b.
+Proof.
+ elim (Even_or_Odd a); [intros (a',H)| intros (a',H)].
+ exists a'. exists false. now nzsimpl.
+ exists a'. exists true. now simpl.
+Qed.
+
+(** We can compact [testbit_odd_0] [testbit_even_0]
+    [testbit_even_succ] [testbit_odd_succ] in only two lemmas. *)
+
+Lemma testbit_0_r a (b:bool) : testbit (2*a+b) 0 = b.
+Proof.
+ destruct b; simpl; rewrite ?add_0_r.
+ apply testbit_odd_0.
+ apply testbit_even_0.
+Qed.
+
+Lemma testbit_succ_r a (b:bool) n : 0<=n ->
+ testbit (2*a+b) (succ n) = testbit a n.
+Proof.
+ destruct b; simpl; rewrite ?add_0_r.
+ now apply testbit_odd_succ.
+ now apply testbit_even_succ.
+Qed.
+
+(** Alternative caracterisations of [testbit] *)
+
+(** This concise equation could have been taken as specification
+   for testbit in the interface, but it would have been hard to
+   implement with little initial knowledge about div and mod *)
+
+Lemma testbit_spec' a n : 0<=n -> a.[n] == (a / 2^n) mod 2.
+Proof.
+ intro Hn. revert a. apply le_ind with (4:=Hn). 
+   solve_proper.
+ intros a. nzsimpl.
+ destruct (exists_div2 a) as (a' & b & H). rewrite H at 1.
+ rewrite testbit_0_r. apply mod_unique with a'; trivial.
+ left. destruct b; split; simpl; order'.
+ clear n Hn. intros n Hn IH a.
+ destruct (exists_div2 a) as (a' & b & H). rewrite H at 1.
+ rewrite testbit_succ_r, IH by trivial. f_equiv.
+ rewrite pow_succ_r, <- div_div by order_pos. f_equiv.
+ apply div_unique with b; trivial.
+ left. destruct b; split; simpl; order'.
+Qed.
+
+(** This caracterisation that uses only basic operations and
+   power was initially taken as specification for testbit.
+   We describe [a] as having a low part and a high part, with
+   the corresponding bit in the middle. This caracterisation
+   is moderatly complex to implement, but also moderately
+   usable... *)
+
+Lemma testbit_spec a n : 0<=n ->
+  exists l h, 0<=l<2^n /\ a == l + (a.[n] + 2*h)*2^n.
+Proof.
+ intro Hn. exists (a mod 2^n). exists (a / 2^n / 2). split.
+ apply mod_pos_bound; order_pos.
+ rewrite add_comm, mul_comm, (add_comm a.[n]).
+ rewrite (div_mod a (2^n)) at 1 by order_nz. do 2 f_equiv.
+ rewrite testbit_spec' by trivial. apply div_mod. order'.
+Qed.
+
+Lemma testbit_true : forall a n, 0<=n ->
+ (a.[n] = true <-> (a / 2^n) mod 2 == 1).
+Proof.
+ intros a n Hn.
+ rewrite <- testbit_spec' by trivial.
+ destruct a.[n]; split; simpl; now try order'.
+Qed.
+
+Lemma testbit_false : forall a n, 0<=n ->
+ (a.[n] = false <-> (a / 2^n) mod 2 == 0).
+Proof.
+ intros a n Hn.
+ rewrite <- testbit_spec' by trivial.
+ destruct a.[n]; split; simpl; now try order'.
+Qed.
+
+Lemma testbit_eqb : forall a n, 0<=n ->
+ a.[n] = eqb ((a / 2^n) mod 2) 1.
+Proof.
+ intros a n Hn.
+ apply eq_true_iff_eq. now rewrite testbit_true, eqb_eq.
+Qed.
+
+(** Results about the injection [b2z] *)
+
+Lemma b2z_inj : forall (a0 b0:bool), a0 == b0 -> a0 = b0.
+Proof.
+ intros [|] [|]; simpl; trivial; order'.
+Qed.
+
+Lemma add_b2z_double_div2 : forall (a0:bool) a, (a0+2*a)/2 == a.
+Proof.
+ intros a0 a. rewrite mul_comm, div_add by order'.
+ now rewrite div_small, add_0_l by (destruct a0; split; simpl; order').
+Qed.
+
+Lemma add_b2z_double_bit0 : forall (a0:bool) a, (a0+2*a).[0] = a0.
+Proof.
+ intros a0 a. apply b2z_inj.
+ rewrite testbit_spec' by order.
+ nzsimpl. rewrite mul_comm, mod_add by order'.
+ now rewrite mod_small by (destruct a0; split; simpl; order').
+Qed.
+
+Lemma b2z_div2 : forall (a0:bool), a0/2 == 0.
+Proof.
+ intros a0. rewrite <- (add_b2z_double_div2 a0 0). now nzsimpl.
+Qed.
+
+Lemma b2z_bit0 : forall (a0:bool), a0.[0] = a0.
+Proof.
+ intros a0. rewrite <- (add_b2z_double_bit0 a0 0) at 2. now nzsimpl.
+Qed.
+
+(** The specification of testbit by low and high parts is complete *)
+
+Lemma testbit_unique : forall a n (a0:bool) l h,
+ 0<=l<2^n -> a == l + (a0 + 2*h)*2^n -> a.[n] = a0.
+Proof.
+ intros a n a0 l h Hl EQ.
+ assert (0<=n).
+  destruct (le_gt_cases 0 n) as [Hn|Hn]; trivial.
+  rewrite pow_neg_r in Hl by trivial. destruct Hl; order.
+ apply b2z_inj. rewrite testbit_spec' by trivial.
+ symmetry. apply mod_unique with h.
+ left; destruct a0; simpl; split; order'.
+ symmetry. apply div_unique with l.
+ now left.
+ now rewrite add_comm, (add_comm _ a0), mul_comm.
+Qed.
+
+(** All bits of number 0 are 0 *)
+
+Lemma bits_0 : forall n, 0.[n] = false.
+Proof.
+ intros n.
+ destruct (le_gt_cases 0 n).
+ apply testbit_false; trivial. nzsimpl; order_nz.
+ now apply testbit_neg_r.
+Qed.
+
+(** For negative numbers, we are actually doing two's complement *)
+
+Lemma bits_opp : forall a n, 0<=n -> (-a).[n] = negb (P a).[n].
+Proof.
+ intros a n Hn.
+ destruct (testbit_spec (-a) n Hn) as (l & h & Hl & EQ).
+ fold (b2z (-a).[n]) in EQ.
+ apply negb_sym.
+ apply testbit_unique with (2^n-l-1) (-h-1).
+ split.
+ apply lt_succ_r. rewrite sub_1_r, succ_pred. now apply lt_0_sub.
+ apply le_succ_l. rewrite sub_1_r, succ_pred. apply le_sub_le_add_r.
+ rewrite <- (add_0_r (2^n)) at 1. now apply add_le_mono_l.
+ rewrite <- add_sub_swap, sub_1_r. f_equiv.
+ apply opp_inj. rewrite opp_add_distr, opp_sub_distr.
+ rewrite (add_comm _ l), <- add_assoc.
+ rewrite EQ at 1. apply add_cancel_l.
+ rewrite <- opp_add_distr.
+ rewrite <- (mul_1_l (2^n)) at 2. rewrite <- mul_add_distr_r.
+ rewrite <- mul_opp_l.
+ f_equiv.
+ rewrite !opp_add_distr.
+ rewrite <- mul_opp_r.
+ rewrite opp_sub_distr, opp_involutive.
+ rewrite (add_comm h).
+ rewrite mul_add_distr_l.
+ rewrite !add_assoc.
+ apply add_cancel_r.
+ rewrite mul_1_r.
+ rewrite add_comm, add_assoc, !add_opp_r, sub_1_r, two_succ, pred_succ.
+ destruct (-a).[n]; simpl. now rewrite sub_0_r. now nzsimpl'.
+Qed.
+
+(** All bits of number (-1) are 1 *)
+
+Lemma bits_m1 : forall n, 0<=n -> (-1).[n] = true.
+Proof.
+ intros. now rewrite bits_opp, one_succ, pred_succ, bits_0.
+Qed.
+
+(** Various ways to refer to the lowest bit of a number *)
+
+Lemma bit0_odd : forall a, a.[0] = odd a.
+Proof.
+ intros. symmetry.
+ destruct (exists_div2 a) as (a' & b & EQ).
+ rewrite EQ, testbit_0_r, add_comm, odd_add_mul_2.
+ destruct b; simpl; apply odd_1 || apply odd_0.
+Qed.
+
+Lemma bit0_eqb : forall a, a.[0] = eqb (a mod 2) 1.
+Proof.
+ intros a. rewrite testbit_eqb by order. now nzsimpl.
+Qed.
+
+Lemma bit0_mod : forall a, a.[0] == a mod 2.
+Proof.
+ intros a. rewrite testbit_spec' by order. now nzsimpl.
+Qed.
+
+(** Hence testing a bit is equivalent to shifting and testing parity *)
+
+Lemma testbit_odd : forall a n, a.[n] = odd (a>>n).
+Proof.
+ intros. now rewrite <- bit0_odd, shiftr_spec, add_0_l.
+Qed.
+
+(** [log2] gives the highest nonzero bit of positive numbers *)
+
+Lemma bit_log2 : forall a, 0<a -> a.[log2 a] = true.
+Proof.
+ intros a Ha.
+ assert (Ha' := log2_nonneg a).
+ destruct (log2_spec_alt a Ha) as (r & EQ & Hr).
+ rewrite EQ at 1.
+ rewrite testbit_true, add_comm by trivial.
+ rewrite <- (mul_1_l (2^log2 a)) at 1.
+ rewrite div_add by order_nz.
+ rewrite div_small; trivial.
+ rewrite add_0_l. apply mod_small. split; order'.
+Qed.
+
+Lemma bits_above_log2 : forall a n, 0<=a -> log2 a < n ->
+ a.[n] = false.
+Proof.
+ intros a n Ha H.
+ assert (Hn : 0<=n).
+  transitivity (log2 a). apply log2_nonneg. order'.
+ rewrite testbit_false by trivial.
+ rewrite div_small. nzsimpl; order'.
+ split. order. apply log2_lt_cancel. now rewrite log2_pow2.
+Qed.
+
+(** Hence the number of bits of [a] is [1+log2 a]
+    (see [Pos.size_nat] and [Pos.size]).
+*)
+
+(** For negative numbers, things are the other ways around:
+    log2 gives the highest zero bit (for numbers below -1).
+*)
+
+Lemma bit_log2_neg : forall a, a < -1 -> a.[log2 (P (-a))] = false.
+Proof.
+ intros a Ha.
+ rewrite <- (opp_involutive a) at 1.
+ rewrite bits_opp.
+ apply negb_false_iff.
+ apply bit_log2.
+ apply opp_lt_mono in Ha. rewrite opp_involutive in Ha.
+ apply lt_succ_lt_pred. now rewrite <- one_succ.
+ apply log2_nonneg.
+Qed.
+
+Lemma bits_above_log2_neg : forall a n, a < 0 -> log2 (P (-a)) < n ->
+ a.[n] = true.
+Proof.
+ intros a n Ha H.
+ assert (Hn : 0<=n).
+  transitivity (log2 (P (-a))). apply log2_nonneg. order'.
+ rewrite <- (opp_involutive a), bits_opp, negb_true_iff by trivial.
+ apply bits_above_log2; trivial.
+ now rewrite <- opp_succ, opp_nonneg_nonpos, le_succ_l.
+Qed.
+
+(** Accesing a high enough bit of a number gives its sign *)
+
+Lemma bits_iff_nonneg : forall a n, log2 (abs a) < n ->
+ (0<=a <-> a.[n] = false).
+Proof.
+ intros a n Hn. split; intros H.
+ rewrite abs_eq in Hn; trivial. now apply bits_above_log2.
+ destruct (le_gt_cases 0 a); trivial.
+ rewrite abs_neq in Hn by order.
+ rewrite bits_above_log2_neg in H; try easy.
+ apply le_lt_trans with (log2 (-a)); trivial.
+ apply log2_le_mono. apply le_pred_l.
+Qed.
+
+Lemma bits_iff_nonneg' : forall a,
+ 0<=a <-> a.[S (log2 (abs a))] = false.
+Proof.
+ intros. apply bits_iff_nonneg. apply lt_succ_diag_r.
+Qed.
+
+Lemma bits_iff_nonneg_ex : forall a,
+ 0<=a <-> (exists k, forall m, k<m -> a.[m] = false).
+Proof.
+ intros a. split.
+ intros Ha. exists (log2 a). intros m Hm. now apply bits_above_log2.
+ intros (k,Hk). destruct (le_gt_cases k (log2 (abs a))).
+ now apply bits_iff_nonneg', Hk, lt_succ_r.
+ apply (bits_iff_nonneg a (S k)).
+ now apply lt_succ_r, lt_le_incl.
+ apply Hk. apply lt_succ_diag_r.
+Qed.
+
+Lemma bits_iff_neg : forall a n, log2 (abs a) < n ->
+ (a<0 <-> a.[n] = true).
+Proof.
+ intros a n Hn.
+ now rewrite lt_nge, <- not_false_iff_true, (bits_iff_nonneg a n).
+Qed.
+
+Lemma bits_iff_neg' : forall a, a<0 <-> a.[S (log2 (abs a))] = true.
+Proof.
+ intros. apply bits_iff_neg. apply lt_succ_diag_r.
+Qed.
+
+Lemma bits_iff_neg_ex : forall a,
+ a<0 <-> (exists k, forall m, k<m -> a.[m] = true).
+Proof.
+ intros a. split.
+ intros Ha. exists (log2 (P (-a))). intros m Hm. now apply bits_above_log2_neg.
+ intros (k,Hk). destruct (le_gt_cases k (log2 (abs a))).
+ now apply bits_iff_neg', Hk, lt_succ_r.
+ apply (bits_iff_neg a (S k)).
+ now apply lt_succ_r, lt_le_incl.
+ apply Hk. apply lt_succ_diag_r.
+Qed.
+
+(** Testing bits after division or multiplication by a power of two *)
+
+Lemma div2_bits : forall a n, 0<=n -> (a/2).[n] = a.[S n].
+Proof.
+ intros a n Hn.
+ apply eq_true_iff_eq. rewrite 2 testbit_true by order_pos.
+ rewrite pow_succ_r by trivial.
+ now rewrite div_div by order_pos.
+Qed.
+
+Lemma div_pow2_bits : forall a n m, 0<=n -> 0<=m -> (a/2^n).[m] = a.[m+n].
+Proof.
+ intros a n m Hn. revert a m. apply le_ind with (4:=Hn).
+ solve_proper.
+ intros a m Hm. now nzsimpl.
+ clear n Hn. intros n Hn IH a m Hm. nzsimpl; trivial.
+ rewrite <- div_div by order_pos.
+ now rewrite IH, div2_bits by order_pos.
+Qed.
+
+Lemma double_bits_succ : forall a n, (2*a).[S n] = a.[n].
+Proof.
+ intros a n.
+ destruct (le_gt_cases 0 n) as [Hn|Hn].
+ now rewrite <- div2_bits, mul_comm, div_mul by order'.
+ rewrite (testbit_neg_r a n Hn).
+ apply le_succ_l in Hn. le_elim Hn.
+ now rewrite testbit_neg_r.
+ now rewrite Hn, bit0_odd, odd_mul, odd_2.
+Qed.
+
+Lemma double_bits : forall a n, (2*a).[n] = a.[P n].
+Proof.
+ intros a n. rewrite <- (succ_pred n) at 1. apply double_bits_succ.
+Qed.
+
+Lemma mul_pow2_bits_add : forall a n m, 0<=n -> (a*2^n).[n+m] = a.[m].
+Proof.
+ intros a n m Hn. revert a m. apply le_ind with (4:=Hn).
+ solve_proper.
+ intros a m. now nzsimpl.
+ clear n Hn. intros n Hn IH a m. nzsimpl; trivial.
+ rewrite mul_assoc, (mul_comm _ 2), <- mul_assoc.
+ now rewrite double_bits_succ.
+Qed.
+
+Lemma mul_pow2_bits : forall a n m, 0<=n -> (a*2^n).[m] = a.[m-n].
+Proof.
+ intros.
+ rewrite <- (add_simpl_r m n) at 1. rewrite add_sub_swap, add_comm.
+ now apply mul_pow2_bits_add.
+Qed.
+
+Lemma mul_pow2_bits_low : forall a n m, m<n -> (a*2^n).[m] = false.
+Proof.
+ intros.
+ destruct (le_gt_cases 0 n).
+ rewrite mul_pow2_bits by trivial.
+ apply testbit_neg_r. now apply lt_sub_0.
+ now rewrite pow_neg_r, mul_0_r, bits_0.
+Qed.
+
+(** Selecting the low part of a number can be done by a modulo *)
+
+Lemma mod_pow2_bits_high : forall a n m, 0<=n<=m ->
+ (a mod 2^n).[m] = false.
+Proof.
+ intros a n m (Hn,H).
+ destruct (mod_pos_bound a (2^n)) as [LE LT]. order_pos.
+ le_elim LE.
+ apply bits_above_log2; try order.
+ apply lt_le_trans with n; trivial.
+ apply log2_lt_pow2; trivial.
+ now rewrite <- LE, bits_0.
+Qed.
+
+Lemma mod_pow2_bits_low : forall a n m, m<n ->
+ (a mod 2^n).[m] = a.[m].
+Proof.
+ intros a n m H.
+ destruct (le_gt_cases 0 m) as [Hm|Hm]; [|now rewrite !testbit_neg_r].
+ rewrite testbit_eqb; trivial.
+ rewrite <- (mod_add _ (2^(P (n-m))*(a/2^n))) by order'.
+ rewrite <- div_add by order_nz.
+ rewrite (mul_comm _ 2), mul_assoc, <- pow_succ_r, succ_pred.
+ rewrite mul_comm, mul_assoc, <- pow_add_r, (add_comm m), sub_add; trivial.
+ rewrite add_comm, <- div_mod by order_nz.
+ symmetry. apply testbit_eqb; trivial.
+ apply le_0_sub; order.
+ now apply lt_le_pred, lt_0_sub.
+Qed.
+
+(** We now prove that having the same bits implies equality.
+    For that we use a notion of equality over functional
+    streams of bits. *)
+
+Definition eqf (f g:t -> bool) := forall n:t, f n = g n.
+
+Instance eqf_equiv : Equivalence eqf.
+Proof.
+ split; congruence.
+Qed.
+
+Local Infix "===" := eqf (at level 70, no associativity).
+
+Instance testbit_eqf : Proper (eq==>eqf) testbit.
+Proof.
+ intros a a' Ha n. now rewrite Ha.
+Qed.
+
+(** Only zero corresponds to the always-false stream. *)
+
+Lemma bits_inj_0 :
+ forall a, (forall n, a.[n] = false) -> a == 0.
+Proof.
+ intros a H. destruct (lt_trichotomy a 0) as [Ha|[Ha|Ha]]; trivial.
+ apply (bits_above_log2_neg a (S (log2 (P (-a))))) in Ha.
+ now rewrite H in Ha.
+ apply lt_succ_diag_r.
+ apply bit_log2 in Ha. now rewrite H in Ha.
+Qed.
+
+(** If two numbers produce the same stream of bits, they are equal. *)
+
+Lemma bits_inj : forall a b, testbit a === testbit b -> a == b.
+Proof.
+ assert (AUX : forall n, 0<=n -> forall a b,
+                0<=a<2^n -> testbit a === testbit b -> a == b).
+  intros n Hn. apply le_ind with (4:=Hn).
+  solve_proper.
+  intros a b Ha H. rewrite pow_0_r, one_succ, lt_succ_r in Ha.
+  assert (Ha' : a == 0) by (destruct Ha; order).
+  rewrite Ha' in *.
+  symmetry. apply bits_inj_0.
+   intros m. now rewrite <- H, bits_0.
+  clear n Hn. intros n Hn IH a b (Ha,Ha') H.
+  rewrite (div_mod a 2), (div_mod b 2) by order'.
+  f_equiv; [ | now rewrite <- 2 bit0_mod, H].
+  f_equiv.
+  apply IH.
+  split. apply div_pos; order'.
+  apply div_lt_upper_bound. order'. now rewrite <- pow_succ_r.
+   intros m.
+   destruct (le_gt_cases 0 m).
+   rewrite 2 div2_bits by trivial. apply H.
+   now rewrite 2 testbit_neg_r.
+ intros a b H.
+ destruct (le_gt_cases 0 a) as [Ha|Ha].
+ apply (AUX a); trivial. split; trivial.
+ apply pow_gt_lin_r; order'.
+ apply succ_inj, opp_inj.
+ assert (0 <= - S a).
+  apply opp_le_mono. now rewrite opp_involutive, opp_0, le_succ_l.
+ apply (AUX (-(S a))); trivial. split; trivial.
+ apply pow_gt_lin_r; order'.
+  intros m. destruct (le_gt_cases 0 m).
+  now rewrite 2 bits_opp, 2 pred_succ, H.
+  now rewrite 2 testbit_neg_r.
+Qed.
+
+Lemma bits_inj_iff : forall a b, testbit a === testbit b <-> a == b.
+Proof.
+ split. apply bits_inj. intros EQ; now rewrite EQ.
+Qed.
+
+(** In fact, checking the bits at positive indexes is enough. *)
+
+Lemma bits_inj' : forall a b,
+ (forall n, 0<=n -> a.[n] = b.[n]) -> a == b.
+Proof.
+ intros a b H. apply bits_inj.
+ intros n. destruct (le_gt_cases 0 n).
+ now apply H.
+ now rewrite 2 testbit_neg_r.
+Qed.
+
+Lemma bits_inj_iff' : forall a b, (forall n, 0<=n -> a.[n] = b.[n]) <-> a == b.
+Proof.
+ split. apply bits_inj'. intros EQ n Hn; now rewrite EQ.
+Qed.
+
+Ltac bitwise := apply bits_inj'; intros ?m ?Hm; autorewrite with bitwise.
+
+Hint Rewrite lxor_spec lor_spec land_spec ldiff_spec bits_0 : bitwise.
+
+(** The streams of bits that correspond to a numbers are
+  exactly the ones which are stationary after some point. *)
+
+Lemma are_bits : forall (f:t->bool), Proper (eq==>Logic.eq) f ->
+ ((exists n, forall m, 0<=m -> f m = n.[m]) <->
+  (exists k, forall m, k<=m -> f m = f k)).
+Proof.
+ intros f Hf. split.
+ intros (a,H).
+  destruct (le_gt_cases 0 a).
+  exists (S (log2 a)). intros m Hm. apply le_succ_l in Hm.
+  rewrite 2 H, 2 bits_above_log2; trivial using lt_succ_diag_r.
+  order_pos. apply le_trans with (log2 a); order_pos.
+  exists (S (log2 (P (-a)))). intros m Hm. apply le_succ_l in Hm.
+  rewrite 2 H, 2 bits_above_log2_neg; trivial using lt_succ_diag_r.
+  order_pos. apply le_trans with (log2 (P (-a))); order_pos.
+ intros (k,Hk).
+  destruct (lt_ge_cases k 0) as [LT|LE].
+  case_eq (f 0); intros H0.
+  exists (-1). intros m Hm. rewrite bits_m1, Hk by order.
+  symmetry; rewrite <- H0. apply Hk; order.
+  exists 0. intros m Hm. rewrite bits_0, Hk by order.
+  symmetry; rewrite <- H0. apply Hk; order.
+  revert f Hf Hk. apply le_ind with (4:=LE).
+  (* compat : solve_proper fails here *)
+  apply proper_sym_impl_iff. exact eq_sym.
+  clear k LE. intros k k' Hk IH f Hf H. apply IH; trivial.
+  now setoid_rewrite Hk.
+  (* /compat *)
+  intros f Hf H0. destruct (f 0).
+  exists (-1). intros m Hm. now rewrite bits_m1, H0.
+  exists 0. intros m Hm. now rewrite bits_0, H0.
+  clear k LE. intros k LE IH f Hf Hk.
+  destruct (IH (fun m => f (S m))) as (n, Hn).
+  solve_proper.
+  intros m Hm. apply Hk. now rewrite <- succ_le_mono.
+  exists (f 0 + 2*n). intros m Hm.
+  le_elim Hm.
+  rewrite <- (succ_pred m), Hn, <- div2_bits.
+  rewrite mul_comm, div_add, b2z_div2, add_0_l; trivial. order'.
+  now rewrite <- lt_succ_r, succ_pred.
+  now rewrite <- lt_succ_r, succ_pred.
+  rewrite <- Hm.
+  symmetry. apply add_b2z_double_bit0.
+Qed.
+
+(** * Properties of shifts *)
+
+(** First, a unified specification for [shiftl] : the [shiftl_spec]
+   below (combined with [testbit_neg_r]) is equivalent to
+   [shiftl_spec_low] and [shiftl_spec_high]. *)
+
+Lemma shiftl_spec : forall a n m, 0<=m -> (a << n).[m] = a.[m-n].
+Proof.
+ intros.
+ destruct (le_gt_cases n m).
+ now apply shiftl_spec_high.
+ rewrite shiftl_spec_low, testbit_neg_r; trivial. now apply lt_sub_0.
+Qed.
+
+(** A shiftl by a negative number is a shiftr, and vice-versa *)
+
+Lemma shiftr_opp_r : forall a n, a >> (-n) == a << n.
+Proof.
+ intros. bitwise. now rewrite shiftr_spec, shiftl_spec, add_opp_r.
+Qed.
+
+Lemma shiftl_opp_r : forall a n, a << (-n) == a >> n.
+Proof.
+ intros. bitwise. now rewrite shiftr_spec, shiftl_spec, sub_opp_r.
+Qed.
+
+(** Shifts correspond to multiplication or division by a power of two *)
+
+Lemma shiftr_div_pow2 : forall a n, 0<=n -> a >> n == a / 2^n.
+Proof.
+ intros. bitwise. now rewrite shiftr_spec, div_pow2_bits.
+Qed.
+
+Lemma shiftr_mul_pow2 : forall a n, n<=0 -> a >> n == a * 2^(-n).
+Proof.
+ intros. bitwise. rewrite shiftr_spec, mul_pow2_bits; trivial.
+ now rewrite sub_opp_r.
+ now apply opp_nonneg_nonpos.
+Qed.
+
+Lemma shiftl_mul_pow2 : forall a n, 0<=n -> a << n == a * 2^n.
+Proof.
+ intros. bitwise. now rewrite shiftl_spec, mul_pow2_bits.
+Qed.
+
+Lemma shiftl_div_pow2 : forall a n, n<=0 -> a << n == a / 2^(-n).
+Proof.
+ intros. bitwise. rewrite shiftl_spec, div_pow2_bits; trivial.
+ now rewrite add_opp_r.
+ now apply opp_nonneg_nonpos.
+Qed.
+
+(** Shifts are morphisms *)
+
+Instance shiftr_wd : Proper (eq==>eq==>eq) shiftr.
+Proof.
+ intros a a' Ha n n' Hn.
+ destruct (le_ge_cases n 0) as [H|H]; assert (H':=H); rewrite Hn in H'.
+ now rewrite 2 shiftr_mul_pow2, Ha, Hn.
+ now rewrite 2 shiftr_div_pow2, Ha, Hn.
+Qed.
+
+Instance shiftl_wd : Proper (eq==>eq==>eq) shiftl.
+Proof.
+ intros a a' Ha n n' Hn. now rewrite <- 2 shiftr_opp_r, Ha, Hn.
+Qed.
+
+(** We could also have specified shiftl with an addition on the left. *)
+
+Lemma shiftl_spec_alt : forall a n m, 0<=n -> (a << n).[m+n] = a.[m].
+Proof.
+ intros. now rewrite shiftl_mul_pow2, mul_pow2_bits, add_simpl_r.
+Qed.
+
+(** Chaining several shifts. The only case for which
+    there isn't any simple expression is a true shiftr
+    followed by a true shiftl.
+*)
+
+Lemma shiftl_shiftl : forall a n m, 0<=n ->
+ (a << n) << m == a << (n+m).
+Proof.
+ intros a n p Hn. bitwise.
+ rewrite 2 (shiftl_spec _ _ m) by trivial.
+ rewrite add_comm, sub_add_distr.
+ destruct (le_gt_cases 0 (m-p)) as [H|H].
+ now rewrite shiftl_spec.
+ rewrite 2 testbit_neg_r; trivial.
+ apply lt_sub_0. now apply lt_le_trans with 0.
+Qed.
+
+Lemma shiftr_shiftl_l : forall a n m, 0<=n ->
+ (a << n) >> m == a << (n-m).
+Proof.
+ intros. now rewrite <- shiftl_opp_r, shiftl_shiftl, add_opp_r.
+Qed.
+
+Lemma shiftr_shiftl_r : forall a n m, 0<=n ->
+ (a << n) >> m == a >> (m-n).
+Proof.
+ intros. now rewrite <- 2 shiftl_opp_r, shiftl_shiftl, opp_sub_distr, add_comm.
+Qed.
+
+Lemma shiftr_shiftr : forall a n m, 0<=m ->
+ (a >> n) >> m == a >> (n+m).
+Proof.
+ intros a n p Hn. bitwise.
+ rewrite 3 shiftr_spec; trivial.
+ now rewrite (add_comm n p), add_assoc.
+ now apply add_nonneg_nonneg.
+Qed.
+
+(** shifts and constants *)
+
+Lemma shiftl_1_l : forall n, 1 << n == 2^n.
+Proof.
+ intros n. destruct (le_gt_cases 0 n).
+ now rewrite shiftl_mul_pow2, mul_1_l.
+ rewrite shiftl_div_pow2, div_1_l, pow_neg_r; try order.
+ apply pow_gt_1. order'. now apply opp_pos_neg.
+Qed.
+
+Lemma shiftl_0_r : forall a, a << 0 == a.
+Proof.
+ intros. rewrite shiftl_mul_pow2 by order. now nzsimpl.
+Qed.
+
+Lemma shiftr_0_r : forall a, a >> 0 == a.
+Proof.
+ intros. now rewrite <- shiftl_opp_r, opp_0, shiftl_0_r.
+Qed.
+
+Lemma shiftl_0_l : forall n, 0 << n == 0.
+Proof.
+ intros.
+ destruct (le_ge_cases 0 n).
+ rewrite shiftl_mul_pow2 by trivial. now nzsimpl.
+ rewrite shiftl_div_pow2 by trivial.
+ rewrite <- opp_nonneg_nonpos in H. nzsimpl; order_nz.
+Qed.
+
+Lemma shiftr_0_l : forall n, 0 >> n == 0.
+Proof.
+ intros. now rewrite <- shiftl_opp_r, shiftl_0_l.
+Qed.
+
+Lemma shiftl_eq_0_iff : forall a n, 0<=n -> (a << n == 0 <-> a == 0).
+Proof.
+ intros a n Hn.
+ rewrite shiftl_mul_pow2 by trivial. rewrite eq_mul_0. split.
+ intros [H | H]; trivial. contradict H; order_nz.
+ intros H. now left.
+Qed.
+
+Lemma shiftr_eq_0_iff : forall a n,
+ a >> n == 0 <-> a==0 \/ (0<a /\ log2 a < n).
+Proof.
+ intros a n.
+ destruct (le_gt_cases 0 n) as [Hn|Hn].
+ rewrite shiftr_div_pow2, div_small_iff by order_nz.
+ destruct (lt_trichotomy a 0) as [LT|[EQ|LT]].
+ split.
+ intros [(H,_)|(H,H')]. order. generalize (pow_nonneg 2 n le_0_2); order.
+ intros [H|(H,H')]; order.
+ rewrite EQ. split. now left. intros _; left. split; order_pos.
+ split. intros [(H,H')|(H,H')]; right. split; trivial.
+  apply log2_lt_pow2; trivial.
+  generalize (pow_nonneg 2 n le_0_2); order.
+ intros [H|(H,H')]. order. left.
+ split. order. now apply log2_lt_pow2.
+ rewrite shiftr_mul_pow2 by order. rewrite eq_mul_0.
+ split; intros [H|H].
+ now left.
+ elim (pow_nonzero 2 (-n)); try apply opp_nonneg_nonpos; order'.
+ now left.
+ destruct H. generalize (log2_nonneg a); order.
+Qed.
+
+Lemma shiftr_eq_0 : forall a n, 0<=a -> log2 a < n -> a >> n == 0.
+Proof.
+ intros a n Ha H. apply shiftr_eq_0_iff.
+ le_elim Ha. right. now split. now left.
+Qed.
+
+(** Properties of [div2]. *)
+
+Lemma div2_div : forall a, div2 a == a/2.
+Proof.
+ intros. rewrite div2_spec, shiftr_div_pow2. now nzsimpl. order'.
+Qed.
+
+Instance div2_wd : Proper (eq==>eq) div2.
+Proof.
+ intros a a' Ha. now rewrite 2 div2_div, Ha.
+Qed.
+
+Lemma div2_odd : forall a, a == 2*(div2 a) + odd a.
+Proof.
+ intros a. rewrite div2_div, <- bit0_odd, bit0_mod.
+ apply div_mod. order'.
+Qed.
+
+(** Properties of [lxor] and others, directly deduced
+    from properties of [xorb] and others. *)
+
+Instance lxor_wd : Proper (eq ==> eq ==> eq) lxor.
+Proof.
+ intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb.
+Qed.
+
+Instance land_wd : Proper (eq ==> eq ==> eq) land.
+Proof.
+ intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb.
+Qed.
+
+Instance lor_wd : Proper (eq ==> eq ==> eq) lor.
+Proof.
+ intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb.
+Qed.
+
+Instance ldiff_wd : Proper (eq ==> eq ==> eq) ldiff.
+Proof.
+ intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb.
+Qed.
+
+Lemma lxor_eq : forall a a', lxor a a' == 0 -> a == a'.
+Proof.
+ intros a a' H. bitwise. apply xorb_eq.
+ now rewrite <- lxor_spec, H, bits_0.
+Qed.
+
+Lemma lxor_nilpotent : forall a, lxor a a == 0.
+Proof.
+ intros. bitwise. apply xorb_nilpotent.
+Qed.
+
+Lemma lxor_eq_0_iff : forall a a', lxor a a' == 0 <-> a == a'.
+Proof.
+ split. apply lxor_eq. intros EQ; rewrite EQ; apply lxor_nilpotent.
+Qed.
+
+Lemma lxor_0_l : forall a, lxor 0 a == a.
+Proof.
+ intros. bitwise. apply xorb_false_l.
+Qed.
+
+Lemma lxor_0_r : forall a, lxor a 0 == a.
+Proof.
+ intros. bitwise. apply xorb_false_r.
+Qed.
+
+Lemma lxor_comm : forall a b, lxor a b == lxor b a.
+Proof.
+ intros. bitwise. apply xorb_comm.
+Qed.
+
+Lemma lxor_assoc :
+ forall a b c, lxor (lxor a b) c == lxor a (lxor b c).
+Proof.
+ intros. bitwise. apply xorb_assoc.
+Qed.
+
+Lemma lor_0_l : forall a, lor 0 a == a.
+Proof.
+ intros. bitwise. trivial.
+Qed.
+
+Lemma lor_0_r : forall a, lor a 0 == a.
+Proof.
+ intros. bitwise. apply orb_false_r.
+Qed.
+
+Lemma lor_comm : forall a b, lor a b == lor b a.
+Proof.
+ intros. bitwise. apply orb_comm.
+Qed.
+
+Lemma lor_assoc :
+ forall a b c, lor a (lor b c) == lor (lor a b) c.
+Proof.
+ intros. bitwise. apply orb_assoc.
+Qed.
+
+Lemma lor_diag : forall a, lor a a == a.
+Proof.
+ intros. bitwise. apply orb_diag.
+Qed.
+
+Lemma lor_eq_0_l : forall a b, lor a b == 0 -> a == 0.
+Proof.
+ intros a b H. bitwise.
+ apply (orb_false_iff a.[m] b.[m]).
+ now rewrite <- lor_spec, H, bits_0.
+Qed.
+
+Lemma lor_eq_0_iff : forall a b, lor a b == 0 <-> a == 0 /\ b == 0.
+Proof.
+ intros a b. split.
+ split. now apply lor_eq_0_l in H.
+ rewrite lor_comm in H. now apply lor_eq_0_l in H.
+ intros (EQ,EQ'). now rewrite EQ, lor_0_l.
+Qed.
+
+Lemma land_0_l : forall a, land 0 a == 0.
+Proof.
+ intros. bitwise. trivial.
+Qed.
+
+Lemma land_0_r : forall a, land a 0 == 0.
+Proof.
+ intros. bitwise. apply andb_false_r.
+Qed.
+
+Lemma land_comm : forall a b, land a b == land b a.
+Proof.
+ intros. bitwise. apply andb_comm.
+Qed.
+
+Lemma land_assoc :
+ forall a b c, land a (land b c) == land (land a b) c.
+Proof.
+ intros. bitwise. apply andb_assoc.
+Qed.
+
+Lemma land_diag : forall a, land a a == a.
+Proof.
+ intros. bitwise. apply andb_diag.
+Qed.
+
+Lemma ldiff_0_l : forall a, ldiff 0 a == 0.
+Proof.
+ intros. bitwise. trivial.
+Qed.
+
+Lemma ldiff_0_r : forall a, ldiff a 0 == a.
+Proof.
+ intros. bitwise. now rewrite andb_true_r.
+Qed.
+
+Lemma ldiff_diag : forall a, ldiff a a == 0.
+Proof.
+ intros. bitwise. apply andb_negb_r.
+Qed.
+
+Lemma lor_land_distr_l : forall a b c,
+ lor (land a b) c == land (lor a c) (lor b c).
+Proof.
+ intros. bitwise. apply orb_andb_distrib_l.
+Qed.
+
+Lemma lor_land_distr_r : forall a b c,
+ lor a (land b c) == land (lor a b) (lor a c).
+Proof.
+ intros. bitwise. apply orb_andb_distrib_r.
+Qed.
+
+Lemma land_lor_distr_l : forall a b c,
+ land (lor a b) c == lor (land a c) (land b c).
+Proof.
+ intros. bitwise. apply andb_orb_distrib_l.
+Qed.
+
+Lemma land_lor_distr_r : forall a b c,
+ land a (lor b c) == lor (land a b) (land a c).
+Proof.
+ intros. bitwise. apply andb_orb_distrib_r.
+Qed.
+
+Lemma ldiff_ldiff_l : forall a b c,
+ ldiff (ldiff a b) c == ldiff a (lor b c).
+Proof.
+ intros. bitwise. now rewrite negb_orb, andb_assoc.
+Qed.
+
+Lemma lor_ldiff_and : forall a b,
+ lor (ldiff a b) (land a b) == a.
+Proof.
+ intros. bitwise.
+ now rewrite <- andb_orb_distrib_r, orb_comm, orb_negb_r, andb_true_r.
+Qed.
+
+Lemma land_ldiff : forall a b,
+ land (ldiff a b) b == 0.
+Proof.
+ intros. bitwise.
+ now rewrite <-andb_assoc, (andb_comm (negb _)), andb_negb_r, andb_false_r.
+Qed.
+
+(** Properties of [setbit] and [clearbit] *)
+
+Definition setbit a n := lor a (1 << n).
+Definition clearbit a n := ldiff a (1 << n).
+
+Lemma setbit_spec' : forall a n, setbit a n == lor a (2^n).
+Proof.
+ intros. unfold setbit. now rewrite shiftl_1_l.
+Qed.
+
+Lemma clearbit_spec' : forall a n, clearbit a n == ldiff a (2^n).
+Proof.
+ intros. unfold clearbit. now rewrite shiftl_1_l.
+Qed.
+
+Instance setbit_wd : Proper (eq==>eq==>eq) setbit.
+Proof. unfold setbit. solve_proper. Qed.
+
+Instance clearbit_wd : Proper (eq==>eq==>eq) clearbit.
+Proof. unfold clearbit. solve_proper. Qed.
+
+Lemma pow2_bits_true : forall n, 0<=n -> (2^n).[n] = true.
+Proof.
+ intros. rewrite <- (mul_1_l (2^n)).
+ now rewrite mul_pow2_bits, sub_diag, bit0_odd, odd_1.
+Qed.
+
+Lemma pow2_bits_false : forall n m, n~=m -> (2^n).[m] = false.
+Proof.
+ intros.
+ destruct (le_gt_cases 0 n); [|now rewrite pow_neg_r, bits_0].
+ destruct (le_gt_cases n m).
+ rewrite <- (mul_1_l (2^n)), mul_pow2_bits; trivial.
+ rewrite <- (succ_pred (m-n)), <- div2_bits.
+ now rewrite div_small, bits_0 by (split; order').
+ rewrite <- lt_succ_r, succ_pred, lt_0_sub. order.
+ rewrite <- (mul_1_l (2^n)), mul_pow2_bits_low; trivial.
+Qed.
+
+Lemma pow2_bits_eqb : forall n m, 0<=n -> (2^n).[m] = eqb n m.
+Proof.
+ intros n m Hn. apply eq_true_iff_eq. rewrite eqb_eq. split.
+ destruct (eq_decidable n m) as [H|H]. trivial.
+ now rewrite (pow2_bits_false _ _ H).
+ intros EQ. rewrite EQ. apply pow2_bits_true; order.
+Qed.
+
+Lemma setbit_eqb : forall a n m, 0<=n ->
+ (setbit a n).[m] = eqb n m || a.[m].
+Proof.
+ intros. now rewrite setbit_spec', lor_spec, pow2_bits_eqb, orb_comm.
+Qed.
+
+Lemma setbit_iff : forall a n m, 0<=n ->
+ ((setbit a n).[m] = true <-> n==m \/ a.[m] = true).
+Proof.
+ intros. now rewrite setbit_eqb, orb_true_iff, eqb_eq.
+Qed.
+
+Lemma setbit_eq : forall a n, 0<=n -> (setbit a n).[n] = true.
+Proof.
+ intros. apply setbit_iff; trivial. now left.
+Qed.
+
+Lemma setbit_neq : forall a n m, 0<=n -> n~=m ->
+ (setbit a n).[m] = a.[m].
+Proof.
+ intros a n m Hn H. rewrite setbit_eqb; trivial.
+ rewrite <- eqb_eq in H. apply not_true_is_false in H. now rewrite H.
+Qed.
+
+Lemma clearbit_eqb : forall a n m,
+ (clearbit a n).[m] = a.[m] && negb (eqb n m).
+Proof.
+ intros.
+ destruct (le_gt_cases 0 m); [| now rewrite 2 testbit_neg_r].
+ rewrite clearbit_spec', ldiff_spec. f_equal. f_equal.
+ destruct (le_gt_cases 0 n) as [Hn|Hn].
+ now apply pow2_bits_eqb.
+ symmetry. rewrite pow_neg_r, bits_0, <- not_true_iff_false, eqb_eq; order.
+Qed.
+
+Lemma clearbit_iff : forall a n m,
+ (clearbit a n).[m] = true <-> a.[m] = true /\ n~=m.
+Proof.
+ intros. rewrite clearbit_eqb, andb_true_iff, <- eqb_eq.
+ now rewrite negb_true_iff, not_true_iff_false.
+Qed.
+
+Lemma clearbit_eq : forall a n, (clearbit a n).[n] = false.
+Proof.
+ intros. rewrite clearbit_eqb, (proj2 (eqb_eq _ _) (eq_refl n)).
+ apply andb_false_r.
+Qed.
+
+Lemma clearbit_neq : forall a n m, n~=m ->
+ (clearbit a n).[m] = a.[m].
+Proof.
+ intros a n m H. rewrite clearbit_eqb.
+ rewrite <- eqb_eq in H. apply not_true_is_false in H. rewrite H.
+ apply andb_true_r.
+Qed.
+
+(** Shifts of bitwise operations *)
+
+Lemma shiftl_lxor : forall a b n,
+ (lxor a b) << n == lxor (a << n) (b << n).
+Proof.
+ intros. bitwise. now rewrite !shiftl_spec, lxor_spec.
+Qed.
+
+Lemma shiftr_lxor : forall a b n,
+ (lxor a b) >> n == lxor (a >> n) (b >> n).
+Proof.
+ intros. bitwise. now rewrite !shiftr_spec, lxor_spec.
+Qed.
+
+Lemma shiftl_land : forall a b n,
+ (land a b) << n == land (a << n) (b << n).
+Proof.
+ intros. bitwise. now rewrite !shiftl_spec, land_spec.
+Qed.
+
+Lemma shiftr_land : forall a b n,
+ (land a b) >> n == land (a >> n) (b >> n).
+Proof.
+ intros. bitwise. now rewrite !shiftr_spec, land_spec.
+Qed.
+
+Lemma shiftl_lor : forall a b n,
+ (lor a b) << n == lor (a << n) (b << n).
+Proof.
+ intros. bitwise. now rewrite !shiftl_spec, lor_spec.
+Qed.
+
+Lemma shiftr_lor : forall a b n,
+ (lor a b) >> n == lor (a >> n) (b >> n).
+Proof.
+ intros. bitwise. now rewrite !shiftr_spec, lor_spec.
+Qed.
+
+Lemma shiftl_ldiff : forall a b n,
+ (ldiff a b) << n == ldiff (a << n) (b << n).
+Proof.
+ intros. bitwise. now rewrite !shiftl_spec, ldiff_spec.
+Qed.
+
+Lemma shiftr_ldiff : forall a b n,
+ (ldiff a b) >> n == ldiff (a >> n) (b >> n).
+Proof.
+ intros. bitwise. now rewrite !shiftr_spec, ldiff_spec.
+Qed.
+
+(** For integers, we do have a binary complement function *)
+
+Definition lnot a := P (-a).
+
+Instance lnot_wd : Proper (eq==>eq) lnot.
+Proof. unfold lnot. solve_proper. Qed.
+
+Lemma lnot_spec : forall a n, 0<=n -> (lnot a).[n] = negb a.[n].
+Proof.
+ intros. unfold lnot. rewrite <- (opp_involutive a) at 2.
+ rewrite bits_opp, negb_involutive; trivial.
+Qed.
+
+Lemma lnot_involutive : forall a, lnot (lnot a) == a.
+Proof.
+ intros a. bitwise. now rewrite 2 lnot_spec, negb_involutive.
+Qed.
+
+Lemma lnot_0 : lnot 0 == -1.
+Proof.
+ unfold lnot. now rewrite opp_0, <- sub_1_r, sub_0_l.
+Qed.
+
+Lemma lnot_m1 : lnot (-1) == 0.
+Proof.
+ unfold lnot. now rewrite opp_involutive, one_succ, pred_succ.
+Qed.
+
+(** Complement and other operations *)
+
+Lemma lor_m1_r : forall a, lor a (-1) == -1.
+Proof.
+ intros. bitwise. now rewrite bits_m1, orb_true_r.
+Qed.
+
+Lemma lor_m1_l : forall a, lor (-1) a == -1.
+Proof.
+ intros. now rewrite lor_comm, lor_m1_r.
+Qed.
+
+Lemma land_m1_r : forall a, land a (-1) == a.
+Proof.
+ intros. bitwise. now rewrite bits_m1, andb_true_r.
+Qed.
+
+Lemma land_m1_l : forall a, land (-1) a == a.
+Proof.
+ intros. now rewrite land_comm, land_m1_r.
+Qed.
+
+Lemma ldiff_m1_r : forall a, ldiff a (-1) == 0.
+Proof.
+ intros. bitwise. now rewrite bits_m1, andb_false_r.
+Qed.
+
+Lemma ldiff_m1_l : forall a, ldiff (-1) a == lnot a.
+Proof.
+ intros. bitwise. now rewrite lnot_spec, bits_m1.
+Qed.
+
+Lemma lor_lnot_diag : forall a, lor a (lnot a) == -1.
+Proof.
+ intros a. bitwise. rewrite lnot_spec, bits_m1; trivial.
+ now destruct a.[m].
+Qed.
+
+Lemma add_lnot_diag : forall a, a + lnot a == -1.
+Proof.
+ intros a. unfold lnot.
+ now rewrite add_pred_r, add_opp_r, sub_diag, one_succ, opp_succ, opp_0.
+Qed.
+
+Lemma ldiff_land : forall a b, ldiff a b == land a (lnot b).
+Proof.
+ intros. bitwise. now rewrite lnot_spec.
+Qed.
+
+Lemma land_lnot_diag : forall a, land a (lnot a) == 0.
+Proof.
+ intros. now rewrite <- ldiff_land, ldiff_diag.
+Qed.
+
+Lemma lnot_lor : forall a b, lnot (lor a b) == land (lnot a) (lnot b).
+Proof.
+ intros a b. bitwise. now rewrite !lnot_spec, lor_spec, negb_orb.
+Qed.
+
+Lemma lnot_land : forall a b, lnot (land a b) == lor (lnot a) (lnot b).
+Proof.
+ intros a b. bitwise. now rewrite !lnot_spec, land_spec, negb_andb.
+Qed.
+
+Lemma lnot_ldiff : forall a b, lnot (ldiff a b) == lor (lnot a) b.
+Proof.
+ intros a b. bitwise.
+ now rewrite !lnot_spec, ldiff_spec, negb_andb, negb_involutive.
+Qed.
+
+Lemma lxor_lnot_lnot : forall a b, lxor (lnot a) (lnot b) == lxor a b.
+Proof.
+ intros a b. bitwise. now rewrite !lnot_spec, xorb_negb_negb.
+Qed.
+
+Lemma lnot_lxor_l : forall a b, lnot (lxor a b) == lxor (lnot a) b.
+Proof.
+ intros a b. bitwise. now rewrite !lnot_spec, !lxor_spec, negb_xorb_l.
+Qed.
+
+Lemma lnot_lxor_r : forall a b, lnot (lxor a b) == lxor a (lnot b).
+Proof.
+ intros a b. bitwise. now rewrite !lnot_spec, !lxor_spec, negb_xorb_r.
+Qed.
+
+Lemma lxor_m1_r : forall a, lxor a (-1) == lnot a.
+Proof.
+ intros. now rewrite <- (lxor_0_r (lnot a)), <- lnot_m1, lxor_lnot_lnot.
+Qed.
+
+Lemma lxor_m1_l : forall a, lxor (-1) a == lnot a.
+Proof.
+ intros. now rewrite lxor_comm, lxor_m1_r.
+Qed.
+
+Lemma lxor_lor : forall a b, land a b == 0 ->
+ lxor a b == lor a b.
+Proof.
+ intros a b H. bitwise.
+ assert (a.[m] && b.[m] = false)
+   by now rewrite <- land_spec, H, bits_0.
+ now destruct a.[m], b.[m].
+Qed.
+
+Lemma lnot_shiftr : forall a n, 0<=n -> lnot (a >> n) == (lnot a) >> n.
+Proof.
+ intros a n Hn. bitwise.
+ now rewrite lnot_spec, 2 shiftr_spec, lnot_spec by order_pos.
+Qed.
+
+(** [(ones n)] is [2^n-1], the number with [n] digits 1 *)
+
+Definition ones n := P (1<<n).
+
+Instance ones_wd : Proper (eq==>eq) ones.
+Proof. unfold ones. solve_proper. Qed.
+
+Lemma ones_equiv : forall n, ones n == P (2^n).
+Proof.
+ intros. unfold ones.
+ destruct (le_gt_cases 0 n).
+ now rewrite shiftl_mul_pow2, mul_1_l.
+ f_equiv. rewrite pow_neg_r; trivial.
+ rewrite <- shiftr_opp_r. apply shiftr_eq_0_iff. right; split.
+ order'. rewrite log2_1. now apply opp_pos_neg.
+Qed.
+
+Lemma ones_add : forall n m, 0<=n -> 0<=m ->
+ ones (m+n) == 2^m * ones n + ones m.
+Proof.
+ intros n m Hn Hm. rewrite !ones_equiv.
+ rewrite <- !sub_1_r, mul_sub_distr_l, mul_1_r, <- pow_add_r by trivial.
+ rewrite add_sub_assoc, sub_add. reflexivity.
+Qed.
+
+Lemma ones_div_pow2 : forall n m, 0<=m<=n -> ones n / 2^m == ones (n-m).
+Proof.
+ intros n m (Hm,H). symmetry. apply div_unique with (ones m).
+ left. rewrite ones_equiv. split.
+ rewrite <- lt_succ_r, succ_pred. order_pos.
+ now rewrite <- le_succ_l, succ_pred.
+ rewrite <- (sub_add m n) at 1. rewrite (add_comm _ m).
+ apply ones_add; trivial. now apply le_0_sub.
+Qed.
+
+Lemma ones_mod_pow2 : forall n m, 0<=m<=n -> (ones n) mod (2^m) == ones m.
+Proof.
+ intros n m (Hm,H). symmetry. apply mod_unique with (ones (n-m)).
+ left. rewrite ones_equiv. split.
+ rewrite <- lt_succ_r, succ_pred. order_pos.
+ now rewrite <- le_succ_l, succ_pred.
+ rewrite <- (sub_add m n) at 1. rewrite (add_comm _ m).
+ apply ones_add; trivial. now apply le_0_sub.
+Qed.
+
+Lemma ones_spec_low : forall n m, 0<=m<n -> (ones n).[m] = true.
+Proof.
+ intros n m (Hm,H). apply testbit_true; trivial.
+ rewrite ones_div_pow2 by (split; order).
+ rewrite <- (pow_1_r 2). rewrite ones_mod_pow2.
+ rewrite ones_equiv. now nzsimpl'.
+ split. order'. apply le_add_le_sub_r. nzsimpl. now apply le_succ_l.
+Qed.
+
+Lemma ones_spec_high : forall n m, 0<=n<=m -> (ones n).[m] = false.
+Proof.
+ intros n m (Hn,H). le_elim Hn.
+ apply bits_above_log2; rewrite ones_equiv.
+ rewrite <-lt_succ_r, succ_pred; order_pos.
+ rewrite log2_pred_pow2; trivial. now rewrite <-le_succ_l, succ_pred.
+ rewrite ones_equiv. now rewrite <- Hn, pow_0_r, one_succ, pred_succ, bits_0.
+Qed.
+
+Lemma ones_spec_iff : forall n m, 0<=n ->
+ ((ones n).[m] = true <-> 0<=m<n).
+Proof.
+ intros n m Hn. split. intros H.
+ destruct (lt_ge_cases m 0) as [Hm|Hm].
+  now rewrite testbit_neg_r in H.
+  split; trivial. apply lt_nge. intro H'. rewrite ones_spec_high in H.
+  discriminate. now split.
+ apply ones_spec_low.
+Qed.
+
+Lemma lor_ones_low : forall a n, 0<=a -> log2 a < n ->
+ lor a (ones n) == ones n.
+Proof.
+ intros a n Ha H. bitwise. destruct (le_gt_cases n m).
+ rewrite ones_spec_high, bits_above_log2; try split; trivial.
+ now apply lt_le_trans with n.
+ apply le_trans with (log2 a); order_pos.
+ rewrite ones_spec_low, orb_true_r; try split; trivial.
+Qed.
+
+Lemma land_ones : forall a n, 0<=n -> land a (ones n) == a mod 2^n.
+Proof.
+ intros a n Hn. bitwise. destruct (le_gt_cases n m).
+ rewrite ones_spec_high, mod_pow2_bits_high, andb_false_r;
+  try split; trivial.
+ rewrite ones_spec_low, mod_pow2_bits_low, andb_true_r;
+  try split; trivial.
+Qed.
+
+Lemma land_ones_low : forall a n, 0<=a -> log2 a < n ->
+ land a (ones n) == a.
+Proof.
+ intros a n Ha H.
+ assert (Hn : 0<=n) by (generalize (log2_nonneg a); order).
+ rewrite land_ones; trivial. apply mod_small.
+ split; trivial.
+ apply log2_lt_cancel. now rewrite log2_pow2.
+Qed.
+
+Lemma ldiff_ones_r : forall a n, 0<=n ->
+ ldiff a (ones n) == (a >> n) << n.
+Proof.
+ intros a n Hn. bitwise. destruct (le_gt_cases n m).
+ rewrite ones_spec_high, shiftl_spec_high, shiftr_spec; trivial.
+ rewrite sub_add; trivial. apply andb_true_r.
+ now apply le_0_sub.
+ now split.
+ rewrite ones_spec_low, shiftl_spec_low, andb_false_r;
+  try split; trivial.
+Qed.
+
+Lemma ldiff_ones_r_low : forall a n, 0<=a -> log2 a < n ->
+ ldiff a (ones n) == 0.
+Proof.
+ intros a n Ha H. bitwise. destruct (le_gt_cases n m).
+ rewrite ones_spec_high, bits_above_log2; trivial.
+ now apply lt_le_trans with n.
+ split; trivial. now apply le_trans with (log2 a); order_pos.
+ rewrite ones_spec_low, andb_false_r; try split; trivial.
+Qed.
+
+Lemma ldiff_ones_l_low : forall a n, 0<=a -> log2 a < n ->
+ ldiff (ones n) a == lxor a (ones n).
+Proof.
+ intros a n Ha H. bitwise. destruct (le_gt_cases n m).
+ rewrite ones_spec_high, bits_above_log2; trivial.
+ now apply lt_le_trans with n.
+ split; trivial. now apply le_trans with (log2 a); order_pos.
+ rewrite ones_spec_low, xorb_true_r; try split; trivial.
+Qed.
+
+(** Bitwise operations and sign *)
+
+Lemma shiftl_nonneg : forall a n, 0 <= (a << n) <-> 0 <= a.
+Proof.
+ intros a n.
+ destruct (le_ge_cases 0 n) as [Hn|Hn].
+ (* 0<=n *)
+ rewrite 2 bits_iff_nonneg_ex. split; intros (k,Hk).
+ exists (k-n). intros m Hm.
+ destruct (le_gt_cases 0 m); [|now rewrite testbit_neg_r].
+ rewrite <- (add_simpl_r m n), <- (shiftl_spec a n) by order_pos.
+ apply Hk. now apply lt_sub_lt_add_r.
+ exists (k+n). intros m Hm.
+ destruct (le_gt_cases 0 m); [|now rewrite testbit_neg_r].
+ rewrite shiftl_spec by trivial. apply Hk. now apply lt_add_lt_sub_r.
+ (* n<=0*)
+ rewrite <- shiftr_opp_r, 2 bits_iff_nonneg_ex. split; intros (k,Hk).
+ destruct (le_gt_cases 0 k).
+ exists (k-n). intros m Hm. apply lt_sub_lt_add_r in Hm.
+ rewrite <- (add_simpl_r m n), <- add_opp_r, <- (shiftr_spec a (-n)).
+ now apply Hk. order.
+ assert (EQ : a >> (-n) == 0).
+  apply bits_inj'. intros m Hm. rewrite bits_0. apply Hk; order.
+ apply shiftr_eq_0_iff in EQ.
+ rewrite <- bits_iff_nonneg_ex. destruct EQ as [EQ|[LT _]]; order.
+ exists (k+n). intros m Hm.
+ destruct (le_gt_cases 0 m); [|now rewrite testbit_neg_r].
+ rewrite shiftr_spec by trivial. apply Hk.
+ rewrite add_opp_r. now apply lt_add_lt_sub_r.
+Qed.
+
+Lemma shiftl_neg : forall a n, (a << n) < 0 <-> a < 0.
+Proof.
+ intros a n. now rewrite 2 lt_nge, shiftl_nonneg.
+Qed.
+
+Lemma shiftr_nonneg : forall a n, 0 <= (a >> n) <-> 0 <= a.
+Proof.
+ intros. rewrite <- shiftl_opp_r. apply shiftl_nonneg.
+Qed.
+
+Lemma shiftr_neg : forall a n, (a >> n) < 0 <-> a < 0.
+Proof.
+ intros a n. now rewrite 2 lt_nge, shiftr_nonneg.
+Qed.
+
+Lemma div2_nonneg : forall a, 0 <= div2 a <-> 0 <= a.
+Proof.
+ intros. rewrite div2_spec. apply shiftr_nonneg.
+Qed.
+
+Lemma div2_neg : forall a, div2 a < 0 <-> a < 0.
+Proof.
+ intros a. now rewrite 2 lt_nge, div2_nonneg.
+Qed.
+
+Lemma lor_nonneg : forall a b, 0 <= lor a b <-> 0<=a /\ 0<=b.
+Proof.
+ intros a b.
+ rewrite 3 bits_iff_nonneg_ex. split. intros (k,Hk).
+ split; exists k; intros m Hm; apply (orb_false_elim a.[m] b.[m]);
+  rewrite <- lor_spec; now apply Hk.
+ intros ((k,Hk),(k',Hk')).
+ destruct (le_ge_cases k k'); [ exists k' | exists k ];
+  intros m Hm; rewrite lor_spec, Hk, Hk'; trivial; order.
+Qed.
+
+Lemma lor_neg : forall a b, lor a b < 0 <-> a < 0 \/ b < 0.
+Proof.
+ intros a b. rewrite 3 lt_nge, lor_nonneg. split.
+  apply not_and. apply le_decidable.
+  now intros [H|H] (H',H'').
+Qed.
+
+Lemma lnot_nonneg : forall a, 0 <= lnot a <-> a < 0.
+Proof.
+ intros a; unfold lnot.
+ now rewrite <- opp_succ, opp_nonneg_nonpos, le_succ_l.
+Qed.
+
+Lemma lnot_neg : forall a, lnot a < 0 <-> 0 <= a.
+Proof.
+ intros a. now rewrite le_ngt, lt_nge, lnot_nonneg.
+Qed.
+
+Lemma land_nonneg : forall a b, 0 <= land a b <-> 0<=a \/ 0<=b.
+Proof.
+ intros a b.
+ now rewrite <- (lnot_involutive (land a b)), lnot_land, lnot_nonneg,
+  lor_neg, !lnot_neg.
+Qed.
+
+Lemma land_neg : forall a b, land a b < 0 <-> a < 0 /\ b < 0.
+Proof.
+ intros a b.
+ now rewrite <- (lnot_involutive (land a b)), lnot_land, lnot_neg,
+  lor_nonneg, !lnot_nonneg.
+Qed.
+
+Lemma ldiff_nonneg : forall a b, 0 <= ldiff a b <-> 0<=a \/ b<0.
+Proof.
+ intros. now rewrite ldiff_land, land_nonneg, lnot_nonneg.
+Qed.
+
+Lemma ldiff_neg : forall a b, ldiff a b < 0 <-> a<0 /\ 0<=b.
+Proof.
+ intros. now rewrite ldiff_land, land_neg, lnot_neg.
+Qed.
+
+Lemma lxor_nonneg : forall a b, 0 <= lxor a b <-> (0<=a <-> 0<=b).
+Proof.
+ assert (H : forall a b, 0<=a -> 0<=b -> 0<=lxor a b).
+  intros a b. rewrite 3 bits_iff_nonneg_ex. intros (k,Hk) (k', Hk').
+  destruct (le_ge_cases k k'); [ exists k' | exists k];
+   intros m Hm; rewrite lxor_spec, Hk, Hk'; trivial; order.
+ assert (H' : forall a b, 0<=a -> b<0 -> lxor a b<0).
+  intros a b. rewrite bits_iff_nonneg_ex, 2 bits_iff_neg_ex.
+  intros (k,Hk) (k', Hk').
+  destruct (le_ge_cases k k'); [ exists k' | exists k];
+   intros m Hm; rewrite lxor_spec, Hk, Hk'; trivial; order.
+ intros a b.
+ split.
+ intros Hab. split.
+ intros Ha. destruct (le_gt_cases 0 b) as [Hb|Hb]; trivial.
+  generalize (H' _ _ Ha Hb). order.
+ intros Hb. destruct (le_gt_cases 0 a) as [Ha|Ha]; trivial.
+  generalize (H' _ _ Hb Ha). rewrite lxor_comm. order.
+ intros E.
+ destruct (le_gt_cases 0 a) as [Ha|Ha]. apply H; trivial. apply E; trivial.
+ destruct (le_gt_cases 0 b) as [Hb|Hb]. apply H; trivial. apply E; trivial.
+ rewrite <- lxor_lnot_lnot. apply H; now apply lnot_nonneg.
+Qed.
+
+(** Bitwise operations and log2 *)
+
+Lemma log2_bits_unique : forall a n,
+ a.[n] = true ->
+ (forall m, n<m -> a.[m] = false) ->
+ log2 a == n.
+Proof.
+ intros a n H H'.
+ destruct (lt_trichotomy a 0) as [Ha|[Ha|Ha]].
+ (* a < 0 *)
+ destruct (proj1 (bits_iff_neg_ex a) Ha) as (k,Hk).
+ destruct (le_gt_cases n k).
+ specialize (Hk (S k) (lt_succ_diag_r _)).
+ rewrite H' in Hk. discriminate. apply lt_succ_r; order.
+ specialize (H' (S n) (lt_succ_diag_r _)).
+ rewrite Hk in H'. discriminate. apply lt_succ_r; order.
+ (* a = 0 *)
+ now rewrite Ha, bits_0 in H.
+ (* 0 < a *)
+ apply le_antisymm; apply le_ngt; intros LT.
+ specialize (H' _ LT). now rewrite bit_log2 in H'.
+ now rewrite bits_above_log2 in H by order.
+Qed.
+
+Lemma log2_shiftr : forall a n, 0<a -> log2 (a >> n) == max 0 (log2 a - n).
+Proof.
+ intros a n Ha.
+ destruct (le_gt_cases 0 (log2 a - n));
+   [rewrite max_r | rewrite max_l]; try order.
+ apply log2_bits_unique.
+ now rewrite shiftr_spec, sub_add, bit_log2.
+ intros m Hm.
+ destruct (le_gt_cases 0 m); [|now rewrite testbit_neg_r].
+ rewrite shiftr_spec; trivial. apply bits_above_log2; try order.
+ now apply lt_sub_lt_add_r.
+ rewrite lt_sub_lt_add_r, add_0_l in H.
+ apply log2_nonpos. apply le_lteq; right.
+ apply shiftr_eq_0_iff. right. now split.
+Qed.
+
+Lemma log2_shiftl : forall a n, 0<a -> 0<=n -> log2 (a << n) == log2 a + n.
+Proof.
+ intros a n Ha Hn.
+ rewrite shiftl_mul_pow2, add_comm by trivial.
+ now apply log2_mul_pow2.
+Qed.
+
+Lemma log2_shiftl' : forall a n, 0<a -> log2 (a << n) == max 0 (log2 a + n).
+Proof.
+ intros a n Ha.
+ rewrite <- shiftr_opp_r, log2_shiftr by trivial.
+ destruct (le_gt_cases 0 (log2 a + n));
+   [rewrite 2 max_r | rewrite 2 max_l]; rewrite ?sub_opp_r; try order.
+Qed.
+
+Lemma log2_lor : forall a b, 0<=a -> 0<=b ->
+ log2 (lor a b) == max (log2 a) (log2 b).
+Proof.
+ assert (AUX : forall a b, 0<=a -> a<=b -> log2 (lor a b) == log2 b).
+  intros a b Ha H.
+  le_elim Ha; [|now rewrite <- Ha, lor_0_l].
+  apply log2_bits_unique.
+  now rewrite lor_spec, bit_log2, orb_true_r by order.
+  intros m Hm. assert (H' := log2_le_mono _ _ H).
+  now rewrite lor_spec, 2 bits_above_log2 by order.
+ (* main *)
+ intros a b Ha Hb. destruct (le_ge_cases a b) as [H|H].
+ rewrite max_r by now apply log2_le_mono.
+ now apply AUX.
+ rewrite max_l by now apply log2_le_mono.
+ rewrite lor_comm. now apply AUX.
+Qed.
+
+Lemma log2_land : forall a b, 0<=a -> 0<=b ->
+ log2 (land a b) <= min (log2 a) (log2 b).
+Proof.
+ assert (AUX : forall a b, 0<=a -> a<=b -> log2 (land a b) <= log2 a).
+  intros a b Ha Hb.
+  apply le_ngt. intros LT.
+  assert (H : 0 <= land a b) by (apply land_nonneg; now left).
+  le_elim H.
+  generalize (bit_log2 (land a b) H).
+  now rewrite land_spec, bits_above_log2.
+  rewrite <- H in LT. apply log2_lt_cancel in LT; order.
+ (* main *)
+ intros a b Ha Hb.
+ destruct (le_ge_cases a b) as [H|H].
+ rewrite min_l by now apply log2_le_mono. now apply AUX.
+ rewrite min_r by now apply log2_le_mono. rewrite land_comm. now apply AUX.
+Qed.
+
+Lemma log2_lxor : forall a b, 0<=a -> 0<=b ->
+ log2 (lxor a b) <= max (log2 a) (log2 b).
+Proof.
+ assert (AUX : forall a b, 0<=a -> a<=b -> log2 (lxor a b) <= log2 b).
+  intros a b Ha Hb.
+  apply le_ngt. intros LT.
+  assert (H : 0 <= lxor a b) by (apply lxor_nonneg; split; order).
+  le_elim H.
+  generalize (bit_log2 (lxor a b) H).
+  rewrite lxor_spec, 2 bits_above_log2; try order. discriminate.
+  apply le_lt_trans with (log2 b); trivial. now apply log2_le_mono.
+  rewrite <- H in LT. apply log2_lt_cancel in LT; order.
+ (* main *)
+ intros a b Ha Hb.
+ destruct (le_ge_cases a b) as [H|H].
+ rewrite max_r by now apply log2_le_mono. now apply AUX.
+ rewrite max_l by now apply log2_le_mono. rewrite lxor_comm. now apply AUX.
+Qed.
+
+(** Bitwise operations and arithmetical operations *)
+
+Local Notation xor3 a b c := (xorb (xorb a b) c).
+Local Notation lxor3 a b c := (lxor (lxor a b) c).
+Local Notation nextcarry a b c := ((a&&b) || (c && (a||b))).
+Local Notation lnextcarry a b c := (lor (land a b) (land c (lor a b))).
+
+Lemma add_bit0 : forall a b, (a+b).[0] = xorb a.[0] b.[0].
+Proof.
+ intros. now rewrite !bit0_odd, odd_add.
+Qed.
+
+Lemma add3_bit0 : forall a b c,
+ (a+b+c).[0] = xor3 a.[0] b.[0] c.[0].
+Proof.
+ intros. now rewrite !add_bit0.
+Qed.
+
+Lemma add3_bits_div2 : forall (a0 b0 c0 : bool),
+ (a0 + b0 + c0)/2 == nextcarry a0 b0 c0.
+Proof.
+ assert (H : 1+1 == 2) by now nzsimpl'.
+ intros [|] [|] [|]; simpl; rewrite ?add_0_l, ?add_0_r, ?H;
+  (apply div_same; order') || (apply div_small; split; order') || idtac.
+ symmetry. apply div_unique with 1. left; split; order'. now nzsimpl'.
+Qed.
+
+Lemma add_carry_div2 : forall a b (c0:bool),
+ (a + b + c0)/2 == a/2 + b/2 + nextcarry a.[0] b.[0] c0.
+Proof.
+ intros.
+ rewrite <- add3_bits_div2.
+ rewrite (add_comm ((a/2)+_)).
+ rewrite <- div_add by order'.
+ f_equiv.
+ rewrite <- !div2_div, mul_comm, mul_add_distr_l.
+ rewrite (div2_odd a), <- bit0_odd at 1.
+ rewrite (div2_odd b), <- bit0_odd at 1.
+ rewrite add_shuffle1.
+ rewrite <-(add_assoc _ _ c0). apply add_comm.
+Qed.
+
+(** The main result concerning addition: we express the bits of the sum
+  in term of bits of [a] and [b] and of some carry stream which is also
+  recursively determined by another equation.
+*)
+
+Lemma add_carry_bits_aux : forall n, 0<=n ->
+ forall a b (c0:bool), -(2^n) <= a < 2^n -> -(2^n) <= b < 2^n ->
+  exists c,
+   a+b+c0 == lxor3 a b c /\ c/2 == lnextcarry a b c /\ c.[0] = c0.
+Proof.
+ intros n Hn. apply le_ind with (4:=Hn).
+ solve_proper.
+ (* base *)
+ intros a b c0. rewrite !pow_0_r, !one_succ, !lt_succ_r, <- !one_succ.
+ intros (Ha1,Ha2) (Hb1,Hb2).
+ le_elim Ha1; rewrite <- ?le_succ_l, ?succ_m1 in Ha1;
+  le_elim Hb1; rewrite <- ?le_succ_l, ?succ_m1 in Hb1.
+ (* base, a = 0, b = 0 *)
+ exists c0.
+ rewrite (le_antisymm _ _ Ha2 Ha1), (le_antisymm _ _ Hb2 Hb1).
+ rewrite !add_0_l, !lxor_0_l, !lor_0_r, !land_0_r, !lor_0_r.
+ rewrite b2z_div2, b2z_bit0; now repeat split.
+ (* base, a = 0, b = -1 *)
+ exists (-c0). rewrite <- Hb1, (le_antisymm _ _ Ha2 Ha1). repeat split.
+ rewrite add_0_l, lxor_0_l, lxor_m1_l.
+ unfold lnot. now rewrite opp_involutive, add_comm, add_opp_r, sub_1_r.
+ rewrite land_0_l, !lor_0_l, land_m1_r.
+ symmetry. apply div_unique with c0. left; destruct c0; simpl; split; order'.
+  now rewrite two_succ, mul_succ_l, mul_1_l, add_opp_r, sub_add.
+ rewrite bit0_odd, odd_opp; destruct c0; simpl; apply odd_1 || apply odd_0.
+ (* base, a = -1, b = 0 *)
+ exists (-c0). rewrite <- Ha1, (le_antisymm _ _ Hb2 Hb1). repeat split.
+ rewrite add_0_r, lxor_0_r, lxor_m1_l.
+ unfold lnot. now rewrite opp_involutive, add_comm, add_opp_r, sub_1_r.
+ rewrite land_0_r, lor_0_r, lor_0_l, land_m1_r.
+ symmetry. apply div_unique with c0. left; destruct c0; simpl; split; order'.
+  now rewrite two_succ, mul_succ_l, mul_1_l, add_opp_r, sub_add.
+ rewrite bit0_odd, odd_opp; destruct c0; simpl; apply odd_1 || apply odd_0.
+ (* base, a = -1, b = -1 *)
+ exists (c0 + 2*(-1)). rewrite <- Ha1, <- Hb1. repeat split.
+ rewrite lxor_m1_l, lnot_m1, lxor_0_l.
+ now rewrite two_succ, mul_succ_l, mul_1_l, add_comm, add_assoc.
+ rewrite land_m1_l, lor_m1_l.
+ apply add_b2z_double_div2.
+ apply add_b2z_double_bit0.
+ (* step *)
+ clear n Hn. intros n Hn IH a b c0 Ha Hb.
+ set (c1:=nextcarry a.[0] b.[0] c0).
+ destruct (IH (a/2) (b/2) c1) as (c & IH1 & IH2 & Hc); clear IH.
+ split.
+ apply div_le_lower_bound. order'. now rewrite mul_opp_r, <- pow_succ_r.
+ apply div_lt_upper_bound. order'. now rewrite <- pow_succ_r.
+ split.
+ apply div_le_lower_bound. order'. now rewrite mul_opp_r, <- pow_succ_r.
+ apply div_lt_upper_bound. order'. now rewrite <- pow_succ_r.
+ exists (c0 + 2*c). repeat split.
+ (* step, add *)
+ bitwise.
+ le_elim Hm.
+ rewrite <- (succ_pred m), lt_succ_r in Hm.
+ rewrite <- (succ_pred m), <- !div2_bits, <- 2 lxor_spec by trivial.
+ f_equiv.
+ rewrite add_b2z_double_div2, <- IH1. apply add_carry_div2.
+ rewrite <- Hm.
+ now rewrite add_b2z_double_bit0, add3_bit0, b2z_bit0.
+ (* step, carry *)
+ rewrite add_b2z_double_div2.
+ bitwise.
+ le_elim Hm.
+ rewrite <- (succ_pred m), lt_succ_r in Hm.
+ rewrite <- (succ_pred m), <- !div2_bits, IH2 by trivial.
+ autorewrite with bitwise. now rewrite add_b2z_double_div2.
+ rewrite <- Hm.
+ now rewrite add_b2z_double_bit0.
+ (* step, carry0 *)
+ apply add_b2z_double_bit0.
+Qed.
+
+Lemma add_carry_bits : forall a b (c0:bool), exists c,
+ a+b+c0 == lxor3 a b c /\ c/2 == lnextcarry a b c /\ c.[0] = c0.
+Proof.
+ intros a b c0.
+ set (n := max (abs a) (abs b)).
+ apply (add_carry_bits_aux n).
+ (* positivity *)
+ unfold n.
+ destruct (le_ge_cases (abs a) (abs b));
+  [rewrite max_r|rewrite max_l]; order_pos'.
+ (* bound for a *)
+ assert (Ha : abs a < 2^n).
+  apply lt_le_trans with (2^(abs a)). apply pow_gt_lin_r; order_pos'.
+  apply pow_le_mono_r. order'. unfold n.
+  destruct (le_ge_cases (abs a) (abs b));
+   [rewrite max_r|rewrite max_l]; try order.
+ apply abs_lt in Ha. destruct Ha; split; order.
+ (* bound for b *)
+ assert (Hb : abs b < 2^n).
+  apply lt_le_trans with (2^(abs b)). apply pow_gt_lin_r; order_pos'.
+  apply pow_le_mono_r. order'. unfold n.
+  destruct (le_ge_cases (abs a) (abs b));
+   [rewrite max_r|rewrite max_l]; try order.
+ apply abs_lt in Hb. destruct Hb; split; order.
+Qed.
+
+(** Particular case : the second bit of an addition *)
+
+Lemma add_bit1 : forall a b,
+ (a+b).[1] = xor3 a.[1] b.[1] (a.[0] && b.[0]).
+Proof.
+ intros a b.
+ destruct (add_carry_bits a b false) as (c & EQ1 & EQ2 & Hc).
+ simpl in EQ1; rewrite add_0_r in EQ1. rewrite EQ1.
+ autorewrite with bitwise. f_equal.
+ rewrite one_succ, <- div2_bits, EQ2 by order.
+ autorewrite with bitwise.
+ rewrite Hc. simpl. apply orb_false_r.
+Qed.
+
+(** In an addition, there will be no carries iff there is
+  no common bits in the numbers to add *)
+
+Lemma nocarry_equiv : forall a b c,
+ c/2 == lnextcarry a b c -> c.[0] = false ->
+ (c == 0 <-> land a b == 0).
+Proof.
+ intros a b c H H'.
+ split. intros EQ; rewrite EQ in *.
+ rewrite div_0_l in H by order'.
+ symmetry in H. now apply lor_eq_0_l in H.
+ intros EQ. rewrite EQ, lor_0_l in H.
+ apply bits_inj'. intros n Hn. rewrite bits_0.
+ apply le_ind with (4:=Hn).
+ solve_proper.
+ trivial.
+ clear n Hn. intros n Hn IH.
+ rewrite <- div2_bits, H; trivial.
+ autorewrite with bitwise.
+ now rewrite IH.
+Qed.
+
+(** When there is no common bits, the addition is just a xor *)
+
+Lemma add_nocarry_lxor : forall a b, land a b == 0 ->
+ a+b == lxor a b.
+Proof.
+ intros a b H.
+ destruct (add_carry_bits a b false) as (c & EQ1 & EQ2 & Hc).
+ simpl in EQ1; rewrite add_0_r in EQ1. rewrite EQ1.
+ apply (nocarry_equiv a b c) in H; trivial.
+ rewrite H. now rewrite lxor_0_r.
+Qed.
+
+(** A null [ldiff] implies being smaller *)
+
+Lemma ldiff_le : forall a b, 0<=b -> ldiff a b == 0 -> 0 <= a <= b.
+Proof.
+ assert (AUX : forall n, 0<=n ->
+          forall a b, 0 <= a < 2^n -> 0<=b -> ldiff a b == 0 -> a <= b).
+ intros n Hn. apply le_ind with (4:=Hn); clear n Hn.
+ solve_proper.
+ intros a b Ha Hb _. rewrite pow_0_r, one_succ, lt_succ_r in Ha.
+ setoid_replace a with 0 by (destruct Ha; order'); trivial.
+ intros n Hn IH a b (Ha,Ha') Hb H.
+ assert (NEQ : 2 ~= 0) by order'.
+ rewrite (div_mod a 2 NEQ), (div_mod b 2 NEQ).
+ apply add_le_mono.
+ apply mul_le_mono_pos_l; try order'.
+ apply IH.
+ split. apply div_pos; order'.
+ apply div_lt_upper_bound; try order'. now rewrite <- pow_succ_r.
+ apply div_pos; order'.
+ rewrite <- (pow_1_r 2), <- 2 shiftr_div_pow2 by order'.
+ rewrite <- shiftr_ldiff, H, shiftr_div_pow2, pow_1_r, div_0_l; order'.
+ rewrite <- 2 bit0_mod.
+ apply bits_inj_iff in H. specialize (H 0).
+ rewrite ldiff_spec, bits_0 in H.
+ destruct a.[0], b.[0]; try discriminate; simpl; order'.
+ (* main *)
+ intros a b Hb Hd.
+ assert (Ha : 0<=a).
+  apply le_ngt; intros Ha'. apply (lt_irrefl 0). rewrite <- Hd at 1.
+  apply ldiff_neg. now split.
+ split; trivial. apply (AUX a); try split; trivial. apply pow_gt_lin_r; order'.
+Qed.
+
+(** Subtraction can be a ldiff when the opposite ldiff is null. *)
+
+Lemma sub_nocarry_ldiff : forall a b, ldiff b a == 0 ->
+ a-b == ldiff a b.
+Proof.
+ intros a b H.
+ apply add_cancel_r with b.
+ rewrite sub_add.
+ symmetry.
+ rewrite add_nocarry_lxor; trivial.
+ bitwise.
+ apply bits_inj_iff in H. specialize (H m).
+ rewrite ldiff_spec, bits_0 in H.
+ now destruct a.[m], b.[m].
+ apply land_ldiff.
+Qed.
+
+(** Adding numbers with no common bits cannot lead to a much bigger number *)
+
+Lemma add_nocarry_lt_pow2 : forall a b n, land a b == 0 ->
+ a < 2^n -> b < 2^n -> a+b < 2^n.
+Proof.
+ intros a b n H Ha Hb.
+ destruct (le_gt_cases a 0) as [Ha'|Ha'].
+ apply le_lt_trans with (0+b). now apply add_le_mono_r. now nzsimpl.
+ destruct (le_gt_cases b 0) as [Hb'|Hb'].
+ apply le_lt_trans with (a+0). now apply add_le_mono_l. now nzsimpl.
+ rewrite add_nocarry_lxor by order.
+ destruct (lt_ge_cases 0 (lxor a b)); [|apply le_lt_trans with 0; order_pos].
+ apply log2_lt_pow2; trivial.
+ apply log2_lt_pow2 in Ha; trivial.
+ apply log2_lt_pow2 in Hb; trivial.
+ apply le_lt_trans with (max (log2 a) (log2 b)).
+ apply log2_lxor; order.
+ destruct (le_ge_cases (log2 a) (log2 b));
+  [rewrite max_r|rewrite max_l]; order.
+Qed.
+
+Lemma add_nocarry_mod_lt_pow2 : forall a b n, 0<=n -> land a b == 0 ->
+ a mod 2^n + b mod 2^n < 2^n.
+Proof.
+ intros a b n Hn H.
+ apply add_nocarry_lt_pow2.
+ bitwise.
+ destruct (le_gt_cases n m).
+ rewrite mod_pow2_bits_high; now split.
+ now rewrite !mod_pow2_bits_low, <- land_spec, H, bits_0.
+ apply mod_pos_bound; order_pos.
+ apply mod_pos_bound; order_pos.
+Qed.
+
+End ZBitsProp.
diff --git a/theories/Numbers/Integer/Abstract/ZDivEucl.v b/theories/Numbers/Integer/Abstract/ZDivEucl.v
index 4555e733..dd8aa100 100644
--- a/theories/Numbers/Integer/Abstract/ZDivEucl.v
+++ b/theories/Numbers/Integer/Abstract/ZDivEucl.v
@@ -1,11 +1,13 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+Require Import ZAxioms ZMulOrder ZSgnAbs NZDiv.
+
 (** * Euclidean Division for integers, Euclid convention
 
     We use here the "usual" formulation of the Euclid Theorem
@@ -19,37 +21,29 @@
     Vol. 14, No.2, pp. 127-144, April 1992.
 
     See files [ZDivTrunc] and [ZDivFloor] for others conventions.
-*)
-
-Require Import ZAxioms ZProperties NZDiv.
 
-Module Type ZDivSpecific (Import Z : ZAxiomsExtSig')(Import DM : DivMod' Z).
- Axiom mod_always_pos : forall a b, 0 <= a mod b < abs b.
-End ZDivSpecific.
-
-Module Type ZDiv (Z:ZAxiomsExtSig)
- := DivMod Z <+ NZDivCommon Z <+ ZDivSpecific Z.
+    We simply extend NZDiv with a bound for modulo that holds
+    regardless of the sign of a and b. This new specification
+    subsume mod_bound_pos, which nonetheless stays there for
+    subtyping. Note also that ZAxiomSig now already contain
+    a div and a modulo (that follow the Floor convention).
+    We just ignore them here.
+*)
 
-Module Type ZDivSig := ZAxiomsExtSig <+ ZDiv.
-Module Type ZDivSig' := ZAxiomsExtSig' <+ ZDiv <+ DivModNotation.
+Module Type EuclidSpec (Import A : ZAxiomsSig')(Import B : DivMod' A).
+ Axiom mod_always_pos : forall a b, b ~= 0 -> 0 <= a mod b < abs b.
+End EuclidSpec.
 
-Module ZDivPropFunct (Import Z : ZDivSig')(Import ZP : ZPropSig Z).
+Module Type ZEuclid (Z:ZAxiomsSig) := NZDiv.NZDiv Z <+ EuclidSpec Z.
+Module Type ZEuclid' (Z:ZAxiomsSig) := NZDiv.NZDiv' Z <+ EuclidSpec Z.
 
-(** We benefit from what already exists for NZ *)
+Module ZEuclidProp
+ (Import A : ZAxiomsSig')
+ (Import B : ZMulOrderProp A)
+ (Import C : ZSgnAbsProp A B)
+ (Import D : ZEuclid' A).
 
- Module ZD <: NZDiv Z.
-  Definition div := div.
-  Definition modulo := modulo.
-  Definition div_wd := div_wd.
-  Definition mod_wd := mod_wd.
-  Definition div_mod := div_mod.
-  Lemma mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b.
-  Proof.
-  intros. rewrite <- (abs_eq b) at 3 by now apply lt_le_incl.
-  apply mod_always_pos.
-  Qed.
- End ZD.
- Module Import NZDivP := NZDivPropFunct Z ZP ZD.
+ Module Import Private_NZDiv := Nop <+ NZDivProp A D B.
 
 (** Another formulation of the main equation *)
 
@@ -117,7 +111,7 @@ Lemma div_opp_r : forall a b, b~=0 -> a/(-b) == -(a/b).
 Proof.
 intros. symmetry.
 apply div_unique with (a mod b).
-rewrite abs_opp; apply mod_always_pos.
+rewrite abs_opp; now apply mod_always_pos.
 rewrite mul_opp_opp; now apply div_mod.
 Qed.
 
@@ -125,7 +119,7 @@ Lemma mod_opp_r : forall a b, b~=0 -> a mod (-b) == a mod b.
 Proof.
 intros. symmetry.
 apply mod_unique with (-(a/b)).
-rewrite abs_opp; apply mod_always_pos.
+rewrite abs_opp; now apply mod_always_pos.
 rewrite mul_opp_opp; now apply div_mod.
 Qed.
 
@@ -274,6 +268,11 @@ Proof.
 intros. rewrite mod_eq, div_mul by trivial. rewrite mul_comm; apply sub_diag.
 Qed.
 
+Theorem div_unique_exact a b q: b~=0 -> a == b*q -> q == a/b.
+Proof.
+ intros Hb H. rewrite H, mul_comm. symmetry. now apply div_mul.
+Qed.
+
 (** * Order results about mod and div *)
 
 (** A modulo cannot grow beyond its starting point. *)
@@ -296,7 +295,7 @@ intros a b Hb.
 split.
 intros EQ.
 rewrite (div_mod a b Hb), EQ; nzsimpl.
-apply mod_always_pos.
+now apply mod_always_pos.
 intros. pos_or_neg b.
 apply div_small.
 now rewrite <- (abs_eq b).
@@ -365,7 +364,7 @@ intros.
 nzsimpl.
 rewrite (div_mod a b) at 1; try order.
 rewrite <- add_lt_mono_l.
-destruct (mod_always_pos a b).
+destruct (mod_always_pos a b). order.
 rewrite abs_eq in *; order.
 Qed.
 
@@ -375,7 +374,7 @@ intros a b Hb.
 rewrite mul_pred_r, <- add_opp_r.
 rewrite (div_mod a b) at 1; try order.
 rewrite <- add_lt_mono_l.
-destruct (mod_always_pos a b).
+destruct (mod_always_pos a b). order.
 rewrite <- opp_pos_neg in Hb. rewrite abs_neq' in *; order.
 Qed.
 
@@ -469,7 +468,7 @@ apply div_unique with ((a mod b)*c).
 (* ineqs *)
 rewrite abs_mul, (abs_eq c) by order.
 rewrite <-(mul_0_l c), <-mul_lt_mono_pos_r, <-mul_le_mono_pos_r by trivial.
-apply mod_always_pos.
+now apply mod_always_pos.
 (* equation *)
 rewrite (div_mod a b) at 1 by order.
 rewrite mul_add_distr_r.
@@ -556,17 +555,18 @@ Proof.
 Qed.
 
 (** With the current convention, the following result isn't always
-    true for negative divisors. For instance
-    [ 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) ]. *)
+    true with a negative intermediate divisor. For instance
+    [ 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) ] and
+    [ 3/(-2)/2 = -1 <> 0 = 3 / (-2*2) ]. *)
 
-Lemma div_div : forall a b c, 0<b -> 0<c ->
+Lemma div_div : forall a b c, 0<b -> c~=0 ->
  (a/b)/c == a/(b*c).
 Proof.
  intros a b c Hb Hc.
  apply div_unique with (b*((a/b) mod c) + a mod b).
  (* begin 0<= ... <abs(b*c) *)
  rewrite abs_mul.
- destruct (mod_always_pos (a/b) c), (mod_always_pos a b).
+ destruct (mod_always_pos (a/b) c), (mod_always_pos a b); try order.
  split.
  apply add_nonneg_nonneg; trivial.
  apply mul_nonneg_nonneg; order.
@@ -581,6 +581,22 @@ Proof.
  apply div_mod; order.
 Qed.
 
+(** Similarly, the following result doesn't always hold when [b<0].
+    For instance [3 mod (-2*-2)) = 3] while
+    [3 mod (-2) + (-2)*((3/-2) mod -2) = -1]. *)
+
+Lemma mod_mul_r : forall a b c, 0<b -> c~=0 ->
+ a mod (b*c) == a mod b + b*((a/b) mod c).
+Proof.
+ intros a b c Hb Hc.
+ apply add_cancel_l with (b*c*(a/(b*c))).
+ rewrite <- div_mod by (apply neq_mul_0; split; order).
+ rewrite <- div_div by trivial.
+ rewrite add_assoc, add_shuffle0, <- mul_assoc, <- mul_add_distr_l.
+ rewrite <- div_mod by order.
+ apply div_mod; order.
+Qed.
+
 (** A last inequality: *)
 
 Theorem div_mul_le:
@@ -590,16 +606,13 @@ Proof. exact div_mul_le. Qed.
 (** mod is related to divisibility *)
 
 Lemma mod_divides : forall a b, b~=0 ->
- (a mod b == 0 <-> exists c, a == b*c).
+ (a mod b == 0 <-> (b|a)).
 Proof.
 intros a b Hb. split.
-intros Hab. exists (a/b). rewrite (div_mod a b Hb) at 1.
- rewrite Hab; now nzsimpl.
-intros (c,Hc).
-rewrite Hc, mul_comm.
-now apply mod_mul.
+intros Hab. exists (a/b). rewrite mul_comm.
+ rewrite (div_mod a b Hb) at 1. rewrite Hab; now nzsimpl.
+intros (c,Hc). rewrite Hc. now apply mod_mul.
 Qed.
 
-
-End ZDivPropFunct.
+End ZEuclidProp.
 
diff --git a/theories/Numbers/Integer/Abstract/ZDivFloor.v b/theories/Numbers/Integer/Abstract/ZDivFloor.v
index efefab81..2ccc79e9 100644
--- a/theories/Numbers/Integer/Abstract/ZDivFloor.v
+++ b/theories/Numbers/Integer/Abstract/ZDivFloor.v
@@ -1,11 +1,13 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+Require Import ZAxioms ZMulOrder ZSgnAbs NZDiv.
+
 (** * Euclidean Division for integers (Floor convention)
 
     We use here the convention known as Floor, or Round-Toward-Bottom,
@@ -14,7 +16,7 @@
 
     [a = bq+r /\ 0 <= |r| < |b| /\ Sign(r) = Sign(b)]
 
-    This is the convention followed historically by [Zdiv] in Coq, and
+    This is the convention followed historically by [Z.div] in Coq, and
     corresponds to convention "F" in the following paper:
 
     R. Boute, "The Euclidean definition of the functions div and mod",
@@ -24,33 +26,13 @@
     See files [ZDivTrunc] and [ZDivEucl] for others conventions.
 *)
 
-Require Import ZAxioms ZProperties NZDiv.
-
-Module Type ZDivSpecific (Import Z:ZAxiomsSig')(Import DM : DivMod' Z).
- Axiom mod_pos_bound : forall a b, 0 < b -> 0 <= a mod b < b.
- Axiom mod_neg_bound : forall a b, b < 0 -> b < a mod b <= 0.
-End ZDivSpecific.
-
-Module Type ZDiv (Z:ZAxiomsSig)
- := DivMod Z <+ NZDivCommon Z <+ ZDivSpecific Z.
-
-Module Type ZDivSig := ZAxiomsExtSig <+ ZDiv.
-Module Type ZDivSig' := ZAxiomsExtSig' <+ ZDiv <+ DivModNotation.
-
-Module ZDivPropFunct (Import Z : ZDivSig')(Import ZP : ZPropSig Z).
+Module Type ZDivProp
+ (Import A : ZAxiomsSig')
+ (Import B : ZMulOrderProp A)
+ (Import C : ZSgnAbsProp A B).
 
 (** We benefit from what already exists for NZ *)
-
- Module ZD <: NZDiv Z.
-  Definition div := div.
-  Definition modulo := modulo.
-  Definition div_wd := div_wd.
-  Definition mod_wd := mod_wd.
-  Definition div_mod := div_mod.
-  Lemma mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b.
-  Proof. intros. now apply mod_pos_bound. Qed.
- End ZD.
- Module Import NZDivP := NZDivPropFunct Z ZP ZD.
+Module Import Private_NZDiv := Nop <+ NZDivProp A A B.
 
 (** Another formulation of the main equation *)
 
@@ -62,6 +44,18 @@ rewrite <- add_move_l.
 symmetry. now apply div_mod.
 Qed.
 
+(** We have a general bound for absolute values *)
+
+Lemma mod_bound_abs :
+ forall a b, b~=0 -> abs (a mod b) < abs b.
+Proof.
+intros.
+destruct (abs_spec b) as [(LE,EQ)|(LE,EQ)]; rewrite EQ.
+destruct (mod_pos_bound a b). order. now rewrite abs_eq.
+destruct (mod_neg_bound a b). order. rewrite abs_neq; trivial.
+now rewrite <- opp_lt_mono.
+Qed.
+
 (** Uniqueness theorems *)
 
 Theorem div_mod_unique : forall b q1 q2 r1 r2 : t,
@@ -94,7 +88,7 @@ Theorem div_unique_pos:
 Proof. intros; apply div_unique with r; auto. Qed.
 
 Theorem div_unique_neg:
- forall a b q r, 0<=r<b -> a == b*q + r -> q == a/b.
+ forall a b q r, b<r<=0 -> a == b*q + r -> q == a/b.
 Proof. intros; apply div_unique with r; auto. Qed.
 
 Theorem mod_unique:
@@ -230,11 +224,26 @@ rewrite mod_opp_opp, mod_opp_l_nz by trivial.
 now rewrite opp_sub_distr, add_comm, add_opp_r.
 Qed.
 
-(** The sign of [a mod b] is the one of [b] *)
+(** The sign of [a mod b] is the one of [b] (when it isn't null) *)
+
+Lemma mod_sign_nz : forall a b, b~=0 -> a mod b ~= 0 ->
+ sgn (a mod b) == sgn b.
+Proof.
+intros a b Hb H. destruct (lt_ge_cases 0 b) as [Hb'|Hb'].
+destruct (mod_pos_bound a b Hb'). rewrite 2 sgn_pos; order.
+destruct (mod_neg_bound a b). order. rewrite 2 sgn_neg; order.
+Qed.
 
-(* TODO: a proper sgn function and theory *)
+Lemma mod_sign : forall a b, b~=0 -> sgn (a mod b) ~= -sgn b.
+Proof.
+intros a b Hb H.
+destruct (eq_decidable (a mod b) 0) as [EQ|NEQ].
+apply Hb, sgn_null_iff, opp_inj. now rewrite <- H, opp_0, EQ, sgn_0.
+apply Hb, sgn_null_iff. apply eq_mul_0_l with 2; try order'. nzsimpl'.
+apply add_move_0_l. rewrite <- H. symmetry. now apply mod_sign_nz.
+Qed.
 
-Lemma mod_sign : forall a b, b~=0 -> (0 <= (a mod b) * b).
+Lemma mod_sign_mul : forall a b, b~=0 -> 0 <= (a mod b) * b.
 Proof.
 intros. destruct (lt_ge_cases 0 b).
 apply mul_nonneg_nonneg; destruct (mod_pos_bound a b); order.
@@ -307,6 +316,11 @@ Proof.
 intros. rewrite mod_eq, div_mul by trivial. rewrite mul_comm; apply sub_diag.
 Qed.
 
+Theorem div_unique_exact a b q: b~=0 -> a == b*q -> q == a/b.
+Proof.
+ intros Hb H. rewrite H, mul_comm. symmetry. now apply div_mul.
+Qed.
+
 (** * Order results about mod and div *)
 
 (** A modulo cannot grow beyond its starting point. *)
@@ -585,15 +599,25 @@ Proof.
 Qed.
 
 (** With the current convention, the following result isn't always
-    true for negative divisors. For instance
-    [ 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) ]. *)
+    true with a negative last divisor. For instance
+    [ 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) ], or
+    [ 5/2/(-2) = -1 <> -2 = 5 / (2*-2) ]. *)
 
-Lemma div_div : forall a b c, 0<b -> 0<c ->
+Lemma div_div : forall a b c, b~=0 -> 0<c ->
  (a/b)/c == a/(b*c).
 Proof.
  intros a b c Hb Hc.
  apply div_unique with (b*((a/b) mod c) + a mod b).
  (* begin 0<= ... <b*c \/ ... *)
+ apply neg_pos_cases in Hb. destruct Hb as [Hb|Hb].
+ right.
+ destruct (mod_pos_bound (a/b) c), (mod_neg_bound a b); trivial.
+ split.
+ apply le_lt_trans with (b*((a/b) mod c) + b).
+ now rewrite <- mul_succ_r, <- mul_le_mono_neg_l, le_succ_l.
+ now rewrite <- add_lt_mono_l.
+ apply add_nonpos_nonpos; trivial.
+ apply mul_nonpos_nonneg; order.
  left.
  destruct (mod_pos_bound (a/b) c), (mod_pos_bound a b); trivial.
  split.
@@ -609,24 +633,27 @@ Proof.
  apply div_mod; order.
 Qed.
 
+(** Similarly, the following result doesn't always hold when [c<0].
+    For instance [3 mod (-2*-2)) = 3] while
+    [3 mod (-2) + (-2)*((3/-2) mod -2) = -1].
+*)
+
+Lemma rem_mul_r : forall a b c, b~=0 -> 0<c ->
+ a mod (b*c) == a mod b + b*((a/b) mod c).
+Proof.
+ intros a b c Hb Hc.
+ apply add_cancel_l with (b*c*(a/(b*c))).
+ rewrite <- div_mod by (apply neq_mul_0; split; order).
+ rewrite <- div_div by trivial.
+ rewrite add_assoc, add_shuffle0, <- mul_assoc, <- mul_add_distr_l.
+ rewrite <- div_mod by order.
+ apply div_mod; order.
+Qed.
+
 (** A last inequality: *)
 
 Theorem div_mul_le:
  forall a b c, 0<=a -> 0<b -> 0<=c -> c*(a/b) <= (c*a)/b.
 Proof. exact div_mul_le. Qed.
 
-(** mod is related to divisibility *)
-
-Lemma mod_divides : forall a b, b~=0 ->
- (a mod b == 0 <-> exists c, a == b*c).
-Proof.
-intros a b Hb. split.
-intros Hab. exists (a/b). rewrite (div_mod a b Hb) at 1.
- rewrite Hab. now nzsimpl.
-intros (c,Hc).
-rewrite Hc, mul_comm.
-now apply mod_mul.
-Qed.
-
-End ZDivPropFunct.
-
+End ZDivProp.
diff --git a/theories/Numbers/Integer/Abstract/ZDivTrunc.v b/theories/Numbers/Integer/Abstract/ZDivTrunc.v
index 069d8a8d..d69d0e10 100644
--- a/theories/Numbers/Integer/Abstract/ZDivTrunc.v
+++ b/theories/Numbers/Integer/Abstract/ZDivTrunc.v
@@ -1,11 +1,13 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+Require Import ZAxioms ZMulOrder ZSgnAbs NZDiv.
+
 (** * Euclidean Division for integers (Trunc convention)
 
     We use here the convention known as Trunc, or Round-Toward-Zero,
@@ -24,25 +26,24 @@
     See files [ZDivFloor] and [ZDivEucl] for others conventions.
 *)
 
-Require Import ZAxioms ZProperties NZDiv.
-
-Module Type ZDivSpecific (Import Z:ZAxiomsSig')(Import DM : DivMod' Z).
- Axiom mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b.
- Axiom mod_opp_l : forall a b, b ~= 0 -> (-a) mod b == - (a mod b).
- Axiom mod_opp_r : forall a b, b ~= 0 -> a mod (-b) == a mod b.
-End ZDivSpecific.
-
-Module Type ZDiv (Z:ZAxiomsSig)
- := DivMod Z <+ NZDivCommon Z <+ ZDivSpecific Z.
-
-Module Type ZDivSig := ZAxiomsExtSig <+ ZDiv.
-Module Type ZDivSig' := ZAxiomsExtSig' <+ ZDiv <+ DivModNotation.
-
-Module ZDivPropFunct (Import Z : ZDivSig')(Import ZP : ZPropSig Z).
+Module Type ZQuotProp
+ (Import A : ZAxiomsSig')
+ (Import B : ZMulOrderProp A)
+ (Import C : ZSgnAbsProp A B).
 
 (** We benefit from what already exists for NZ *)
 
- Module Import NZDivP := NZDivPropFunct Z ZP Z.
+ Module Import Private_Div.
+ Module Quot2Div <: NZDiv A.
+  Definition div := quot.
+  Definition modulo := A.rem.
+  Definition div_wd := quot_wd.
+  Definition mod_wd := rem_wd.
+  Definition div_mod := quot_rem.
+  Definition mod_bound_pos := rem_bound_pos.
+ End Quot2Div.
+ Module NZQuot := Nop <+ NZDivProp A Quot2Div B.
+ End Private_Div.
 
 Ltac pos_or_neg a :=
  let LT := fresh "LT" in
@@ -51,175 +52,274 @@ Ltac pos_or_neg a :=
 
 (** Another formulation of the main equation *)
 
-Lemma mod_eq :
- forall a b, b~=0 -> a mod b == a - b*(a/b).
+Lemma rem_eq :
+ forall a b, b~=0 -> a rem b == a - b*(a÷b).
 Proof.
 intros.
 rewrite <- add_move_l.
-symmetry. now apply div_mod.
+symmetry. now apply quot_rem.
 Qed.
 
 (** A few sign rules (simple ones) *)
 
-Lemma mod_opp_opp : forall a b, b ~= 0 -> (-a) mod (-b) == - (a mod b).
-Proof. intros. now rewrite mod_opp_r, mod_opp_l. Qed.
+Lemma rem_opp_opp : forall a b, b ~= 0 -> (-a) rem (-b) == - (a rem b).
+Proof. intros. now rewrite rem_opp_r, rem_opp_l. Qed.
 
-Lemma div_opp_l : forall a b, b ~= 0 -> (-a)/b == -(a/b).
+Lemma quot_opp_l : forall a b, b ~= 0 -> (-a)÷b == -(a÷b).
 Proof.
 intros.
 rewrite <- (mul_cancel_l _ _ b) by trivial.
-rewrite <- (add_cancel_r _ _ ((-a) mod b)).
-now rewrite <- div_mod, mod_opp_l, mul_opp_r, <- opp_add_distr, <- div_mod.
+rewrite <- (add_cancel_r _ _ ((-a) rem b)).
+now rewrite <- quot_rem, rem_opp_l, mul_opp_r, <- opp_add_distr, <- quot_rem.
 Qed.
 
-Lemma div_opp_r : forall a b, b ~= 0 -> a/(-b) == -(a/b).
+Lemma quot_opp_r : forall a b, b ~= 0 -> a÷(-b) == -(a÷b).
 Proof.
 intros.
 assert (-b ~= 0) by (now rewrite eq_opp_l, opp_0).
 rewrite <- (mul_cancel_l _ _ (-b)) by trivial.
-rewrite <- (add_cancel_r _ _ (a mod (-b))).
-now rewrite <- div_mod, mod_opp_r, mul_opp_opp, <- div_mod.
-Qed.
-
-Lemma div_opp_opp : forall a b, b ~= 0 -> (-a)/(-b) == a/b.
-Proof. intros. now rewrite div_opp_r, div_opp_l, opp_involutive. Qed.
-
-(** The sign of [a mod b] is the one of [a] *)
-
-(* TODO: a proper sgn function and theory *)
-
-Lemma mod_sign : forall a b, b~=0 -> 0 <= (a mod b) * a.
-Proof.
-assert (Aux : forall a b, 0<b -> 0 <= (a mod b) * a).
- intros. pos_or_neg a.
- apply mul_nonneg_nonneg; trivial. now destruct (mod_bound a b).
- rewrite <- mul_opp_opp, <- mod_opp_l by order.
- apply mul_nonneg_nonneg; try order. destruct (mod_bound (-a) b); order.
-intros. pos_or_neg b. apply Aux; order.
-rewrite <- mod_opp_r by order. apply Aux; order.
+rewrite <- (add_cancel_r _ _ (a rem (-b))).
+now rewrite <- quot_rem, rem_opp_r, mul_opp_opp, <- quot_rem.
 Qed.
 
+Lemma quot_opp_opp : forall a b, b ~= 0 -> (-a)÷(-b) == a÷b.
+Proof. intros. now rewrite quot_opp_r, quot_opp_l, opp_involutive. Qed.
 
 (** Uniqueness theorems *)
 
-Theorem div_mod_unique : forall b q1 q2 r1 r2 : t,
+Theorem quot_rem_unique : forall b q1 q2 r1 r2 : t,
   (0<=r1<b \/ b<r1<=0) -> (0<=r2<b \/ b<r2<=0) ->
   b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2.
 Proof.
 intros b q1 q2 r1 r2 Hr1 Hr2 EQ.
 destruct Hr1; destruct Hr2; try (intuition; order).
-apply div_mod_unique with b; trivial.
+apply NZQuot.div_mod_unique with b; trivial.
 rewrite <- (opp_inj_wd r1 r2).
-apply div_mod_unique with (-b); trivial.
+apply NZQuot.div_mod_unique with (-b); trivial.
 rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto.
 rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto.
 now rewrite 2 mul_opp_l, <- 2 opp_add_distr, opp_inj_wd.
 Qed.
 
-Theorem div_unique:
- forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> q == a/b.
-Proof. intros; now apply div_unique with r. Qed.
+Theorem quot_unique:
+ forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> q == a÷b.
+Proof. intros; now apply NZQuot.div_unique with r. Qed.
 
-Theorem mod_unique:
- forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> r == a mod b.
-Proof. intros; now apply mod_unique with q. Qed.
+Theorem rem_unique:
+ forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> r == a rem b.
+Proof. intros; now apply NZQuot.mod_unique with q. Qed.
 
 (** A division by itself returns 1 *)
 
-Lemma div_same : forall a, a~=0 -> a/a == 1.
+Lemma quot_same : forall a, a~=0 -> a÷a == 1.
 Proof.
-intros. pos_or_neg a. apply div_same; order.
-rewrite <- div_opp_opp by trivial. now apply div_same.
+intros. pos_or_neg a. apply NZQuot.div_same; order.
+rewrite <- quot_opp_opp by trivial. now apply NZQuot.div_same.
 Qed.
 
-Lemma mod_same : forall a, a~=0 -> a mod a == 0.
+Lemma rem_same : forall a, a~=0 -> a rem a == 0.
 Proof.
-intros. rewrite mod_eq, div_same by trivial. nzsimpl. apply sub_diag.
+intros. rewrite rem_eq, quot_same by trivial. nzsimpl. apply sub_diag.
 Qed.
 
 (** A division of a small number by a bigger one yields zero. *)
 
-Theorem div_small: forall a b, 0<=a<b -> a/b == 0.
-Proof. exact div_small. Qed.
+Theorem quot_small: forall a b, 0<=a<b -> a÷b == 0.
+Proof. exact NZQuot.div_small. Qed.
 
-(** Same situation, in term of modulo: *)
+(** Same situation, in term of remulo: *)
 
-Theorem mod_small: forall a b, 0<=a<b -> a mod b == a.
-Proof. exact mod_small. Qed.
+Theorem rem_small: forall a b, 0<=a<b -> a rem b == a.
+Proof. exact NZQuot.mod_small. Qed.
 
 (** * Basic values of divisions and modulo. *)
 
-Lemma div_0_l: forall a, a~=0 -> 0/a == 0.
+Lemma quot_0_l: forall a, a~=0 -> 0÷a == 0.
 Proof.
-intros. pos_or_neg a. apply div_0_l; order.
-rewrite <- div_opp_opp, opp_0 by trivial. now apply div_0_l.
+intros. pos_or_neg a. apply NZQuot.div_0_l; order.
+rewrite <- quot_opp_opp, opp_0 by trivial. now apply NZQuot.div_0_l.
 Qed.
 
-Lemma mod_0_l: forall a, a~=0 -> 0 mod a == 0.
+Lemma rem_0_l: forall a, a~=0 -> 0 rem a == 0.
 Proof.
-intros; rewrite mod_eq, div_0_l; now nzsimpl.
+intros; rewrite rem_eq, quot_0_l; now nzsimpl.
 Qed.
 
-Lemma div_1_r: forall a, a/1 == a.
+Lemma quot_1_r: forall a, a÷1 == a.
 Proof.
-intros. pos_or_neg a. now apply div_1_r.
-apply opp_inj. rewrite <- div_opp_l. apply div_1_r; order.
+intros. pos_or_neg a. now apply NZQuot.div_1_r.
+apply opp_inj. rewrite <- quot_opp_l. apply NZQuot.div_1_r; order.
 intro EQ; symmetry in EQ; revert EQ; apply lt_neq, lt_0_1.
 Qed.
 
-Lemma mod_1_r: forall a, a mod 1 == 0.
+Lemma rem_1_r: forall a, a rem 1 == 0.
 Proof.
-intros. rewrite mod_eq, div_1_r; nzsimpl; auto using sub_diag.
+intros. rewrite rem_eq, quot_1_r; nzsimpl; auto using sub_diag.
 intro EQ; symmetry in EQ; revert EQ; apply lt_neq; apply lt_0_1.
 Qed.
 
-Lemma div_1_l: forall a, 1<a -> 1/a == 0.
-Proof. exact div_1_l. Qed.
+Lemma quot_1_l: forall a, 1<a -> 1÷a == 0.
+Proof. exact NZQuot.div_1_l. Qed.
+
+Lemma rem_1_l: forall a, 1<a -> 1 rem a == 1.
+Proof. exact NZQuot.mod_1_l. Qed.
 
-Lemma mod_1_l: forall a, 1<a -> 1 mod a == 1.
-Proof. exact mod_1_l. Qed.
+Lemma quot_mul : forall a b, b~=0 -> (a*b)÷b == a.
+Proof.
+intros. pos_or_neg a; pos_or_neg b. apply NZQuot.div_mul; order.
+rewrite <- quot_opp_opp, <- mul_opp_r by order. apply NZQuot.div_mul; order.
+rewrite <- opp_inj_wd, <- quot_opp_l, <- mul_opp_l by order.
+apply NZQuot.div_mul; order.
+rewrite <- opp_inj_wd, <- quot_opp_r, <- mul_opp_opp by order.
+apply NZQuot.div_mul; order.
+Qed.
 
-Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a.
+Lemma rem_mul : forall a b, b~=0 -> (a*b) rem b == 0.
 Proof.
-intros. pos_or_neg a; pos_or_neg b. apply div_mul; order.
-rewrite <- div_opp_opp, <- mul_opp_r by order. apply div_mul; order.
-rewrite <- opp_inj_wd, <- div_opp_l, <- mul_opp_l by order. apply div_mul; order.
-rewrite <- opp_inj_wd, <- div_opp_r, <- mul_opp_opp by order. apply div_mul; order.
+intros. rewrite rem_eq, quot_mul by trivial. rewrite mul_comm; apply sub_diag.
 Qed.
 
-Lemma mod_mul : forall a b, b~=0 -> (a*b) mod b == 0.
+Theorem quot_unique_exact a b q: b~=0 -> a == b*q -> q == a÷b.
 Proof.
-intros. rewrite mod_eq, div_mul by trivial. rewrite mul_comm; apply sub_diag.
+ intros Hb H. rewrite H, mul_comm. symmetry. now apply quot_mul.
 Qed.
 
-(** * Order results about mod and div *)
+(** The sign of [a rem b] is the one of [a] (when it's not null) *)
+
+Lemma rem_nonneg : forall a b, b~=0 -> 0 <= a -> 0 <= a rem b.
+Proof.
+ intros. pos_or_neg b. destruct (rem_bound_pos a b); order.
+ rewrite <- rem_opp_r; trivial.
+ destruct (rem_bound_pos a (-b)); trivial.
+Qed.
+
+Lemma rem_nonpos : forall a b, b~=0 -> a <= 0 -> a rem b <= 0.
+Proof.
+ intros a b Hb Ha.
+ apply opp_nonneg_nonpos. apply opp_nonneg_nonpos in Ha.
+ rewrite <- rem_opp_l by trivial. now apply rem_nonneg.
+Qed.
+
+Lemma rem_sign_mul : forall a b, b~=0 -> 0 <= (a rem b) * a.
+Proof.
+intros a b Hb. destruct (le_ge_cases 0 a).
+ apply mul_nonneg_nonneg; trivial. now apply rem_nonneg.
+ apply mul_nonpos_nonpos; trivial. now apply rem_nonpos.
+Qed.
+
+Lemma rem_sign_nz : forall a b, b~=0 -> a rem b ~= 0 ->
+ sgn (a rem b) == sgn a.
+Proof.
+intros a b Hb H. destruct (lt_trichotomy 0 a) as [LT|[EQ|LT]].
+rewrite 2 sgn_pos; try easy.
+ generalize (rem_nonneg a b Hb (lt_le_incl _ _ LT)). order.
+now rewrite <- EQ, rem_0_l, sgn_0.
+rewrite 2 sgn_neg; try easy.
+ generalize (rem_nonpos a b Hb (lt_le_incl _ _ LT)). order.
+Qed.
+
+Lemma rem_sign : forall a b, a~=0 -> b~=0 -> sgn (a rem b) ~= -sgn a.
+Proof.
+intros a b Ha Hb H.
+destruct (eq_decidable (a rem b) 0) as [EQ|NEQ].
+apply Ha, sgn_null_iff, opp_inj. now rewrite <- H, opp_0, EQ, sgn_0.
+apply Ha, sgn_null_iff. apply eq_mul_0_l with 2; try order'. nzsimpl'.
+apply add_move_0_l. rewrite <- H. symmetry. now apply rem_sign_nz.
+Qed.
+
+(** Operations and absolute value *)
+
+Lemma rem_abs_l : forall a b, b ~= 0 -> (abs a) rem b == abs (a rem b).
+Proof.
+intros a b Hb. destruct (le_ge_cases 0 a) as [LE|LE].
+rewrite 2 abs_eq; try easy. now apply rem_nonneg.
+rewrite 2 abs_neq, rem_opp_l; try easy. now apply rem_nonpos.
+Qed.
+
+Lemma rem_abs_r : forall a b, b ~= 0 -> a rem (abs b) == a rem b.
+Proof.
+intros a b Hb. destruct (le_ge_cases 0 b).
+now rewrite abs_eq. now rewrite abs_neq, ?rem_opp_r.
+Qed.
+
+Lemma rem_abs : forall a b,  b ~= 0 -> (abs a) rem (abs b) == abs (a rem b).
+Proof.
+intros. now rewrite rem_abs_r, rem_abs_l.
+Qed.
+
+Lemma quot_abs_l : forall a b, b ~= 0 -> (abs a)÷b == (sgn a)*(a÷b).
+Proof.
+intros a b Hb. destruct (lt_trichotomy 0 a) as [LT|[EQ|LT]].
+rewrite abs_eq, sgn_pos by order. now nzsimpl.
+rewrite <- EQ, abs_0, quot_0_l; trivial. now nzsimpl.
+rewrite abs_neq, quot_opp_l, sgn_neg by order.
+ rewrite mul_opp_l. now nzsimpl.
+Qed.
+
+Lemma quot_abs_r : forall a b, b ~= 0 -> a÷(abs b) == (sgn b)*(a÷b).
+Proof.
+intros a b Hb. destruct (lt_trichotomy 0 b) as [LT|[EQ|LT]].
+rewrite abs_eq, sgn_pos by order. now nzsimpl.
+order.
+rewrite abs_neq, quot_opp_r, sgn_neg by order.
+ rewrite mul_opp_l. now nzsimpl.
+Qed.
+
+Lemma quot_abs : forall a b, b ~= 0 -> (abs a)÷(abs b) == abs (a÷b).
+Proof.
+intros a b Hb.
+pos_or_neg a; [rewrite (abs_eq a)|rewrite (abs_neq a)];
+ try apply opp_nonneg_nonpos; try order.
+pos_or_neg b; [rewrite (abs_eq b)|rewrite (abs_neq b)];
+ try apply opp_nonneg_nonpos; try order.
+rewrite abs_eq; try easy. apply NZQuot.div_pos; order.
+rewrite <- abs_opp, <- quot_opp_r, abs_eq; try easy.
+ apply NZQuot.div_pos; order.
+pos_or_neg b; [rewrite (abs_eq b)|rewrite (abs_neq b)];
+ try apply opp_nonneg_nonpos; try order.
+rewrite <- (abs_opp (_÷_)), <- quot_opp_l, abs_eq; try easy.
+ apply NZQuot.div_pos; order.
+rewrite <- (quot_opp_opp a b), abs_eq; try easy.
+ apply NZQuot.div_pos; order.
+Qed.
+
+(** We have a general bound for absolute values *)
+
+Lemma rem_bound_abs :
+ forall a b, b~=0 -> abs (a rem b) < abs b.
+Proof.
+intros. rewrite <- rem_abs; trivial.
+apply rem_bound_pos. apply abs_nonneg. now apply abs_pos.
+Qed.
+
+(** * Order results about rem and quot *)
 
 (** A modulo cannot grow beyond its starting point. *)
 
-Theorem mod_le: forall a b, 0<=a -> 0<b -> a mod b <= a.
-Proof. exact mod_le. Qed.
+Theorem rem_le: forall a b, 0<=a -> 0<b -> a rem b <= a.
+Proof. exact NZQuot.mod_le. Qed.
 
-Theorem div_pos : forall a b, 0<=a -> 0<b -> 0<= a/b.
-Proof. exact div_pos. Qed.
+Theorem quot_pos : forall a b, 0<=a -> 0<b -> 0<= a÷b.
+Proof. exact NZQuot.div_pos. Qed.
 
-Lemma div_str_pos : forall a b, 0<b<=a -> 0 < a/b.
-Proof. exact div_str_pos. Qed.
+Lemma quot_str_pos : forall a b, 0<b<=a -> 0 < a÷b.
+Proof. exact NZQuot.div_str_pos. Qed.
 
-Lemma div_small_iff : forall a b, b~=0 -> (a/b==0 <-> abs a < abs b).
+Lemma quot_small_iff : forall a b, b~=0 -> (a÷b==0 <-> abs a < abs b).
 Proof.
 intros. pos_or_neg a; pos_or_neg b.
-rewrite div_small_iff; try order. rewrite 2 abs_eq; intuition; order.
-rewrite <- opp_inj_wd, opp_0, <- div_opp_r, div_small_iff by order.
+rewrite NZQuot.div_small_iff; try order. rewrite 2 abs_eq; intuition; order.
+rewrite <- opp_inj_wd, opp_0, <- quot_opp_r, NZQuot.div_small_iff by order.
  rewrite (abs_eq a), (abs_neq' b); intuition; order.
-rewrite <- opp_inj_wd, opp_0, <- div_opp_l, div_small_iff by order.
+rewrite <- opp_inj_wd, opp_0, <- quot_opp_l, NZQuot.div_small_iff by order.
  rewrite (abs_neq' a), (abs_eq b); intuition; order.
-rewrite <- div_opp_opp, div_small_iff by order.
+rewrite <- quot_opp_opp, NZQuot.div_small_iff by order.
  rewrite (abs_neq' a), (abs_neq' b); intuition; order.
 Qed.
 
-Lemma mod_small_iff : forall a b, b~=0 -> (a mod b == a <-> abs a < abs b).
+Lemma rem_small_iff : forall a b, b~=0 -> (a rem b == a <-> abs a < abs b).
 Proof.
-intros. rewrite mod_eq, <- div_small_iff by order.
+intros. rewrite rem_eq, <- quot_small_iff by order.
 rewrite sub_move_r, <- (add_0_r a) at 1. rewrite add_cancel_l.
 rewrite eq_sym_iff, eq_mul_0. tauto.
 Qed.
@@ -227,306 +327,306 @@ Qed.
 (** As soon as the divisor is strictly greater than 1,
     the division is strictly decreasing. *)
 
-Lemma div_lt : forall a b, 0<a -> 1<b -> a/b < a.
-Proof. exact div_lt. Qed.
+Lemma quot_lt : forall a b, 0<a -> 1<b -> a÷b < a.
+Proof. exact NZQuot.div_lt. Qed.
 
 (** [le] is compatible with a positive division. *)
 
-Lemma div_le_mono : forall a b c, 0<c -> a<=b -> a/c <= b/c.
+Lemma quot_le_mono : forall a b c, 0<c -> a<=b -> a÷c <= b÷c.
 Proof.
-intros. pos_or_neg a. apply div_le_mono; auto.
+intros. pos_or_neg a. apply NZQuot.div_le_mono; auto.
 pos_or_neg b. apply le_trans with 0.
- rewrite <- opp_nonneg_nonpos, <- div_opp_l by order.
- apply div_pos; order.
- apply div_pos; order.
-rewrite opp_le_mono in *. rewrite <- 2 div_opp_l by order.
- apply div_le_mono; intuition; order.
+ rewrite <- opp_nonneg_nonpos, <- quot_opp_l by order.
+ apply quot_pos; order.
+ apply quot_pos; order.
+rewrite opp_le_mono in *. rewrite <- 2 quot_opp_l by order.
+ apply NZQuot.div_le_mono; intuition; order.
 Qed.
 
 (** With this choice of division,
-    rounding of div is always done toward zero: *)
+    rounding of quot is always done toward zero: *)
 
-Lemma mul_div_le : forall a b, 0<=a -> b~=0 -> 0 <= b*(a/b) <= a.
+Lemma mul_quot_le : forall a b, 0<=a -> b~=0 -> 0 <= b*(a÷b) <= a.
 Proof.
 intros. pos_or_neg b.
 split.
-apply mul_nonneg_nonneg; [|apply div_pos]; order.
-apply mul_div_le; order.
-rewrite <- mul_opp_opp, <- div_opp_r by order.
+apply mul_nonneg_nonneg; [|apply quot_pos]; order.
+apply NZQuot.mul_div_le; order.
+rewrite <- mul_opp_opp, <- quot_opp_r by order.
 split.
-apply mul_nonneg_nonneg; [|apply div_pos]; order.
-apply mul_div_le; order.
+apply mul_nonneg_nonneg; [|apply quot_pos]; order.
+apply NZQuot.mul_div_le; order.
 Qed.
 
-Lemma mul_div_ge : forall a b, a<=0 -> b~=0 -> a <= b*(a/b) <= 0.
+Lemma mul_quot_ge : forall a b, a<=0 -> b~=0 -> a <= b*(a÷b) <= 0.
 Proof.
 intros.
-rewrite <- opp_nonneg_nonpos, opp_le_mono, <-mul_opp_r, <-div_opp_l by order.
+rewrite <- opp_nonneg_nonpos, opp_le_mono, <-mul_opp_r, <-quot_opp_l by order.
 rewrite <- opp_nonneg_nonpos in *.
-destruct (mul_div_le (-a) b); tauto.
+destruct (mul_quot_le (-a) b); tauto.
 Qed.
 
-(** For positive numbers, considering [S (a/b)] leads to an upper bound for [a] *)
+(** For positive numbers, considering [S (a÷b)] leads to an upper bound for [a] *)
 
-Lemma mul_succ_div_gt: forall a b, 0<=a -> 0<b -> a < b*(S (a/b)).
-Proof. exact mul_succ_div_gt. Qed.
+Lemma mul_succ_quot_gt: forall a b, 0<=a -> 0<b -> a < b*(S (a÷b)).
+Proof. exact NZQuot.mul_succ_div_gt. Qed.
 
 (** Similar results with negative numbers *)
 
-Lemma mul_pred_div_lt: forall a b, a<=0 -> 0<b -> b*(P (a/b)) < a.
+Lemma mul_pred_quot_lt: forall a b, a<=0 -> 0<b -> b*(P (a÷b)) < a.
 Proof.
 intros.
-rewrite opp_lt_mono, <- mul_opp_r, opp_pred, <- div_opp_l by order.
+rewrite opp_lt_mono, <- mul_opp_r, opp_pred, <- quot_opp_l by order.
 rewrite <- opp_nonneg_nonpos in *.
-now apply mul_succ_div_gt.
+now apply mul_succ_quot_gt.
 Qed.
 
-Lemma mul_pred_div_gt: forall a b, 0<=a -> b<0 -> a < b*(P (a/b)).
+Lemma mul_pred_quot_gt: forall a b, 0<=a -> b<0 -> a < b*(P (a÷b)).
 Proof.
 intros.
-rewrite <- mul_opp_opp, opp_pred, <- div_opp_r by order.
+rewrite <- mul_opp_opp, opp_pred, <- quot_opp_r by order.
 rewrite <- opp_pos_neg in *.
-now apply mul_succ_div_gt.
+now apply mul_succ_quot_gt.
 Qed.
 
-Lemma mul_succ_div_lt: forall a b, a<=0 -> b<0 -> b*(S (a/b)) < a.
+Lemma mul_succ_quot_lt: forall a b, a<=0 -> b<0 -> b*(S (a÷b)) < a.
 Proof.
 intros.
-rewrite opp_lt_mono, <- mul_opp_l, <- div_opp_opp by order.
+rewrite opp_lt_mono, <- mul_opp_l, <- quot_opp_opp by order.
 rewrite <- opp_nonneg_nonpos, <- opp_pos_neg in *.
-now apply mul_succ_div_gt.
+now apply mul_succ_quot_gt.
 Qed.
 
-(** Inequality [mul_div_le] is exact iff the modulo is zero. *)
+(** Inequality [mul_quot_le] is exact iff the modulo is zero. *)
 
-Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0).
+Lemma quot_exact : forall a b, b~=0 -> (a == b*(a÷b) <-> a rem b == 0).
 Proof.
-intros. rewrite mod_eq by order. rewrite sub_move_r; nzsimpl; tauto.
+intros. rewrite rem_eq by order. rewrite sub_move_r; nzsimpl; tauto.
 Qed.
 
-(** Some additionnal inequalities about div. *)
+(** Some additionnal inequalities about quot. *)
 
-Theorem div_lt_upper_bound:
-  forall a b q, 0<=a -> 0<b -> a < b*q -> a/b < q.
-Proof. exact div_lt_upper_bound. Qed.
+Theorem quot_lt_upper_bound:
+  forall a b q, 0<=a -> 0<b -> a < b*q -> a÷b < q.
+Proof. exact NZQuot.div_lt_upper_bound. Qed.
 
-Theorem div_le_upper_bound:
-  forall a b q, 0<b -> a <= b*q -> a/b <= q.
+Theorem quot_le_upper_bound:
+  forall a b q, 0<b -> a <= b*q -> a÷b <= q.
 Proof.
 intros.
-rewrite <- (div_mul q b) by order.
-apply div_le_mono; trivial. now rewrite mul_comm.
+rewrite <- (quot_mul q b) by order.
+apply quot_le_mono; trivial. now rewrite mul_comm.
 Qed.
 
-Theorem div_le_lower_bound:
-  forall a b q, 0<b -> b*q <= a -> q <= a/b.
+Theorem quot_le_lower_bound:
+  forall a b q, 0<b -> b*q <= a -> q <= a÷b.
 Proof.
 intros.
-rewrite <- (div_mul q b) by order.
-apply div_le_mono; trivial. now rewrite mul_comm.
+rewrite <- (quot_mul q b) by order.
+apply quot_le_mono; trivial. now rewrite mul_comm.
 Qed.
 
 (** A division respects opposite monotonicity for the divisor *)
 
-Lemma div_le_compat_l: forall p q r, 0<=p -> 0<q<=r -> p/r <= p/q.
-Proof. exact div_le_compat_l. Qed.
+Lemma quot_le_compat_l: forall p q r, 0<=p -> 0<q<=r -> p÷r <= p÷q.
+Proof. exact NZQuot.div_le_compat_l. Qed.
 
-(** * Relations between usual operations and mod and div *)
+(** * Relations between usual operations and rem and quot *)
 
 (** Unlike with other division conventions, some results here aren't
     always valid, and need to be restricted. For instance
-    [(a+b*c) mod c <> a mod c] for [a=9,b=-5,c=2] *)
+    [(a+b*c) rem c <> a rem c] for [a=9,b=-5,c=2] *)
 
-Lemma mod_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a ->
- (a + b * c) mod c == a mod c.
+Lemma rem_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a ->
+ (a + b * c) rem c == a rem c.
 Proof.
-assert (forall a b c, c~=0 -> 0<=a -> 0<=a+b*c -> (a+b*c) mod c == a mod c).
- intros. pos_or_neg c. apply mod_add; order.
- rewrite <- (mod_opp_r a), <- (mod_opp_r (a+b*c)) by order.
+assert (forall a b c, c~=0 -> 0<=a -> 0<=a+b*c -> (a+b*c) rem c == a rem c).
+ intros. pos_or_neg c. apply NZQuot.mod_add; order.
+ rewrite <- (rem_opp_r a), <- (rem_opp_r (a+b*c)) by order.
  rewrite <- mul_opp_opp in *.
- apply mod_add; order.
+ apply NZQuot.mod_add; order.
 intros a b c Hc Habc.
 destruct (le_0_mul _ _ Habc) as [(Habc',Ha)|(Habc',Ha)]. auto.
 apply opp_inj. revert Ha Habc'.
 rewrite <- 2 opp_nonneg_nonpos.
-rewrite <- 2 mod_opp_l, opp_add_distr, <- mul_opp_l by order. auto.
+rewrite <- 2 rem_opp_l, opp_add_distr, <- mul_opp_l by order. auto.
 Qed.
 
-Lemma div_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a ->
- (a + b * c) / c == a / c + b.
+Lemma quot_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a ->
+ (a + b * c) ÷ c == a ÷ c + b.
 Proof.
 intros.
 rewrite <- (mul_cancel_l _ _ c) by trivial.
-rewrite <- (add_cancel_r _ _ ((a+b*c) mod c)).
-rewrite <- div_mod, mod_add by trivial.
-now rewrite mul_add_distr_l, add_shuffle0, <-div_mod, mul_comm.
+rewrite <- (add_cancel_r _ _ ((a+b*c) rem c)).
+rewrite <- quot_rem, rem_add by trivial.
+now rewrite mul_add_distr_l, add_shuffle0, <-quot_rem, mul_comm.
 Qed.
 
-Lemma div_add_l: forall a b c, b~=0 -> 0 <= (a*b+c)*c ->
- (a * b + c) / b == a + c / b.
+Lemma quot_add_l: forall a b c, b~=0 -> 0 <= (a*b+c)*c ->
+ (a * b + c) ÷ b == a + c ÷ b.
 Proof.
- intros a b c. rewrite add_comm, (add_comm a). now apply div_add.
+ intros a b c. rewrite add_comm, (add_comm a). now apply quot_add.
 Qed.
 
 (** Cancellations. *)
 
-Lemma div_mul_cancel_r : forall a b c, b~=0 -> c~=0 ->
- (a*c)/(b*c) == a/b.
+Lemma quot_mul_cancel_r : forall a b c, b~=0 -> c~=0 ->
+ (a*c)÷(b*c) == a÷b.
 Proof.
-assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a*c)/(b*c) == a/b).
- intros. pos_or_neg c. apply div_mul_cancel_r; order.
- rewrite <- div_opp_opp, <- 2 mul_opp_r. apply div_mul_cancel_r; order.
+assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a*c)÷(b*c) == a÷b).
+ intros. pos_or_neg c. apply NZQuot.div_mul_cancel_r; order.
+ rewrite <- quot_opp_opp, <- 2 mul_opp_r. apply NZQuot.div_mul_cancel_r; order.
  rewrite <- neq_mul_0; intuition order.
-assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a*c)/(b*c) == a/b).
+assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a*c)÷(b*c) == a÷b).
  intros. pos_or_neg b. apply Aux1; order.
- apply opp_inj. rewrite <- 2 div_opp_r, <- mul_opp_l; try order. apply Aux1; order.
+ apply opp_inj. rewrite <- 2 quot_opp_r, <- mul_opp_l; try order. apply Aux1; order.
  rewrite <- neq_mul_0; intuition order.
 intros. pos_or_neg a. apply Aux2; order.
-apply opp_inj. rewrite <- 2 div_opp_l, <- mul_opp_l; try order. apply Aux2; order.
+apply opp_inj. rewrite <- 2 quot_opp_l, <- mul_opp_l; try order. apply Aux2; order.
 rewrite <- neq_mul_0; intuition order.
 Qed.
 
-Lemma div_mul_cancel_l : forall a b c, b~=0 -> c~=0 ->
- (c*a)/(c*b) == a/b.
+Lemma quot_mul_cancel_l : forall a b c, b~=0 -> c~=0 ->
+ (c*a)÷(c*b) == a÷b.
 Proof.
-intros. rewrite !(mul_comm c); now apply div_mul_cancel_r.
+intros. rewrite !(mul_comm c); now apply quot_mul_cancel_r.
 Qed.
 
-Lemma mul_mod_distr_r: forall a b c, b~=0 -> c~=0 ->
-  (a*c) mod (b*c) == (a mod b) * c.
+Lemma mul_rem_distr_r: forall a b c, b~=0 -> c~=0 ->
+  (a*c) rem (b*c) == (a rem b) * c.
 Proof.
 intros.
 assert (b*c ~= 0) by (rewrite <- neq_mul_0; tauto).
-rewrite ! mod_eq by trivial.
-rewrite div_mul_cancel_r by order.
-now rewrite mul_sub_distr_r, <- !mul_assoc, (mul_comm (a/b) c).
+rewrite ! rem_eq by trivial.
+rewrite quot_mul_cancel_r by order.
+now rewrite mul_sub_distr_r, <- !mul_assoc, (mul_comm (a÷b) c).
 Qed.
 
-Lemma mul_mod_distr_l: forall a b c, b~=0 -> c~=0 ->
-  (c*a) mod (c*b) == c * (a mod b).
+Lemma mul_rem_distr_l: forall a b c, b~=0 -> c~=0 ->
+  (c*a) rem (c*b) == c * (a rem b).
 Proof.
-intros; rewrite !(mul_comm c); now apply mul_mod_distr_r.
+intros; rewrite !(mul_comm c); now apply mul_rem_distr_r.
 Qed.
 
 (** Operations modulo. *)
 
-Theorem mod_mod: forall a n, n~=0 ->
- (a mod n) mod n == a mod n.
+Theorem rem_rem: forall a n, n~=0 ->
+ (a rem n) rem n == a rem n.
 Proof.
-intros. pos_or_neg a; pos_or_neg n. apply mod_mod; order.
-rewrite <- ! (mod_opp_r _ n) by trivial. apply mod_mod; order.
-apply opp_inj. rewrite <- !mod_opp_l by order. apply mod_mod; order.
-apply opp_inj. rewrite <- !mod_opp_opp by order. apply mod_mod; order.
+intros. pos_or_neg a; pos_or_neg n. apply NZQuot.mod_mod; order.
+rewrite <- ! (rem_opp_r _ n) by trivial. apply NZQuot.mod_mod; order.
+apply opp_inj. rewrite <- !rem_opp_l by order. apply NZQuot.mod_mod; order.
+apply opp_inj. rewrite <- !rem_opp_opp by order. apply NZQuot.mod_mod; order.
 Qed.
 
-Lemma mul_mod_idemp_l : forall a b n, n~=0 ->
- ((a mod n)*b) mod n == (a*b) mod n.
+Lemma mul_rem_idemp_l : forall a b n, n~=0 ->
+ ((a rem n)*b) rem n == (a*b) rem n.
 Proof.
 assert (Aux1 : forall a b n, 0<=a -> 0<=b -> n~=0 ->
-         ((a mod n)*b) mod n == (a*b) mod n).
- intros. pos_or_neg n. apply mul_mod_idemp_l; order.
- rewrite <- ! (mod_opp_r _ n) by order. apply mul_mod_idemp_l; order.
+         ((a rem n)*b) rem n == (a*b) rem n).
+ intros. pos_or_neg n. apply NZQuot.mul_mod_idemp_l; order.
+ rewrite <- ! (rem_opp_r _ n) by order. apply NZQuot.mul_mod_idemp_l; order.
 assert (Aux2 : forall a b n, 0<=a -> n~=0 ->
-         ((a mod n)*b) mod n == (a*b) mod n).
+         ((a rem n)*b) rem n == (a*b) rem n).
  intros. pos_or_neg b. now apply Aux1.
- apply opp_inj. rewrite <-2 mod_opp_l, <-2 mul_opp_r by order.
+ apply opp_inj. rewrite <-2 rem_opp_l, <-2 mul_opp_r by order.
   apply Aux1; order.
 intros a b n Hn. pos_or_neg a. now apply Aux2.
-apply opp_inj. rewrite <-2 mod_opp_l, <-2 mul_opp_l, <-mod_opp_l by order.
+apply opp_inj. rewrite <-2 rem_opp_l, <-2 mul_opp_l, <-rem_opp_l by order.
 apply Aux2; order.
 Qed.
 
-Lemma mul_mod_idemp_r : forall a b n, n~=0 ->
- (a*(b mod n)) mod n == (a*b) mod n.
+Lemma mul_rem_idemp_r : forall a b n, n~=0 ->
+ (a*(b rem n)) rem n == (a*b) rem n.
 Proof.
-intros. rewrite !(mul_comm a). now apply mul_mod_idemp_l.
+intros. rewrite !(mul_comm a). now apply mul_rem_idemp_l.
 Qed.
 
-Theorem mul_mod: forall a b n, n~=0 ->
- (a * b) mod n == ((a mod n) * (b mod n)) mod n.
+Theorem mul_rem: forall a b n, n~=0 ->
+ (a * b) rem n == ((a rem n) * (b rem n)) rem n.
 Proof.
-intros. now rewrite mul_mod_idemp_l, mul_mod_idemp_r.
+intros. now rewrite mul_rem_idemp_l, mul_rem_idemp_r.
 Qed.
 
 (** addition and modulo
 
   Generally speaking, unlike with other conventions, we don't have
-       [(a+b) mod n = (a mod n + b mod n) mod n]
+       [(a+b) rem n = (a rem n + b rem n) rem n]
   for any a and b.
-  For instance, take (8 + (-10)) mod 3 = -2 whereas
-  (8 mod 3 + (-10 mod 3)) mod 3 = 1.
+  For instance, take (8 + (-10)) rem 3 = -2 whereas
+  (8 rem 3 + (-10 rem 3)) rem 3 = 1.
 *)
 
-Lemma add_mod_idemp_l : forall a b n, n~=0 -> 0 <= a*b ->
- ((a mod n)+b) mod n == (a+b) mod n.
+Lemma add_rem_idemp_l : forall a b n, n~=0 -> 0 <= a*b ->
+ ((a rem n)+b) rem n == (a+b) rem n.
 Proof.
 assert (Aux : forall a b n, 0<=a -> 0<=b -> n~=0 ->
-          ((a mod n)+b) mod n == (a+b) mod n).
- intros. pos_or_neg n. apply add_mod_idemp_l; order.
- rewrite <- ! (mod_opp_r _ n) by order. apply add_mod_idemp_l; order.
+          ((a rem n)+b) rem n == (a+b) rem n).
+ intros. pos_or_neg n. apply NZQuot.add_mod_idemp_l; order.
+ rewrite <- ! (rem_opp_r _ n) by order. apply NZQuot.add_mod_idemp_l; order.
 intros a b n Hn Hab. destruct (le_0_mul _ _ Hab) as [(Ha,Hb)|(Ha,Hb)].
 now apply Aux.
-apply opp_inj. rewrite <-2 mod_opp_l, 2 opp_add_distr, <-mod_opp_l by order.
+apply opp_inj. rewrite <-2 rem_opp_l, 2 opp_add_distr, <-rem_opp_l by order.
 rewrite <- opp_nonneg_nonpos in *.
 now apply Aux.
 Qed.
 
-Lemma add_mod_idemp_r : forall a b n, n~=0 -> 0 <= a*b ->
- (a+(b mod n)) mod n == (a+b) mod n.
+Lemma add_rem_idemp_r : forall a b n, n~=0 -> 0 <= a*b ->
+ (a+(b rem n)) rem n == (a+b) rem n.
 Proof.
-intros. rewrite !(add_comm a). apply add_mod_idemp_l; trivial.
+intros. rewrite !(add_comm a). apply add_rem_idemp_l; trivial.
 now rewrite mul_comm.
 Qed.
 
-Theorem add_mod: forall a b n, n~=0 -> 0 <= a*b ->
- (a+b) mod n == (a mod n + b mod n) mod n.
+Theorem add_rem: forall a b n, n~=0 -> 0 <= a*b ->
+ (a+b) rem n == (a rem n + b rem n) rem n.
 Proof.
-intros a b n Hn Hab. rewrite add_mod_idemp_l, add_mod_idemp_r; trivial.
+intros a b n Hn Hab. rewrite add_rem_idemp_l, add_rem_idemp_r; trivial.
 reflexivity.
 destruct (le_0_mul _ _ Hab) as [(Ha,Hb)|(Ha,Hb)];
- destruct (le_0_mul _ _ (mod_sign b n Hn)) as [(Hb',Hm)|(Hb',Hm)];
+ destruct (le_0_mul _ _ (rem_sign_mul b n Hn)) as [(Hb',Hm)|(Hb',Hm)];
  auto using mul_nonneg_nonneg, mul_nonpos_nonpos.
- setoid_replace b with 0 by order. rewrite mod_0_l by order. nzsimpl; order.
- setoid_replace b with 0 by order. rewrite mod_0_l by order. nzsimpl; order.
+ setoid_replace b with 0 by order. rewrite rem_0_l by order. nzsimpl; order.
+ setoid_replace b with 0 by order. rewrite rem_0_l by order. nzsimpl; order.
 Qed.
 
+(** Conversely, the following results need less restrictions here. *)
 
-(** Conversely, the following result needs less restrictions here. *)
-
-Lemma div_div : forall a b c, b~=0 -> c~=0 ->
- (a/b)/c == a/(b*c).
+Lemma quot_quot : forall a b c, b~=0 -> c~=0 ->
+ (a÷b)÷c == a÷(b*c).
 Proof.
-assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a/b)/c == a/(b*c)).
- intros. pos_or_neg c. apply div_div; order.
- apply opp_inj. rewrite <- 2 div_opp_r, <- mul_opp_r; trivial.
- apply div_div; order.
+assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a÷b)÷c == a÷(b*c)).
+ intros. pos_or_neg c. apply NZQuot.div_div; order.
+ apply opp_inj. rewrite <- 2 quot_opp_r, <- mul_opp_r; trivial.
+ apply NZQuot.div_div; order.
  rewrite <- neq_mul_0; intuition order.
-assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a/b)/c == a/(b*c)).
+assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a÷b)÷c == a÷(b*c)).
  intros. pos_or_neg b. apply Aux1; order.
- apply opp_inj. rewrite <- div_opp_l, <- 2 div_opp_r, <- mul_opp_l; trivial.
+ apply opp_inj. rewrite <- quot_opp_l, <- 2 quot_opp_r, <- mul_opp_l; trivial.
  apply Aux1; trivial.
  rewrite <- neq_mul_0; intuition order.
 intros. pos_or_neg a. apply Aux2; order.
-apply opp_inj. rewrite <- 3 div_opp_l; try order. apply Aux2; order.
+apply opp_inj. rewrite <- 3 quot_opp_l; try order. apply Aux2; order.
 rewrite <- neq_mul_0. tauto.
 Qed.
 
-(** A last inequality: *)
-
-Theorem div_mul_le:
- forall a b c, 0<=a -> 0<b -> 0<=c -> c*(a/b) <= (c*a)/b.
-Proof. exact div_mul_le. Qed.
-
-(** mod is related to divisibility *)
-
-Lemma mod_divides : forall a b, b~=0 ->
- (a mod b == 0 <-> exists c, a == b*c).
+Lemma mod_mul_r : forall a b c, b~=0 -> c~=0 ->
+ a rem (b*c) == a rem b + b*((a÷b) rem c).
 Proof.
- intros a b Hb. split.
- intros Hab. exists (a/b). rewrite (div_mod a b Hb) at 1.
-  rewrite Hab; now nzsimpl.
- intros (c,Hc). rewrite Hc, mul_comm. now apply mod_mul.
+ intros a b c Hb Hc.
+ apply add_cancel_l with (b*c*(a÷(b*c))).
+ rewrite <- quot_rem by (apply neq_mul_0; split; order).
+ rewrite <- quot_quot by trivial.
+ rewrite add_assoc, add_shuffle0, <- mul_assoc, <- mul_add_distr_l.
+ rewrite <- quot_rem by order.
+ apply quot_rem; order.
 Qed.
 
-End ZDivPropFunct.
+(** A last inequality: *)
+
+Theorem quot_mul_le:
+ forall a b c, 0<=a -> 0<b -> 0<=c -> c*(a÷b) <= (c*a)÷b.
+Proof. exact NZQuot.div_mul_le. Qed.
+
+End ZQuotProp.
 
diff --git a/theories/Numbers/Integer/Abstract/ZGcd.v b/theories/Numbers/Integer/Abstract/ZGcd.v
new file mode 100644
index 00000000..feac10b3
--- /dev/null
+++ b/theories/Numbers/Integer/Abstract/ZGcd.v
@@ -0,0 +1,274 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Properties of the greatest common divisor *)
+
+Require Import ZAxioms ZMulOrder ZSgnAbs NZGcd.
+
+Module Type ZGcdProp
+ (Import A : ZAxiomsSig')
+ (Import B : ZMulOrderProp A)
+ (Import C : ZSgnAbsProp A B).
+
+ Include NZGcdProp A A B.
+
+(** Results concerning divisibility*)
+
+Lemma divide_opp_l : forall n m, (-n | m) <-> (n | m).
+Proof.
+ intros n m. split; intros (p,Hp); exists (-p); rewrite Hp.
+  now rewrite mul_opp_l, mul_opp_r.
+  now rewrite mul_opp_opp.
+Qed.
+
+Lemma divide_opp_r : forall n m, (n | -m) <-> (n | m).
+Proof.
+ intros n m. split; intros (p,Hp); exists (-p).
+  now rewrite mul_opp_l, <- Hp, opp_involutive.
+  now rewrite Hp, mul_opp_l.
+Qed.
+
+Lemma divide_abs_l : forall n m, (abs n | m) <-> (n | m).
+Proof.
+ intros n m. destruct (abs_eq_or_opp n) as [H|H]; rewrite H.
+ easy. apply divide_opp_l.
+Qed.
+
+Lemma divide_abs_r : forall n m, (n | abs m) <-> (n | m).
+Proof.
+ intros n m. destruct (abs_eq_or_opp m) as [H|H]; rewrite H.
+ easy. apply divide_opp_r.
+Qed.
+
+Lemma divide_1_r_abs : forall n, (n | 1) -> abs n == 1.
+Proof.
+ intros n Hn. apply divide_1_r_nonneg. apply abs_nonneg.
+ now apply divide_abs_l.
+Qed.
+
+Lemma divide_1_r : forall n, (n | 1) -> n==1 \/ n==-1.
+Proof.
+ intros n (m,H). rewrite mul_comm in H. now apply eq_mul_1 with m.
+Qed.
+
+Lemma divide_antisym_abs : forall n m,
+ (n | m) -> (m | n) -> abs n == abs m.
+Proof.
+ intros. apply divide_antisym_nonneg; try apply abs_nonneg.
+ now apply divide_abs_l, divide_abs_r.
+ now apply divide_abs_l, divide_abs_r.
+Qed.
+
+Lemma divide_antisym : forall n m,
+ (n | m) -> (m | n) -> n == m \/ n == -m.
+Proof.
+ intros. now apply abs_eq_cases, divide_antisym_abs.
+Qed.
+
+Lemma divide_sub_r : forall n m p, (n | m) -> (n | p) -> (n | m - p).
+Proof.
+ intros n m p H H'. rewrite <- add_opp_r.
+ apply divide_add_r; trivial. now apply divide_opp_r.
+Qed.
+
+Lemma divide_add_cancel_r : forall n m p, (n | m) -> (n | m + p) -> (n | p).
+Proof.
+ intros n m p H H'. rewrite <- (add_simpl_l m p). now apply divide_sub_r.
+Qed.
+
+(** Properties of gcd *)
+
+Lemma gcd_opp_l : forall n m, gcd (-n) m == gcd n m.
+Proof.
+ intros. apply gcd_unique_alt; try apply gcd_nonneg.
+ intros. rewrite divide_opp_r. apply gcd_divide_iff.
+Qed.
+
+Lemma gcd_opp_r : forall n m, gcd n (-m) == gcd n m.
+Proof.
+ intros. now rewrite gcd_comm, gcd_opp_l, gcd_comm.
+Qed.
+
+Lemma gcd_abs_l : forall n m, gcd (abs n) m == gcd n m.
+Proof.
+ intros. destruct (abs_eq_or_opp n) as [H|H]; rewrite H.
+ easy. apply gcd_opp_l.
+Qed.
+
+Lemma gcd_abs_r : forall n m, gcd n (abs m) == gcd n m.
+Proof.
+ intros. now rewrite gcd_comm, gcd_abs_l, gcd_comm.
+Qed.
+
+Lemma gcd_0_l : forall n, gcd 0 n == abs n.
+Proof.
+ intros. rewrite <- gcd_abs_r. apply gcd_0_l_nonneg, abs_nonneg.
+Qed.
+
+Lemma gcd_0_r : forall n, gcd n 0 == abs n.
+Proof.
+ intros. now rewrite gcd_comm, gcd_0_l.
+Qed.
+
+Lemma gcd_diag : forall n, gcd n n == abs n.
+Proof.
+ intros. rewrite <- gcd_abs_l, <- gcd_abs_r.
+ apply gcd_diag_nonneg, abs_nonneg.
+Qed.
+
+Lemma gcd_add_mult_diag_r : forall n m p, gcd n (m+p*n) == gcd n m.
+Proof.
+ intros. apply gcd_unique_alt; try apply gcd_nonneg.
+ intros. rewrite gcd_divide_iff. split; intros (U,V); split; trivial.
+ apply divide_add_r; trivial. now apply divide_mul_r.
+ apply divide_add_cancel_r with (p*n); trivial.
+ now apply divide_mul_r. now rewrite add_comm.
+Qed.
+
+Lemma gcd_add_diag_r : forall n m, gcd n (m+n) == gcd n m.
+Proof.
+ intros n m. rewrite <- (mul_1_l n) at 2. apply gcd_add_mult_diag_r.
+Qed.
+
+Lemma gcd_sub_diag_r : forall n m, gcd n (m-n) == gcd n m.
+Proof.
+ intros n m. rewrite <- (mul_1_l n) at 2.
+ rewrite <- add_opp_r, <- mul_opp_l. apply gcd_add_mult_diag_r.
+Qed.
+
+Definition Bezout n m p := exists a b, a*n + b*m == p.
+
+Instance Bezout_wd : Proper (eq==>eq==>eq==>iff) Bezout.
+Proof.
+ unfold Bezout. intros x x' Hx y y' Hy z z' Hz.
+ setoid_rewrite Hx. setoid_rewrite Hy. now setoid_rewrite Hz.
+Qed.
+
+Lemma bezout_1_gcd : forall n m, Bezout n m 1 -> gcd n m == 1.
+Proof.
+ intros n m (q & r & H).
+ apply gcd_unique; trivial using divide_1_l, le_0_1.
+ intros p Hn Hm.
+ rewrite <- H. apply divide_add_r; now apply divide_mul_r.
+Qed.
+
+Lemma gcd_bezout : forall n m p, gcd n m == p -> Bezout n m p.
+Proof.
+ (* First, a version restricted to natural numbers *)
+ assert (aux : forall n, 0<=n -> forall m, 0<=m -> Bezout n m (gcd n m)).
+  intros n Hn; pattern n.
+  apply strong_right_induction with (z:=0); trivial.
+  unfold Bezout. solve_proper.
+  clear n Hn. intros n Hn IHn.
+  apply le_lteq in Hn; destruct Hn as [Hn|Hn].
+  intros m Hm; pattern m.
+  apply strong_right_induction with (z:=0); trivial.
+  unfold Bezout. solve_proper.
+  clear m Hm. intros m Hm IHm.
+  destruct (lt_trichotomy n m) as [LT|[EQ|LT]].
+  (* n < m *)
+  destruct (IHm (m-n)) as (a & b & EQ).
+  apply sub_nonneg; order.
+  now apply lt_sub_pos.
+  exists (a-b). exists b.
+  rewrite gcd_sub_diag_r in EQ. rewrite <- EQ.
+  rewrite mul_sub_distr_r, mul_sub_distr_l.
+  now rewrite add_sub_assoc, add_sub_swap.
+  (* n = m *)
+  rewrite EQ. rewrite gcd_diag_nonneg; trivial.
+  exists 1. exists 0. now nzsimpl.
+  (* m < n *)
+  destruct (IHn m Hm LT n) as (a & b & EQ). order.
+  exists b. exists a. now rewrite gcd_comm, <- EQ, add_comm.
+  (* n = 0 *)
+  intros m Hm. rewrite <- Hn, gcd_0_l_nonneg; trivial.
+  exists 0. exists 1. now nzsimpl.
+ (* Then we relax the positivity condition on n *)
+ assert (aux' : forall n m, 0<=m -> Bezout n m (gcd n m)).
+  intros n m Hm.
+  destruct (le_ge_cases 0 n). now apply aux.
+  assert (Hn' : 0 <= -n) by now apply opp_nonneg_nonpos.
+  destruct (aux (-n) Hn' m Hm) as (a & b & EQ).
+  exists (-a). exists b. now rewrite <- gcd_opp_l, <- EQ, mul_opp_r, mul_opp_l.
+ (* And finally we do the same for m *)
+ intros n m p Hp. rewrite <- Hp; clear Hp.
+ destruct (le_ge_cases 0 m). now apply aux'.
+ assert (Hm' : 0 <= -m) by now apply opp_nonneg_nonpos.
+ destruct (aux' n (-m) Hm') as (a & b & EQ).
+ exists a. exists (-b). now rewrite <- gcd_opp_r, <- EQ, mul_opp_r, mul_opp_l.
+Qed.
+
+Lemma gcd_mul_mono_l :
+  forall n m p, gcd (p * n) (p * m) == abs p * gcd n m.
+Proof.
+ intros n m p.
+ apply gcd_unique.
+ apply mul_nonneg_nonneg; trivial using gcd_nonneg, abs_nonneg.
+ destruct (gcd_divide_l n m) as (q,Hq).
+ rewrite Hq at 2. rewrite mul_assoc. apply mul_divide_mono_r.
+ rewrite <- (abs_sgn p) at 2. rewrite <- mul_assoc. apply divide_factor_l.
+ destruct (gcd_divide_r n m) as (q,Hq).
+ rewrite Hq at 2. rewrite mul_assoc. apply mul_divide_mono_r.
+ rewrite <- (abs_sgn p) at 2. rewrite <- mul_assoc. apply divide_factor_l.
+ intros q H H'.
+ destruct (gcd_bezout n m (gcd n m) (eq_refl _)) as (a & b & EQ).
+ rewrite <- EQ, <- sgn_abs, mul_add_distr_l. apply divide_add_r.
+ rewrite mul_shuffle2. now apply divide_mul_l.
+ rewrite mul_shuffle2. now apply divide_mul_l.
+Qed.
+
+Lemma gcd_mul_mono_l_nonneg :
+ forall n m p, 0<=p -> gcd (p*n) (p*m) == p * gcd n m.
+Proof.
+ intros. rewrite <- (abs_eq p) at 3; trivial. apply gcd_mul_mono_l.
+Qed.
+
+Lemma gcd_mul_mono_r :
+ forall n m p, gcd (n * p) (m * p) == gcd n m * abs p.
+Proof.
+ intros n m p. now rewrite !(mul_comm _ p), gcd_mul_mono_l, mul_comm.
+Qed.
+
+Lemma gcd_mul_mono_r_nonneg :
+ forall n m p, 0<=p -> gcd (n*p) (m*p) == gcd n m * p.
+Proof.
+ intros. rewrite <- (abs_eq p) at 3; trivial. apply gcd_mul_mono_r.
+Qed.
+
+Lemma gauss : forall n m p, (n | m * p) -> gcd n m == 1 -> (n | p).
+Proof.
+ intros n m p H G.
+ destruct (gcd_bezout n m 1 G) as (a & b & EQ).
+ rewrite <- (mul_1_l p), <- EQ, mul_add_distr_r.
+ apply divide_add_r. rewrite mul_shuffle0. apply divide_factor_r.
+ rewrite <- mul_assoc. now apply divide_mul_r.
+Qed.
+
+Lemma divide_mul_split : forall n m p, n ~= 0 -> (n | m * p) ->
+ exists q r, n == q*r /\ (q | m) /\ (r | p).
+Proof.
+ intros n m p Hn H.
+ assert (G := gcd_nonneg n m).
+ apply le_lteq in G; destruct G as [G|G].
+ destruct (gcd_divide_l n m) as (q,Hq).
+ exists (gcd n m). exists q.
+ split. now rewrite mul_comm.
+ split. apply gcd_divide_r.
+ destruct (gcd_divide_r n m) as (r,Hr).
+ rewrite Hr in H. rewrite Hq in H at 1.
+ rewrite mul_shuffle0 in H. apply mul_divide_cancel_r in H; [|order].
+ apply gauss with r; trivial.
+ apply mul_cancel_r with (gcd n m); [order|].
+ rewrite mul_1_l.
+ rewrite <- gcd_mul_mono_r_nonneg, <- Hq, <- Hr; order.
+ symmetry in G. apply gcd_eq_0 in G. destruct G as (Hn',_); order.
+Qed.
+
+(** TODO : more about rel_prime (i.e. gcd == 1), about prime ... *)
+
+End ZGcdProp.
diff --git a/theories/Numbers/Integer/Abstract/ZLcm.v b/theories/Numbers/Integer/Abstract/ZLcm.v
new file mode 100644
index 00000000..45da2dee
--- /dev/null
+++ b/theories/Numbers/Integer/Abstract/ZLcm.v
@@ -0,0 +1,471 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import ZAxioms ZMulOrder ZSgnAbs ZGcd ZDivTrunc ZDivFloor.
+
+(** * Least Common Multiple *)
+
+(** Unlike other functions around, we will define lcm below instead of
+  axiomatizing it. Indeed, there is no "prior art" about lcm in the
+  standard library to be compliant with, and the generic definition
+  of lcm via gcd is quite reasonable.
+
+  By the way, we also state here some combined properties of div/mod
+  and quot/rem and gcd.
+*)
+
+Module Type ZLcmProp
+ (Import A : ZAxiomsSig')
+ (Import B : ZMulOrderProp A)
+ (Import C : ZSgnAbsProp A B)
+ (Import D : ZDivProp A B C)
+ (Import E : ZQuotProp A B C)
+ (Import F : ZGcdProp A B C).
+
+(** The two notions of division are equal on non-negative numbers *)
+
+Lemma quot_div_nonneg : forall a b, 0<=a -> 0<b -> a÷b == a/b.
+Proof.
+ intros. apply div_unique_pos with (a rem b).
+ now apply rem_bound_pos.
+ apply quot_rem. order.
+Qed.
+
+Lemma rem_mod_nonneg : forall a b, 0<=a -> 0<b -> a rem b == a mod b.
+Proof.
+ intros. apply mod_unique_pos with (a÷b).
+ now apply rem_bound_pos.
+ apply quot_rem. order.
+Qed.
+
+(** We can use the sign rule to have an relation between divisions. *)
+
+Lemma quot_div : forall a b, b~=0 ->
+ a÷b == (sgn a)*(sgn b)*(abs a / abs b).
+Proof.
+ assert (AUX : forall a b, 0<b -> a÷b == (sgn a)*(sgn b)*(abs a / abs b)).
+  intros a b Hb. rewrite (sgn_pos b), (abs_eq b), mul_1_r by order.
+  destruct (lt_trichotomy 0 a) as [Ha|[Ha|Ha]].
+  rewrite sgn_pos, abs_eq, mul_1_l, quot_div_nonneg; order.
+  rewrite <- Ha, abs_0, sgn_0, quot_0_l, div_0_l, mul_0_l; order.
+  rewrite sgn_neg, abs_neq, mul_opp_l, mul_1_l, eq_opp_r, <-quot_opp_l
+    by order.
+   apply quot_div_nonneg; trivial. apply opp_nonneg_nonpos; order.
+ (* main *)
+ intros a b Hb.
+ apply neg_pos_cases in Hb. destruct Hb as [Hb|Hb]; [|now apply AUX].
+ rewrite <- (opp_involutive b) at 1. rewrite quot_opp_r.
+ rewrite AUX, abs_opp, sgn_opp, mul_opp_r, mul_opp_l, opp_involutive.
+ reflexivity.
+ now apply opp_pos_neg.
+ rewrite eq_opp_l, opp_0; order.
+Qed.
+
+Lemma rem_mod : forall a b, b~=0 ->
+ a rem b == (sgn a) * ((abs a) mod (abs b)).
+Proof.
+ intros a b Hb.
+ rewrite <- rem_abs_r by trivial.
+ assert (Hb' := proj2 (abs_pos b) Hb).
+ destruct (lt_trichotomy 0 a) as [Ha|[Ha|Ha]].
+ rewrite (abs_eq a), sgn_pos, mul_1_l, rem_mod_nonneg; order.
+ rewrite <- Ha, abs_0, sgn_0, mod_0_l, rem_0_l, mul_0_l; order.
+ rewrite sgn_neg, (abs_neq a), mul_opp_l, mul_1_l, eq_opp_r, <-rem_opp_l
+    by order.
+  apply rem_mod_nonneg; trivial. apply opp_nonneg_nonpos; order.
+Qed.
+
+(** Modulo and remainder are null at the same place,
+    and this correspond to the divisibility relation. *)
+
+Lemma mod_divide : forall a b, b~=0 -> (a mod b == 0 <-> (b|a)).
+Proof.
+ intros a b Hb. split.
+ intros Hab. exists (a/b). rewrite mul_comm.
+ rewrite (div_mod a b Hb) at 1. rewrite Hab; now nzsimpl.
+ intros (c,Hc). rewrite Hc. now apply mod_mul.
+Qed.
+
+Lemma rem_divide : forall a b, b~=0 -> (a rem b == 0 <-> (b|a)).
+Proof.
+ intros a b Hb. split.
+ intros Hab. exists (a÷b). rewrite mul_comm.
+ rewrite (quot_rem a b Hb) at 1. rewrite Hab; now nzsimpl.
+ intros (c,Hc). rewrite Hc. now apply rem_mul.
+Qed.
+
+Lemma rem_mod_eq_0 : forall a b, b~=0 -> (a rem b == 0 <-> a mod b == 0).
+Proof.
+ intros a b Hb. now rewrite mod_divide, rem_divide.
+Qed.
+
+(** When division is exact, div and quot agree *)
+
+Lemma quot_div_exact : forall a b, b~=0 -> (b|a) -> a÷b == a/b.
+Proof.
+ intros a b Hb H.
+ apply mul_cancel_l with b; trivial.
+ assert (H':=H).
+ apply rem_divide, quot_exact in H; trivial.
+ apply mod_divide, div_exact in H'; trivial.
+ now rewrite <-H,<-H'.
+Qed.
+
+Lemma divide_div_mul_exact : forall a b c, b~=0 -> (b|a) ->
+ (c*a)/b == c*(a/b).
+Proof.
+ intros a b c Hb H.
+ apply mul_cancel_l with b; trivial.
+ rewrite mul_assoc, mul_shuffle0.
+ assert (H':=H). apply mod_divide, div_exact in H'; trivial.
+ rewrite <- H', (mul_comm a c).
+ symmetry. apply div_exact; trivial.
+ apply mod_divide; trivial.
+ now apply divide_mul_r.
+Qed.
+
+Lemma divide_quot_mul_exact : forall a b c, b~=0 -> (b|a) ->
+ (c*a)÷b == c*(a÷b).
+Proof.
+ intros a b c Hb H.
+ rewrite 2 quot_div_exact; trivial.
+ apply divide_div_mul_exact; trivial.
+ now apply divide_mul_r.
+Qed.
+
+(** Gcd of divided elements, for exact divisions *)
+
+Lemma gcd_div_factor : forall a b c, 0<c -> (c|a) -> (c|b) ->
+ gcd (a/c) (b/c) == (gcd a b)/c.
+Proof.
+ intros a b c Hc Ha Hb.
+ apply mul_cancel_l with c; try order.
+ assert (H:=gcd_greatest _ _ _ Ha Hb).
+ apply mod_divide, div_exact in H; try order.
+ rewrite <- H.
+ rewrite <- gcd_mul_mono_l_nonneg; try order.
+ f_equiv; symmetry; apply div_exact; try order;
+  apply mod_divide; trivial; try order.
+Qed.
+
+Lemma gcd_quot_factor : forall a b c, 0<c -> (c|a) -> (c|b) ->
+ gcd (a÷c) (b÷c) == (gcd a b)÷c.
+Proof.
+ intros a b c Hc Ha Hb. rewrite !quot_div_exact; trivial; try order.
+ now apply gcd_div_factor. now apply gcd_greatest.
+Qed.
+
+Lemma gcd_div_gcd : forall a b g, g~=0 -> g == gcd a b ->
+ gcd (a/g) (b/g) == 1.
+Proof.
+ intros a b g NZ EQ. rewrite gcd_div_factor.
+ now rewrite <- EQ, div_same.
+ generalize (gcd_nonneg a b); order.
+ rewrite EQ; apply gcd_divide_l.
+ rewrite EQ; apply gcd_divide_r.
+Qed.
+
+Lemma gcd_quot_gcd : forall a b g, g~=0 -> g == gcd a b ->
+ gcd (a÷g) (b÷g) == 1.
+Proof.
+ intros a b g NZ EQ. rewrite !quot_div_exact; trivial.
+ now apply gcd_div_gcd.
+ rewrite EQ; apply gcd_divide_r.
+ rewrite EQ; apply gcd_divide_l.
+Qed.
+
+(** The following equality is crucial for Euclid algorithm *)
+
+Lemma gcd_mod : forall a b, b~=0 -> gcd (a mod b) b == gcd b a.
+Proof.
+ intros a b Hb. rewrite mod_eq; trivial.
+ rewrite <- add_opp_r, mul_comm, <- mul_opp_l.
+ rewrite (gcd_comm _ b).
+ apply gcd_add_mult_diag_r.
+Qed.
+
+Lemma gcd_rem : forall a b, b~=0 -> gcd (a rem b) b == gcd b a.
+Proof.
+ intros a b Hb. rewrite rem_eq; trivial.
+ rewrite <- add_opp_r, mul_comm, <- mul_opp_l.
+ rewrite (gcd_comm _ b).
+ apply gcd_add_mult_diag_r.
+Qed.
+
+(** We now define lcm thanks to gcd:
+
+    lcm a b = a * (b / gcd a b)
+            = (a / gcd a b) * b
+            = (a*b) / gcd a b
+
+   We had an abs in order to have an always-nonnegative lcm,
+   in the spirit of gcd. Nota: [lcm 0 0] should be 0, which
+   isn't garantee with the third equation above.
+*)
+
+Definition lcm a b := abs (a*(b/gcd a b)).
+
+Instance lcm_wd : Proper (eq==>eq==>eq) lcm.
+Proof. unfold lcm. solve_proper. Qed.
+
+Lemma lcm_equiv1 : forall a b, gcd a b ~= 0 ->
+  a * (b / gcd a b) == (a*b)/gcd a b.
+Proof.
+ intros a b H. rewrite divide_div_mul_exact; try easy. apply gcd_divide_r.
+Qed.
+
+Lemma lcm_equiv2 : forall a b, gcd a b ~= 0 ->
+  (a / gcd a b) * b == (a*b)/gcd a b.
+Proof.
+ intros a b H. rewrite 2 (mul_comm _ b).
+ rewrite divide_div_mul_exact; try easy. apply gcd_divide_l.
+Qed.
+
+Lemma gcd_div_swap : forall a b,
+ (a / gcd a b) * b == a * (b / gcd a b).
+Proof.
+ intros a b. destruct (eq_decidable (gcd a b) 0) as [EQ|NEQ].
+ apply gcd_eq_0 in EQ. destruct EQ as (EQ,EQ'). rewrite EQ, EQ'. now nzsimpl.
+ now rewrite lcm_equiv1, <-lcm_equiv2.
+Qed.
+
+Lemma divide_lcm_l : forall a b, (a | lcm a b).
+Proof.
+ unfold lcm. intros a b. apply divide_abs_r, divide_factor_l.
+Qed.
+
+Lemma divide_lcm_r : forall a b, (b | lcm a b).
+Proof.
+ unfold lcm. intros a b. apply divide_abs_r. rewrite <- gcd_div_swap.
+ apply divide_factor_r.
+Qed.
+
+Lemma divide_div : forall a b c, a~=0 -> (a|b) -> (b|c) -> (b/a|c/a).
+Proof.
+ intros a b c Ha Hb (c',Hc). exists c'.
+ now rewrite <- divide_div_mul_exact, <- Hc.
+Qed.
+
+Lemma lcm_least : forall a b c,
+ (a | c) -> (b | c) -> (lcm a b | c).
+Proof.
+ intros a b c Ha Hb. unfold lcm. apply divide_abs_l.
+ destruct (eq_decidable (gcd a b) 0) as [EQ|NEQ].
+ apply gcd_eq_0 in EQ. destruct EQ as (EQ,EQ'). rewrite EQ in *. now nzsimpl.
+ assert (Ga := gcd_divide_l a b).
+ assert (Gb := gcd_divide_r a b).
+ set (g:=gcd a b) in *.
+ assert (Ha' := divide_div g a c NEQ Ga Ha).
+ assert (Hb' := divide_div g b c NEQ Gb Hb).
+ destruct Ha' as (a',Ha'). rewrite Ha', mul_comm in Hb'.
+ apply gauss in Hb'; [|apply gcd_div_gcd; unfold g; trivial using gcd_comm].
+ destruct Hb' as (b',Hb').
+ exists b'.
+ rewrite mul_shuffle3, <- Hb'.
+ rewrite (proj2 (div_exact c g NEQ)).
+ rewrite Ha', mul_shuffle3, (mul_comm a a'). f_equiv.
+ symmetry. apply div_exact; trivial.
+ apply mod_divide; trivial.
+ apply mod_divide; trivial. transitivity a; trivial.
+Qed.
+
+Lemma lcm_nonneg : forall a b, 0 <= lcm a b.
+Proof.
+ intros a b. unfold lcm. apply abs_nonneg.
+Qed.
+
+Lemma lcm_comm : forall a b, lcm a b == lcm b a.
+Proof.
+ intros a b. unfold lcm. rewrite (gcd_comm b), (mul_comm b).
+ now rewrite <- gcd_div_swap.
+Qed.
+
+Lemma lcm_divide_iff : forall n m p,
+  (lcm n m | p) <-> (n | p) /\ (m | p).
+Proof.
+ intros. split. split.
+ transitivity (lcm n m); trivial using divide_lcm_l.
+ transitivity (lcm n m); trivial using divide_lcm_r.
+ intros (H,H'). now apply lcm_least.
+Qed.
+
+Lemma lcm_unique : forall n m p,
+ 0<=p -> (n|p) -> (m|p) ->
+ (forall q, (n|q) -> (m|q) -> (p|q)) ->
+ lcm n m == p.
+Proof.
+ intros n m p Hp Hn Hm H.
+ apply divide_antisym_nonneg; trivial. apply lcm_nonneg.
+ now apply lcm_least.
+ apply H. apply divide_lcm_l. apply divide_lcm_r.
+Qed.
+
+Lemma lcm_unique_alt : forall n m p, 0<=p ->
+ (forall q, (p|q) <-> (n|q) /\ (m|q)) ->
+ lcm n m == p.
+Proof.
+ intros n m p Hp H.
+ apply lcm_unique; trivial.
+ apply H, divide_refl.
+ apply H, divide_refl.
+ intros. apply H. now split.
+Qed.
+
+Lemma lcm_assoc : forall n m p, lcm n (lcm m p) == lcm (lcm n m) p.
+Proof.
+ intros. apply lcm_unique_alt; try apply lcm_nonneg.
+ intros. now rewrite !lcm_divide_iff, and_assoc.
+Qed.
+
+Lemma lcm_0_l : forall n, lcm 0 n == 0.
+Proof.
+ intros. apply lcm_unique; trivial. order.
+ apply divide_refl.
+ apply divide_0_r.
+Qed.
+
+Lemma lcm_0_r : forall n, lcm n 0 == 0.
+Proof.
+ intros. now rewrite lcm_comm, lcm_0_l.
+Qed.
+
+Lemma lcm_1_l_nonneg : forall n, 0<=n -> lcm 1 n == n.
+Proof.
+ intros. apply lcm_unique; trivial using divide_1_l, le_0_1, divide_refl.
+Qed.
+
+Lemma lcm_1_r_nonneg : forall n, 0<=n -> lcm n 1 == n.
+Proof.
+ intros. now rewrite lcm_comm, lcm_1_l_nonneg.
+Qed.
+
+Lemma lcm_diag_nonneg : forall n, 0<=n -> lcm n n == n.
+Proof.
+ intros. apply lcm_unique; trivial using divide_refl.
+Qed.
+
+Lemma lcm_eq_0 : forall n m, lcm n m == 0 <-> n == 0 \/ m == 0.
+Proof.
+ intros. split.
+ intros EQ.
+ apply eq_mul_0.
+ apply divide_0_l. rewrite <- EQ. apply lcm_least.
+  apply divide_factor_l. apply divide_factor_r.
+ destruct 1 as [EQ|EQ]; rewrite EQ. apply lcm_0_l. apply lcm_0_r.
+Qed.
+
+Lemma divide_lcm_eq_r : forall n m, 0<=m -> (n|m) -> lcm n m == m.
+Proof.
+ intros n m Hm H. apply lcm_unique_alt; trivial.
+ intros q. split. split; trivial. now transitivity m.
+ now destruct 1.
+Qed.
+
+Lemma divide_lcm_iff : forall n m, 0<=m -> ((n|m) <-> lcm n m == m).
+Proof.
+ intros n m Hn. split. now apply divide_lcm_eq_r.
+ intros EQ. rewrite <- EQ. apply divide_lcm_l.
+Qed.
+
+Lemma lcm_opp_l : forall n m, lcm (-n) m == lcm n m.
+Proof.
+ intros. apply lcm_unique_alt; try apply lcm_nonneg.
+ intros. rewrite divide_opp_l. apply lcm_divide_iff.
+Qed.
+
+Lemma lcm_opp_r : forall n m, lcm n (-m) == lcm n m.
+Proof.
+ intros. now rewrite lcm_comm, lcm_opp_l, lcm_comm.
+Qed.
+
+Lemma lcm_abs_l : forall n m, lcm (abs n) m == lcm n m.
+Proof.
+ intros. destruct (abs_eq_or_opp n) as [H|H]; rewrite H.
+ easy. apply lcm_opp_l.
+Qed.
+
+Lemma lcm_abs_r : forall n m, lcm n (abs m) == lcm n m.
+Proof.
+ intros. now rewrite lcm_comm, lcm_abs_l, lcm_comm.
+Qed.
+
+Lemma lcm_1_l : forall n, lcm 1 n == abs n.
+Proof.
+ intros. rewrite <- lcm_abs_r. apply lcm_1_l_nonneg, abs_nonneg.
+Qed.
+
+Lemma lcm_1_r : forall n, lcm n 1 == abs n.
+Proof.
+ intros. now rewrite lcm_comm, lcm_1_l.
+Qed.
+
+Lemma lcm_diag : forall n, lcm n n == abs n.
+Proof.
+ intros. rewrite <- lcm_abs_l, <- lcm_abs_r.
+ apply lcm_diag_nonneg, abs_nonneg.
+Qed.
+
+Lemma lcm_mul_mono_l :
+  forall n m p, lcm (p * n) (p * m) == abs p * lcm n m.
+Proof.
+ intros n m p.
+ destruct (eq_decidable p 0) as [Hp|Hp].
+  rewrite Hp. nzsimpl. rewrite lcm_0_l, abs_0. now nzsimpl.
+ destruct (eq_decidable (gcd n m) 0) as [Hg|Hg].
+  apply gcd_eq_0 in Hg. destruct Hg as (Hn,Hm); rewrite Hn, Hm.
+  nzsimpl. rewrite lcm_0_l. now nzsimpl.
+ unfold lcm.
+ rewrite gcd_mul_mono_l.
+ rewrite !abs_mul, mul_assoc. f_equiv.
+ rewrite <- (abs_sgn p) at 1. rewrite <- mul_assoc.
+ rewrite div_mul_cancel_l; trivial.
+ rewrite divide_div_mul_exact; trivial. rewrite abs_mul.
+ rewrite <- (sgn_abs (sgn p)), sgn_sgn.
+ destruct (sgn_spec p) as [(_,EQ)|[(EQ,_)|(_,EQ)]].
+  rewrite EQ. now nzsimpl. order.
+  rewrite EQ. rewrite mul_opp_l, mul_opp_r, opp_involutive. now nzsimpl.
+ apply gcd_divide_r.
+ contradict Hp. now apply abs_0_iff.
+Qed.
+
+Lemma lcm_mul_mono_l_nonneg :
+ forall n m p, 0<=p -> lcm (p*n) (p*m) == p * lcm n m.
+Proof.
+ intros. rewrite <- (abs_eq p) at 3; trivial. apply lcm_mul_mono_l.
+Qed.
+
+Lemma lcm_mul_mono_r :
+ forall n m p, lcm (n * p) (m * p) == lcm n m * abs p.
+Proof.
+ intros n m p. now rewrite !(mul_comm _ p), lcm_mul_mono_l, mul_comm.
+Qed.
+
+Lemma lcm_mul_mono_r_nonneg :
+ forall n m p, 0<=p -> lcm (n*p) (m*p) == lcm n m * p.
+Proof.
+ intros. rewrite <- (abs_eq p) at 3; trivial. apply lcm_mul_mono_r.
+Qed.
+
+Lemma gcd_1_lcm_mul : forall n m, n~=0 -> m~=0 ->
+ (gcd n m == 1 <-> lcm n m == abs (n*m)).
+Proof.
+ intros n m Hn Hm. split; intros H.
+ unfold lcm. rewrite H. now rewrite div_1_r.
+ unfold lcm in *.
+ rewrite !abs_mul in H. apply mul_cancel_l in H; [|now rewrite abs_0_iff].
+ assert (H' := gcd_divide_r n m).
+ assert (Hg : gcd n m ~= 0) by (red; rewrite gcd_eq_0; destruct 1; order).
+ apply mod_divide in H'; trivial. apply div_exact in H'; trivial.
+ assert (m / gcd n m ~=0) by (contradict Hm; rewrite H', Hm; now nzsimpl).
+ rewrite <- (mul_1_l (abs (_/_))) in H.
+ rewrite H' in H at 3. rewrite abs_mul in H.
+ apply mul_cancel_r in H; [|now rewrite abs_0_iff].
+ rewrite abs_eq in H. order. apply gcd_nonneg.
+Qed.
+
+End ZLcmProp.
diff --git a/theories/Numbers/Integer/Abstract/ZLt.v b/theories/Numbers/Integer/Abstract/ZLt.v
index 57be0f0e..96be5811 100644
--- a/theories/Numbers/Integer/Abstract/ZLt.v
+++ b/theories/Numbers/Integer/Abstract/ZLt.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,12 +8,10 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: ZLt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export ZMul.
 
-Module ZOrderPropFunct (Import Z : ZAxiomsSig').
-Include ZMulPropFunct Z.
+Module ZOrderProp (Import Z : ZAxiomsMiniSig').
+Include ZMulProp Z.
 
 (** Instances of earlier theorems for m == 0 *)
 
@@ -70,12 +68,12 @@ Qed.
 
 Theorem lt_lt_pred : forall n m, n < m -> P n < m.
 Proof.
-intros; apply <- lt_pred_le; now apply lt_le_incl.
+intros; apply lt_pred_le; now apply lt_le_incl.
 Qed.
 
 Theorem le_le_pred : forall n m, n <= m -> P n <= m.
 Proof.
-intros; apply lt_le_incl; now apply <- lt_pred_le.
+intros; apply lt_le_incl; now apply lt_pred_le.
 Qed.
 
 Theorem lt_pred_lt : forall n m, n < P m -> n < m.
@@ -85,7 +83,7 @@ Qed.
 
 Theorem le_pred_lt : forall n m, n <= P m -> n <= m.
 Proof.
-intros; apply lt_le_incl; now apply <- lt_le_pred.
+intros; apply lt_le_incl; now apply lt_le_pred.
 Qed.
 
 Theorem pred_lt_mono : forall n m, n < m <-> P n < P m.
@@ -123,12 +121,12 @@ Proof.
 intro; apply lt_neq; apply lt_pred_l.
 Qed.
 
-Theorem lt_n1_r : forall n m, n < m -> m < 0 -> n < -(1).
+Theorem lt_m1_r : forall n m, n < m -> m < 0 -> n < -1.
 Proof.
-intros n m H1 H2. apply -> lt_le_pred in H2.
-setoid_replace (P 0) with (-(1)) in H2. now apply lt_le_trans with m.
-apply <- eq_opp_r. now rewrite opp_pred, opp_0.
+intros n m H1 H2. apply lt_le_pred in H2.
+setoid_replace (P 0) with (-1) in H2. now apply lt_le_trans with m.
+apply eq_opp_r. now rewrite one_succ, opp_pred, opp_0.
 Qed.
 
-End ZOrderPropFunct.
+End ZOrderProp.
 
diff --git a/theories/Numbers/Integer/Abstract/ZMaxMin.v b/theories/Numbers/Integer/Abstract/ZMaxMin.v
new file mode 100644
index 00000000..dc7598e3
--- /dev/null
+++ b/theories/Numbers/Integer/Abstract/ZMaxMin.v
@@ -0,0 +1,179 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import ZAxioms ZMulOrder GenericMinMax.
+
+(** * Properties of minimum and maximum specific to integer numbers *)
+
+Module Type ZMaxMinProp (Import Z : ZAxiomsMiniSig').
+Include ZMulOrderProp Z.
+
+(** The following results are concrete instances of [max_monotone]
+    and similar lemmas. *)
+
+(** Succ *)
+
+Lemma succ_max_distr : forall n m, S (max n m) == max (S n) (S m).
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?succ_le_mono.
+Qed.
+
+Lemma succ_min_distr : forall n m, S (min n m) == min (S n) (S m).
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?succ_le_mono.
+Qed.
+
+(** Pred *)
+
+Lemma pred_max_distr : forall n m, P (max n m) == max (P n) (P m).
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?pred_le_mono.
+Qed.
+
+Lemma pred_min_distr : forall n m, P (min n m) == min (P n) (P m).
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?pred_le_mono.
+Qed.
+
+(** Add *)
+
+Lemma add_max_distr_l : forall n m p, max (p + n) (p + m) == p + max n m.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?add_le_mono_l.
+Qed.
+
+Lemma add_max_distr_r : forall n m p, max (n + p) (m + p) == max n m + p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?add_le_mono_r.
+Qed.
+
+Lemma add_min_distr_l : forall n m p, min (p + n) (p + m) == p + min n m.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?add_le_mono_l.
+Qed.
+
+Lemma add_min_distr_r : forall n m p, min (n + p) (m + p) == min n m + p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?add_le_mono_r.
+Qed.
+
+(** Opp *)
+
+Lemma opp_max_distr : forall n m, -(max n m) == min (-n) (-m).
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite max_r by trivial. symmetry. apply min_r. now rewrite <- opp_le_mono.
+ rewrite max_l by trivial. symmetry. apply min_l. now rewrite <- opp_le_mono.
+Qed.
+
+Lemma opp_min_distr : forall n m, -(min n m) == max (-n) (-m).
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite min_l by trivial. symmetry. apply max_l. now rewrite <- opp_le_mono.
+ rewrite min_r by trivial. symmetry. apply max_r. now rewrite <- opp_le_mono.
+Qed.
+
+(** Sub *)
+
+Lemma sub_max_distr_l : forall n m p, max (p - n) (p - m) == p - min n m.
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite min_l by trivial. apply max_l. now rewrite <- sub_le_mono_l.
+ rewrite min_r by trivial. apply max_r. now rewrite <- sub_le_mono_l.
+Qed.
+
+Lemma sub_max_distr_r : forall n m p, max (n - p) (m - p) == max n m - p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply sub_le_mono_r.
+Qed.
+
+Lemma sub_min_distr_l : forall n m p, min (p - n) (p - m) == p - max n m.
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite max_r by trivial. apply min_r. now rewrite <- sub_le_mono_l.
+ rewrite max_l by trivial. apply min_l. now rewrite <- sub_le_mono_l.
+Qed.
+
+Lemma sub_min_distr_r : forall n m p, min (n - p) (m - p) == min n m - p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply sub_le_mono_r.
+Qed.
+
+(** Mul *)
+
+Lemma mul_max_distr_nonneg_l : forall n m p, 0 <= p ->
+ max (p * n) (p * m) == p * max n m.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply mul_le_mono_nonneg_l.
+Qed.
+
+Lemma mul_max_distr_nonneg_r : forall n m p, 0 <= p ->
+ max (n * p) (m * p) == max n m * p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply mul_le_mono_nonneg_r.
+Qed.
+
+Lemma mul_min_distr_nonneg_l : forall n m p, 0 <= p ->
+ min (p * n) (p * m) == p * min n m.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply mul_le_mono_nonneg_l.
+Qed.
+
+Lemma mul_min_distr_nonneg_r : forall n m p, 0 <= p ->
+ min (n * p) (m * p) == min n m * p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply mul_le_mono_nonneg_r.
+Qed.
+
+Lemma mul_max_distr_nonpos_l : forall n m p, p <= 0 ->
+ max (p * n) (p * m) == p * min n m.
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite min_l by trivial. rewrite max_l. reflexivity. now apply mul_le_mono_nonpos_l.
+ rewrite min_r by trivial. rewrite max_r. reflexivity. now apply mul_le_mono_nonpos_l.
+Qed.
+
+Lemma mul_max_distr_nonpos_r : forall n m p, p <= 0 ->
+ max (n * p) (m * p) == min n m * p.
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite min_l by trivial. rewrite max_l. reflexivity. now apply mul_le_mono_nonpos_r.
+ rewrite min_r by trivial. rewrite max_r. reflexivity. now apply mul_le_mono_nonpos_r.
+Qed.
+
+Lemma mul_min_distr_nonpos_l : forall n m p, p <= 0 ->
+ min (p * n) (p * m) == p * max n m.
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite max_r by trivial. rewrite min_r. reflexivity. now apply mul_le_mono_nonpos_l.
+ rewrite max_l by trivial. rewrite min_l. reflexivity. now apply mul_le_mono_nonpos_l.
+Qed.
+
+Lemma mul_min_distr_nonpos_r : forall n m p, p <= 0 ->
+ min (n * p) (m * p) == max n m * p.
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite max_r by trivial. rewrite min_r. reflexivity. now apply mul_le_mono_nonpos_r.
+ rewrite max_l by trivial. rewrite min_l. reflexivity. now apply mul_le_mono_nonpos_r.
+Qed.
+
+End ZMaxMinProp.
diff --git a/theories/Numbers/Integer/Abstract/ZMul.v b/theories/Numbers/Integer/Abstract/ZMul.v
index 83dc0e10..c5fbd450 100644
--- a/theories/Numbers/Integer/Abstract/ZMul.v
+++ b/theories/Numbers/Integer/Abstract/ZMul.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,12 +8,10 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: ZMul.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export ZAdd.
 
-Module ZMulPropFunct (Import Z : ZAxiomsSig').
-Include ZAddPropFunct Z.
+Module ZMulProp (Import Z : ZAxiomsMiniSig').
+Include ZAddProp Z.
 
 (** A note on naming: right (correspondingly, left) distributivity
     happens when the sum is multiplied by a number on the right
@@ -41,7 +39,7 @@ Qed.
 
 Theorem mul_opp_l : forall n m, (- n) * m == - (n * m).
 Proof.
-intros n m. apply -> add_move_0_r.
+intros n m. apply add_move_0_r.
 now rewrite <- mul_add_distr_r, add_opp_diag_l, mul_0_l.
 Qed.
 
@@ -55,6 +53,11 @@ Proof.
 intros n m; now rewrite mul_opp_l, mul_opp_r, opp_involutive.
 Qed.
 
+Theorem mul_opp_comm : forall n m, (- n) * m == n * (- m).
+Proof.
+intros n m. now rewrite mul_opp_l, <- mul_opp_r.
+Qed.
+
 Theorem mul_sub_distr_l : forall n m p, n * (m - p) == n * m - n * p.
 Proof.
 intros n m p. do 2 rewrite <- add_opp_r. rewrite mul_add_distr_l.
@@ -67,6 +70,6 @@ intros n m p; rewrite (mul_comm (n - m) p), (mul_comm n p), (mul_comm m p);
 now apply mul_sub_distr_l.
 Qed.
 
-End ZMulPropFunct.
+End ZMulProp.
 
 
diff --git a/theories/Numbers/Integer/Abstract/ZMulOrder.v b/theories/Numbers/Integer/Abstract/ZMulOrder.v
index 06a5d168..8edf97f4 100644
--- a/theories/Numbers/Integer/Abstract/ZMulOrder.v
+++ b/theories/Numbers/Integer/Abstract/ZMulOrder.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,14 +8,10 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: ZMulOrder.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export ZAddOrder.
 
-Module Type ZMulOrderPropFunct (Import Z : ZAxiomsSig').
-Include ZAddOrderPropFunct Z.
-
-Local Notation "- 1" := (-(1)).
+Module Type ZMulOrderProp (Import Z : ZAxiomsMiniSig').
+Include ZAddOrderProp Z.
 
 Theorem mul_lt_mono_nonpos :
   forall n m p q, m <= 0 -> n < m -> q <= 0 -> p < q ->  m * q < n * p.
@@ -94,18 +90,11 @@ Qed.
 
 Notation mul_nonpos := le_mul_0 (only parsing).
 
-Theorem le_0_square : forall n, 0 <= n * n.
-Proof.
-intro n; destruct (neg_nonneg_cases n).
-apply lt_le_incl; now apply mul_neg_neg.
-now apply mul_nonneg_nonneg.
-Qed.
-
-Notation square_nonneg := le_0_square (only parsing).
+Notation le_0_square := square_nonneg (only parsing).
 
 Theorem nlt_square_0 : forall n, ~ n * n < 0.
 Proof.
-intros n H. apply -> lt_nge in H. apply H. apply square_nonneg.
+intros n H. apply lt_nge in H. apply H. apply square_nonneg.
 Qed.
 
 Theorem square_lt_mono_nonpos : forall n m, n <= 0 -> m < n -> n * n < m * m.
@@ -120,42 +109,38 @@ Qed.
 
 Theorem square_lt_simpl_nonpos : forall n m, m <= 0 -> n * n < m * m -> m < n.
 Proof.
-intros n m H1 H2. destruct (le_gt_cases n 0).
-destruct (lt_ge_cases m n).
-assumption. assert (F : m * m <= n * n) by now apply square_le_mono_nonpos.
-apply -> le_ngt in F. false_hyp H2 F.
-now apply le_lt_trans with 0.
+intros n m H1 H2. destruct (le_gt_cases n 0); [|order].
+destruct (lt_ge_cases m n) as [LE|GT]; trivial.
+apply square_le_mono_nonpos in GT; order.
 Qed.
 
 Theorem square_le_simpl_nonpos : forall n m, m <= 0 -> n * n <= m * m -> m <= n.
 Proof.
-intros n m H1 H2. destruct (le_gt_cases n 0).
-destruct (le_gt_cases m n).
-assumption. assert (F : m * m < n * n) by now apply square_lt_mono_nonpos.
-apply -> lt_nge in F. false_hyp H2 F.
-apply lt_le_incl; now apply le_lt_trans with 0.
+intros n m H1 H2. destruct (le_gt_cases n 0); [|order].
+destruct (le_gt_cases m n) as [LE|GT]; trivial.
+apply square_lt_mono_nonpos in GT; order.
 Qed.
 
 Theorem lt_1_mul_neg : forall n m, n < -1 -> m < 0 -> 1 < n * m.
 Proof.
-intros n m H1 H2. apply -> (mul_lt_mono_neg_r m) in H1.
-apply <- opp_pos_neg in H2. rewrite mul_opp_l, mul_1_l in H1.
+intros n m H1 H2. apply (mul_lt_mono_neg_r m) in H1.
+apply opp_pos_neg in H2. rewrite mul_opp_l, mul_1_l in H1.
 now apply lt_1_l with (- m).
 assumption.
 Qed.
 
-Theorem lt_mul_n1_neg : forall n m, 1 < n -> m < 0 -> n * m < -1.
+Theorem lt_mul_m1_neg : forall n m, 1 < n -> m < 0 -> n * m < -1.
 Proof.
-intros n m H1 H2. apply -> (mul_lt_mono_neg_r m) in H1.
-rewrite mul_1_l in H1. now apply lt_n1_r with m.
+intros n m H1 H2. apply (mul_lt_mono_neg_r m) in H1.
+rewrite mul_1_l in H1. now apply lt_m1_r with m.
 assumption.
 Qed.
 
-Theorem lt_mul_n1_pos : forall n m, n < -1 -> 0 < m -> n * m < -1.
+Theorem lt_mul_m1_pos : forall n m, n < -1 -> 0 < m -> n * m < -1.
 Proof.
-intros n m H1 H2. apply -> (mul_lt_mono_pos_r m) in H1.
+intros n m H1 H2. apply (mul_lt_mono_pos_r m) in H1.
 rewrite mul_opp_l, mul_1_l in H1.
-apply <- opp_neg_pos in H2. now apply lt_n1_r with (- m).
+apply opp_neg_pos in H2. now apply lt_m1_r with (- m).
 assumption.
 Qed.
 
@@ -163,39 +148,33 @@ Theorem lt_1_mul_l : forall n m, 1 < n ->
  n * m < -1 \/ n * m == 0 \/ 1 < n * m.
 Proof.
 intros n m H; destruct (lt_trichotomy m 0) as [H1 | [H1 | H1]].
-left. now apply lt_mul_n1_neg.
+left. now apply lt_mul_m1_neg.
 right; left; now rewrite H1, mul_0_r.
 right; right; now apply lt_1_mul_pos.
 Qed.
 
-Theorem lt_n1_mul_r : forall n m, n < -1 ->
+Theorem lt_m1_mul_r : forall n m, n < -1 ->
  n * m < -1 \/ n * m == 0 \/ 1 < n * m.
 Proof.
 intros n m H; destruct (lt_trichotomy m 0) as [H1 | [H1 | H1]].
 right; right. now apply lt_1_mul_neg.
 right; left; now rewrite H1, mul_0_r.
-left. now apply lt_mul_n1_pos.
+left. now apply lt_mul_m1_pos.
 Qed.
 
 Theorem eq_mul_1 : forall n m, n * m == 1 -> n == 1 \/ n == -1.
 Proof.
-assert (F : ~ 1 < -1).
-intro H.
-assert (H1 : -1 < 0). apply <- opp_neg_pos. apply lt_succ_diag_r.
-assert (H2 : 1 < 0) by now apply lt_trans with (-1).
-false_hyp H2 nlt_succ_diag_l.
+assert (F := lt_m1_0).
 zero_pos_neg n.
-intros m H; rewrite mul_0_l in H; false_hyp H neq_succ_diag_r.
-intros n H; split; apply <- le_succ_l in H; le_elim H.
-intros m H1; apply (lt_1_mul_l n m) in H.
-rewrite H1 in H; destruct H as [H | [H | H]].
-false_hyp H F. false_hyp H neq_succ_diag_l. false_hyp H lt_irrefl.
-intros; now left.
-intros m H1; apply (lt_1_mul_l n m) in H. rewrite mul_opp_l in H1;
-apply -> eq_opp_l in H1. rewrite H1 in H; destruct H as [H | [H | H]].
-false_hyp H lt_irrefl. apply -> eq_opp_l in H. rewrite opp_0 in H.
-false_hyp H neq_succ_diag_l. false_hyp H F.
-intros; right; symmetry; now apply opp_wd.
+(* n = 0 *)
+intros m. nzsimpl. now left.
+(* 0 < n, proving P n /\ P (-n) *)
+intros n Hn. rewrite <- le_succ_l, <- one_succ in Hn.
+le_elim Hn; split; intros m H.
+destruct (lt_1_mul_l n m) as [|[|]]; order'.
+rewrite mul_opp_l, eq_opp_l in H. destruct (lt_1_mul_l n m) as [|[|]]; order'.
+now left.
+intros; right. now f_equiv.
 Qed.
 
 Theorem lt_mul_diag_l : forall n m, n < 0 -> (1 < m <-> n * m < n).
@@ -229,5 +208,9 @@ apply mul_lt_mono_nonneg.
 now apply lt_le_incl. assumption. apply le_0_1. assumption.
 Qed.
 
-End ZMulOrderPropFunct.
+(** Alternative name : *)
+
+Definition mul_eq_1 := eq_mul_1.
+
+End ZMulOrderProp.
 
diff --git a/theories/Numbers/Integer/Abstract/ZParity.v b/theories/Numbers/Integer/Abstract/ZParity.v
new file mode 100644
index 00000000..13541309
--- /dev/null
+++ b/theories/Numbers/Integer/Abstract/ZParity.v
@@ -0,0 +1,52 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Bool ZMulOrder NZParity.
+
+(** Some more properties of [even] and [odd]. *)
+
+Module Type ZParityProp (Import Z : ZAxiomsSig')
+                        (Import ZP : ZMulOrderProp Z).
+
+Include NZParityProp Z Z ZP.
+
+Lemma odd_pred : forall n, odd (P n) = even n.
+Proof.
+ intros. rewrite <- (succ_pred n) at 2. symmetry. apply even_succ.
+Qed.
+
+Lemma even_pred : forall n, even (P n) = odd n.
+Proof.
+ intros. rewrite <- (succ_pred n) at 2. symmetry. apply odd_succ.
+Qed.
+
+Lemma even_opp : forall n, even (-n) = even n.
+Proof.
+ assert (H : forall n, Even n -> Even (-n)).
+  intros n (m,H). exists (-m). rewrite mul_opp_r. now f_equiv.
+ intros. rewrite eq_iff_eq_true, !even_spec.
+ split. rewrite <- (opp_involutive n) at 2. apply H.
+ apply H.
+Qed.
+
+Lemma odd_opp : forall n, odd (-n) = odd n.
+Proof.
+ intros. rewrite <- !negb_even. now rewrite even_opp.
+Qed.
+
+Lemma even_sub : forall n m, even (n-m) = Bool.eqb (even n) (even m).
+Proof.
+ intros. now rewrite <- add_opp_r, even_add, even_opp.
+Qed.
+
+Lemma odd_sub : forall n m, odd (n-m) = xorb (odd n) (odd m).
+Proof.
+ intros. now rewrite <- add_opp_r, odd_add, odd_opp.
+Qed.
+
+End ZParityProp.
diff --git a/theories/Numbers/Integer/Abstract/ZPow.v b/theories/Numbers/Integer/Abstract/ZPow.v
new file mode 100644
index 00000000..d30cea33
--- /dev/null
+++ b/theories/Numbers/Integer/Abstract/ZPow.v
@@ -0,0 +1,135 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Properties of the power function *)
+
+Require Import Bool ZAxioms ZMulOrder ZParity ZSgnAbs NZPow.
+
+Module Type ZPowProp
+ (Import A : ZAxiomsSig')
+ (Import B : ZMulOrderProp A)
+ (Import C : ZParityProp A B)
+ (Import D : ZSgnAbsProp A B).
+
+ Include NZPowProp A A B.
+
+(** A particular case of [pow_add_r], with no precondition *)
+
+Lemma pow_twice_r a b : a^(2*b) == a^b * a^b.
+Proof.
+ rewrite two_succ. nzsimpl.
+ destruct (le_gt_cases 0 b).
+ - now rewrite pow_add_r.
+ - rewrite !pow_neg_r. now nzsimpl. trivial.
+   now apply add_neg_neg.
+Qed.
+
+(** Parity of power *)
+
+Lemma even_pow : forall a b, 0<b -> even (a^b) = even a.
+Proof.
+ intros a b Hb. apply lt_ind with (4:=Hb). solve_proper.
+ now nzsimpl.
+ clear b Hb. intros b Hb IH. nzsimpl; [|order].
+ rewrite even_mul, IH. now destruct (even a).
+Qed.
+
+Lemma odd_pow : forall a b, 0<b -> odd (a^b) = odd a.
+Proof.
+ intros. now rewrite <- !negb_even, even_pow.
+Qed.
+
+(** Properties of power of negative numbers *)
+
+Lemma pow_opp_even : forall a b, Even b -> (-a)^b == a^b.
+Proof.
+ intros a b (c,H). rewrite H.
+ destruct (le_gt_cases 0 c).
+ rewrite 2 pow_mul_r by order'.
+ rewrite 2 pow_2_r.
+ now rewrite mul_opp_opp.
+ assert (2*c < 0) by (apply mul_pos_neg; order').
+ now rewrite !pow_neg_r.
+Qed.
+
+Lemma pow_opp_odd : forall a b, Odd b -> (-a)^b == -(a^b).
+Proof.
+ intros a b (c,H). rewrite H.
+ destruct (le_gt_cases 0 c) as [LE|GT].
+ assert (0 <= 2*c) by (apply mul_nonneg_nonneg; order').
+ rewrite add_1_r, !pow_succ_r; trivial.
+ rewrite pow_opp_even by (now exists c).
+ apply mul_opp_l.
+ apply double_above in GT. rewrite mul_0_r in GT.
+ rewrite !pow_neg_r by trivial. now rewrite opp_0.
+Qed.
+
+Lemma pow_even_abs : forall a b, Even b -> a^b == (abs a)^b.
+Proof.
+ intros. destruct (abs_eq_or_opp a) as [EQ|EQ]; rewrite EQ.
+ reflexivity.
+ symmetry. now apply pow_opp_even.
+Qed.
+
+Lemma pow_even_nonneg : forall a b, Even b -> 0 <= a^b.
+Proof.
+ intros. rewrite pow_even_abs by trivial.
+ apply pow_nonneg, abs_nonneg.
+Qed.
+
+Lemma pow_odd_abs_sgn : forall a b, Odd b -> a^b == sgn a * (abs a)^b.
+Proof.
+ intros a b H.
+ destruct (sgn_spec a) as [(LT,EQ)|[(EQ',EQ)|(LT,EQ)]]; rewrite EQ.
+ nzsimpl.
+ rewrite abs_eq; order.
+ rewrite <- EQ'. nzsimpl.
+ destruct (le_gt_cases 0 b).
+ apply pow_0_l.
+ assert (b~=0) by (contradict H; now rewrite H, <-odd_spec, odd_0).
+ order.
+ now rewrite pow_neg_r.
+ rewrite abs_neq by order.
+ rewrite pow_opp_odd; trivial.
+ now rewrite mul_opp_opp, mul_1_l.
+Qed.
+
+Lemma pow_odd_sgn : forall a b, 0<=b -> Odd b -> sgn (a^b) == sgn a.
+Proof.
+ intros a b Hb H.
+ destruct (sgn_spec a) as [(LT,EQ)|[(EQ',EQ)|(LT,EQ)]]; rewrite EQ.
+ apply sgn_pos. apply pow_pos_nonneg; trivial.
+ rewrite <- EQ'. rewrite pow_0_l. apply sgn_0.
+ assert (b~=0) by (contradict H; now rewrite H, <-odd_spec, odd_0).
+ order.
+ apply sgn_neg.
+ rewrite <- (opp_involutive a). rewrite pow_opp_odd by trivial.
+ apply opp_neg_pos.
+ apply pow_pos_nonneg; trivial.
+ now apply opp_pos_neg.
+Qed.
+
+Lemma abs_pow : forall a b, abs (a^b) == (abs a)^b.
+Proof.
+ intros a b.
+ destruct (Even_or_Odd b).
+ rewrite pow_even_abs by trivial.
+ apply abs_eq, pow_nonneg, abs_nonneg.
+ rewrite pow_odd_abs_sgn by trivial.
+ rewrite abs_mul.
+ destruct (lt_trichotomy 0 a) as [Ha|[Ha|Ha]].
+ rewrite (sgn_pos a), (abs_eq 1), mul_1_l by order'.
+ apply abs_eq, pow_nonneg, abs_nonneg.
+ rewrite <- Ha, sgn_0, abs_0, mul_0_l.
+ symmetry. apply pow_0_l'. intro Hb. rewrite Hb in H.
+ apply (Even_Odd_False 0); trivial. exists 0; now nzsimpl.
+ rewrite (sgn_neg a), abs_opp, (abs_eq 1), mul_1_l by order'.
+ apply abs_eq, pow_nonneg, abs_nonneg.
+Qed.
+
+End ZPowProp.
diff --git a/theories/Numbers/Integer/Abstract/ZProperties.v b/theories/Numbers/Integer/Abstract/ZProperties.v
index ae7c3209..8973df35 100644
--- a/theories/Numbers/Integer/Abstract/ZProperties.v
+++ b/theories/Numbers/Integer/Abstract/ZProperties.v
@@ -1,24 +1,19 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ZProperties.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+Require Export ZAxioms ZMaxMin ZSgnAbs ZParity ZPow ZDivTrunc ZDivFloor
+ ZGcd ZLcm NZLog NZSqrt ZBits.
 
-Require Export ZAxioms ZMulOrder ZSgnAbs.
-
-(** This functor summarizes all known facts about Z.
-    For the moment it is only an alias to [ZMulOrderPropFunct], which
-    subsumes all others, plus properties of [sgn] and [abs].
-*)
-
-Module Type ZPropSig (Z:ZAxiomsExtSig) :=
- ZMulOrderPropFunct Z <+ ZSgnAbsPropSig Z.
-
-Module ZPropFunct (Z:ZAxiomsExtSig) <: ZPropSig Z.
- Include ZPropSig Z.
-End ZPropFunct.
+(** This functor summarizes all known facts about Z. *)
 
+Module Type ZProp (Z:ZAxiomsSig) :=
+ ZMaxMinProp Z <+ ZSgnAbsProp Z <+ ZParityProp Z <+ ZPowProp Z
+ <+ NZSqrtProp Z Z <+ NZSqrtUpProp Z Z
+ <+ NZLog2Prop Z Z Z <+ NZLog2UpProp Z Z Z
+ <+ ZDivProp Z <+ ZQuotProp Z <+ ZGcdProp Z <+ ZLcmProp Z
+ <+ ZBitsProp Z.
diff --git a/theories/Numbers/Integer/Abstract/ZSgnAbs.v b/theories/Numbers/Integer/Abstract/ZSgnAbs.v
index cecaa6a3..24b6003c 100644
--- a/theories/Numbers/Integer/Abstract/ZSgnAbs.v
+++ b/theories/Numbers/Integer/Abstract/ZSgnAbs.v
@@ -1,25 +1,19 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-Require Export ZMulOrder.
+(** Properties of [abs] and [sgn] *)
 
-(** An axiomatization of [abs]. *)
-
-Module Type HasAbs(Import Z : ZAxiomsSig').
- Parameter Inline abs : t -> t.
- Axiom abs_eq : forall n, 0<=n -> abs n == n.
- Axiom abs_neq : forall n, n<=0 -> abs n == -n.
-End HasAbs.
+Require Import ZMulOrder.
 
 (** Since we already have [max], we could have defined [abs]. *)
 
-Module GenericAbs (Import Z : ZAxiomsSig')
-                  (Import ZP : ZMulOrderPropFunct Z) <: HasAbs Z.
+Module GenericAbs (Import Z : ZAxiomsMiniSig')
+                  (Import ZP : ZMulOrderProp Z) <: HasAbs Z.
  Definition abs n := max n (-n).
  Lemma abs_eq : forall n, 0<=n -> abs n == n.
  Proof.
@@ -35,37 +29,28 @@ Module GenericAbs (Import Z : ZAxiomsSig')
  Qed.
 End GenericAbs.
 
-(** An Axiomatization of [sgn]. *)
-
-Module Type HasSgn (Import Z : ZAxiomsSig').
- Parameter Inline sgn : t -> t.
- Axiom sgn_null : forall n, n==0 -> sgn n == 0.
- Axiom sgn_pos : forall n, 0<n -> sgn n == 1.
- Axiom sgn_neg : forall n, n<0 -> sgn n == -(1).
-End HasSgn.
-
 (** We can deduce a [sgn] function from a [compare] function *)
 
-Module Type ZDecAxiomsSig := ZAxiomsSig <+ HasCompare.
-Module Type ZDecAxiomsSig' := ZAxiomsSig' <+ HasCompare.
+Module Type ZDecAxiomsSig := ZAxiomsMiniSig <+ HasCompare.
+Module Type ZDecAxiomsSig' := ZAxiomsMiniSig' <+ HasCompare.
 
 Module Type GenericSgn (Import Z : ZDecAxiomsSig')
-                       (Import ZP : ZMulOrderPropFunct Z) <: HasSgn Z.
+                       (Import ZP : ZMulOrderProp Z) <: HasSgn Z.
  Definition sgn n :=
-  match compare 0 n with Eq => 0 | Lt => 1 | Gt => -(1) end.
+  match compare 0 n with Eq => 0 | Lt => 1 | Gt => -1 end.
  Lemma sgn_null : forall n, n==0 -> sgn n == 0.
  Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed.
  Lemma sgn_pos : forall n, 0<n -> sgn n == 1.
  Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed.
- Lemma sgn_neg : forall n, n<0 -> sgn n == -(1).
+ Lemma sgn_neg : forall n, n<0 -> sgn n == -1.
  Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed.
 End GenericSgn.
 
-Module Type ZAxiomsExtSig := ZAxiomsSig <+ HasAbs <+ HasSgn.
-Module Type ZAxiomsExtSig' := ZAxiomsSig' <+ HasAbs <+ HasSgn.
 
-Module Type ZSgnAbsPropSig (Import Z : ZAxiomsExtSig')
-                           (Import ZP : ZMulOrderPropFunct Z).
+(** Derived properties of [abs] and [sgn] *)
+
+Module Type ZSgnAbsProp (Import Z : ZAxiomsSig')
+                        (Import ZP : ZMulOrderProp Z).
 
 Ltac destruct_max n :=
  destruct (le_ge_cases 0 n);
@@ -183,6 +168,28 @@ Proof.
  rewrite EQn, EQ, opp_inj_wd, eq_opp_l, or_comm. apply abs_eq_or_opp.
 Qed.
 
+Lemma abs_lt : forall a b, abs a < b <-> -b < a < b.
+Proof.
+ intros a b.
+ destruct (abs_spec a) as [[LE EQ]|[LT EQ]]; rewrite EQ; clear EQ.
+ split; try split; try destruct 1; try order.
+ apply lt_le_trans with 0; trivial. apply opp_neg_pos; order.
+ rewrite opp_lt_mono, opp_involutive.
+ split; try split; try destruct 1; try order.
+ apply lt_le_trans with 0; trivial. apply opp_nonpos_nonneg; order.
+Qed.
+
+Lemma abs_le : forall a b, abs a <= b <-> -b <= a <= b.
+Proof.
+ intros a b.
+ destruct (abs_spec a) as [[LE EQ]|[LT EQ]]; rewrite EQ; clear EQ.
+ split; try split; try destruct 1; try order.
+ apply le_trans with 0; trivial. apply opp_nonpos_nonneg; order.
+ rewrite opp_le_mono, opp_involutive.
+ split; try split; try destruct 1; try order.
+ apply le_trans with 0. order. apply opp_nonpos_nonneg; order.
+Qed.
+
 (** Triangular inequality *)
 
 Lemma abs_triangle : forall n m, abs (n + m) <= abs n + abs m.
@@ -249,7 +256,7 @@ Qed.
 Lemma sgn_spec : forall n,
   0 < n /\ sgn n == 1 \/
   0 == n /\ sgn n == 0 \/
-  0 > n /\ sgn n == -(1).
+  0 > n /\ sgn n == -1.
 Proof.
  intros n.
  destruct_sgn n; [left|right;left|right;right]; auto with relations.
@@ -264,7 +271,7 @@ Lemma sgn_pos_iff : forall n, sgn n == 1 <-> 0<n.
 Proof.
  split; try apply sgn_pos. destruct_sgn n; auto.
  intros. elim (lt_neq 0 1); auto. apply lt_0_1.
- intros. elim (lt_neq (-(1)) 1); auto.
+ intros. elim (lt_neq (-1) 1); auto.
  apply lt_trans with 0. rewrite opp_neg_pos. apply lt_0_1. apply lt_0_1.
 Qed.
 
@@ -272,16 +279,16 @@ Lemma sgn_null_iff : forall n, sgn n == 0 <-> n==0.
 Proof.
  split; try apply sgn_null. destruct_sgn n; auto with relations.
  intros. elim (lt_neq 0 1); auto with relations. apply lt_0_1.
- intros. elim (lt_neq (-(1)) 0); auto.
+ intros. elim (lt_neq (-1) 0); auto.
  rewrite opp_neg_pos. apply lt_0_1.
 Qed.
 
-Lemma sgn_neg_iff : forall n, sgn n == -(1) <-> n<0.
+Lemma sgn_neg_iff : forall n, sgn n == -1 <-> n<0.
 Proof.
  split; try apply sgn_neg. destruct_sgn n; auto with relations.
- intros. elim (lt_neq (-(1)) 1); auto with relations.
+ intros. elim (lt_neq (-1) 1); auto with relations.
  apply lt_trans with 0. rewrite opp_neg_pos. apply lt_0_1. apply lt_0_1.
- intros. elim (lt_neq (-(1)) 0); auto with relations.
+ intros. elim (lt_neq (-1) 0); auto with relations.
  rewrite opp_neg_pos. apply lt_0_1.
 Qed.
 
@@ -343,6 +350,15 @@ Proof.
  rewrite eq_opp_l. apply abs_neq. now apply lt_le_incl.
 Qed.
 
-End ZSgnAbsPropSig.
+Lemma sgn_sgn : forall x, sgn (sgn x) == sgn x.
+Proof.
+ intros.
+ destruct (sgn_spec x) as [(LT,EQ)|[(EQ',EQ)|(LT,EQ)]]; rewrite EQ.
+ apply sgn_pos, lt_0_1.
+ now apply sgn_null.
+ apply sgn_neg. rewrite opp_neg_pos. apply lt_0_1.
+Qed.
+
+End ZSgnAbsProp.
 
 
diff --git a/theories/Numbers/Integer/BigZ/BigZ.v b/theories/Numbers/Integer/BigZ/BigZ.v
index 7df8909f..a56f90b0 100644
--- a/theories/Numbers/Integer/BigZ/BigZ.v
+++ b/theories/Numbers/Integer/BigZ/BigZ.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: BigZ.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export BigN.
 Require Import ZProperties ZDivFloor ZSig ZSigZAxioms ZMake.
 
@@ -21,82 +19,64 @@ Require Import ZProperties ZDivFloor ZSig ZSigZAxioms ZMake.
     - [ZMake.Make BigN] provides the operations and basic specs w.r.t. ZArith
     - [ZTypeIsZAxioms] shows (mainly) that these operations implement
       the interface [ZAxioms]
-    - [ZPropSig] adds all generic properties derived from [ZAxioms]
-    - [ZDivPropFunct] provides generic properties of [div] and [mod]
-      ("Floor" variant)
+    - [ZProp] adds all generic properties derived from [ZAxioms]
     - [MinMax*Properties] provides properties of [min] and [max]
 
 *)
 
+Delimit Scope bigZ_scope with bigZ.
 
-Module BigZ <: ZType <: OrderedTypeFull <: TotalOrder :=
- ZMake.Make BigN <+ ZTypeIsZAxioms
- <+ !ZPropSig <+ !ZDivPropFunct <+ HasEqBool2Dec
- <+ !MinMaxLogicalProperties <+ !MinMaxDecProperties.
+Module BigZ <: ZType <: OrderedTypeFull <: TotalOrder.
+ Include ZMake.Make BigN [scope abstract_scope to bigZ_scope].
+ Bind Scope bigZ_scope with t t_.
+ Include ZTypeIsZAxioms
+ <+ ZProp [no inline]
+ <+ HasEqBool2Dec [no inline]
+ <+ MinMaxLogicalProperties [no inline]
+ <+ MinMaxDecProperties [no inline].
+End BigZ.
 
-(** Notations about [BigZ] *)
+(** For precision concerning the above scope handling, see comment in BigN *)
 
-Notation bigZ := BigZ.t.
+(** Notations about [BigZ] *)
 
-Delimit Scope bigZ_scope with bigZ.
-Bind Scope bigZ_scope with bigZ.
-Bind Scope bigZ_scope with BigZ.t.
-Bind Scope bigZ_scope with BigZ.t_.
-(* Bind Scope has no retroactive effect, let's declare scopes by hand. *)
-Arguments Scope BigZ.Pos [bigN_scope].
-Arguments Scope BigZ.Neg [bigN_scope].
-Arguments Scope BigZ.to_Z [bigZ_scope].
-Arguments Scope BigZ.succ [bigZ_scope].
-Arguments Scope BigZ.pred [bigZ_scope].
-Arguments Scope BigZ.opp [bigZ_scope].
-Arguments Scope BigZ.square [bigZ_scope].
-Arguments Scope BigZ.add [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.sub [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.mul [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.div [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.eq [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.lt [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.le [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.eq [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.compare [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.min [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.max [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.eq_bool [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.power_pos [bigZ_scope positive_scope].
-Arguments Scope BigZ.power [bigZ_scope N_scope].
-Arguments Scope BigZ.sqrt [bigZ_scope].
-Arguments Scope BigZ.div_eucl [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.modulo [bigZ_scope bigZ_scope].
-Arguments Scope BigZ.gcd [bigZ_scope bigZ_scope].
+Local Open Scope bigZ_scope.
 
+Notation bigZ := BigZ.t.
+Bind Scope bigZ_scope with bigZ BigZ.t BigZ.t_.
+Arguments BigZ.Pos _%bigN.
+Arguments BigZ.Neg _%bigN.
 Local Notation "0" := BigZ.zero : bigZ_scope.
 Local Notation "1" := BigZ.one : bigZ_scope.
+Local Notation "2" := BigZ.two : bigZ_scope.
 Infix "+" := BigZ.add : bigZ_scope.
 Infix "-" := BigZ.sub : bigZ_scope.
 Notation "- x" := (BigZ.opp x) : bigZ_scope.
 Infix "*" := BigZ.mul : bigZ_scope.
 Infix "/" := BigZ.div : bigZ_scope.
-Infix "^" := BigZ.power : bigZ_scope.
+Infix "^" := BigZ.pow : bigZ_scope.
 Infix "?=" := BigZ.compare : bigZ_scope.
+Infix "=?" := BigZ.eqb (at level 70, no associativity) : bigZ_scope.
+Infix "<=?" := BigZ.leb (at level 70, no associativity) : bigZ_scope.
+Infix "<?" := BigZ.ltb (at level 70, no associativity) : bigZ_scope.
 Infix "==" := BigZ.eq (at level 70, no associativity) : bigZ_scope.
-Notation "x != y" := (~x==y)%bigZ (at level 70, no associativity) : bigZ_scope.
+Notation "x != y" := (~x==y) (at level 70, no associativity) : bigZ_scope.
 Infix "<" := BigZ.lt : bigZ_scope.
 Infix "<=" := BigZ.le : bigZ_scope.
-Notation "x > y" := (BigZ.lt y x)(only parsing) : bigZ_scope.
-Notation "x >= y" := (BigZ.le y x)(only parsing) : bigZ_scope.
-Notation "x < y < z" := (x<y /\ y<z)%bigZ : bigZ_scope.
-Notation "x < y <= z" := (x<y /\ y<=z)%bigZ : bigZ_scope.
-Notation "x <= y < z" := (x<=y /\ y<z)%bigZ : bigZ_scope.
-Notation "x <= y <= z" := (x<=y /\ y<=z)%bigZ : bigZ_scope.
+Notation "x > y" := (y < x) (only parsing) : bigZ_scope.
+Notation "x >= y" := (y <= x) (only parsing) : bigZ_scope.
+Notation "x < y < z" := (x<y /\ y<z) : bigZ_scope.
+Notation "x < y <= z" := (x<y /\ y<=z) : bigZ_scope.
+Notation "x <= y < z" := (x<=y /\ y<z) : bigZ_scope.
+Notation "x <= y <= z" := (x<=y /\ y<=z) : bigZ_scope.
 Notation "[ i ]" := (BigZ.to_Z i) : bigZ_scope.
-Infix "mod" := BigZ.modulo (at level 40, no associativity) : bigN_scope.
-
-Local Open Scope bigZ_scope.
+Infix "mod" := BigZ.modulo (at level 40, no associativity) : bigZ_scope.
+Infix "÷" := BigZ.quot (at level 40, left associativity) : bigZ_scope.
 
 (** Some additional results about [BigZ] *)
 
 Theorem spec_to_Z: forall n : bigZ,
-  BigN.to_Z (BigZ.to_N n) = ((Zsgn [n]) * [n])%Z.
+  BigN.to_Z (BigZ.to_N n) = ((Z.sgn [n]) * [n])%Z.
 Proof.
 intros n; case n; simpl; intros p;
   generalize (BigN.spec_pos p); case (BigN.to_Z p); auto.
@@ -105,7 +85,7 @@ intros p1 H1; case H1; auto.
 Qed.
 
 Theorem spec_to_N n:
- ([n] = Zsgn [n] * (BigN.to_Z (BigZ.to_N n)))%Z.
+ ([n] = Z.sgn [n] * (BigN.to_Z (BigZ.to_N n)))%Z.
 Proof.
 case n; simpl; intros p;
   generalize (BigN.spec_pos p); case (BigN.to_Z p); auto.
@@ -135,29 +115,31 @@ symmetry. apply BigZ.add_opp_r.
 exact BigZ.add_opp_diag_r.
 Qed.
 
-Lemma BigZeqb_correct : forall x y, BigZ.eq_bool x y = true -> x==y.
+Lemma BigZeqb_correct : forall x y, (x =? y) = true -> x==y.
 Proof. now apply BigZ.eqb_eq. Qed.
 
-Lemma BigZpower : power_theory 1 BigZ.mul BigZ.eq (@id N) BigZ.power.
+Definition BigZ_of_N n := BigZ.of_Z (Z.of_N n).
+
+Lemma BigZpower : power_theory 1 BigZ.mul BigZ.eq BigZ_of_N BigZ.pow.
 Proof.
 constructor.
-intros. red. rewrite BigZ.spec_power. unfold id.
-destruct Zpower_theory as [EQ]. rewrite EQ.
+intros. unfold BigZ.eq, BigZ_of_N. rewrite BigZ.spec_pow, BigZ.spec_of_Z.
+rewrite Zpower_theory.(rpow_pow_N).
 destruct n; simpl. reflexivity.
 induction p; simpl; intros; BigZ.zify; rewrite ?IHp; auto.
 Qed.
 
 Lemma BigZdiv : div_theory BigZ.eq BigZ.add BigZ.mul (@id _)
- (fun a b => if BigZ.eq_bool b 0 then (0,a) else BigZ.div_eucl a b).
+ (fun a b => if b =? 0 then (0,a) else BigZ.div_eucl a b).
 Proof.
 constructor. unfold id. intros a b.
 BigZ.zify.
-generalize (Zeq_bool_if [b] 0); destruct (Zeq_bool [b] 0).
+case Z.eqb_spec.
 BigZ.zify. auto with zarith.
 intros NEQ.
 generalize (BigZ.spec_div_eucl a b).
 generalize (Z_div_mod_full [a] [b] NEQ).
-destruct BigZ.div_eucl as (q,r), Zdiv_eucl as (q',r').
+destruct BigZ.div_eucl as (q,r), Z.div_eucl as (q',r').
 intros (EQ,_). injection 1. intros EQr EQq.
 BigZ.zify. rewrite EQr, EQq; auto.
 Qed.
@@ -170,6 +152,7 @@ Ltac isBigZcst t :=
  | BigZ.Neg ?t => isBigNcst t
  | BigZ.zero => constr:true
  | BigZ.one => constr:true
+ | BigZ.two => constr:true
  | BigZ.minus_one => constr:true
  | _ => constr:false
  end.
@@ -180,16 +163,25 @@ Ltac BigZcst t :=
  | false => constr:NotConstant
  end.
 
+Ltac BigZ_to_N t :=
+ match t with
+ | BigZ.Pos ?t => BigN_to_N t
+ | BigZ.zero => constr:0%N
+ | BigZ.one => constr:1%N
+ | BigZ.two => constr:2%N
+ | _ => constr:NotConstant
+ end.
+
 (** Registration for the "ring" tactic *)
 
 Add Ring BigZr : BigZring
  (decidable BigZeqb_correct,
   constants [BigZcst],
-  power_tac BigZpower [Ncst],
+  power_tac BigZpower [BigZ_to_N],
   div BigZdiv).
 
 Section TestRing.
-Let test : forall x y, 1 + x*y + x^2 + 1 == 1*1 + 1 + y*x + 1*x*x.
+Let test : forall x y, 1 + x*y + x^2 + 1 == 1*1 + 1 + (y + 1*x)*x.
 Proof.
 intros. ring_simplify. reflexivity.
 Qed.
diff --git a/theories/Numbers/Integer/BigZ/ZMake.v b/theories/Numbers/Integer/BigZ/ZMake.v
index 48db793c..180fe0a9 100644
--- a/theories/Numbers/Integer/BigZ/ZMake.v
+++ b/theories/Numbers/Integer/BigZ/ZMake.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: ZMake.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import ZArith.
 Require Import BigNumPrelude.
 Require Import NSig.
@@ -23,113 +21,148 @@ Open Scope Z_scope.
   [NSig.NType] to a structure of integers [ZSig.ZType].
 *)
 
-Module Make (N:NType) <: ZType.
+Module Make (NN:NType) <: ZType.
 
  Inductive t_ :=
-  | Pos : N.t -> t_
-  | Neg : N.t -> t_.
+  | Pos : NN.t -> t_
+  | Neg : NN.t -> t_.
 
  Definition t := t_.
 
- Definition zero := Pos N.zero.
- Definition one  := Pos N.one.
- Definition minus_one := Neg N.one.
+ Bind Scope abstract_scope with t t_.
+
+ Definition zero := Pos NN.zero.
+ Definition one  := Pos NN.one.
+ Definition two := Pos NN.two.
+ Definition minus_one := Neg NN.one.
 
  Definition of_Z x :=
   match x with
-  | Zpos x => Pos (N.of_N (Npos x))
+  | Zpos x => Pos (NN.of_N (Npos x))
   | Z0 => zero
-  | Zneg x => Neg (N.of_N (Npos x))
+  | Zneg x => Neg (NN.of_N (Npos x))
   end.
 
  Definition to_Z x :=
   match x with
-  | Pos nx => N.to_Z nx
-  | Neg nx => Zopp (N.to_Z nx)
+  | Pos nx => NN.to_Z nx
+  | Neg nx => Z.opp (NN.to_Z nx)
   end.
 
  Theorem spec_of_Z: forall x, to_Z (of_Z x) = x.
  Proof.
  intros x; case x; unfold to_Z, of_Z, zero.
-   exact N.spec_0.
-   intros; rewrite N.spec_of_N; auto.
-   intros; rewrite N.spec_of_N; auto.
+   exact NN.spec_0.
+   intros; rewrite NN.spec_of_N; auto.
+   intros; rewrite NN.spec_of_N; auto.
  Qed.
 
  Definition eq x y := (to_Z x = to_Z y).
 
  Theorem spec_0: to_Z zero = 0.
- exact N.spec_0.
+ exact NN.spec_0.
  Qed.
 
  Theorem spec_1: to_Z one = 1.
- exact N.spec_1.
+ exact NN.spec_1.
+ Qed.
+
+ Theorem spec_2: to_Z two = 2.
+ exact NN.spec_2.
  Qed.
 
  Theorem spec_m1: to_Z minus_one = -1.
- simpl; rewrite N.spec_1; auto.
+ simpl; rewrite NN.spec_1; auto.
  Qed.
 
  Definition compare x y :=
   match x, y with
-  | Pos nx, Pos ny => N.compare nx ny
+  | Pos nx, Pos ny => NN.compare nx ny
   | Pos nx, Neg ny =>
-    match N.compare nx N.zero with
+    match NN.compare nx NN.zero with
     | Gt => Gt
-    | _ => N.compare ny N.zero
+    | _ => NN.compare ny NN.zero
     end
   | Neg nx, Pos ny =>
-    match N.compare N.zero nx with
+    match NN.compare NN.zero nx with
     | Lt => Lt
-    | _ => N.compare N.zero ny
+    | _ => NN.compare NN.zero ny
     end
-  | Neg nx, Neg ny => N.compare ny nx
+  | Neg nx, Neg ny => NN.compare ny nx
   end.
 
  Theorem spec_compare :
-  forall x y, compare x y = Zcompare (to_Z x) (to_Z y).
+  forall x y, compare x y = Z.compare (to_Z x) (to_Z y).
  Proof.
  unfold compare, to_Z.
  destruct x as [x|x], y as [y|y];
- rewrite ?N.spec_compare, ?N.spec_0, <-?Zcompare_opp; auto;
- assert (Hx:=N.spec_pos x); assert (Hy:=N.spec_pos y);
- set (X:=N.to_Z x) in *; set (Y:=N.to_Z y) in *; clearbody X Y.
- destruct (Zcompare_spec X 0) as [EQ|LT|GT].
-  rewrite EQ. rewrite <- Zopp_0 at 2. apply Zcompare_opp.
-  exfalso. omega.
-  symmetry. change (X > -Y). omega.
- destruct (Zcompare_spec 0 X) as [EQ|LT|GT].
-  rewrite <- EQ. rewrite Zopp_0; auto.
-  symmetry. change (-X < Y). omega.
-  exfalso. omega.
- Qed.
-
- Definition eq_bool x y :=
+ rewrite ?NN.spec_compare, ?NN.spec_0, ?Z.compare_opp; auto;
+ assert (Hx:=NN.spec_pos x); assert (Hy:=NN.spec_pos y);
+ set (X:=NN.to_Z x) in *; set (Y:=NN.to_Z y) in *; clearbody X Y.
+ - destruct (Z.compare_spec X 0) as [EQ|LT|GT].
+   + rewrite <- Z.opp_0 in EQ. now rewrite EQ, Z.compare_opp.
+   + exfalso. omega.
+   + symmetry. change (X > -Y). omega.
+ - destruct (Z.compare_spec 0 X) as [EQ|LT|GT].
+   + rewrite <- EQ, Z.opp_0; auto.
+   + symmetry. change (-X < Y). omega.
+   + exfalso. omega.
+ Qed.
+
+ Definition eqb x y :=
   match compare x y with
   | Eq => true
   | _ => false
   end.
 
- Theorem spec_eq_bool:
-  forall x y, eq_bool x y = Zeq_bool (to_Z x) (to_Z y).
+ Theorem spec_eqb x y : eqb x y = Z.eqb (to_Z x) (to_Z y).
  Proof.
- unfold eq_bool, Zeq_bool; intros; rewrite spec_compare; reflexivity.
+ apply Bool.eq_iff_eq_true.
+ unfold eqb. rewrite Z.eqb_eq, <- Z.compare_eq_iff, spec_compare.
+ split; [now destruct Z.compare | now intros ->].
  Qed.
 
  Definition lt n m := to_Z n < to_Z m.
  Definition le n m := to_Z n <= to_Z m.
 
+
+ Definition ltb (x y : t) : bool :=
+  match compare x y with
+  | Lt => true
+  | _  => false
+  end.
+
+ Theorem spec_ltb x y : ltb x y = Z.ltb (to_Z x) (to_Z y).
+ Proof.
+ apply Bool.eq_iff_eq_true.
+ rewrite Z.ltb_lt. unfold Z.lt, ltb. rewrite spec_compare.
+ split; [now destruct Z.compare | now intros ->].
+ Qed.
+
+ Definition leb (x y : t) : bool :=
+  match compare x y with
+  | Gt => false
+  | _  => true
+  end.
+
+ Theorem spec_leb x y : leb x y = Z.leb (to_Z x) (to_Z y).
+ Proof.
+ apply Bool.eq_iff_eq_true.
+ rewrite Z.leb_le. unfold Z.le, leb. rewrite spec_compare.
+ destruct Z.compare; split; try easy. now destruct 1.
+ Qed.
+
  Definition min n m := match compare n m with Gt => m | _ => n end.
  Definition max n m := match compare n m with Lt => m | _ => n end.
 
- Theorem spec_min : forall n m, to_Z (min n m) = Zmin (to_Z n) (to_Z m).
+ Theorem spec_min : forall n m, to_Z (min n m) = Z.min (to_Z n) (to_Z m).
  Proof.
- unfold min, Zmin. intros. rewrite spec_compare. destruct Zcompare; auto.
+ unfold min, Z.min. intros. rewrite spec_compare. destruct Z.compare; auto.
  Qed.
 
- Theorem spec_max : forall n m, to_Z (max n m) = Zmax (to_Z n) (to_Z m).
+ Theorem spec_max : forall n m, to_Z (max n m) = Z.max (to_Z n) (to_Z m).
  Proof.
- unfold max, Zmax. intros. rewrite spec_compare. destruct Zcompare; auto.
+ unfold max, Z.max. intros. rewrite spec_compare. destruct Z.compare; auto.
  Qed.
 
  Definition to_N x :=
@@ -140,11 +173,11 @@ Module Make (N:NType) <: ZType.
 
  Definition abs x := Pos (to_N x).
 
- Theorem spec_abs: forall x, to_Z (abs x) = Zabs (to_Z x).
+ Theorem spec_abs: forall x, to_Z (abs x) = Z.abs (to_Z x).
  Proof.
- intros x; case x; clear x; intros x; assert (F:=N.spec_pos x).
-    simpl; rewrite Zabs_eq; auto.
- simpl; rewrite Zabs_non_eq; simpl; auto with zarith.
+ intros x; case x; clear x; intros x; assert (F:=NN.spec_pos x).
+    simpl; rewrite Z.abs_eq; auto.
+ simpl; rewrite Z.abs_neq; simpl; auto with zarith.
  Qed.
 
  Definition opp x :=
@@ -160,10 +193,10 @@ Module Make (N:NType) <: ZType.
 
  Definition succ x :=
   match x with
-  | Pos n => Pos (N.succ n)
+  | Pos n => Pos (NN.succ n)
   | Neg n =>
-    match N.compare N.zero n with
-    | Lt => Neg (N.pred n)
+    match NN.compare NN.zero n with
+    | Lt => Neg (NN.pred n)
     | _ => one
     end
   end.
@@ -171,232 +204,260 @@ Module Make (N:NType) <: ZType.
  Theorem spec_succ: forall n, to_Z (succ n) = to_Z n + 1.
  Proof.
  intros x; case x; clear x; intros x.
-   exact (N.spec_succ x).
- simpl. rewrite N.spec_compare. case Zcompare_spec; rewrite ?N.spec_0; simpl.
-  intros HH; rewrite <- HH; rewrite N.spec_1; ring.
-  intros HH; rewrite N.spec_pred, Zmax_r; auto with zarith.
- generalize (N.spec_pos x); auto with zarith.
+   exact (NN.spec_succ x).
+ simpl. rewrite NN.spec_compare. case Z.compare_spec; rewrite ?NN.spec_0; simpl.
+  intros HH; rewrite <- HH; rewrite NN.spec_1; ring.
+  intros HH; rewrite NN.spec_pred, Z.max_r; auto with zarith.
+ generalize (NN.spec_pos x); auto with zarith.
  Qed.
 
  Definition add x y :=
   match x, y with
-  | Pos nx, Pos ny => Pos (N.add nx ny)
+  | Pos nx, Pos ny => Pos (NN.add nx ny)
   | Pos nx, Neg ny =>
-    match N.compare nx ny with
-    | Gt => Pos (N.sub nx ny)
+    match NN.compare nx ny with
+    | Gt => Pos (NN.sub nx ny)
     | Eq => zero
-    | Lt => Neg (N.sub ny nx)
+    | Lt => Neg (NN.sub ny nx)
     end
   | Neg nx, Pos ny =>
-    match N.compare nx ny with
-    | Gt => Neg (N.sub nx ny)
+    match NN.compare nx ny with
+    | Gt => Neg (NN.sub nx ny)
     | Eq => zero
-    | Lt => Pos (N.sub ny nx)
+    | Lt => Pos (NN.sub ny nx)
     end
-  | Neg nx, Neg ny => Neg (N.add nx ny)
+  | Neg nx, Neg ny => Neg (NN.add nx ny)
   end.
 
  Theorem spec_add: forall x y, to_Z (add x y) = to_Z x +  to_Z y.
  Proof.
  unfold add, to_Z; intros [x | x] [y | y];
-   try (rewrite N.spec_add; auto with zarith);
- rewrite N.spec_compare; case Zcompare_spec;
-  unfold zero; rewrite ?N.spec_0, ?N.spec_sub; omega with *.
+   try (rewrite NN.spec_add; auto with zarith);
+ rewrite NN.spec_compare; case Z.compare_spec;
+  unfold zero; rewrite ?NN.spec_0, ?NN.spec_sub; omega with *.
  Qed.
 
  Definition pred x :=
   match x with
   | Pos nx =>
-    match N.compare N.zero nx with
-    | Lt => Pos (N.pred nx)
+    match NN.compare NN.zero nx with
+    | Lt => Pos (NN.pred nx)
     | _ => minus_one
     end
-  | Neg nx => Neg (N.succ nx)
+  | Neg nx => Neg (NN.succ nx)
   end.
 
  Theorem spec_pred: forall x, to_Z (pred x) = to_Z x - 1.
  Proof.
  unfold pred, to_Z, minus_one; intros [x | x];
-   try (rewrite N.spec_succ; ring).
- rewrite N.spec_compare; case Zcompare_spec;
-  rewrite ?N.spec_0, ?N.spec_1, ?N.spec_pred;
-  generalize (N.spec_pos x); omega with *.
+   try (rewrite NN.spec_succ; ring).
+ rewrite NN.spec_compare; case Z.compare_spec;
+  rewrite ?NN.spec_0, ?NN.spec_1, ?NN.spec_pred;
+  generalize (NN.spec_pos x); omega with *.
  Qed.
 
  Definition sub x y :=
   match x, y with
   | Pos nx, Pos ny =>
-    match N.compare nx ny with
-    | Gt => Pos (N.sub nx ny)
+    match NN.compare nx ny with
+    | Gt => Pos (NN.sub nx ny)
     | Eq => zero
-    | Lt => Neg (N.sub ny nx)
+    | Lt => Neg (NN.sub ny nx)
     end
-  | Pos nx, Neg ny => Pos (N.add nx ny)
-  | Neg nx, Pos ny => Neg (N.add nx ny)
+  | Pos nx, Neg ny => Pos (NN.add nx ny)
+  | Neg nx, Pos ny => Neg (NN.add nx ny)
   | Neg nx, Neg ny =>
-    match N.compare nx ny with
-    | Gt => Neg (N.sub nx ny)
+    match NN.compare nx ny with
+    | Gt => Neg (NN.sub nx ny)
     | Eq => zero
-    | Lt => Pos (N.sub ny nx)
+    | Lt => Pos (NN.sub ny nx)
     end
   end.
 
  Theorem spec_sub: forall x y, to_Z (sub x y) = to_Z x - to_Z y.
  Proof.
  unfold sub, to_Z; intros [x | x] [y | y];
-  try (rewrite N.spec_add; auto with zarith);
- rewrite N.spec_compare; case Zcompare_spec;
-  unfold zero; rewrite ?N.spec_0, ?N.spec_sub; omega with *.
+  try (rewrite NN.spec_add; auto with zarith);
+ rewrite NN.spec_compare; case Z.compare_spec;
+  unfold zero; rewrite ?NN.spec_0, ?NN.spec_sub; omega with *.
  Qed.
 
  Definition mul x y :=
   match x, y with
-  | Pos nx, Pos ny => Pos (N.mul nx ny)
-  | Pos nx, Neg ny => Neg (N.mul nx ny)
-  | Neg nx, Pos ny => Neg (N.mul nx ny)
-  | Neg nx, Neg ny => Pos (N.mul nx ny)
+  | Pos nx, Pos ny => Pos (NN.mul nx ny)
+  | Pos nx, Neg ny => Neg (NN.mul nx ny)
+  | Neg nx, Pos ny => Neg (NN.mul nx ny)
+  | Neg nx, Neg ny => Pos (NN.mul nx ny)
   end.
 
  Theorem spec_mul: forall x y, to_Z (mul x y) = to_Z x * to_Z y.
  Proof.
- unfold mul, to_Z; intros [x | x] [y | y]; rewrite N.spec_mul; ring.
+ unfold mul, to_Z; intros [x | x] [y | y]; rewrite NN.spec_mul; ring.
  Qed.
 
  Definition square x :=
   match x with
-  | Pos nx => Pos (N.square nx)
-  | Neg nx => Pos (N.square nx)
+  | Pos nx => Pos (NN.square nx)
+  | Neg nx => Pos (NN.square nx)
   end.
 
  Theorem spec_square: forall x, to_Z (square x) = to_Z x *  to_Z x.
  Proof.
- unfold square, to_Z; intros [x | x]; rewrite N.spec_square; ring.
+ unfold square, to_Z; intros [x | x]; rewrite NN.spec_square; ring.
  Qed.
 
- Definition power_pos x p :=
+ Definition pow_pos x p :=
   match x with
-  | Pos nx => Pos (N.power_pos nx p)
+  | Pos nx => Pos (NN.pow_pos nx p)
   | Neg nx =>
     match p with
     | xH => x
-    | xO _ => Pos (N.power_pos nx p)
-    | xI _ => Neg (N.power_pos nx p)
+    | xO _ => Pos (NN.pow_pos nx p)
+    | xI _ => Neg (NN.pow_pos nx p)
     end
   end.
 
- Theorem spec_power_pos: forall x n, to_Z (power_pos x n) = to_Z x ^ Zpos n.
+ Theorem spec_pow_pos: forall x n, to_Z (pow_pos x n) = to_Z x ^ Zpos n.
  Proof.
  assert (F0: forall x, (-x)^2 = x^2).
-   intros x; rewrite Zpower_2; ring.
- unfold power_pos, to_Z; intros [x | x] [p | p |];
-   try rewrite N.spec_power_pos; try ring.
+   intros x; rewrite Z.pow_2_r; ring.
+ unfold pow_pos, to_Z; intros [x | x] [p | p |];
+   try rewrite NN.spec_pow_pos; try ring.
  assert (F: 0 <= 2 * Zpos p).
   assert (0 <= Zpos p); auto with zarith.
- rewrite Zpos_xI; repeat rewrite Zpower_exp; auto with zarith.
- repeat rewrite Zpower_mult; auto with zarith.
+ rewrite Pos2Z.inj_xI; repeat rewrite Zpower_exp; auto with zarith.
+ repeat rewrite Z.pow_mul_r; auto with zarith.
  rewrite F0; ring.
  assert (F: 0 <= 2 * Zpos p).
   assert (0 <= Zpos p); auto with zarith.
- rewrite Zpos_xO; repeat rewrite Zpower_exp; auto with zarith.
- repeat rewrite Zpower_mult; auto with zarith.
+ rewrite Pos2Z.inj_xO; repeat rewrite Zpower_exp; auto with zarith.
+ repeat rewrite Z.pow_mul_r; auto with zarith.
  rewrite F0; ring.
  Qed.
 
- Definition power x n :=
+ Definition pow_N x n :=
   match n with
   | N0 => one
-  | Npos p => power_pos x p
+  | Npos p => pow_pos x p
+  end.
+
+ Theorem spec_pow_N: forall x n, to_Z (pow_N x n) = to_Z x ^ Z.of_N n.
+ Proof.
+ destruct n; simpl. apply NN.spec_1.
+ apply spec_pow_pos.
+ Qed.
+
+ Definition pow x y :=
+  match to_Z y with
+  | Z0 => one
+  | Zpos p => pow_pos x p
+  | Zneg p => zero
   end.
 
- Theorem spec_power: forall x n, to_Z (power x n) = to_Z x ^ Z_of_N n.
+ Theorem spec_pow: forall x y, to_Z (pow x y) = to_Z x ^ to_Z y.
  Proof.
- destruct n; simpl. rewrite N.spec_1; reflexivity.
- apply spec_power_pos.
+ intros. unfold pow. destruct (to_Z y); simpl.
+ apply NN.spec_1.
+ apply spec_pow_pos.
+ apply NN.spec_0.
  Qed.
 
+ Definition log2 x :=
+  match x with
+  | Pos nx => Pos (NN.log2 nx)
+  | Neg nx => zero
+  end.
+
+ Theorem spec_log2: forall x, to_Z (log2 x) = Z.log2 (to_Z x).
+ Proof.
+  intros. destruct x as [p|p]; simpl. apply NN.spec_log2.
+  rewrite NN.spec_0.
+  destruct (Z_le_lt_eq_dec _ _ (NN.spec_pos p)) as [LT|EQ].
+  rewrite Z.log2_nonpos; auto with zarith.
+  now rewrite <- EQ.
+ Qed.
 
  Definition sqrt x :=
   match x with
-  | Pos nx => Pos (N.sqrt nx)
-  | Neg nx => Neg N.zero
+  | Pos nx => Pos (NN.sqrt nx)
+  | Neg nx => Neg NN.zero
   end.
 
- Theorem spec_sqrt: forall x, 0 <= to_Z x ->
-   to_Z (sqrt x) ^ 2 <= to_Z x < (to_Z (sqrt x) + 1) ^ 2.
+ Theorem spec_sqrt: forall x, to_Z (sqrt x) = Z.sqrt (to_Z x).
  Proof.
- unfold to_Z, sqrt; intros [x | x] H.
-   exact (N.spec_sqrt x).
- replace (N.to_Z x) with 0.
-   rewrite N.spec_0; simpl Zpower; unfold Zpower_pos, iter_pos;
-    auto with zarith.
- generalize (N.spec_pos x); auto with zarith.
+  destruct x as [p|p]; simpl.
+  apply NN.spec_sqrt.
+  rewrite NN.spec_0.
+  destruct (Z_le_lt_eq_dec _ _ (NN.spec_pos p)) as [LT|EQ].
+  rewrite Z.sqrt_neg; auto with zarith.
+  now rewrite <- EQ.
  Qed.
 
  Definition div_eucl x y :=
   match x, y with
   | Pos nx, Pos ny =>
-    let (q, r) := N.div_eucl nx ny in
+    let (q, r) := NN.div_eucl nx ny in
     (Pos q, Pos r)
   | Pos nx, Neg ny =>
-    let (q, r) := N.div_eucl nx ny in
-    if N.eq_bool N.zero r
+    let (q, r) := NN.div_eucl nx ny in
+    if NN.eqb NN.zero r
     then (Neg q, zero)
-    else (Neg (N.succ q), Neg (N.sub ny r))
+    else (Neg (NN.succ q), Neg (NN.sub ny r))
   | Neg nx, Pos ny =>
-    let (q, r) := N.div_eucl nx ny in
-    if N.eq_bool N.zero r
+    let (q, r) := NN.div_eucl nx ny in
+    if NN.eqb NN.zero r
     then (Neg q, zero)
-    else (Neg (N.succ q), Pos (N.sub ny r))
+    else (Neg (NN.succ q), Pos (NN.sub ny r))
   | Neg nx, Neg ny =>
-    let (q, r) := N.div_eucl nx ny in
+    let (q, r) := NN.div_eucl nx ny in
     (Pos q, Neg r)
   end.
 
  Ltac break_nonneg x px EQx :=
   let H := fresh "H" in
-  assert (H:=N.spec_pos x);
-  destruct (N.to_Z x) as [|px|px]_eqn:EQx;
+  assert (H:=NN.spec_pos x);
+  destruct (NN.to_Z x) as [|px|px] eqn:EQx;
    [clear H|clear H|elim H; reflexivity].
 
  Theorem spec_div_eucl: forall x y,
    let (q,r) := div_eucl x y in
-   (to_Z q, to_Z r) = Zdiv_eucl (to_Z x) (to_Z y).
+   (to_Z q, to_Z r) = Z.div_eucl (to_Z x) (to_Z y).
  Proof.
  unfold div_eucl, to_Z. intros [x | x] [y | y].
  (* Pos Pos *)
- generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y); auto.
+ generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y); auto.
  (* Pos Neg *)
- generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y) as (q,r).
+ generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r).
  break_nonneg x px EQx; break_nonneg y py EQy;
- try (injection 1; intros Hr Hq; rewrite N.spec_eq_bool, N.spec_0, Hr;
-      simpl; rewrite Hq, N.spec_0; auto).
+ try (injection 1; intros Hr Hq; rewrite NN.spec_eqb, NN.spec_0, Hr;
+      simpl; rewrite Hq, NN.spec_0; auto).
  change (- Zpos py) with (Zneg py).
  assert (GT : Zpos py > 0) by (compute; auto).
  generalize (Z_div_mod (Zpos px) (Zpos py) GT).
- unfold Zdiv_eucl. destruct (Zdiv_eucl_POS px (Zpos py)) as (q',r').
+ unfold Z.div_eucl. destruct (Z.pos_div_eucl px (Zpos py)) as (q',r').
  intros (EQ,MOD). injection 1. intros Hr' Hq'.
- rewrite N.spec_eq_bool, N.spec_0, Hr'.
+ rewrite NN.spec_eqb, NN.spec_0, Hr'.
  break_nonneg r pr EQr.
- subst; simpl. rewrite N.spec_0; auto.
- subst. lazy iota beta delta [Zeq_bool Zcompare].
- rewrite N.spec_sub, N.spec_succ, EQy, EQr. f_equal. omega with *.
+ subst; simpl. rewrite NN.spec_0; auto.
+ subst. lazy iota beta delta [Z.eqb].
+ rewrite NN.spec_sub, NN.spec_succ, EQy, EQr. f_equal. omega with *.
  (* Neg Pos *)
- generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y) as (q,r).
+ generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r).
  break_nonneg x px EQx; break_nonneg y py EQy;
- try (injection 1; intros Hr Hq; rewrite N.spec_eq_bool, N.spec_0, Hr;
-      simpl; rewrite Hq, N.spec_0; auto).
+ try (injection 1; intros Hr Hq; rewrite NN.spec_eqb, NN.spec_0, Hr;
+      simpl; rewrite Hq, NN.spec_0; auto).
  change (- Zpos px) with (Zneg px).
  assert (GT : Zpos py > 0) by (compute; auto).
  generalize (Z_div_mod (Zpos px) (Zpos py) GT).
- unfold Zdiv_eucl. destruct (Zdiv_eucl_POS px (Zpos py)) as (q',r').
+ unfold Z.div_eucl. destruct (Z.pos_div_eucl px (Zpos py)) as (q',r').
  intros (EQ,MOD). injection 1. intros Hr' Hq'.
- rewrite N.spec_eq_bool, N.spec_0, Hr'.
+ rewrite NN.spec_eqb, NN.spec_0, Hr'.
  break_nonneg r pr EQr.
- subst; simpl. rewrite N.spec_0; auto.
- subst. lazy iota beta delta [Zeq_bool Zcompare].
- rewrite N.spec_sub, N.spec_succ, EQy, EQr. f_equal. omega with *.
+ subst; simpl. rewrite NN.spec_0; auto.
+ subst. lazy iota beta delta [Z.eqb].
+ rewrite NN.spec_sub, NN.spec_succ, EQy, EQr. f_equal. omega with *.
  (* Neg Neg *)
- generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y) as (q,r).
+ generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r).
  break_nonneg x px EQx; break_nonneg y py EQy;
  try (injection 1; intros Hr Hq; rewrite Hr, Hq; auto).
  simpl. intros <-; auto.
@@ -407,8 +468,8 @@ Module Make (N:NType) <: ZType.
  Definition spec_div: forall x y,
      to_Z (div x y) = to_Z x / to_Z y.
  Proof.
- intros x y; generalize (spec_div_eucl x y); unfold div, Zdiv.
- case div_eucl; case Zdiv_eucl; simpl; auto.
+ intros x y; generalize (spec_div_eucl x y); unfold div, Z.div.
+ case div_eucl; case Z.div_eucl; simpl; auto.
  intros q r q11 r1 H; injection H; auto.
  Qed.
 
@@ -417,25 +478,69 @@ Module Make (N:NType) <: ZType.
  Theorem spec_modulo:
    forall x y, to_Z (modulo x y) = to_Z x mod to_Z y.
  Proof.
- intros x y; generalize (spec_div_eucl x y); unfold modulo, Zmod.
- case div_eucl; case Zdiv_eucl; simpl; auto.
+ intros x y; generalize (spec_div_eucl x y); unfold modulo, Z.modulo.
+ case div_eucl; case Z.div_eucl; simpl; auto.
  intros q r q11 r1 H; injection H; auto.
  Qed.
 
+ Definition quot x y :=
+  match x, y with
+  | Pos nx, Pos ny => Pos (NN.div nx ny)
+  | Pos nx, Neg ny => Neg (NN.div nx ny)
+  | Neg nx, Pos ny => Neg (NN.div nx ny)
+  | Neg nx, Neg ny => Pos (NN.div nx ny)
+  end.
+
+ Definition rem x y :=
+  if eqb y zero then x
+  else
+    match x, y with
+      | Pos nx, Pos ny => Pos (NN.modulo nx ny)
+      | Pos nx, Neg ny => Pos (NN.modulo nx ny)
+      | Neg nx, Pos ny => Neg (NN.modulo nx ny)
+      | Neg nx, Neg ny => Neg (NN.modulo nx ny)
+    end.
+
+ Lemma spec_quot : forall x y, to_Z (quot x y) = (to_Z x) ÷ (to_Z y).
+ Proof.
+  intros [x|x] [y|y]; simpl; symmetry; rewrite NN.spec_div;
+  (* Nota: we rely here on [forall a b, a ÷ 0 = b / 0] *)
+  destruct (Z.eq_dec (NN.to_Z y) 0) as [EQ|NEQ];
+    try (rewrite EQ; now destruct (NN.to_Z x));
+  rewrite ?Z.quot_opp_r, ?Z.quot_opp_l, ?Z.opp_involutive, ?Z.opp_inj_wd;
+  trivial; apply Z.quot_div_nonneg;
+   generalize (NN.spec_pos x) (NN.spec_pos y); Z.order.
+ Qed.
+
+ Lemma spec_rem : forall x y,
+   to_Z (rem x y) = Z.rem (to_Z x) (to_Z y).
+ Proof.
+  intros x y. unfold rem. rewrite spec_eqb, spec_0.
+  case Z.eqb_spec; intros Hy.
+  (* Nota: we rely here on [Z.rem a 0 = a] *)
+  rewrite Hy. now destruct (to_Z x).
+  destruct x as [x|x], y as [y|y]; simpl in *; symmetry;
+   rewrite ?Z.eq_opp_l, ?Z.opp_0 in Hy;
+   rewrite NN.spec_modulo, ?Z.rem_opp_r, ?Z.rem_opp_l, ?Z.opp_involutive,
+    ?Z.opp_inj_wd;
+   trivial; apply Z.rem_mod_nonneg;
+    generalize (NN.spec_pos x) (NN.spec_pos y); Z.order.
+ Qed.
+
  Definition gcd x y :=
   match x, y with
-  | Pos nx, Pos ny => Pos (N.gcd nx ny)
-  | Pos nx, Neg ny => Pos (N.gcd nx ny)
-  | Neg nx, Pos ny => Pos (N.gcd nx ny)
-  | Neg nx, Neg ny => Pos (N.gcd nx ny)
+  | Pos nx, Pos ny => Pos (NN.gcd nx ny)
+  | Pos nx, Neg ny => Pos (NN.gcd nx ny)
+  | Neg nx, Pos ny => Pos (NN.gcd nx ny)
+  | Neg nx, Neg ny => Pos (NN.gcd nx ny)
   end.
 
- Theorem spec_gcd: forall a b, to_Z (gcd a b) = Zgcd (to_Z a) (to_Z b).
+ Theorem spec_gcd: forall a b, to_Z (gcd a b) = Z.gcd (to_Z a) (to_Z b).
  Proof.
- unfold gcd, Zgcd, to_Z; intros [x | x] [y | y]; rewrite N.spec_gcd; unfold Zgcd;
-  auto; case N.to_Z; simpl; auto with zarith;
-  try rewrite Zabs_Zopp; auto;
-  case N.to_Z; simpl; auto with zarith.
+ unfold gcd, Z.gcd, to_Z; intros [x | x] [y | y]; rewrite NN.spec_gcd; unfold Z.gcd;
+  auto; case NN.to_Z; simpl; auto with zarith;
+  try rewrite Z.abs_opp; auto;
+  case NN.to_Z; simpl; auto with zarith.
  Qed.
 
  Definition sgn x :=
@@ -445,12 +550,212 @@ Module Make (N:NType) <: ZType.
    | Gt => minus_one
   end.
 
- Lemma spec_sgn : forall x, to_Z (sgn x) = Zsgn (to_Z x).
+ Lemma spec_sgn : forall x, to_Z (sgn x) = Z.sgn (to_Z x).
  Proof.
- intros. unfold sgn. rewrite spec_compare. case Zcompare_spec.
+ intros. unfold sgn. rewrite spec_compare. case Z.compare_spec.
  rewrite spec_0. intros <-; auto.
- rewrite spec_0, spec_1. symmetry. rewrite Zsgn_pos; auto.
- rewrite spec_0, spec_m1. symmetry. rewrite Zsgn_neg; auto with zarith.
+ rewrite spec_0, spec_1. symmetry. rewrite Z.sgn_pos_iff; auto.
+ rewrite spec_0, spec_m1. symmetry. rewrite Z.sgn_neg_iff; auto with zarith.
+ Qed.
+
+ Definition even z :=
+  match z with
+   | Pos n => NN.even n
+   | Neg n => NN.even n
+  end.
+
+ Definition odd z :=
+  match z with
+   | Pos n => NN.odd n
+   | Neg n => NN.odd n
+  end.
+
+ Lemma spec_even : forall z, even z = Z.even (to_Z z).
+ Proof.
+  intros [n|n]; simpl; rewrite NN.spec_even; trivial.
+  destruct (NN.to_Z n) as [|p|p]; now try destruct p.
+ Qed.
+
+ Lemma spec_odd : forall z, odd z = Z.odd (to_Z z).
+ Proof.
+  intros [n|n]; simpl; rewrite NN.spec_odd; trivial.
+  destruct (NN.to_Z n) as [|p|p]; now try destruct p.
+ Qed.
+
+ Definition norm_pos z :=
+   match z with
+     | Pos _ => z
+     | Neg n => if NN.eqb n NN.zero then Pos n else z
+   end.
+
+ Definition testbit a n :=
+   match norm_pos n, norm_pos a with
+     | Pos p, Pos a => NN.testbit a p
+     | Pos p, Neg a => negb (NN.testbit (NN.pred a) p)
+     | Neg p, _ => false
+   end.
+
+ Definition shiftl a n :=
+   match norm_pos a, n with
+     | Pos a, Pos n => Pos (NN.shiftl a n)
+     | Pos a, Neg n => Pos (NN.shiftr a n)
+     | Neg a, Pos n => Neg (NN.shiftl a n)
+     | Neg a, Neg n => Neg (NN.succ (NN.shiftr (NN.pred a) n))
+   end.
+
+ Definition shiftr a n := shiftl a (opp n).
+
+ Definition lor a b :=
+   match norm_pos a, norm_pos b with
+     | Pos a, Pos b => Pos (NN.lor a b)
+     | Neg a, Pos b => Neg (NN.succ (NN.ldiff (NN.pred a) b))
+     | Pos a, Neg b => Neg (NN.succ (NN.ldiff (NN.pred b) a))
+     | Neg a, Neg b => Neg (NN.succ (NN.land (NN.pred a) (NN.pred b)))
+   end.
+
+ Definition land a b :=
+   match norm_pos a, norm_pos b with
+     | Pos a, Pos b => Pos (NN.land a b)
+     | Neg a, Pos b => Pos (NN.ldiff b (NN.pred a))
+     | Pos a, Neg b => Pos (NN.ldiff a (NN.pred b))
+     | Neg a, Neg b => Neg (NN.succ (NN.lor (NN.pred a) (NN.pred b)))
+   end.
+
+ Definition ldiff a b :=
+   match norm_pos a, norm_pos b with
+     | Pos a, Pos b => Pos (NN.ldiff a b)
+     | Neg a, Pos b => Neg (NN.succ (NN.lor (NN.pred a) b))
+     | Pos a, Neg b => Pos (NN.land a (NN.pred b))
+     | Neg a, Neg b => Pos (NN.ldiff (NN.pred b) (NN.pred a))
+   end.
+
+ Definition lxor a b :=
+   match norm_pos a, norm_pos b with
+     | Pos a, Pos b => Pos (NN.lxor a b)
+     | Neg a, Pos b => Neg (NN.succ (NN.lxor (NN.pred a) b))
+     | Pos a, Neg b => Neg (NN.succ (NN.lxor a (NN.pred b)))
+     | Neg a, Neg b => Pos (NN.lxor (NN.pred a) (NN.pred b))
+   end.
+
+ Definition div2 x := shiftr x one.
+
+ Lemma Zlnot_alt1 : forall x, -(x+1) = Z.lnot x.
+ Proof.
+  unfold Z.lnot, Z.pred; auto with zarith.
+ Qed.
+
+ Lemma Zlnot_alt2 : forall x, Z.lnot (x-1) = -x.
+ Proof.
+  unfold Z.lnot, Z.pred; auto with zarith.
+ Qed.
+
+ Lemma Zlnot_alt3 : forall x, Z.lnot (-x) = x-1.
+ Proof.
+  unfold Z.lnot, Z.pred; auto with zarith.
+ Qed.
+
+ Lemma spec_norm_pos : forall x, to_Z (norm_pos x) = to_Z x.
+ Proof.
+  intros [x|x]; simpl; trivial.
+  rewrite NN.spec_eqb, NN.spec_0.
+  case Z.eqb_spec; simpl; auto with zarith.
+ Qed.
+
+ Lemma spec_norm_pos_pos : forall x y, norm_pos x = Neg y ->
+  0 < NN.to_Z y.
+ Proof.
+  intros [x|x] y; simpl; try easy.
+  rewrite NN.spec_eqb, NN.spec_0.
+  case Z.eqb_spec; simpl; try easy.
+  inversion 2. subst. generalize (NN.spec_pos y); auto with zarith.
+ Qed.
+
+ Ltac destr_norm_pos x :=
+  rewrite <- (spec_norm_pos x);
+  let H := fresh in
+  let x' := fresh x in
+  assert (H := spec_norm_pos_pos x);
+  destruct (norm_pos x) as [x'|x'];
+   specialize (H x' (eq_refl _)) || clear H.
+
+ Lemma spec_testbit: forall x p, testbit x p = Z.testbit (to_Z x) (to_Z p).
+ Proof.
+  intros x p. unfold testbit.
+  destr_norm_pos p; simpl. destr_norm_pos x; simpl.
+  apply NN.spec_testbit.
+  rewrite NN.spec_testbit, NN.spec_pred, Z.max_r by auto with zarith.
+  symmetry. apply Z.bits_opp. apply NN.spec_pos.
+  symmetry. apply Z.testbit_neg_r; auto with zarith.
+ Qed.
+
+ Lemma spec_shiftl: forall x p, to_Z (shiftl x p) = Z.shiftl (to_Z x) (to_Z p).
+ Proof.
+  intros x p. unfold shiftl.
+  destr_norm_pos x; destruct p as [p|p]; simpl;
+   assert (Hp := NN.spec_pos p).
+  apply NN.spec_shiftl.
+  rewrite Z.shiftl_opp_r. apply NN.spec_shiftr.
+  rewrite !NN.spec_shiftl.
+  rewrite !Z.shiftl_mul_pow2 by apply NN.spec_pos.
+  symmetry. apply Z.mul_opp_l.
+  rewrite Z.shiftl_opp_r, NN.spec_succ, NN.spec_shiftr, NN.spec_pred, Z.max_r
+   by auto with zarith.
+  now rewrite Zlnot_alt1, Z.lnot_shiftr, Zlnot_alt2.
+ Qed.
+
+ Lemma spec_shiftr: forall x p, to_Z (shiftr x p) = Z.shiftr (to_Z x) (to_Z p).
+ Proof.
+  intros. unfold shiftr. rewrite spec_shiftl, spec_opp.
+  apply Z.shiftl_opp_r.
+ Qed.
+
+ Lemma spec_land: forall x y, to_Z (land x y) = Z.land (to_Z x) (to_Z y).
+ Proof.
+  intros x y. unfold land.
+  destr_norm_pos x; destr_norm_pos y; simpl;
+   rewrite ?NN.spec_succ, ?NN.spec_land, ?NN.spec_ldiff, ?NN.spec_lor,
+    ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith.
+  now rewrite Z.ldiff_land, Zlnot_alt2.
+  now rewrite Z.ldiff_land, Z.land_comm, Zlnot_alt2.
+  now rewrite Z.lnot_lor, !Zlnot_alt2.
+ Qed.
+
+ Lemma spec_lor: forall x y, to_Z (lor x y) = Z.lor (to_Z x) (to_Z y).
+ Proof.
+  intros x y. unfold lor.
+  destr_norm_pos x; destr_norm_pos y; simpl;
+   rewrite ?NN.spec_succ, ?NN.spec_land, ?NN.spec_ldiff, ?NN.spec_lor,
+    ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith.
+  now rewrite Z.lnot_ldiff, Z.lor_comm, Zlnot_alt2.
+  now rewrite Z.lnot_ldiff, Zlnot_alt2.
+  now rewrite Z.lnot_land, !Zlnot_alt2.
+ Qed.
+
+ Lemma spec_ldiff: forall x y, to_Z (ldiff x y) = Z.ldiff (to_Z x) (to_Z y).
+ Proof.
+  intros x y. unfold ldiff.
+  destr_norm_pos x; destr_norm_pos y; simpl;
+   rewrite ?NN.spec_succ, ?NN.spec_land, ?NN.spec_ldiff, ?NN.spec_lor,
+    ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith.
+  now rewrite Z.ldiff_land, Zlnot_alt3.
+  now rewrite Z.lnot_lor, Z.ldiff_land, <- Zlnot_alt2.
+  now rewrite 2 Z.ldiff_land, Zlnot_alt2, Z.land_comm, Zlnot_alt3.
+ Qed.
+
+ Lemma spec_lxor: forall x y, to_Z (lxor x y) = Z.lxor (to_Z x) (to_Z y).
+ Proof.
+  intros x y. unfold lxor.
+  destr_norm_pos x; destr_norm_pos y; simpl;
+   rewrite ?NN.spec_succ, ?NN.spec_lxor, ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1;
+   auto with zarith.
+  now rewrite !Z.lnot_lxor_r, Zlnot_alt2.
+  now rewrite !Z.lnot_lxor_l, Zlnot_alt2.
+  now rewrite <- Z.lxor_lnot_lnot, !Zlnot_alt2.
+ Qed.
+
+ Lemma spec_div2: forall x, to_Z (div2 x) = Z.div2 (to_Z x).
+ Proof.
+  intros x. unfold div2. now rewrite spec_shiftr, Z.div2_spec, spec_1.
  Qed.
 
 End Make.
diff --git a/theories/Numbers/Integer/Binary/ZBinary.v b/theories/Numbers/Integer/Binary/ZBinary.v
index a7e05fee..fc600eae 100644
--- a/theories/Numbers/Integer/Binary/ZBinary.v
+++ b/theories/Numbers/Integer/Binary/ZBinary.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,107 +8,35 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: ZBinary.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
 
-
-Require Import ZAxioms ZProperties.
-Require Import ZArith_base.
+Require Import ZAxioms ZProperties BinInt.
 
 Local Open Scope Z_scope.
 
-(** * Implementation of [ZAxiomsSig] by [BinInt.Z] *)
-
-Module ZBinAxiomsMod <: ZAxiomsExtSig.
-
-(** Bi-directional induction. *)
-
-Theorem bi_induction :
-  forall A : Z -> Prop, Proper (eq ==> iff) A ->
-    A 0 -> (forall n : Z, A n <-> A (Zsucc n)) -> forall n : Z, A n.
-Proof.
-intros A A_wd A0 AS n; apply Zind; clear n.
-assumption.
-intros; rewrite <- Zsucc_succ'. now apply -> AS.
-intros n H. rewrite <- Zpred_pred'. rewrite Zsucc_pred in H. now apply <- AS.
-Qed.
-
-(** Basic operations. *)
-
-Definition eq_equiv : Equivalence (@eq Z) := eq_equivalence.
-Local Obligation Tactic := simpl_relation.
-Program Instance succ_wd : Proper (eq==>eq) Zsucc.
-Program Instance pred_wd : Proper (eq==>eq) Zpred.
-Program Instance add_wd : Proper (eq==>eq==>eq) Zplus.
-Program Instance sub_wd : Proper (eq==>eq==>eq) Zminus.
-Program Instance mul_wd : Proper (eq==>eq==>eq) Zmult.
-
-Definition pred_succ n := eq_sym (Zpred_succ n).
-Definition add_0_l := Zplus_0_l.
-Definition add_succ_l := Zplus_succ_l.
-Definition sub_0_r := Zminus_0_r.
-Definition sub_succ_r := Zminus_succ_r.
-Definition mul_0_l := Zmult_0_l.
-Definition mul_succ_l := Zmult_succ_l.
-
-(** Order *)
-
-Program Instance lt_wd : Proper (eq==>eq==>iff) Zlt.
-
-Definition lt_eq_cases := Zle_lt_or_eq_iff.
-Definition lt_irrefl := Zlt_irrefl.
-Definition lt_succ_r := Zlt_succ_r.
+(** BinInt.Z is already implementing [ZAxiomsMiniSig] *)
 
-Definition min_l := Zmin_l.
-Definition min_r := Zmin_r.
-Definition max_l := Zmax_l.
-Definition max_r := Zmax_r.
+Module Z
+ <: ZAxiomsSig <: UsualOrderedTypeFull <: TotalOrder
+ <: UsualDecidableTypeFull
+ := BinInt.Z.
 
-(** Properties specific to integers, not natural numbers. *)
+(** * An [order] tactic for integers *)
 
-Program Instance opp_wd : Proper (eq==>eq) Zopp.
+Ltac z_order := Z.order.
 
-Definition succ_pred n := eq_sym (Zsucc_pred n).
-Definition opp_0 := Zopp_0.
-Definition opp_succ := Zopp_succ.
+(** Note that [z_order] is domain-agnostic: it will not prove
+    [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
 
-(** Absolute value and sign *)
-
-Definition abs_eq := Zabs_eq.
-Definition abs_neq := Zabs_non_eq.
-
-Lemma sgn_null : forall x, x = 0 -> Zsgn x = 0.
-Proof. intros. apply <- Zsgn_null; auto. Qed.
-Lemma sgn_pos : forall x, 0 < x -> Zsgn x = 1.
-Proof. intros. apply <- Zsgn_pos; auto. Qed.
-Lemma sgn_neg : forall x, x < 0 -> Zsgn x = -1.
-Proof. intros. apply <- Zsgn_neg; auto. Qed.
-
-(** The instantiation of operations.
-    Placing them at the very end avoids having indirections in above lemmas. *)
-
-Definition t := Z.
-Definition eq := (@eq Z).
-Definition zero := 0.
-Definition succ := Zsucc.
-Definition pred := Zpred.
-Definition add := Zplus.
-Definition sub := Zminus.
-Definition mul := Zmult.
-Definition lt := Zlt.
-Definition le := Zle.
-Definition min := Zmin.
-Definition max := Zmax.
-Definition opp := Zopp.
-Definition abs := Zabs.
-Definition sgn := Zsgn.
-
-End ZBinAxiomsMod.
-
-Module Export ZBinPropMod := ZPropFunct ZBinAxiomsMod.
+Section TestOrder.
+ Let test : forall x y, x<=y -> y<=x -> x=y.
+ Proof.
+ z_order.
+ Qed.
+End TestOrder.
 
 (** Z forms a ring *)
 
-(*Lemma Zring : ring_theory 0 1 NZadd NZmul NZsub Zopp NZeq.
+(*Lemma Zring : ring_theory 0 1 NZadd NZmul NZsub Z.opp NZeq.
 Proof.
 constructor.
 exact Zadd_0_l.
@@ -123,18 +51,3 @@ exact Zadd_opp_r.
 Qed.
 
 Add Ring ZR : Zring.*)
-
-
-
-(*
-Theorem eq_equiv_e : forall x y : Z, E x y <-> e x y.
-Proof.
-intros x y; unfold E, e, Zeq_bool; split; intro H.
-rewrite H; now rewrite Zcompare_refl.
-rewrite eq_true_unfold_pos in H.
-assert (H1 : (x ?= y) = Eq).
-case_eq (x ?= y); intro H1; rewrite H1 in H; simpl in H;
-[reflexivity | discriminate H | discriminate H].
-now apply Zcompare_Eq_eq.
-Qed.
-*)
diff --git a/theories/Numbers/Integer/NatPairs/ZNatPairs.v b/theories/Numbers/Integer/NatPairs/ZNatPairs.v
index ea3d9ad9..b5e1fa5b 100644
--- a/theories/Numbers/Integer/NatPairs/ZNatPairs.v
+++ b/theories/Numbers/Integer/NatPairs/ZNatPairs.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,25 +8,25 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: ZNatPairs.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import NProperties. (* The most complete file for N *)
-Require Export ZProperties. (* The most complete file for Z *)
+Require Import NSub ZAxioms.
 Require Export Ring.
 
 Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope.
 Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope.
-Open Local Scope pair_scope.
+Local Open Scope pair_scope.
 
-Module ZPairsAxiomsMod (Import N : NAxiomsSig) <: ZAxiomsSig.
-Module Import NPropMod := NPropFunct N. (* Get all properties of N *)
+Module ZPairsAxiomsMod (Import N : NAxiomsMiniSig) <: ZAxiomsMiniSig.
+ Module Import NProp.
+   Include NSubProp N.
+ End NProp.
 
 Delimit Scope NScope with N.
 Bind Scope NScope with N.t.
 Infix "=="  := N.eq (at level 70) : NScope.
 Notation "x ~= y" := (~ N.eq x y) (at level 70) : NScope.
 Notation "0" := N.zero : NScope.
-Notation "1" := (N.succ N.zero) : NScope.
+Notation "1" := N.one : NScope.
+Notation "2" := N.two : NScope.
 Infix "+" := N.add : NScope.
 Infix "-" := N.sub : NScope.
 Infix "*" := N.mul : NScope.
@@ -44,6 +44,8 @@ Module Z.
 
 Definition t := (N.t * N.t)%type.
 Definition zero : t := (0, 0).
+Definition one : t := (1,0).
+Definition two : t := (2,0).
 Definition eq (p q : t) := (p#1 + q#2 == q#1 + p#2).
 Definition succ (n : t) : t := (N.succ n#1, n#2).
 Definition pred (n : t) : t := (n#1, N.succ n#2).
@@ -57,7 +59,7 @@ Definition le (n m : t) := n#1 + m#2 <= m#1 + n#2.
 Definition min (n m : t) : t := (min (n#1 + m#2) (m#1 + n#2), n#2 + m#2).
 Definition max (n m : t) : t := (max (n#1 + m#2) (m#1 + n#2), n#2 + m#2).
 
-(** NB : We do not have [Zpred (Zsucc n) = n] but only [Zpred (Zsucc n) == n].
+(** NB : We do not have [Z.pred (Z.succ n) = n] but only [Z.pred (Z.succ n) == n].
     It could be possible to consider as canonical only pairs where
     one of the elements is 0, and make all operations convert
     canonical values into other canonical values. In that case, we
@@ -74,7 +76,8 @@ Bind Scope ZScope with Z.t.
 Infix "=="  := Z.eq (at level 70) : ZScope.
 Notation "x ~= y" := (~ Z.eq x y) (at level 70) : ZScope.
 Notation "0" := Z.zero : ZScope.
-Notation "1" := (Z.succ Z.zero) : ZScope.
+Notation "1" := Z.one : ZScope.
+Notation "2" := Z.two : ZScope.
 Infix "+" := Z.add : ZScope.
 Infix "-" := Z.sub : ZScope.
 Infix "*" := Z.mul : ZScope.
@@ -128,15 +131,14 @@ Qed.
 
 Instance sub_wd : Proper (Z.eq ==> Z.eq ==> Z.eq) Z.sub.
 Proof.
-intros n1 m1 H1 n2 m2 H2. rewrite 2 sub_add_opp.
-apply add_wd, opp_wd; auto.
+intros n1 m1 H1 n2 m2 H2. rewrite 2 sub_add_opp. now do 2 f_equiv.
 Qed.
 
 Lemma mul_comm : forall n m, n*m == m*n.
 Proof.
 intros (n1,n2) (m1,m2); compute.
 rewrite (add_comm (m1*n2)%N).
-apply N.add_wd; apply N.add_wd; apply mul_comm.
+do 2 f_equiv; apply mul_comm.
 Qed.
 
 Instance mul_wd : Proper (Z.eq ==> Z.eq ==> Z.eq) Z.mul.
@@ -160,20 +162,22 @@ Hypothesis A_wd : Proper (Z.eq==>iff) A.
 Theorem bi_induction :
   A 0 -> (forall n, A n <-> A (Z.succ n)) -> forall n, A n.
 Proof.
+Open Scope NScope.
 intros A0 AS n; unfold Z.zero, Z.succ, Z.eq in *.
 destruct n as [n m].
-cut (forall p, A (p, 0%N)); [intro H1 |].
-cut (forall p, A (0%N, p)); [intro H2 |].
+cut (forall p, A (p, 0)); [intro H1 |].
+cut (forall p, A (0, p)); [intro H2 |].
 destruct (add_dichotomy n m) as [[p H] | [p H]].
-rewrite (A_wd (n, m) (0%N, p)) by (rewrite add_0_l; now rewrite add_comm).
+rewrite (A_wd (n, m) (0, p)) by (rewrite add_0_l; now rewrite add_comm).
 apply H2.
-rewrite (A_wd (n, m) (p, 0%N)) by now rewrite add_0_r. apply H1.
+rewrite (A_wd (n, m) (p, 0)) by now rewrite add_0_r. apply H1.
 induct p. assumption. intros p IH.
-apply -> (A_wd (0%N, p) (1%N, N.succ p)) in IH; [| now rewrite add_0_l, add_1_l].
-now apply <- AS.
+apply (A_wd (0, p) (1, N.succ p)) in IH; [| now rewrite add_0_l, add_1_l].
+rewrite one_succ in IH. now apply AS.
 induct p. assumption. intros p IH.
-replace 0%N with (snd (p, 0%N)); [| reflexivity].
-replace (N.succ p) with (N.succ (fst (p, 0%N))); [| reflexivity]. now apply -> AS.
+replace 0 with (snd (p, 0)); [| reflexivity].
+replace (N.succ p) with (N.succ (fst (p, 0))); [| reflexivity]. now apply -> AS.
+Close Scope NScope.
 Qed.
 
 End Induction.
@@ -190,6 +194,16 @@ Proof.
 intro n; unfold Z.succ, Z.pred, Z.eq; simpl; now nzsimpl.
 Qed.
 
+Theorem one_succ : 1 == Z.succ 0.
+Proof.
+unfold Z.eq; simpl. now nzsimpl'.
+Qed.
+
+Theorem two_succ : 2 == Z.succ 1.
+Proof.
+unfold Z.eq; simpl. now nzsimpl'.
+Qed.
+
 Theorem opp_0 : - 0 == 0.
 Proof.
 unfold Z.opp, Z.eq; simpl. now nzsimpl.
@@ -298,6 +312,8 @@ Qed.
 Definition t := Z.t.
 Definition eq := Z.eq.
 Definition zero := Z.zero.
+Definition one := Z.one.
+Definition two := Z.two.
 Definition succ := Z.succ.
 Definition pred := Z.pred.
 Definition add := Z.add.
diff --git a/theories/Numbers/Integer/SpecViaZ/ZSig.v b/theories/Numbers/Integer/SpecViaZ/ZSig.v
index ff797e32..0a26a910 100644
--- a/theories/Numbers/Integer/SpecViaZ/ZSig.v
+++ b/theories/Numbers/Integer/SpecViaZ/ZSig.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,9 +8,7 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: ZSig.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import ZArith Znumtheory.
+Require Import BinInt.
 
 Open Scope Z_scope.
 
@@ -35,11 +33,14 @@ Module Type ZType.
  Parameter spec_of_Z: forall x, to_Z (of_Z x) = x.
 
  Parameter compare : t -> t -> comparison.
- Parameter eq_bool : t -> t -> bool.
+ Parameter eqb : t -> t -> bool.
+ Parameter ltb : t -> t -> bool.
+ Parameter leb : t -> t -> bool.
  Parameter min : t -> t -> t.
  Parameter max : t -> t -> t.
  Parameter zero : t.
  Parameter one : t.
+ Parameter two : t.
  Parameter minus_one : t.
  Parameter succ : t -> t.
  Parameter add  : t -> t -> t.
@@ -48,22 +49,39 @@ Module Type ZType.
  Parameter opp : t -> t.
  Parameter mul : t -> t -> t.
  Parameter square : t -> t.
- Parameter power_pos : t -> positive -> t.
- Parameter power : t -> N -> t.
+ Parameter pow_pos : t -> positive -> t.
+ Parameter pow_N : t -> N -> t.
+ Parameter pow : t -> t -> t.
  Parameter sqrt : t -> t.
+ Parameter log2 : t -> t.
  Parameter div_eucl : t -> t -> t * t.
  Parameter div : t -> t -> t.
  Parameter modulo : t -> t -> t.
+ Parameter quot : t -> t -> t.
+ Parameter rem : t -> t -> t.
  Parameter gcd : t -> t -> t.
  Parameter sgn : t -> t.
  Parameter abs : t -> t.
+ Parameter even : t -> bool.
+ Parameter odd : t -> bool.
+ Parameter testbit : t -> t -> bool.
+ Parameter shiftr : t -> t -> t.
+ Parameter shiftl : t -> t -> t.
+ Parameter land : t -> t -> t.
+ Parameter lor : t -> t -> t.
+ Parameter ldiff : t -> t -> t.
+ Parameter lxor : t -> t -> t.
+ Parameter div2 : t -> t.
 
- Parameter spec_compare: forall x y, compare x y = Zcompare [x] [y].
- Parameter spec_eq_bool: forall x y, eq_bool x y = Zeq_bool [x] [y].
- Parameter spec_min : forall x y, [min x y] = Zmin [x] [y].
- Parameter spec_max : forall x y, [max x y] = Zmax [x] [y].
+ Parameter spec_compare: forall x y, compare x y = ([x] ?= [y]).
+ Parameter spec_eqb : forall x y, eqb x y = ([x] =? [y]).
+ Parameter spec_ltb : forall x y, ltb x y = ([x] <? [y]).
+ Parameter spec_leb : forall x y, leb x y = ([x] <=? [y]).
+ Parameter spec_min : forall x y, [min x y] = Z.min [x] [y].
+ Parameter spec_max : forall x y, [max x y] = Z.max [x] [y].
  Parameter spec_0: [zero] = 0.
  Parameter spec_1: [one] = 1.
+ Parameter spec_2: [two] = 2.
  Parameter spec_m1: [minus_one] = -1.
  Parameter spec_succ: forall n, [succ n] = [n] + 1.
  Parameter spec_add: forall x y, [add x y] = [x] + [y].
@@ -72,17 +90,30 @@ Module Type ZType.
  Parameter spec_opp: forall x, [opp x] = - [x].
  Parameter spec_mul: forall x y, [mul x y] = [x] * [y].
  Parameter spec_square: forall x, [square x] = [x] *  [x].
- Parameter spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n.
- Parameter spec_power: forall x n, [power x n] = [x] ^ Z_of_N n.
- Parameter spec_sqrt: forall x, 0 <= [x] ->
-   [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2.
+ Parameter spec_pow_pos: forall x n, [pow_pos x n] = [x] ^ Zpos n.
+ Parameter spec_pow_N: forall x n, [pow_N x n] = [x] ^ Z.of_N n.
+ Parameter spec_pow: forall x n, [pow x n] = [x] ^ [n].
+ Parameter spec_sqrt: forall x, [sqrt x] = Z.sqrt [x].
+ Parameter spec_log2: forall x, [log2 x] = Z.log2 [x].
  Parameter spec_div_eucl: forall x y,
-   let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y].
+   let (q,r) := div_eucl x y in ([q], [r]) = Z.div_eucl [x] [y].
  Parameter spec_div: forall x y, [div x y] = [x] / [y].
  Parameter spec_modulo: forall x y, [modulo x y] = [x] mod [y].
- Parameter spec_gcd: forall a b, [gcd a b] = Zgcd (to_Z a) (to_Z b).
- Parameter spec_sgn : forall x, [sgn x] = Zsgn [x].
- Parameter spec_abs : forall x, [abs x] = Zabs [x].
+ Parameter spec_quot: forall x y, [quot x y] = [x] ÷ [y].
+ Parameter spec_rem: forall x y, [rem x y] = Z.rem [x] [y].
+ Parameter spec_gcd: forall a b, [gcd a b] = Z.gcd [a] [b].
+ Parameter spec_sgn : forall x, [sgn x] = Z.sgn [x].
+ Parameter spec_abs : forall x, [abs x] = Z.abs [x].
+ Parameter spec_even : forall x, even x = Z.even [x].
+ Parameter spec_odd : forall x, odd x = Z.odd [x].
+ Parameter spec_testbit: forall x p, testbit x p = Z.testbit [x] [p].
+ Parameter spec_shiftr: forall x p, [shiftr x p] = Z.shiftr [x] [p].
+ Parameter spec_shiftl: forall x p, [shiftl x p] = Z.shiftl [x] [p].
+ Parameter spec_land: forall x y, [land x y] = Z.land [x] [y].
+ Parameter spec_lor: forall x y, [lor x y] = Z.lor [x] [y].
+ Parameter spec_ldiff: forall x y, [ldiff x y] = Z.ldiff [x] [y].
+ Parameter spec_lxor: forall x y, [lxor x y] = Z.lxor [x] [y].
+ Parameter spec_div2: forall x, [div2 x] = Z.div2 [x].
 
 End ZType.
 
@@ -90,12 +121,15 @@ Module Type ZType_Notation (Import Z:ZType).
  Notation "[ x ]" := (to_Z x).
  Infix "=="  := eq (at level 70).
  Notation "0" := zero.
+ Notation "1" := one.
+ Notation "2" := two.
  Infix "+" := add.
  Infix "-" := sub.
  Infix "*" := mul.
+ Infix "^" := pow.
  Notation "- x" := (opp x).
  Infix "<=" := le.
  Infix "<" := lt.
 End ZType_Notation.
 
-Module Type ZType' := ZType <+ ZType_Notation.
\ No newline at end of file
+Module Type ZType' := ZType <+ ZType_Notation.
diff --git a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
index 879a17dd..e2ec3482 100644
--- a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
+++ b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
@@ -1,27 +1,24 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ZSigZAxioms.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+Require Import Bool ZArith OrdersFacts Nnat ZAxioms ZSig.
 
-Require Import ZArith ZAxioms ZDivFloor ZSig.
+(** * The interface [ZSig.ZType] implies the interface [ZAxiomsSig] *)
 
-(** * The interface [ZSig.ZType] implies the interface [ZAxiomsSig]
-
-    It also provides [sgn], [abs], [div], [mod]
-*)
-
-
-Module ZTypeIsZAxioms (Import Z : ZType').
+Module ZTypeIsZAxioms (Import ZZ : ZType').
 
 Hint Rewrite
- spec_0 spec_1 spec_add spec_sub spec_pred spec_succ
- spec_mul spec_opp spec_of_Z spec_div spec_modulo
- spec_compare spec_eq_bool spec_max spec_min spec_abs spec_sgn
+ spec_0 spec_1 spec_2 spec_add spec_sub spec_pred spec_succ
+ spec_mul spec_opp spec_of_Z spec_div spec_modulo spec_square spec_sqrt
+ spec_compare spec_eqb spec_ltb spec_leb spec_max spec_min
+ spec_abs spec_sgn spec_pow spec_log2 spec_even spec_odd spec_gcd
+ spec_quot spec_rem spec_testbit spec_shiftl spec_shiftr
+ spec_land spec_lor spec_ldiff spec_lxor spec_div2
  : zsimpl.
 
 Ltac zsimpl := autorewrite with zsimpl.
@@ -44,9 +41,19 @@ Proof.
 intros. zify. auto with zarith.
 Qed.
 
+Theorem one_succ : 1 == succ 0.
+Proof.
+now zify.
+Qed.
+
+Theorem two_succ : 2 == succ 1.
+Proof.
+now zify.
+Qed.
+
 Section Induction.
 
-Variable A : Z.t -> Prop.
+Variable A : ZZ.t -> Prop.
 Hypothesis A_wd : Proper (eq==>iff) A.
 Hypothesis A0 : A 0.
 Hypothesis AS : forall n, A n <-> A (succ n).
@@ -86,7 +93,7 @@ replace z with (-(-z))%Z in * by (auto with zarith).
 remember (-z)%Z as z'.
 pattern z'; apply natlike_ind.
 apply B0.
-intros; rewrite Zopp_succ; unfold Zpred; apply BP; auto.
+intros; rewrite Z.opp_succ; unfold Z.pred; apply BP; auto.
 subst z'; auto with zarith.
 Qed.
 
@@ -131,36 +138,66 @@ Qed.
 
 (** Order *)
 
-Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y).
+Lemma eqb_eq x y : eqb x y = true <-> x == y.
+Proof.
+ zify. apply Z.eqb_eq.
+Qed.
+
+Lemma leb_le x y : leb x y = true <-> x <= y.
+Proof.
+ zify. apply Z.leb_le.
+Qed.
+
+Lemma ltb_lt x y : ltb x y = true <-> x < y.
 Proof.
- intros. zify. destruct (Zcompare_spec [x] [y]); auto.
+ zify. apply Z.ltb_lt.
 Qed.
 
-Definition eqb := eq_bool.
+Lemma compare_eq_iff n m : compare n m = Eq <-> n == m.
+Proof.
+ intros. zify. apply Z.compare_eq_iff.
+Qed.
+
+Lemma compare_lt_iff n m : compare n m = Lt <-> n < m.
+Proof.
+ intros. zify. reflexivity.
+Qed.
 
-Lemma eqb_eq : forall x y, eq_bool x y = true <-> x == y.
+Lemma compare_le_iff n m : compare n m <> Gt <-> n <= m.
 Proof.
- intros. zify. symmetry. apply Zeq_is_eq_bool.
+ intros. zify. reflexivity.
 Qed.
 
+Lemma compare_antisym n m : compare m n = CompOpp (compare n m).
+Proof.
+ intros. zify. apply Z.compare_antisym.
+Qed.
+
+Include BoolOrderFacts ZZ ZZ ZZ [no inline].
+
 Instance compare_wd : Proper (eq ==> eq ==> Logic.eq) compare.
 Proof.
-intros x x' Hx y y' Hy. rewrite 2 spec_compare, Hx, Hy; intuition.
+intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
 Qed.
 
-Instance lt_wd : Proper (eq ==> eq ==> iff) lt.
+Instance eqb_wd : Proper (eq ==> eq ==> Logic.eq) eqb.
 Proof.
-intros x x' Hx y y' Hy; unfold lt; rewrite Hx, Hy; intuition.
+intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
 Qed.
 
-Theorem lt_eq_cases : forall n m, n <= m <-> n < m \/ n == m.
+Instance ltb_wd : Proper (eq ==> eq ==> Logic.eq) ltb.
 Proof.
-intros. zify. omega.
+intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
 Qed.
 
-Theorem lt_irrefl : forall n, ~ n < n.
+Instance leb_wd : Proper (eq ==> eq ==> Logic.eq) leb.
 Proof.
-intros. zify. omega.
+intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
+Qed.
+
+Instance lt_wd : Proper (eq ==> eq ==> iff) lt.
+Proof.
+intros x x' Hx y y' Hy; unfold lt; rewrite Hx, Hy; intuition.
 Qed.
 
 Theorem lt_succ_r : forall n m, n < (succ m) <-> n <= m.
@@ -190,13 +227,15 @@ Qed.
 
 (** Part specific to integers, not natural numbers *)
 
-Program Instance opp_wd : Proper (eq ==> eq) opp.
-
 Theorem succ_pred : forall n, succ (pred n) == n.
 Proof.
 intros. zify. auto with zarith.
 Qed.
 
+(** Opp *)
+
+Program Instance opp_wd : Proper (eq ==> eq) opp.
+
 Theorem opp_0 : - 0 == 0.
 Proof.
 intros. zify. auto with zarith.
@@ -207,6 +246,8 @@ Proof.
 intros. zify. auto with zarith.
 Qed.
 
+(** Abs / Sgn *)
+
 Theorem abs_eq : forall n, 0 <= n -> abs n == n.
 Proof.
 intros n. zify. omega with *.
@@ -222,22 +263,108 @@ Proof.
 intros n. zify. omega with *.
 Qed.
 
-Theorem sgn_pos : forall n, 0<n -> sgn n == succ 0.
+Theorem sgn_pos : forall n, 0<n -> sgn n == 1.
 Proof.
 intros n. zify. omega with *.
 Qed.
 
-Theorem sgn_neg : forall n, n<0 -> sgn n == opp (succ 0).
+Theorem sgn_neg : forall n, n<0 -> sgn n == opp 1.
 Proof.
 intros n. zify. omega with *.
 Qed.
 
+(** Power *)
+
+Program Instance pow_wd : Proper (eq==>eq==>eq) pow.
+
+Lemma pow_0_r : forall a, a^0 == 1.
+Proof.
+ intros. now zify.
+Qed.
+
+Lemma pow_succ_r : forall a b, 0<=b -> a^(succ b) == a * a^b.
+Proof.
+ intros a b. zify. intros. now rewrite Z.add_1_r, Z.pow_succ_r.
+Qed.
+
+Lemma pow_neg_r : forall a b, b<0 -> a^b == 0.
+Proof.
+ intros a b. zify. intros Hb.
+ destruct [b]; reflexivity || discriminate.
+Qed.
+
+Lemma pow_pow_N : forall a b, 0<=b -> a^b == pow_N a (Z.to_N (to_Z b)).
+Proof.
+ intros a b. zify. intros Hb. now rewrite spec_pow_N, Z2N.id.
+Qed.
+
+Lemma pow_pos_N : forall a p, pow_pos a p == pow_N a (Npos p).
+Proof.
+ intros a b. red. now rewrite spec_pow_N, spec_pow_pos.
+Qed.
+
+(** Square *)
+
+Lemma square_spec n : square n == n * n.
+Proof.
+ now zify.
+Qed.
+
+(** Sqrt *)
+
+Lemma sqrt_spec : forall n, 0<=n ->
+ (sqrt n)*(sqrt n) <= n /\ n < (succ (sqrt n))*(succ (sqrt n)).
+Proof.
+ intros n. zify. apply Z.sqrt_spec.
+Qed.
+
+Lemma sqrt_neg : forall n, n<0 -> sqrt n == 0.
+Proof.
+ intros n. zify. apply Z.sqrt_neg.
+Qed.
+
+(** Log2 *)
+
+Lemma log2_spec : forall n, 0<n ->
+ 2^(log2 n) <= n /\ n < 2^(succ (log2 n)).
+Proof.
+ intros n. zify. apply Z.log2_spec.
+Qed.
+
+Lemma log2_nonpos : forall n, n<=0 -> log2 n == 0.
+Proof.
+ intros n. zify. apply Z.log2_nonpos.
+Qed.
+
+(** Even / Odd *)
+
+Definition Even n := exists m, n == 2*m.
+Definition Odd n := exists m, n == 2*m+1.
+
+Lemma even_spec n : even n = true <-> Even n.
+Proof.
+ unfold Even. zify. rewrite Z.even_spec.
+ split; intros (m,Hm).
+ - exists (of_Z m). now zify.
+ - exists [m]. revert Hm. now zify.
+Qed.
+
+Lemma odd_spec n : odd n = true <-> Odd n.
+Proof.
+ unfold Odd. zify. rewrite Z.odd_spec.
+ split; intros (m,Hm).
+ - exists (of_Z m). now zify.
+ - exists [m]. revert Hm. now zify.
+Qed.
+
+(** Div / Mod *)
+
 Program Instance div_wd : Proper (eq==>eq==>eq) div.
 Program Instance mod_wd : Proper (eq==>eq==>eq) modulo.
 
 Theorem div_mod : forall a b, ~b==0 -> a == b*(div a b) + (modulo a b).
 Proof.
-intros a b. zify. intros. apply Z_div_mod_eq_full; auto.
+intros a b. zify. intros. apply Z.div_mod; auto.
 Qed.
 
 Theorem mod_pos_bound :
@@ -252,8 +379,149 @@ Proof.
 intros a b. zify. intros. apply Z_mod_neg; auto with zarith.
 Qed.
 
+Definition mod_bound_pos :
+ forall a b, 0<=a -> 0<b -> 0 <= modulo a b /\ modulo a b < b :=
+ fun a b _ H => mod_pos_bound a b H.
+
+(** Quot / Rem *)
+
+Program Instance quot_wd : Proper (eq==>eq==>eq) quot.
+Program Instance rem_wd : Proper (eq==>eq==>eq) rem.
+
+Theorem quot_rem : forall a b, ~b==0 -> a == b*(quot a b) + rem a b.
+Proof.
+intros a b. zify. apply Z.quot_rem.
+Qed.
+
+Theorem rem_bound_pos :
+ forall a b, 0<=a -> 0<b -> 0 <= rem a b /\ rem a b < b.
+Proof.
+intros a b. zify. apply Z.rem_bound_pos.
+Qed.
+
+Theorem rem_opp_l : forall a b, ~b==0 -> rem (-a) b == -(rem a b).
+Proof.
+intros a b. zify. apply Z.rem_opp_l.
+Qed.
+
+Theorem rem_opp_r : forall a b, ~b==0 -> rem a (-b) == rem a b.
+Proof.
+intros a b. zify. apply Z.rem_opp_r.
+Qed.
+
+(** Gcd *)
+
+Definition divide n m := exists p, m == p*n.
+Local Notation "( x | y )" := (divide x y) (at level 0).
+
+Lemma spec_divide : forall n m, (n|m) <-> Z.divide [n] [m].
+Proof.
+ intros n m. split.
+ - intros (p,H). exists [p]. revert H; now zify.
+ - intros (z,H). exists (of_Z z). now zify.
+Qed.
+
+Lemma gcd_divide_l : forall n m, (gcd n m | n).
+Proof.
+ intros n m. apply spec_divide. zify. apply Z.gcd_divide_l.
+Qed.
+
+Lemma gcd_divide_r : forall n m, (gcd n m | m).
+Proof.
+ intros n m. apply spec_divide. zify. apply Z.gcd_divide_r.
+Qed.
+
+Lemma gcd_greatest : forall n m p, (p|n) -> (p|m) -> (p|gcd n m).
+Proof.
+ intros n m p. rewrite !spec_divide. zify. apply Z.gcd_greatest.
+Qed.
+
+Lemma gcd_nonneg : forall n m, 0 <= gcd n m.
+Proof.
+ intros. zify. apply Z.gcd_nonneg.
+Qed.
+
+(** Bitwise operations *)
+
+Program Instance testbit_wd : Proper (eq==>eq==>Logic.eq) testbit.
+
+Lemma testbit_odd_0 : forall a, testbit (2*a+1) 0 = true.
+Proof.
+ intros. zify. apply Z.testbit_odd_0.
+Qed.
+
+Lemma testbit_even_0 : forall a, testbit (2*a) 0 = false.
+Proof.
+ intros. zify. apply Z.testbit_even_0.
+Qed.
+
+Lemma testbit_odd_succ : forall a n, 0<=n ->
+ testbit (2*a+1) (succ n) = testbit a n.
+Proof.
+ intros a n. zify. apply Z.testbit_odd_succ.
+Qed.
+
+Lemma testbit_even_succ : forall a n, 0<=n ->
+ testbit (2*a) (succ n) = testbit a n.
+Proof.
+ intros a n. zify. apply Z.testbit_even_succ.
+Qed.
+
+Lemma testbit_neg_r : forall a n, n<0 -> testbit a n = false.
+Proof.
+ intros a n. zify. apply Z.testbit_neg_r.
+Qed.
+
+Lemma shiftr_spec : forall a n m, 0<=m ->
+ testbit (shiftr a n) m = testbit a (m+n).
+Proof.
+ intros a n m. zify. apply Z.shiftr_spec.
+Qed.
+
+Lemma shiftl_spec_high : forall a n m, 0<=m -> n<=m ->
+ testbit (shiftl a n) m = testbit a (m-n).
+Proof.
+ intros a n m. zify. intros Hn H.
+ now apply Z.shiftl_spec_high.
+Qed.
+
+Lemma shiftl_spec_low : forall a n m, m<n ->
+ testbit (shiftl a n) m = false.
+Proof.
+ intros a n m. zify. intros H. now apply Z.shiftl_spec_low.
+Qed.
+
+Lemma land_spec : forall a b n,
+ testbit (land a b) n = testbit a n && testbit b n.
+Proof.
+ intros a n m. zify. now apply Z.land_spec.
+Qed.
+
+Lemma lor_spec : forall a b n,
+ testbit (lor a b) n = testbit a n || testbit b n.
+Proof.
+ intros a n m. zify. now apply Z.lor_spec.
+Qed.
+
+Lemma ldiff_spec : forall a b n,
+ testbit (ldiff a b) n = testbit a n && negb (testbit b n).
+Proof.
+ intros a n m. zify. now apply Z.ldiff_spec.
+Qed.
+
+Lemma lxor_spec : forall a b n,
+ testbit (lxor a b) n = xorb (testbit a n) (testbit b n).
+Proof.
+ intros a n m. zify. now apply Z.lxor_spec.
+Qed.
+
+Lemma div2_spec : forall a, div2 a == shiftr a 1.
+Proof.
+ intros a. zify. now apply Z.div2_spec.
+Qed.
+
 End ZTypeIsZAxioms.
 
-Module ZType_ZAxioms (Z : ZType)
- <: ZAxiomsSig <: ZDivSig <: HasCompare Z <: HasEqBool Z <: HasMinMax Z
- := Z <+ ZTypeIsZAxioms.
+Module ZType_ZAxioms (ZZ : ZType)
+ <: ZAxiomsSig <: OrderFunctions ZZ <: HasMinMax ZZ
+ := ZZ <+ ZTypeIsZAxioms.
diff --git a/theories/Numbers/NaryFunctions.v b/theories/Numbers/NaryFunctions.v
index 1d9a65dc..7cf3daea 100644
--- a/theories/Numbers/NaryFunctions.v
+++ b/theories/Numbers/NaryFunctions.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 (*          Pierre Letouzey, Jerome Vouillon, PPS, Paris 7, 2008        *)
 (************************************************************************)
 
-(*i $Id: NaryFunctions.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Local Open Scope type_scope.
 
 Require Import List.
diff --git a/theories/Numbers/NatInt/NZAdd.v b/theories/Numbers/NatInt/NZAdd.v
index 782619f0..83b2d63b 100644
--- a/theories/Numbers/NatInt/NZAdd.v
+++ b/theories/Numbers/NatInt/NZAdd.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,16 +8,15 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NZAdd.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import NZAxioms NZBase.
 
-Module Type NZAddPropSig
- (Import NZ : NZAxiomsSig')(Import NZBase : NZBasePropSig NZ).
+Module Type NZAddProp (Import NZ : NZAxiomsSig')(Import NZBase : NZBaseProp NZ).
 
 Hint Rewrite
  pred_succ add_0_l add_succ_l mul_0_l mul_succ_l sub_0_r sub_succ_r : nz.
+Hint Rewrite one_succ two_succ : nz'.
 Ltac nzsimpl := autorewrite with nz.
+Ltac nzsimpl' := autorewrite with nz nz'.
 
 Theorem add_0_r : forall n, n + 0 == n.
 Proof.
@@ -31,6 +30,11 @@ intros n m; nzinduct n. now nzsimpl.
 intro. nzsimpl. now rewrite succ_inj_wd.
 Qed.
 
+Theorem add_succ_comm : forall n m, S n + m == n + S m.
+Proof.
+intros n m. now rewrite add_succ_r, add_succ_l.
+Qed.
+
 Hint Rewrite add_0_r add_succ_r : nz.
 
 Theorem add_comm : forall n m, n + m == m + n.
@@ -41,14 +45,16 @@ Qed.
 
 Theorem add_1_l : forall n, 1 + n == S n.
 Proof.
-intro n; now nzsimpl.
+intro n; now nzsimpl'.
 Qed.
 
 Theorem add_1_r : forall n, n + 1 == S n.
 Proof.
-intro n; now nzsimpl.
+intro n; now nzsimpl'.
 Qed.
 
+Hint Rewrite add_1_l add_1_r : nz.
+
 Theorem add_assoc : forall n m p, n + (m + p) == (n + m) + p.
 Proof.
 intros n m p; nzinduct n. now nzsimpl.
@@ -78,13 +84,19 @@ Qed.
 
 Theorem add_shuffle2 : forall n m p q, (n + m) + (p + q) == (n + q) + (m + p).
 Proof.
-intros n m p q.
-rewrite 2 add_assoc, add_shuffle0, add_cancel_r. apply add_shuffle0.
+intros n m p q. rewrite (add_comm p). apply add_shuffle1.
+Qed.
+
+Theorem add_shuffle3 : forall n m p, n + (m + p) == m + (n + p).
+Proof.
+intros n m p. now rewrite add_comm, <- add_assoc, (add_comm p).
 Qed.
 
 Theorem sub_1_r : forall n, n - 1 == P n.
 Proof.
-intro n; now nzsimpl.
+intro n; now nzsimpl'.
 Qed.
 
-End NZAddPropSig.
+Hint Rewrite sub_1_r : nz.
+
+End NZAddProp.
diff --git a/theories/Numbers/NatInt/NZAddOrder.v b/theories/Numbers/NatInt/NZAddOrder.v
index ed56cd8f..ed179699 100644
--- a/theories/Numbers/NatInt/NZAddOrder.v
+++ b/theories/Numbers/NatInt/NZAddOrder.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,12 +8,10 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NZAddOrder.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import NZAxioms NZBase NZMul NZOrder.
 
-Module Type NZAddOrderPropSig (Import NZ : NZOrdAxiomsSig').
-Include NZBasePropSig NZ <+ NZMulPropSig NZ <+ NZOrderPropSig NZ.
+Module Type NZAddOrderProp (Import NZ : NZOrdAxiomsSig').
+Include NZBaseProp NZ <+ NZMulProp NZ <+ NZOrderProp NZ.
 
 Theorem add_lt_mono_l : forall n m p, n < m <-> p + n < p + m.
 Proof.
@@ -30,7 +28,7 @@ Theorem add_lt_mono : forall n m p q, n < m -> p < q -> n + p < m + q.
 Proof.
 intros n m p q H1 H2.
 apply lt_trans with (m + p);
-[now apply -> add_lt_mono_r | now apply -> add_lt_mono_l].
+[now apply add_lt_mono_r | now apply add_lt_mono_l].
 Qed.
 
 Theorem add_le_mono_l : forall n m p, n <= m <-> p + n <= p + m.
@@ -48,21 +46,21 @@ Theorem add_le_mono : forall n m p q, n <= m -> p <= q -> n + p <= m + q.
 Proof.
 intros n m p q H1 H2.
 apply le_trans with (m + p);
-[now apply -> add_le_mono_r | now apply -> add_le_mono_l].
+[now apply add_le_mono_r | now apply add_le_mono_l].
 Qed.
 
 Theorem add_lt_le_mono : forall n m p q, n < m -> p <= q -> n + p < m + q.
 Proof.
 intros n m p q H1 H2.
 apply lt_le_trans with (m + p);
-[now apply -> add_lt_mono_r | now apply -> add_le_mono_l].
+[now apply add_lt_mono_r | now apply add_le_mono_l].
 Qed.
 
 Theorem add_le_lt_mono : forall n m p q, n <= m -> p < q -> n + p < m + q.
 Proof.
 intros n m p q H1 H2.
 apply le_lt_trans with (m + p);
-[now apply -> add_le_mono_r | now apply -> add_lt_mono_l].
+[now apply add_le_mono_r | now apply add_lt_mono_l].
 Qed.
 
 Theorem add_pos_pos : forall n m, 0 < n -> 0 < m -> 0 < n + m.
@@ -149,5 +147,22 @@ Proof.
 intros n m H; apply add_le_cases; now nzsimpl.
 Qed.
 
-End NZAddOrderPropSig.
+(** Substraction *)
+
+(** We can prove the existence of a subtraction of any number by
+    a smaller one *)
+
+Lemma le_exists_sub : forall n m, n<=m -> exists p, m == p+n /\ 0<=p.
+Proof.
+ intros n m H. apply le_ind with (4:=H). solve_proper.
+ exists 0; nzsimpl; split; order.
+ clear m H. intros m H (p & EQ & LE). exists (S p).
+  split. nzsimpl. now f_equiv. now apply le_le_succ_r.
+Qed.
+
+(** For the moment, it doesn't seem possible to relate
+    this existing subtraction with [sub].
+*)
+
+End NZAddOrderProp.
 
diff --git a/theories/Numbers/NatInt/NZAxioms.v b/theories/Numbers/NatInt/NZAxioms.v
index 33236cde..3a432eaa 100644
--- a/theories/Numbers/NatInt/NZAxioms.v
+++ b/theories/Numbers/NatInt/NZAxioms.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,8 +8,6 @@
 
 (** Initial Author : Evgeny Makarov, INRIA, 2007 *)
 
-(*i $Id: NZAxioms.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Equalities Orders NumPrelude GenericMinMax.
 
 (** Axiomatization of a domain with zero, successor, predecessor,
@@ -20,7 +18,7 @@ Require Export Equalities Orders NumPrelude GenericMinMax.
 *)
 
 Module Type ZeroSuccPred (Import T:Typ).
- Parameter Inline zero : t.
+ Parameter Inline(20) zero : t.
  Parameters Inline succ pred : t -> t.
 End ZeroSuccPred.
 
@@ -28,8 +26,6 @@ Module Type ZeroSuccPredNotation (T:Typ)(Import NZ:ZeroSuccPred T).
  Notation "0" := zero.
  Notation S := succ.
  Notation P := pred.
- Notation "1" := (S 0).
- Notation "2" := (S 1).
 End ZeroSuccPredNotation.
 
 Module Type ZeroSuccPred' (T:Typ) :=
@@ -44,9 +40,33 @@ Module Type IsNZDomain (Import E:Eq')(Import NZ:ZeroSuccPred' E).
     A 0 -> (forall n, A n <-> A (S n)) -> forall n, A n.
 End IsNZDomain.
 
-Module Type NZDomainSig := EqualityType <+ ZeroSuccPred <+ IsNZDomain.
-Module Type NZDomainSig' := EqualityType' <+ ZeroSuccPred' <+ IsNZDomain.
+(** Axiomatization of some more constants
+
+    Simply denoting "1" for (S 0) and so on works ok when implementing
+    by nat, but leaves some (N.succ N0) when implementing by N.
+*)
+
+Module Type OneTwo (Import T:Typ).
+ Parameter Inline(20) one two : t.
+End OneTwo.
 
+Module Type OneTwoNotation (T:Typ)(Import NZ:OneTwo T).
+ Notation "1" := one.
+ Notation "2" := two.
+End OneTwoNotation.
+
+Module Type OneTwo' (T:Typ) := OneTwo T <+ OneTwoNotation T.
+
+Module Type IsOneTwo (E:Eq')(Z:ZeroSuccPred' E)(O:OneTwo' E).
+ Import E Z O.
+ Axiom one_succ : 1 == S 0.
+ Axiom two_succ : 2 == S 1.
+End IsOneTwo.
+
+Module Type NZDomainSig :=
+ EqualityType <+ ZeroSuccPred <+ IsNZDomain <+ OneTwo <+ IsOneTwo.
+Module Type NZDomainSig' :=
+ EqualityType' <+ ZeroSuccPred' <+ IsNZDomain <+ OneTwo' <+ IsOneTwo.
 
 (** Axiomatization of basic operations : [+] [-] [*] *)
 
@@ -117,3 +137,9 @@ Module Type NZDecOrdSig' := NZOrdSig' <+ HasCompare.
 Module Type NZDecOrdAxiomsSig := NZOrdAxiomsSig <+ HasCompare.
 Module Type NZDecOrdAxiomsSig' := NZOrdAxiomsSig' <+ HasCompare.
 
+(** A square function *)
+
+Module Type NZSquare (Import NZ : NZBasicFunsSig').
+ Parameter Inline square : t -> t.
+ Axiom square_spec : forall n, square n == n * n.
+End NZSquare.
diff --git a/theories/Numbers/NatInt/NZBase.v b/theories/Numbers/NatInt/NZBase.v
index 119f8265..62b14829 100644
--- a/theories/Numbers/NatInt/NZBase.v
+++ b/theories/Numbers/NatInt/NZBase.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,11 +8,14 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NZBase.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import NZAxioms.
 
-Module Type NZBasePropSig (Import NZ : NZDomainSig').
+Module Type NZBaseProp (Import NZ : NZDomainSig').
+
+(** An artificial scope meant to be substituted later *)
+
+Delimit Scope abstract_scope with abstract.
+Bind Scope abstract_scope with t.
 
 Include BackportEq NZ NZ. (** eq_refl, eq_sym, eq_trans *)
 
@@ -50,7 +53,7 @@ Theorem succ_inj_wd : forall n1 n2, S n1 == S n2 <-> n1 == n2.
 Proof.
 intros; split.
 apply succ_inj.
-apply succ_wd.
+intros. now f_equiv.
 Qed.
 
 Theorem succ_inj_wd_neg : forall n m, S n ~= S m <-> n ~= m.
@@ -63,7 +66,7 @@ left-inverse to the successor at this point *)
 
 Section CentralInduction.
 
-Variable A : predicate t.
+Variable A : t -> Prop.
 Hypothesis A_wd : Proper (eq==>iff) A.
 
 Theorem central_induction :
@@ -72,7 +75,7 @@ Theorem central_induction :
       forall n, A n.
 Proof.
 intros z Base Step; revert Base; pattern z; apply bi_induction.
-solve_predicate_wd.
+solve_proper.
 intro; now apply bi_induction.
 intro; pose proof (Step n); tauto.
 Qed.
@@ -85,5 +88,5 @@ Tactic Notation "nzinduct" ident(n) :=
 Tactic Notation "nzinduct" ident(n) constr(u) :=
   induction_maker n ltac:(apply central_induction with (z := u)).
 
-End NZBasePropSig.
+End NZBaseProp.
 
diff --git a/theories/Numbers/NatInt/NZBits.v b/theories/Numbers/NatInt/NZBits.v
new file mode 100644
index 00000000..8be5d45c
--- /dev/null
+++ b/theories/Numbers/NatInt/NZBits.v
@@ -0,0 +1,64 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Bool NZAxioms NZMulOrder NZParity NZPow NZDiv NZLog.
+
+(** Axiomatization of some bitwise operations *)
+
+Module Type Bits (Import A : Typ).
+ Parameter Inline testbit : t -> t -> bool.
+ Parameters Inline shiftl shiftr land lor ldiff lxor : t -> t -> t.
+ Parameter Inline div2 : t -> t.
+End Bits.
+
+Module Type BitsNotation (Import A : Typ)(Import B : Bits A).
+ Notation "a .[ n ]" := (testbit a n) (at level 5, format "a .[ n ]").
+ Infix ">>" := shiftr (at level 30, no associativity).
+ Infix "<<" := shiftl (at level 30, no associativity).
+End BitsNotation.
+
+Module Type Bits' (A:Typ) := Bits A <+ BitsNotation A.
+
+Module Type NZBitsSpec
+ (Import A : NZOrdAxiomsSig')(Import B : Bits' A).
+
+ Declare Instance testbit_wd : Proper (eq==>eq==>Logic.eq) testbit.
+ Axiom testbit_odd_0 : forall a, (2*a+1).[0] = true.
+ Axiom testbit_even_0 : forall a, (2*a).[0] = false.
+ Axiom testbit_odd_succ : forall a n, 0<=n -> (2*a+1).[S n] = a.[n].
+ Axiom testbit_even_succ : forall a n, 0<=n -> (2*a).[S n] = a.[n].
+ Axiom testbit_neg_r : forall a n, n<0 -> a.[n] = false.
+
+ Axiom shiftr_spec : forall a n m, 0<=m -> (a >> n).[m] = a.[m+n].
+ Axiom shiftl_spec_high : forall a n m, 0<=m -> n<=m -> (a << n).[m] = a.[m-n].
+ Axiom shiftl_spec_low : forall a n m, m<n -> (a << n).[m] = false.
+
+ Axiom land_spec : forall a b n, (land a b).[n] = a.[n] && b.[n].
+ Axiom lor_spec : forall a b n, (lor a b).[n] = a.[n] || b.[n].
+ Axiom ldiff_spec : forall a b n, (ldiff a b).[n] = a.[n] && negb b.[n].
+ Axiom lxor_spec : forall a b n, (lxor a b).[n] = xorb a.[n] b.[n].
+ Axiom div2_spec : forall a, div2 a == a >> 1.
+
+End NZBitsSpec.
+
+Module Type NZBits (A:NZOrdAxiomsSig) := Bits A <+ NZBitsSpec A.
+Module Type NZBits' (A:NZOrdAxiomsSig) := Bits' A <+ NZBitsSpec A.
+
+(** In the functor of properties will also be defined:
+   - [setbit : t -> t -> t ] defined as [lor a (1<<n)].
+   - [clearbit : t -> t -> t ] defined as [ldiff a (1<<n)].
+   - [ones : t -> t], the number with [n] initial true bits,
+     corresponding to [2^n - 1].
+   - a logical complement [lnot]. For integer numbers it will
+     be a [t->t], doing a swap of all bits, while on natural
+     numbers, it will be a bounded complement [t->t->t], swapping
+     only the first [n] bits.
+*)
+
+(** For the moment, no shared properties about NZ here,
+  since properties and proofs for N and Z are quite different *)
diff --git a/theories/Numbers/NatInt/NZDiv.v b/theories/Numbers/NatInt/NZDiv.v
index ba1c171e..4b8a62a8 100644
--- a/theories/Numbers/NatInt/NZDiv.v
+++ b/theories/Numbers/NatInt/NZDiv.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -12,44 +12,36 @@ Require Import NZAxioms NZMulOrder.
 
 (** The first signatures will be common to all divisions over NZ, N and Z *)
 
-Module Type DivMod (Import T:Typ).
+Module Type DivMod (Import A : Typ).
  Parameters Inline div modulo : t -> t -> t.
 End DivMod.
 
-Module Type DivModNotation (T:Typ)(Import NZ:DivMod T).
+Module Type DivModNotation (A : Typ)(Import B : DivMod A).
  Infix "/" := div.
  Infix "mod" := modulo (at level 40, no associativity).
 End DivModNotation.
 
-Module Type DivMod' (T:Typ) := DivMod T <+ DivModNotation T.
+Module Type DivMod' (A : Typ) := DivMod A <+ DivModNotation A.
 
-Module Type NZDivCommon (Import NZ : NZAxiomsSig')(Import DM : DivMod' NZ).
+Module Type NZDivSpec (Import A : NZOrdAxiomsSig')(Import B : DivMod' A).
  Declare Instance div_wd : Proper (eq==>eq==>eq) div.
  Declare Instance mod_wd : Proper (eq==>eq==>eq) modulo.
  Axiom div_mod : forall a b, b ~= 0 -> a == b*(a/b) + (a mod b).
-End NZDivCommon.
+ Axiom mod_bound_pos : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b.
+End NZDivSpec.
 
 (** The different divisions will only differ in the conditions
-    they impose on [modulo]. For NZ, we only describe behavior
-    on positive numbers.
-
-    NB: This axiom would also be true for N and Z, but redundant.
+    they impose on [modulo]. For NZ, we have only described the
+    behavior on positive numbers.
 *)
 
-Module Type NZDivSpecific (Import NZ : NZOrdAxiomsSig')(Import DM : DivMod' NZ).
- Axiom mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b.
-End NZDivSpecific.
-
-Module Type NZDiv (NZ:NZOrdAxiomsSig)
- := DivMod NZ <+ NZDivCommon NZ <+ NZDivSpecific NZ.
+Module Type NZDiv (A : NZOrdAxiomsSig) := DivMod A <+ NZDivSpec A.
+Module Type NZDiv' (A : NZOrdAxiomsSig) := NZDiv A <+ DivModNotation A.
 
-Module Type NZDiv' (NZ:NZOrdAxiomsSig) := NZDiv NZ <+ DivModNotation NZ.
-
-Module NZDivPropFunct
- (Import NZ : NZOrdAxiomsSig')
- (Import NZP : NZMulOrderPropSig NZ)
- (Import NZD : NZDiv' NZ)
-.
+Module Type NZDivProp
+ (Import A : NZOrdAxiomsSig')
+ (Import B : NZDiv' A)
+ (Import C : NZMulOrderProp A).
 
 (** Uniqueness theorems *)
 
@@ -84,7 +76,7 @@ Theorem div_unique:
 Proof.
 intros a b q r Ha (Hb,Hr) EQ.
 destruct (div_mod_unique b q (a/b) r (a mod b)); auto.
-apply mod_bound; order.
+apply mod_bound_pos; order.
 rewrite <- div_mod; order.
 Qed.
 
@@ -94,18 +86,21 @@ Theorem mod_unique:
 Proof.
 intros a b q r Ha (Hb,Hr) EQ.
 destruct (div_mod_unique b q (a/b) r (a mod b)); auto.
-apply mod_bound; order.
+apply mod_bound_pos; order.
 rewrite <- div_mod; order.
 Qed.
 
+Theorem div_unique_exact a b q:
+ 0<=a -> 0<b -> a == b*q -> q == a/b.
+Proof.
+ intros Ha Hb H. apply div_unique with 0; nzsimpl; now try split.
+Qed.
 
 (** A division by itself returns 1 *)
 
 Lemma div_same : forall a, 0<a -> a/a == 1.
 Proof.
-intros. symmetry.
-apply div_unique with 0; intuition; try order.
-now nzsimpl.
+intros. symmetry. apply div_unique_exact; nzsimpl; order.
 Qed.
 
 Lemma mod_same : forall a, 0<a -> a mod a == 0.
@@ -147,9 +142,7 @@ Qed.
 
 Lemma div_1_r: forall a, 0<=a -> a/1 == a.
 Proof.
-intros. symmetry.
-apply div_unique with 0; try split; try order; try apply lt_0_1.
-now nzsimpl.
+intros. symmetry. apply div_unique_exact; nzsimpl; order'.
 Qed.
 
 Lemma mod_1_r: forall a, 0<=a -> a mod 1 == 0.
@@ -161,20 +154,19 @@ Qed.
 
 Lemma div_1_l: forall a, 1<a -> 1/a == 0.
 Proof.
-intros; apply div_small; split; auto. apply le_succ_diag_r.
+intros; apply div_small; split; auto. apply le_0_1.
 Qed.
 
 Lemma mod_1_l: forall a, 1<a -> 1 mod a == 1.
 Proof.
-intros; apply mod_small; split; auto. apply le_succ_diag_r.
+intros; apply mod_small; split; auto. apply le_0_1.
 Qed.
 
 Lemma div_mul : forall a b, 0<=a -> 0<b -> (a*b)/b == a.
 Proof.
-intros; symmetry.
-apply div_unique with 0; try split; try order.
+intros; symmetry. apply div_unique_exact; trivial.
 apply mul_nonneg_nonneg; order.
-nzsimpl; apply mul_comm.
+apply mul_comm.
 Qed.
 
 Lemma mod_mul : forall a b, 0<=a -> 0<b -> (a*b) mod b == 0.
@@ -194,7 +186,7 @@ Theorem mod_le: forall a b, 0<=a -> 0<b -> a mod b <= a.
 Proof.
 intros. destruct (le_gt_cases b a).
 apply le_trans with b; auto.
-apply lt_le_incl. destruct (mod_bound a b); auto.
+apply lt_le_incl. destruct (mod_bound_pos a b); auto.
 rewrite lt_eq_cases; right.
 apply mod_small; auto.
 Qed.
@@ -216,7 +208,7 @@ Lemma div_str_pos : forall a b, 0<b<=a -> 0 < a/b.
 Proof.
 intros a b (Hb,Hab).
 assert (LE : 0 <= a/b) by (apply div_pos; order).
-assert (MOD : a mod b < b) by (destruct (mod_bound a b); order).
+assert (MOD : a mod b < b) by (destruct (mod_bound_pos a b); order).
 rewrite lt_eq_cases in LE; destruct LE as [LT|EQ]; auto.
 exfalso; revert Hab.
 rewrite (div_mod a b), <-EQ; nzsimpl; order.
@@ -263,7 +255,7 @@ rewrite <- (mul_1_l (a/b)) at 1.
 rewrite <- mul_lt_mono_pos_r; auto.
 apply div_str_pos; auto.
 rewrite <- (add_0_r (b*(a/b))) at 1.
-rewrite <- add_le_mono_l. destruct (mod_bound a b); order.
+rewrite <- add_le_mono_l. destruct (mod_bound_pos a b); order.
 Qed.
 
 (** [le] is compatible with a positive division. *)
@@ -282,8 +274,8 @@ apply lt_le_trans with b; auto.
 rewrite (div_mod b c) at 1 by order.
 rewrite <- add_assoc, <- add_le_mono_l.
 apply le_trans with (c+0).
-nzsimpl; destruct (mod_bound b c); order.
-rewrite <- add_le_mono_l. destruct (mod_bound a c); order.
+nzsimpl; destruct (mod_bound_pos b c); order.
+rewrite <- add_le_mono_l. destruct (mod_bound_pos a c); order.
 Qed.
 
 (** The following two properties could be used as specification of div *)
@@ -293,7 +285,7 @@ Proof.
 intros.
 rewrite (add_le_mono_r _ _ (a mod b)), <- div_mod by order.
 rewrite <- (add_0_r a) at 1.
-rewrite <- add_le_mono_l. destruct (mod_bound a b); order.
+rewrite <- add_le_mono_l. destruct (mod_bound_pos a b); order.
 Qed.
 
 Lemma mul_succ_div_gt : forall a b, 0<=a -> 0<b -> a < b*(S (a/b)).
@@ -302,7 +294,7 @@ intros.
 rewrite (div_mod a b) at 1 by order.
 rewrite (mul_succ_r).
 rewrite <- add_lt_mono_l.
-destruct (mod_bound a b); auto.
+destruct (mod_bound_pos a b); auto.
 Qed.
 
 
@@ -359,7 +351,7 @@ Proof.
  apply mul_le_mono_nonneg_r; try order.
  apply div_pos; order.
  rewrite <- (add_0_r (r*(p/r))) at 1.
- rewrite <- add_le_mono_l. destruct (mod_bound p r); order.
+ rewrite <- add_le_mono_l. destruct (mod_bound_pos p r); order.
 Qed.
 
 
@@ -371,7 +363,7 @@ Proof.
  intros.
  symmetry.
  apply mod_unique with (a/c+b); auto.
- apply mod_bound; auto.
+ apply mod_bound_pos; auto.
  rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order.
  now rewrite mul_comm.
 Qed.
@@ -404,8 +396,8 @@ Proof.
  apply div_unique with ((a mod b)*c).
  apply mul_nonneg_nonneg; order.
  split.
- apply mul_nonneg_nonneg; destruct (mod_bound a b); order.
- rewrite <- mul_lt_mono_pos_r; auto. destruct (mod_bound a b); auto.
+ apply mul_nonneg_nonneg; destruct (mod_bound_pos a b); order.
+ rewrite <- mul_lt_mono_pos_r; auto. destruct (mod_bound_pos a b); auto.
  rewrite (div_mod a b) at 1 by order.
  rewrite mul_add_distr_r.
  rewrite add_cancel_r.
@@ -441,7 +433,7 @@ Qed.
 Theorem mod_mod: forall a n, 0<=a -> 0<n ->
  (a mod n) mod n == a mod n.
 Proof.
- intros. destruct (mod_bound a n); auto. now rewrite mod_small_iff.
+ intros. destruct (mod_bound_pos a n); auto. now rewrite mod_small_iff.
 Qed.
 
 Lemma mul_mod_idemp_l : forall a b n, 0<=a -> 0<=b -> 0<n ->
@@ -454,7 +446,7 @@ Proof.
  rewrite mul_add_distr_l, mul_assoc.
  intros. rewrite mod_add; auto.
  now rewrite mul_comm.
- apply mul_nonneg_nonneg; destruct (mod_bound a n); auto.
+ apply mul_nonneg_nonneg; destruct (mod_bound_pos a n); auto.
 Qed.
 
 Lemma mul_mod_idemp_r : forall a b n, 0<=a -> 0<=b -> 0<n ->
@@ -467,7 +459,7 @@ Theorem mul_mod: forall a b n, 0<=a -> 0<=b -> 0<n ->
  (a * b) mod n == ((a mod n) * (b mod n)) mod n.
 Proof.
  intros. rewrite mul_mod_idemp_l, mul_mod_idemp_r; trivial. reflexivity.
- now destruct (mod_bound b n).
+ now destruct (mod_bound_pos b n).
 Qed.
 
 Lemma add_mod_idemp_l : forall a b n, 0<=a -> 0<=b -> 0<n ->
@@ -478,7 +470,7 @@ Proof.
  rewrite (div_mod a n) at 1 2 by order.
  rewrite <- add_assoc, add_comm, mul_comm.
  intros. rewrite mod_add; trivial. reflexivity.
- apply add_nonneg_nonneg; auto. destruct (mod_bound a n); auto.
+ apply add_nonneg_nonneg; auto. destruct (mod_bound_pos a n); auto.
 Qed.
 
 Lemma add_mod_idemp_r : forall a b n, 0<=a -> 0<=b -> 0<n ->
@@ -491,7 +483,7 @@ Theorem add_mod: forall a b n, 0<=a -> 0<=b -> 0<n ->
  (a+b) mod n == (a mod n + b mod n) mod n.
 Proof.
  intros. rewrite add_mod_idemp_l, add_mod_idemp_r; trivial. reflexivity.
- now destruct (mod_bound b n).
+ now destruct (mod_bound_pos b n).
 Qed.
 
 Lemma div_div : forall a b c, 0<=a -> 0<b -> 0<c ->
@@ -500,7 +492,7 @@ Proof.
  intros a b c Ha Hb Hc.
  apply div_unique with (b*((a/b) mod c) + a mod b); trivial.
  (* begin 0<= ... <b*c *)
- destruct (mod_bound (a/b) c), (mod_bound a b); auto using div_pos.
+ destruct (mod_bound_pos (a/b) c), (mod_bound_pos a b); auto using div_pos.
  split.
  apply add_nonneg_nonneg; auto.
  apply mul_nonneg_nonneg; order.
@@ -514,6 +506,18 @@ Proof.
  apply div_mod; order.
 Qed.
 
+Lemma mod_mul_r : forall a b c, 0<=a -> 0<b -> 0<c ->
+ a mod (b*c) == a mod b + b*((a/b) mod c).
+Proof.
+ intros a b c Ha Hb Hc.
+ apply add_cancel_l with (b*c*(a/(b*c))).
+ rewrite <- div_mod by (apply neq_mul_0; split; order).
+ rewrite <- div_div by trivial.
+ rewrite add_assoc, add_shuffle0, <- mul_assoc, <- mul_add_distr_l.
+ rewrite <- div_mod by order.
+ apply div_mod; order.
+Qed.
+
 (** A last inequality: *)
 
 Theorem div_mul_le:
@@ -538,5 +542,5 @@ Proof.
  rewrite (mul_le_mono_pos_l _ _ b); auto. nzsimpl. order.
 Qed.
 
-End NZDivPropFunct.
+End NZDivProp.
 
diff --git a/theories/Numbers/NatInt/NZDomain.v b/theories/Numbers/NatInt/NZDomain.v
index 9dba3c3c..4b71d539 100644
--- a/theories/Numbers/NatInt/NZDomain.v
+++ b/theories/Numbers/NatInt/NZDomain.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: NZDomain.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NumPrelude NZAxioms.
 Require Import NZBase NZOrder NZAddOrder Plus Minus.
 
@@ -16,97 +14,36 @@ Require Import NZBase NZOrder NZAddOrder Plus Minus.
     translation from Peano numbers [nat] into NZ.
 *)
 
-(** First, a section about iterating a function. *)
-
-Section Iter.
-Variable A : Type.
-Fixpoint iter (f:A->A)(n:nat) : A -> A := fun a =>
-  match n with
-    | O => a
-    | S n => f (iter f n a)
-  end.
-Infix "^" := iter.
-
-Lemma iter_alt : forall f n m, (f^(Datatypes.S n)) m = (f^n) (f m).
-Proof.
-induction n; simpl; auto.
-intros; rewrite <- IHn; auto.
-Qed.
-
-Lemma iter_plus : forall f n n' m, (f^(n+n')) m = (f^n) ((f^n') m).
-Proof.
-induction n; simpl; auto.
-intros; rewrite IHn; auto.
-Qed.
+(** First, some complements about [nat_iter] *)
 
-Lemma iter_plus_bis : forall f n n' m, (f^(n+n')) m = (f^n') ((f^n) m).
-Proof.
-induction n; simpl; auto.
-intros. rewrite <- iter_alt, IHn; auto.
-Qed.
+Local Notation "f ^ n" := (nat_iter n f).
 
-Global Instance iter_wd (R:relation A) : Proper ((R==>R)==>eq==>R==>R) iter.
+Instance nat_iter_wd n {A} (R:relation A) :
+ Proper ((R==>R)==>R==>R) (nat_iter n).
 Proof.
-intros f f' Hf n n' Hn; subst n'. induction n; simpl; red; auto.
+intros f f' Hf. induction n; simpl; red; auto.
 Qed.
 
-End Iter.
-Implicit Arguments iter [A].
-Local Infix "^" := iter.
-
-
 Module NZDomainProp (Import NZ:NZDomainSig').
+Include NZBaseProp NZ.
 
 (** * Relationship between points thanks to [succ] and [pred]. *)
 
-(** We prove that any points in NZ have a common descendant by [succ] *)
-
-Definition common_descendant n m := exists k, exists l, (S^k) n == (S^l) m.
-
-Instance common_descendant_wd : Proper (eq==>eq==>iff) common_descendant.
-Proof.
-unfold common_descendant. intros n n' Hn m m' Hm.
-setoid_rewrite Hn. setoid_rewrite Hm. auto with *.
-Qed.
-
-Instance common_descendant_equiv : Equivalence common_descendant.
-Proof.
-split; red.
-intros x. exists O; exists O. simpl; auto with *.
-intros x y (p & q & H); exists q; exists p; auto with *.
-intros x y z (p & q & Hpq) (r & s & Hrs).
-exists (r+p)%nat. exists (q+s)%nat.
-rewrite !iter_plus. rewrite Hpq, <-Hrs, <-iter_plus, <- iter_plus_bis.
-auto with *.
-Qed.
-
-Lemma common_descendant_with_0 : forall n, common_descendant n 0.
-Proof.
-apply bi_induction.
-intros n n' Hn. rewrite Hn; auto with *.
-reflexivity.
-split; intros (p & q & H).
-exists p; exists (Datatypes.S q). rewrite <- iter_alt; simpl.
- apply succ_wd; auto.
-exists (Datatypes.S p); exists q. rewrite iter_alt; auto.
-Qed.
-
-Lemma common_descendant_always : forall n m, common_descendant n m.
-Proof.
-intros. transitivity 0; [|symmetry]; apply common_descendant_with_0.
-Qed.
-
-(** Thanks to [succ] being injective, we can then deduce that for any two
-    points, one is an iterated successor of the other. *)
+(** For any two points, one is an iterated successor of the other. *)
 
-Lemma itersucc_or_itersucc : forall n m, exists k, n == (S^k) m \/ m == (S^k) n.
+Lemma itersucc_or_itersucc n m : exists k, n == (S^k) m \/ m == (S^k) n.
 Proof.
-intros n m. destruct (common_descendant_always n m) as (k & l & H).
-revert l H. induction k.
-simpl. intros; exists l; left; auto with *.
-intros. destruct l.
-simpl in *. exists (Datatypes.S k); right; auto with *.
-simpl in *. apply pred_wd in H; rewrite !pred_succ in H. eauto.
+nzinduct n m.
+exists 0%nat. now left.
+intros n. split; intros [k [L|R]].
+exists (Datatypes.S k). left. now apply succ_wd.
+destruct k as [|k].
+simpl in R. exists 1%nat. left. now apply succ_wd.
+rewrite nat_iter_succ_r in R. exists k. now right.
+destruct k as [|k]; simpl in L.
+exists 1%nat. now right.
+apply succ_inj in L. exists k. now left.
+exists (Datatypes.S k). right. now rewrite nat_iter_succ_r.
 Qed.
 
 (** Generalized version of [pred_succ] when iterating *)
@@ -116,7 +53,7 @@ Proof.
 induction k.
 simpl; auto with *.
 simpl; intros. apply pred_wd in H. rewrite pred_succ in H. apply IHk in H; auto.
-rewrite <- iter_alt in H; auto.
+rewrite <- nat_iter_succ_r in H; auto.
 Qed.
 
 (** From a given point, all others are iterated successors
@@ -307,7 +244,7 @@ End NZOfNat.
 
 Module NZOfNatOrd (Import NZ:NZOrdSig').
 Include NZOfNat NZ.
-Include NZOrderPropFunct NZ.
+Include NZBaseProp NZ <+ NZOrderProp NZ.
 Local Open Scope ofnat.
 
 Theorem ofnat_S_gt_0 :
@@ -315,8 +252,8 @@ Theorem ofnat_S_gt_0 :
 Proof.
 unfold ofnat.
 intros n; induction n as [| n IH]; simpl in *.
-apply lt_0_1.
-apply lt_trans with 1. apply lt_0_1. now rewrite <- succ_lt_mono.
+apply lt_succ_diag_r.
+apply lt_trans with (S 0). apply lt_succ_diag_r. now rewrite <- succ_lt_mono.
 Qed.
 
 Theorem ofnat_S_neq_0 :
@@ -375,14 +312,14 @@ Lemma ofnat_add_l : forall n m, [n]+m == (S^n) m.
 Proof.
  induction n; intros.
  apply add_0_l.
- rewrite ofnat_succ, add_succ_l. simpl; apply succ_wd; auto.
+ rewrite ofnat_succ, add_succ_l. simpl. now f_equiv.
 Qed.
 
 Lemma ofnat_add : forall n m, [n+m] == [n]+[m].
 Proof.
  intros. rewrite ofnat_add_l.
  induction n; simpl. reflexivity.
- rewrite ofnat_succ. now apply succ_wd.
+ rewrite ofnat_succ. now f_equiv.
 Qed.
 
 Lemma ofnat_mul : forall n m, [n*m] == [n]*[m].
@@ -391,14 +328,14 @@ Proof.
  symmetry. apply mul_0_l.
  rewrite plus_comm.
  rewrite ofnat_succ, ofnat_add, mul_succ_l.
- now apply add_wd.
+ now f_equiv.
 Qed.
 
 Lemma ofnat_sub_r : forall n m, n-[m] == (P^m) n.
 Proof.
  induction m; simpl; intros.
  rewrite ofnat_zero. apply sub_0_r.
- rewrite ofnat_succ, sub_succ_r. now apply pred_wd.
+ rewrite ofnat_succ, sub_succ_r. now f_equiv.
 Qed.
 
 Lemma ofnat_sub : forall n m, m<=n -> [n-m] == [n]-[m].
@@ -409,7 +346,7 @@ Proof.
  intros.
  destruct n.
  inversion H.
- rewrite iter_alt.
+ rewrite nat_iter_succ_r.
  simpl.
  rewrite ofnat_succ, pred_succ; auto with arith.
 Qed.
diff --git a/theories/Numbers/NatInt/NZGcd.v b/theories/Numbers/NatInt/NZGcd.v
new file mode 100644
index 00000000..d7e598fb
--- /dev/null
+++ b/theories/Numbers/NatInt/NZGcd.v
@@ -0,0 +1,307 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Greatest Common Divisor *)
+
+Require Import NZAxioms NZMulOrder.
+
+(** Interface of a gcd function, then its specification on naturals *)
+
+Module Type Gcd (Import A : Typ).
+ Parameter Inline gcd : t -> t -> t.
+End Gcd.
+
+Module Type NZGcdSpec (A : NZOrdAxiomsSig')(B : Gcd A).
+ Import A B.
+ Definition divide n m := exists p, m == p*n.
+ Local Notation "( n | m )" := (divide n m) (at level 0).
+ Axiom gcd_divide_l : forall n m, (gcd n m | n).
+ Axiom gcd_divide_r : forall n m, (gcd n m | m).
+ Axiom gcd_greatest : forall n m p, (p | n) -> (p | m) -> (p | gcd n m).
+ Axiom gcd_nonneg : forall n m, 0 <= gcd n m.
+End NZGcdSpec.
+
+Module Type DivideNotation (A:NZOrdAxiomsSig')(B:Gcd A)(C:NZGcdSpec A B).
+ Import A B C.
+ Notation "( n | m )" := (divide n m) (at level 0).
+End DivideNotation.
+
+Module Type NZGcd (A : NZOrdAxiomsSig) := Gcd A <+ NZGcdSpec A.
+Module Type NZGcd' (A : NZOrdAxiomsSig) :=
+ Gcd A <+ NZGcdSpec A <+ DivideNotation A.
+
+(** Derived properties of gcd *)
+
+Module NZGcdProp
+ (Import A : NZOrdAxiomsSig')
+ (Import B : NZGcd' A)
+ (Import C : NZMulOrderProp A).
+
+(** Results concerning divisibility*)
+
+Instance divide_wd : Proper (eq==>eq==>iff) divide.
+Proof.
+ unfold divide. intros x x' Hx y y' Hy.
+ setoid_rewrite Hx. setoid_rewrite Hy. easy.
+Qed.
+
+Lemma divide_1_l : forall n, (1 | n).
+Proof.
+ intros n. exists n. now nzsimpl.
+Qed.
+
+Lemma divide_0_r : forall n, (n | 0).
+Proof.
+ intros n. exists 0. now nzsimpl.
+Qed.
+
+Hint Rewrite divide_1_l divide_0_r : nz.
+
+Lemma divide_0_l : forall n, (0 | n) -> n==0.
+Proof.
+ intros n (m,Hm). revert Hm. now nzsimpl.
+Qed.
+
+Lemma eq_mul_1_nonneg : forall n m,
+ 0<=n -> n*m == 1 -> n==1 /\ m==1.
+Proof.
+ intros n m Hn H.
+ le_elim Hn.
+ destruct (lt_ge_cases m 0) as [Hm|Hm].
+ generalize (mul_pos_neg n m Hn Hm). order'.
+ le_elim Hm.
+ apply le_succ_l in Hn. rewrite <- one_succ in Hn.
+ le_elim Hn.
+ generalize (lt_1_mul_pos n m Hn Hm). order.
+ rewrite <- Hn, mul_1_l in H. now split.
+ rewrite <- Hm, mul_0_r in H. order'.
+ rewrite <- Hn, mul_0_l in H. order'.
+Qed.
+
+Lemma eq_mul_1_nonneg' : forall n m,
+ 0<=m -> n*m == 1 -> n==1 /\ m==1.
+Proof.
+ intros n m Hm H. rewrite mul_comm in H.
+ now apply and_comm, eq_mul_1_nonneg.
+Qed.
+
+Lemma divide_1_r_nonneg : forall n, 0<=n -> (n | 1) -> n==1.
+Proof.
+ intros n Hn (m,Hm). symmetry in Hm.
+ now apply (eq_mul_1_nonneg' m n).
+Qed.
+
+Lemma divide_refl : forall n, (n | n).
+Proof.
+ intros n. exists 1. now nzsimpl.
+Qed.
+
+Lemma divide_trans : forall n m p, (n | m) -> (m | p) -> (n | p).
+Proof.
+ intros n m p (q,Hq) (r,Hr). exists (r*q).
+ now rewrite Hr, Hq, mul_assoc.
+Qed.
+
+Instance divide_reflexive : Reflexive divide := divide_refl.
+Instance divide_transitive : Transitive divide := divide_trans.
+
+(** Due to sign, no general antisymmetry result *)
+
+Lemma divide_antisym_nonneg : forall n m,
+ 0<=n -> 0<=m -> (n | m) -> (m | n) -> n == m.
+Proof.
+ intros n m Hn Hm (q,Hq) (r,Hr).
+ le_elim Hn.
+ destruct (lt_ge_cases q 0) as [Hq'|Hq'].
+ generalize (mul_neg_pos q n Hq' Hn). order.
+ rewrite Hq, mul_assoc in Hr. symmetry in Hr.
+ apply mul_id_l in Hr; [|order].
+ destruct (eq_mul_1_nonneg' r q) as [_ H]; trivial.
+ now rewrite H, mul_1_l in Hq.
+ rewrite <- Hn, mul_0_r in Hq. now rewrite <- Hn.
+Qed.
+
+Lemma mul_divide_mono_l : forall n m p, (n | m) -> (p * n | p * m).
+Proof.
+ intros n m p (q,Hq). exists q. now rewrite mul_shuffle3, Hq.
+Qed.
+
+Lemma mul_divide_mono_r : forall n m p, (n | m) -> (n * p | m * p).
+Proof.
+ intros n m p (q,Hq). exists q. now rewrite mul_assoc, Hq.
+Qed.
+
+Lemma mul_divide_cancel_l : forall n m p, p ~= 0 ->
+ ((p * n | p * m) <-> (n | m)).
+Proof.
+ intros n m p Hp. split.
+ intros (q,Hq). exists q. now rewrite mul_shuffle3, mul_cancel_l in Hq.
+ apply mul_divide_mono_l.
+Qed.
+
+Lemma mul_divide_cancel_r : forall n m p, p ~= 0 ->
+ ((n * p | m * p) <-> (n | m)).
+Proof.
+ intros. rewrite 2 (mul_comm _ p). now apply mul_divide_cancel_l.
+Qed.
+
+Lemma divide_add_r : forall n m p, (n | m) -> (n | p) -> (n | m + p).
+Proof.
+ intros n m p (q,Hq) (r,Hr). exists (q+r).
+ now rewrite mul_add_distr_r, Hq, Hr.
+Qed.
+
+Lemma divide_mul_l : forall n m p, (n | m) -> (n | m * p).
+Proof.
+ intros n m p (q,Hq). exists (q*p). now rewrite mul_shuffle0, Hq.
+Qed.
+
+Lemma divide_mul_r : forall n m p, (n | p) -> (n | m * p).
+Proof.
+ intros n m p. rewrite mul_comm. apply divide_mul_l.
+Qed.
+
+Lemma divide_factor_l : forall n m, (n | n * m).
+Proof.
+ intros. apply divide_mul_l, divide_refl.
+Qed.
+
+Lemma divide_factor_r : forall n m, (n | m * n).
+Proof.
+ intros. apply divide_mul_r, divide_refl.
+Qed.
+
+Lemma divide_pos_le : forall n m, 0 < m -> (n | m) -> n <= m.
+Proof.
+ intros n m Hm (q,Hq).
+ destruct (le_gt_cases n 0) as [Hn|Hn]. order.
+ rewrite Hq.
+ destruct (lt_ge_cases q 0) as [Hq'|Hq'].
+ generalize (mul_neg_pos q n Hq' Hn). order.
+ le_elim Hq'.
+ rewrite <- (mul_1_l n) at 1. apply mul_le_mono_pos_r; trivial.
+ now rewrite one_succ, le_succ_l.
+ rewrite <- Hq', mul_0_l in Hq. order.
+Qed.
+
+(** Basic properties of gcd *)
+
+Lemma gcd_unique : forall n m p,
+ 0<=p -> (p|n) -> (p|m) ->
+ (forall q, (q|n) -> (q|m) -> (q|p)) ->
+ gcd n m == p.
+Proof.
+ intros n m p Hp Hn Hm H.
+ apply divide_antisym_nonneg; trivial. apply gcd_nonneg.
+ apply H. apply gcd_divide_l. apply gcd_divide_r.
+ now apply gcd_greatest.
+Qed.
+
+Instance gcd_wd : Proper (eq==>eq==>eq) gcd.
+Proof.
+ intros x x' Hx y y' Hy.
+ apply gcd_unique.
+ apply gcd_nonneg.
+ rewrite Hx. apply gcd_divide_l.
+ rewrite Hy. apply gcd_divide_r.
+ intro. rewrite Hx, Hy. apply gcd_greatest.
+Qed.
+
+Lemma gcd_divide_iff : forall n m p,
+  (p | gcd n m) <-> (p | n) /\ (p | m).
+Proof.
+ intros. split. split.
+ transitivity (gcd n m); trivial using gcd_divide_l.
+ transitivity (gcd n m); trivial using gcd_divide_r.
+ intros (H,H'). now apply gcd_greatest.
+Qed.
+
+Lemma gcd_unique_alt : forall n m p, 0<=p ->
+ (forall q, (q|p) <-> (q|n) /\ (q|m)) ->
+ gcd n m == p.
+Proof.
+ intros n m p Hp H.
+ apply gcd_unique; trivial.
+ apply H. apply divide_refl.
+ apply H. apply divide_refl.
+ intros. apply H. now split.
+Qed.
+
+Lemma gcd_comm : forall n m, gcd n m == gcd m n.
+Proof.
+ intros. apply gcd_unique_alt; try apply gcd_nonneg.
+ intros. rewrite and_comm. apply gcd_divide_iff.
+Qed.
+
+Lemma gcd_assoc : forall n m p, gcd n (gcd m p) == gcd (gcd n m) p.
+Proof.
+ intros. apply gcd_unique_alt; try apply gcd_nonneg.
+ intros. now rewrite !gcd_divide_iff, and_assoc.
+Qed.
+
+Lemma gcd_0_l_nonneg : forall n, 0<=n -> gcd 0 n == n.
+Proof.
+ intros. apply gcd_unique; trivial.
+ apply divide_0_r.
+ apply divide_refl.
+Qed.
+
+Lemma gcd_0_r_nonneg : forall n, 0<=n -> gcd n 0 == n.
+Proof.
+ intros. now rewrite gcd_comm, gcd_0_l_nonneg.
+Qed.
+
+Lemma gcd_1_l : forall n, gcd 1 n == 1.
+Proof.
+ intros. apply gcd_unique; trivial using divide_1_l, le_0_1.
+Qed.
+
+Lemma gcd_1_r : forall n, gcd n 1 == 1.
+Proof.
+ intros. now rewrite gcd_comm, gcd_1_l.
+Qed.
+
+Lemma gcd_diag_nonneg : forall n, 0<=n -> gcd n n == n.
+Proof.
+ intros. apply gcd_unique; trivial using divide_refl.
+Qed.
+
+Lemma gcd_eq_0_l : forall n m, gcd n m == 0 -> n == 0.
+Proof.
+ intros.
+ generalize (gcd_divide_l n m). rewrite H. apply divide_0_l.
+Qed.
+
+Lemma gcd_eq_0_r : forall n m, gcd n m == 0 -> m == 0.
+Proof.
+ intros. apply gcd_eq_0_l with n. now rewrite gcd_comm.
+Qed.
+
+Lemma gcd_eq_0 : forall n m, gcd n m == 0 <-> n == 0 /\ m == 0.
+Proof.
+ intros. split. split.
+ now apply gcd_eq_0_l with m.
+ now apply gcd_eq_0_r with n.
+ intros (EQ,EQ'). rewrite EQ, EQ'. now apply gcd_0_r_nonneg.
+Qed.
+
+Lemma gcd_mul_diag_l : forall n m, 0<=n -> gcd n (n*m) == n.
+Proof.
+ intros n m Hn. apply gcd_unique_alt; trivial.
+ intros q. split. split; trivial. now apply divide_mul_l.
+ now destruct 1.
+Qed.
+
+Lemma divide_gcd_iff : forall n m, 0<=n -> ((n|m) <-> gcd n m == n).
+Proof.
+ intros n m Hn. split. intros (q,Hq). rewrite Hq.
+ rewrite mul_comm. now apply gcd_mul_diag_l.
+ intros EQ. rewrite <- EQ. apply gcd_divide_r.
+Qed.
+
+End NZGcdProp.
diff --git a/theories/Numbers/NatInt/NZLog.v b/theories/Numbers/NatInt/NZLog.v
new file mode 100644
index 00000000..fba91bf3
--- /dev/null
+++ b/theories/Numbers/NatInt/NZLog.v
@@ -0,0 +1,889 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Base-2 Logarithm *)
+
+Require Import NZAxioms NZMulOrder NZPow.
+
+(** Interface of a log2 function, then its specification on naturals *)
+
+Module Type Log2 (Import A : Typ).
+ Parameter Inline log2 : t -> t.
+End Log2.
+
+Module Type NZLog2Spec (A : NZOrdAxiomsSig')(B : Pow' A)(C : Log2 A).
+ Import A B C.
+ Axiom log2_spec : forall a, 0<a -> 2^(log2 a) <= a < 2^(S (log2 a)).
+ Axiom log2_nonpos : forall a, a<=0 -> log2 a == 0.
+End NZLog2Spec.
+
+Module Type NZLog2 (A : NZOrdAxiomsSig)(B : Pow A) := Log2 A <+ NZLog2Spec A B.
+
+(** Derived properties of logarithm *)
+
+Module Type NZLog2Prop
+ (Import A : NZOrdAxiomsSig')
+ (Import B : NZPow' A)
+ (Import C : NZLog2 A B)
+ (Import D : NZMulOrderProp A)
+ (Import E : NZPowProp A B D).
+
+(** log2 is always non-negative *)
+
+Lemma log2_nonneg : forall a, 0 <= log2 a.
+Proof.
+ intros a. destruct (le_gt_cases a 0) as [Ha|Ha].
+ now rewrite log2_nonpos.
+ destruct (log2_spec a Ha) as (_,LT).
+ apply lt_succ_r, (pow_gt_1 2). order'.
+ rewrite <- le_succ_l, <- one_succ in Ha. order.
+Qed.
+
+(** A tactic for proving positivity and non-negativity *)
+
+Ltac order_pos :=
+((apply add_pos_pos || apply add_nonneg_nonneg ||
+  apply mul_pos_pos || apply mul_nonneg_nonneg ||
+  apply pow_nonneg || apply pow_pos_nonneg ||
+  apply log2_nonneg || apply (le_le_succ_r 0));
+ order_pos) (* in case of success of an apply, we recurse *)
+|| order'.  (* otherwise *)
+
+(** The spec of log2 indeed determines it *)
+
+Lemma log2_unique : forall a b, 0<=b -> 2^b<=a<2^(S b) -> log2 a == b.
+Proof.
+ intros a b Hb (LEb,LTb).
+ assert (Ha : 0 < a).
+  apply lt_le_trans with (2^b); trivial.
+  apply pow_pos_nonneg; order'.
+ assert (Hc := log2_nonneg a).
+ destruct (log2_spec a Ha) as (LEc,LTc).
+ assert (log2 a <= b).
+  apply lt_succ_r, (pow_lt_mono_r_iff 2); try order'.
+  now apply le_le_succ_r.
+ assert (b <= log2 a).
+  apply lt_succ_r, (pow_lt_mono_r_iff 2); try order'.
+  now apply le_le_succ_r.
+ order.
+Qed.
+
+(** Hence log2 is a morphism. *)
+
+Instance log2_wd : Proper (eq==>eq) log2.
+Proof.
+ intros x x' Hx.
+ destruct (le_gt_cases x 0).
+ rewrite 2 log2_nonpos; trivial. reflexivity. now rewrite <- Hx.
+ apply log2_unique. apply log2_nonneg.
+ rewrite Hx in *. now apply log2_spec.
+Qed.
+
+(** An alternate specification *)
+
+Lemma log2_spec_alt : forall a, 0<a -> exists r,
+ a == 2^(log2 a) + r /\ 0 <= r < 2^(log2 a).
+Proof.
+ intros a Ha.
+ destruct (log2_spec _ Ha) as (LE,LT).
+ destruct (le_exists_sub _ _ LE) as (r & Hr & Hr').
+ exists r.
+ split. now rewrite add_comm.
+ split. trivial.
+ apply (add_lt_mono_r _ _ (2^log2 a)).
+ rewrite <- Hr. generalize LT.
+ rewrite pow_succ_r by order_pos.
+ rewrite two_succ at 1. now nzsimpl.
+Qed.
+
+Lemma log2_unique' : forall a b c, 0<=b -> 0<=c<2^b ->
+ a == 2^b + c -> log2 a == b.
+Proof.
+ intros a b c Hb (Hc,H) EQ.
+ apply log2_unique. trivial.
+ rewrite EQ.
+ split.
+ rewrite <- add_0_r at 1. now apply add_le_mono_l.
+ rewrite pow_succ_r by order.
+ rewrite two_succ at 2. nzsimpl. now apply add_lt_mono_l.
+Qed.
+
+(** log2 is exact on powers of 2 *)
+
+Lemma log2_pow2 : forall a, 0<=a -> log2 (2^a) == a.
+Proof.
+ intros a Ha.
+ apply log2_unique' with 0; trivial.
+ split; order_pos. now nzsimpl.
+Qed.
+
+(** log2 and predecessors of powers of 2 *)
+
+Lemma log2_pred_pow2 : forall a, 0<a -> log2 (P (2^a)) == P a.
+Proof.
+ intros a Ha.
+ assert (Ha' : S (P a) == a) by (now rewrite lt_succ_pred with 0).
+ apply log2_unique.
+ apply lt_succ_r; order.
+ rewrite <-le_succ_l, <-lt_succ_r, Ha'.
+ rewrite lt_succ_pred with 0.
+ split; try easy. apply pow_lt_mono_r_iff; try order'.
+  rewrite succ_lt_mono, Ha'. apply lt_succ_diag_r.
+ apply pow_pos_nonneg; order'.
+Qed.
+
+(** log2 and basic constants *)
+
+Lemma log2_1 : log2 1 == 0.
+Proof.
+ rewrite <- (pow_0_r 2). now apply log2_pow2.
+Qed.
+
+Lemma log2_2 : log2 2 == 1.
+Proof.
+ rewrite <- (pow_1_r 2). apply log2_pow2; order'.
+Qed.
+
+(** log2 n is strictly positive for 1<n *)
+
+Lemma log2_pos : forall a, 1<a -> 0 < log2 a.
+Proof.
+ intros a Ha.
+ assert (Ha' : 0 < a) by order'.
+ assert (H := log2_nonneg a). le_elim H; trivial.
+ generalize (log2_spec a Ha'). rewrite <- H in *. nzsimpl; try order.
+ intros (_,H'). rewrite two_succ in H'. apply lt_succ_r in H'; order.
+Qed.
+
+(** Said otherwise, log2 is null only below 1 *)
+
+Lemma log2_null : forall a, log2 a == 0 <-> a <= 1.
+Proof.
+ intros a. split; intros H.
+ destruct (le_gt_cases a 1) as [Ha|Ha]; trivial.
+ generalize (log2_pos a Ha); order.
+ le_elim H.
+ apply log2_nonpos. apply lt_succ_r. now rewrite <- one_succ.
+ rewrite H. apply log2_1.
+Qed.
+
+(** log2 is a monotone function (but not a strict one) *)
+
+Lemma log2_le_mono : forall a b, a<=b -> log2 a <= log2 b.
+Proof.
+ intros a b H.
+ destruct (le_gt_cases a 0) as [Ha|Ha].
+ rewrite log2_nonpos; order_pos.
+ assert (Hb : 0 < b) by order.
+ destruct (log2_spec a Ha) as (LEa,_).
+ destruct (log2_spec b Hb) as (_,LTb).
+ apply lt_succ_r, (pow_lt_mono_r_iff 2); order_pos.
+Qed.
+
+(** No reverse result for <=, consider for instance log2 3 <= log2 2 *)
+
+Lemma log2_lt_cancel : forall a b, log2 a < log2 b -> a < b.
+Proof.
+ intros a b H.
+ destruct (le_gt_cases b 0) as [Hb|Hb].
+  rewrite (log2_nonpos b) in H; trivial.
+  generalize (log2_nonneg a); order.
+ destruct (le_gt_cases a 0) as [Ha|Ha]. order.
+ destruct (log2_spec a Ha) as (_,LTa).
+ destruct (log2_spec b Hb) as (LEb,_).
+ apply le_succ_l in H.
+ apply (pow_le_mono_r_iff 2) in H; order_pos.
+Qed.
+
+(** When left side is a power of 2, we have an equivalence for <= *)
+
+Lemma log2_le_pow2 : forall a b, 0<a -> (2^b<=a <-> b <= log2 a).
+Proof.
+ intros a b Ha.
+ split; intros H.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ generalize (log2_nonneg a); order.
+ rewrite <- (log2_pow2 b); trivial. now apply log2_le_mono.
+ transitivity (2^(log2 a)).
+ apply pow_le_mono_r; order'.
+ now destruct (log2_spec a Ha).
+Qed.
+
+(** When right side is a square, we have an equivalence for < *)
+
+Lemma log2_lt_pow2 : forall a b, 0<a -> (a<2^b <-> log2 a < b).
+Proof.
+ intros a b Ha.
+ split; intros H.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ rewrite pow_neg_r in H; order.
+ apply (pow_lt_mono_r_iff 2); try order_pos.
+ apply le_lt_trans with a; trivial.
+ now destruct (log2_spec a Ha).
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ generalize (log2_nonneg a); order.
+ apply log2_lt_cancel; try order.
+ now rewrite log2_pow2.
+Qed.
+
+(** Comparing log2 and identity *)
+
+Lemma log2_lt_lin : forall a, 0<a -> log2 a < a.
+Proof.
+ intros a Ha.
+ apply (pow_lt_mono_r_iff 2); try order_pos.
+ apply le_lt_trans with a.
+ now destruct (log2_spec a Ha).
+ apply pow_gt_lin_r; order'.
+Qed.
+
+Lemma log2_le_lin : forall a, 0<=a -> log2 a <= a.
+Proof.
+ intros a Ha.
+ le_elim Ha.
+ now apply lt_le_incl, log2_lt_lin.
+ rewrite <- Ha, log2_nonpos; order.
+Qed.
+
+(** Log2 and multiplication. *)
+
+(** Due to rounding error, we don't have the usual
+    [log2 (a*b) = log2 a + log2 b] but we may be off by 1 at most *)
+
+Lemma log2_mul_below : forall a b, 0<a -> 0<b ->
+ log2 a + log2 b <= log2 (a*b).
+Proof.
+ intros a b Ha Hb.
+ apply log2_le_pow2; try order_pos.
+ rewrite pow_add_r by order_pos.
+ apply mul_le_mono_nonneg; try apply log2_spec; order_pos.
+Qed.
+
+Lemma log2_mul_above : forall a b, 0<=a -> 0<=b ->
+ log2 (a*b) <= log2 a + log2 b + 1.
+Proof.
+ intros a b Ha Hb.
+ le_elim Ha.
+ le_elim Hb.
+ apply lt_succ_r.
+ rewrite add_1_r, <- add_succ_r, <- add_succ_l.
+ apply log2_lt_pow2; try order_pos.
+ rewrite pow_add_r by order_pos.
+ apply mul_lt_mono_nonneg; try order; now apply log2_spec.
+ rewrite <- Hb. nzsimpl. rewrite log2_nonpos; order_pos.
+ rewrite <- Ha. nzsimpl. rewrite log2_nonpos; order_pos.
+Qed.
+
+(** And we can't find better approximations in general.
+    - The lower bound is exact for powers of 2.
+    - Concerning the upper bound, for any c>1, take a=b=2^c-1,
+      then log2 (a*b) = c+c -1 while (log2 a) = (log2 b) = c-1
+*)
+
+(** At least, we get back the usual equation when we multiply by 2 (or 2^k) *)
+
+Lemma log2_mul_pow2 : forall a b, 0<a -> 0<=b -> log2 (a*2^b) == b + log2 a.
+Proof.
+ intros a b Ha Hb.
+ apply log2_unique; try order_pos. split.
+ rewrite pow_add_r, mul_comm; try order_pos.
+ apply mul_le_mono_nonneg_r. order_pos. now apply log2_spec.
+ rewrite <-add_succ_r, pow_add_r, mul_comm; try order_pos.
+ apply mul_lt_mono_pos_l. order_pos. now apply log2_spec.
+Qed.
+
+Lemma log2_double : forall a, 0<a -> log2 (2*a) == S (log2 a).
+Proof.
+ intros a Ha. generalize (log2_mul_pow2 a 1 Ha le_0_1). now nzsimpl'.
+Qed.
+
+(** Two numbers with same log2 cannot be far away. *)
+
+Lemma log2_same : forall a b, 0<a -> 0<b -> log2 a == log2 b -> a < 2*b.
+Proof.
+ intros a b Ha Hb H.
+ apply log2_lt_cancel. rewrite log2_double, H by trivial.
+ apply lt_succ_diag_r.
+Qed.
+
+(** Log2 and successor :
+    - the log2 function climbs by at most 1 at a time
+    - otherwise it stays at the same value
+    - the +1 steps occur for powers of two
+*)
+
+Lemma log2_succ_le : forall a, log2 (S a) <= S (log2 a).
+Proof.
+ intros a.
+ destruct (lt_trichotomy 0 a) as [LT|[EQ|LT]].
+ apply (pow_le_mono_r_iff 2); try order_pos.
+ transitivity (S a).
+ apply log2_spec.
+ apply lt_succ_r; order.
+ now apply le_succ_l, log2_spec.
+ rewrite <- EQ, <- one_succ, log2_1; order_pos.
+ rewrite 2 log2_nonpos. order_pos. order'. now rewrite le_succ_l.
+Qed.
+
+Lemma log2_succ_or : forall a,
+ log2 (S a) == S (log2 a) \/ log2 (S a) == log2 a.
+Proof.
+ intros.
+ destruct (le_gt_cases (log2 (S a)) (log2 a)) as [H|H].
+ right. generalize (log2_le_mono _ _ (le_succ_diag_r a)); order.
+ left. apply le_succ_l in H. generalize (log2_succ_le a); order.
+Qed.
+
+Lemma log2_eq_succ_is_pow2 : forall a,
+ log2 (S a) == S (log2 a) -> exists b, S a == 2^b.
+Proof.
+ intros a H.
+ destruct (le_gt_cases a 0) as [Ha|Ha].
+ rewrite 2 (proj2 (log2_null _)) in H. generalize (lt_succ_diag_r 0); order.
+ order'. apply le_succ_l. order'.
+ assert (Ha' : 0 < S a) by (apply lt_succ_r; order).
+ exists (log2 (S a)).
+ generalize (proj1 (log2_spec (S a) Ha')) (proj2 (log2_spec a Ha)).
+ rewrite <- le_succ_l, <- H. order.
+Qed.
+
+Lemma log2_eq_succ_iff_pow2 : forall a, 0<a ->
+ (log2 (S a) == S (log2 a) <-> exists b, S a == 2^b).
+Proof.
+ intros a Ha.
+ split. apply log2_eq_succ_is_pow2.
+ intros (b,Hb).
+ assert (Hb' : 0 < b).
+  apply (pow_gt_1 2); try order'; now rewrite <- Hb, one_succ, <- succ_lt_mono.
+ rewrite Hb, log2_pow2; try order'.
+ setoid_replace a with (P (2^b)). rewrite log2_pred_pow2; trivial.
+ symmetry; now apply lt_succ_pred with 0.
+ apply succ_inj. rewrite Hb. symmetry. apply lt_succ_pred with 0.
+  rewrite <- Hb, lt_succ_r; order.
+Qed.
+
+Lemma log2_succ_double : forall a, 0<a -> log2 (2*a+1) == S (log2 a).
+Proof.
+ intros a Ha.
+ rewrite add_1_r.
+ destruct (log2_succ_or (2*a)) as [H|H]; [exfalso|now rewrite H, log2_double].
+ apply log2_eq_succ_is_pow2 in H. destruct H as (b,H).
+ destruct (lt_trichotomy b 0) as [LT|[EQ|LT]].
+ rewrite pow_neg_r in H; trivial.
+ apply (mul_pos_pos 2), succ_lt_mono in Ha; try order'.
+ rewrite <- one_succ in Ha. order'.
+ rewrite EQ, pow_0_r in H.
+ apply (mul_pos_pos 2), succ_lt_mono in Ha; try order'.
+ rewrite <- one_succ in Ha. order'.
+ assert (EQ:=lt_succ_pred 0 b LT).
+ rewrite <- EQ, pow_succ_r in H; [|now rewrite <- lt_succ_r, EQ].
+ destruct (lt_ge_cases a (2^(P b))) as [LT'|LE'].
+ generalize (mul_2_mono_l _ _ LT'). rewrite add_1_l. order.
+ rewrite (mul_le_mono_pos_l _ _ 2) in LE'; try order'.
+ rewrite <- H in LE'. apply le_succ_l in LE'. order.
+Qed.
+
+(** Log2 and addition *)
+
+Lemma log2_add_le : forall a b, a~=1 -> b~=1 -> log2 (a+b) <= log2 a + log2 b.
+Proof.
+ intros a b Ha Hb.
+ destruct (lt_trichotomy a 1) as [Ha'|[Ha'|Ha']]; [|order|].
+ rewrite one_succ, lt_succ_r in Ha'.
+ rewrite (log2_nonpos a); trivial. nzsimpl. apply log2_le_mono.
+ rewrite <- (add_0_l b) at 2. now apply add_le_mono.
+ destruct (lt_trichotomy b 1) as [Hb'|[Hb'|Hb']]; [|order|].
+ rewrite one_succ, lt_succ_r in Hb'.
+ rewrite (log2_nonpos b); trivial. nzsimpl. apply log2_le_mono.
+ rewrite <- (add_0_r a) at 2. now apply add_le_mono.
+ clear Ha Hb.
+ apply lt_succ_r.
+ apply log2_lt_pow2; try order_pos.
+ rewrite pow_succ_r by order_pos.
+ rewrite two_succ, one_succ at 1. nzsimpl.
+ apply add_lt_mono.
+ apply lt_le_trans with (2^(S (log2 a))). apply log2_spec; order'.
+ apply pow_le_mono_r. order'. rewrite <- add_1_r. apply add_le_mono_l.
+  rewrite one_succ; now apply le_succ_l, log2_pos.
+ apply lt_le_trans with (2^(S (log2 b))). apply log2_spec; order'.
+ apply pow_le_mono_r. order'. rewrite <- add_1_l. apply add_le_mono_r.
+  rewrite one_succ; now apply le_succ_l, log2_pos.
+Qed.
+
+(** The sum of two log2 is less than twice the log2 of the sum.
+    The large inequality is obvious thanks to monotonicity.
+    The strict one requires some more work. This is almost
+    a convexity inequality for points [2a], [2b] and their middle [a+b] :
+    ideally, we would have [2*log(a+b) >= log(2a)+log(2b) = 2+log a+log b].
+    Here, we cannot do better: consider for instance a=2 b=4, then 1+2<2*2
+*)
+
+Lemma add_log2_lt : forall a b, 0<a -> 0<b ->
+ log2 a + log2 b < 2 * log2 (a+b).
+Proof.
+ intros a b Ha Hb. nzsimpl'.
+ assert (H : log2 a <= log2 (a+b)).
+  apply log2_le_mono. rewrite <- (add_0_r a) at 1. apply add_le_mono; order.
+ assert (H' : log2 b <= log2 (a+b)).
+  apply log2_le_mono. rewrite <- (add_0_l b) at 1. apply add_le_mono; order.
+ le_elim H.
+ apply lt_le_trans with (log2 (a+b) + log2 b).
+  now apply add_lt_mono_r. now apply add_le_mono_l.
+ rewrite <- H at 1. apply add_lt_mono_l.
+ le_elim H'; trivial.
+ symmetry in H. apply log2_same in H; try order_pos.
+ symmetry in H'. apply log2_same in H'; try order_pos.
+ revert H H'. nzsimpl'. rewrite <- add_lt_mono_l, <- add_lt_mono_r; order.
+Qed.
+
+End NZLog2Prop.
+
+Module NZLog2UpProp
+ (Import A : NZDecOrdAxiomsSig')
+ (Import B : NZPow' A)
+ (Import C : NZLog2 A B)
+ (Import D : NZMulOrderProp A)
+ (Import E : NZPowProp A B D)
+ (Import F : NZLog2Prop A B C D E).
+
+(** * [log2_up] : a binary logarithm that rounds up instead of down *)
+
+(** For once, we define instead of axiomatizing, thanks to log2 *)
+
+Definition log2_up a :=
+ match compare 1 a with
+  | Lt => S (log2 (P a))
+  | _ => 0
+ end.
+
+Lemma log2_up_eqn0 : forall a, a<=1 -> log2_up a == 0.
+Proof.
+ intros a Ha. unfold log2_up. case compare_spec; try order.
+Qed.
+
+Lemma log2_up_eqn : forall a, 1<a -> log2_up a == S (log2 (P a)).
+Proof.
+ intros a Ha. unfold log2_up. case compare_spec; try order.
+Qed.
+
+Lemma log2_up_spec : forall a, 1<a ->
+ 2^(P (log2_up a)) < a <= 2^(log2_up a).
+Proof.
+ intros a Ha.
+ rewrite log2_up_eqn; trivial.
+ rewrite pred_succ.
+ rewrite <- (lt_succ_pred 1 a Ha) at 2 3.
+ rewrite lt_succ_r, le_succ_l.
+ apply log2_spec.
+ apply succ_lt_mono. now rewrite (lt_succ_pred 1 a Ha), <- one_succ.
+Qed.
+
+Lemma log2_up_nonpos : forall a, a<=0 -> log2_up a == 0.
+Proof.
+ intros. apply log2_up_eqn0. order'.
+Qed.
+
+Instance log2_up_wd : Proper (eq==>eq) log2_up.
+Proof.
+ assert (Proper (eq==>eq==>Logic.eq) compare).
+  repeat red; intros; do 2 case compare_spec; trivial; order.
+ intros a a' Ha. unfold log2_up. rewrite Ha at 1.
+ case compare; now rewrite ?Ha.
+Qed.
+
+(** [log2_up] is always non-negative *)
+
+Lemma log2_up_nonneg : forall a, 0 <= log2_up a.
+Proof.
+ intros a. unfold log2_up. case compare_spec; try order.
+ intros. apply le_le_succ_r, log2_nonneg.
+Qed.
+
+(** The spec of [log2_up] indeed determines it *)
+
+Lemma log2_up_unique : forall a b, 0<b -> 2^(P b)<a<=2^b -> log2_up a == b.
+Proof.
+ intros a b Hb (LEb,LTb).
+ assert (Ha : 1 < a).
+  apply le_lt_trans with (2^(P b)); trivial.
+  rewrite one_succ. apply le_succ_l.
+  apply pow_pos_nonneg. order'. apply lt_succ_r.
+  now rewrite (lt_succ_pred 0 b Hb).
+ assert (Hc := log2_up_nonneg a).
+ destruct (log2_up_spec a Ha) as (LTc,LEc).
+ assert (b <= log2_up a).
+  apply lt_succ_r. rewrite <- (lt_succ_pred 0 b Hb).
+  rewrite <- succ_lt_mono.
+  apply (pow_lt_mono_r_iff 2); try order'.
+ assert (Hc' : 0 < log2_up a) by order.
+ assert (log2_up a <= b).
+  apply lt_succ_r. rewrite <- (lt_succ_pred 0 _ Hc').
+  rewrite <- succ_lt_mono.
+  apply (pow_lt_mono_r_iff 2); try order'.
+ order.
+Qed.
+
+(** [log2_up] is exact on powers of 2 *)
+
+Lemma log2_up_pow2 : forall a, 0<=a -> log2_up (2^a) == a.
+Proof.
+ intros a Ha.
+ le_elim Ha.
+ apply log2_up_unique; trivial.
+ split; try order.
+ apply pow_lt_mono_r; try order'.
+ rewrite <- (lt_succ_pred 0 a Ha) at 2.
+ now apply lt_succ_r.
+ now rewrite <- Ha, pow_0_r, log2_up_eqn0.
+Qed.
+
+(** [log2_up] and successors of powers of 2 *)
+
+Lemma log2_up_succ_pow2 : forall a, 0<=a -> log2_up (S (2^a)) == S a.
+Proof.
+ intros a Ha.
+ rewrite log2_up_eqn, pred_succ, log2_pow2; try easy.
+ rewrite one_succ, <- succ_lt_mono. apply pow_pos_nonneg; order'.
+Qed.
+
+(** Basic constants *)
+
+Lemma log2_up_1 : log2_up 1 == 0.
+Proof.
+ now apply log2_up_eqn0.
+Qed.
+
+Lemma log2_up_2 : log2_up 2 == 1.
+Proof.
+ rewrite <- (pow_1_r 2). apply log2_up_pow2; order'.
+Qed.
+
+(** Links between log2 and [log2_up] *)
+
+Lemma le_log2_log2_up : forall a, log2 a <= log2_up a.
+Proof.
+ intros a. unfold log2_up. case compare_spec; intros H.
+ rewrite <- H, log2_1. order.
+ rewrite <- (lt_succ_pred 1 a H) at 1. apply log2_succ_le.
+ rewrite log2_nonpos. order. now rewrite <-lt_succ_r, <-one_succ.
+Qed.
+
+Lemma le_log2_up_succ_log2 : forall a, log2_up a <= S (log2 a).
+Proof.
+ intros a. unfold log2_up. case compare_spec; intros H; try order_pos.
+ rewrite <- succ_le_mono. apply log2_le_mono.
+ rewrite <- (lt_succ_pred 1 a H) at 2. apply le_succ_diag_r.
+Qed.
+
+Lemma log2_log2_up_spec : forall a, 0<a ->
+ 2^log2 a <= a <= 2^log2_up a.
+Proof.
+ intros a H. split.
+ now apply log2_spec.
+ rewrite <-le_succ_l, <-one_succ in H. le_elim H.
+ now apply log2_up_spec.
+ now rewrite <-H, log2_up_1, pow_0_r.
+Qed.
+
+Lemma log2_log2_up_exact :
+ forall a, 0<a -> (log2 a == log2_up a <-> exists b, a == 2^b).
+Proof.
+ intros a Ha.
+ split. intros. exists (log2 a).
+  generalize (log2_log2_up_spec a Ha). rewrite <-H.
+  destruct 1; order.
+ intros (b,Hb). rewrite Hb.
+ destruct (le_gt_cases 0 b).
+ now rewrite log2_pow2, log2_up_pow2.
+ rewrite pow_neg_r; trivial. now rewrite log2_nonpos, log2_up_nonpos.
+Qed.
+
+(** [log2_up] n is strictly positive for 1<n *)
+
+Lemma log2_up_pos : forall a, 1<a -> 0 < log2_up a.
+Proof.
+ intros. rewrite log2_up_eqn; trivial. apply lt_succ_r; order_pos.
+Qed.
+
+(** Said otherwise, [log2_up] is null only below 1 *)
+
+Lemma log2_up_null : forall a, log2_up a == 0 <-> a <= 1.
+Proof.
+ intros a. split; intros H.
+ destruct (le_gt_cases a 1) as [Ha|Ha]; trivial.
+ generalize (log2_up_pos a Ha); order.
+ now apply log2_up_eqn0.
+Qed.
+
+(** [log2_up] is a monotone function (but not a strict one) *)
+
+Lemma log2_up_le_mono : forall a b, a<=b -> log2_up a <= log2_up b.
+Proof.
+ intros a b H.
+ destruct (le_gt_cases a 1) as [Ha|Ha].
+ rewrite log2_up_eqn0; trivial. apply log2_up_nonneg.
+ rewrite 2 log2_up_eqn; try order.
+ rewrite <- succ_le_mono. apply log2_le_mono, succ_le_mono.
+ rewrite 2 lt_succ_pred with 1; order.
+Qed.
+
+(** No reverse result for <=, consider for instance log2_up 4 <= log2_up 3 *)
+
+Lemma log2_up_lt_cancel : forall a b, log2_up a < log2_up b -> a < b.
+Proof.
+ intros a b H.
+ destruct (le_gt_cases b 1) as [Hb|Hb].
+  rewrite (log2_up_eqn0 b) in H; trivial.
+  generalize (log2_up_nonneg a); order.
+ destruct (le_gt_cases a 1) as [Ha|Ha]. order.
+ rewrite 2 log2_up_eqn in H; try order.
+ rewrite <- succ_lt_mono in H. apply log2_lt_cancel, succ_lt_mono in H.
+ rewrite 2 lt_succ_pred with 1 in H; order.
+Qed.
+
+(** When left side is a power of 2, we have an equivalence for < *)
+
+Lemma log2_up_lt_pow2 : forall a b, 0<a -> (2^b<a <-> b < log2_up a).
+Proof.
+ intros a b Ha.
+ split; intros H.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ generalize (log2_up_nonneg a); order.
+ apply (pow_lt_mono_r_iff 2). order'. apply log2_up_nonneg.
+ apply lt_le_trans with a; trivial.
+ apply (log2_up_spec a).
+ apply le_lt_trans with (2^b); trivial.
+ rewrite one_succ, le_succ_l. apply pow_pos_nonneg; order'.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ now rewrite pow_neg_r.
+ rewrite <- (log2_up_pow2 b) in H; trivial. now apply log2_up_lt_cancel.
+Qed.
+
+(** When right side is a square, we have an equivalence for <= *)
+
+Lemma log2_up_le_pow2 : forall a b, 0<a -> (a<=2^b <-> log2_up a <= b).
+Proof.
+ intros a b Ha.
+ split; intros H.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ rewrite pow_neg_r in H; order.
+ rewrite <- (log2_up_pow2 b); trivial. now apply log2_up_le_mono.
+ transitivity (2^(log2_up a)).
+ now apply log2_log2_up_spec.
+ apply pow_le_mono_r; order'.
+Qed.
+
+(** Comparing [log2_up] and identity *)
+
+Lemma log2_up_lt_lin : forall a, 0<a -> log2_up a < a.
+Proof.
+ intros a Ha.
+ assert (H : S (P a) == a) by (now apply lt_succ_pred with 0).
+ rewrite <- H at 2. apply lt_succ_r. apply log2_up_le_pow2; trivial.
+ rewrite <- H at 1. apply le_succ_l.
+ apply pow_gt_lin_r. order'. apply lt_succ_r; order.
+Qed.
+
+Lemma log2_up_le_lin : forall a, 0<=a -> log2_up a <= a.
+Proof.
+ intros a Ha.
+ le_elim Ha.
+ now apply lt_le_incl, log2_up_lt_lin.
+ rewrite <- Ha, log2_up_nonpos; order.
+Qed.
+
+(** [log2_up] and multiplication. *)
+
+(** Due to rounding error, we don't have the usual
+    [log2_up (a*b) = log2_up a + log2_up b] but we may be off by 1 at most *)
+
+Lemma log2_up_mul_above : forall a b, 0<=a -> 0<=b ->
+  log2_up (a*b) <= log2_up a + log2_up b.
+Proof.
+ intros a b Ha Hb.
+ assert (Ha':=log2_up_nonneg a).
+ assert (Hb':=log2_up_nonneg b).
+ le_elim Ha.
+ le_elim Hb.
+ apply log2_up_le_pow2; try order_pos.
+ rewrite pow_add_r; trivial.
+ apply mul_le_mono_nonneg; try apply log2_log2_up_spec; order'.
+ rewrite <- Hb. nzsimpl. rewrite log2_up_nonpos; order_pos.
+ rewrite <- Ha. nzsimpl. rewrite log2_up_nonpos; order_pos.
+Qed.
+
+Lemma log2_up_mul_below : forall a b, 0<a -> 0<b ->
+ log2_up a + log2_up b <= S (log2_up (a*b)).
+Proof.
+ intros a b Ha Hb.
+ rewrite <-le_succ_l, <-one_succ in Ha. le_elim Ha.
+ rewrite <-le_succ_l, <-one_succ in Hb. le_elim Hb.
+ assert (Ha' : 0 < log2_up a) by (apply log2_up_pos; trivial).
+ assert (Hb' : 0 < log2_up b) by (apply log2_up_pos; trivial).
+ rewrite <- (lt_succ_pred 0 (log2_up a)); trivial.
+ rewrite <- (lt_succ_pred 0 (log2_up b)); trivial.
+ nzsimpl. rewrite <- succ_le_mono, le_succ_l.
+ apply (pow_lt_mono_r_iff 2). order'. apply log2_up_nonneg.
+ rewrite pow_add_r; try (apply lt_succ_r; rewrite (lt_succ_pred 0); trivial).
+ apply lt_le_trans with (a*b).
+ apply mul_lt_mono_nonneg; try order_pos; try now apply log2_up_spec.
+ apply log2_up_spec.
+ setoid_replace 1 with (1*1) by now nzsimpl.
+ apply mul_lt_mono_nonneg; order'.
+ rewrite <- Hb, log2_up_1; nzsimpl. apply le_succ_diag_r.
+ rewrite <- Ha, log2_up_1; nzsimpl. apply le_succ_diag_r.
+Qed.
+
+(** And we can't find better approximations in general.
+    - The upper bound is exact for powers of 2.
+    - Concerning the lower bound, for any c>1, take a=b=2^c+1,
+      then [log2_up (a*b) = c+c +1] while [(log2_up a) = (log2_up b) = c+1]
+*)
+
+(** At least, we get back the usual equation when we multiply by 2 (or 2^k) *)
+
+Lemma log2_up_mul_pow2 : forall a b, 0<a -> 0<=b ->
+ log2_up (a*2^b) == b + log2_up a.
+Proof.
+ intros a b Ha Hb.
+ rewrite <- le_succ_l, <- one_succ in Ha; le_elim Ha.
+ apply log2_up_unique. apply add_nonneg_pos; trivial. now apply log2_up_pos.
+ split.
+ assert (EQ := lt_succ_pred 0 _ (log2_up_pos _ Ha)).
+ rewrite <- EQ. nzsimpl. rewrite pow_add_r, mul_comm; trivial.
+ apply mul_lt_mono_pos_r. order_pos. now apply log2_up_spec.
+ rewrite <- lt_succ_r, EQ. now apply log2_up_pos.
+ rewrite pow_add_r, mul_comm; trivial.
+ apply mul_le_mono_nonneg_l. order_pos. now apply log2_up_spec.
+ apply log2_up_nonneg.
+ now rewrite <- Ha, mul_1_l, log2_up_1, add_0_r, log2_up_pow2.
+Qed.
+
+Lemma log2_up_double : forall a, 0<a -> log2_up (2*a) == S (log2_up a).
+Proof.
+ intros a Ha. generalize (log2_up_mul_pow2 a 1 Ha le_0_1). now nzsimpl'.
+Qed.
+
+(** Two numbers with same [log2_up] cannot be far away. *)
+
+Lemma log2_up_same : forall a b, 0<a -> 0<b -> log2_up a == log2_up b -> a < 2*b.
+Proof.
+ intros a b Ha Hb H.
+ apply log2_up_lt_cancel. rewrite log2_up_double, H by trivial.
+ apply lt_succ_diag_r.
+Qed.
+
+(** [log2_up] and successor :
+    - the [log2_up] function climbs by at most 1 at a time
+    - otherwise it stays at the same value
+    - the +1 steps occur after powers of two
+*)
+
+Lemma log2_up_succ_le : forall a, log2_up (S a) <= S (log2_up a).
+Proof.
+ intros a.
+ destruct (lt_trichotomy 1 a) as [LT|[EQ|LT]].
+ rewrite 2 log2_up_eqn; trivial.
+ rewrite pred_succ, <- succ_le_mono. rewrite <-(lt_succ_pred 1 a LT) at 1.
+ apply log2_succ_le.
+ apply lt_succ_r; order.
+ rewrite <- EQ, <- two_succ, log2_up_1, log2_up_2. now nzsimpl'.
+ rewrite 2 log2_up_eqn0. order_pos. order'. now rewrite le_succ_l.
+Qed.
+
+Lemma log2_up_succ_or : forall a,
+ log2_up (S a) == S (log2_up a) \/ log2_up (S a) == log2_up a.
+Proof.
+ intros.
+ destruct (le_gt_cases (log2_up (S a)) (log2_up a)).
+ right. generalize (log2_up_le_mono _ _ (le_succ_diag_r a)); order.
+ left. apply le_succ_l in H. generalize (log2_up_succ_le a); order.
+Qed.
+
+Lemma log2_up_eq_succ_is_pow2 : forall a,
+ log2_up (S a) == S (log2_up a) -> exists b, a == 2^b.
+Proof.
+ intros a H.
+ destruct (le_gt_cases a 0) as [Ha|Ha].
+ rewrite 2 (proj2 (log2_up_null _)) in H. generalize (lt_succ_diag_r 0); order.
+ order'. apply le_succ_l. order'.
+ assert (Ha' : 1 < S a) by (now rewrite one_succ, <- succ_lt_mono).
+ exists (log2_up a).
+ generalize (proj1 (log2_up_spec (S a) Ha')) (proj2 (log2_log2_up_spec a Ha)).
+ rewrite H, pred_succ, lt_succ_r. order.
+Qed.
+
+Lemma log2_up_eq_succ_iff_pow2 : forall a, 0<a ->
+ (log2_up (S a) == S (log2_up a) <-> exists b, a == 2^b).
+Proof.
+ intros a Ha.
+ split. apply log2_up_eq_succ_is_pow2.
+ intros (b,Hb).
+ destruct (lt_ge_cases b 0) as [Hb'|Hb'].
+  rewrite pow_neg_r in Hb; order.
+ rewrite Hb, log2_up_pow2; try order'.
+ now rewrite log2_up_succ_pow2.
+Qed.
+
+Lemma log2_up_succ_double : forall a, 0<a ->
+ log2_up (2*a+1) == 2 + log2 a.
+Proof.
+ intros a Ha.
+ rewrite log2_up_eqn. rewrite add_1_r, pred_succ, log2_double; now nzsimpl'.
+ apply le_lt_trans with (0+1). now nzsimpl'.
+ apply add_lt_mono_r. order_pos.
+Qed.
+
+(** [log2_up] and addition *)
+
+Lemma log2_up_add_le : forall a b, a~=1 -> b~=1 ->
+ log2_up (a+b) <= log2_up a + log2_up b.
+Proof.
+ intros a b Ha Hb.
+ destruct (lt_trichotomy a 1) as [Ha'|[Ha'|Ha']]; [|order|].
+ rewrite (log2_up_eqn0 a) by order. nzsimpl. apply log2_up_le_mono.
+ rewrite one_succ, lt_succ_r in Ha'.
+ rewrite <- (add_0_l b) at 2. now apply add_le_mono.
+ destruct (lt_trichotomy b 1) as [Hb'|[Hb'|Hb']]; [|order|].
+ rewrite (log2_up_eqn0 b) by order. nzsimpl. apply log2_up_le_mono.
+ rewrite one_succ, lt_succ_r in Hb'.
+ rewrite <- (add_0_r a) at 2. now apply add_le_mono.
+ clear Ha Hb.
+ transitivity (log2_up (a*b)).
+ now apply log2_up_le_mono, add_le_mul.
+ apply log2_up_mul_above; order'.
+Qed.
+
+(** The sum of two [log2_up] is less than twice the [log2_up] of the sum.
+    The large inequality is obvious thanks to monotonicity.
+    The strict one requires some more work. This is almost
+    a convexity inequality for points [2a], [2b] and their middle [a+b] :
+    ideally, we would have [2*log(a+b) >= log(2a)+log(2b) = 2+log a+log b].
+    Here, we cannot do better: consider for instance a=3 b=5, then 2+3<2*3
+*)
+
+Lemma add_log2_up_lt : forall a b, 0<a -> 0<b ->
+ log2_up a + log2_up b < 2 * log2_up (a+b).
+Proof.
+ intros a b Ha Hb. nzsimpl'.
+ assert (H : log2_up a <= log2_up (a+b)).
+  apply log2_up_le_mono. rewrite <- (add_0_r a) at 1. apply add_le_mono; order.
+ assert (H' : log2_up b <= log2_up (a+b)).
+  apply log2_up_le_mono. rewrite <- (add_0_l b) at 1. apply add_le_mono; order.
+ le_elim H.
+ apply lt_le_trans with (log2_up (a+b) + log2_up b).
+  now apply add_lt_mono_r. now apply add_le_mono_l.
+ rewrite <- H at 1. apply add_lt_mono_l.
+ le_elim H'. trivial.
+ symmetry in H. apply log2_up_same in H; try order_pos.
+ symmetry in H'. apply log2_up_same in H'; try order_pos.
+ revert H H'. nzsimpl'. rewrite <- add_lt_mono_l, <- add_lt_mono_r; order.
+Qed.
+
+End NZLog2UpProp.
+
diff --git a/theories/Numbers/NatInt/NZMul.v b/theories/Numbers/NatInt/NZMul.v
index b1adcea9..117a9621 100644
--- a/theories/Numbers/NatInt/NZMul.v
+++ b/theories/Numbers/NatInt/NZMul.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,13 +8,10 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NZMul.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import NZAxioms NZBase NZAdd.
 
-Module Type NZMulPropSig
- (Import NZ : NZAxiomsSig')(Import NZBase : NZBasePropSig NZ).
-Include NZAddPropSig NZ NZBase.
+Module Type NZMulProp (Import NZ : NZAxiomsSig')(Import NZBase : NZBaseProp NZ).
+Include NZAddProp NZ NZBase.
 
 Theorem mul_0_r : forall n, n * 0 == 0.
 Proof.
@@ -59,12 +56,34 @@ Qed.
 
 Theorem mul_1_l : forall n, 1 * n == n.
 Proof.
-intro n. now nzsimpl.
+intro n. now nzsimpl'.
 Qed.
 
 Theorem mul_1_r : forall n, n * 1 == n.
 Proof.
-intro n. now nzsimpl.
+intro n. now nzsimpl'.
+Qed.
+
+Hint Rewrite mul_1_l mul_1_r : nz.
+
+Theorem mul_shuffle0 : forall n m p, n*m*p == n*p*m.
+Proof.
+intros n m p. now rewrite <- 2 mul_assoc, (mul_comm m).
+Qed.
+
+Theorem mul_shuffle1 : forall n m p q, (n * m) * (p * q) == (n * p) * (m * q).
+Proof.
+intros n m p q. now rewrite 2 mul_assoc, (mul_shuffle0 n).
+Qed.
+
+Theorem mul_shuffle2 : forall n m p q, (n * m) * (p * q) == (n * q) * (m * p).
+Proof.
+intros n m p q. rewrite (mul_comm p). apply mul_shuffle1.
+Qed.
+
+Theorem mul_shuffle3 : forall n m p, n * (m * p) == m * (n * p).
+Proof.
+intros n m p. now rewrite mul_assoc, (mul_comm n), mul_assoc.
 Qed.
 
-End NZMulPropSig.
+End NZMulProp.
diff --git a/theories/Numbers/NatInt/NZMulOrder.v b/theories/Numbers/NatInt/NZMulOrder.v
index 09e468ff..a1fe4bf5 100644
--- a/theories/Numbers/NatInt/NZMulOrder.v
+++ b/theories/Numbers/NatInt/NZMulOrder.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,13 +8,11 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NZMulOrder.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import NZAxioms.
 Require Import NZAddOrder.
 
-Module Type NZMulOrderPropSig (Import NZ : NZOrdAxiomsSig').
-Include NZAddOrderPropSig NZ.
+Module Type NZMulOrderProp (Import NZ : NZOrdAxiomsSig').
+Include NZAddOrderProp NZ.
 
 Theorem mul_lt_pred :
   forall p q n m, S p == q -> (p * n < p * m <-> q * n + m < q * m + n).
@@ -26,17 +24,16 @@ Qed.
 
 Theorem mul_lt_mono_pos_l : forall p n m, 0 < p -> (n < m <-> p * n < p * m).
 Proof.
-nzord_induct p.
-intros n m H; false_hyp H lt_irrefl.
-intros p H IH n m H1. nzsimpl.
-le_elim H. assert (LR : forall n m, n < m -> p * n + n < p * m + m).
-intros n1 m1 H2. apply add_lt_mono; [now apply -> IH | assumption].
-split; [apply LR |]. intro H2. apply -> lt_dne; intro H3.
-apply <- le_ngt in H3. le_elim H3.
-apply lt_asymm in H2. apply H2. now apply LR.
-rewrite H3 in H2; false_hyp H2 lt_irrefl.
-rewrite <- H; now nzsimpl.
-intros p H1 _ n m H2. destruct (lt_asymm _ _ H1 H2).
+intros p n m Hp. revert n m. apply lt_ind with (4:=Hp). solve_proper.
+intros. now nzsimpl.
+clear p Hp. intros p Hp IH n m. nzsimpl.
+assert (LR : forall n m, n < m -> p * n + n < p * m + m)
+ by (intros n1 m1 H; apply add_lt_mono; trivial; now rewrite <- IH).
+split; intros H.
+now apply LR.
+destruct (lt_trichotomy n m) as [LT|[EQ|GT]]; trivial.
+rewrite EQ in H. order.
+apply LR in GT. order.
 Qed.
 
 Theorem mul_lt_mono_pos_r : forall p n m, 0 < p -> (n < m <-> n * p < m * p).
@@ -48,19 +45,19 @@ Qed.
 Theorem mul_lt_mono_neg_l : forall p n m, p < 0 -> (n < m <-> p * m < p * n).
 Proof.
 nzord_induct p.
-intros n m H; false_hyp H lt_irrefl.
-intros p H1 _ n m H2. apply lt_succ_l in H2. apply <- nle_gt in H2.
-false_hyp H1 H2.
-intros p H IH n m H1. apply <- le_succ_l in H.
-le_elim H. assert (LR : forall n m, n < m -> p * m < p * n).
-intros n1 m1 H2. apply (le_lt_add_lt n1 m1).
-now apply lt_le_incl. rewrite <- 2 mul_succ_l. now apply -> IH.
-split; [apply LR |]. intro H2. apply -> lt_dne; intro H3.
-apply <- le_ngt in H3. le_elim H3.
-apply lt_asymm in H2. apply H2. now apply LR.
-rewrite H3 in H2; false_hyp H2 lt_irrefl.
-rewrite (mul_lt_pred p (S p)) by reflexivity.
-rewrite H; do 2 rewrite mul_0_l; now do 2 rewrite add_0_l.
+order.
+intros p Hp _ n m Hp'. apply lt_succ_l in Hp'. order.
+intros p Hp IH n m _. apply le_succ_l in Hp.
+le_elim Hp.
+assert (LR : forall n m, n < m -> p * m < p * n).
+ intros n1 m1 H. apply (le_lt_add_lt n1 m1).
+ now apply lt_le_incl. rewrite <- 2 mul_succ_l. now rewrite <- IH.
+split; intros H.
+now apply LR.
+destruct (lt_trichotomy n m) as [LT|[EQ|GT]]; trivial.
+rewrite EQ in H. order.
+apply LR in GT. order.
+rewrite (mul_lt_pred p (S p)), Hp; now nzsimpl.
 Qed.
 
 Theorem mul_lt_mono_neg_r : forall p n m, p < 0 -> (n < m <-> m * p < n * p).
@@ -72,7 +69,7 @@ Qed.
 Theorem mul_le_mono_nonneg_l : forall n m p, 0 <= p -> n <= m -> p * n <= p * m.
 Proof.
 intros n m p H1 H2. le_elim H1.
-le_elim H2. apply lt_le_incl. now apply -> mul_lt_mono_pos_l.
+le_elim H2. apply lt_le_incl. now apply mul_lt_mono_pos_l.
 apply eq_le_incl; now rewrite H2.
 apply eq_le_incl; rewrite <- H1; now do 2 rewrite mul_0_l.
 Qed.
@@ -80,7 +77,7 @@ Qed.
 Theorem mul_le_mono_nonpos_l : forall n m p, p <= 0 -> n <= m -> p * m <= p * n.
 Proof.
 intros n m p H1 H2. le_elim H1.
-le_elim H2. apply lt_le_incl. now apply -> mul_lt_mono_neg_l.
+le_elim H2. apply lt_le_incl. now apply mul_lt_mono_neg_l.
 apply eq_le_incl; now rewrite H2.
 apply eq_le_incl; rewrite H1; now do 2 rewrite mul_0_l.
 Qed.
@@ -99,20 +96,13 @@ Qed.
 
 Theorem mul_cancel_l : forall n m p, p ~= 0 -> (p * n == p * m <-> n == m).
 Proof.
-intros n m p H; split; intro H1.
-destruct (lt_trichotomy p 0) as [H2 | [H2 | H2]].
-apply -> eq_dne; intro H3. apply -> lt_gt_cases in H3. destruct H3 as [H3 | H3].
-assert (H4 : p * m < p * n); [now apply -> mul_lt_mono_neg_l |].
-rewrite H1 in H4; false_hyp H4 lt_irrefl.
-assert (H4 : p * n < p * m); [now apply -> mul_lt_mono_neg_l |].
-rewrite H1 in H4; false_hyp H4 lt_irrefl.
-false_hyp H2 H.
-apply -> eq_dne; intro H3. apply -> lt_gt_cases in H3. destruct H3 as [H3 | H3].
-assert (H4 : p * n < p * m) by (now apply -> mul_lt_mono_pos_l).
-rewrite H1 in H4; false_hyp H4 lt_irrefl.
-assert (H4 : p * m < p * n) by (now apply -> mul_lt_mono_pos_l).
-rewrite H1 in H4; false_hyp H4 lt_irrefl.
-now rewrite H1.
+intros n m p Hp; split; intro H; [|now f_equiv].
+apply lt_gt_cases in Hp; destruct Hp as [Hp|Hp];
+ destruct (lt_trichotomy n m) as [LT|[EQ|GT]]; trivial.
+apply (mul_lt_mono_neg_l p) in LT; order.
+apply (mul_lt_mono_neg_l p) in GT; order.
+apply (mul_lt_mono_pos_l p) in LT; order.
+apply (mul_lt_mono_pos_l p) in GT; order.
 Qed.
 
 Theorem mul_cancel_r : forall n m p, p ~= 0 -> (n * p == m * p <-> n == m).
@@ -183,17 +173,17 @@ Qed.
 
 Theorem mul_pos_pos : forall n m, 0 < n -> 0 < m -> 0 < n * m.
 Proof.
-intros n m H1 H2. rewrite <- (mul_0_l m). now apply -> mul_lt_mono_pos_r.
+intros n m H1 H2. rewrite <- (mul_0_l m). now apply mul_lt_mono_pos_r.
 Qed.
 
 Theorem mul_neg_neg : forall n m, n < 0 -> m < 0 -> 0 < n * m.
 Proof.
-intros n m H1 H2. rewrite <- (mul_0_l m). now apply -> mul_lt_mono_neg_r.
+intros n m H1 H2. rewrite <- (mul_0_l m). now apply mul_lt_mono_neg_r.
 Qed.
 
 Theorem mul_pos_neg : forall n m, 0 < n -> m < 0 -> n * m < 0.
 Proof.
-intros n m H1 H2. rewrite <- (mul_0_l m). now apply -> mul_lt_mono_neg_r.
+intros n m H1 H2. rewrite <- (mul_0_l m). now apply mul_lt_mono_neg_r.
 Qed.
 
 Theorem mul_neg_pos : forall n m, n < 0 -> 0 < m -> n * m < 0.
@@ -206,9 +196,33 @@ Proof.
 intros. rewrite <- (mul_0_l m). apply mul_le_mono_nonneg; order.
 Qed.
 
+Theorem mul_pos_cancel_l : forall n m, 0 < n -> (0 < n*m <-> 0 < m).
+Proof.
+intros n m Hn. rewrite <- (mul_0_r n) at 1.
+ symmetry. now apply mul_lt_mono_pos_l.
+Qed.
+
+Theorem mul_pos_cancel_r : forall n m, 0 < m -> (0 < n*m <-> 0 < n).
+Proof.
+intros n m Hn. rewrite <- (mul_0_l m) at 1.
+ symmetry. now apply mul_lt_mono_pos_r.
+Qed.
+
+Theorem mul_nonneg_cancel_l : forall n m, 0 < n -> (0 <= n*m <-> 0 <= m).
+Proof.
+intros n m Hn. rewrite <- (mul_0_r n) at 1.
+ symmetry. now apply mul_le_mono_pos_l.
+Qed.
+
+Theorem mul_nonneg_cancel_r : forall n m, 0 < m -> (0 <= n*m <-> 0 <= n).
+Proof.
+intros n m Hn. rewrite <- (mul_0_l m) at 1.
+ symmetry. now apply mul_le_mono_pos_r.
+Qed.
+
 Theorem lt_1_mul_pos : forall n m, 1 < n -> 0 < m -> 1 < n * m.
 Proof.
-intros n m H1 H2. apply -> (mul_lt_mono_pos_r m) in H1.
+intros n m H1 H2. apply (mul_lt_mono_pos_r m) in H1.
 rewrite mul_1_l in H1. now apply lt_1_l with m.
 assumption.
 Qed.
@@ -229,7 +243,7 @@ Qed.
 Theorem neq_mul_0 : forall n m, n ~= 0 /\ m ~= 0 <-> n * m ~= 0.
 Proof.
 intros n m; split; intro H.
-intro H1; apply -> eq_mul_0 in H1. tauto.
+intro H1; apply eq_mul_0 in H1. tauto.
 split; intro H1; rewrite H1 in H;
 (rewrite mul_0_l in H || rewrite mul_0_r in H); now apply H.
 Qed.
@@ -241,19 +255,25 @@ Qed.
 
 Theorem eq_mul_0_l : forall n m, n * m == 0 -> m ~= 0 -> n == 0.
 Proof.
-intros n m H1 H2. apply -> eq_mul_0 in H1. destruct H1 as [H1 | H1].
+intros n m H1 H2. apply eq_mul_0 in H1. destruct H1 as [H1 | H1].
 assumption. false_hyp H1 H2.
 Qed.
 
 Theorem eq_mul_0_r : forall n m, n * m == 0 -> n ~= 0 -> m == 0.
 Proof.
-intros n m H1 H2; apply -> eq_mul_0 in H1. destruct H1 as [H1 | H1].
+intros n m H1 H2; apply eq_mul_0 in H1. destruct H1 as [H1 | H1].
 false_hyp H1 H2. assumption.
 Qed.
 
-Theorem lt_0_mul : forall n m, 0 < n * m <-> (0 < n /\ 0 < m) \/ (m < 0 /\ n < 0).
+(** Some alternative names: *)
+
+Definition mul_eq_0 := eq_mul_0.
+Definition mul_eq_0_l := eq_mul_0_l.
+Definition mul_eq_0_r := eq_mul_0_r.
+
+Theorem lt_0_mul n m : 0 < n * m <-> (0 < n /\ 0 < m) \/ (m < 0 /\ n < 0).
 Proof.
-intros n m; split; [intro H | intros [[H1 H2] | [H1 H2]]].
+split; [intro H | intros [[H1 H2] | [H1 H2]]].
 destruct (lt_trichotomy n 0) as [H1 | [H1 | H1]];
 [| rewrite H1 in H; rewrite mul_0_l in H; false_hyp H lt_irrefl |];
 (destruct (lt_trichotomy m 0) as [H2 | [H2 | H2]];
@@ -283,25 +303,100 @@ Theorem square_lt_simpl_nonneg : forall n m, 0 <= m -> n * n < m * m -> n < m.
 Proof.
 intros n m H1 H2. destruct (lt_ge_cases n 0).
 now apply lt_le_trans with 0.
-destruct (lt_ge_cases n m).
-assumption. assert (F : m * m <= n * n) by now apply square_le_mono_nonneg.
-apply -> le_ngt in F. false_hyp H2 F.
+destruct (lt_ge_cases n m) as [LT|LE]; trivial.
+apply square_le_mono_nonneg in LE; order.
 Qed.
 
 Theorem square_le_simpl_nonneg : forall n m, 0 <= m -> n * n <= m * m -> n <= m.
 Proof.
 intros n m H1 H2. destruct (lt_ge_cases n 0).
 apply lt_le_incl; now apply lt_le_trans with 0.
-destruct (le_gt_cases n m).
-assumption. assert (F : m * m < n * n) by now apply square_lt_mono_nonneg.
-apply -> lt_nge in F. false_hyp H2 F.
+destruct (le_gt_cases n m) as [LE|LT]; trivial.
+apply square_lt_mono_nonneg in LT; order.
+Qed.
+
+Theorem mul_2_mono_l : forall n m, n < m -> 1 + 2 * n < 2 * m.
+Proof.
+intros n m. rewrite <- le_succ_l, (mul_le_mono_pos_l (S n) m two).
+rewrite two_succ. nzsimpl. now rewrite le_succ_l.
+order'.
+Qed.
+
+Lemma add_le_mul : forall a b, 1<a -> 1<b -> a+b <= a*b.
+Proof.
+ assert (AUX : forall a b, 0<a -> 0<b -> (S a)+(S b) <= (S a)*(S b)).
+  intros a b Ha Hb.
+  nzsimpl. rewrite <- succ_le_mono. apply le_succ_l.
+  rewrite <- add_assoc, <- (add_0_l (a+b)), (add_comm b).
+  apply add_lt_mono_r.
+  now apply mul_pos_pos.
+ intros a b Ha Hb.
+ assert (Ha' := lt_succ_pred 1 a Ha).
+ assert (Hb' := lt_succ_pred 1 b Hb).
+ rewrite <- Ha', <- Hb'. apply AUX; rewrite succ_lt_mono, <- one_succ; order.
+Qed.
+
+(** A few results about squares *)
+
+Lemma square_nonneg : forall a, 0 <= a * a.
+Proof.
+ intros. rewrite <- (mul_0_r a). destruct (le_gt_cases a 0).
+ now apply mul_le_mono_nonpos_l.
+ apply mul_le_mono_nonneg_l; order.
+Qed.
+
+Lemma crossmul_le_addsquare : forall a b, 0<=a -> 0<=b -> b*a+a*b <= a*a+b*b.
+Proof.
+ assert (AUX : forall a b, 0<=a<=b -> b*a+a*b <= a*a+b*b).
+  intros a b (Ha,H).
+  destruct (le_exists_sub _ _ H) as (d & EQ & Hd).
+  rewrite EQ.
+  rewrite 2 mul_add_distr_r.
+  rewrite !add_assoc. apply add_le_mono_r.
+  rewrite add_comm. apply add_le_mono_l.
+  apply mul_le_mono_nonneg_l; trivial. order.
+ intros a b Ha Hb.
+ destruct (le_gt_cases a b).
+ apply AUX; split; order.
+ rewrite (add_comm (b*a)), (add_comm (a*a)).
+ apply AUX; split; order.
+Qed.
+
+Lemma add_square_le : forall a b, 0<=a -> 0<=b ->
+ a*a + b*b <= (a+b)*(a+b).
+Proof.
+ intros a b Ha Hb.
+ rewrite mul_add_distr_r, !mul_add_distr_l.
+ rewrite add_assoc.
+ apply add_le_mono_r.
+ rewrite <- add_assoc.
+ rewrite <- (add_0_r (a*a)) at 1.
+ apply add_le_mono_l.
+ apply add_nonneg_nonneg; now apply mul_nonneg_nonneg.
+Qed.
+
+Lemma square_add_le : forall a b, 0<=a -> 0<=b ->
+ (a+b)*(a+b) <= 2*(a*a + b*b).
+Proof.
+ intros a b Ha Hb.
+ rewrite !mul_add_distr_l, !mul_add_distr_r. nzsimpl'.
+ rewrite <- !add_assoc. apply add_le_mono_l.
+ rewrite !add_assoc. apply add_le_mono_r.
+ apply crossmul_le_addsquare; order.
 Qed.
 
-Theorem mul_2_mono_l : forall n m, n < m -> 1 + (1 + 1) * n < (1 + 1) * m.
+Lemma quadmul_le_squareadd : forall a b, 0<=a -> 0<=b ->
+ 2*2*a*b <= (a+b)*(a+b).
 Proof.
-intros n m. rewrite <- le_succ_l, (mul_le_mono_pos_l (S n) m (1 + 1)).
-rewrite !mul_add_distr_r; nzsimpl; now rewrite le_succ_l.
-apply add_pos_pos; now apply lt_0_1.
+ intros.
+ nzsimpl'.
+ rewrite !mul_add_distr_l, !mul_add_distr_r.
+ rewrite (add_comm _ (b*b)), add_assoc.
+ apply add_le_mono_r.
+ rewrite (add_shuffle0 (a*a)), (mul_comm b a).
+ apply add_le_mono_r.
+ rewrite (mul_comm a b) at 1.
+ now apply crossmul_le_addsquare.
 Qed.
 
-End NZMulOrderPropSig.
+End NZMulOrderProp.
diff --git a/theories/Numbers/NatInt/NZOrder.v b/theories/Numbers/NatInt/NZOrder.v
index 07805772..3dae9c70 100644
--- a/theories/Numbers/NatInt/NZOrder.v
+++ b/theories/Numbers/NatInt/NZOrder.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,28 +8,26 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NZOrder.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import NZAxioms NZBase Decidable OrdersTac.
 
-Module Type NZOrderPropSig
- (Import NZ : NZOrdSig')(Import NZBase : NZBasePropSig NZ).
+Module Type NZOrderProp
+ (Import NZ : NZOrdSig')(Import NZBase : NZBaseProp NZ).
 
 Instance le_wd : Proper (eq==>eq==>iff) le.
 Proof.
-intros n n' Hn m m' Hm. rewrite !lt_eq_cases, !Hn, !Hm; auto with *.
+intros n n' Hn m m' Hm. now rewrite <- !lt_succ_r, Hn, Hm.
 Qed.
 
 Ltac le_elim H := rewrite lt_eq_cases in H; destruct H as [H | H].
 
 Theorem lt_le_incl : forall n m, n < m -> n <= m.
 Proof.
-intros; apply <- lt_eq_cases; now left.
+intros. apply lt_eq_cases. now left.
 Qed.
 
 Theorem le_refl : forall n, n <= n.
 Proof.
-intro; apply <- lt_eq_cases; now right.
+intro. apply lt_eq_cases. now right.
 Qed.
 
 Theorem lt_succ_diag_r : forall n, n < S n.
@@ -99,7 +97,7 @@ intros n m; nzinduct n m.
 intros H; false_hyp H lt_irrefl.
 intro n; split; intros H H1 H2.
 apply lt_succ_r in H2. le_elim H2.
-apply H; auto. apply -> le_succ_l. now apply lt_le_incl.
+apply H; auto. apply le_succ_l. now apply lt_le_incl.
 rewrite H2 in H1. false_hyp H1 nlt_succ_diag_l.
 apply le_succ_l in H1. le_elim H1.
 apply H; auto. rewrite lt_succ_r. now apply lt_le_incl.
@@ -148,19 +146,17 @@ Definition lt_compat := lt_wd.
 Definition lt_total := lt_trichotomy.
 Definition le_lteq := lt_eq_cases.
 
-Module OrderElts <: TotalOrder.
- Definition t := t.
- Definition eq := eq.
- Definition lt := lt.
- Definition le := le.
+Module Private_OrderTac.
+Module IsTotal.
  Definition eq_equiv := eq_equiv.
  Definition lt_strorder := lt_strorder.
  Definition lt_compat := lt_compat.
  Definition lt_total := lt_total.
  Definition le_lteq := le_lteq.
-End OrderElts.
-Module OrderTac := !MakeOrderTac OrderElts.
-Ltac order := OrderTac.order.
+End IsTotal.
+Module Tac := !MakeOrderTac NZ IsTotal.
+End Private_OrderTac.
+Ltac order := Private_OrderTac.Tac.order.
 
 (** Some direct consequences of [order]. *)
 
@@ -208,12 +204,12 @@ Qed.
 
 Theorem lt_succ_l : forall n m, S n < m -> n < m.
 Proof.
-intros n m H; apply -> le_succ_l; order.
+intros n m H; apply le_succ_l; order.
 Qed.
 
 Theorem le_le_succ_r : forall n m, n <= m -> n <= S m.
 Proof.
-intros n m LE. rewrite <- lt_succ_r in LE. order.
+intros n m LE. apply lt_succ_r in LE. order.
 Qed.
 
 Theorem lt_lt_succ_r : forall n m, n < m -> n < S m.
@@ -233,19 +229,37 @@ Qed.
 
 Theorem lt_0_1 : 0 < 1.
 Proof.
-apply lt_succ_diag_r.
+rewrite one_succ. apply lt_succ_diag_r.
 Qed.
 
 Theorem le_0_1 : 0 <= 1.
 Proof.
-apply le_succ_diag_r.
+apply lt_le_incl, lt_0_1.
 Qed.
 
-Theorem lt_1_l : forall n m, 0 < n -> n < m -> 1 < m.
+Theorem lt_1_2 : 1 < 2.
+Proof.
+rewrite two_succ. apply lt_succ_diag_r.
+Qed.
+
+Theorem lt_0_2 : 0 < 2.
+Proof.
+transitivity 1. apply lt_0_1. apply lt_1_2.
+Qed.
+
+Theorem le_0_2 : 0 <= 2.
 Proof.
-intros n m H1 H2. apply <- le_succ_l in H1. order.
+apply lt_le_incl, lt_0_2.
 Qed.
 
+(** The order tactic enriched with some knowledge of 0,1,2 *)
+
+Ltac order' := generalize lt_0_1 lt_1_2; order.
+
+Theorem lt_1_l : forall n m, 0 < n -> n < m -> 1 < m.
+Proof.
+intros n m H1 H2. rewrite <- le_succ_l, <- one_succ in H1. order.
+Qed.
 
 (** More Trichotomy, decidability and double negation elimination. *)
 
@@ -347,7 +361,7 @@ Proof.
 intro z; nzinduct n z.
 order.
 intro n; split; intros IH m H1 H2.
-apply -> le_succ_r in H2. destruct H2 as [H2 | H2].
+apply le_succ_r in H2. destruct H2 as [H2 | H2].
 now apply IH. exists n. now split; [| rewrite <- lt_succ_r; rewrite <- H2].
 apply IH. assumption. now apply le_le_succ_r.
 Qed.
@@ -359,6 +373,13 @@ intros z n H; apply lt_exists_pred_strong with (z := z) (n := n).
 assumption. apply le_refl.
 Qed.
 
+Lemma lt_succ_pred : forall z n, z < n -> S (P n) == n.
+Proof.
+ intros z n H.
+ destruct (lt_exists_pred _ _ H) as (n' & EQ & LE).
+ rewrite EQ. now rewrite pred_succ.
+Qed.
+
 (** Stronger variant of induction with assumptions n >= 0 (n < 0)
 in the induction step *)
 
@@ -390,14 +411,14 @@ Qed.
 Lemma rs'_rs'' : right_step' -> right_step''.
 Proof.
 intros RS' n; split; intros H1 m H2 H3.
-apply -> lt_succ_r in H3; le_elim H3;
+apply lt_succ_r in H3; le_elim H3;
 [now apply H1 | rewrite H3 in *; now apply RS'].
 apply H1; [assumption | now apply lt_lt_succ_r].
 Qed.
 
 Lemma rbase : A' z.
 Proof.
-intros m H1 H2. apply -> le_ngt in H1. false_hyp H2 H1.
+intros m H1 H2. apply le_ngt in H1. false_hyp H2 H1.
 Qed.
 
 Lemma A'A_right : (forall n, A' n) -> forall n, z <= n -> A n.
@@ -449,28 +470,28 @@ Let left_step'' := forall n, A' n <-> A' (S n).
 Lemma ls_ls' :  A z -> left_step -> left_step'.
 Proof.
 intros Az LS n H1 H2. le_elim H1.
-apply LS; trivial. apply H2; [now apply <- le_succ_l | now apply eq_le_incl].
+apply LS; trivial. apply H2; [now apply le_succ_l | now apply eq_le_incl].
 rewrite H1; apply Az.
 Qed.
 
 Lemma ls'_ls'' : left_step' -> left_step''.
 Proof.
 intros LS' n; split; intros H1 m H2 H3.
-apply -> le_succ_l in H3. apply lt_le_incl in H3. now apply H1.
+apply le_succ_l in H3. apply lt_le_incl in H3. now apply H1.
 le_elim H3.
-apply <- le_succ_l in H3. now apply H1.
+apply le_succ_l in H3. now apply H1.
 rewrite <- H3 in *; now apply LS'.
 Qed.
 
 Lemma lbase : A' (S z).
 Proof.
-intros m H1 H2. apply -> le_succ_l in H2.
-apply -> le_ngt in H1. false_hyp H2 H1.
+intros m H1 H2. apply le_succ_l in H2.
+apply le_ngt in H1. false_hyp H2 H1.
 Qed.
 
 Lemma A'A_left : (forall n, A' n) -> forall n, n <= z -> A n.
 Proof.
-intros H1 n H2. apply H1 with (n := n); [assumption | now apply eq_le_incl].
+intros H1 n H2. apply (H1 n); [assumption | now apply eq_le_incl].
 Qed.
 
 Theorem strong_left_induction: left_step' -> forall n, n <= z -> A n.
@@ -527,8 +548,8 @@ Theorem order_induction' :
     forall n, A n.
 Proof.
 intros Az AS AP n; apply order_induction; try assumption.
-intros m H1 H2. apply AP in H2; [| now apply <- le_succ_l].
-apply -> (A_wd (P (S m)) m); [assumption | apply pred_succ].
+intros m H1 H2. apply AP in H2; [|now apply le_succ_l].
+now rewrite pred_succ in H2.
 Qed.
 
 End Center.
@@ -555,11 +576,11 @@ Theorem lt_ind : forall (n : t),
    forall m, n < m -> A m.
 Proof.
 intros n H1 H2 m H3.
-apply right_induction with (S n); [assumption | | now apply <- le_succ_l].
-intros; apply H2; try assumption. now apply -> le_succ_l.
+apply right_induction with (S n); [assumption | | now apply le_succ_l].
+intros; apply H2; try assumption. now apply le_succ_l.
 Qed.
 
-(** Elimintation principle for <= *)
+(** Elimination principle for <= *)
 
 Theorem le_ind : forall (n : t),
   A n ->
@@ -582,8 +603,8 @@ Section WF.
 
 Variable z : t.
 
-Let Rlt (n m : t) := z <= n /\ n < m.
-Let Rgt (n m : t) := m < n /\ n <= z.
+Let Rlt (n m : t) := z <= n < m.
+Let Rgt (n m : t) := m < n <= z.
 
 Instance Rlt_wd : Proper (eq ==> eq ==> iff) Rlt.
 Proof.
@@ -595,25 +616,13 @@ Proof.
 intros x1 x2 H1 x3 x4 H2; unfold Rgt; rewrite H1; now rewrite H2.
 Qed.
 
-Instance Acc_lt_wd : Proper (eq==>iff) (Acc Rlt).
-Proof.
-intros x1 x2 H; split; intro H1; destruct H1 as [H2];
-constructor; intros; apply H2; now (rewrite H || rewrite <- H).
-Qed.
-
-Instance Acc_gt_wd : Proper (eq==>iff) (Acc Rgt).
-Proof.
-intros x1 x2 H; split; intro H1; destruct H1 as [H2];
-constructor; intros; apply H2; now (rewrite H || rewrite <- H).
-Qed.
-
 Theorem lt_wf : well_founded Rlt.
 Proof.
 unfold well_founded.
 apply strong_right_induction' with (z := z).
-apply Acc_lt_wd.
+auto with typeclass_instances.
 intros n H; constructor; intros y [H1 H2].
-apply <- nle_gt in H2. elim H2. now apply le_trans with z.
+apply nle_gt in H2. elim H2. now apply le_trans with z.
 intros n H1 H2; constructor; intros m [H3 H4]. now apply H2.
 Qed.
 
@@ -621,24 +630,20 @@ Theorem gt_wf : well_founded Rgt.
 Proof.
 unfold well_founded.
 apply strong_left_induction' with (z := z).
-apply Acc_gt_wd.
+auto with typeclass_instances.
 intros n H; constructor; intros y [H1 H2].
-apply <- nle_gt in H2. elim H2. now apply le_lt_trans with n.
+apply nle_gt in H2. elim H2. now apply le_lt_trans with n.
 intros n H1 H2; constructor; intros m [H3 H4].
-apply H2. assumption. now apply <- le_succ_l.
+apply H2. assumption. now apply le_succ_l.
 Qed.
 
 End WF.
 
-End NZOrderPropSig.
-
-Module NZOrderPropFunct (NZ : NZOrdSig) :=
- NZBasePropSig NZ <+ NZOrderPropSig NZ.
+End NZOrderProp.
 
 (** If we have moreover a [compare] function, we can build
     an [OrderedType] structure. *)
 
-Module NZOrderedTypeFunct (NZ : NZDecOrdSig')
-  <: DecidableTypeFull <: OrderedTypeFull :=
- NZ <+ NZOrderPropFunct <+ Compare2EqBool <+ HasEqBool2Dec.
-
+Module NZOrderedType (NZ : NZDecOrdSig')
+ <: DecidableTypeFull <: OrderedTypeFull
+ := NZ <+ NZBaseProp <+ NZOrderProp NZ <+ Compare2EqBool <+ HasEqBool2Dec.
diff --git a/theories/Numbers/NatInt/NZParity.v b/theories/Numbers/NatInt/NZParity.v
new file mode 100644
index 00000000..0e932378
--- /dev/null
+++ b/theories/Numbers/NatInt/NZParity.v
@@ -0,0 +1,263 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Bool NZAxioms NZMulOrder.
+
+(** Parity functions *)
+
+Module Type NZParity (Import A : NZAxiomsSig').
+ Parameter Inline even odd : t -> bool.
+ Definition Even n := exists m, n == 2*m.
+ Definition Odd n := exists m, n == 2*m+1.
+ Axiom even_spec : forall n, even n = true <-> Even n.
+ Axiom odd_spec : forall n, odd n = true <-> Odd n.
+End NZParity.
+
+Module Type NZParityProp
+ (Import A : NZOrdAxiomsSig')
+ (Import B : NZParity A)
+ (Import C : NZMulOrderProp A).
+
+(** Morphisms *)
+
+Instance Even_wd : Proper (eq==>iff) Even.
+Proof. unfold Even. solve_proper. Qed.
+
+Instance Odd_wd : Proper (eq==>iff) Odd.
+Proof. unfold Odd. solve_proper. Qed.
+
+Instance even_wd : Proper (eq==>Logic.eq) even.
+Proof.
+ intros x x' EQ. rewrite eq_iff_eq_true, 2 even_spec. now f_equiv.
+Qed.
+
+Instance odd_wd : Proper (eq==>Logic.eq) odd.
+Proof.
+ intros x x' EQ. rewrite eq_iff_eq_true, 2 odd_spec. now f_equiv.
+Qed.
+
+(** Evenness and oddity are dual notions *)
+
+Lemma Even_or_Odd : forall x, Even x \/ Odd x.
+Proof.
+ nzinduct x.
+ left. exists 0. now nzsimpl.
+ intros x.
+ split; intros [(y,H)|(y,H)].
+ right. exists y. rewrite H. now nzsimpl.
+ left. exists (S y). rewrite H. now nzsimpl'.
+ right.
+ assert (LT : exists z, z<y).
+  destruct (lt_ge_cases 0 y) as [LT|GT]; [now exists 0 | exists x].
+  rewrite <- le_succ_l, H. nzsimpl'.
+  rewrite <- (add_0_r y) at 3. now apply add_le_mono_l.
+ destruct LT as (z,LT).
+ destruct (lt_exists_pred z y LT) as (y' & Hy' & _).
+ exists y'. rewrite <- succ_inj_wd, H, Hy'. now nzsimpl'.
+ left. exists y. rewrite <- succ_inj_wd. rewrite H. now nzsimpl.
+Qed.
+
+Lemma double_below : forall n m, n<=m -> 2*n < 2*m+1.
+Proof.
+ intros. nzsimpl'. apply lt_succ_r. now apply add_le_mono.
+Qed.
+
+Lemma double_above : forall n m, n<m -> 2*n+1 < 2*m.
+Proof.
+ intros. nzsimpl'.
+ rewrite <- le_succ_l, <- add_succ_l, <- add_succ_r.
+ apply add_le_mono; now apply le_succ_l.
+Qed.
+
+Lemma Even_Odd_False : forall x, Even x -> Odd x -> False.
+Proof.
+intros x (y,E) (z,O). rewrite O in E; clear O.
+destruct (le_gt_cases y z) as [LE|GT].
+generalize (double_below _ _ LE); order.
+generalize (double_above _ _ GT); order.
+Qed.
+
+Lemma orb_even_odd : forall n, orb (even n) (odd n) = true.
+Proof.
+ intros.
+ destruct (Even_or_Odd n) as [H|H].
+ rewrite <- even_spec in H. now rewrite H.
+ rewrite <- odd_spec in H. now rewrite H, orb_true_r.
+Qed.
+
+Lemma negb_odd : forall n, negb (odd n) = even n.
+Proof.
+ intros.
+ generalize (Even_or_Odd n) (Even_Odd_False n).
+ rewrite <- even_spec, <- odd_spec.
+ destruct (odd n), (even n); simpl; intuition.
+Qed.
+
+Lemma negb_even : forall n, negb (even n) = odd n.
+Proof.
+ intros. rewrite <- negb_odd. apply negb_involutive.
+Qed.
+
+(** Constants *)
+
+Lemma even_0 : even 0 = true.
+Proof.
+ rewrite even_spec. exists 0. now nzsimpl.
+Qed.
+
+Lemma odd_0 : odd 0 = false.
+Proof.
+ now rewrite <- negb_even, even_0.
+Qed.
+
+Lemma odd_1 : odd 1 = true.
+Proof.
+ rewrite odd_spec. exists 0. now nzsimpl'.
+Qed.
+
+Lemma even_1 : even 1 = false.
+Proof.
+ now rewrite <- negb_odd, odd_1.
+Qed.
+
+Lemma even_2 : even 2 = true.
+Proof.
+ rewrite even_spec. exists 1. now nzsimpl'.
+Qed.
+
+Lemma odd_2 : odd 2 = false.
+Proof.
+ now rewrite <- negb_even, even_2.
+Qed.
+
+(** Parity and successor *)
+
+Lemma Odd_succ : forall n, Odd (S n) <-> Even n.
+Proof.
+ split; intros (m,H).
+ exists m. apply succ_inj. now rewrite add_1_r in H.
+ exists m. rewrite add_1_r. now f_equiv.
+Qed.
+
+Lemma odd_succ : forall n, odd (S n) = even n.
+Proof.
+ intros. apply eq_iff_eq_true. rewrite even_spec, odd_spec.
+ apply Odd_succ.
+Qed.
+
+Lemma even_succ : forall n, even (S n) = odd n.
+Proof.
+ intros. now rewrite <- negb_odd, odd_succ, negb_even.
+Qed.
+
+Lemma Even_succ : forall n, Even (S n) <-> Odd n.
+Proof.
+ intros. now rewrite <- even_spec, even_succ, odd_spec.
+Qed.
+
+(** Parity and successor of successor *)
+
+Lemma Even_succ_succ : forall n, Even (S (S n)) <-> Even n.
+Proof.
+ intros. now rewrite Even_succ, Odd_succ.
+Qed.
+
+Lemma Odd_succ_succ : forall n, Odd (S (S n)) <-> Odd n.
+Proof.
+ intros. now rewrite Odd_succ, Even_succ.
+Qed.
+
+Lemma even_succ_succ : forall n, even (S (S n)) = even n.
+Proof.
+ intros. now rewrite even_succ, odd_succ.
+Qed.
+
+Lemma odd_succ_succ : forall n, odd (S (S n)) = odd n.
+Proof.
+ intros. now rewrite odd_succ, even_succ.
+Qed.
+
+(** Parity and addition *)
+
+Lemma even_add : forall n m, even (n+m) = Bool.eqb (even n) (even m).
+Proof.
+ intros.
+ case_eq (even n); case_eq (even m);
+  rewrite <- ?negb_true_iff, ?negb_even, ?odd_spec, ?even_spec;
+  intros (m',Hm) (n',Hn).
+ exists (n'+m'). now rewrite mul_add_distr_l, Hn, Hm.
+ exists (n'+m'). now rewrite mul_add_distr_l, Hn, Hm, add_assoc.
+ exists (n'+m'). now rewrite mul_add_distr_l, Hn, Hm, add_shuffle0.
+ exists (n'+m'+1). rewrite Hm,Hn. nzsimpl'. now rewrite add_shuffle1.
+Qed.
+
+Lemma odd_add : forall n m, odd (n+m) = xorb (odd n) (odd m).
+Proof.
+ intros. rewrite <- !negb_even. rewrite even_add.
+ now destruct (even n), (even m).
+Qed.
+
+(** Parity and multiplication *)
+
+Lemma even_mul : forall n m, even (mul n m) = even n || even m.
+Proof.
+ intros.
+ case_eq (even n); simpl; rewrite ?even_spec.
+ intros (n',Hn). exists (n'*m). now rewrite Hn, mul_assoc.
+ case_eq (even m); simpl; rewrite ?even_spec.
+ intros (m',Hm). exists (n*m'). now rewrite Hm, !mul_assoc, (mul_comm 2).
+ (* odd / odd *)
+ rewrite <- !negb_true_iff, !negb_even, !odd_spec.
+ intros (m',Hm) (n',Hn). exists (n'*2*m' +n'+m').
+ rewrite Hn,Hm, !mul_add_distr_l, !mul_add_distr_r, !mul_1_l, !mul_1_r.
+ now rewrite add_shuffle1, add_assoc, !mul_assoc.
+Qed.
+
+Lemma odd_mul : forall n m, odd (mul n m) = odd n && odd m.
+Proof.
+ intros. rewrite <- !negb_even. rewrite even_mul.
+ now destruct (even n), (even m).
+Qed.
+
+(** A particular case : adding by an even number *)
+
+Lemma even_add_even : forall n m, Even m -> even (n+m) = even n.
+Proof.
+ intros n m Hm. apply even_spec in Hm.
+ rewrite even_add, Hm. now destruct (even n).
+Qed.
+
+Lemma odd_add_even : forall n m, Even m -> odd (n+m) = odd n.
+Proof.
+ intros n m Hm. apply even_spec in Hm.
+ rewrite odd_add, <- (negb_even m), Hm. now destruct (odd n).
+Qed.
+
+Lemma even_add_mul_even : forall n m p, Even m -> even (n+m*p) = even n.
+Proof.
+ intros n m p Hm. apply even_spec in Hm.
+ apply even_add_even. apply even_spec. now rewrite even_mul, Hm.
+Qed.
+
+Lemma odd_add_mul_even : forall n m p, Even m -> odd (n+m*p) = odd n.
+Proof.
+ intros n m p Hm. apply even_spec in Hm.
+ apply odd_add_even. apply even_spec. now rewrite even_mul, Hm.
+Qed.
+
+Lemma even_add_mul_2 : forall n m, even (n+2*m) = even n.
+Proof.
+ intros. apply even_add_mul_even. apply even_spec, even_2.
+Qed.
+
+Lemma odd_add_mul_2 : forall n m, odd (n+2*m) = odd n.
+Proof.
+ intros. apply odd_add_mul_even. apply even_spec, even_2.
+Qed.
+
+End NZParityProp.
\ No newline at end of file
diff --git a/theories/Numbers/NatInt/NZPow.v b/theories/Numbers/NatInt/NZPow.v
new file mode 100644
index 00000000..26d5ffef
--- /dev/null
+++ b/theories/Numbers/NatInt/NZPow.v
@@ -0,0 +1,411 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Power Function *)
+
+Require Import NZAxioms NZMulOrder.
+
+(** Interface of a power function, then its specification on naturals *)
+
+Module Type Pow (Import A : Typ).
+ Parameters Inline pow : t -> t -> t.
+End Pow.
+
+Module Type PowNotation (A : Typ)(Import B : Pow A).
+ Infix "^" := pow.
+End PowNotation.
+
+Module Type Pow' (A : Typ) := Pow A <+ PowNotation A.
+
+Module Type NZPowSpec (Import A : NZOrdAxiomsSig')(Import B : Pow' A).
+ Declare Instance pow_wd : Proper (eq==>eq==>eq) pow.
+ Axiom pow_0_r : forall a, a^0 == 1.
+ Axiom pow_succ_r : forall a b, 0<=b -> a^(succ b) == a * a^b.
+ Axiom pow_neg_r : forall a b, b<0 -> a^b == 0.
+End NZPowSpec.
+
+(** The above [pow_neg_r] specification is useless (and trivially
+   provable) for N. Having it here allows to already derive
+   some slightly more general statements. *)
+
+Module Type NZPow (A : NZOrdAxiomsSig) := Pow A <+ NZPowSpec A.
+Module Type NZPow' (A : NZOrdAxiomsSig) := Pow' A <+ NZPowSpec A.
+
+(** Derived properties of power *)
+
+Module Type NZPowProp
+ (Import A : NZOrdAxiomsSig')
+ (Import B : NZPow' A)
+ (Import C : NZMulOrderProp A).
+
+Hint Rewrite pow_0_r pow_succ_r : nz.
+
+(** Power and basic constants *)
+
+Lemma pow_0_l : forall a, 0<a -> 0^a == 0.
+Proof.
+ intros a Ha.
+ destruct (lt_exists_pred _ _ Ha) as (a' & EQ & Ha').
+ rewrite EQ. now nzsimpl.
+Qed.
+
+Lemma pow_0_l' : forall a, a~=0 -> 0^a == 0.
+Proof.
+ intros a Ha.
+ destruct (lt_trichotomy a 0) as [LT|[EQ|GT]]; try order.
+ now rewrite pow_neg_r.
+ now apply pow_0_l.
+Qed.
+
+Lemma pow_1_r : forall a, a^1 == a.
+Proof.
+ intros. now nzsimpl'.
+Qed.
+
+Lemma pow_1_l : forall a, 0<=a -> 1^a == 1.
+Proof.
+ apply le_ind; intros. solve_proper.
+ now nzsimpl.
+ now nzsimpl.
+Qed.
+
+Hint Rewrite pow_1_r pow_1_l : nz.
+
+Lemma pow_2_r : forall a, a^2 == a*a.
+Proof.
+ intros. rewrite two_succ. nzsimpl; order'.
+Qed.
+
+Hint Rewrite pow_2_r : nz.
+
+(** Power and nullity *)
+
+Lemma pow_eq_0 : forall a b, 0<=b -> a^b == 0 -> a == 0.
+Proof.
+ intros a b Hb. apply le_ind with (4:=Hb).
+ solve_proper.
+ rewrite pow_0_r. order'.
+ clear b Hb. intros b Hb IH.
+ rewrite pow_succ_r by trivial.
+ intros H. apply eq_mul_0 in H. destruct H; trivial.
+ now apply IH.
+Qed.
+
+Lemma pow_nonzero : forall a b, a~=0 -> 0<=b -> a^b ~= 0.
+Proof.
+ intros a b Ha Hb. contradict Ha. now apply pow_eq_0 with b.
+Qed.
+
+Lemma pow_eq_0_iff : forall a b, a^b == 0 <-> b<0 \/ (0<b /\ a==0).
+Proof.
+ intros a b. split.
+ intros H.
+ destruct (lt_trichotomy b 0) as [Hb|[Hb|Hb]].
+ now left.
+ rewrite Hb, pow_0_r in H; order'.
+ right. split; trivial. apply pow_eq_0 with b; order.
+ intros [Hb|[Hb Ha]]. now rewrite pow_neg_r.
+ rewrite Ha. apply pow_0_l'. order.
+Qed.
+
+(** Power and addition, multiplication *)
+
+Lemma pow_add_r : forall a b c, 0<=b -> 0<=c ->
+  a^(b+c) == a^b * a^c.
+Proof.
+ intros a b c Hb. apply le_ind with (4:=Hb). solve_proper.
+ now nzsimpl.
+ clear b Hb. intros b Hb IH Hc.
+ nzsimpl; trivial.
+ rewrite IH; trivial. apply mul_assoc.
+ now apply add_nonneg_nonneg.
+Qed.
+
+Lemma pow_mul_l : forall a b c,
+  (a*b)^c == a^c * b^c.
+Proof.
+ intros a b c.
+ destruct (lt_ge_cases c 0) as [Hc|Hc].
+ rewrite !(pow_neg_r _ _ Hc). now nzsimpl.
+ apply le_ind with (4:=Hc). solve_proper.
+ now nzsimpl.
+ clear c Hc. intros c Hc IH.
+ nzsimpl; trivial.
+ rewrite IH; trivial. apply mul_shuffle1.
+Qed.
+
+Lemma pow_mul_r : forall a b c, 0<=b -> 0<=c ->
+  a^(b*c) == (a^b)^c.
+Proof.
+ intros a b c Hb. apply le_ind with (4:=Hb). solve_proper.
+ intros. now nzsimpl.
+ clear b Hb. intros b Hb IH Hc.
+ nzsimpl; trivial.
+ rewrite pow_add_r, IH, pow_mul_l; trivial. apply mul_comm.
+ now apply mul_nonneg_nonneg.
+Qed.
+
+(** Positivity *)
+
+Lemma pow_nonneg : forall a b, 0<=a -> 0<=a^b.
+Proof.
+ intros a b Ha.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ now rewrite !(pow_neg_r _ _ Hb).
+ apply le_ind with (4:=Hb). solve_proper.
+ nzsimpl; order'.
+ clear b Hb. intros b Hb IH.
+ nzsimpl; trivial. now apply mul_nonneg_nonneg.
+Qed.
+
+Lemma pow_pos_nonneg : forall a b, 0<a -> 0<=b -> 0<a^b.
+Proof.
+ intros a b Ha Hb. apply le_ind with (4:=Hb). solve_proper.
+ nzsimpl; order'.
+ clear b Hb. intros b Hb IH.
+ nzsimpl; trivial. now apply mul_pos_pos.
+Qed.
+
+(** Monotonicity *)
+
+Lemma pow_lt_mono_l : forall a b c, 0<c -> 0<=a<b -> a^c < b^c.
+Proof.
+ intros a b c Hc. apply lt_ind with (4:=Hc). solve_proper.
+ intros (Ha,H). nzsimpl; trivial; order.
+ clear c Hc. intros c Hc IH (Ha,H).
+ nzsimpl; try order.
+ apply mul_lt_mono_nonneg; trivial.
+ apply pow_nonneg; try order.
+ apply IH. now split.
+Qed.
+
+Lemma pow_le_mono_l : forall a b c, 0<=a<=b -> a^c <= b^c.
+Proof.
+ intros a b c (Ha,H).
+ destruct (lt_trichotomy c 0) as [Hc|[Hc|Hc]].
+ rewrite !(pow_neg_r _ _ Hc); now nzsimpl.
+ rewrite Hc; now nzsimpl.
+ apply lt_eq_cases in H. destruct H as [H|H]; [|now rewrite <- H].
+ apply lt_le_incl, pow_lt_mono_l; now try split.
+Qed.
+
+Lemma pow_gt_1 : forall a b, 1<a -> (0<b <-> 1<a^b).
+Proof.
+ intros a b Ha. split; intros Hb.
+ rewrite <- (pow_1_l b) by order.
+ apply pow_lt_mono_l; try split; order'.
+ destruct (lt_trichotomy b 0) as [H|[H|H]]; trivial.
+ rewrite pow_neg_r in Hb; order'.
+ rewrite H, pow_0_r in Hb. order.
+Qed.
+
+Lemma pow_lt_mono_r : forall a b c, 1<a -> 0<=c -> b<c -> a^b < a^c.
+Proof.
+ intros a b c Ha Hc H.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ rewrite pow_neg_r by trivial. apply pow_pos_nonneg; order'.
+ assert (H' : b<=c) by order.
+ destruct (le_exists_sub _ _ H') as (d & EQ & Hd).
+ rewrite EQ, pow_add_r; trivial. rewrite <- (mul_1_l (a^b)) at 1.
+ apply mul_lt_mono_pos_r.
+ apply pow_pos_nonneg; order'.
+ apply pow_gt_1; trivial.
+ apply lt_eq_cases in Hd; destruct Hd as [LT|EQ']; trivial.
+  rewrite <- EQ' in *. rewrite add_0_l in EQ. order.
+Qed.
+
+(** NB: since 0^0 > 0^1, the following result isn't valid with a=0 *)
+
+Lemma pow_le_mono_r : forall a b c, 0<a -> b<=c -> a^b <= a^c.
+Proof.
+ intros a b c Ha H.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ rewrite (pow_neg_r _ _ Hb). apply pow_nonneg; order.
+ apply le_succ_l in Ha; rewrite <- one_succ in Ha.
+ apply lt_eq_cases in Ha; destruct Ha as [Ha|Ha]; [|rewrite <- Ha].
+ apply lt_eq_cases in H; destruct H as [H|H]; [|now rewrite <- H].
+ apply lt_le_incl, pow_lt_mono_r; order.
+ nzsimpl; order.
+Qed.
+
+Lemma pow_le_mono : forall a b c d, 0<a<=c -> b<=d ->
+ a^b <= c^d.
+Proof.
+ intros. transitivity (a^d).
+ apply pow_le_mono_r; intuition order.
+ apply pow_le_mono_l; intuition order.
+Qed.
+
+Lemma pow_lt_mono : forall a b c d, 0<a<c -> 0<b<d ->
+ a^b < c^d.
+Proof.
+ intros a b c d (Ha,Hac) (Hb,Hbd).
+ apply le_succ_l in Ha; rewrite <- one_succ in Ha.
+ apply lt_eq_cases in Ha; destruct Ha as [Ha|Ha]; [|rewrite <- Ha].
+ transitivity (a^d).
+ apply pow_lt_mono_r; intuition order.
+ apply pow_lt_mono_l; try split; order'.
+ nzsimpl; try order. apply pow_gt_1; order.
+Qed.
+
+(** Injectivity *)
+
+Lemma pow_inj_l : forall a b c, 0<=a -> 0<=b -> 0<c ->
+ a^c == b^c -> a == b.
+Proof.
+ intros a b c Ha Hb Hc EQ.
+ destruct (lt_trichotomy a b) as [LT|[EQ'|GT]]; trivial.
+ assert (a^c < b^c) by (apply pow_lt_mono_l; try split; trivial).
+ order.
+ assert (b^c < a^c) by (apply pow_lt_mono_l; try split; trivial).
+ order.
+Qed.
+
+Lemma pow_inj_r : forall a b c, 1<a -> 0<=b -> 0<=c ->
+ a^b == a^c -> b == c.
+Proof.
+ intros a b c Ha Hb Hc EQ.
+ destruct (lt_trichotomy b c) as [LT|[EQ'|GT]]; trivial.
+ assert (a^b < a^c) by (apply pow_lt_mono_r; try split; trivial).
+ order.
+ assert (a^c < a^b) by (apply pow_lt_mono_r; try split; trivial).
+ order.
+Qed.
+
+(** Monotonicity results, both ways *)
+
+Lemma pow_lt_mono_l_iff : forall a b c, 0<=a -> 0<=b -> 0<c ->
+  (a<b <-> a^c < b^c).
+Proof.
+ intros a b c Ha Hb Hc.
+ split; intro LT.
+ apply pow_lt_mono_l; try split; trivial.
+ destruct (le_gt_cases b a) as [LE|GT]; trivial.
+ assert (b^c <= a^c) by (apply pow_le_mono_l; try split; order).
+ order.
+Qed.
+
+Lemma pow_le_mono_l_iff : forall a b c, 0<=a -> 0<=b -> 0<c ->
+  (a<=b <-> a^c <= b^c).
+Proof.
+ intros a b c Ha Hb Hc.
+ split; intro LE.
+ apply pow_le_mono_l; try split; trivial.
+ destruct (le_gt_cases a b) as [LE'|GT]; trivial.
+ assert (b^c < a^c) by (apply pow_lt_mono_l; try split; trivial).
+ order.
+Qed.
+
+Lemma pow_lt_mono_r_iff : forall a b c, 1<a -> 0<=c ->
+  (b<c <-> a^b < a^c).
+Proof.
+ intros a b c Ha Hc.
+ split; intro LT.
+ now apply pow_lt_mono_r.
+ destruct (le_gt_cases c b) as [LE|GT]; trivial.
+ assert (a^c <= a^b) by (apply pow_le_mono_r; order').
+ order.
+Qed.
+
+Lemma pow_le_mono_r_iff : forall a b c, 1<a -> 0<=c ->
+  (b<=c <-> a^b <= a^c).
+Proof.
+ intros a b c Ha Hc.
+ split; intro LE.
+ apply pow_le_mono_r; order'.
+ destruct (le_gt_cases b c) as [LE'|GT]; trivial.
+ assert (a^c < a^b) by (apply pow_lt_mono_r; order').
+ order.
+Qed.
+
+(** For any a>1, the a^x function is above the identity function *)
+
+Lemma pow_gt_lin_r : forall a b, 1<a -> 0<=b -> b < a^b.
+Proof.
+ intros a b Ha Hb. apply le_ind with (4:=Hb). solve_proper.
+ nzsimpl. order'.
+ clear b Hb. intros b Hb IH. nzsimpl; trivial.
+ rewrite <- !le_succ_l in *. rewrite <- two_succ in Ha.
+ transitivity (2*(S b)).
+  nzsimpl'. rewrite <- 2 succ_le_mono.
+  rewrite <- (add_0_l b) at 1. apply add_le_mono; order.
+ apply mul_le_mono_nonneg; trivial.
+ order'.
+ now apply lt_le_incl, lt_succ_r.
+Qed.
+
+(** Someday, we should say something about the full Newton formula.
+    In the meantime, we can at least provide some inequalities about
+    (a+b)^c.
+*)
+
+Lemma pow_add_lower : forall a b c, 0<=a -> 0<=b -> 0<c ->
+  a^c + b^c <= (a+b)^c.
+Proof.
+ intros a b c Ha Hb Hc. apply lt_ind with (4:=Hc). solve_proper.
+ nzsimpl; order.
+ clear c Hc. intros c Hc IH.
+ assert (0<=c) by order'.
+ nzsimpl; trivial.
+ transitivity ((a+b)*(a^c + b^c)).
+ rewrite mul_add_distr_r, !mul_add_distr_l.
+ apply add_le_mono.
+ rewrite <- add_0_r at 1. apply add_le_mono_l.
+  apply mul_nonneg_nonneg; trivial.
+  apply pow_nonneg; trivial.
+ rewrite <- add_0_l at 1. apply add_le_mono_r.
+  apply mul_nonneg_nonneg; trivial.
+  apply pow_nonneg; trivial.
+ apply mul_le_mono_nonneg_l; trivial.
+ now apply add_nonneg_nonneg.
+Qed.
+
+(** This upper bound can also be seen as a convexity proof for x^c :
+    image of (a+b)/2 is below the middle of the images of a and b
+*)
+
+Lemma pow_add_upper : forall a b c, 0<=a -> 0<=b -> 0<c ->
+  (a+b)^c <= 2^(pred c) * (a^c + b^c).
+Proof.
+ assert (aux : forall a b c, 0<=a<=b -> 0<c ->
+         (a + b) * (a ^ c + b ^ c) <= 2 * (a * a ^ c + b * b ^ c)).
+ (* begin *)
+  intros a b c (Ha,H) Hc.
+  rewrite !mul_add_distr_l, !mul_add_distr_r. nzsimpl'.
+  rewrite <- !add_assoc. apply add_le_mono_l.
+  rewrite !add_assoc. apply add_le_mono_r.
+  destruct (le_exists_sub _ _ H) as (d & EQ & Hd).
+  rewrite EQ.
+  rewrite 2 mul_add_distr_r.
+  rewrite !add_assoc. apply add_le_mono_r.
+  rewrite add_comm. apply add_le_mono_l.
+  apply mul_le_mono_nonneg_l; trivial.
+  apply pow_le_mono_l; try split; order.
+ (* end *)
+ intros a b c Ha Hb Hc. apply lt_ind with (4:=Hc). solve_proper.
+ nzsimpl; order.
+ clear c Hc. intros c Hc IH.
+ assert (0<=c) by order.
+ nzsimpl; trivial.
+ transitivity ((a+b)*(2^(pred c) * (a^c + b^c))).
+ apply mul_le_mono_nonneg_l; trivial.
+ now apply add_nonneg_nonneg.
+ rewrite mul_assoc. rewrite (mul_comm (a+b)).
+ assert (EQ : S (P c) == c) by (apply lt_succ_pred with 0; order').
+ assert (LE : 0 <= P c) by (now rewrite succ_le_mono, EQ, le_succ_l).
+ assert (EQ' : 2^c == 2^(P c) * 2) by (rewrite <- EQ at 1; nzsimpl'; order).
+ rewrite EQ', <- !mul_assoc.
+ apply mul_le_mono_nonneg_l.
+ apply pow_nonneg; order'.
+ destruct (le_gt_cases a b).
+ apply aux; try split; order'.
+ rewrite (add_comm a), (add_comm (a^c)), (add_comm (a*a^c)).
+ apply aux; try split; order'.
+Qed.
+
+End NZPowProp.
diff --git a/theories/Numbers/NatInt/NZProperties.v b/theories/Numbers/NatInt/NZProperties.v
index 7279325d..a2eb1996 100644
--- a/theories/Numbers/NatInt/NZProperties.v
+++ b/theories/Numbers/NatInt/NZProperties.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,13 +8,11 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NZProperties.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NZAxioms NZMulOrder.
 
 (** This functor summarizes all known facts about NZ.
-    For the moment it is only an alias to [NZMulOrderPropFunct], which
+    For the moment it is only an alias to [NZMulOrderProp], which
     subsumes all others.
 *)
 
-Module Type NZPropFunct := NZMulOrderPropSig.
+Module Type NZProp := NZMulOrderProp.
diff --git a/theories/Numbers/NatInt/NZSqrt.v b/theories/Numbers/NatInt/NZSqrt.v
new file mode 100644
index 00000000..8146fd01
--- /dev/null
+++ b/theories/Numbers/NatInt/NZSqrt.v
@@ -0,0 +1,734 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Square Root Function *)
+
+Require Import NZAxioms NZMulOrder.
+
+(** Interface of a sqrt function, then its specification on naturals *)
+
+Module Type Sqrt (Import A : Typ).
+ Parameter Inline sqrt : t -> t.
+End Sqrt.
+
+Module Type SqrtNotation (A : Typ)(Import B : Sqrt A).
+ Notation "√ x" := (sqrt x) (at level 6).
+End SqrtNotation.
+
+Module Type Sqrt' (A : Typ) := Sqrt A <+ SqrtNotation A.
+
+Module Type NZSqrtSpec (Import A : NZOrdAxiomsSig')(Import B : Sqrt' A).
+ Axiom sqrt_spec : forall a, 0<=a -> √a * √a <= a < S (√a) * S (√a).
+ Axiom sqrt_neg : forall a, a<0 -> √a == 0.
+End NZSqrtSpec.
+
+Module Type NZSqrt (A : NZOrdAxiomsSig) := Sqrt A <+ NZSqrtSpec A.
+Module Type NZSqrt' (A : NZOrdAxiomsSig) := Sqrt' A <+ NZSqrtSpec A.
+
+(** Derived properties of power *)
+
+Module Type NZSqrtProp
+ (Import A : NZOrdAxiomsSig')
+ (Import B : NZSqrt' A)
+ (Import C : NZMulOrderProp A).
+
+Local Notation "a ²" := (a*a) (at level 5, no associativity, format "a ²").
+
+(** First, sqrt is non-negative *)
+
+Lemma sqrt_spec_nonneg : forall b,
+ b² < (S b)² -> 0 <= b.
+Proof.
+ intros b LT.
+ destruct (le_gt_cases 0 b) as [Hb|Hb]; trivial. exfalso.
+ assert ((S b)² < b²).
+  rewrite mul_succ_l, <- (add_0_r b²).
+  apply add_lt_le_mono.
+  apply mul_lt_mono_neg_l; trivial. apply lt_succ_diag_r.
+  now apply le_succ_l.
+ order.
+Qed.
+
+Lemma sqrt_nonneg : forall a, 0<=√a.
+Proof.
+ intros. destruct (lt_ge_cases a 0) as [Ha|Ha].
+ now rewrite (sqrt_neg _ Ha).
+ apply sqrt_spec_nonneg. destruct (sqrt_spec a Ha). order.
+Qed.
+
+(** The spec of sqrt indeed determines it *)
+
+Lemma sqrt_unique : forall a b, b² <= a < (S b)² -> √a == b.
+Proof.
+ intros a b (LEb,LTb).
+ assert (Ha : 0<=a) by (transitivity b²; trivial using square_nonneg).
+ assert (Hb : 0<=b) by (apply sqrt_spec_nonneg; order).
+ assert (Ha': 0<=√a) by now apply sqrt_nonneg.
+ destruct (sqrt_spec a Ha) as (LEa,LTa).
+ assert (b <= √a).
+  apply lt_succ_r, square_lt_simpl_nonneg; [|order].
+  now apply lt_le_incl, lt_succ_r.
+ assert (√a <= b).
+  apply lt_succ_r, square_lt_simpl_nonneg; [|order].
+  now apply lt_le_incl, lt_succ_r.
+ order.
+Qed.
+
+(** Hence sqrt is a morphism *)
+
+Instance sqrt_wd : Proper (eq==>eq) sqrt.
+Proof.
+ intros x x' Hx.
+ destruct (lt_ge_cases x 0) as [H|H].
+ rewrite 2 sqrt_neg; trivial. reflexivity.
+ now rewrite <- Hx.
+ apply sqrt_unique. rewrite Hx in *. now apply sqrt_spec.
+Qed.
+
+(** An alternate specification *)
+
+Lemma sqrt_spec_alt : forall a, 0<=a -> exists r,
+ a == (√a)² + r /\ 0 <= r <= 2*√a.
+Proof.
+ intros a Ha.
+ destruct (sqrt_spec _ Ha) as (LE,LT).
+ destruct (le_exists_sub _ _ LE) as (r & Hr & Hr').
+ exists r.
+ split. now rewrite add_comm.
+ split. trivial.
+ apply (add_le_mono_r _ _ (√a)²).
+ rewrite <- Hr, add_comm.
+ generalize LT. nzsimpl'. now rewrite lt_succ_r, add_assoc.
+Qed.
+
+Lemma sqrt_unique' : forall a b c, 0<=c<=2*b ->
+ a == b² + c -> √a == b.
+Proof.
+ intros a b c (Hc,H) EQ.
+ apply sqrt_unique.
+ rewrite EQ.
+ split.
+ rewrite <- add_0_r at 1. now apply add_le_mono_l.
+ nzsimpl. apply lt_succ_r.
+ rewrite <- add_assoc. apply add_le_mono_l.
+ generalize H; now nzsimpl'.
+Qed.
+
+(** Sqrt is exact on squares *)
+
+Lemma sqrt_square : forall a, 0<=a -> √(a²) == a.
+Proof.
+ intros a Ha.
+ apply sqrt_unique' with 0.
+ split. order. apply mul_nonneg_nonneg; order'. now nzsimpl.
+Qed.
+
+(** Sqrt and predecessors of squares *)
+
+Lemma sqrt_pred_square : forall a, 0<a -> √(P a²) == P a.
+Proof.
+ intros a Ha.
+ apply sqrt_unique.
+ assert (EQ := lt_succ_pred 0 a Ha).
+ rewrite EQ. split.
+ apply lt_succ_r.
+ rewrite (lt_succ_pred 0).
+ assert (0 <= P a) by (now rewrite <- lt_succ_r, EQ).
+ assert (P a < a) by (now rewrite <- le_succ_l, EQ).
+ apply mul_lt_mono_nonneg; trivial.
+ now apply mul_pos_pos.
+ apply le_succ_l.
+ rewrite (lt_succ_pred 0). reflexivity. now apply mul_pos_pos.
+Qed.
+
+(** Sqrt is a monotone function (but not a strict one) *)
+
+Lemma sqrt_le_mono : forall a b, a <= b -> √a <= √b.
+Proof.
+ intros a b Hab.
+ destruct (lt_ge_cases a 0) as [Ha|Ha].
+ rewrite (sqrt_neg _ Ha). apply sqrt_nonneg.
+ assert (Hb : 0 <= b) by order.
+ destruct (sqrt_spec a Ha) as (LE,_).
+ destruct (sqrt_spec b Hb) as (_,LT).
+ apply lt_succ_r.
+ apply square_lt_simpl_nonneg; try order.
+ now apply lt_le_incl, lt_succ_r, sqrt_nonneg.
+Qed.
+
+(** No reverse result for <=, consider for instance √2 <= √1 *)
+
+Lemma sqrt_lt_cancel : forall a b, √a < √b -> a < b.
+Proof.
+ intros a b H.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ rewrite (sqrt_neg b Hb) in H; generalize (sqrt_nonneg a); order.
+ destruct (lt_ge_cases a 0) as [Ha|Ha]; [order|].
+ destruct (sqrt_spec a Ha) as (_,LT).
+ destruct (sqrt_spec b Hb) as (LE,_).
+ apply le_succ_l in H.
+ assert ((S (√a))² <= (√b)²).
+  apply mul_le_mono_nonneg; trivial.
+  now apply lt_le_incl, lt_succ_r, sqrt_nonneg.
+  now apply lt_le_incl, lt_succ_r, sqrt_nonneg.
+ order.
+Qed.
+
+(** When left side is a square, we have an equivalence for <= *)
+
+Lemma sqrt_le_square : forall a b, 0<=a -> 0<=b -> (b²<=a <-> b <= √a).
+Proof.
+ intros a b Ha Hb. split; intros H.
+ rewrite <- (sqrt_square b); trivial.
+ now apply sqrt_le_mono.
+ destruct (sqrt_spec a Ha) as (LE,LT).
+ transitivity (√a)²; trivial.
+ now apply mul_le_mono_nonneg.
+Qed.
+
+(** When right side is a square, we have an equivalence for < *)
+
+Lemma sqrt_lt_square : forall a b, 0<=a -> 0<=b -> (a<b² <-> √a < b).
+Proof.
+ intros a b Ha Hb. split; intros H.
+ destruct (sqrt_spec a Ha) as (LE,_).
+ apply square_lt_simpl_nonneg; try order.
+ rewrite <- (sqrt_square b Hb) in H.
+ now apply sqrt_lt_cancel.
+Qed.
+
+(** Sqrt and basic constants *)
+
+Lemma sqrt_0 : √0 == 0.
+Proof.
+ rewrite <- (mul_0_l 0) at 1. now apply sqrt_square.
+Qed.
+
+Lemma sqrt_1 : √1 == 1.
+Proof.
+ rewrite <- (mul_1_l 1) at 1. apply sqrt_square. order'.
+Qed.
+
+Lemma sqrt_2 : √2 == 1.
+Proof.
+ apply sqrt_unique' with 1. nzsimpl; split; order'. now nzsimpl'.
+Qed.
+
+Lemma sqrt_pos : forall a, 0 < √a <-> 0 < a.
+Proof.
+ intros a. split; intros Ha. apply sqrt_lt_cancel. now rewrite sqrt_0.
+ rewrite <- le_succ_l, <- one_succ, <- sqrt_1. apply sqrt_le_mono.
+ now rewrite one_succ, le_succ_l.
+Qed.
+
+Lemma sqrt_lt_lin : forall a, 1<a -> √a<a.
+Proof.
+ intros a Ha. rewrite <- sqrt_lt_square; try order'.
+ rewrite <- (mul_1_r a) at 1.
+ rewrite <- mul_lt_mono_pos_l; order'.
+Qed.
+
+Lemma sqrt_le_lin : forall a, 0<=a -> √a<=a.
+Proof.
+ intros a Ha.
+ destruct (le_gt_cases a 0) as [H|H].
+ setoid_replace a with 0 by order. now rewrite sqrt_0.
+ destruct (le_gt_cases a 1) as [H'|H'].
+ rewrite <- le_succ_l, <- one_succ in H.
+ setoid_replace a with 1 by order. now rewrite sqrt_1.
+ now apply lt_le_incl, sqrt_lt_lin.
+Qed.
+
+(** Sqrt and multiplication. *)
+
+(** Due to rounding error, we don't have the usual √(a*b) = √a*√b
+    but only lower and upper bounds. *)
+
+Lemma sqrt_mul_below : forall a b, √a * √b <= √(a*b).
+Proof.
+ intros a b.
+ destruct (lt_ge_cases a 0) as [Ha|Ha].
+ rewrite (sqrt_neg a Ha). nzsimpl. apply sqrt_nonneg.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+ rewrite (sqrt_neg b Hb). nzsimpl. apply sqrt_nonneg.
+ assert (Ha':=sqrt_nonneg a).
+ assert (Hb':=sqrt_nonneg b).
+ apply sqrt_le_square; try now apply mul_nonneg_nonneg.
+ rewrite mul_shuffle1.
+ apply mul_le_mono_nonneg; try now apply mul_nonneg_nonneg.
+  now apply sqrt_spec.
+  now apply sqrt_spec.
+Qed.
+
+Lemma sqrt_mul_above : forall a b, 0<=a -> 0<=b -> √(a*b) < S (√a) * S (√b).
+Proof.
+ intros a b Ha Hb.
+ apply sqrt_lt_square.
+ now apply mul_nonneg_nonneg.
+ apply mul_nonneg_nonneg.
+ now apply lt_le_incl, lt_succ_r, sqrt_nonneg.
+ now apply lt_le_incl, lt_succ_r, sqrt_nonneg.
+ rewrite mul_shuffle1.
+ apply mul_lt_mono_nonneg; trivial; now apply sqrt_spec.
+Qed.
+
+(** And we can't find better approximations in general.
+    - The lower bound is exact for squares
+    - Concerning the upper bound, for any c>0, take a=b=c²-1,
+      then √(a*b) = c² -1 while S √a = S √b = c
+*)
+
+(** Sqrt and successor :
+    - the sqrt function climbs by at most 1 at a time
+    - otherwise it stays at the same value
+    - the +1 steps occur for squares
+*)
+
+Lemma sqrt_succ_le : forall a, 0<=a -> √(S a) <= S (√a).
+Proof.
+ intros a Ha.
+ apply lt_succ_r.
+ apply sqrt_lt_square.
+ now apply le_le_succ_r.
+ apply le_le_succ_r, le_le_succ_r, sqrt_nonneg.
+ rewrite <- (add_1_l (S (√a))).
+ apply lt_le_trans with (1²+(S (√a))²).
+ rewrite mul_1_l, add_1_l, <- succ_lt_mono.
+ now apply sqrt_spec.
+ apply add_square_le. order'. apply le_le_succ_r, sqrt_nonneg.
+Qed.
+
+Lemma sqrt_succ_or : forall a, 0<=a -> √(S a) == S (√a) \/ √(S a) == √a.
+Proof.
+ intros a Ha.
+ destruct (le_gt_cases (√(S a)) (√a)) as [H|H].
+ right. generalize (sqrt_le_mono _ _ (le_succ_diag_r a)); order.
+ left. apply le_succ_l in H. generalize (sqrt_succ_le a Ha); order.
+Qed.
+
+Lemma sqrt_eq_succ_iff_square : forall a, 0<=a ->
+ (√(S a) == S (√a) <-> exists b, 0<b /\ S a == b²).
+Proof.
+ intros a Ha. split.
+ intros EQ. exists (S (√a)).
+ split. apply lt_succ_r, sqrt_nonneg.
+ generalize (proj2 (sqrt_spec a Ha)). rewrite <- le_succ_l.
+ assert (Ha' : 0 <= S a) by now apply le_le_succ_r.
+ generalize (proj1 (sqrt_spec (S a) Ha')). rewrite EQ; order.
+ intros (b & Hb & H).
+ rewrite H. rewrite sqrt_square; try order.
+ symmetry.
+ rewrite <- (lt_succ_pred 0 b Hb). f_equiv.
+ rewrite <- (lt_succ_pred 0 b²) in H. apply succ_inj in H.
+ now rewrite H, sqrt_pred_square.
+ now apply mul_pos_pos.
+Qed.
+
+(** Sqrt and addition *)
+
+Lemma sqrt_add_le : forall a b, √(a+b) <= √a + √b.
+Proof.
+ assert (AUX : forall a b, a<0 -> √(a+b) <= √a + √b).
+  intros a b Ha. rewrite (sqrt_neg a Ha). nzsimpl.
+  apply sqrt_le_mono.
+  rewrite <- (add_0_l b) at 2.
+  apply add_le_mono_r; order.
+ intros a b.
+ destruct (lt_ge_cases a 0) as [Ha|Ha]. now apply AUX.
+ destruct (lt_ge_cases b 0) as [Hb|Hb].
+  rewrite (add_comm a), (add_comm (√a)); now apply AUX.
+ assert (Ha':=sqrt_nonneg a).
+ assert (Hb':=sqrt_nonneg b).
+ rewrite <- lt_succ_r.
+ apply sqrt_lt_square.
+  now apply add_nonneg_nonneg.
+  now apply lt_le_incl, lt_succ_r, add_nonneg_nonneg.
+ destruct (sqrt_spec a Ha) as (_,LTa).
+ destruct (sqrt_spec b Hb) as (_,LTb).
+ revert LTa LTb. nzsimpl. rewrite 3 lt_succ_r.
+ intros LTa LTb.
+ assert (H:=add_le_mono _ _ _ _ LTa LTb).
+ etransitivity; [eexact H|]. clear LTa LTb H.
+ rewrite <- (add_assoc _ (√a) (√a)).
+ rewrite <- (add_assoc _ (√b) (√b)).
+ rewrite add_shuffle1.
+ rewrite <- (add_assoc _ (√a + √b)).
+ rewrite (add_shuffle1 (√a) (√b)).
+ apply add_le_mono_r.
+ now apply add_square_le.
+Qed.
+
+(** convexity inequality for sqrt: sqrt of middle is above middle
+    of square roots. *)
+
+Lemma add_sqrt_le : forall a b, 0<=a -> 0<=b -> √a + √b <= √(2*(a+b)).
+Proof.
+ intros a b Ha Hb.
+ assert (Ha':=sqrt_nonneg a).
+ assert (Hb':=sqrt_nonneg b).
+ apply sqrt_le_square.
+  apply mul_nonneg_nonneg. order'. now apply add_nonneg_nonneg.
+  now apply add_nonneg_nonneg.
+ transitivity (2*((√a)² + (√b)²)).
+ now apply square_add_le.
+ apply mul_le_mono_nonneg_l. order'.
+ apply add_le_mono; now apply sqrt_spec.
+Qed.
+
+End NZSqrtProp.
+
+Module Type NZSqrtUpProp
+ (Import A : NZDecOrdAxiomsSig')
+ (Import B : NZSqrt' A)
+ (Import C : NZMulOrderProp A)
+ (Import D : NZSqrtProp A B C).
+
+(** * [sqrt_up] : a square root that rounds up instead of down *)
+
+Local Notation "a ²" := (a*a) (at level 5, no associativity, format "a ²").
+
+(** For once, we define instead of axiomatizing, thanks to sqrt *)
+
+Definition sqrt_up a :=
+ match compare 0 a with
+  | Lt => S √(P a)
+  | _ => 0
+ end.
+
+Local Notation "√° a" := (sqrt_up a) (at level 6, no associativity).
+
+Lemma sqrt_up_eqn0 : forall a, a<=0 -> √°a == 0.
+Proof.
+ intros a Ha. unfold sqrt_up. case compare_spec; try order.
+Qed.
+
+Lemma sqrt_up_eqn : forall a, 0<a -> √°a == S √(P a).
+Proof.
+ intros a Ha. unfold sqrt_up. case compare_spec; try order.
+Qed.
+
+Lemma sqrt_up_spec : forall a, 0<a -> (P √°a)² < a <= (√°a)².
+Proof.
+ intros a Ha.
+ rewrite sqrt_up_eqn, pred_succ; trivial.
+ assert (Ha' := lt_succ_pred 0 a Ha).
+ rewrite <- Ha' at 3 4.
+ rewrite le_succ_l, lt_succ_r.
+ apply sqrt_spec.
+ now rewrite <- lt_succ_r, Ha'.
+Qed.
+
+(** First, [sqrt_up] is non-negative *)
+
+Lemma sqrt_up_nonneg : forall a, 0<=√°a.
+Proof.
+ intros. destruct (le_gt_cases a 0) as [Ha|Ha].
+ now rewrite sqrt_up_eqn0.
+ rewrite sqrt_up_eqn; trivial. apply le_le_succ_r, sqrt_nonneg.
+Qed.
+
+(** [sqrt_up] is a morphism *)
+
+Instance sqrt_up_wd : Proper (eq==>eq) sqrt_up.
+Proof.
+ assert (Proper (eq==>eq==>Logic.eq) compare).
+  intros x x' Hx y y' Hy. do 2 case compare_spec; trivial; order.
+ intros x x' Hx. unfold sqrt_up. rewrite Hx. case compare; now rewrite ?Hx.
+Qed.
+
+(** The spec of [sqrt_up] indeed determines it *)
+
+Lemma sqrt_up_unique : forall a b, 0<b -> (P b)² < a <= b² -> √°a == b.
+Proof.
+ intros a b Hb (LEb,LTb).
+ assert (Ha : 0<a)
+  by (apply le_lt_trans with (P b)²; trivial using square_nonneg).
+ rewrite sqrt_up_eqn; trivial.
+ assert (Hb' := lt_succ_pred 0 b Hb).
+ rewrite <- Hb'. f_equiv. apply sqrt_unique.
+ rewrite <- le_succ_l, <- lt_succ_r, Hb'.
+ rewrite (lt_succ_pred 0 a Ha). now split.
+Qed.
+
+(** [sqrt_up] is exact on squares *)
+
+Lemma sqrt_up_square : forall a, 0<=a -> √°(a²) == a.
+Proof.
+ intros a Ha.
+ le_elim Ha.
+ rewrite sqrt_up_eqn by (now apply mul_pos_pos).
+ rewrite sqrt_pred_square; trivial. apply (lt_succ_pred 0); trivial.
+ rewrite sqrt_up_eqn0; trivial. rewrite <- Ha. now nzsimpl.
+Qed.
+
+(** [sqrt_up] and successors of squares *)
+
+Lemma sqrt_up_succ_square : forall a, 0<=a -> √°(S a²) == S a.
+Proof.
+ intros a Ha.
+ rewrite sqrt_up_eqn by (now apply lt_succ_r, mul_nonneg_nonneg).
+ now rewrite pred_succ, sqrt_square.
+Qed.
+
+(** Basic constants *)
+
+Lemma sqrt_up_0 : √°0 == 0.
+Proof.
+ rewrite <- (mul_0_l 0) at 1. now apply sqrt_up_square.
+Qed.
+
+Lemma sqrt_up_1 : √°1 == 1.
+Proof.
+ rewrite <- (mul_1_l 1) at 1. apply sqrt_up_square. order'.
+Qed.
+
+Lemma sqrt_up_2 : √°2 == 2.
+Proof.
+ rewrite sqrt_up_eqn by order'.
+ now rewrite two_succ, pred_succ, sqrt_1.
+Qed.
+
+(**  Links between sqrt and [sqrt_up] *)
+
+Lemma le_sqrt_sqrt_up : forall a, √a <= √°a.
+Proof.
+ intros a. unfold sqrt_up. case compare_spec; intros H.
+ rewrite <- H, sqrt_0. order.
+ rewrite <- (lt_succ_pred 0 a H) at 1. apply sqrt_succ_le.
+ apply lt_succ_r. now rewrite (lt_succ_pred 0 a H).
+ now rewrite sqrt_neg.
+Qed.
+
+Lemma le_sqrt_up_succ_sqrt : forall a, √°a <= S (√a).
+Proof.
+ intros a. unfold sqrt_up.
+ case compare_spec; intros H; try apply le_le_succ_r, sqrt_nonneg.
+ rewrite <- succ_le_mono. apply sqrt_le_mono.
+ rewrite <- (lt_succ_pred 0 a H) at 2. apply le_succ_diag_r.
+Qed.
+
+Lemma sqrt_sqrt_up_spec : forall a, 0<=a -> (√a)² <= a <= (√°a)².
+Proof.
+ intros a H. split.
+ now apply sqrt_spec.
+ le_elim H.
+ now apply sqrt_up_spec.
+ now rewrite <-H, sqrt_up_0, mul_0_l.
+Qed.
+
+Lemma sqrt_sqrt_up_exact :
+ forall a, 0<=a -> (√a == √°a <-> exists b, 0<=b /\ a == b²).
+Proof.
+ intros a Ha.
+ split. intros. exists √a.
+  split. apply sqrt_nonneg.
+  generalize (sqrt_sqrt_up_spec a Ha). rewrite <-H. destruct 1; order.
+ intros (b & Hb & Hb'). rewrite Hb'.
+ now rewrite sqrt_square, sqrt_up_square.
+Qed.
+
+(** [sqrt_up] is a monotone function (but not a strict one) *)
+
+Lemma sqrt_up_le_mono : forall a b, a <= b -> √°a <= √°b.
+Proof.
+ intros a b H.
+ destruct (le_gt_cases a 0) as [Ha|Ha].
+ rewrite (sqrt_up_eqn0 _ Ha). apply sqrt_up_nonneg.
+ rewrite 2 sqrt_up_eqn by order. rewrite <- succ_le_mono.
+ apply sqrt_le_mono, succ_le_mono. rewrite 2 (lt_succ_pred 0); order.
+Qed.
+
+(** No reverse result for <=, consider for instance √°3 <= √°2 *)
+
+Lemma sqrt_up_lt_cancel : forall a b, √°a < √°b -> a < b.
+Proof.
+ intros a b H.
+ destruct (le_gt_cases b 0) as [Hb|Hb].
+ rewrite (sqrt_up_eqn0 _ Hb) in H; generalize (sqrt_up_nonneg a); order.
+ destruct (le_gt_cases a 0) as [Ha|Ha]; [order|].
+ rewrite <- (lt_succ_pred 0 a Ha), <- (lt_succ_pred 0 b Hb), <- succ_lt_mono.
+ apply sqrt_lt_cancel, succ_lt_mono. now rewrite <- 2 sqrt_up_eqn.
+Qed.
+
+(** When left side is a square, we have an equivalence for < *)
+
+Lemma sqrt_up_lt_square : forall a b, 0<=a -> 0<=b -> (b² < a <-> b < √°a).
+Proof.
+ intros a b Ha Hb. split; intros H.
+ destruct (sqrt_up_spec a) as (LE,LT).
+ apply le_lt_trans with b²; trivial using square_nonneg.
+ apply square_lt_simpl_nonneg; try order. apply sqrt_up_nonneg.
+ apply sqrt_up_lt_cancel. now rewrite sqrt_up_square.
+Qed.
+
+(** When right side is a square, we have an equivalence for <= *)
+
+Lemma sqrt_up_le_square : forall a b, 0<=a -> 0<=b -> (a <= b² <-> √°a <= b).
+Proof.
+ intros a b Ha Hb. split; intros H.
+ rewrite <- (sqrt_up_square b Hb).
+ now apply sqrt_up_le_mono.
+ apply square_le_mono_nonneg in H; [|now apply sqrt_up_nonneg].
+ transitivity (√°a)²; trivial. now apply sqrt_sqrt_up_spec.
+Qed.
+
+Lemma sqrt_up_pos : forall a, 0 < √°a <-> 0 < a.
+Proof.
+ intros a. split; intros Ha. apply sqrt_up_lt_cancel. now rewrite sqrt_up_0.
+ rewrite <- le_succ_l, <- one_succ, <- sqrt_up_1. apply sqrt_up_le_mono.
+ now rewrite one_succ, le_succ_l.
+Qed.
+
+Lemma sqrt_up_lt_lin : forall a, 2<a -> √°a < a.
+Proof.
+ intros a Ha.
+ rewrite sqrt_up_eqn by order'.
+ assert (Ha' := lt_succ_pred 2 a Ha).
+ rewrite <- Ha' at 2. rewrite <- succ_lt_mono.
+ apply sqrt_lt_lin. rewrite succ_lt_mono. now rewrite Ha', <- two_succ.
+Qed.
+
+Lemma sqrt_up_le_lin : forall a, 0<=a -> √°a<=a.
+Proof.
+ intros a Ha.
+ le_elim Ha.
+ rewrite sqrt_up_eqn; trivial. apply le_succ_l.
+ apply le_lt_trans with (P a). apply sqrt_le_lin.
+ now rewrite <- lt_succ_r, (lt_succ_pred 0).
+ rewrite <- (lt_succ_pred 0 a) at 2; trivial. apply lt_succ_diag_r.
+ now rewrite <- Ha, sqrt_up_0.
+Qed.
+
+(** [sqrt_up] and multiplication. *)
+
+(** Due to rounding error, we don't have the usual [√(a*b) = √a*√b]
+    but only lower and upper bounds. *)
+
+Lemma sqrt_up_mul_above : forall a b, 0<=a -> 0<=b -> √°(a*b) <= √°a * √°b.
+Proof.
+ intros a b Ha Hb.
+ apply sqrt_up_le_square.
+ now apply mul_nonneg_nonneg.
+ apply mul_nonneg_nonneg; apply sqrt_up_nonneg.
+ rewrite mul_shuffle1.
+ apply mul_le_mono_nonneg; trivial; now apply sqrt_sqrt_up_spec.
+Qed.
+
+Lemma sqrt_up_mul_below : forall a b, 0<a -> 0<b -> (P √°a)*(P √°b) < √°(a*b).
+Proof.
+ intros a b Ha Hb.
+ apply sqrt_up_lt_square.
+ apply mul_nonneg_nonneg; order.
+ apply mul_nonneg_nonneg; apply lt_succ_r.
+ rewrite (lt_succ_pred 0); now rewrite sqrt_up_pos.
+ rewrite (lt_succ_pred 0); now rewrite sqrt_up_pos.
+ rewrite mul_shuffle1.
+ apply mul_lt_mono_nonneg; trivial using square_nonneg;
+  now apply sqrt_up_spec.
+Qed.
+
+(** And we can't find better approximations in general.
+    - The upper bound is exact for squares
+    - Concerning the lower bound, for any c>0, take [a=b=c²+1],
+      then [√°(a*b) = c²+1] while [P √°a = P √°b = c]
+*)
+
+(** [sqrt_up] and successor :
+    - the [sqrt_up] function climbs by at most 1 at a time
+    - otherwise it stays at the same value
+    - the +1 steps occur after squares
+*)
+
+Lemma sqrt_up_succ_le : forall a, 0<=a -> √°(S a) <= S (√°a).
+Proof.
+ intros a Ha.
+ apply sqrt_up_le_square.
+ now apply le_le_succ_r.
+ apply le_le_succ_r, sqrt_up_nonneg.
+ rewrite <- (add_1_l (√°a)).
+ apply le_trans with (1²+(√°a)²).
+ rewrite mul_1_l, add_1_l, <- succ_le_mono.
+ now apply sqrt_sqrt_up_spec.
+ apply add_square_le. order'. apply sqrt_up_nonneg.
+Qed.
+
+Lemma sqrt_up_succ_or : forall a, 0<=a -> √°(S a) == S (√°a) \/ √°(S a) == √°a.
+Proof.
+ intros a Ha.
+ destruct (le_gt_cases (√°(S a)) (√°a)) as [H|H].
+ right. generalize (sqrt_up_le_mono _ _ (le_succ_diag_r a)); order.
+ left. apply le_succ_l in H. generalize (sqrt_up_succ_le a Ha); order.
+Qed.
+
+Lemma sqrt_up_eq_succ_iff_square : forall a, 0<=a ->
+ (√°(S a) == S (√°a) <-> exists b, 0<=b /\ a == b²).
+Proof.
+ intros a Ha. split.
+ intros EQ.
+ le_elim Ha.
+ exists (√°a). split. apply sqrt_up_nonneg.
+ generalize (proj2 (sqrt_up_spec a Ha)).
+ assert (Ha' : 0 < S a) by (apply lt_succ_r; order').
+ generalize (proj1 (sqrt_up_spec (S a) Ha')).
+ rewrite EQ, pred_succ, lt_succ_r. order.
+ exists 0. nzsimpl. now split.
+ intros (b & Hb & H).
+ now rewrite H, sqrt_up_succ_square, sqrt_up_square.
+Qed.
+
+(** [sqrt_up] and addition *)
+
+Lemma sqrt_up_add_le : forall a b, √°(a+b) <= √°a + √°b.
+Proof.
+ assert (AUX : forall a b, a<=0 -> √°(a+b) <= √°a + √°b).
+  intros a b Ha. rewrite (sqrt_up_eqn0 a Ha). nzsimpl.
+  apply sqrt_up_le_mono.
+  rewrite <- (add_0_l b) at 2.
+  apply add_le_mono_r; order.
+ intros a b.
+ destruct (le_gt_cases a 0) as [Ha|Ha]. now apply AUX.
+ destruct (le_gt_cases b 0) as [Hb|Hb].
+  rewrite (add_comm a), (add_comm (√°a)); now apply AUX.
+ rewrite 2 sqrt_up_eqn; trivial.
+ nzsimpl. rewrite <- succ_le_mono.
+ transitivity (√(P a) + √b).
+ rewrite <- (lt_succ_pred 0 a Ha) at 1. nzsimpl. apply sqrt_add_le.
+ apply add_le_mono_l.
+ apply le_sqrt_sqrt_up.
+ now apply add_pos_pos.
+Qed.
+
+(** Convexity-like inequality for [sqrt_up]: [sqrt_up] of middle is above middle
+    of square roots. We cannot say more, for instance take a=b=2, then
+    2+2 <= S 3 *)
+
+Lemma add_sqrt_up_le : forall a b, 0<=a -> 0<=b -> √°a + √°b <= S √°(2*(a+b)).
+Proof.
+ intros a b Ha Hb.
+ le_elim Ha.
+ le_elim Hb.
+ rewrite 3 sqrt_up_eqn; trivial.
+ nzsimpl. rewrite <- 2 succ_le_mono.
+ etransitivity; [eapply add_sqrt_le|].
+ apply lt_succ_r. now rewrite (lt_succ_pred 0 a Ha).
+ apply lt_succ_r. now rewrite (lt_succ_pred 0 b Hb).
+ apply sqrt_le_mono.
+ apply lt_succ_r. rewrite (lt_succ_pred 0).
+ apply mul_lt_mono_pos_l. order'.
+ apply add_lt_mono.
+ apply le_succ_l. now rewrite (lt_succ_pred 0).
+ apply le_succ_l. now rewrite (lt_succ_pred 0).
+ apply mul_pos_pos. order'. now apply add_pos_pos.
+ apply mul_pos_pos. order'. now apply add_pos_pos.
+ rewrite <- Hb, sqrt_up_0. nzsimpl. apply le_le_succ_r, sqrt_up_le_mono.
+ rewrite <- (mul_1_l a) at 1. apply mul_le_mono_nonneg_r; order'.
+ rewrite <- Ha, sqrt_up_0. nzsimpl. apply le_le_succ_r, sqrt_up_le_mono.
+ rewrite <- (mul_1_l b) at 1. apply mul_le_mono_nonneg_r; order'.
+Qed.
+
+End NZSqrtUpProp.
diff --git a/theories/Numbers/Natural/Abstract/NAdd.v b/theories/Numbers/Natural/Abstract/NAdd.v
index 4185de95..0ff86fca 100644
--- a/theories/Numbers/Natural/Abstract/NAdd.v
+++ b/theories/Numbers/Natural/Abstract/NAdd.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,12 +8,10 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NAdd.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NBase.
 
-Module NAddPropFunct (Import N : NAxiomsSig').
-Include NBasePropFunct N.
+Module NAddProp (Import N : NAxiomsMiniSig').
+Include NBaseProp N.
 
 (** For theorems about [add] that are both valid for [N] and [Z], see [NZAdd] *)
 (** Now comes theorems valid for natural numbers but not for Z *)
@@ -24,9 +22,9 @@ intros n m; induct n.
 nzsimpl; intuition.
 intros n IH. nzsimpl.
 setoid_replace (S (n + m) == 0) with False by
- (apply -> neg_false; apply neq_succ_0).
+ (apply neg_false; apply neq_succ_0).
 setoid_replace (S n == 0) with False by
- (apply -> neg_false; apply neq_succ_0). tauto.
+ (apply neg_false; apply neq_succ_0). tauto.
 Qed.
 
 Theorem eq_add_succ :
@@ -47,13 +45,13 @@ Qed.
 Theorem eq_add_1 : forall n m,
   n + m == 1 -> n == 1 /\ m == 0 \/ n == 0 /\ m == 1.
 Proof.
-intros n m H.
+intros n m. rewrite one_succ. intro H.
 assert (H1 : exists p, n + m == S p) by now exists 0.
-apply -> eq_add_succ in H1. destruct H1 as [[n' H1] | [m' H1]].
+apply eq_add_succ in H1. destruct H1 as [[n' H1] | [m' H1]].
 left. rewrite H1 in H; rewrite add_succ_l in H; apply succ_inj in H.
-apply -> eq_add_0 in H. destruct H as [H2 H3]; rewrite H2 in H1; now split.
+apply eq_add_0 in H. destruct H as [H2 H3]; rewrite H2 in H1; now split.
 right. rewrite H1 in H; rewrite add_succ_r in H; apply succ_inj in H.
-apply -> eq_add_0 in H. destruct H as [H2 H3]; rewrite H3 in H1; now split.
+apply eq_add_0 in H. destruct H as [H2 H3]; rewrite H3 in H1; now split.
 Qed.
 
 Theorem succ_add_discr : forall n m, m ~= S (n + m).
@@ -77,5 +75,5 @@ intros n m H; rewrite (add_comm n (P m));
 rewrite (add_comm n m); now apply add_pred_l.
 Qed.
 
-End NAddPropFunct.
+End NAddProp.
 
diff --git a/theories/Numbers/Natural/Abstract/NAddOrder.v b/theories/Numbers/Natural/Abstract/NAddOrder.v
index 0282a6b8..5f80714a 100644
--- a/theories/Numbers/Natural/Abstract/NAddOrder.v
+++ b/theories/Numbers/Natural/Abstract/NAddOrder.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,12 +8,10 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NAddOrder.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NOrder.
 
-Module NAddOrderPropFunct (Import N : NAxiomsSig').
-Include NOrderPropFunct N.
+Module NAddOrderProp (Import N : NAxiomsMiniSig').
+Include NOrderProp N.
 
 (** Theorems true for natural numbers, not for integers *)
 
@@ -45,4 +43,4 @@ Proof.
 intros; apply add_nonneg_pos. apply le_0_l. assumption.
 Qed.
 
-End NAddOrderPropFunct.
+End NAddOrderProp.
diff --git a/theories/Numbers/Natural/Abstract/NAxioms.v b/theories/Numbers/Natural/Abstract/NAxioms.v
index d1cc9972..061da038 100644
--- a/theories/Numbers/Natural/Abstract/NAxioms.v
+++ b/theories/Numbers/Natural/Abstract/NAxioms.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,32 +8,60 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NAxioms.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+Require Export Bool NZAxioms NZParity NZPow NZSqrt NZLog NZDiv NZGcd NZBits.
 
-Require Export NZAxioms.
+(** From [NZ], we obtain natural numbers just by stating that [pred 0] == 0 *)
 
-Set Implicit Arguments.
+Module Type NAxiom (Import NZ : NZDomainSig').
+ Axiom pred_0 : P 0 == 0.
+End NAxiom.
 
-Module Type NAxioms (Import NZ : NZDomainSig').
+Module Type NAxiomsMiniSig := NZOrdAxiomsSig <+ NAxiom.
+Module Type NAxiomsMiniSig' := NZOrdAxiomsSig' <+ NAxiom.
 
-Axiom pred_0 : P 0 == 0.
+(** Let's now add some more functions and their specification *)
 
-Parameter Inline recursion : forall A : Type, A -> (t -> A -> A) -> t -> A.
-Implicit Arguments recursion [A].
+(** Division Function : we reuse NZDiv.DivMod and NZDiv.NZDivCommon,
+    and add to that a N-specific constraint. *)
 
-Declare Instance recursion_wd (A : Type) (Aeq : relation A) :
- Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A).
+Module Type NDivSpecific (Import N : NAxiomsMiniSig')(Import DM : DivMod' N).
+ Axiom mod_upper_bound : forall a b, b ~= 0 -> a mod b < b.
+End NDivSpecific.
+
+(** For all other functions, the NZ axiomatizations are enough. *)
+
+(** We now group everything together. *)
+
+Module Type NAxiomsSig := NAxiomsMiniSig <+ OrderFunctions
+  <+ NZParity.NZParity <+ NZPow.NZPow <+ NZSqrt.NZSqrt <+ NZLog.NZLog2
+  <+ NZGcd.NZGcd <+ NZDiv.NZDiv <+ NZBits.NZBits <+ NZSquare.
+
+Module Type NAxiomsSig' := NAxiomsMiniSig' <+ OrderFunctions'
+  <+ NZParity.NZParity <+ NZPow.NZPow' <+ NZSqrt.NZSqrt' <+ NZLog.NZLog2
+  <+ NZGcd.NZGcd' <+ NZDiv.NZDiv' <+ NZBits.NZBits' <+ NZSquare.
+
+
+(** It could also be interesting to have a constructive recursor function. *)
+
+Module Type NAxiomsRec (Import NZ : NZDomainSig').
+
+Parameter Inline recursion : forall {A : Type}, A -> (t -> A -> A) -> t -> A.
+
+Declare Instance recursion_wd {A : Type} (Aeq : relation A) :
+ Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) recursion.
 
 Axiom recursion_0 :
-  forall (A : Type) (a : A) (f : t -> A -> A), recursion a f 0 = a.
+  forall {A} (a : A) (f : t -> A -> A), recursion a f 0 = a.
 
 Axiom recursion_succ :
-  forall (A : Type) (Aeq : relation A) (a : A) (f : t -> A -> A),
+  forall {A} (Aeq : relation A) (a : A) (f : t -> A -> A),
     Aeq a a -> Proper (eq==>Aeq==>Aeq) f ->
       forall n, Aeq (recursion a f (S n)) (f n (recursion a f n)).
 
-End NAxioms.
+End NAxiomsRec.
 
-Module Type NAxiomsSig := NZOrdAxiomsSig <+ NAxioms.
-Module Type NAxiomsSig' := NZOrdAxiomsSig' <+ NAxioms.
+Module Type NAxiomsRecSig := NAxiomsMiniSig <+ NAxiomsRec.
+Module Type NAxiomsRecSig' := NAxiomsMiniSig' <+ NAxiomsRec.
 
+Module Type NAxiomsFullSig := NAxiomsSig <+ NAxiomsRec.
+Module Type NAxiomsFullSig' := NAxiomsSig' <+ NAxiomsRec.
diff --git a/theories/Numbers/Natural/Abstract/NBase.v b/theories/Numbers/Natural/Abstract/NBase.v
index efaba960..09e9ccdf 100644
--- a/theories/Numbers/Natural/Abstract/NBase.v
+++ b/theories/Numbers/Natural/Abstract/NBase.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,48 +8,23 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NBase.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Decidable.
 Require Export NAxioms.
 Require Import NZProperties.
 
-Module NBasePropFunct (Import N : NAxiomsSig').
+Module NBaseProp (Import N : NAxiomsMiniSig').
 (** First, we import all known facts about both natural numbers and integers. *)
-Include NZPropFunct N.
-
-(** We prove that the successor of a number is not zero by defining a
-function (by recursion) that maps 0 to false and the successor to true *)
-
-Definition if_zero (A : Type) (a b : A) (n : N.t) : A :=
-  recursion a (fun _ _ => b) n.
-
-Implicit Arguments if_zero [A].
-
-Instance if_zero_wd (A : Type) :
- Proper (Logic.eq ==> Logic.eq ==> N.eq ==> Logic.eq) (@if_zero A).
-Proof.
-intros; unfold if_zero.
-repeat red; intros. apply recursion_wd; auto. repeat red; auto.
-Qed.
-
-Theorem if_zero_0 : forall (A : Type) (a b : A), if_zero a b 0 = a.
-Proof.
-unfold if_zero; intros; now rewrite recursion_0.
-Qed.
+Include NZProp N.
 
-Theorem if_zero_succ :
- forall (A : Type) (a b : A) (n : N.t), if_zero a b (S n) = b.
-Proof.
-intros; unfold if_zero.
-now rewrite recursion_succ.
-Qed.
+(** From [pred_0] and order facts, we can prove that 0 isn't a successor. *)
 
 Theorem neq_succ_0 : forall n, S n ~= 0.
 Proof.
-intros n H.
-generalize (Logic.eq_refl (if_zero false true 0)).
-rewrite <- H at 1. rewrite if_zero_0, if_zero_succ; discriminate.
+ intros n EQ.
+ assert (EQ' := pred_succ n).
+ rewrite EQ, pred_0 in EQ'.
+ rewrite <- EQ' in EQ.
+ now apply (neq_succ_diag_l 0).
 Qed.
 
 Theorem neq_0_succ : forall n, 0 ~= S n.
@@ -66,7 +41,7 @@ nzinduct n.
 now apply eq_le_incl.
 intro n; split.
 apply le_le_succ_r.
-intro H; apply -> le_succ_r in H; destruct H as [H | H].
+intro H; apply le_succ_r in H; destruct H as [H | H].
 assumption.
 symmetry in H; false_hyp H neq_succ_0.
 Qed.
@@ -119,12 +94,11 @@ Qed.
 Theorem eq_pred_0 : forall n, P n == 0 <-> n == 0 \/ n == 1.
 Proof.
 cases n.
-rewrite pred_0. setoid_replace (0 == 1) with False using relation iff. tauto.
-split; intro H; [symmetry in H; false_hyp H neq_succ_0 | elim H].
+rewrite pred_0. now split; [left|].
 intro n. rewrite pred_succ.
-setoid_replace (S n == 0) with False using relation iff by
-  (apply -> neg_false; apply neq_succ_0).
-rewrite succ_inj_wd. tauto.
+split. intros H; right. now rewrite H, one_succ.
+intros [H|H]. elim (neq_succ_0 _ H).
+apply succ_inj_wd. now rewrite <- one_succ.
 Qed.
 
 Theorem succ_pred : forall n, n ~= 0 -> S (P n) == n.
@@ -155,6 +129,7 @@ Theorem pair_induction :
   A 0 -> A 1 ->
     (forall n, A n -> A (S n) -> A (S (S n))) -> forall n, A n.
 Proof.
+rewrite one_succ.
 intros until 3.
 assert (D : forall n, A n /\ A (S n)); [ |intro n; exact (proj1 (D n))].
 induct n; [ | intros n [IH1 IH2]]; auto.
@@ -204,7 +179,7 @@ Ltac double_induct n m :=
   try intros until n;
   try intros until m;
   pattern n, m; apply double_induction; clear n m;
-  [solve_relation_wd | | | ].
+  [solve_proper | | | ].
 
-End NBasePropFunct.
+End NBaseProp.
 
diff --git a/theories/Numbers/Natural/Abstract/NBits.v b/theories/Numbers/Natural/Abstract/NBits.v
new file mode 100644
index 00000000..1581ce57
--- /dev/null
+++ b/theories/Numbers/Natural/Abstract/NBits.v
@@ -0,0 +1,1463 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Bool NAxioms NSub NPow NDiv NParity NLog.
+
+(** Derived properties of bitwise operations *)
+
+Module Type NBitsProp
+ (Import A : NAxiomsSig')
+ (Import B : NSubProp A)
+ (Import C : NParityProp A B)
+ (Import D : NPowProp A B C)
+ (Import E : NDivProp A B)
+ (Import F : NLog2Prop A B C D).
+
+Include BoolEqualityFacts A.
+
+Ltac order_nz := try apply pow_nonzero; order'.
+Hint Rewrite div_0_l mod_0_l div_1_r mod_1_r : nz.
+
+(** Some properties of power and division *)
+
+Lemma pow_sub_r : forall a b c, a~=0 -> c<=b -> a^(b-c) == a^b / a^c.
+Proof.
+ intros a b c Ha H.
+ apply div_unique with 0.
+ generalize (pow_nonzero a c Ha) (le_0_l (a^c)); order'.
+ nzsimpl. now rewrite <- pow_add_r, add_comm, sub_add.
+Qed.
+
+Lemma pow_div_l : forall a b c, b~=0 -> a mod b == 0 ->
+ (a/b)^c == a^c / b^c.
+Proof.
+ intros a b c Hb H.
+ apply div_unique with 0.
+ generalize (pow_nonzero b c Hb) (le_0_l (b^c)); order'.
+ nzsimpl. rewrite <- pow_mul_l. f_equiv. now apply div_exact.
+Qed.
+
+(** An injection from bits [true] and [false] to numbers 1 and 0.
+    We declare it as a (local) coercion for shorter statements. *)
+
+Definition b2n (b:bool) := if b then 1 else 0.
+Local Coercion b2n : bool >-> t.
+
+Instance b2n_proper : Proper (Logic.eq ==> eq) b2n.
+Proof. solve_proper. Qed.
+
+Lemma exists_div2 a : exists a' (b:bool), a == 2*a' + b.
+Proof.
+ elim (Even_or_Odd a); [intros (a',H)| intros (a',H)].
+ exists a'. exists false. now nzsimpl.
+ exists a'. exists true. now simpl.
+Qed.
+
+(** We can compact [testbit_odd_0] [testbit_even_0]
+    [testbit_even_succ] [testbit_odd_succ] in only two lemmas. *)
+
+Lemma testbit_0_r a (b:bool) : testbit (2*a+b) 0 = b.
+Proof.
+ destruct b; simpl; rewrite ?add_0_r.
+ apply testbit_odd_0.
+ apply testbit_even_0.
+Qed.
+
+Lemma testbit_succ_r a (b:bool) n :
+ testbit (2*a+b) (succ n) = testbit a n.
+Proof.
+ destruct b; simpl; rewrite ?add_0_r.
+ apply testbit_odd_succ, le_0_l.
+ apply testbit_even_succ, le_0_l.
+Qed.
+
+(** Alternative caracterisations of [testbit] *)
+
+(** This concise equation could have been taken as specification
+   for testbit in the interface, but it would have been hard to
+   implement with little initial knowledge about div and mod *)
+
+Lemma testbit_spec' a n : a.[n] == (a / 2^n) mod 2.
+Proof.
+ revert a. induct n.
+ intros a. nzsimpl.
+ destruct (exists_div2 a) as (a' & b & H). rewrite H at 1.
+ rewrite testbit_0_r. apply mod_unique with a'; trivial.
+ destruct b; order'.
+ intros n IH a.
+ destruct (exists_div2 a) as (a' & b & H). rewrite H at 1.
+ rewrite testbit_succ_r, IH. f_equiv.
+ rewrite pow_succ_r', <- div_div by order_nz. f_equiv.
+ apply div_unique with b; trivial.
+ destruct b; order'.
+Qed.
+
+(** This caracterisation that uses only basic operations and
+   power was initially taken as specification for testbit.
+   We describe [a] as having a low part and a high part, with
+   the corresponding bit in the middle. This caracterisation
+   is moderatly complex to implement, but also moderately
+   usable... *)
+
+Lemma testbit_spec a n :
+  exists l h, 0<=l<2^n /\ a == l + (a.[n] + 2*h)*2^n.
+Proof.
+ exists (a mod 2^n). exists (a / 2^n / 2). split.
+ split; [apply le_0_l | apply mod_upper_bound; order_nz].
+ rewrite add_comm, mul_comm, (add_comm a.[n]).
+ rewrite (div_mod a (2^n)) at 1 by order_nz. do 2 f_equiv.
+ rewrite testbit_spec'. apply div_mod. order'.
+Qed.
+
+Lemma testbit_true : forall a n,
+ a.[n] = true <-> (a / 2^n) mod 2 == 1.
+Proof.
+ intros a n.
+ rewrite <- testbit_spec'; destruct a.[n]; split; simpl; now try order'.
+Qed.
+
+Lemma testbit_false : forall a n,
+ a.[n] = false <-> (a / 2^n) mod 2 == 0.
+Proof.
+ intros a n.
+ rewrite <- testbit_spec'; destruct a.[n]; split; simpl; now try order'.
+Qed.
+
+Lemma testbit_eqb : forall a n,
+ a.[n] = eqb ((a / 2^n) mod 2) 1.
+Proof.
+ intros a n.
+ apply eq_true_iff_eq. now rewrite testbit_true, eqb_eq.
+Qed.
+
+(** Results about the injection [b2n] *)
+
+Lemma b2n_inj : forall (a0 b0:bool), a0 == b0 -> a0 = b0.
+Proof.
+ intros [|] [|]; simpl; trivial; order'.
+Qed.
+
+Lemma add_b2n_double_div2 : forall (a0:bool) a, (a0+2*a)/2 == a.
+Proof.
+ intros a0 a. rewrite mul_comm, div_add by order'.
+ now rewrite div_small, add_0_l by (destruct a0; order').
+Qed.
+
+Lemma add_b2n_double_bit0 : forall (a0:bool) a, (a0+2*a).[0] = a0.
+Proof.
+ intros a0 a. apply b2n_inj.
+ rewrite testbit_spec'. nzsimpl. rewrite mul_comm, mod_add by order'.
+ now rewrite mod_small by (destruct a0; order').
+Qed.
+
+Lemma b2n_div2 : forall (a0:bool), a0/2 == 0.
+Proof.
+ intros a0. rewrite <- (add_b2n_double_div2 a0 0). now nzsimpl.
+Qed.
+
+Lemma b2n_bit0 : forall (a0:bool), a0.[0] = a0.
+Proof.
+ intros a0. rewrite <- (add_b2n_double_bit0 a0 0) at 2. now nzsimpl.
+Qed.
+
+(** The specification of testbit by low and high parts is complete *)
+
+Lemma testbit_unique : forall a n (a0:bool) l h,
+ l<2^n -> a == l + (a0 + 2*h)*2^n -> a.[n] = a0.
+Proof.
+ intros a n a0 l h Hl EQ.
+ apply b2n_inj. rewrite testbit_spec' by trivial.
+ symmetry. apply mod_unique with h. destruct a0; simpl; order'.
+ symmetry. apply div_unique with l; trivial.
+ now rewrite add_comm, (add_comm _ a0), mul_comm.
+Qed.
+
+(** All bits of number 0 are 0 *)
+
+Lemma bits_0 : forall n, 0.[n] = false.
+Proof.
+ intros n. apply testbit_false. nzsimpl; order_nz.
+Qed.
+
+(** Various ways to refer to the lowest bit of a number *)
+
+Lemma bit0_odd : forall a, a.[0] = odd a.
+Proof.
+ intros. symmetry.
+ destruct (exists_div2 a) as (a' & b & EQ).
+ rewrite EQ, testbit_0_r, add_comm, odd_add_mul_2.
+ destruct b; simpl; apply odd_1 || apply odd_0.
+Qed.
+
+Lemma bit0_eqb : forall a, a.[0] = eqb (a mod 2) 1.
+Proof.
+ intros a. rewrite testbit_eqb. now nzsimpl.
+Qed.
+
+Lemma bit0_mod : forall a, a.[0] == a mod 2.
+Proof.
+ intros a. rewrite testbit_spec'. now nzsimpl.
+Qed.
+
+(** Hence testing a bit is equivalent to shifting and testing parity *)
+
+Lemma testbit_odd : forall a n, a.[n] = odd (a>>n).
+Proof.
+ intros. now rewrite <- bit0_odd, shiftr_spec, add_0_l.
+Qed.
+
+(** [log2] gives the highest nonzero bit *)
+
+Lemma bit_log2 : forall a, a~=0 -> a.[log2 a] = true.
+Proof.
+ intros a Ha.
+ assert (Ha' : 0 < a) by (generalize (le_0_l a); order).
+ destruct (log2_spec_alt a Ha') as (r & EQ & (_,Hr)).
+ rewrite EQ at 1.
+ rewrite testbit_true, add_comm.
+ rewrite <- (mul_1_l (2^log2 a)) at 1.
+ rewrite div_add by order_nz.
+ rewrite div_small by trivial.
+ rewrite add_0_l. apply mod_small. order'.
+Qed.
+
+Lemma bits_above_log2 : forall a n, log2 a < n ->
+ a.[n] = false.
+Proof.
+ intros a n H.
+ rewrite testbit_false.
+ rewrite div_small. nzsimpl; order'.
+ apply log2_lt_cancel. rewrite log2_pow2; trivial using le_0_l.
+Qed.
+
+(** Hence the number of bits of [a] is [1+log2 a]
+    (see [Pos.size_nat] and [Pos.size]).
+*)
+
+(** Testing bits after division or multiplication by a power of two *)
+
+Lemma div2_bits : forall a n, (a/2).[n] = a.[S n].
+Proof.
+ intros. apply eq_true_iff_eq.
+ rewrite 2 testbit_true.
+ rewrite pow_succ_r by apply le_0_l.
+ now rewrite div_div by order_nz.
+Qed.
+
+Lemma div_pow2_bits : forall a n m, (a/2^n).[m] = a.[m+n].
+Proof.
+ intros a n. revert a. induct n.
+ intros a m. now nzsimpl.
+ intros n IH a m. nzsimpl; try apply le_0_l.
+ rewrite <- div_div by order_nz.
+ now rewrite IH, div2_bits.
+Qed.
+
+Lemma double_bits_succ : forall a n, (2*a).[S n] = a.[n].
+Proof.
+ intros. rewrite <- div2_bits. now rewrite mul_comm, div_mul by order'.
+Qed.
+
+Lemma mul_pow2_bits_add : forall a n m, (a*2^n).[m+n] = a.[m].
+Proof.
+ intros. rewrite <- div_pow2_bits. now rewrite div_mul by order_nz.
+Qed.
+
+Lemma mul_pow2_bits_high : forall a n m, n<=m -> (a*2^n).[m] = a.[m-n].
+Proof.
+ intros.
+ rewrite <- (sub_add n m) at 1 by order'.
+ now rewrite mul_pow2_bits_add.
+Qed.
+
+Lemma mul_pow2_bits_low : forall a n m, m<n -> (a*2^n).[m] = false.
+Proof.
+ intros. apply testbit_false.
+ rewrite <- (sub_add m n) by order'. rewrite pow_add_r, mul_assoc.
+ rewrite div_mul by order_nz.
+ rewrite <- (succ_pred (n-m)). rewrite pow_succ_r.
+ now rewrite (mul_comm 2), mul_assoc, mod_mul by order'.
+ apply lt_le_pred.
+ apply sub_gt in H. generalize (le_0_l (n-m)); order.
+ now apply sub_gt.
+Qed.
+
+(** Selecting the low part of a number can be done by a modulo *)
+
+Lemma mod_pow2_bits_high : forall a n m, n<=m ->
+ (a mod 2^n).[m] = false.
+Proof.
+ intros a n m H.
+ destruct (eq_0_gt_0_cases (a mod 2^n)) as [EQ|LT].
+ now rewrite EQ, bits_0.
+ apply bits_above_log2.
+ apply lt_le_trans with n; trivial.
+ apply log2_lt_pow2; trivial.
+ apply mod_upper_bound; order_nz.
+Qed.
+
+Lemma mod_pow2_bits_low : forall a n m, m<n ->
+ (a mod 2^n).[m] = a.[m].
+Proof.
+ intros a n m H.
+ rewrite testbit_eqb.
+ rewrite <- (mod_add _ (2^(P (n-m))*(a/2^n))) by order'.
+ rewrite <- div_add by order_nz.
+ rewrite (mul_comm _ 2), mul_assoc, <- pow_succ_r', succ_pred
+   by now apply sub_gt.
+ rewrite mul_comm, mul_assoc, <- pow_add_r, (add_comm m), sub_add
+   by order.
+ rewrite add_comm, <- div_mod by order_nz.
+ symmetry. apply testbit_eqb.
+Qed.
+
+(** We now prove that having the same bits implies equality.
+    For that we use a notion of equality over functional
+    streams of bits. *)
+
+Definition eqf (f g:t -> bool) := forall n:t, f n = g n.
+
+Instance eqf_equiv : Equivalence eqf.
+Proof.
+ split; congruence.
+Qed.
+
+Local Infix "===" := eqf (at level 70, no associativity).
+
+Instance testbit_eqf : Proper (eq==>eqf) testbit.
+Proof.
+ intros a a' Ha n. now rewrite Ha.
+Qed.
+
+(** Only zero corresponds to the always-false stream. *)
+
+Lemma bits_inj_0 :
+ forall a, (forall n, a.[n] = false) -> a == 0.
+Proof.
+ intros a H. destruct (eq_decidable a 0) as [EQ|NEQ]; trivial.
+ apply bit_log2 in NEQ. now rewrite H in NEQ.
+Qed.
+
+(** If two numbers produce the same stream of bits, they are equal. *)
+
+Lemma bits_inj : forall a b, testbit a === testbit b -> a == b.
+Proof.
+ intros a. pattern a.
+ apply strong_right_induction with 0;[solve_proper|clear a|apply le_0_l].
+ intros a _ IH b H.
+ destruct (eq_0_gt_0_cases a) as [EQ|LT].
+ rewrite EQ in H |- *. symmetry. apply bits_inj_0.
+ intros n. now rewrite <- H, bits_0.
+ rewrite (div_mod a 2), (div_mod b 2) by order'.
+ f_equiv; [ | now rewrite <- 2 bit0_mod, H].
+ f_equiv.
+ apply IH; trivial using le_0_l.
+ apply div_lt; order'.
+ intro n. rewrite 2 div2_bits. apply H.
+Qed.
+
+Lemma bits_inj_iff : forall a b, testbit a === testbit b <-> a == b.
+Proof.
+ split. apply bits_inj. intros EQ; now rewrite EQ.
+Qed.
+
+Hint Rewrite lxor_spec lor_spec land_spec ldiff_spec bits_0 : bitwise.
+
+Ltac bitwise := apply bits_inj; intros ?m; autorewrite with bitwise.
+
+(** The streams of bits that correspond to a natural numbers are
+  exactly the ones that are always 0 after some point *)
+
+Lemma are_bits : forall (f:t->bool), Proper (eq==>Logic.eq) f ->
+ ((exists n, f === testbit n) <->
+  (exists k, forall m, k<=m -> f m = false)).
+Proof.
+ intros f Hf. split.
+ intros (a,H).
+  exists (S (log2 a)). intros m Hm. apply le_succ_l in Hm.
+  rewrite H, bits_above_log2; trivial using lt_succ_diag_r.
+ intros (k,Hk).
+  revert f Hf Hk. induct k.
+  intros f Hf H0.
+  exists 0. intros m. rewrite bits_0, H0; trivial. apply le_0_l.
+  intros k IH f Hf Hk.
+  destruct (IH (fun m => f (S m))) as (n, Hn).
+  solve_proper.
+  intros m Hm. apply Hk. now rewrite <- succ_le_mono.
+  exists (f 0 + 2*n). intros m.
+  destruct (zero_or_succ m) as [Hm|(m', Hm)]; rewrite Hm.
+  symmetry. apply add_b2n_double_bit0.
+  rewrite Hn, <- div2_bits.
+  rewrite mul_comm, div_add, b2n_div2, add_0_l; trivial. order'.
+Qed.
+
+(** Properties of shifts *)
+
+Lemma shiftr_spec' : forall a n m, (a >> n).[m] = a.[m+n].
+Proof.
+ intros. apply shiftr_spec. apply le_0_l.
+Qed.
+
+Lemma shiftl_spec_high' : forall a n m, n<=m -> (a << n).[m] = a.[m-n].
+Proof.
+ intros. apply shiftl_spec_high; trivial. apply le_0_l.
+Qed.
+
+Lemma shiftr_div_pow2 : forall a n, a >> n == a / 2^n.
+Proof.
+ intros. bitwise. rewrite shiftr_spec'.
+ symmetry. apply div_pow2_bits.
+Qed.
+
+Lemma shiftl_mul_pow2 : forall a n, a << n == a * 2^n.
+Proof.
+ intros. bitwise.
+ destruct (le_gt_cases n m) as [H|H].
+ now rewrite shiftl_spec_high', mul_pow2_bits_high.
+ now rewrite shiftl_spec_low, mul_pow2_bits_low.
+Qed.
+
+Lemma shiftl_spec_alt : forall a n m, (a << n).[m+n] = a.[m].
+Proof.
+ intros. now rewrite shiftl_mul_pow2, mul_pow2_bits_add.
+Qed.
+
+Instance shiftr_wd : Proper (eq==>eq==>eq) shiftr.
+Proof.
+ intros a a' Ha b b' Hb. now rewrite 2 shiftr_div_pow2, Ha, Hb.
+Qed.
+
+Instance shiftl_wd : Proper (eq==>eq==>eq) shiftl.
+Proof.
+ intros a a' Ha b b' Hb. now rewrite 2 shiftl_mul_pow2, Ha, Hb.
+Qed.
+
+Lemma shiftl_shiftl : forall a n m,
+ (a << n) << m == a << (n+m).
+Proof.
+ intros. now rewrite !shiftl_mul_pow2, pow_add_r, mul_assoc.
+Qed.
+
+Lemma shiftr_shiftr : forall a n m,
+ (a >> n) >> m == a >> (n+m).
+Proof.
+ intros.
+ now rewrite !shiftr_div_pow2, pow_add_r, div_div by order_nz.
+Qed.
+
+Lemma shiftr_shiftl_l : forall a n m, m<=n ->
+ (a << n) >> m == a << (n-m).
+Proof.
+ intros.
+ rewrite shiftr_div_pow2, !shiftl_mul_pow2.
+ rewrite <- (sub_add m n) at 1 by trivial.
+ now rewrite pow_add_r, mul_assoc, div_mul by order_nz.
+Qed.
+
+Lemma shiftr_shiftl_r : forall a n m, n<=m ->
+ (a << n) >> m == a >> (m-n).
+Proof.
+ intros.
+ rewrite !shiftr_div_pow2, shiftl_mul_pow2.
+ rewrite <- (sub_add n m) at 1 by trivial.
+ rewrite pow_add_r, (mul_comm (2^(m-n))).
+ now rewrite <- div_div, div_mul by order_nz.
+Qed.
+
+(** shifts and constants *)
+
+Lemma shiftl_1_l : forall n, 1 << n == 2^n.
+Proof.
+ intros. now rewrite shiftl_mul_pow2, mul_1_l.
+Qed.
+
+Lemma shiftl_0_r : forall a, a << 0 == a.
+Proof.
+ intros. rewrite shiftl_mul_pow2. now nzsimpl.
+Qed.
+
+Lemma shiftr_0_r : forall a, a >> 0 == a.
+Proof.
+ intros. rewrite shiftr_div_pow2. now nzsimpl.
+Qed.
+
+Lemma shiftl_0_l : forall n, 0 << n == 0.
+Proof.
+ intros. rewrite shiftl_mul_pow2. now nzsimpl.
+Qed.
+
+Lemma shiftr_0_l : forall n, 0 >> n == 0.
+Proof.
+ intros. rewrite shiftr_div_pow2. nzsimpl; order_nz.
+Qed.
+
+Lemma shiftl_eq_0_iff : forall a n, a << n == 0 <-> a == 0.
+Proof.
+ intros a n. rewrite shiftl_mul_pow2. rewrite eq_mul_0. split.
+ intros [H | H]; trivial. contradict H; order_nz.
+ intros H. now left.
+Qed.
+
+Lemma shiftr_eq_0_iff : forall a n,
+ a >> n == 0 <-> a==0 \/ (0<a /\ log2 a < n).
+Proof.
+ intros a n.
+ rewrite shiftr_div_pow2, div_small_iff by order_nz.
+ destruct (eq_0_gt_0_cases a) as [EQ|LT].
+ rewrite EQ. split. now left. intros _.
+  assert (H : 2~=0) by order'.
+  generalize (pow_nonzero 2 n H) (le_0_l (2^n)); order.
+ rewrite log2_lt_pow2; trivial.
+ split. right; split; trivial. intros [H|[_ H]]; now order.
+Qed.
+
+Lemma shiftr_eq_0 : forall a n, log2 a < n -> a >> n == 0.
+Proof.
+ intros a n H. rewrite shiftr_eq_0_iff.
+ destruct (eq_0_gt_0_cases a) as [EQ|LT]. now left. right; now split.
+Qed.
+
+(** Properties of [div2]. *)
+
+Lemma div2_div : forall a, div2 a == a/2.
+Proof.
+ intros. rewrite div2_spec, shiftr_div_pow2. now nzsimpl.
+Qed.
+
+Instance div2_wd : Proper (eq==>eq) div2.
+Proof.
+ intros a a' Ha. now rewrite 2 div2_div, Ha.
+Qed.
+
+Lemma div2_odd : forall a, a == 2*(div2 a) + odd a.
+Proof.
+ intros a. rewrite div2_div, <- bit0_odd, bit0_mod.
+ apply div_mod. order'.
+Qed.
+
+(** Properties of [lxor] and others, directly deduced
+    from properties of [xorb] and others. *)
+
+Instance lxor_wd : Proper (eq ==> eq ==> eq) lxor.
+Proof.
+ intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb.
+Qed.
+
+Instance land_wd : Proper (eq ==> eq ==> eq) land.
+Proof.
+ intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb.
+Qed.
+
+Instance lor_wd : Proper (eq ==> eq ==> eq) lor.
+Proof.
+ intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb.
+Qed.
+
+Instance ldiff_wd : Proper (eq ==> eq ==> eq) ldiff.
+Proof.
+ intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb.
+Qed.
+
+Lemma lxor_eq : forall a a', lxor a a' == 0 -> a == a'.
+Proof.
+ intros a a' H. bitwise. apply xorb_eq.
+ now rewrite <- lxor_spec, H, bits_0.
+Qed.
+
+Lemma lxor_nilpotent : forall a, lxor a a == 0.
+Proof.
+ intros. bitwise. apply xorb_nilpotent.
+Qed.
+
+Lemma lxor_eq_0_iff : forall a a', lxor a a' == 0 <-> a == a'.
+Proof.
+ split. apply lxor_eq. intros EQ; rewrite EQ; apply lxor_nilpotent.
+Qed.
+
+Lemma lxor_0_l : forall a, lxor 0 a == a.
+Proof.
+ intros. bitwise. apply xorb_false_l.
+Qed.
+
+Lemma lxor_0_r : forall a, lxor a 0 == a.
+Proof.
+ intros. bitwise. apply xorb_false_r.
+Qed.
+
+Lemma lxor_comm : forall a b, lxor a b == lxor b a.
+Proof.
+ intros. bitwise. apply xorb_comm.
+Qed.
+
+Lemma lxor_assoc :
+ forall a b c, lxor (lxor a b) c == lxor a (lxor b c).
+Proof.
+ intros. bitwise. apply xorb_assoc.
+Qed.
+
+Lemma lor_0_l : forall a, lor 0 a == a.
+Proof.
+ intros. bitwise. trivial.
+Qed.
+
+Lemma lor_0_r : forall a, lor a 0 == a.
+Proof.
+ intros. bitwise. apply orb_false_r.
+Qed.
+
+Lemma lor_comm : forall a b, lor a b == lor b a.
+Proof.
+ intros. bitwise. apply orb_comm.
+Qed.
+
+Lemma lor_assoc :
+ forall a b c, lor a (lor b c) == lor (lor a b) c.
+Proof.
+ intros. bitwise. apply orb_assoc.
+Qed.
+
+Lemma lor_diag : forall a, lor a a == a.
+Proof.
+ intros. bitwise. apply orb_diag.
+Qed.
+
+Lemma lor_eq_0_l : forall a b, lor a b == 0 -> a == 0.
+Proof.
+ intros a b H. bitwise.
+ apply (orb_false_iff a.[m] b.[m]).
+ now rewrite <- lor_spec, H, bits_0.
+Qed.
+
+Lemma lor_eq_0_iff : forall a b, lor a b == 0 <-> a == 0 /\ b == 0.
+Proof.
+ intros a b. split.
+ split. now apply lor_eq_0_l in H.
+ rewrite lor_comm in H. now apply lor_eq_0_l in H.
+ intros (EQ,EQ'). now rewrite EQ, lor_0_l.
+Qed.
+
+Lemma land_0_l : forall a, land 0 a == 0.
+Proof.
+ intros. bitwise. trivial.
+Qed.
+
+Lemma land_0_r : forall a, land a 0 == 0.
+Proof.
+ intros. bitwise. apply andb_false_r.
+Qed.
+
+Lemma land_comm : forall a b, land a b == land b a.
+Proof.
+ intros. bitwise. apply andb_comm.
+Qed.
+
+Lemma land_assoc :
+ forall a b c, land a (land b c) == land (land a b) c.
+Proof.
+ intros. bitwise. apply andb_assoc.
+Qed.
+
+Lemma land_diag : forall a, land a a == a.
+Proof.
+ intros. bitwise. apply andb_diag.
+Qed.
+
+Lemma ldiff_0_l : forall a, ldiff 0 a == 0.
+Proof.
+ intros. bitwise. trivial.
+Qed.
+
+Lemma ldiff_0_r : forall a, ldiff a 0 == a.
+Proof.
+ intros. bitwise. now rewrite andb_true_r.
+Qed.
+
+Lemma ldiff_diag : forall a, ldiff a a == 0.
+Proof.
+ intros. bitwise. apply andb_negb_r.
+Qed.
+
+Lemma lor_land_distr_l : forall a b c,
+ lor (land a b) c == land (lor a c) (lor b c).
+Proof.
+ intros. bitwise. apply orb_andb_distrib_l.
+Qed.
+
+Lemma lor_land_distr_r : forall a b c,
+ lor a (land b c) == land (lor a b) (lor a c).
+Proof.
+ intros. bitwise. apply orb_andb_distrib_r.
+Qed.
+
+Lemma land_lor_distr_l : forall a b c,
+ land (lor a b) c == lor (land a c) (land b c).
+Proof.
+ intros. bitwise. apply andb_orb_distrib_l.
+Qed.
+
+Lemma land_lor_distr_r : forall a b c,
+ land a (lor b c) == lor (land a b) (land a c).
+Proof.
+ intros. bitwise. apply andb_orb_distrib_r.
+Qed.
+
+Lemma ldiff_ldiff_l : forall a b c,
+ ldiff (ldiff a b) c == ldiff a (lor b c).
+Proof.
+ intros. bitwise. now rewrite negb_orb, andb_assoc.
+Qed.
+
+Lemma lor_ldiff_and : forall a b,
+ lor (ldiff a b) (land a b) == a.
+Proof.
+ intros. bitwise.
+ now rewrite <- andb_orb_distrib_r, orb_comm, orb_negb_r, andb_true_r.
+Qed.
+
+Lemma land_ldiff : forall a b,
+ land (ldiff a b) b == 0.
+Proof.
+ intros. bitwise.
+ now rewrite <-andb_assoc, (andb_comm (negb _)), andb_negb_r, andb_false_r.
+Qed.
+
+(** Properties of [setbit] and [clearbit] *)
+
+Definition setbit a n := lor a (1<<n).
+Definition clearbit a n := ldiff a (1<<n).
+
+Lemma setbit_spec' : forall a n, setbit a n == lor a (2^n).
+Proof.
+ intros. unfold setbit. now rewrite shiftl_1_l.
+Qed.
+
+Lemma clearbit_spec' : forall a n, clearbit a n == ldiff a (2^n).
+Proof.
+ intros. unfold clearbit. now rewrite shiftl_1_l.
+Qed.
+
+Instance setbit_wd : Proper (eq==>eq==>eq) setbit.
+Proof. unfold setbit. solve_proper. Qed.
+
+Instance clearbit_wd : Proper (eq==>eq==>eq) clearbit.
+Proof. unfold clearbit. solve_proper. Qed.
+
+Lemma pow2_bits_true : forall n, (2^n).[n] = true.
+Proof.
+ intros. rewrite <- (mul_1_l (2^n)). rewrite <- (add_0_l n) at 2.
+ now rewrite mul_pow2_bits_add, bit0_odd, odd_1.
+Qed.
+
+Lemma pow2_bits_false : forall n m, n~=m -> (2^n).[m] = false.
+Proof.
+ intros.
+ rewrite <- (mul_1_l (2^n)).
+ destruct (le_gt_cases n m).
+ rewrite mul_pow2_bits_high; trivial.
+ rewrite <- (succ_pred (m-n)) by (apply sub_gt; order).
+ now rewrite <- div2_bits, div_small, bits_0 by order'.
+ rewrite mul_pow2_bits_low; trivial.
+Qed.
+
+Lemma pow2_bits_eqb : forall n m, (2^n).[m] = eqb n m.
+Proof.
+ intros. apply eq_true_iff_eq. rewrite eqb_eq. split.
+ destruct (eq_decidable n m) as [H|H]. trivial.
+ now rewrite (pow2_bits_false _ _ H).
+ intros EQ. rewrite EQ. apply pow2_bits_true.
+Qed.
+
+Lemma setbit_eqb : forall a n m,
+ (setbit a n).[m] = eqb n m || a.[m].
+Proof.
+ intros. now rewrite setbit_spec', lor_spec, pow2_bits_eqb, orb_comm.
+Qed.
+
+Lemma setbit_iff : forall a n m,
+ (setbit a n).[m] = true <-> n==m \/ a.[m] = true.
+Proof.
+ intros. now rewrite setbit_eqb, orb_true_iff, eqb_eq.
+Qed.
+
+Lemma setbit_eq : forall a n, (setbit a n).[n] = true.
+Proof.
+ intros. apply setbit_iff. now left.
+Qed.
+
+Lemma setbit_neq : forall a n m, n~=m ->
+ (setbit a n).[m] = a.[m].
+Proof.
+ intros a n m H. rewrite setbit_eqb.
+ rewrite <- eqb_eq in H. apply not_true_is_false in H. now rewrite H.
+Qed.
+
+Lemma clearbit_eqb : forall a n m,
+ (clearbit a n).[m] = a.[m] && negb (eqb n m).
+Proof.
+ intros. now rewrite clearbit_spec', ldiff_spec, pow2_bits_eqb.
+Qed.
+
+Lemma clearbit_iff : forall a n m,
+ (clearbit a n).[m] = true <-> a.[m] = true /\ n~=m.
+Proof.
+ intros. rewrite clearbit_eqb, andb_true_iff, <- eqb_eq.
+ now rewrite negb_true_iff, not_true_iff_false.
+Qed.
+
+Lemma clearbit_eq : forall a n, (clearbit a n).[n] = false.
+Proof.
+ intros. rewrite clearbit_eqb, (proj2 (eqb_eq _ _) (eq_refl n)).
+ apply andb_false_r.
+Qed.
+
+Lemma clearbit_neq : forall a n m, n~=m ->
+ (clearbit a n).[m] = a.[m].
+Proof.
+ intros a n m H. rewrite clearbit_eqb.
+ rewrite <- eqb_eq in H. apply not_true_is_false in H. rewrite H.
+ apply andb_true_r.
+Qed.
+
+(** Shifts of bitwise operations *)
+
+Lemma shiftl_lxor : forall a b n,
+ (lxor a b) << n == lxor (a << n) (b << n).
+Proof.
+ intros. bitwise.
+ destruct (le_gt_cases n m).
+ now rewrite !shiftl_spec_high', lxor_spec.
+ now rewrite !shiftl_spec_low.
+Qed.
+
+Lemma shiftr_lxor : forall a b n,
+ (lxor a b) >> n == lxor (a >> n) (b >> n).
+Proof.
+ intros. bitwise. now rewrite !shiftr_spec', lxor_spec.
+Qed.
+
+Lemma shiftl_land : forall a b n,
+ (land a b) << n == land (a << n) (b << n).
+Proof.
+ intros. bitwise.
+ destruct (le_gt_cases n m).
+ now rewrite !shiftl_spec_high', land_spec.
+ now rewrite !shiftl_spec_low.
+Qed.
+
+Lemma shiftr_land : forall a b n,
+ (land a b) >> n == land (a >> n) (b >> n).
+Proof.
+ intros. bitwise. now rewrite !shiftr_spec', land_spec.
+Qed.
+
+Lemma shiftl_lor : forall a b n,
+ (lor a b) << n == lor (a << n) (b << n).
+Proof.
+ intros. bitwise.
+ destruct (le_gt_cases n m).
+ now rewrite !shiftl_spec_high', lor_spec.
+ now rewrite !shiftl_spec_low.
+Qed.
+
+Lemma shiftr_lor : forall a b n,
+ (lor a b) >> n == lor (a >> n) (b >> n).
+Proof.
+ intros. bitwise. now rewrite !shiftr_spec', lor_spec.
+Qed.
+
+Lemma shiftl_ldiff : forall a b n,
+ (ldiff a b) << n == ldiff (a << n) (b << n).
+Proof.
+ intros. bitwise.
+ destruct (le_gt_cases n m).
+ now rewrite !shiftl_spec_high', ldiff_spec.
+ now rewrite !shiftl_spec_low.
+Qed.
+
+Lemma shiftr_ldiff : forall a b n,
+ (ldiff a b) >> n == ldiff (a >> n) (b >> n).
+Proof.
+ intros. bitwise. now rewrite !shiftr_spec', ldiff_spec.
+Qed.
+
+(** We cannot have a function complementing all bits of a number,
+    otherwise it would have an infinity of bit 1. Nonetheless,
+    we can design a bounded complement *)
+
+Definition ones n := P (1 << n).
+
+Definition lnot a n := lxor a (ones n).
+
+Instance ones_wd : Proper (eq==>eq) ones.
+Proof. unfold ones. solve_proper. Qed.
+
+Instance lnot_wd : Proper (eq==>eq==>eq) lnot.
+Proof. unfold lnot. solve_proper. Qed.
+
+Lemma ones_equiv : forall n, ones n == P (2^n).
+Proof.
+ intros; unfold ones; now rewrite shiftl_1_l.
+Qed.
+
+Lemma ones_add : forall n m, ones (m+n) == 2^m * ones n + ones m.
+Proof.
+ intros n m. rewrite !ones_equiv.
+ rewrite <- !sub_1_r, mul_sub_distr_l, mul_1_r, <- pow_add_r.
+ rewrite add_sub_assoc, sub_add. reflexivity.
+ apply pow_le_mono_r. order'.
+ rewrite <- (add_0_r m) at 1. apply add_le_mono_l, le_0_l.
+ rewrite <- (pow_0_r 2). apply pow_le_mono_r. order'. apply le_0_l.
+Qed.
+
+Lemma ones_div_pow2 : forall n m, m<=n -> ones n / 2^m == ones (n-m).
+Proof.
+ intros n m H. symmetry. apply div_unique with (ones m).
+ rewrite ones_equiv.
+ apply le_succ_l. rewrite succ_pred; order_nz.
+ rewrite <- (sub_add m n H) at 1. rewrite (add_comm _ m).
+ apply ones_add.
+Qed.
+
+Lemma ones_mod_pow2 : forall n m, m<=n -> (ones n) mod (2^m) == ones m.
+Proof.
+ intros n m H. symmetry. apply mod_unique with (ones (n-m)).
+ rewrite ones_equiv.
+ apply le_succ_l. rewrite succ_pred; order_nz.
+ rewrite <- (sub_add m n H) at 1. rewrite (add_comm _ m).
+ apply ones_add.
+Qed.
+
+Lemma ones_spec_low : forall n m, m<n -> (ones n).[m] = true.
+Proof.
+ intros. apply testbit_true. rewrite ones_div_pow2 by order.
+ rewrite <- (pow_1_r 2). rewrite ones_mod_pow2.
+ rewrite ones_equiv. now nzsimpl'.
+ apply le_add_le_sub_r. nzsimpl. now apply le_succ_l.
+Qed.
+
+Lemma ones_spec_high : forall n m, n<=m -> (ones n).[m] = false.
+Proof.
+ intros.
+ destruct (eq_0_gt_0_cases n) as [EQ|LT]; rewrite ones_equiv.
+ now rewrite EQ, pow_0_r, one_succ, pred_succ, bits_0.
+ apply bits_above_log2.
+ rewrite log2_pred_pow2; trivial. rewrite <-le_succ_l, succ_pred; order.
+Qed.
+
+Lemma ones_spec_iff : forall n m, (ones n).[m] = true <-> m<n.
+Proof.
+ intros. split. intros H.
+ apply lt_nge. intro H'. apply ones_spec_high in H'.
+ rewrite H in H'; discriminate.
+ apply ones_spec_low.
+Qed.
+
+Lemma lnot_spec_low : forall a n m, m<n ->
+ (lnot a n).[m] = negb a.[m].
+Proof.
+ intros. unfold lnot. now rewrite lxor_spec, ones_spec_low.
+Qed.
+
+Lemma lnot_spec_high : forall a n m, n<=m ->
+ (lnot a n).[m] = a.[m].
+Proof.
+ intros. unfold lnot. now rewrite lxor_spec, ones_spec_high, xorb_false_r.
+Qed.
+
+Lemma lnot_involutive : forall a n, lnot (lnot a n) n == a.
+Proof.
+ intros a n. bitwise.
+ destruct (le_gt_cases n m).
+ now rewrite 2 lnot_spec_high.
+ now rewrite 2 lnot_spec_low, negb_involutive.
+Qed.
+
+Lemma lnot_0_l : forall n, lnot 0 n == ones n.
+Proof.
+ intros. unfold lnot. apply lxor_0_l.
+Qed.
+
+Lemma lnot_ones : forall n, lnot (ones n) n == 0.
+Proof.
+ intros. unfold lnot. apply lxor_nilpotent.
+Qed.
+
+(** Bounded complement and other operations *)
+
+Lemma lor_ones_low : forall a n, log2 a < n ->
+ lor a (ones n) == ones n.
+Proof.
+ intros a n H. bitwise. destruct (le_gt_cases n m).
+ rewrite ones_spec_high, bits_above_log2; trivial.
+ now apply lt_le_trans with n.
+ now rewrite ones_spec_low, orb_true_r.
+Qed.
+
+Lemma land_ones : forall a n, land a (ones n) == a mod 2^n.
+Proof.
+ intros a n. bitwise. destruct (le_gt_cases n m).
+ now rewrite ones_spec_high, mod_pow2_bits_high, andb_false_r.
+ now rewrite ones_spec_low, mod_pow2_bits_low, andb_true_r.
+Qed.
+
+Lemma land_ones_low : forall a n, log2 a < n ->
+ land a (ones n) == a.
+Proof.
+ intros; rewrite land_ones. apply mod_small.
+ apply log2_lt_cancel. rewrite log2_pow2; trivial using le_0_l.
+Qed.
+
+Lemma ldiff_ones_r : forall a n,
+ ldiff a (ones n) == (a >> n) << n.
+Proof.
+ intros a n. bitwise. destruct (le_gt_cases n m).
+ rewrite ones_spec_high, shiftl_spec_high', shiftr_spec'; trivial.
+ rewrite sub_add; trivial. apply andb_true_r.
+ now rewrite ones_spec_low, shiftl_spec_low, andb_false_r.
+Qed.
+
+Lemma ldiff_ones_r_low : forall a n, log2 a < n ->
+ ldiff a (ones n) == 0.
+Proof.
+ intros a n H. bitwise. destruct (le_gt_cases n m).
+ rewrite ones_spec_high, bits_above_log2; trivial.
+ now apply lt_le_trans with n.
+ now rewrite ones_spec_low, andb_false_r.
+Qed.
+
+Lemma ldiff_ones_l_low : forall a n, log2 a < n ->
+ ldiff (ones n) a == lnot a n.
+Proof.
+ intros a n H. bitwise. destruct (le_gt_cases n m).
+ rewrite ones_spec_high, lnot_spec_high, bits_above_log2; trivial.
+ now apply lt_le_trans with n.
+ now rewrite ones_spec_low, lnot_spec_low.
+Qed.
+
+Lemma lor_lnot_diag : forall a n,
+ lor a (lnot a n) == lor a (ones n).
+Proof.
+ intros a n. bitwise.
+ destruct (le_gt_cases n m).
+ rewrite lnot_spec_high, ones_spec_high; trivial. now destruct a.[m].
+ rewrite lnot_spec_low, ones_spec_low; trivial. now destruct a.[m].
+Qed.
+
+Lemma lor_lnot_diag_low : forall a n, log2 a < n ->
+ lor a (lnot a n) == ones n.
+Proof.
+ intros a n H. now rewrite lor_lnot_diag, lor_ones_low.
+Qed.
+
+Lemma land_lnot_diag : forall a n,
+ land a (lnot a n) == ldiff a (ones n).
+Proof.
+ intros a n. bitwise.
+ destruct (le_gt_cases n m).
+ rewrite lnot_spec_high, ones_spec_high; trivial. now destruct a.[m].
+ rewrite lnot_spec_low, ones_spec_low; trivial. now destruct a.[m].
+Qed.
+
+Lemma land_lnot_diag_low : forall a n, log2 a < n ->
+ land a (lnot a n) == 0.
+Proof.
+ intros. now rewrite land_lnot_diag, ldiff_ones_r_low.
+Qed.
+
+Lemma lnot_lor_low : forall a b n, log2 a < n -> log2 b < n ->
+ lnot (lor a b) n == land (lnot a n) (lnot b n).
+Proof.
+ intros a b n Ha Hb. bitwise. destruct (le_gt_cases n m).
+ rewrite !lnot_spec_high, lor_spec, !bits_above_log2; trivial.
+ now apply lt_le_trans with n.
+ now apply lt_le_trans with n.
+ now rewrite !lnot_spec_low, lor_spec, negb_orb.
+Qed.
+
+Lemma lnot_land_low : forall a b n, log2 a < n -> log2 b < n ->
+ lnot (land a b) n == lor (lnot a n) (lnot b n).
+Proof.
+ intros a b n Ha Hb. bitwise. destruct (le_gt_cases n m).
+ rewrite !lnot_spec_high, land_spec, !bits_above_log2; trivial.
+ now apply lt_le_trans with n.
+ now apply lt_le_trans with n.
+ now rewrite !lnot_spec_low, land_spec, negb_andb.
+Qed.
+
+Lemma ldiff_land_low : forall a b n, log2 a < n ->
+ ldiff a b == land a (lnot b n).
+Proof.
+ intros a b n Ha. bitwise. destruct (le_gt_cases n m).
+ rewrite (bits_above_log2 a m). trivial.
+ now apply lt_le_trans with n.
+ rewrite !lnot_spec_low; trivial.
+Qed.
+
+Lemma lnot_ldiff_low : forall a b n, log2 a < n -> log2 b < n ->
+ lnot (ldiff a b) n == lor (lnot a n) b.
+Proof.
+ intros a b n Ha Hb. bitwise. destruct (le_gt_cases n m).
+ rewrite !lnot_spec_high, ldiff_spec, !bits_above_log2; trivial.
+ now apply lt_le_trans with n.
+ now apply lt_le_trans with n.
+ now rewrite !lnot_spec_low, ldiff_spec, negb_andb, negb_involutive.
+Qed.
+
+Lemma lxor_lnot_lnot : forall a b n,
+ lxor (lnot a n) (lnot b n) == lxor a b.
+Proof.
+ intros a b n. bitwise. destruct (le_gt_cases n m).
+ rewrite !lnot_spec_high; trivial.
+ rewrite !lnot_spec_low, xorb_negb_negb; trivial.
+Qed.
+
+Lemma lnot_lxor_l : forall a b n,
+ lnot (lxor a b) n == lxor (lnot a n) b.
+Proof.
+ intros a b n. bitwise. destruct (le_gt_cases n m).
+ rewrite !lnot_spec_high, lxor_spec; trivial.
+ rewrite !lnot_spec_low, lxor_spec, negb_xorb_l; trivial.
+Qed.
+
+Lemma lnot_lxor_r : forall a b n,
+ lnot (lxor a b) n == lxor a (lnot b n).
+Proof.
+ intros a b n. bitwise. destruct (le_gt_cases n m).
+ rewrite !lnot_spec_high, lxor_spec; trivial.
+ rewrite !lnot_spec_low, lxor_spec, negb_xorb_r; trivial.
+Qed.
+
+Lemma lxor_lor : forall a b, land a b == 0 ->
+ lxor a b == lor a b.
+Proof.
+ intros a b H. bitwise.
+ assert (a.[m] && b.[m] = false)
+   by now rewrite <- land_spec, H, bits_0.
+ now destruct a.[m], b.[m].
+Qed.
+
+(** Bitwise operations and log2 *)
+
+Lemma log2_bits_unique : forall a n,
+ a.[n] = true ->
+ (forall m, n<m -> a.[m] = false) ->
+ log2 a == n.
+Proof.
+ intros a n H H'.
+ destruct (eq_0_gt_0_cases a) as [Ha|Ha].
+ now rewrite Ha, bits_0 in H.
+ apply le_antisymm; apply le_ngt; intros LT.
+ specialize (H' _ LT). now rewrite bit_log2 in H' by order.
+ now rewrite bits_above_log2 in H by order.
+Qed.
+
+Lemma log2_shiftr : forall a n, log2 (a >> n) == log2 a - n.
+Proof.
+ intros a n.
+ destruct (eq_0_gt_0_cases a) as [Ha|Ha].
+ now rewrite Ha, shiftr_0_l, log2_nonpos, sub_0_l by order.
+ destruct (lt_ge_cases (log2 a) n).
+ rewrite shiftr_eq_0, log2_nonpos by order.
+ symmetry. rewrite sub_0_le; order.
+ apply log2_bits_unique.
+ now rewrite shiftr_spec', sub_add, bit_log2 by order.
+ intros m Hm.
+ rewrite shiftr_spec'; trivial. apply bits_above_log2; try order.
+ now apply lt_sub_lt_add_r.
+Qed.
+
+Lemma log2_shiftl : forall a n, a~=0 -> log2 (a << n) == log2 a + n.
+Proof.
+ intros a n Ha.
+ rewrite shiftl_mul_pow2, add_comm by trivial.
+ apply log2_mul_pow2. generalize (le_0_l a); order. apply le_0_l.
+Qed.
+
+Lemma log2_lor : forall a b,
+ log2 (lor a b) == max (log2 a) (log2 b).
+Proof.
+ assert (AUX : forall a b, a<=b -> log2 (lor a b) == log2 b).
+  intros a b H.
+  destruct (eq_0_gt_0_cases a) as [Ha|Ha]. now rewrite Ha, lor_0_l.
+  apply log2_bits_unique.
+  now rewrite lor_spec, bit_log2, orb_true_r by order.
+  intros m Hm. assert (H' := log2_le_mono _ _ H).
+  now rewrite lor_spec, 2 bits_above_log2 by order.
+ (* main *)
+ intros a b. destruct (le_ge_cases a b) as [H|H].
+ rewrite max_r by now apply log2_le_mono.
+ now apply AUX.
+ rewrite max_l by now apply log2_le_mono.
+ rewrite lor_comm. now apply AUX.
+Qed.
+
+Lemma log2_land : forall a b,
+ log2 (land a b) <= min (log2 a) (log2 b).
+Proof.
+ assert (AUX : forall a b, a<=b -> log2 (land a b) <= log2 a).
+  intros a b H.
+  apply le_ngt. intros H'.
+  destruct (eq_decidable (land a b) 0) as [EQ|NEQ].
+  rewrite EQ in H'. apply log2_lt_cancel in H'. generalize (le_0_l a); order.
+  generalize (bit_log2 (land a b) NEQ).
+  now rewrite land_spec, bits_above_log2.
+ (* main *)
+ intros a b.
+ destruct (le_ge_cases a b) as [H|H].
+ rewrite min_l by now apply log2_le_mono. now apply AUX.
+ rewrite min_r by now apply log2_le_mono. rewrite land_comm. now apply AUX.
+Qed.
+
+Lemma log2_lxor : forall a b,
+ log2 (lxor a b) <= max (log2 a) (log2 b).
+Proof.
+ assert (AUX : forall a b, a<=b -> log2 (lxor a b) <= log2 b).
+  intros a b H.
+  apply le_ngt. intros H'.
+  destruct (eq_decidable (lxor a b) 0) as [EQ|NEQ].
+  rewrite EQ in H'. apply log2_lt_cancel in H'. generalize (le_0_l a); order.
+  generalize (bit_log2 (lxor a b) NEQ).
+  rewrite lxor_spec, 2 bits_above_log2; try order. discriminate.
+  apply le_lt_trans with (log2 b); trivial. now apply log2_le_mono.
+ (* main *)
+ intros a b.
+ destruct (le_ge_cases a b) as [H|H].
+ rewrite max_r by now apply log2_le_mono. now apply AUX.
+ rewrite max_l by now apply log2_le_mono. rewrite lxor_comm. now apply AUX.
+Qed.
+
+(** Bitwise operations and arithmetical operations *)
+
+Local Notation xor3 a b c := (xorb (xorb a b) c).
+Local Notation lxor3 a b c := (lxor (lxor a b) c).
+
+Local Notation nextcarry a b c := ((a&&b) || (c && (a||b))).
+Local Notation lnextcarry a b c := (lor (land a b) (land c (lor a b))).
+
+Lemma add_bit0 : forall a b, (a+b).[0] = xorb a.[0] b.[0].
+Proof.
+ intros. now rewrite !bit0_odd, odd_add.
+Qed.
+
+Lemma add3_bit0 : forall a b c,
+ (a+b+c).[0] = xor3 a.[0] b.[0] c.[0].
+Proof.
+ intros. now rewrite !add_bit0.
+Qed.
+
+Lemma add3_bits_div2 : forall (a0 b0 c0 : bool),
+ (a0 + b0 + c0)/2 == nextcarry a0 b0 c0.
+Proof.
+ assert (H : 1+1 == 2) by now nzsimpl'.
+ intros [|] [|] [|]; simpl; rewrite ?add_0_l, ?add_0_r, ?H;
+  (apply div_same; order') || (apply div_small; order') || idtac.
+ symmetry. apply div_unique with 1. order'. now nzsimpl'.
+Qed.
+
+Lemma add_carry_div2 : forall a b (c0:bool),
+ (a + b + c0)/2 == a/2 + b/2 + nextcarry a.[0] b.[0] c0.
+Proof.
+ intros.
+ rewrite <- add3_bits_div2.
+ rewrite (add_comm ((a/2)+_)).
+ rewrite <- div_add by order'.
+ f_equiv.
+ rewrite <- !div2_div, mul_comm, mul_add_distr_l.
+ rewrite (div2_odd a), <- bit0_odd at 1. fold (b2n a.[0]).
+ rewrite (div2_odd b), <- bit0_odd at 1. fold (b2n b.[0]).
+ rewrite add_shuffle1.
+ rewrite <-(add_assoc _ _ c0). apply add_comm.
+Qed.
+
+(** The main result concerning addition: we express the bits of the sum
+  in term of bits of [a] and [b] and of some carry stream which is also
+  recursively determined by another equation.
+*)
+
+Lemma add_carry_bits : forall a b (c0:bool), exists c,
+ a+b+c0 == lxor3 a b c /\ c/2 == lnextcarry a b c /\ c.[0] = c0.
+Proof.
+ intros a b c0.
+ (* induction over some n such that [a<2^n] and [b<2^n] *)
+ set (n:=max a b).
+ assert (Ha : a<2^n).
+  apply lt_le_trans with (2^a). apply pow_gt_lin_r, lt_1_2.
+  apply pow_le_mono_r. order'. unfold n.
+  destruct (le_ge_cases a b); [rewrite max_r|rewrite max_l]; order'.
+ assert (Hb : b<2^n).
+  apply lt_le_trans with (2^b). apply pow_gt_lin_r, lt_1_2.
+  apply pow_le_mono_r. order'. unfold n.
+  destruct (le_ge_cases a b); [rewrite max_r|rewrite max_l]; order'.
+ clearbody n.
+ revert a b c0 Ha Hb. induct n.
+ (*base*)
+ intros a b c0. rewrite !pow_0_r, !one_succ, !lt_succ_r. intros Ha Hb.
+ exists c0.
+ setoid_replace a with 0 by (generalize (le_0_l a); order').
+ setoid_replace b with 0 by (generalize (le_0_l b); order').
+ rewrite !add_0_l, !lxor_0_l, !lor_0_r, !land_0_r, !lor_0_r.
+ rewrite b2n_div2, b2n_bit0; now repeat split.
+ (*step*)
+ intros n IH a b c0 Ha Hb.
+ set (c1:=nextcarry a.[0] b.[0] c0).
+ destruct (IH (a/2) (b/2) c1) as (c & IH1 & IH2 & Hc); clear IH.
+ apply div_lt_upper_bound; trivial. order'. now rewrite <- pow_succ_r'.
+ apply div_lt_upper_bound; trivial. order'. now rewrite <- pow_succ_r'.
+ exists (c0 + 2*c). repeat split.
+ (* - add *)
+ bitwise.
+ destruct (zero_or_succ m) as [EQ|[m' EQ]]; rewrite EQ; clear EQ.
+ now rewrite add_b2n_double_bit0, add3_bit0, b2n_bit0.
+ rewrite <- !div2_bits, <- 2 lxor_spec.
+ f_equiv.
+ rewrite add_b2n_double_div2, <- IH1. apply add_carry_div2.
+ (* - carry *)
+ rewrite add_b2n_double_div2.
+ bitwise.
+ destruct (zero_or_succ m) as [EQ|[m' EQ]]; rewrite EQ; clear EQ.
+ now rewrite add_b2n_double_bit0.
+ rewrite <- !div2_bits, IH2. autorewrite with bitwise.
+ now rewrite add_b2n_double_div2.
+ (* - carry0 *)
+ apply add_b2n_double_bit0.
+Qed.
+
+(** Particular case : the second bit of an addition *)
+
+Lemma add_bit1 : forall a b,
+ (a+b).[1] = xor3 a.[1] b.[1] (a.[0] && b.[0]).
+Proof.
+ intros a b.
+ destruct (add_carry_bits a b false) as (c & EQ1 & EQ2 & Hc).
+ simpl in EQ1; rewrite add_0_r in EQ1. rewrite EQ1.
+ autorewrite with bitwise. f_equal.
+ rewrite one_succ, <- div2_bits, EQ2.
+ autorewrite with bitwise.
+ rewrite Hc. simpl. apply orb_false_r.
+Qed.
+
+(** In an addition, there will be no carries iff there is
+  no common bits in the numbers to add *)
+
+Lemma nocarry_equiv : forall a b c,
+ c/2 == lnextcarry a b c -> c.[0] = false ->
+ (c == 0 <-> land a b == 0).
+Proof.
+ intros a b c H H'.
+ split. intros EQ; rewrite EQ in *.
+ rewrite div_0_l in H by order'.
+ symmetry in H. now apply lor_eq_0_l in H.
+ intros EQ. rewrite EQ, lor_0_l in H.
+ apply bits_inj_0.
+ induct n. trivial.
+ intros n IH.
+ rewrite <- div2_bits, H.
+ autorewrite with bitwise.
+ now rewrite IH.
+Qed.
+
+(** When there is no common bits, the addition is just a xor *)
+
+Lemma add_nocarry_lxor : forall a b, land a b == 0 ->
+ a+b == lxor a b.
+Proof.
+ intros a b H.
+ destruct (add_carry_bits a b false) as (c & EQ1 & EQ2 & Hc).
+ simpl in EQ1; rewrite add_0_r in EQ1. rewrite EQ1.
+ apply (nocarry_equiv a b c) in H; trivial.
+ rewrite H. now rewrite lxor_0_r.
+Qed.
+
+(** A null [ldiff] implies being smaller *)
+
+Lemma ldiff_le : forall a b, ldiff a b == 0 -> a <= b.
+Proof.
+ cut (forall n a b, a < 2^n -> ldiff a b == 0 -> a <= b).
+ intros H a b. apply (H a), pow_gt_lin_r; order'.
+ induct n.
+ intros a b Ha _. rewrite pow_0_r, one_succ, lt_succ_r in Ha.
+ assert (Ha' : a == 0) by (generalize (le_0_l a); order').
+ rewrite Ha'. apply le_0_l.
+ intros n IH a b Ha H.
+ assert (NEQ : 2 ~= 0) by order'.
+ rewrite (div_mod a 2 NEQ), (div_mod b 2 NEQ).
+ apply add_le_mono.
+ apply mul_le_mono_l.
+ apply IH.
+ apply div_lt_upper_bound; trivial. now rewrite <- pow_succ_r'.
+ rewrite <- (pow_1_r 2), <- 2 shiftr_div_pow2.
+ now rewrite <- shiftr_ldiff, H, shiftr_div_pow2, pow_1_r, div_0_l.
+ rewrite <- 2 bit0_mod.
+ apply bits_inj_iff in H. specialize (H 0).
+ rewrite ldiff_spec, bits_0 in H.
+ destruct a.[0], b.[0]; try discriminate; simpl; order'.
+Qed.
+
+(** Subtraction can be a ldiff when the opposite ldiff is null. *)
+
+Lemma sub_nocarry_ldiff : forall a b, ldiff b a == 0 ->
+ a-b == ldiff a b.
+Proof.
+ intros a b H.
+ apply add_cancel_r with b.
+ rewrite sub_add.
+ symmetry.
+ rewrite add_nocarry_lxor.
+ bitwise.
+ apply bits_inj_iff in H. specialize (H m).
+ rewrite ldiff_spec, bits_0 in H.
+ now destruct a.[m], b.[m].
+ apply land_ldiff.
+ now apply ldiff_le.
+Qed.
+
+(** We can express lnot in term of subtraction *)
+
+Lemma add_lnot_diag_low : forall a n, log2 a < n ->
+ a + lnot a n == ones n.
+Proof.
+ intros a n H.
+ assert (H' := land_lnot_diag_low a n H).
+ rewrite add_nocarry_lxor, lxor_lor by trivial.
+ now apply lor_lnot_diag_low.
+Qed.
+
+Lemma lnot_sub_low : forall a n, log2 a < n ->
+ lnot a n == ones n - a.
+Proof.
+ intros a n H.
+ now rewrite <- (add_lnot_diag_low a n H), add_comm, add_sub.
+Qed.
+
+(** Adding numbers with no common bits cannot lead to a much bigger number *)
+
+Lemma add_nocarry_lt_pow2 : forall a b n, land a b == 0 ->
+ a < 2^n -> b < 2^n -> a+b < 2^n.
+Proof.
+ intros a b n H Ha Hb.
+ rewrite add_nocarry_lxor by trivial.
+ apply div_small_iff. order_nz.
+ rewrite <- shiftr_div_pow2, shiftr_lxor, !shiftr_div_pow2.
+ rewrite 2 div_small by trivial.
+ apply lxor_0_l.
+Qed.
+
+Lemma add_nocarry_mod_lt_pow2 : forall a b n, land a b == 0 ->
+ a mod 2^n + b mod 2^n < 2^n.
+Proof.
+ intros a b n H.
+ apply add_nocarry_lt_pow2.
+ bitwise.
+ destruct (le_gt_cases n m).
+ now rewrite mod_pow2_bits_high.
+ now rewrite !mod_pow2_bits_low, <- land_spec, H, bits_0.
+ apply mod_upper_bound; order_nz.
+ apply mod_upper_bound; order_nz.
+Qed.
+
+End NBitsProp.
diff --git a/theories/Numbers/Natural/Abstract/NDefOps.v b/theories/Numbers/Natural/Abstract/NDefOps.v
index 7b38c148..621a2ed9 100644
--- a/theories/Numbers/Natural/Abstract/NDefOps.v
+++ b/theories/Numbers/Natural/Abstract/NDefOps.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,14 +8,41 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NDefOps.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Bool. (* To get the orb and negb function *)
 Require Import RelationPairs.
 Require Export NStrongRec.
 
-Module NdefOpsPropFunct (Import N : NAxiomsSig').
-Include NStrongRecPropFunct N.
+(** In this module, we derive generic implementations of usual operators
+   just via the use of a [recursion] function. *)
+
+Module NdefOpsProp (Import N : NAxiomsRecSig').
+Include NStrongRecProp N.
+
+(** Nullity Test *)
+
+Definition if_zero (A : Type) (a b : A) (n : N.t) : A :=
+  recursion a (fun _ _ => b) n.
+
+Arguments if_zero [A] a b n.
+
+Instance if_zero_wd (A : Type) :
+ Proper (Logic.eq ==> Logic.eq ==> N.eq ==> Logic.eq) (@if_zero A).
+Proof.
+unfold if_zero. (* TODO : solve_proper : SLOW + BUG *)
+f_equiv'.
+Qed.
+
+Theorem if_zero_0 : forall (A : Type) (a b : A), if_zero a b 0 = a.
+Proof.
+unfold if_zero; intros; now rewrite recursion_0.
+Qed.
+
+Theorem if_zero_succ :
+ forall (A : Type) (a b : A) (n : N.t), if_zero a b (S n) = b.
+Proof.
+intros; unfold if_zero.
+now rewrite recursion_succ.
+Qed.
 
 (*****************************************************)
 (**                   Addition                       *)
@@ -24,17 +51,9 @@ Definition def_add (x y : N.t) := recursion y (fun _ => S) x.
 
 Local Infix "+++" := def_add (at level 50, left associativity).
 
-Instance def_add_prewd : Proper (N.eq==>N.eq==>N.eq) (fun _ => S).
-Proof.
-intros _ _ _ p p' Epp'; now rewrite Epp'.
-Qed.
-
 Instance def_add_wd : Proper (N.eq ==> N.eq ==> N.eq) def_add.
 Proof.
-intros x x' Exx' y y' Eyy'. unfold def_add.
-(* TODO: why rewrite Exx' don't work here (or verrrry slowly) ? *)
-apply recursion_wd with (Aeq := N.eq); auto with *.
-apply def_add_prewd.
+unfold def_add. f_equiv'.
 Qed.
 
 Theorem def_add_0_l : forall y, 0 +++ y == y.
@@ -45,7 +64,7 @@ Qed.
 Theorem def_add_succ_l : forall x y, S x +++ y == S (x +++ y).
 Proof.
 intros x y; unfold def_add.
-rewrite recursion_succ; auto with *.
+rewrite recursion_succ; f_equiv'.
 Qed.
 
 Theorem def_add_add : forall n m, n +++ m == n + m.
@@ -62,18 +81,10 @@ Definition def_mul (x y : N.t) := recursion 0 (fun _ p => p +++ x) y.
 
 Local Infix "**" := def_mul (at level 40, left associativity).
 
-Instance def_mul_prewd :
- Proper (N.eq==>N.eq==>N.eq==>N.eq) (fun x _ p => p +++ x).
-Proof.
-repeat red; intros; now apply def_add_wd.
-Qed.
-
 Instance def_mul_wd : Proper (N.eq ==> N.eq ==> N.eq) def_mul.
 Proof.
-unfold def_mul.
-intros x x' Exx' y y' Eyy'.
-apply recursion_wd; auto with *.
-now apply def_mul_prewd.
+unfold def_mul. (* TODO : solve_proper SLOW + BUG *)
+f_equiv'.
 Qed.
 
 Theorem def_mul_0_r : forall x, x ** 0 == 0.
@@ -85,7 +96,7 @@ Theorem def_mul_succ_r : forall x y, x ** S y == x ** y +++ x.
 Proof.
 intros x y; unfold def_mul.
 rewrite recursion_succ; auto with *.
-now apply def_mul_prewd.
+f_equiv'.
 Qed.
 
 Theorem def_mul_mul : forall n m, n ** m == n * m.
@@ -106,25 +117,9 @@ recursion
 
 Local Infix "<<" := ltb (at level 70, no associativity).
 
-Instance ltb_prewd1 : Proper (N.eq==>Logic.eq) (if_zero false true).
-Proof.
-red; intros; apply if_zero_wd; auto.
-Qed.
-
-Instance ltb_prewd2 : Proper (N.eq==>(N.eq==>Logic.eq)==>N.eq==>Logic.eq)
- (fun _ f n => recursion false (fun n' _ => f n') n).
-Proof.
-repeat red; intros; simpl.
-apply recursion_wd; auto with *.
-repeat red; auto.
-Qed.
-
 Instance ltb_wd : Proper (N.eq ==> N.eq ==> Logic.eq) ltb.
 Proof.
-unfold ltb.
-intros n n' Hn m m' Hm.
-apply f_equiv; auto with *.
-apply recursion_wd; auto; [ apply ltb_prewd1 | apply ltb_prewd2 ].
+unfold ltb. f_equiv'.
 Qed.
 
 Theorem ltb_base : forall n, 0 << n = if_zero false true n.
@@ -136,11 +131,9 @@ Theorem ltb_step :
   forall m n, S m << n = recursion false (fun n' _ => m << n') n.
 Proof.
 intros m n; unfold ltb at 1.
-apply f_equiv; auto with *.
-rewrite recursion_succ by (apply ltb_prewd1||apply ltb_prewd2).
-fold (ltb m).
-repeat red; intros. apply recursion_wd; auto.
-repeat red; intros; now apply ltb_wd.
+f_equiv.
+rewrite recursion_succ; f_equiv'.
+reflexivity.
 Qed.
 
 (* Above, we rewrite applications of function. Is it possible to rewrite
@@ -162,8 +155,7 @@ Qed.
 Theorem succ_ltb_mono : forall n m, (S n << S m) = (n << m).
 Proof.
 intros n m.
-rewrite ltb_step. rewrite recursion_succ; try reflexivity.
-repeat red; intros; now apply ltb_wd.
+rewrite ltb_step. rewrite recursion_succ; f_equiv'.
 Qed.
 
 Theorem ltb_lt : forall n m, n << m = true <-> n < m.
@@ -188,9 +180,7 @@ Definition even (x : N.t) := recursion true (fun _ p => negb p) x.
 
 Instance even_wd : Proper (N.eq==>Logic.eq) even.
 Proof.
-intros n n' Hn. unfold even.
-apply recursion_wd; auto.
-congruence.
+unfold even. f_equiv'.
 Qed.
 
 Theorem even_0 : even 0 = true.
@@ -202,19 +192,12 @@ Qed.
 Theorem even_succ : forall x, even (S x) = negb (even x).
 Proof.
 unfold even.
-intro x; rewrite recursion_succ; try reflexivity.
-congruence.
+intro x; rewrite recursion_succ; f_equiv'.
 Qed.
 
 (*****************************************************)
 (**                Division by 2                     *)
 
-Local Notation "a <= b <= c" := (a<=b /\ b<=c).
-Local Notation "a <= b < c" := (a<=b /\ b<c).
-Local Notation "a < b <= c" := (a<b /\ b<=c).
-Local Notation "a < b < c" := (a<b /\ b<c).
-Local Notation "2" := (S 1).
-
 Definition half_aux (x : N.t) : N.t * N.t :=
   recursion (0, 0) (fun _ p => let (x1, x2) := p in (S x2, x1)) x.
 
@@ -223,14 +206,14 @@ Definition half (x : N.t) := snd (half_aux x).
 Instance half_aux_wd : Proper (N.eq ==> N.eq*N.eq) half_aux.
 Proof.
 intros x x' Hx. unfold half_aux.
-apply recursion_wd; auto with *.
+f_equiv; trivial.
 intros y y' Hy (u,v) (u',v') (Hu,Hv). compute in *.
 rewrite Hu, Hv; auto with *.
 Qed.
 
 Instance half_wd : Proper (N.eq==>N.eq) half.
 Proof.
-intros x x' Hx. unfold half. rewrite Hx; auto with *.
+unfold half. f_equiv'.
 Qed.
 
 Lemma half_aux_0 : half_aux 0 = (0,0).
@@ -245,8 +228,7 @@ intros.
 remember (half_aux x) as h.
 destruct h as (f,s); simpl in *.
 unfold half_aux in *.
-rewrite recursion_succ, <- Heqh; simpl; auto.
-repeat red; intros; subst; auto.
+rewrite recursion_succ, <- Heqh; simpl; f_equiv'.
 Qed.
 
 Theorem half_aux_spec : forall n,
@@ -258,7 +240,7 @@ rewrite half_aux_0; simpl; rewrite add_0_l; auto with *.
 intros.
 rewrite half_aux_succ. simpl.
 rewrite add_succ_l, add_comm; auto.
-apply succ_wd; auto.
+now f_equiv.
 Qed.
 
 Theorem half_aux_spec2 : forall n,
@@ -271,7 +253,7 @@ rewrite half_aux_0; simpl. auto with *.
 intros.
 rewrite half_aux_succ; simpl.
 destruct H; auto with *.
-right; apply succ_wd; auto with *.
+right; now f_equiv.
 Qed.
 
 Theorem half_0 : half 0 == 0.
@@ -281,14 +263,14 @@ Qed.
 
 Theorem half_1 : half 1 == 0.
 Proof.
-unfold half. rewrite half_aux_succ, half_aux_0; simpl; auto with *.
+unfold half. rewrite one_succ, half_aux_succ, half_aux_0; simpl; auto with *.
 Qed.
 
 Theorem half_double : forall n,
  n == 2 * half n \/ n == 1 + 2 * half n.
 Proof.
 intros. unfold half.
-nzsimpl.
+nzsimpl'.
 destruct (half_aux_spec2 n) as [H|H]; [left|right].
 rewrite <- H at 1. apply half_aux_spec.
 rewrite <- add_succ_l. rewrite <- H at 1. apply half_aux_spec.
@@ -319,24 +301,23 @@ assert (LE : 0 <= half n) by apply le_0_l.
 le_elim LE; auto.
 destruct (half_double n) as [E|E];
  rewrite <- LE, mul_0_r, ?add_0_r in E; rewrite E in LT.
-destruct (nlt_0_r _ LT).
-rewrite <- succ_lt_mono in LT.
-destruct (nlt_0_r _ LT).
+order'.
+order.
 Qed.
 
 Theorem half_decrease : forall n, 0 < n -> half n < n.
 Proof.
 intros n LT.
-destruct (half_double n) as [E|E]; rewrite E at 2;
- rewrite ?mul_succ_l, ?mul_0_l, ?add_0_l, ?add_assoc.
+destruct (half_double n) as [E|E]; rewrite E at 2; nzsimpl'.
 rewrite <- add_0_l at 1.
 rewrite <- add_lt_mono_r.
 assert (LE : 0 <= half n) by apply le_0_l.
 le_elim LE; auto.
 rewrite <- LE, mul_0_r in E. rewrite E in LT. destruct (nlt_0_r _ LT).
+rewrite <- add_succ_l.
 rewrite <- add_0_l at 1.
 rewrite <- add_lt_mono_r.
-rewrite add_succ_l. apply lt_0_succ.
+apply lt_0_succ.
 Qed.
 
 
@@ -347,17 +328,9 @@ Definition pow (n m : N.t) := recursion 1 (fun _ r => n*r) m.
 
 Local Infix "^^" := pow (at level 30, right associativity).
 
-Instance pow_prewd :
- Proper (N.eq==>N.eq==>N.eq==>N.eq) (fun n _ r => n*r).
-Proof.
-intros n n' Hn x x' Hx y y' Hy. rewrite Hn, Hy; auto with *.
-Qed.
-
 Instance pow_wd : Proper (N.eq==>N.eq==>N.eq) pow.
 Proof.
-intros n n' Hn m m' Hm. unfold pow.
-apply recursion_wd; auto with *.
-now apply pow_prewd.
+unfold pow. f_equiv'.
 Qed.
 
 Lemma pow_0 : forall n, n^^0 == 1.
@@ -367,8 +340,7 @@ Qed.
 
 Lemma pow_succ : forall n m, n^^(S m) == n*(n^^m).
 Proof.
-intros. unfold pow. rewrite recursion_succ; auto with *.
-now apply pow_prewd.
+intros. unfold pow. rewrite recursion_succ; f_equiv'.
 Qed.
 
 
@@ -389,15 +361,13 @@ Proof.
 intros g g' Hg n n' Hn.
 rewrite Hn.
 destruct (n' << 2); auto with *.
-apply succ_wd.
-apply Hg. rewrite Hn; auto with *.
+f_equiv. apply Hg. now f_equiv.
 Qed.
 
 Instance log_wd : Proper (N.eq==>N.eq) log.
 Proof.
 intros x x' Exx'. unfold log.
-apply strong_rec_wd; auto with *.
-apply log_prewd.
+apply strong_rec_wd; f_equiv'.
 Qed.
 
 Lemma log_good_step : forall n h1 h2,
@@ -406,11 +376,11 @@ Lemma log_good_step : forall n h1 h2,
   (if n << 2 then 0 else S (h2 (half n))).
 Proof.
 intros n h1 h2 E.
-destruct (n<<2) as [ ]_eqn:H.
+destruct (n<<2) eqn:H.
 auto with *.
-apply succ_wd, E, half_decrease.
-rewrite <- not_true_iff_false, ltb_lt, nlt_ge, le_succ_l in H.
-apply lt_succ_l; auto.
+f_equiv. apply E, half_decrease.
+rewrite two_succ, <- not_true_iff_false, ltb_lt, nlt_ge, le_succ_l in H.
+order'.
 Qed.
 Hint Resolve log_good_step.
 
@@ -441,14 +411,14 @@ intros n IH k Hk1 Hk2.
 destruct (lt_ge_cases k 2) as [LT|LE].
 (* base *)
 rewrite log_init, pow_0 by auto.
-rewrite <- le_succ_l in Hk2.
+rewrite <- le_succ_l, <- one_succ in Hk2.
 le_elim Hk2.
-rewrite <- nle_gt, le_succ_l in LT. destruct LT; auto.
+rewrite two_succ, <- nle_gt, le_succ_l in LT. destruct LT; auto.
 rewrite <- Hk2.
 rewrite half_1; auto using lt_0_1, le_refl.
 (* step *)
 rewrite log_step, pow_succ by auto.
-rewrite le_succ_l in LE.
+rewrite two_succ, le_succ_l in LE.
 destruct (IH (half k)) as (IH1,IH2).
  rewrite <- lt_succ_r. apply lt_le_trans with k; auto.
   now apply half_decrease.
@@ -458,22 +428,13 @@ split.
 rewrite <- le_succ_l in IH1.
 apply mul_le_mono_l with (p:=2) in IH1.
 eapply lt_le_trans; eauto.
-nzsimpl.
+nzsimpl'.
 rewrite lt_succ_r.
 eapply le_trans; [ eapply half_lower_bound | ].
-nzsimpl; apply le_refl.
+nzsimpl'; apply le_refl.
 eapply le_trans; [ | eapply half_upper_bound ].
 apply mul_le_mono_l; auto.
 Qed.
 
-(** Later:
-
-Theorem log_mul : forall n m, 0 < n -> 0 < m ->
- log (n*m) == log n + log m.
-
-Theorem log_pow2 : forall n, log (2^^n) = n.
-
-*)
-
-End NdefOpsPropFunct.
+End NdefOpsProp.
 
diff --git a/theories/Numbers/Natural/Abstract/NDiv.v b/theories/Numbers/Natural/Abstract/NDiv.v
index 171530f0..d7fb447e 100644
--- a/theories/Numbers/Natural/Abstract/NDiv.v
+++ b/theories/Numbers/Natural/Abstract/NDiv.v
@@ -1,40 +1,36 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(** Euclidean Division *)
+Require Import NAxioms NSub NZDiv.
 
-Require Import NAxioms NProperties NZDiv.
+(** Properties of Euclidean Division *)
 
-Module Type NDivSpecific (Import N : NAxiomsSig')(Import DM : DivMod' N).
- Axiom mod_upper_bound : forall a b, b ~= 0 -> a mod b < b.
-End NDivSpecific.
+Module Type NDivProp (Import N : NAxiomsSig')(Import NP : NSubProp N).
 
-Module Type NDivSig := NAxiomsSig <+ DivMod <+ NZDivCommon <+ NDivSpecific.
-Module Type NDivSig' := NAxiomsSig' <+ DivMod' <+ NZDivCommon <+ NDivSpecific.
+(** We benefit from what already exists for NZ *)
+Module Import Private_NZDiv := Nop <+ NZDivProp N N NP.
 
-Module NDivPropFunct (Import N : NDivSig')(Import NP : NPropSig N).
+Ltac auto' := try rewrite <- neq_0_lt_0; auto using le_0_l.
 
-(** We benefit from what already exists for NZ *)
+(** Let's now state again theorems, but without useless hypothesis. *)
 
- Module ND <: NZDiv N.
-  Definition div := div.
-  Definition modulo := modulo.
-  Definition div_wd := div_wd.
-  Definition mod_wd := mod_wd.
-  Definition div_mod := div_mod.
-  Lemma mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b.
-  Proof. split. apply le_0_l. apply mod_upper_bound. order. Qed.
- End ND.
- Module Import NZDivP := NZDivPropFunct N NP ND.
+Lemma mod_upper_bound : forall a b, b ~= 0 -> a mod b < b.
+Proof. intros. apply mod_bound_pos; auto'. Qed.
 
- Ltac auto' := try rewrite <- neq_0_lt_0; auto using le_0_l.
+(** Another formulation of the main equation *)
 
-(** Let's now state again theorems, but without useless hypothesis. *)
+Lemma mod_eq :
+ forall a b, b~=0 -> a mod b == a - b*(a/b).
+Proof.
+intros.
+symmetry. apply add_sub_eq_l. symmetry.
+now apply div_mod.
+Qed.
 
 (** Uniqueness theorems *)
 
@@ -51,6 +47,9 @@ Theorem mod_unique:
  forall a b q r, r<b -> a == b*q + r -> r == a mod b.
 Proof. intros. apply mod_unique with q; auto'. Qed.
 
+Theorem div_unique_exact: forall a b q, b~=0 -> a == b*q -> q == a/b.
+Proof. intros. apply div_unique_exact; auto'. Qed.
+
 (** A division by itself returns 1 *)
 
 Lemma div_same : forall a, a~=0 -> a/a == 1.
@@ -223,6 +222,10 @@ Lemma div_div : forall a b c, b~=0 -> c~=0 ->
  (a/b)/c == a/(b*c).
 Proof. intros. apply div_div; auto'. Qed.
 
+Lemma mod_mul_r : forall a b c, b~=0 -> c~=0 ->
+ a mod (b*c) == a mod b + b*((a/b) mod c).
+Proof. intros. apply mod_mul_r; auto'. Qed.
+
 (** A last inequality: *)
 
 Theorem div_mul_le:
@@ -235,5 +238,4 @@ Lemma mod_divides : forall a b, b~=0 ->
  (a mod b == 0 <-> exists c, a == b*c).
 Proof. intros. apply mod_divides; auto'. Qed.
 
-End NDivPropFunct.
-
+End NDivProp.
diff --git a/theories/Numbers/Natural/Abstract/NGcd.v b/theories/Numbers/Natural/Abstract/NGcd.v
new file mode 100644
index 00000000..1c5829dd
--- /dev/null
+++ b/theories/Numbers/Natural/Abstract/NGcd.v
@@ -0,0 +1,213 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Properties of the greatest common divisor *)
+
+Require Import NAxioms NSub NZGcd.
+
+Module Type NGcdProp
+ (Import A : NAxiomsSig')
+ (Import B : NSubProp A).
+
+ Include NZGcdProp A A B.
+
+(** Results concerning divisibility*)
+
+Definition divide_1_r n : (n | 1) -> n == 1
+ := divide_1_r_nonneg n (le_0_l n).
+
+Definition divide_antisym n m : (n | m) -> (m | n) -> n == m
+ := divide_antisym_nonneg n m (le_0_l n) (le_0_l m).
+
+Lemma divide_add_cancel_r : forall n m p, (n | m) -> (n | m + p) -> (n | p).
+Proof.
+ intros n m p (q,Hq) (r,Hr).
+ exists (r-q). rewrite mul_sub_distr_r, <- Hq, <- Hr.
+ now rewrite add_comm, add_sub.
+Qed.
+
+Lemma divide_sub_r : forall n m p, (n | m) -> (n | p) -> (n | m - p).
+Proof.
+ intros n m p H H'.
+ destruct (le_ge_cases m p) as [LE|LE].
+ apply sub_0_le in LE. rewrite LE. apply divide_0_r.
+ apply divide_add_cancel_r with p; trivial.
+ now rewrite add_comm, sub_add.
+Qed.
+
+(** Properties of gcd *)
+
+Definition gcd_0_l n : gcd 0 n == n := gcd_0_l_nonneg n (le_0_l n).
+Definition gcd_0_r n : gcd n 0 == n := gcd_0_r_nonneg n (le_0_l n).
+Definition gcd_diag n : gcd n n == n := gcd_diag_nonneg n (le_0_l n).
+Definition gcd_unique' n m p := gcd_unique n m p (le_0_l p).
+Definition gcd_unique_alt' n m p := gcd_unique_alt n m p (le_0_l p).
+Definition divide_gcd_iff' n m := divide_gcd_iff n m (le_0_l n).
+
+Lemma gcd_add_mult_diag_r : forall n m p, gcd n (m+p*n) == gcd n m.
+Proof.
+ intros. apply gcd_unique_alt'.
+ intros. rewrite gcd_divide_iff. split; intros (U,V); split; trivial.
+ apply divide_add_r; trivial. now apply divide_mul_r.
+ apply divide_add_cancel_r with (p*n); trivial.
+ now apply divide_mul_r. now rewrite add_comm.
+Qed.
+
+Lemma gcd_add_diag_r : forall n m, gcd n (m+n) == gcd n m.
+Proof.
+ intros n m. rewrite <- (mul_1_l n) at 2. apply gcd_add_mult_diag_r.
+Qed.
+
+Lemma gcd_sub_diag_r : forall n m, n<=m -> gcd n (m-n) == gcd n m.
+Proof.
+ intros n m H. symmetry.
+ rewrite <- (sub_add n m H) at 1. apply gcd_add_diag_r.
+Qed.
+
+(** On natural numbers, we should use a particular form
+  for the Bezout identity, since we don't have full subtraction. *)
+
+Definition Bezout n m p := exists a b, a*n == p + b*m.
+
+Instance Bezout_wd : Proper (eq==>eq==>eq==>iff) Bezout.
+Proof.
+ unfold Bezout. intros x x' Hx y y' Hy z z' Hz.
+ setoid_rewrite Hx. setoid_rewrite Hy. now setoid_rewrite Hz.
+Qed.
+
+Lemma bezout_1_gcd : forall n m, Bezout n m 1 -> gcd n m == 1.
+Proof.
+ intros n m (q & r & H).
+ apply gcd_unique; trivial using divide_1_l, le_0_1.
+ intros p Hn Hm.
+ apply divide_add_cancel_r with (r*m).
+ now apply divide_mul_r.
+ rewrite add_comm, <- H. now apply divide_mul_r.
+Qed.
+
+(** For strictly positive numbers, we have Bezout in the two directions. *)
+
+Lemma gcd_bezout_pos_pos : forall n, 0<n -> forall m, 0<m ->
+ Bezout n m (gcd n m) /\ Bezout m n (gcd n m).
+Proof.
+ intros n Hn. rewrite <- le_succ_l, <- one_succ in Hn.
+ pattern n. apply strong_right_induction with (z:=1); trivial.
+ unfold Bezout. solve_proper.
+ clear n Hn. intros n Hn IHn.
+ intros m Hm. rewrite <- le_succ_l, <- one_succ in Hm.
+ pattern m. apply strong_right_induction with (z:=1); trivial.
+ unfold Bezout. solve_proper.
+ clear m Hm. intros m Hm IHm.
+ destruct (lt_trichotomy n m) as [LT|[EQ|LT]].
+ (* n < m *)
+ destruct (IHm (m-n)) as ((a & b & EQ), (a' & b' & EQ')).
+ rewrite one_succ, le_succ_l.
+ apply lt_add_lt_sub_l; now nzsimpl.
+ apply sub_lt; order'.
+ split.
+ exists (a+b). exists b.
+ rewrite mul_add_distr_r, EQ, mul_sub_distr_l, <- add_assoc.
+ rewrite gcd_sub_diag_r by order.
+ rewrite sub_add. reflexivity. apply mul_le_mono_l; order.
+ exists a'. exists (a'+b').
+ rewrite gcd_sub_diag_r in EQ' by order.
+ rewrite (add_comm a'), mul_add_distr_r, add_assoc, <- EQ'.
+ rewrite mul_sub_distr_l, sub_add. reflexivity. apply mul_le_mono_l; order.
+ (* n = m *)
+ rewrite EQ. rewrite gcd_diag.
+ split.
+ exists 1. exists 0. now nzsimpl.
+ exists 1. exists 0. now nzsimpl.
+ (* m < n *)
+ rewrite gcd_comm, and_comm.
+ apply IHn; trivial.
+ now rewrite <- le_succ_l, <- one_succ.
+Qed.
+
+Lemma gcd_bezout_pos : forall n m, 0<n -> Bezout n m (gcd n m).
+Proof.
+ intros n m Hn.
+ destruct (eq_0_gt_0_cases m) as [EQ|LT].
+ rewrite EQ, gcd_0_r. exists 1. exists 0. now nzsimpl.
+ now apply gcd_bezout_pos_pos.
+Qed.
+
+(** For arbitrary natural numbers, we could only say that at least
+  one of the Bezout identities holds. *)
+
+Lemma gcd_bezout : forall n m,
+ Bezout n m (gcd n m) \/ Bezout m n (gcd n m).
+Proof.
+ intros n m.
+ destruct (eq_0_gt_0_cases n) as [EQ|LT].
+ right. rewrite EQ, gcd_0_l. exists 1. exists 0. now nzsimpl.
+ left. now apply gcd_bezout_pos.
+Qed.
+
+Lemma gcd_mul_mono_l :
+  forall n m p, gcd (p * n) (p * m) == p * gcd n m.
+Proof.
+ intros n m p.
+ apply gcd_unique'.
+ apply mul_divide_mono_l, gcd_divide_l.
+ apply mul_divide_mono_l, gcd_divide_r.
+ intros q H H'.
+ destruct (eq_0_gt_0_cases n) as [EQ|LT].
+ rewrite EQ in *. now rewrite gcd_0_l.
+ destruct (gcd_bezout_pos n m) as (a & b & EQ); trivial.
+ apply divide_add_cancel_r with (p*m*b).
+ now apply divide_mul_l.
+ rewrite <- mul_assoc, <- mul_add_distr_l, add_comm, (mul_comm m), <- EQ.
+ rewrite (mul_comm a), mul_assoc.
+ now apply divide_mul_l.
+Qed.
+
+Lemma gcd_mul_mono_r :
+ forall n m p, gcd (n*p) (m*p) == gcd n m * p.
+Proof.
+ intros. rewrite !(mul_comm _ p). apply gcd_mul_mono_l.
+Qed.
+
+Lemma gauss : forall n m p, (n | m * p) -> gcd n m == 1 -> (n | p).
+Proof.
+ intros n m p H G.
+ destruct (eq_0_gt_0_cases n) as [EQ|LT].
+ rewrite EQ in *. rewrite gcd_0_l in G. now rewrite <- (mul_1_l p), <- G.
+ destruct (gcd_bezout_pos n m) as (a & b & EQ); trivial.
+ rewrite G in EQ.
+ apply divide_add_cancel_r with (m*p*b).
+ now apply divide_mul_l.
+ rewrite (mul_comm _ b), mul_assoc. rewrite <- (mul_1_l p) at 2.
+ rewrite <- mul_add_distr_r, add_comm, <- EQ.
+ now apply divide_mul_l, divide_factor_r.
+Qed.
+
+Lemma divide_mul_split : forall n m p, n ~= 0 -> (n | m * p) ->
+ exists q r, n == q*r /\ (q | m) /\ (r | p).
+Proof.
+ intros n m p Hn H.
+ assert (G := gcd_nonneg n m). le_elim G.
+ destruct (gcd_divide_l n m) as (q,Hq).
+ exists (gcd n m). exists q.
+ split. now rewrite mul_comm.
+ split. apply gcd_divide_r.
+ destruct (gcd_divide_r n m) as (r,Hr).
+ rewrite Hr in H. rewrite Hq in H at 1.
+ rewrite mul_shuffle0 in H. apply mul_divide_cancel_r in H; [|order].
+ apply gauss with r; trivial.
+ apply mul_cancel_r with (gcd n m); [order|].
+ rewrite mul_1_l.
+ rewrite <- gcd_mul_mono_r, <- Hq, <- Hr; order.
+ symmetry in G. apply gcd_eq_0 in G. destruct G as (Hn',_); order.
+Qed.
+
+(** TODO : relation between gcd and division and modulo *)
+
+(** TODO : more about rel_prime (i.e. gcd == 1), about prime ... *)
+
+End NGcdProp.
diff --git a/theories/Numbers/Natural/Abstract/NIso.v b/theories/Numbers/Natural/Abstract/NIso.v
index d484a625..b17f0c3d 100644
--- a/theories/Numbers/Natural/Abstract/NIso.v
+++ b/theories/Numbers/Natural/Abstract/NIso.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,11 +8,9 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NIso.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import NBase.
 
-Module Homomorphism (N1 N2 : NAxiomsSig).
+Module Homomorphism (N1 N2 : NAxiomsRecSig).
 
 Local Notation "n == m" := (N2.eq n m) (at level 70, no associativity).
 
@@ -25,11 +23,8 @@ Definition natural_isomorphism : N1.t -> N2.t :=
 Instance natural_isomorphism_wd : Proper (N1.eq ==> N2.eq) natural_isomorphism.
 Proof.
 unfold natural_isomorphism.
-intros n m Eqxy.
-apply N1.recursion_wd.
-reflexivity.
-intros _ _ _ y' y'' H. now apply N2.succ_wd.
-assumption.
+repeat red; intros. f_equiv; trivial.
+repeat red; intros. now f_equiv.
 Qed.
 
 Theorem natural_isomorphism_0 : natural_isomorphism N1.zero == N2.zero.
@@ -42,7 +37,7 @@ Theorem natural_isomorphism_succ :
 Proof.
 unfold natural_isomorphism.
 intro n. rewrite N1.recursion_succ; auto with *.
-repeat red; intros. apply N2.succ_wd; auto.
+repeat red; intros. now f_equiv.
 Qed.
 
 Theorem hom_nat_iso : homomorphism natural_isomorphism.
@@ -53,9 +48,9 @@ Qed.
 
 End Homomorphism.
 
-Module Inverse (N1 N2 : NAxiomsSig).
+Module Inverse (N1 N2 : NAxiomsRecSig).
 
-Module Import NBasePropMod1 := NBasePropFunct N1.
+Module Import NBasePropMod1 := NBaseProp N1.
 (* This makes the tactic induct available. Since it is taken from
 (NBasePropFunct NAxiomsMod1), it refers to induction on N1. *)
 
@@ -76,7 +71,7 @@ Qed.
 
 End Inverse.
 
-Module Isomorphism (N1 N2 : NAxiomsSig).
+Module Isomorphism (N1 N2 : NAxiomsRecSig).
 
 Module Hom12 := Homomorphism N1 N2.
 Module Hom21 := Homomorphism N2 N1.
diff --git a/theories/Numbers/Natural/Abstract/NLcm.v b/theories/Numbers/Natural/Abstract/NLcm.v
new file mode 100644
index 00000000..9d8e3e6d
--- /dev/null
+++ b/theories/Numbers/Natural/Abstract/NLcm.v
@@ -0,0 +1,290 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import NAxioms NSub NDiv NGcd.
+
+(** * Least Common Multiple *)
+
+(** Unlike other functions around, we will define lcm below instead of
+  axiomatizing it. Indeed, there is no "prior art" about lcm in the
+  standard library to be compliant with, and the generic definition
+  of lcm via gcd is quite reasonable.
+
+  By the way, we also state here some combined properties of div/mod
+  and gcd.
+*)
+
+Module Type NLcmProp
+ (Import A : NAxiomsSig')
+ (Import B : NSubProp A)
+ (Import C : NDivProp A B)
+ (Import D : NGcdProp A B).
+
+(** Divibility and modulo *)
+
+Lemma mod_divide : forall a b, b~=0 -> (a mod b == 0 <-> (b|a)).
+Proof.
+ intros a b Hb. split.
+ intros Hab. exists (a/b). rewrite mul_comm.
+  rewrite (div_mod a b Hb) at 1. rewrite Hab; now nzsimpl.
+ intros (c,Hc). rewrite Hc. now apply mod_mul.
+Qed.
+
+Lemma divide_div_mul_exact : forall a b c, b~=0 -> (b|a) ->
+ (c*a)/b == c*(a/b).
+Proof.
+ intros a b c Hb H.
+ apply mul_cancel_l with b; trivial.
+ rewrite mul_assoc, mul_shuffle0.
+ assert (H':=H). apply mod_divide, div_exact in H'; trivial.
+ rewrite <- H', (mul_comm a c).
+ symmetry. apply div_exact; trivial.
+ apply mod_divide; trivial.
+ now apply divide_mul_r.
+Qed.
+
+(** Gcd of divided elements, for exact divisions *)
+
+Lemma gcd_div_factor : forall a b c, c~=0 -> (c|a) -> (c|b) ->
+ gcd (a/c) (b/c) == (gcd a b)/c.
+Proof.
+ intros a b c Hc Ha Hb.
+ apply mul_cancel_l with c; try order.
+ assert (H:=gcd_greatest _ _ _ Ha Hb).
+ apply mod_divide, div_exact in H; try order.
+ rewrite <- H.
+ rewrite <- gcd_mul_mono_l; try order.
+ f_equiv; symmetry; apply div_exact; try order;
+  apply mod_divide; trivial; try order.
+Qed.
+
+Lemma gcd_div_gcd : forall a b g, g~=0 -> g == gcd a b ->
+ gcd (a/g) (b/g) == 1.
+Proof.
+ intros a b g NZ EQ. rewrite gcd_div_factor.
+ now rewrite <- EQ, div_same.
+ generalize (gcd_nonneg a b); order.
+ rewrite EQ; apply gcd_divide_l.
+ rewrite EQ; apply gcd_divide_r.
+Qed.
+
+(** The following equality is crucial for Euclid algorithm *)
+
+Lemma gcd_mod : forall a b, b~=0 -> gcd (a mod b) b == gcd b a.
+Proof.
+ intros a b Hb. rewrite (gcd_comm _ b).
+ rewrite <- (gcd_add_mult_diag_r b (a mod b) (a/b)).
+ now rewrite add_comm, mul_comm, <- div_mod.
+Qed.
+
+(** We now define lcm thanks to gcd:
+
+    lcm a b = a * (b / gcd a b)
+            = (a / gcd a b) * b
+            = (a*b) / gcd a b
+
+   Nota: [lcm 0 0] should be 0, which isn't garantee with the third
+   equation above.
+*)
+
+Definition lcm a b := a*(b/gcd a b).
+
+Instance lcm_wd : Proper (eq==>eq==>eq) lcm.
+Proof. unfold lcm. solve_proper. Qed.
+
+Lemma lcm_equiv1 : forall a b, gcd a b ~= 0 ->
+  a * (b / gcd a b) == (a*b)/gcd a b.
+Proof.
+ intros a b H. rewrite divide_div_mul_exact; try easy. apply gcd_divide_r.
+Qed.
+
+Lemma lcm_equiv2 : forall a b, gcd a b ~= 0 ->
+  (a / gcd a b) * b == (a*b)/gcd a b.
+Proof.
+ intros a b H. rewrite 2 (mul_comm _ b).
+ rewrite divide_div_mul_exact; try easy. apply gcd_divide_l.
+Qed.
+
+Lemma gcd_div_swap : forall a b,
+ (a / gcd a b) * b == a * (b / gcd a b).
+Proof.
+ intros a b. destruct (eq_decidable (gcd a b) 0) as [EQ|NEQ].
+ apply gcd_eq_0 in EQ. destruct EQ as (EQ,EQ'). rewrite EQ, EQ'. now nzsimpl.
+ now rewrite lcm_equiv1, <-lcm_equiv2.
+Qed.
+
+Lemma divide_lcm_l : forall a b, (a | lcm a b).
+Proof.
+ unfold lcm. intros a b. apply divide_factor_l.
+Qed.
+
+Lemma divide_lcm_r : forall a b, (b | lcm a b).
+Proof.
+ unfold lcm. intros a b. rewrite <- gcd_div_swap.
+ apply divide_factor_r.
+Qed.
+
+Lemma divide_div : forall a b c, a~=0 -> (a|b) -> (b|c) -> (b/a|c/a).
+Proof.
+ intros a b c Ha Hb (c',Hc). exists c'.
+ now rewrite <- divide_div_mul_exact, Hc.
+Qed.
+
+Lemma lcm_least : forall a b c,
+ (a | c) -> (b | c) -> (lcm a b | c).
+Proof.
+ intros a b c Ha Hb. unfold lcm.
+ destruct (eq_decidable (gcd a b) 0) as [EQ|NEQ].
+ apply gcd_eq_0 in EQ. destruct EQ as (EQ,EQ'). rewrite EQ in *. now nzsimpl.
+ assert (Ga := gcd_divide_l a b).
+ assert (Gb := gcd_divide_r a b).
+ set (g:=gcd a b) in *.
+ assert (Ha' := divide_div g a c NEQ Ga Ha).
+ assert (Hb' := divide_div g b c NEQ Gb Hb).
+ destruct Ha' as (a',Ha'). rewrite Ha', mul_comm in Hb'.
+ apply gauss in Hb'; [|apply gcd_div_gcd; unfold g; trivial using gcd_comm].
+ destruct Hb' as (b',Hb').
+ exists b'.
+ rewrite mul_shuffle3, <- Hb'.
+ rewrite (proj2 (div_exact c g NEQ)).
+ rewrite Ha', mul_shuffle3, (mul_comm a a'). f_equiv.
+ symmetry. apply div_exact; trivial.
+ apply mod_divide; trivial.
+ apply mod_divide; trivial. transitivity a; trivial.
+Qed.
+
+Lemma lcm_comm : forall a b, lcm a b == lcm b a.
+Proof.
+ intros a b. unfold lcm. rewrite (gcd_comm b), (mul_comm b).
+ now rewrite <- gcd_div_swap.
+Qed.
+
+Lemma lcm_divide_iff : forall n m p,
+  (lcm n m | p) <-> (n | p) /\ (m | p).
+Proof.
+ intros. split. split.
+ transitivity (lcm n m); trivial using divide_lcm_l.
+ transitivity (lcm n m); trivial using divide_lcm_r.
+ intros (H,H'). now apply lcm_least.
+Qed.
+
+Lemma lcm_unique : forall n m p,
+ 0<=p -> (n|p) -> (m|p) ->
+ (forall q, (n|q) -> (m|q) -> (p|q)) ->
+ lcm n m == p.
+Proof.
+ intros n m p Hp Hn Hm H.
+ apply divide_antisym; trivial.
+ now apply lcm_least.
+ apply H. apply divide_lcm_l. apply divide_lcm_r.
+Qed.
+
+Lemma lcm_unique_alt : forall n m p, 0<=p ->
+ (forall q, (p|q) <-> (n|q) /\ (m|q)) ->
+ lcm n m == p.
+Proof.
+ intros n m p Hp H.
+ apply lcm_unique; trivial.
+ apply H, divide_refl.
+ apply H, divide_refl.
+ intros. apply H. now split.
+Qed.
+
+Lemma lcm_assoc : forall n m p, lcm n (lcm m p) == lcm (lcm n m) p.
+Proof.
+ intros. apply lcm_unique_alt. apply le_0_l.
+ intros. now rewrite !lcm_divide_iff, and_assoc.
+Qed.
+
+Lemma lcm_0_l : forall n, lcm 0 n == 0.
+Proof.
+ intros. apply lcm_unique; trivial. order.
+ apply divide_refl.
+ apply divide_0_r.
+Qed.
+
+Lemma lcm_0_r : forall n, lcm n 0 == 0.
+Proof.
+ intros. now rewrite lcm_comm, lcm_0_l.
+Qed.
+
+Lemma lcm_1_l : forall n, lcm 1 n == n.
+Proof.
+ intros. apply lcm_unique; trivial using divide_1_l, le_0_l, divide_refl.
+Qed.
+
+Lemma lcm_1_r : forall n, lcm n 1 == n.
+Proof.
+ intros. now rewrite lcm_comm, lcm_1_l.
+Qed.
+
+Lemma lcm_diag : forall n, lcm n n == n.
+Proof.
+ intros. apply lcm_unique; trivial using divide_refl, le_0_l.
+Qed.
+
+Lemma lcm_eq_0 : forall n m, lcm n m == 0 <-> n == 0 \/ m == 0.
+Proof.
+ intros. split.
+ intros EQ.
+ apply eq_mul_0.
+ apply divide_0_l. rewrite <- EQ. apply lcm_least.
+  apply divide_factor_l. apply divide_factor_r.
+ destruct 1 as [EQ|EQ]; rewrite EQ. apply lcm_0_l. apply lcm_0_r.
+Qed.
+
+Lemma divide_lcm_eq_r : forall n m, (n|m) -> lcm n m == m.
+Proof.
+ intros n m H. apply lcm_unique_alt; trivial using le_0_l.
+ intros q. split. split; trivial. now transitivity m.
+ now destruct 1.
+Qed.
+
+Lemma divide_lcm_iff : forall n m, (n|m) <-> lcm n m == m.
+Proof.
+ intros n m. split. now apply divide_lcm_eq_r.
+ intros EQ. rewrite <- EQ. apply divide_lcm_l.
+Qed.
+
+Lemma lcm_mul_mono_l :
+  forall n m p, lcm (p * n) (p * m) == p * lcm n m.
+Proof.
+ intros n m p.
+ destruct (eq_decidable p 0) as [Hp|Hp].
+  rewrite Hp. nzsimpl. rewrite lcm_0_l. now nzsimpl.
+ destruct (eq_decidable (gcd n m) 0) as [Hg|Hg].
+  apply gcd_eq_0 in Hg. destruct Hg as (Hn,Hm); rewrite Hn, Hm.
+  nzsimpl. rewrite lcm_0_l. now nzsimpl.
+ unfold lcm.
+ rewrite gcd_mul_mono_l.
+ rewrite mul_assoc. f_equiv.
+ now rewrite div_mul_cancel_l.
+Qed.
+
+Lemma lcm_mul_mono_r :
+ forall n m p, lcm (n * p) (m * p) == lcm n m * p.
+Proof.
+ intros n m p. now rewrite !(mul_comm _ p), lcm_mul_mono_l, mul_comm.
+Qed.
+
+Lemma gcd_1_lcm_mul : forall n m, n~=0 -> m~=0 ->
+ (gcd n m == 1 <-> lcm n m == n*m).
+Proof.
+ intros n m Hn Hm. split; intros H.
+ unfold lcm. rewrite H. now rewrite div_1_r.
+ unfold lcm in *.
+ apply mul_cancel_l in H; trivial.
+ assert (Hg : gcd n m ~= 0) by (red; rewrite gcd_eq_0; destruct 1; order).
+ assert (H' := gcd_divide_r n m).
+ apply mod_divide in H'; trivial. apply div_exact in H'; trivial.
+ rewrite H in H'.
+ rewrite <- (mul_1_l m) in H' at 1.
+ now apply mul_cancel_r in H'.
+Qed.
+
+End NLcmProp.
diff --git a/theories/Numbers/Natural/Abstract/NLog.v b/theories/Numbers/Natural/Abstract/NLog.v
new file mode 100644
index 00000000..f8dc1a2b
--- /dev/null
+++ b/theories/Numbers/Natural/Abstract/NLog.v
@@ -0,0 +1,23 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Base-2 Logarithm Properties *)
+
+Require Import NAxioms NSub NPow NParity NZLog.
+
+Module Type NLog2Prop
+ (A : NAxiomsSig)
+ (B : NSubProp A)
+ (C : NParityProp A B)
+ (D : NPowProp A B C).
+
+ (** For the moment we simply reuse NZ properties *)
+
+ Include NZLog2Prop A A A B D.Private_NZPow.
+ Include NZLog2UpProp A A A B D.Private_NZPow.
+End NLog2Prop.
diff --git a/theories/Numbers/Natural/Abstract/NMaxMin.v b/theories/Numbers/Natural/Abstract/NMaxMin.v
new file mode 100644
index 00000000..dde7aba5
--- /dev/null
+++ b/theories/Numbers/Natural/Abstract/NMaxMin.v
@@ -0,0 +1,135 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import NAxioms NSub GenericMinMax.
+
+(** * Properties of minimum and maximum specific to natural numbers *)
+
+Module Type NMaxMinProp (Import N : NAxiomsMiniSig').
+Include NSubProp N.
+
+(** Zero *)
+
+Lemma max_0_l : forall n, max 0 n == n.
+Proof.
+ intros. apply max_r. apply le_0_l.
+Qed.
+
+Lemma max_0_r : forall n, max n 0 == n.
+Proof.
+ intros. apply max_l. apply le_0_l.
+Qed.
+
+Lemma min_0_l : forall n, min 0 n == 0.
+Proof.
+ intros. apply min_l. apply le_0_l.
+Qed.
+
+Lemma min_0_r : forall n, min n 0 == 0.
+Proof.
+ intros. apply min_r. apply le_0_l.
+Qed.
+
+(** The following results are concrete instances of [max_monotone]
+    and similar lemmas. *)
+
+(** Succ *)
+
+Lemma succ_max_distr : forall n m, S (max n m) == max (S n) (S m).
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?succ_le_mono.
+Qed.
+
+Lemma succ_min_distr : forall n m, S (min n m) == min (S n) (S m).
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?succ_le_mono.
+Qed.
+
+(** Add *)
+
+Lemma add_max_distr_l : forall n m p, max (p + n) (p + m) == p + max n m.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?add_le_mono_l.
+Qed.
+
+Lemma add_max_distr_r : forall n m p, max (n + p) (m + p) == max n m + p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?add_le_mono_r.
+Qed.
+
+Lemma add_min_distr_l : forall n m p, min (p + n) (p + m) == p + min n m.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?add_le_mono_l.
+Qed.
+
+Lemma add_min_distr_r : forall n m p, min (n + p) (m + p) == min n m + p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?add_le_mono_r.
+Qed.
+
+(** Mul *)
+
+Lemma mul_max_distr_l : forall n m p, max (p * n) (p * m) == p * max n m.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply mul_le_mono_l.
+Qed.
+
+Lemma mul_max_distr_r : forall n m p, max (n * p) (m * p) == max n m * p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply mul_le_mono_r.
+Qed.
+
+Lemma mul_min_distr_l : forall n m p, min (p * n) (p * m) == p * min n m.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply mul_le_mono_l.
+Qed.
+
+Lemma mul_min_distr_r : forall n m p, min (n * p) (m * p) == min n m * p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply mul_le_mono_r.
+Qed.
+
+(** Sub *)
+
+Lemma sub_max_distr_l : forall n m p, max (p - n) (p - m) == p - min n m.
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite min_l by trivial. apply max_l. now apply sub_le_mono_l.
+ rewrite min_r by trivial. apply max_r. now apply sub_le_mono_l.
+Qed.
+
+Lemma sub_max_distr_r : forall n m p, max (n - p) (m - p) == max n m - p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply sub_le_mono_r.
+Qed.
+
+Lemma sub_min_distr_l : forall n m p, min (p - n) (p - m) == p - max n m.
+Proof.
+ intros. destruct (le_ge_cases n m).
+ rewrite max_r by trivial. apply min_r. now apply sub_le_mono_l.
+ rewrite max_l by trivial. apply min_l. now apply sub_le_mono_l.
+Qed.
+
+Lemma sub_min_distr_r : forall n m p, min (n - p) (m - p) == min n m - p.
+Proof.
+ intros. destruct (le_ge_cases n m);
+  [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply sub_le_mono_r.
+Qed.
+
+End NMaxMinProp.
diff --git a/theories/Numbers/Natural/Abstract/NMulOrder.v b/theories/Numbers/Natural/Abstract/NMulOrder.v
index bdd4b674..2f4c91e3 100644
--- a/theories/Numbers/Natural/Abstract/NMulOrder.v
+++ b/theories/Numbers/Natural/Abstract/NMulOrder.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,12 +8,10 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NMulOrder.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NAddOrder.
 
-Module NMulOrderPropFunct (Import N : NAxiomsSig').
-Include NAddOrderPropFunct N.
+Module NMulOrderProp (Import N : NAxiomsMiniSig').
+Include NAddOrderProp N.
 
 (** Theorems that are either not valid on Z or have different proofs
     on N and Z *)
@@ -55,7 +53,7 @@ Qed.
 Theorem lt_0_mul' : forall n m, n * m > 0 <-> n > 0 /\ m > 0.
 Proof.
 intros n m; split; [intro H | intros [H1 H2]].
-apply -> lt_0_mul in H. destruct H as [[H1 H2] | [H1 H2]]. now split.
+apply lt_0_mul in H. destruct H as [[H1 H2] | [H1 H2]]. now split.
  false_hyp H1 nlt_0_r.
 now apply mul_pos_pos.
 Qed.
@@ -67,14 +65,18 @@ Proof.
 intros n m.
 split; [| intros [H1 H2]; now rewrite H1, H2, mul_1_l].
 intro H; destruct (lt_trichotomy n 1) as [H1 | [H1 | H1]].
-apply -> lt_1_r in H1. rewrite H1, mul_0_l in H. false_hyp H neq_0_succ.
+apply lt_1_r in H1. rewrite H1, mul_0_l in H. order'.
 rewrite H1, mul_1_l in H; now split.
 destruct (eq_0_gt_0_cases m) as [H2 | H2].
-rewrite H2, mul_0_r in H; false_hyp H neq_0_succ.
-apply -> (mul_lt_mono_pos_r m) in H1; [| assumption]. rewrite mul_1_l in H1.
+rewrite H2, mul_0_r in H. order'.
+apply (mul_lt_mono_pos_r m) in H1; [| assumption]. rewrite mul_1_l in H1.
 assert (H3 : 1 < n * m) by now apply (lt_1_l m).
 rewrite H in H3; false_hyp H3 lt_irrefl.
 Qed.
 
-End NMulOrderPropFunct.
+(** Alternative name : *)
+
+Definition mul_eq_1 := eq_mul_1.
+
+End NMulOrderProp.
 
diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v
index 17dd3466..a5a12d37 100644
--- a/theories/Numbers/Natural/Abstract/NOrder.v
+++ b/theories/Numbers/Natural/Abstract/NOrder.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,18 +8,16 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NOrder.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NAdd.
 
-Module NOrderPropFunct (Import N : NAxiomsSig').
-Include NAddPropFunct N.
+Module NOrderProp (Import N : NAxiomsMiniSig').
+Include NAddProp N.
 
 (* Theorems that are true for natural numbers but not for integers *)
 
 Theorem lt_wf_0 : well_founded lt.
 Proof.
-setoid_replace lt with (fun n m => 0 <= n /\ n < m).
+setoid_replace lt with (fun n m => 0 <= n < m).
 apply lt_wf.
 intros x y; split.
 intro H; split; [apply le_0_l | assumption]. now intros [_ H].
@@ -29,12 +27,12 @@ Defined.
 
 Theorem nlt_0_r : forall n, ~ n < 0.
 Proof.
-intro n; apply -> le_ngt. apply le_0_l.
+intro n; apply le_ngt. apply le_0_l.
 Qed.
 
 Theorem nle_succ_0 : forall n, ~ (S n <= 0).
 Proof.
-intros n H; apply -> le_succ_l in H; false_hyp H nlt_0_r.
+intros n H; apply le_succ_l in H; false_hyp H nlt_0_r.
 Qed.
 
 Theorem le_0_r : forall n, n <= 0 <-> n == 0.
@@ -65,6 +63,7 @@ Qed.
 
 Theorem zero_one : forall n, n == 0 \/ n == 1 \/ 1 < n.
 Proof.
+setoid_rewrite one_succ.
 induct n. now left.
 cases n. intros; right; now left.
 intros n IH. destruct IH as [H | [H | H]].
@@ -75,6 +74,7 @@ Qed.
 
 Theorem lt_1_r : forall n, n < 1 <-> n == 0.
 Proof.
+setoid_rewrite one_succ.
 cases n.
 split; intro; [reflexivity | apply lt_succ_diag_r].
 intros n. rewrite <- succ_lt_mono.
@@ -83,6 +83,7 @@ Qed.
 
 Theorem le_1_r : forall n, n <= 1 <-> n == 0 \/ n == 1.
 Proof.
+setoid_rewrite one_succ.
 cases n.
 split; intro; [now left | apply le_succ_diag_r].
 intro n. rewrite <- succ_le_mono, le_0_r, succ_inj_wd.
@@ -117,9 +118,9 @@ Proof.
 intros Base Step; induct n.
 intros; apply Base.
 intros n IH m H. elim H using le_ind.
-solve_predicate_wd.
+solve_proper.
 apply Step; [| apply IH]; now apply eq_le_incl.
-intros k H1 H2. apply -> le_succ_l in H1. apply lt_le_incl in H1. auto.
+intros k H1 H2. apply le_succ_l in H1. apply lt_le_incl in H1. auto.
 Qed.
 
 Theorem lt_ind_rel :
@@ -131,7 +132,7 @@ intros Base Step; induct n.
 intros m H. apply lt_exists_pred in H; destruct H as [m' [H _]].
 rewrite H; apply Base.
 intros n IH m H. elim H using lt_ind.
-solve_predicate_wd.
+solve_proper.
 apply Step; [| apply IH]; now apply lt_succ_diag_r.
 intros k H1 H2. apply lt_succ_l in H1. auto.
 Qed.
@@ -175,7 +176,7 @@ Theorem lt_le_pred : forall n m, n < m -> n <= P m.
 Proof.
 intro n; cases m.
 intro H; false_hyp H nlt_0_r.
-intros m IH. rewrite pred_succ; now apply -> lt_succ_r.
+intros m IH. rewrite pred_succ; now apply lt_succ_r.
 Qed.
 
 Theorem lt_pred_le : forall n m, P n < m -> n <= m.
@@ -183,7 +184,7 @@ Theorem lt_pred_le : forall n m, P n < m -> n <= m.
 Proof.
 intros n m; cases n.
 rewrite pred_0; intro H; now apply lt_le_incl.
-intros n IH. rewrite pred_succ in IH. now apply <- le_succ_l.
+intros n IH. rewrite pred_succ in IH. now apply le_succ_l.
 Qed.
 
 Theorem lt_pred_lt : forall n m, n < P m -> n < m.
@@ -200,7 +201,7 @@ Theorem pred_le_mono : forall n m, n <= m -> P n <= P m.
  (* Converse is false for n == 1, m == 0 *)
 Proof.
 intros n m H; elim H using le_ind_rel.
-solve_relation_wd.
+solve_proper.
 intro; rewrite pred_0; apply le_0_l.
 intros p q H1 _; now do 2 rewrite pred_succ.
 Qed.
@@ -208,12 +209,12 @@ Qed.
 Theorem pred_lt_mono : forall n m, n ~= 0 -> (n < m <-> P n < P m).
 Proof.
 intros n m H1; split; intro H2.
-assert (m ~= 0). apply <- neq_0_lt_0. now apply lt_lt_0 with n.
+assert (m ~= 0). apply neq_0_lt_0. now apply lt_lt_0 with n.
 now rewrite <- (succ_pred n) in H2; rewrite <- (succ_pred m) in H2 ;
-[apply <- succ_lt_mono | | |].
-assert (m ~= 0). apply <- neq_0_lt_0. apply lt_lt_0 with (P n).
+[apply succ_lt_mono | | |].
+assert (m ~= 0). apply neq_0_lt_0. apply lt_lt_0 with (P n).
 apply lt_le_trans with (P m). assumption. apply le_pred_l.
-apply -> succ_lt_mono in H2. now do 2 rewrite succ_pred in H2.
+apply succ_lt_mono in H2. now do 2 rewrite succ_pred in H2.
 Qed.
 
 Theorem lt_succ_lt_pred : forall n m, S n < m <-> n < P m.
@@ -224,13 +225,13 @@ Qed.
 Theorem le_succ_le_pred : forall n m, S n <= m -> n <= P m.
  (* Converse is false for n == m == 0 *)
 Proof.
-intros n m H. apply lt_le_pred. now apply -> le_succ_l.
+intros n m H. apply lt_le_pred. now apply le_succ_l.
 Qed.
 
 Theorem lt_pred_lt_succ : forall n m, P n < m -> n < S m.
  (* Converse is false for n == m == 0 *)
 Proof.
-intros n m H. apply <- lt_succ_r. now apply lt_pred_le.
+intros n m H. apply lt_succ_r. now apply lt_pred_le.
 Qed.
 
 Theorem le_pred_le_succ : forall n m, P n <= m <-> n <= S m.
@@ -240,5 +241,5 @@ rewrite pred_0. split; intro H; apply le_0_l.
 intro n. rewrite pred_succ. apply succ_le_mono.
 Qed.
 
-End NOrderPropFunct.
+End NOrderProp.
 
diff --git a/theories/Numbers/Natural/Abstract/NParity.v b/theories/Numbers/Natural/Abstract/NParity.v
new file mode 100644
index 00000000..69b7778a
--- /dev/null
+++ b/theories/Numbers/Natural/Abstract/NParity.v
@@ -0,0 +1,63 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Bool NSub NZParity.
+
+(** Some additionnal properties of [even], [odd]. *)
+
+Module Type NParityProp (Import N : NAxiomsSig')(Import NP : NSubProp N).
+
+Include NZParityProp N N NP.
+
+Lemma odd_pred : forall n, n~=0 -> odd (P n) = even n.
+Proof.
+ intros. rewrite <- (succ_pred n) at 2 by trivial.
+ symmetry. apply even_succ.
+Qed.
+
+Lemma even_pred : forall n, n~=0 -> even (P n) = odd n.
+Proof.
+ intros. rewrite <- (succ_pred n) at 2 by trivial.
+ symmetry. apply odd_succ.
+Qed.
+
+Lemma even_sub : forall n m, m<=n -> even (n-m) = Bool.eqb (even n) (even m).
+Proof.
+ intros.
+ case_eq (even n); case_eq (even m);
+  rewrite <- ?negb_true_iff, ?negb_even, ?odd_spec, ?even_spec;
+  intros (m',Hm) (n',Hn).
+ exists (n'-m'). now rewrite mul_sub_distr_l, Hn, Hm.
+ exists (n'-m'-1).
+  rewrite !mul_sub_distr_l, Hn, Hm, sub_add_distr, mul_1_r.
+  rewrite two_succ at 5. rewrite <- (add_1_l 1). rewrite sub_add_distr.
+  symmetry. apply sub_add.
+  apply le_add_le_sub_l.
+  rewrite add_1_l, <- two_succ, <- (mul_1_r 2) at 1.
+  rewrite <- mul_sub_distr_l. rewrite <- mul_le_mono_pos_l by order'.
+  rewrite one_succ, le_succ_l. rewrite <- lt_add_lt_sub_l, add_0_r.
+  destruct (le_gt_cases n' m') as [LE|GT]; trivial.
+  generalize (double_below _ _ LE). order.
+ exists (n'-m'). rewrite mul_sub_distr_l, Hn, Hm.
+  apply add_sub_swap.
+  apply mul_le_mono_pos_l; try order'.
+  destruct (le_gt_cases m' n') as [LE|GT]; trivial.
+  generalize (double_above _ _ GT). order.
+ exists (n'-m'). rewrite Hm,Hn, mul_sub_distr_l.
+  rewrite sub_add_distr. rewrite add_sub_swap. apply add_sub.
+  apply succ_le_mono.
+  rewrite add_1_r in Hm,Hn. order.
+Qed.
+
+Lemma odd_sub : forall n m, m<=n -> odd (n-m) = xorb (odd n) (odd m).
+Proof.
+ intros. rewrite <- !negb_even. rewrite even_sub by trivial.
+ now destruct (even n), (even m).
+Qed.
+
+End NParityProp.
diff --git a/theories/Numbers/Natural/Abstract/NPow.v b/theories/Numbers/Natural/Abstract/NPow.v
new file mode 100644
index 00000000..ee29a4a7
--- /dev/null
+++ b/theories/Numbers/Natural/Abstract/NPow.v
@@ -0,0 +1,160 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Properties of the power function *)
+
+Require Import Bool NAxioms NSub NParity NZPow.
+
+(** Derived properties of power, specialized on natural numbers *)
+
+Module Type NPowProp
+ (Import A : NAxiomsSig')
+ (Import B : NSubProp A)
+ (Import C : NParityProp A B).
+
+ Module Import Private_NZPow := Nop <+ NZPowProp A A B.
+
+Ltac auto' := trivial; try rewrite <- neq_0_lt_0; auto using le_0_l.
+Ltac wrap l := intros; apply l; auto'.
+
+Lemma pow_succ_r' : forall a b, a^(S b) == a * a^b.
+Proof. wrap pow_succ_r. Qed.
+
+(** Power and basic constants *)
+
+Lemma pow_0_l : forall a, a~=0 -> 0^a == 0.
+Proof. wrap pow_0_l. Qed.
+
+Definition pow_1_r : forall a, a^1 == a
+ := pow_1_r.
+
+Lemma pow_1_l : forall a, 1^a == 1.
+Proof. wrap pow_1_l. Qed.
+
+Definition pow_2_r : forall a, a^2 == a*a
+ := pow_2_r.
+
+(** Power and addition, multiplication *)
+
+Lemma pow_add_r : forall a b c, a^(b+c) == a^b * a^c.
+Proof. wrap pow_add_r. Qed.
+
+Lemma pow_mul_l : forall a b c, (a*b)^c == a^c * b^c.
+Proof. wrap pow_mul_l. Qed.
+
+Lemma pow_mul_r : forall a b c, a^(b*c) == (a^b)^c.
+Proof. wrap pow_mul_r. Qed.
+
+(** Power and nullity *)
+
+Lemma pow_eq_0 : forall a b, b~=0 -> a^b == 0 -> a == 0.
+Proof. intros. apply (pow_eq_0 a b); trivial. auto'. Qed.
+
+Lemma pow_nonzero : forall a b, a~=0 -> a^b ~= 0.
+Proof. wrap pow_nonzero. Qed.
+
+Lemma pow_eq_0_iff : forall a b, a^b == 0 <-> b~=0 /\ a==0.
+Proof.
+ intros a b. split.
+ rewrite pow_eq_0_iff. intros [H |[H H']].
+  generalize (le_0_l b); order. split; order.
+ intros (Hb,Ha). rewrite Ha. now apply pow_0_l'.
+Qed.
+
+(** Monotonicity *)
+
+Lemma pow_lt_mono_l : forall a b c, c~=0 -> a<b -> a^c < b^c.
+Proof. wrap pow_lt_mono_l. Qed.
+
+Lemma pow_le_mono_l : forall a b c, a<=b -> a^c <= b^c.
+Proof. wrap pow_le_mono_l. Qed.
+
+Lemma pow_gt_1 : forall a b, 1<a -> b~=0 -> 1<a^b.
+Proof. wrap pow_gt_1. Qed.
+
+Lemma pow_lt_mono_r : forall a b c, 1<a -> b<c -> a^b < a^c.
+Proof. wrap pow_lt_mono_r. Qed.
+
+(** NB: since 0^0 > 0^1, the following result isn't valid with a=0 *)
+
+Lemma pow_le_mono_r : forall a b c, a~=0 -> b<=c -> a^b <= a^c.
+Proof. wrap pow_le_mono_r. Qed.
+
+Lemma pow_le_mono : forall a b c d, a~=0 -> a<=c -> b<=d ->
+ a^b <= c^d.
+Proof. wrap pow_le_mono. Qed.
+
+Definition pow_lt_mono : forall a b c d, 0<a<c -> 0<b<d ->
+ a^b < c^d
+ := pow_lt_mono.
+
+(** Injectivity *)
+
+Lemma pow_inj_l : forall a b c, c~=0 -> a^c == b^c -> a == b.
+Proof. intros; eapply pow_inj_l; eauto; auto'. Qed.
+
+Lemma pow_inj_r : forall a b c, 1<a -> a^b == a^c -> b == c.
+Proof. intros; eapply pow_inj_r; eauto; auto'. Qed.
+
+(** Monotonicity results, both ways *)
+
+Lemma pow_lt_mono_l_iff : forall a b c, c~=0 ->
+  (a<b <-> a^c < b^c).
+Proof. wrap pow_lt_mono_l_iff. Qed.
+
+Lemma pow_le_mono_l_iff : forall a b c, c~=0 ->
+  (a<=b <-> a^c <= b^c).
+Proof. wrap pow_le_mono_l_iff. Qed.
+
+Lemma pow_lt_mono_r_iff : forall a b c, 1<a ->
+  (b<c <-> a^b < a^c).
+Proof. wrap pow_lt_mono_r_iff. Qed.
+
+Lemma pow_le_mono_r_iff : forall a b c, 1<a ->
+  (b<=c <-> a^b <= a^c).
+Proof. wrap pow_le_mono_r_iff. Qed.
+
+(** For any a>1, the a^x function is above the identity function *)
+
+Lemma pow_gt_lin_r : forall a b, 1<a -> b < a^b.
+Proof. wrap pow_gt_lin_r. Qed.
+
+(** Someday, we should say something about the full Newton formula.
+    In the meantime, we can at least provide some inequalities about
+    (a+b)^c.
+*)
+
+Lemma pow_add_lower : forall a b c, c~=0 ->
+  a^c + b^c <= (a+b)^c.
+Proof. wrap pow_add_lower. Qed.
+
+(** This upper bound can also be seen as a convexity proof for x^c :
+    image of (a+b)/2 is below the middle of the images of a and b
+*)
+
+Lemma pow_add_upper : forall a b c, c~=0 ->
+  (a+b)^c <= 2^(pred c) * (a^c + b^c).
+Proof. wrap pow_add_upper. Qed.
+
+(** Power and parity *)
+
+Lemma even_pow : forall a b, b~=0 -> even (a^b) = even a.
+Proof.
+ intros a b Hb. rewrite neq_0_lt_0 in Hb.
+ apply lt_ind with (4:=Hb). solve_proper.
+ now nzsimpl.
+ clear b Hb. intros b Hb IH.
+ rewrite pow_succ_r', even_mul, IH. now destruct (even a).
+Qed.
+
+Lemma odd_pow : forall a b, b~=0 -> odd (a^b) = odd a.
+Proof.
+ intros. now rewrite <- !negb_even, even_pow.
+Qed.
+
+End NPowProp.
diff --git a/theories/Numbers/Natural/Abstract/NProperties.v b/theories/Numbers/Natural/Abstract/NProperties.v
index c9e05113..90739410 100644
--- a/theories/Numbers/Natural/Abstract/NProperties.v
+++ b/theories/Numbers/Natural/Abstract/NProperties.v
@@ -1,22 +1,17 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: NProperties.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+Require Export NAxioms.
+Require Import NMaxMin NParity NPow NSqrt NLog NDiv NGcd NLcm NBits.
 
-Require Export NAxioms NSub.
+(** This functor summarizes all known facts about N. *)
 
-(** This functor summarizes all known facts about N.
-    For the moment it is only an alias to [NSubPropFunct], which
-    subsumes all others.
-*)
-
-Module Type NPropSig := NSubPropFunct.
-
-Module NPropFunct (N:NAxiomsSig) <: NPropSig N.
- Include NPropSig N.
-End NPropFunct.
+Module Type NProp (N:NAxiomsSig) :=
+ NMaxMinProp N <+ NParityProp N <+ NPowProp N <+ NSqrtProp N
+  <+ NLog2Prop N <+ NDivProp N <+ NGcdProp N <+ NLcmProp N
+  <+ NBitsProp N.
diff --git a/theories/Numbers/Natural/Abstract/NSqrt.v b/theories/Numbers/Natural/Abstract/NSqrt.v
new file mode 100644
index 00000000..9cd62ae9
--- /dev/null
+++ b/theories/Numbers/Natural/Abstract/NSqrt.v
@@ -0,0 +1,75 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Properties of Square Root Function *)
+
+Require Import NAxioms NSub NZSqrt.
+
+Module NSqrtProp (Import A : NAxiomsSig')(Import B : NSubProp A).
+
+ Module Import Private_NZSqrt := Nop <+ NZSqrtProp A A B.
+
+ Ltac auto' := trivial; try rewrite <- neq_0_lt_0; auto using le_0_l.
+ Ltac wrap l := intros; apply l; auto'.
+
+ (** We redefine NZSqrt's results, without the non-negative hyps *)
+
+Lemma sqrt_spec' : forall a, √a*√a <= a < S (√a) * S (√a).
+Proof. wrap sqrt_spec. Qed.
+
+Definition sqrt_unique : forall a b, b*b<=a<(S b)*(S b) -> √a == b
+ := sqrt_unique.
+
+Lemma sqrt_square : forall a, √(a*a) == a.
+Proof. wrap sqrt_square. Qed.
+
+Definition sqrt_le_mono : forall a b, a<=b -> √a <= √b
+ := sqrt_le_mono.
+
+Definition sqrt_lt_cancel : forall a b, √a < √b -> a < b
+ := sqrt_lt_cancel.
+
+Lemma sqrt_le_square : forall a b, b*b<=a <-> b <= √a.
+Proof. wrap sqrt_le_square. Qed.
+
+Lemma sqrt_lt_square : forall a b, a<b*b <-> √a < b.
+Proof. wrap sqrt_lt_square. Qed.
+
+Definition sqrt_0 := sqrt_0.
+Definition sqrt_1 := sqrt_1.
+Definition sqrt_2 := sqrt_2.
+
+Definition sqrt_lt_lin : forall a, 1<a -> √a<a
+ := sqrt_lt_lin.
+
+Lemma sqrt_le_lin : forall a, √a<=a.
+Proof. wrap sqrt_le_lin. Qed.
+
+Definition sqrt_mul_below : forall a b, √a * √b <= √(a*b)
+ := sqrt_mul_below.
+
+Lemma sqrt_mul_above : forall a b, √(a*b) < S (√a) * S (√b).
+Proof. wrap sqrt_mul_above. Qed.
+
+Lemma sqrt_succ_le : forall a, √(S a) <= S (√a).
+Proof. wrap sqrt_succ_le. Qed.
+
+Lemma sqrt_succ_or : forall a, √(S a) == S (√a) \/ √(S a) == √a.
+Proof. wrap sqrt_succ_or. Qed.
+
+Definition sqrt_add_le : forall a b, √(a+b) <= √a + √b
+ := sqrt_add_le.
+
+Lemma add_sqrt_le : forall a b, √a + √b <= √(2*(a+b)).
+Proof. wrap add_sqrt_le. Qed.
+
+(** For the moment, we include stuff about [sqrt_up] with patching them. *)
+
+Include NZSqrtUpProp A A B Private_NZSqrt.
+
+End NSqrtProp.
diff --git a/theories/Numbers/Natural/Abstract/NStrongRec.v b/theories/Numbers/Natural/Abstract/NStrongRec.v
index d9a2427d..e4cbf090 100644
--- a/theories/Numbers/Natural/Abstract/NStrongRec.v
+++ b/theories/Numbers/Natural/Abstract/NStrongRec.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,15 +8,15 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NStrongRec.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file defined the strong (course-of-value, well-founded) recursion
 and proves its properties *)
 
 Require Export NSub.
 
-Module NStrongRecPropFunct (Import N : NAxiomsSig').
-Include NSubPropFunct N.
+Ltac f_equiv' := repeat progress (f_equiv; try intros ? ? ?; auto).
+
+Module NStrongRecProp (Import N : NAxiomsRecSig').
+Include NSubProp N.
 
 Section StrongRecursion.
 
@@ -51,30 +51,18 @@ Proof.
 reflexivity.
 Qed.
 
-(** We need a result similar to [f_equal], but for setoid equalities. *)
-Lemma f_equiv : forall f g x y,
- (N.eq==>Aeq)%signature f g -> N.eq x y -> Aeq (f x) (g y).
-Proof.
-auto.
-Qed.
-
 Instance strong_rec0_wd :
  Proper (Aeq ==> ((N.eq ==> Aeq) ==> N.eq ==> Aeq) ==> N.eq ==> N.eq ==> Aeq)
   strong_rec0.
 Proof.
-unfold strong_rec0.
-repeat red; intros.
-apply f_equiv; auto.
-apply recursion_wd; try red; auto.
+unfold strong_rec0; f_equiv'.
 Qed.
 
 Instance strong_rec_wd :
  Proper (Aeq ==> ((N.eq ==> Aeq) ==> N.eq ==> Aeq) ==> N.eq ==> Aeq) strong_rec.
 Proof.
 intros a a' Eaa' f f' Eff' n n' Enn'.
-rewrite !strong_rec_alt.
-apply strong_rec0_wd; auto.
-now rewrite Enn'.
+rewrite !strong_rec_alt; f_equiv'.
 Qed.
 
 Section FixPoint.
@@ -92,18 +80,16 @@ Lemma strong_rec0_succ : forall a n m,
  Aeq (strong_rec0 a f (S n) m) (f (strong_rec0 a f n) m).
 Proof.
 intros. unfold strong_rec0.
-apply f_equiv; auto with *.
-rewrite recursion_succ; try (repeat red; auto with *; fail).
-apply f_wd.
-apply recursion_wd; try red; auto with *.
+f_equiv.
+rewrite recursion_succ; f_equiv'.
+reflexivity.
 Qed.
 
 Lemma strong_rec_0 : forall a,
  Aeq (strong_rec a f 0) (f (fun _ => a) 0).
 Proof.
-intros. rewrite strong_rec_alt, strong_rec0_succ.
-apply f_wd; auto with *.
-red; intros; rewrite strong_rec0_0; auto with *.
+intros. rewrite strong_rec_alt, strong_rec0_succ; f_equiv'.
+rewrite strong_rec0_0. reflexivity.
 Qed.
 
 (* We need an assumption saying that for every n, the step function (f h n)
@@ -158,7 +144,7 @@ intros.
 transitivity (f (fun n => strong_rec0 a f (S n) n) n).
 rewrite strong_rec_alt.
 apply strong_rec0_fixpoint.
-apply f_wd; auto with *.
+f_equiv.
 intros x x' Hx; rewrite strong_rec_alt, Hx; auto with *.
 Qed.
 
@@ -204,7 +190,7 @@ Qed.
 End FixPoint.
 End StrongRecursion.
 
-Implicit Arguments strong_rec [A].
+Arguments strong_rec [A] a f n.
 
-End NStrongRecPropFunct.
+End NStrongRecProp.
 
diff --git a/theories/Numbers/Natural/Abstract/NSub.v b/theories/Numbers/Natural/Abstract/NSub.v
index c0be3114..68bfffad 100644
--- a/theories/Numbers/Natural/Abstract/NSub.v
+++ b/theories/Numbers/Natural/Abstract/NSub.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,12 +8,10 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NSub.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NMulOrder.
 
-Module Type NSubPropFunct (Import N : NAxiomsSig').
-Include NMulOrderPropFunct N.
+Module Type NSubProp (Import N : NAxiomsMiniSig').
+Include NMulOrderProp N.
 
 Theorem sub_0_l : forall n, 0 - n == 0.
 Proof.
@@ -37,7 +35,7 @@ Qed.
 Theorem sub_gt : forall n m, n > m -> n - m ~= 0.
 Proof.
 intros n m H; elim H using lt_ind_rel; clear n m H.
-solve_relation_wd.
+solve_proper.
 intro; rewrite sub_0_r; apply neq_succ_0.
 intros; now rewrite sub_succ.
 Qed.
@@ -47,8 +45,8 @@ Proof.
 intros n m p; induct p.
 intro; now do 2 rewrite sub_0_r.
 intros p IH H. do 2 rewrite sub_succ_r.
-rewrite <- IH by (apply lt_le_incl; now apply -> le_succ_l).
-rewrite add_pred_r by (apply sub_gt; now apply -> le_succ_l).
+rewrite <- IH by (apply lt_le_incl; now apply le_succ_l).
+rewrite add_pred_r by (apply sub_gt; now apply le_succ_l).
 reflexivity.
 Qed.
 
@@ -205,6 +203,26 @@ Proof.
 intros n m p. rewrite add_comm; apply lt_add_lt_sub_r.
 Qed.
 
+Theorem sub_lt : forall n m, m <= n -> 0 < m -> n - m < n.
+Proof.
+intros n m LE LT.
+assert (LE' := le_sub_l n m). rewrite lt_eq_cases in LE'.
+destruct LE' as [LT'|EQ]. assumption.
+apply add_sub_eq_nz in EQ; [|order].
+rewrite (add_lt_mono_r _ _ n), add_0_l in LT. order.
+Qed.
+
+Lemma sub_le_mono_r : forall n m p, n <= m -> n-p <= m-p.
+Proof.
+ intros. rewrite le_sub_le_add_r. transitivity m. assumption. apply sub_add_le.
+Qed.
+
+Lemma sub_le_mono_l : forall n m p, n <= m -> p-m <= p-n.
+Proof.
+ intros. rewrite le_sub_le_add_r.
+ transitivity (p-n+n); [ apply sub_add_le | now apply add_le_mono_l].
+Qed.
+
 (** Sub and mul *)
 
 Theorem mul_pred_r : forall n m, n * (P m) == n * m - n.
@@ -224,10 +242,10 @@ intros n IH. destruct (le_gt_cases m n) as [H | H].
 rewrite sub_succ_l by assumption. do 2 rewrite mul_succ_l.
 rewrite (add_comm ((n - m) * p) p), (add_comm (n * p) p).
 rewrite <- (add_sub_assoc p (n * p) (m * p)) by now apply mul_le_mono_r.
-now apply <- add_cancel_l.
-assert (H1 : S n <= m); [now apply <- le_succ_l |].
-setoid_replace (S n - m) with 0 by now apply <- sub_0_le.
-setoid_replace ((S n * p) - m * p) with 0 by (apply <- sub_0_le; now apply mul_le_mono_r).
+now apply add_cancel_l.
+assert (H1 : S n <= m); [now apply le_succ_l |].
+setoid_replace (S n - m) with 0 by now apply sub_0_le.
+setoid_replace ((S n * p) - m * p) with 0 by (apply sub_0_le; now apply mul_le_mono_r).
 apply mul_0_l.
 Qed.
 
@@ -298,5 +316,5 @@ Theorem add_dichotomy :
   forall n m, (exists p, p + n == m) \/ (exists p, p + m == n).
 Proof. exact le_alt_dichotomy. Qed.
 
-End NSubPropFunct.
+End NSubProp.
 
diff --git a/theories/Numbers/Natural/BigN/BigN.v b/theories/Numbers/Natural/BigN/BigN.v
index 7c480862..072b75f7 100644
--- a/theories/Numbers/Natural/BigN/BigN.v
+++ b/theories/Numbers/Natural/BigN/BigN.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -12,7 +12,7 @@
 
 Require Export Int31.
 Require Import CyclicAxioms Cyclic31 Ring31 NSig NSigNAxioms NMake
-  NProperties NDiv GenericMinMax.
+  NProperties GenericMinMax.
 
 (** The following [BigN] module regroups both the operations and
     all the abstract properties:
@@ -21,73 +21,63 @@ Require Import CyclicAxioms Cyclic31 Ring31 NSig NSigNAxioms NMake
        w.r.t. ZArith
     - [NTypeIsNAxioms] shows (mainly) that these operations implement
       the interface [NAxioms]
-    - [NPropSig] adds all generic properties derived from [NAxioms]
-    - [NDivPropFunct] provides generic properties of [div] and [mod].
+    - [NProp] adds all generic properties derived from [NAxioms]
     - [MinMax*Properties] provides properties of [min] and [max].
 
 *)
 
-Module BigN <: NType <: OrderedTypeFull <: TotalOrder :=
- NMake.Make Int31Cyclic <+ NTypeIsNAxioms
- <+ !NPropSig <+ !NDivPropFunct <+ HasEqBool2Dec
- <+ !MinMaxLogicalProperties <+ !MinMaxDecProperties.
+Delimit Scope bigN_scope with bigN.
 
+Module BigN <: NType <: OrderedTypeFull <: TotalOrder.
+ Include NMake.Make Int31Cyclic [scope abstract_scope to bigN_scope].
+ Bind Scope bigN_scope with t t'.
+ Include NTypeIsNAxioms
+  <+ NProp [no inline]
+  <+ HasEqBool2Dec [no inline]
+  <+ MinMaxLogicalProperties [no inline]
+  <+ MinMaxDecProperties [no inline].
+End BigN.
+
+(** Nota concerning scopes : for the first Include, we cannot bind
+    the scope bigN_scope to a type that doesn't exists yet.
+    We hence need to explicitely declare the scope substitution.
+    For the next Include, the abstract type t (in scope abstract_scope)
+    gets substituted to concrete BigN.t (in scope bigN_scope),
+    and the corresponding argument scope are fixed automatically.
+*)
 
 (** Notations about [BigN] *)
 
-Notation bigN := BigN.t.
-
-Delimit Scope bigN_scope with bigN.
-Bind Scope bigN_scope with bigN.
-Bind Scope bigN_scope with BigN.t.
-Bind Scope bigN_scope with BigN.t_.
-(* Bind Scope has no retroactive effect, let's declare scopes by hand. *)
-Arguments Scope BigN.to_Z [bigN_scope].
-Arguments Scope BigN.succ [bigN_scope].
-Arguments Scope BigN.pred [bigN_scope].
-Arguments Scope BigN.square [bigN_scope].
-Arguments Scope BigN.add [bigN_scope bigN_scope].
-Arguments Scope BigN.sub [bigN_scope bigN_scope].
-Arguments Scope BigN.mul [bigN_scope bigN_scope].
-Arguments Scope BigN.div [bigN_scope bigN_scope].
-Arguments Scope BigN.eq [bigN_scope bigN_scope].
-Arguments Scope BigN.lt [bigN_scope bigN_scope].
-Arguments Scope BigN.le [bigN_scope bigN_scope].
-Arguments Scope BigN.eq [bigN_scope bigN_scope].
-Arguments Scope BigN.compare [bigN_scope bigN_scope].
-Arguments Scope BigN.min [bigN_scope bigN_scope].
-Arguments Scope BigN.max [bigN_scope bigN_scope].
-Arguments Scope BigN.eq_bool [bigN_scope bigN_scope].
-Arguments Scope BigN.power_pos [bigN_scope positive_scope].
-Arguments Scope BigN.power [bigN_scope N_scope].
-Arguments Scope BigN.sqrt [bigN_scope].
-Arguments Scope BigN.div_eucl [bigN_scope bigN_scope].
-Arguments Scope BigN.modulo [bigN_scope bigN_scope].
-Arguments Scope BigN.gcd [bigN_scope bigN_scope].
+Local Open Scope bigN_scope.
 
+Notation bigN := BigN.t.
+Bind Scope bigN_scope with bigN BigN.t BigN.t'.
+Arguments BigN.N0 _%int31.
 Local Notation "0" := BigN.zero : bigN_scope. (* temporary notation *)
 Local Notation "1" := BigN.one : bigN_scope. (* temporary notation *)
+Local Notation "2" := BigN.two : bigN_scope. (* temporary notation *)
 Infix "+" := BigN.add : bigN_scope.
 Infix "-" := BigN.sub : bigN_scope.
 Infix "*" := BigN.mul : bigN_scope.
 Infix "/" := BigN.div : bigN_scope.
-Infix "^" := BigN.power : bigN_scope.
+Infix "^" := BigN.pow : bigN_scope.
 Infix "?=" := BigN.compare : bigN_scope.
+Infix "=?" := BigN.eqb (at level 70, no associativity) : bigN_scope.
+Infix "<=?" := BigN.leb (at level 70, no associativity) : bigN_scope.
+Infix "<?" := BigN.ltb (at level 70, no associativity) : bigN_scope.
 Infix "==" := BigN.eq (at level 70, no associativity) : bigN_scope.
-Notation "x != y" := (~x==y)%bigN (at level 70, no associativity) : bigN_scope.
+Notation "x != y" := (~x==y) (at level 70, no associativity) : bigN_scope.
 Infix "<" := BigN.lt : bigN_scope.
 Infix "<=" := BigN.le : bigN_scope.
-Notation "x > y" := (BigN.lt y x)(only parsing) : bigN_scope.
-Notation "x >= y" := (BigN.le y x)(only parsing) : bigN_scope.
-Notation "x < y < z" := (x<y /\ y<z)%bigN : bigN_scope.
-Notation "x < y <= z" := (x<y /\ y<=z)%bigN : bigN_scope.
-Notation "x <= y < z" := (x<=y /\ y<z)%bigN : bigN_scope.
-Notation "x <= y <= z" := (x<=y /\ y<=z)%bigN : bigN_scope.
+Notation "x > y" := (y < x) (only parsing) : bigN_scope.
+Notation "x >= y" := (y <= x) (only parsing) : bigN_scope.
+Notation "x < y < z" := (x<y /\ y<z) : bigN_scope.
+Notation "x < y <= z" := (x<y /\ y<=z) : bigN_scope.
+Notation "x <= y < z" := (x<=y /\ y<z) : bigN_scope.
+Notation "x <= y <= z" := (x<=y /\ y<=z) : bigN_scope.
 Notation "[ i ]" := (BigN.to_Z i) : bigN_scope.
 Infix "mod" := BigN.modulo (at level 40, no associativity) : bigN_scope.
 
-Local Open Scope bigN_scope.
-
 (** Example of reasoning about [BigN] *)
 
 Theorem succ_pred: forall q : bigN,
@@ -107,29 +97,29 @@ exact BigN.mul_1_l. exact BigN.mul_0_l. exact BigN.mul_comm.
 exact BigN.mul_assoc. exact BigN.mul_add_distr_r.
 Qed.
 
-Lemma BigNeqb_correct : forall x y, BigN.eq_bool x y = true -> x==y.
+Lemma BigNeqb_correct : forall x y, (x =? y) = true -> x==y.
 Proof. now apply BigN.eqb_eq. Qed.
 
-Lemma BigNpower : power_theory 1 BigN.mul BigN.eq (@id N) BigN.power.
+Lemma BigNpower : power_theory 1 BigN.mul BigN.eq BigN.of_N BigN.pow.
 Proof.
 constructor.
-intros. red. rewrite BigN.spec_power. unfold id.
-destruct Zpower_theory as [EQ]. rewrite EQ.
+intros. red. rewrite BigN.spec_pow, BigN.spec_of_N.
+rewrite Zpower_theory.(rpow_pow_N).
 destruct n; simpl. reflexivity.
 induction p; simpl; intros; BigN.zify; rewrite ?IHp; auto.
 Qed.
 
 Lemma BigNdiv : div_theory BigN.eq BigN.add BigN.mul (@id _)
- (fun a b => if BigN.eq_bool b 0 then (0,a) else BigN.div_eucl a b).
+ (fun a b => if b =? 0 then (0,a) else BigN.div_eucl a b).
 Proof.
 constructor. unfold id. intros a b.
 BigN.zify.
-generalize (Zeq_bool_if [b] 0); destruct (Zeq_bool [b] 0).
+case Z.eqb_spec.
 BigN.zify. auto with zarith.
 intros NEQ.
 generalize (BigN.spec_div_eucl a b).
 generalize (Z_div_mod_full [a] [b] NEQ).
-destruct BigN.div_eucl as (q,r), Zdiv_eucl as (q',r').
+destruct BigN.div_eucl as (q,r), Z.div_eucl as (q',r').
 intros (EQ,_). injection 1. intros EQr EQq.
 BigN.zify. rewrite EQr, EQq; auto.
 Qed.
@@ -163,6 +153,7 @@ Ltac isBigNcst t :=
    end
  | BigN.zero => constr:true
  | BigN.one => constr:true
+ | BigN.two => constr:true
  | _ => constr:false
  end.
 
@@ -172,6 +163,12 @@ Ltac BigNcst t :=
  | false => constr:NotConstant
  end.
 
+Ltac BigN_to_N t :=
+ match isBigNcst t with
+ | true => eval vm_compute in (BigN.to_N t)
+ | false => constr:NotConstant
+ end.
+
 Ltac Ncst t :=
  match isNcst t with
  | true => constr:t
@@ -183,11 +180,11 @@ Ltac Ncst t :=
 Add Ring BigNr : BigNring
  (decidable BigNeqb_correct,
   constants [BigNcst],
-  power_tac BigNpower [Ncst],
+  power_tac BigNpower [BigN_to_N],
   div BigNdiv).
 
 Section TestRing.
-Let test : forall x y, 1 + x*y + x^2 + 1 == 1*1 + 1 + y*x + 1*x*x.
+Let test : forall x y, 1 + x*y^1 + x^2 + 1 == 1*1 + 1 + y*x + 1*x*x.
 intros. ring_simplify. reflexivity.
 Qed.
 End TestRing.
diff --git a/theories/Numbers/Natural/BigN/NMake.v b/theories/Numbers/Natural/BigN/NMake.v
index 2b70f1bb..5012a1b9 100644
--- a/theories/Numbers/Natural/BigN/NMake.v
+++ b/theories/Numbers/Natural/BigN/NMake.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -16,118 +16,577 @@
     representation. The representation-dependent (and macro-generated) part
     is now in [NMake_gen]. *)
 
-Require Import BigNumPrelude ZArith CyclicAxioms.
-Require Import Nbasic Wf_nat StreamMemo NSig NMake_gen.
+Require Import Bool BigNumPrelude ZArith Nnat Ndigits CyclicAxioms DoubleType
+  Nbasic Wf_nat StreamMemo NSig NMake_gen.
 
-Module Make (Import W0:CyclicType) <: NType.
+Module Make (W0:CyclicType) <: NType.
 
- (** Macro-generated part *)
+ (** Let's include the macro-generated part. Even if we can't functorize
+     things (due to Eval red_t below), the rest of the module only uses
+     elements mentionned in interface [NAbstract]. *)
 
  Include NMake_gen.Make W0.
 
+ Open Scope Z_scope.
+
+ Local Notation "[ x ]" := (to_Z x).
+
+ Definition eq (x y : t) := [x] = [y].
+
+ Declare Reduction red_t :=
+  lazy beta iota delta
+   [iter_t reduce same_level mk_t mk_t_S succ_t dom_t dom_op].
+
+ Ltac red_t :=
+  match goal with |- ?u => let v := (eval red_t in u) in change v end.
+
+ (** * Generic results *)
+
+ Tactic Notation "destr_t" constr(x) "as" simple_intropattern(pat) :=
+  destruct (destr_t x) as pat; cbv zeta;
+  rewrite ?iter_mk_t, ?spec_mk_t, ?spec_reduce.
+
+ Lemma spec_same_level : forall A (P:Z->Z->A->Prop)
+  (f : forall n, dom_t n -> dom_t n -> A),
+  (forall n x y, P (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y)) ->
+  forall x y, P [x] [y] (same_level f x y).
+ Proof.
+ intros. apply spec_same_level_dep with (P:=fun _ => P); auto.
+ Qed.
+
+ Theorem spec_pos: forall x, 0 <= [x].
+ Proof.
+ intros x. destr_t x as (n,x). now case (ZnZ.spec_to_Z x).
+ Qed.
+
+ Lemma digits_dom_op_incr : forall n m, (n<=m)%nat ->
+  (ZnZ.digits (dom_op n) <= ZnZ.digits (dom_op m))%positive.
+ Proof.
+ intros.
+ change (Zpos (ZnZ.digits (dom_op n)) <= Zpos (ZnZ.digits (dom_op m))).
+ rewrite !digits_dom_op, !Pshiftl_nat_Zpower.
+ apply Z.mul_le_mono_nonneg_l; auto with zarith.
+ apply Z.pow_le_mono_r; auto with zarith.
+ Qed.
+
+ Definition to_N (x : t) := Z.to_N (to_Z x).
+
+ (** * Zero, One *)
+
+ Definition zero := mk_t O ZnZ.zero.
+ Definition one := mk_t O ZnZ.one.
+
+ Theorem spec_0: [zero] = 0.
+ Proof.
+ unfold zero. rewrite spec_mk_t. exact ZnZ.spec_0.
+ Qed.
+
+ Theorem spec_1: [one] = 1.
+ Proof.
+ unfold one. rewrite spec_mk_t. exact ZnZ.spec_1.
+ Qed.
+
+ (** * Successor *)
+
+ (** NB: it is crucial here and for the rest of this file to preserve
+     the let-in's. They allow to pre-compute once and for all the
+     field access to Z/nZ initial structures (when n=0..6). *)
+
+ Local Notation succn := (fun n =>
+  let op := dom_op n in
+  let succ_c := ZnZ.succ_c in
+  let one := ZnZ.one in
+  fun x => match succ_c x with
+   | C0 r => mk_t n r
+   | C1 r => mk_t_S n (WW one r)
+  end).
+
+ Definition succ : t -> t := Eval red_t in iter_t succn.
+
+ Lemma succ_fold : succ = iter_t succn.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_succ: forall n, [succ n] = [n] + 1.
+ Proof.
+  intros x. rewrite succ_fold. destr_t x as (n,x).
+  generalize (ZnZ.spec_succ_c x); case ZnZ.succ_c.
+  intros. rewrite spec_mk_t. assumption.
+  intros. unfold interp_carry in *.
+  rewrite spec_mk_t_S. simpl. rewrite ZnZ.spec_1. assumption.
+ Qed.
+
+ (** Two *)
+
+ (** Not really pretty, but since W0 might be Z/2Z, we're not sure
+     there's a proper 2 there. *)
+
+ Definition two := succ one.
+
+ Lemma spec_2 : [two] = 2.
+ Proof.
+  unfold two. now rewrite spec_succ, spec_1.
+ Qed.
+
+ (** * Addition *)
+
+ Local Notation addn := (fun n =>
+  let op := dom_op n in
+  let add_c := ZnZ.add_c in
+  let one := ZnZ.one in
+  fun x y =>match add_c x y with
+  | C0 r => mk_t n r
+  | C1 r => mk_t_S n (WW one r)
+  end).
+
+ Definition add : t -> t -> t := Eval red_t in same_level addn.
+
+ Lemma add_fold : add = same_level addn.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_add: forall x y, [add x y] = [x] + [y].
+ Proof.
+  intros x y. rewrite add_fold. apply spec_same_level; clear x y.
+  intros n x y. simpl.
+  generalize (ZnZ.spec_add_c x y); case ZnZ.add_c; intros z H.
+  rewrite spec_mk_t. assumption.
+  rewrite spec_mk_t_S. unfold interp_carry in H.
+  simpl. rewrite ZnZ.spec_1. assumption.
+ Qed.
 
  (** * Predecessor *)
 
- Lemma spec_pred : forall x, [pred x] = Zmax 0 ([x]-1).
+ Local Notation predn := (fun n =>
+  let pred_c := ZnZ.pred_c in
+  fun x => match pred_c x with
+   | C0 r => reduce n r
+   | C1 _ => zero
+  end).
+
+ Definition pred : t -> t := Eval red_t in iter_t predn.
+
+ Lemma pred_fold : pred = iter_t predn.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_pred_pos : forall x, 0 < [x] -> [pred x] = [x] - 1.
  Proof.
- intros. destruct (Zle_lt_or_eq _ _ (spec_pos x)).
- rewrite Zmax_r; auto with zarith.
- apply spec_pred_pos; auto.
- rewrite <- H; apply spec_pred0; auto.
+  intros x. rewrite pred_fold. destr_t x as (n,x). intros H.
+  generalize (ZnZ.spec_pred_c x); case ZnZ.pred_c; intros y H'.
+  rewrite spec_reduce. assumption.
+  exfalso. unfold interp_carry in *.
+  generalize (ZnZ.spec_to_Z x) (ZnZ.spec_to_Z y); auto with zarith.
  Qed.
 
+ Theorem spec_pred0 : forall x, [x] = 0 -> [pred x] = 0.
+ Proof.
+  intros x. rewrite pred_fold. destr_t x as (n,x). intros H.
+  generalize (ZnZ.spec_pred_c x); case ZnZ.pred_c; intros y H'.
+  rewrite spec_reduce.
+  unfold interp_carry in H'.
+  generalize (ZnZ.spec_to_Z y); auto with zarith.
+  exact spec_0.
+ Qed.
+
+ Lemma spec_pred x : [pred x] = Z.max 0 ([x]-1).
+ Proof.
+ rewrite Z.max_comm.
+ destruct (Z.max_spec ([x]-1) 0) as [(H,->)|(H,->)].
+ - apply spec_pred0; generalize (spec_pos x); auto with zarith.
+ - apply spec_pred_pos; auto with zarith.
+ Qed.
 
  (** * Subtraction *)
 
- Lemma spec_sub : forall x y, [sub x y] = Zmax 0 ([x]-[y]).
+ Local Notation subn := (fun n =>
+  let sub_c := ZnZ.sub_c in
+  fun x y => match sub_c x y with
+  | C0 r => reduce n r
+  | C1 r => zero
+  end).
+
+ Definition sub : t -> t -> t := Eval red_t in same_level subn.
+
+ Lemma sub_fold : sub = same_level subn.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_sub_pos : forall x y, [y] <= [x] -> [sub x y] = [x] - [y].
+ Proof.
+  intros x y. rewrite sub_fold. apply spec_same_level. clear x y.
+  intros n x y. simpl.
+  generalize (ZnZ.spec_sub_c x y); case ZnZ.sub_c; intros z H LE.
+  rewrite spec_reduce. assumption.
+  unfold interp_carry in H.
+  exfalso.
+  generalize (ZnZ.spec_to_Z z); auto with zarith.
+ Qed.
+
+ Theorem spec_sub0 : forall x y, [x] < [y] -> [sub x y] = 0.
  Proof.
- intros. destruct (Zle_or_lt [y] [x]).
- rewrite Zmax_r; auto with zarith. apply spec_sub_pos; auto.
- rewrite Zmax_l; auto with zarith. apply spec_sub0; auto.
+  intros x y. rewrite sub_fold. apply spec_same_level. clear x y.
+  intros n x y. simpl.
+  generalize (ZnZ.spec_sub_c x y); case ZnZ.sub_c; intros z H LE.
+  rewrite spec_reduce.
+  unfold interp_carry in H.
+  generalize (ZnZ.spec_to_Z z); auto with zarith.
+  exact spec_0.
+ Qed.
+
+ Lemma spec_sub : forall x y, [sub x y] = Z.max 0 ([x]-[y]).
+ Proof.
+ intros. destruct (Z.le_gt_cases [y] [x]).
+ rewrite Z.max_r; auto with zarith. apply spec_sub_pos; auto.
+ rewrite Z.max_l; auto with zarith. apply spec_sub0; auto.
  Qed.
 
  (** * Comparison *)
 
- Theorem spec_compare : forall x y, compare x y = Zcompare [x] [y].
+ Definition comparen_m n :
+  forall m, word (dom_t n) (S m) -> dom_t n -> comparison :=
+  let op := dom_op n in
+  let zero := @ZnZ.zero _ op in
+  let compare := @ZnZ.compare _ op in
+  let compare0 := compare zero in
+  fun m => compare_mn_1 (dom_t n) (dom_t n) zero compare compare0 compare (S m).
+
+ Let spec_comparen_m:
+  forall n m (x : word (dom_t n) (S m)) (y : dom_t n),
+   comparen_m n m x y = Z.compare (eval n (S m) x) (ZnZ.to_Z y).
+ Proof.
+  intros n m x y.
+  unfold comparen_m, eval.
+  rewrite nmake_double.
+  apply spec_compare_mn_1.
+  exact ZnZ.spec_0.
+  intros. apply ZnZ.spec_compare.
+  exact ZnZ.spec_to_Z.
+  exact ZnZ.spec_compare.
+  exact ZnZ.spec_compare.
+  exact ZnZ.spec_to_Z.
+ Qed.
+
+ Definition comparenm n m wx wy :=
+    let mn := Max.max n m in
+    let d := diff n m in
+    let op := make_op mn in
+    ZnZ.compare
+       (castm (diff_r n m) (extend_tr wx (snd d)))
+       (castm (diff_l n m) (extend_tr wy (fst d))).
+
+ Local Notation compare_folded :=
+   (iter_sym _
+      (fun n => @ZnZ.compare _ (dom_op n))
+      comparen_m
+      comparenm
+      CompOpp).
+
+ Definition compare : t -> t -> comparison :=
+  Eval lazy beta iota delta [iter_sym dom_op dom_t comparen_m] in
+  compare_folded.
+
+ Lemma compare_fold : compare = compare_folded.
+ Proof.
+ lazy beta iota delta [iter_sym dom_op dom_t comparen_m]. reflexivity.
+ Qed.
+
+ Theorem spec_compare : forall x y,
+   compare x y = Z.compare [x] [y].
  Proof.
- intros x y. generalize (spec_compare_aux x y); destruct compare;
- intros; symmetry; try rewrite Zcompare_Eq_iff_eq; assumption.
+  intros x y. rewrite compare_fold. apply spec_iter_sym; clear x y.
+  intros. apply ZnZ.spec_compare.
+  intros. cbv beta zeta. apply spec_comparen_m.
+  intros n m x y; unfold comparenm.
+  rewrite (spec_cast_l n m x), (spec_cast_r n m y).
+  unfold to_Z; apply ZnZ.spec_compare.
+  intros. subst. now rewrite <- Z.compare_antisym.
  Qed.
 
- Definition eq_bool x y :=
+ Definition eqb (x y : t) : bool :=
   match compare x y with
   | Eq => true
   | _  => false
   end.
 
- Theorem spec_eq_bool : forall x y, eq_bool x y = Zeq_bool [x] [y].
+ Theorem spec_eqb x y : eqb x y = Z.eqb [x] [y].
+ Proof.
+ apply eq_iff_eq_true.
+ unfold eqb. rewrite Z.eqb_eq, <- Z.compare_eq_iff, spec_compare.
+ split; [now destruct Z.compare | now intros ->].
+ Qed.
+
+ Definition lt (n m : t) := [n] < [m].
+ Definition le (n m : t) := [n] <= [m].
+
+ Definition ltb (x y : t) : bool :=
+  match compare x y with
+  | Lt => true
+  | _  => false
+  end.
+
+ Theorem spec_ltb x y : ltb x y = Z.ltb [x] [y].
  Proof.
- intros. unfold eq_bool, Zeq_bool. rewrite spec_compare; reflexivity.
+ apply eq_iff_eq_true.
+ rewrite Z.ltb_lt. unfold Z.lt, ltb. rewrite spec_compare.
+ split; [now destruct Z.compare | now intros ->].
  Qed.
 
- Theorem spec_eq_bool_aux: forall x y,
-    if eq_bool x y then [x] = [y] else [x] <> [y].
+ Definition leb (x y : t) : bool :=
+  match compare x y with
+  | Gt => false
+  | _  => true
+  end.
+
+ Theorem spec_leb x y : leb x y = Z.leb [x] [y].
  Proof.
- intros x y; unfold eq_bool.
- generalize (spec_compare_aux x y); case compare; auto with zarith.
+ apply eq_iff_eq_true.
+ rewrite Z.leb_le. unfold Z.le, leb. rewrite spec_compare.
+ destruct Z.compare; split; try easy. now destruct 1.
  Qed.
 
- Definition lt n m := [n] < [m].
- Definition le n m := [n] <= [m].
+ Definition min (n m : t) : t := match compare n m with Gt => m | _ => n end.
+ Definition max (n m : t) : t := match compare n m with Lt => m | _ => n end.
 
- Definition min n m := match compare n m with Gt => m | _ => n end.
- Definition max n m := match compare n m with Lt => m | _ => n end.
+ Theorem spec_max : forall n m, [max n m] = Z.max [n] [m].
+ Proof.
+ intros. unfold max, Z.max. rewrite spec_compare; destruct Z.compare; reflexivity.
+ Qed.
 
- Theorem spec_max : forall n m, [max n m] = Zmax [n] [m].
+ Theorem spec_min : forall n m, [min n m] = Z.min [n] [m].
  Proof.
- intros. unfold max, Zmax. rewrite spec_compare; destruct Zcompare; reflexivity.
+ intros. unfold min, Z.min. rewrite spec_compare; destruct Z.compare; reflexivity.
  Qed.
 
- Theorem spec_min : forall n m, [min n m] = Zmin [n] [m].
+ (** * Multiplication *)
+
+ Definition wn_mul n : forall m, word (dom_t n) (S m) -> dom_t n -> t :=
+  let op := dom_op n in
+  let zero := @ZnZ.zero _ op in
+  let succ := @ZnZ.succ _ op in
+  let add_c := @ZnZ.add_c _ op in
+  let mul_c := @ZnZ.mul_c _ op in
+  let ww := @ZnZ.WW _ op in
+  let ow := @ZnZ.OW _ op in
+  let eq0 := @ZnZ.eq0 _ op in
+  let mul_add := @DoubleMul.w_mul_add _ zero succ add_c mul_c in
+  let mul_add_n1 := @DoubleMul.double_mul_add_n1 _ zero ww ow mul_add in
+  fun m x y =>
+   let (w,r) := mul_add_n1 (S m) x y zero in
+   if eq0 w then mk_t_w' n m r
+   else mk_t_w' n (S m) (WW (extend n m w) r).
+
+ Definition mulnm n m x y :=
+    let mn := Max.max n m in
+    let d := diff n m in
+    let op := make_op mn in
+     reduce_n (S mn) (ZnZ.mul_c
+       (castm (diff_r n m) (extend_tr x (snd d)))
+       (castm (diff_l n m) (extend_tr y (fst d)))).
+
+ Local Notation mul_folded :=
+  (iter_sym _
+    (fun n => let mul_c := ZnZ.mul_c in
+      fun x y => reduce (S n) (succ_t _ (mul_c x y)))
+    wn_mul
+    mulnm
+    (fun x => x)).
+
+ Definition mul : t -> t -> t :=
+  Eval lazy beta iota delta
+   [iter_sym dom_op dom_t reduce succ_t extend zeron
+    wn_mul DoubleMul.w_mul_add mk_t_w'] in
+  mul_folded.
+
+ Lemma mul_fold : mul = mul_folded.
  Proof.
- intros. unfold min, Zmin. rewrite spec_compare; destruct Zcompare; reflexivity.
+  lazy beta iota delta
+   [iter_sym dom_op dom_t reduce succ_t extend zeron
+    wn_mul  DoubleMul.w_mul_add mk_t_w']. reflexivity.
  Qed.
 
+ Lemma spec_muln:
+   forall n (x: word _ (S n)) y,
+     [Nn (S n) (ZnZ.mul_c (Ops:=make_op n) x y)] = [Nn n x] * [Nn n y].
+ Proof.
+    intros n x y; unfold to_Z.
+    rewrite <- ZnZ.spec_mul_c.
+    rewrite make_op_S.
+    case ZnZ.mul_c; auto.
+ Qed.
 
- (** * Power *)
+ Lemma spec_mul_add_n1: forall n m x y z,
+  let (q,r) := DoubleMul.double_mul_add_n1 ZnZ.zero ZnZ.WW ZnZ.OW
+          (DoubleMul.w_mul_add ZnZ.zero ZnZ.succ ZnZ.add_c ZnZ.mul_c)
+          (S m) x y z in
+  ZnZ.to_Z q * (base (ZnZ.digits (nmake_op _ (dom_op n) (S m))))
+   + eval n (S m) r =
+  eval n (S m) x * ZnZ.to_Z y + ZnZ.to_Z z.
+ Proof.
+ intros n m x y z.
+ rewrite digits_nmake.
+ unfold eval. rewrite nmake_double.
+ apply DoubleMul.spec_double_mul_add_n1.
+ apply ZnZ.spec_0.
+ exact ZnZ.spec_WW.
+ exact ZnZ.spec_OW.
+ apply DoubleCyclic.spec_mul_add.
+ Qed.
 
- Fixpoint power_pos (x:t) (p:positive) {struct p} : t :=
-  match p with
-  | xH => x
-  | xO p => square (power_pos x p)
-  | xI p => mul (square (power_pos x p)) x
-  end.
+ Lemma spec_wn_mul : forall n m x y,
+   [wn_mul n m x y] = (eval n (S m) x) * ZnZ.to_Z y.
+ Proof.
+  intros; unfold wn_mul.
+  generalize (spec_mul_add_n1 n m x y ZnZ.zero).
+  case DoubleMul.double_mul_add_n1; intros q r Hqr.
+  rewrite ZnZ.spec_0, Z.add_0_r in Hqr. rewrite <- Hqr.
+  generalize (ZnZ.spec_eq0 q); case ZnZ.eq0; intros HH.
+  rewrite HH; auto. simpl. apply spec_mk_t_w'.
+  clear.
+  rewrite spec_mk_t_w'.
+  set (m' := S m) in *.
+  unfold eval.
+  rewrite nmake_WW. f_equal. f_equal.
+  rewrite <- spec_mk_t.
+  symmetry. apply spec_extend.
+ Qed.
 
- Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n.
+ Theorem spec_mul : forall x y, [mul x y] = [x] * [y].
  Proof.
- intros x n; generalize x; elim n; clear n x; simpl power_pos.
- intros; rewrite spec_mul; rewrite spec_square; rewrite H.
- rewrite Zpos_xI; rewrite Zpower_exp; auto with zarith.
- rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith.
- rewrite Zpower_2; rewrite Zpower_1_r; auto.
- intros; rewrite spec_square; rewrite H.
- rewrite Zpos_xO; auto with zarith.
- rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith.
- rewrite Zpower_2; auto.
- intros; rewrite Zpower_1_r; auto.
+  intros x y. rewrite mul_fold. apply spec_iter_sym; clear x y.
+   intros n x y. cbv zeta beta.
+    rewrite spec_reduce, spec_succ_t, <- ZnZ.spec_mul_c; auto.
+   apply spec_wn_mul.
+   intros n m x y; unfold mulnm. rewrite spec_reduce_n.
+    rewrite (spec_cast_l n m x), (spec_cast_r n m y).
+    apply spec_muln.
+   intros. rewrite Z.mul_comm; auto.
  Qed.
 
- Definition power x (n:N) := match n with
-  | BinNat.N0 => one
-  | BinNat.Npos p => power_pos x p
- end.
+ (** * Division by a smaller number *)
+
+ Definition wn_divn1 n :=
+  let op := dom_op n in
+  let zd := ZnZ.zdigits op in
+  let zero := @ZnZ.zero _ op in
+  let ww := @ZnZ.WW _ op in
+  let head0 := @ZnZ.head0 _ op in
+  let add_mul_div := @ZnZ.add_mul_div _ op in
+  let div21 := @ZnZ.div21 _ op in
+  let compare := @ZnZ.compare _ op in
+  let sub := @ZnZ.sub _ op in
+  let ddivn1 :=
+    DoubleDivn1.double_divn1 zd zero ww head0 add_mul_div div21 compare sub in
+  fun m x y => let (u,v) := ddivn1 (S m) x y in (mk_t_w' n m u, mk_t n v).
+
+ Let div_gtnm n m wx wy :=
+    let mn := Max.max n m in
+    let d := diff n m in
+    let op := make_op mn in
+    let (q, r):= ZnZ.div_gt
+         (castm (diff_r n m) (extend_tr wx (snd d)))
+         (castm (diff_l n m) (extend_tr wy (fst d))) in
+    (reduce_n mn q, reduce_n mn r).
+
+ Local Notation div_gt_folded :=
+   (iter _
+     (fun n => let div_gt := ZnZ.div_gt in
+       fun x y => let (u,v) := div_gt x y in (reduce n u, reduce n v))
+     (fun n =>
+       let div_gt := ZnZ.div_gt in
+       fun m x y =>
+         let y' := DoubleBase.get_low (zeron n) (S m) y in
+         let (u,v) := div_gt x y' in (reduce n u, reduce n v))
+      wn_divn1
+      div_gtnm).
+
+ Definition div_gt :=
+  Eval lazy beta iota delta
+   [iter dom_op dom_t reduce zeron wn_divn1 mk_t_w' mk_t] in
+  div_gt_folded.
+
+ Lemma div_gt_fold : div_gt = div_gt_folded.
+ Proof.
+  lazy beta iota delta [iter dom_op dom_t reduce zeron wn_divn1 mk_t_w' mk_t].
+  reflexivity.
+ Qed.
+
+ Lemma spec_get_endn: forall n m x y,
+  eval n m x  <= [mk_t n y] ->
+   [mk_t n (DoubleBase.get_low (zeron n) m x)] = eval n m x.
+ Proof.
+  intros n m x y H.
+  unfold eval. rewrite nmake_double.
+  rewrite spec_mk_t in *.
+  apply DoubleBase.spec_get_low.
+  apply spec_zeron.
+  exact ZnZ.spec_to_Z.
+  apply Z.le_lt_trans with (ZnZ.to_Z y); auto.
+    rewrite <- nmake_double; auto.
+  case (ZnZ.spec_to_Z y); auto.
+ Qed.
 
- Theorem spec_power: forall x n, [power x n] = [x] ^ Z_of_N n.
+ Let spec_divn1 n :=
+   DoubleDivn1.spec_double_divn1
+    (ZnZ.zdigits (dom_op n)) (ZnZ.zero:dom_t n)
+    ZnZ.WW ZnZ.head0
+    ZnZ.add_mul_div ZnZ.div21
+    ZnZ.compare ZnZ.sub ZnZ.to_Z
+    ZnZ.spec_to_Z
+    ZnZ.spec_zdigits
+    ZnZ.spec_0 ZnZ.spec_WW ZnZ.spec_head0
+    ZnZ.spec_add_mul_div ZnZ.spec_div21
+    ZnZ.spec_compare ZnZ.spec_sub.
+
+ Lemma spec_div_gt_aux : forall x y, [x] > [y] -> 0 < [y] ->
+   let (q,r) := div_gt x y in
+   [x] = [q] * [y] + [r] /\ 0 <= [r] < [y].
  Proof.
- destruct n; simpl. apply (spec_1 w0_spec).
- apply spec_power_pos.
+  intros x y. rewrite div_gt_fold. apply spec_iter; clear x y.
+   intros n x y H1 H2. simpl.
+    generalize (ZnZ.spec_div_gt x y H1 H2); case ZnZ.div_gt.
+    intros u v. rewrite 2 spec_reduce. auto.
+   intros n m x y H1 H2. cbv zeta beta.
+    generalize (ZnZ.spec_div_gt x
+                (DoubleBase.get_low (zeron n) (S m) y)).
+    case ZnZ.div_gt.
+    intros u v H3; repeat rewrite spec_reduce.
+    generalize (spec_get_endn n (S m) y x). rewrite !spec_mk_t. intros H4.
+    rewrite H4 in H3; auto with zarith.
+   intros n m x y H1 H2.
+    generalize (spec_divn1 n (S m) x y H2).
+    unfold wn_divn1; case DoubleDivn1.double_divn1.
+    intros u v H3.
+    rewrite spec_mk_t_w', spec_mk_t.
+    rewrite <- !nmake_double in H3; auto.
+   intros n m x y H1 H2; unfold div_gtnm.
+    generalize (ZnZ.spec_div_gt
+                   (castm (diff_r n m)
+                     (extend_tr x (snd (diff n m))))
+                   (castm (diff_l n m)
+                     (extend_tr y (fst (diff n m))))).
+    case ZnZ.div_gt.
+    intros xx yy HH.
+    repeat rewrite spec_reduce_n.
+    rewrite (spec_cast_l n m x), (spec_cast_r n m y).
+    unfold to_Z; apply HH.
+    rewrite (spec_cast_l n m x) in H1; auto.
+    rewrite (spec_cast_r n m y) in H1; auto.
+    rewrite (spec_cast_r n m y) in H2; auto.
  Qed.
 
+ Theorem spec_div_gt: forall x y, [x] > [y] -> 0 < [y] ->
+  let (q,r) := div_gt x y in
+  [q] = [x] / [y] /\ [r] = [x] mod [y].
+ Proof.
+  intros x y H1 H2; generalize (spec_div_gt_aux x y H1 H2); case div_gt.
+  intros q r (H3, H4); split.
+  apply (Zdiv_unique [x] [y] [q] [r]); auto.
+  rewrite Z.mul_comm; auto.
+  apply (Zmod_unique [x] [y] [q] [r]); auto.
+  rewrite Z.mul_comm; auto.
+ Qed.
 
- (** * Div *)
+ (** * General Division *)
 
- Definition div_eucl x y :=
-  if eq_bool y zero then (zero,zero) else
+ Definition div_eucl (x y : t) : t * t :=
+  if eqb y zero then (zero,zero) else
   match compare x y with
   | Eq => (one, zero)
   | Lt => (zero, x)
@@ -136,49 +595,123 @@ Module Make (Import W0:CyclicType) <: NType.
 
  Theorem spec_div_eucl: forall x y,
       let (q,r) := div_eucl x y in
-      ([q], [r]) = Zdiv_eucl [x] [y].
+      ([q], [r]) = Z.div_eucl [x] [y].
  Proof.
- assert (F0: [zero] = 0).
-   exact (spec_0 w0_spec).
- assert (F1: [one] = 1).
-   exact (spec_1 w0_spec).
  intros x y. unfold div_eucl.
- generalize (spec_eq_bool_aux y zero). destruct eq_bool; rewrite F0.
- intro H. rewrite H. destruct [x]; auto.
- intro H'.
- assert (0 < [y]) by (generalize (spec_pos y); auto with zarith).
+ rewrite spec_eqb, spec_compare, spec_0.
+ case Z.eqb_spec.
+ intros ->. rewrite spec_0. destruct [x]; auto.
+ intros H'.
+ assert (H : 0 < [y]) by (generalize (spec_pos y); auto with zarith).
  clear H'.
- generalize (spec_compare_aux x y); case compare; try rewrite F0;
-   try rewrite F1; intros; auto with zarith.
- rewrite H0; generalize (Z_div_same [y] (Zlt_gt _ _ H))
-                        (Z_mod_same [y] (Zlt_gt _ _ H));
-  unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto.
- assert (F2: 0 <= [x] < [y]).
-   generalize (spec_pos x); auto.
- generalize (Zdiv_small _ _ F2)
-            (Zmod_small _ _ F2);
-  unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto.
- generalize (spec_div_gt _ _ H0 H); auto.
- unfold Zdiv, Zmod; case Zdiv_eucl; case div_gt.
+ case Z.compare_spec; intros Cmp;
+   rewrite ?spec_0, ?spec_1; intros; auto with zarith.
+ rewrite Cmp; generalize (Z_div_same [y] (Z.lt_gt _ _ H))
+                         (Z_mod_same [y] (Z.lt_gt _ _ H));
+  unfold Z.div, Z.modulo; case Z.div_eucl; intros; subst; auto.
+ assert (LeLt: 0 <= [x] < [y]) by (generalize (spec_pos x); auto).
+ generalize (Zdiv_small _ _ LeLt) (Zmod_small _ _ LeLt);
+  unfold Z.div, Z.modulo; case Z.div_eucl; intros; subst; auto.
+ generalize (spec_div_gt _ _ (Z.lt_gt _ _ Cmp) H); auto.
+ unfold Z.div, Z.modulo; case Z.div_eucl; case div_gt.
  intros a b c d (H1, H2); subst; auto.
  Qed.
 
- Definition div x y := fst (div_eucl x y).
+ Definition div (x y : t) : t := fst (div_eucl x y).
 
  Theorem spec_div:
    forall x y, [div x y] = [x] / [y].
  Proof.
  intros x y; unfold div; generalize (spec_div_eucl x y);
    case div_eucl; simpl fst.
- intros xx yy; unfold Zdiv; case Zdiv_eucl; intros qq rr H;
+ intros xx yy; unfold Z.div; case Z.div_eucl; intros qq rr H;
   injection H; auto.
  Qed.
 
+ (** * Modulo by a smaller number *)
+
+ Definition wn_modn1 n :=
+  let op := dom_op n in
+  let zd := ZnZ.zdigits op in
+  let zero := @ZnZ.zero _ op in
+  let head0 := @ZnZ.head0 _ op in
+  let add_mul_div := @ZnZ.add_mul_div _ op in
+  let div21 := @ZnZ.div21 _ op in
+  let compare := @ZnZ.compare _ op in
+  let sub := @ZnZ.sub _ op in
+  let dmodn1 :=
+    DoubleDivn1.double_modn1 zd zero head0 add_mul_div div21 compare sub in
+  fun m x y => reduce n (dmodn1 (S m) x y).
+
+ Let mod_gtnm n m wx wy :=
+    let mn := Max.max n m in
+    let d := diff n m in
+    let op := make_op mn in
+    reduce_n mn (ZnZ.modulo_gt
+         (castm (diff_r n m) (extend_tr wx (snd d)))
+         (castm (diff_l n m) (extend_tr wy (fst d)))).
+
+ Local Notation mod_gt_folded :=
+   (iter _
+      (fun n => let modulo_gt := ZnZ.modulo_gt in
+        fun x y => reduce n (modulo_gt x y))
+      (fun n => let modulo_gt := ZnZ.modulo_gt in
+        fun m x y =>
+          reduce n (modulo_gt x (DoubleBase.get_low (zeron n) (S m) y)))
+      wn_modn1
+      mod_gtnm).
+
+ Definition mod_gt :=
+  Eval lazy beta iota delta [iter dom_op dom_t reduce wn_modn1 zeron] in
+  mod_gt_folded.
+
+ Lemma mod_gt_fold : mod_gt = mod_gt_folded.
+ Proof.
+  lazy beta iota delta [iter dom_op dom_t reduce wn_modn1 zeron].
+  reflexivity.
+ Qed.
+
+ Let spec_modn1 n :=
+   DoubleDivn1.spec_double_modn1
+    (ZnZ.zdigits (dom_op n)) (ZnZ.zero:dom_t n)
+    ZnZ.WW ZnZ.head0
+    ZnZ.add_mul_div ZnZ.div21
+    ZnZ.compare ZnZ.sub ZnZ.to_Z
+    ZnZ.spec_to_Z
+    ZnZ.spec_zdigits
+    ZnZ.spec_0 ZnZ.spec_WW ZnZ.spec_head0
+    ZnZ.spec_add_mul_div ZnZ.spec_div21
+    ZnZ.spec_compare ZnZ.spec_sub.
+
+ Theorem spec_mod_gt:
+   forall x y, [x] > [y] -> 0 < [y] -> [mod_gt x y] = [x] mod [y].
+ Proof.
+ intros x y. rewrite mod_gt_fold. apply spec_iter; clear x y.
+ intros n x y H1 H2. simpl. rewrite spec_reduce.
+   exact (ZnZ.spec_modulo_gt x y H1 H2).
+ intros n m x y H1 H2. cbv zeta beta. rewrite spec_reduce.
+  rewrite <- spec_mk_t in H1.
+  rewrite <- (spec_get_endn n (S m) y x); auto with zarith.
+  rewrite spec_mk_t.
+  apply ZnZ.spec_modulo_gt; auto.
+  rewrite <- (spec_get_endn n (S m) y x), !spec_mk_t in H1; auto with zarith.
+  rewrite <- (spec_get_endn n (S m) y x), !spec_mk_t in H2; auto with zarith.
+ intros n m x y H1 H2. unfold wn_modn1. rewrite spec_reduce.
+  unfold eval; rewrite nmake_double.
+  apply (spec_modn1 n); auto.
+ intros n m x y H1 H2; unfold mod_gtnm.
+  repeat rewrite spec_reduce_n.
+  rewrite (spec_cast_l n m x), (spec_cast_r n m y).
+  unfold to_Z; apply ZnZ.spec_modulo_gt.
+  rewrite (spec_cast_l n m x) in H1; auto.
+  rewrite (spec_cast_r n m y) in H1; auto.
+  rewrite (spec_cast_r n m y) in H2; auto.
+ Qed.
 
- (** * Modulo *)
+ (** * General Modulo *)
 
- Definition modulo x y :=
-  if eq_bool y zero then zero else
+ Definition modulo (x y : t) : t :=
+  if eqb y zero then zero else
   match compare x y with
   | Eq => zero
   | Lt => x
@@ -188,25 +721,130 @@ Module Make (Import W0:CyclicType) <: NType.
  Theorem spec_modulo:
    forall x y, [modulo x y] = [x] mod [y].
  Proof.
- assert (F0: [zero] = 0).
-   exact (spec_0 w0_spec).
- assert (F1: [one] = 1).
-   exact (spec_1 w0_spec).
  intros x y. unfold modulo.
- generalize (spec_eq_bool_aux y zero). destruct eq_bool; rewrite F0.
- intro H; rewrite H. destruct [x]; auto.
+ rewrite spec_eqb, spec_compare, spec_0.
+ case Z.eqb_spec.
+ intros ->; rewrite spec_0. destruct [x]; auto.
  intro H'.
  assert (H : 0 < [y]) by (generalize (spec_pos y); auto with zarith).
  clear H'.
- generalize (spec_compare_aux x y); case compare; try rewrite F0;
-   try rewrite F1; intros; try split; auto with zarith.
- rewrite H0; apply sym_equal; apply Z_mod_same; auto with zarith.
- apply sym_equal; apply Zmod_small; auto with zarith.
+ case Z.compare_spec;
+   rewrite ?spec_0, ?spec_1; intros; try split; auto with zarith.
+ rewrite H0; symmetry; apply Z_mod_same; auto with zarith.
+ symmetry; apply Zmod_small; auto with zarith.
  generalize (spec_pos x); auto with zarith.
- apply spec_mod_gt; auto.
+ apply spec_mod_gt; auto with zarith.
+ Qed.
+
+ (** * Square *)
+
+ Local Notation squaren := (fun n =>
+   let square_c := ZnZ.square_c in
+   fun x => reduce (S n) (succ_t _ (square_c x))).
+
+ Definition square : t -> t := Eval red_t in iter_t squaren.
+
+ Lemma square_fold : square = iter_t squaren.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_square: forall x, [square x] = [x] * [x].
+ Proof.
+  intros x. rewrite square_fold. destr_t x as (n,x).
+  rewrite spec_succ_t. exact (ZnZ.spec_square_c x).
+ Qed.
+
+ (** * Square Root *)
+
+ Local Notation sqrtn := (fun n =>
+   let sqrt := ZnZ.sqrt in
+   fun x => reduce n (sqrt x)).
+
+ Definition sqrt : t -> t := Eval red_t in iter_t sqrtn.
+
+ Lemma sqrt_fold : sqrt = iter_t sqrtn.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_sqrt_aux: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2.
+ Proof.
+  intros x. rewrite sqrt_fold. destr_t x as (n,x). exact (ZnZ.spec_sqrt x).
+ Qed.
+
+ Theorem spec_sqrt: forall x, [sqrt x] = Z.sqrt [x].
+ Proof.
+  intros x.
+  symmetry. apply Z.sqrt_unique.
+  rewrite <- ! Z.pow_2_r. apply spec_sqrt_aux.
+ Qed.
+
+ (** * Power *)
+
+ Fixpoint pow_pos (x:t)(p:positive) : t :=
+  match p with
+  | xH => x
+  | xO p => square (pow_pos x p)
+  | xI p => mul (square (pow_pos x p)) x
+  end.
+
+ Theorem spec_pow_pos: forall x n, [pow_pos x n] = [x] ^ Zpos n.
+ Proof.
+ intros x n; generalize x; elim n; clear n x; simpl pow_pos.
+ intros; rewrite spec_mul; rewrite spec_square; rewrite H.
+ rewrite Pos2Z.inj_xI; rewrite Zpower_exp; auto with zarith.
+ rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r; auto with zarith.
+ rewrite Z.pow_2_r; rewrite Z.pow_1_r; auto.
+ intros; rewrite spec_square; rewrite H.
+ rewrite Pos2Z.inj_xO; auto with zarith.
+ rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r; auto with zarith.
+ rewrite Z.pow_2_r; auto.
+ intros; rewrite Z.pow_1_r; auto.
+ Qed.
+
+ Definition pow_N (x:t)(n:N) : t := match n with
+  | BinNat.N0 => one
+  | BinNat.Npos p => pow_pos x p
+ end.
+
+ Theorem spec_pow_N: forall x n, [pow_N x n] = [x] ^ Z.of_N n.
+ Proof.
+ destruct n; simpl. apply spec_1.
+ apply spec_pow_pos.
+ Qed.
+
+ Definition pow (x y:t) : t := pow_N x (to_N y).
+
+ Theorem spec_pow : forall x y, [pow x y] = [x] ^ [y].
+ Proof.
+ intros. unfold pow, to_N.
+ now rewrite spec_pow_N, Z2N.id by apply spec_pos.
  Qed.
 
 
+ (** * digits
+
+     Number of digits in the representation of a numbers
+     (including head zero's).
+     NB: This function isn't a morphism for setoid [eq].
+ *)
+
+ Local Notation digitsn := (fun n =>
+   let digits := ZnZ.digits (dom_op n) in
+   fun _ => digits).
+
+ Definition digits : t -> positive := Eval red_t in iter_t digitsn.
+
+ Lemma digits_fold : digits = iter_t digitsn.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_digits: forall x, 0 <= [x] < 2 ^ Zpos (digits x).
+ Proof.
+ intros x. rewrite digits_fold. destr_t x as (n,x). exact (ZnZ.spec_to_Z x).
+ Qed.
+
+ Lemma digits_level : forall x, digits x = ZnZ.digits (dom_op (level x)).
+ Proof.
+ intros x. rewrite digits_fold. unfold level. destr_t x as (n,x). reflexivity.
+ Qed.
+
  (** * Gcd *)
 
  Definition gcd_gt_body a b cont :=
@@ -226,19 +864,16 @@ Module Make (Import W0:CyclicType) <: NType.
          Zis_gcd  [a1] [b1] [cont a1 b1]) ->
       Zis_gcd [a] [b] [gcd_gt_body a b cont].
  Proof.
- assert (F1: [zero] = 0).
-   unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto.
  intros a b cont p H2 H3 H4; unfold gcd_gt_body.
- generalize (spec_compare_aux b zero); case compare; try rewrite F1.
-   intros HH; rewrite HH; apply Zis_gcd_0.
+ rewrite ! spec_compare, spec_0. case Z.compare_spec.
+  intros ->; apply Zis_gcd_0.
  intros HH; absurd (0 <= [b]); auto with zarith.
  case (spec_digits b); auto with zarith.
- intros H5; generalize (spec_compare_aux (mod_gt a b) zero);
-   case compare; try rewrite F1.
- intros H6; rewrite <- (Zmult_1_r [b]).
+ intros H5; case Z.compare_spec.
+ intros H6; rewrite <- (Z.mul_1_r [b]).
  rewrite (Z_div_mod_eq [a] [b]); auto with zarith.
  rewrite <- spec_mod_gt; auto with zarith.
- rewrite H6; rewrite Zplus_0_r.
+ rewrite H6; rewrite Z.add_0_r.
  apply Zis_gcd_mult; apply Zis_gcd_1.
  intros; apply False_ind.
  case (spec_digits (mod_gt a b)); auto with zarith.
@@ -253,27 +888,22 @@ Module Make (Import W0:CyclicType) <: NType.
    rewrite <- spec_mod_gt; auto with zarith.
  repeat rewrite <- spec_mod_gt; auto with zarith.
  apply H4; auto with zarith.
- apply Zmult_lt_reg_r with 2; auto with zarith.
- apply Zle_lt_trans with ([b] + [mod_gt a b]); auto with zarith.
- apply Zle_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith.
-   apply Zplus_le_compat_r.
- pattern [b] at 1; rewrite <- (Zmult_1_l [b]).
- apply Zmult_le_compat_r; auto with zarith.
- case (Zle_lt_or_eq 0 ([a]/[b])); auto with zarith.
- intros HH; rewrite (Z_div_mod_eq [a] [b]) in H2;
-   try rewrite <- HH in H2; auto with zarith.
- case (Z_mod_lt [a] [b]); auto with zarith.
- rewrite Zmult_comm; rewrite spec_mod_gt; auto with zarith.
- rewrite <- Z_div_mod_eq; auto with zarith.
- pattern 2 at 2; rewrite <- (Zpower_1_r 2).
- rewrite <- Zpower_exp; auto with zarith.
- ring_simplify (p - 1 + 1); auto.
- case (Zle_lt_or_eq 0 p); auto with zarith.
- generalize H3; case p; simpl Zpower; auto with zarith.
- intros HH; generalize H3; rewrite <- HH; simpl Zpower; auto with zarith.
- Qed.
-
- Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) {struct p} : t :=
+ apply Z.mul_lt_mono_pos_r with 2; auto with zarith.
+ apply Z.le_lt_trans with ([b] + [mod_gt a b]); auto with zarith.
+ apply Z.le_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith.
+ - apply Z.add_le_mono_r.
+   rewrite <- (Z.mul_1_l [b]) at 1.
+   apply Z.mul_le_mono_nonneg_r; auto with zarith.
+   change 1 with (Z.succ 0). apply Z.le_succ_l.
+   apply Z.div_str_pos; auto with zarith.
+ - rewrite Z.mul_comm; rewrite spec_mod_gt; auto with zarith.
+   rewrite <- Z_div_mod_eq; auto with zarith.
+   rewrite Z.mul_comm, <- Z.pow_succ_r, Z.sub_1_r, Z.succ_pred; auto.
+   apply Z.le_0_sub. change 1 with (Z.succ 0). apply Z.le_succ_l.
+   destruct p; simpl in H3; auto with zarith.
+ Qed.
+
+ Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) : t :=
   gcd_gt_body a b
     (fun a b =>
        match p with
@@ -294,7 +924,7 @@ Module Make (Import W0:CyclicType) <: NType.
      apply Hrec with (Zpos p + n); auto.
        replace (Zpos p + (Zpos p + n)) with
          (Zpos (xI p) + n  - 1); auto.
-       rewrite Zpos_xI; ring.
+       rewrite Pos2Z.inj_xI; ring.
    intros a2 b2 H9 H10.
      apply Hrec with n; auto.
  intros p Hrec n a b cont H2 H3 H4.
@@ -303,23 +933,18 @@ Module Make (Import W0:CyclicType) <: NType.
      apply Hrec with (Zpos p + n - 1); auto.
        replace (Zpos p + (Zpos p + n - 1)) with
          (Zpos (xO p) + n  - 1); auto.
-       rewrite Zpos_xO; ring.
+       rewrite Pos2Z.inj_xO; ring.
    intros a2 b2 H9 H10.
      apply Hrec with (n - 1); auto.
        replace (Zpos p + (n - 1)) with
          (Zpos p + n  - 1); auto with zarith.
    intros a3 b3 H12 H13; apply H4; auto with zarith.
-    apply Zlt_le_trans with (1 := H12).
-    case (Zle_or_lt 1 n); intros HH.
-    apply Zpower_le_monotone; auto with zarith.
-    apply Zle_trans with 0; auto with zarith.
-    assert (HH1: n - 1 < 0); auto with zarith.
-    generalize HH1; case (n - 1); auto with zarith.
-    intros p1 HH2; discriminate.
+    apply Z.lt_le_trans with (1 := H12).
+    apply Z.pow_le_mono_r; auto with zarith.
  intros n a b cont H H2 H3.
   simpl gcd_gt_aux.
   apply Zspec_gcd_gt_body with (n + 1); auto with zarith.
-  rewrite Zplus_comm; auto.
+  rewrite Z.add_comm; auto.
   intros a1 b1 H5 H6; apply H3; auto.
   replace n with (n + 1 - 1); auto; try ring.
  Qed.
@@ -333,192 +958,699 @@ Module Make (Import W0:CyclicType) <: NType.
  Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b.
 
  Theorem spec_gcd_gt: forall a b,
-   [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b].
+   [a] > [b] -> [gcd_gt a b] = Z.gcd [a] [b].
  Proof.
  intros a b H2.
  case (spec_digits (gcd_gt a b)); intros H3 H4.
  case (spec_digits a); intros H5 H6.
- apply sym_equal; apply Zis_gcd_gcd; auto with zarith.
+ symmetry; apply Zis_gcd_gcd; auto with zarith.
  unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith.
- intros a1 a2; rewrite Zpower_0_r.
+ intros a1 a2; rewrite Z.pow_0_r.
  case (spec_digits a2); intros H7 H8;
    intros; apply False_ind; auto with zarith.
  Qed.
 
- Definition gcd a b :=
+ Definition gcd (a b : t) : t :=
   match compare a b with
   | Eq => a
   | Lt => gcd_gt b a
   | Gt => gcd_gt a b
   end.
 
- Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b].
+ Theorem spec_gcd: forall a b, [gcd a b] = Z.gcd [a] [b].
  Proof.
  intros a b.
  case (spec_digits a); intros H1 H2.
  case (spec_digits b); intros H3 H4.
- unfold gcd; generalize (spec_compare_aux a b); case compare.
- intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto.
+ unfold gcd. rewrite spec_compare. case Z.compare_spec.
+ intros HH; rewrite HH; symmetry; apply Zis_gcd_gcd; auto.
    apply Zis_gcd_refl.
- intros; apply trans_equal with (Zgcd [b] [a]).
+ intros; transitivity (Z.gcd [b] [a]).
    apply spec_gcd_gt; auto with zarith.
  apply Zis_gcd_gcd; auto with zarith.
- apply Zgcd_is_pos.
+ apply Z.gcd_nonneg.
  apply Zis_gcd_sym; apply Zgcd_is_gcd.
- intros; apply spec_gcd_gt; auto.
+ intros; apply spec_gcd_gt; auto with zarith.
  Qed.
 
+ (** * Parity test *)
+
+ Definition even : t -> bool := Eval red_t in
+   iter_t (fun n x => ZnZ.is_even x).
+
+ Definition odd x := negb (even x).
+
+ Lemma even_fold : even = iter_t (fun n x => ZnZ.is_even x).
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_even_aux: forall x,
+   if even x then [x] mod 2 = 0 else [x] mod 2 = 1.
+ Proof.
+ intros x. rewrite even_fold. destr_t x as (n,x).
+ exact (ZnZ.spec_is_even x).
+ Qed.
+
+ Theorem spec_even: forall x, even x = Z.even [x].
+ Proof.
+ intros x. assert (H := spec_even_aux x). symmetry.
+ rewrite (Z.div_mod [x] 2); auto with zarith.
+ destruct (even x); rewrite H, ?Z.add_0_r.
+ rewrite Zeven_bool_iff. apply Zeven_2p.
+ apply not_true_is_false. rewrite Zeven_bool_iff.
+ apply Zodd_not_Zeven. apply Zodd_2p_plus_1.
+ Qed.
+
+ Theorem spec_odd: forall x, odd x = Z.odd [x].
+ Proof.
+ intros x. unfold odd.
+ assert (H := spec_even_aux x). symmetry.
+ rewrite (Z.div_mod [x] 2); auto with zarith.
+ destruct (even x); rewrite H, ?Z.add_0_r; simpl negb.
+ apply not_true_is_false. rewrite Zodd_bool_iff.
+ apply Zeven_not_Zodd. apply Zeven_2p.
+ apply Zodd_bool_iff. apply Zodd_2p_plus_1.
+ Qed.
 
  (** * Conversion *)
 
- Definition of_N x :=
+ Definition pheight p :=
+   Peano.pred (Pos.to_nat (get_height (ZnZ.digits (dom_op 0)) (plength p))).
+
+ Theorem pheight_correct: forall p,
+    Zpos p < 2 ^ (Zpos (ZnZ.digits (dom_op 0)) * 2 ^ (Z.of_nat (pheight p))).
+ Proof.
+ intros p; unfold pheight.
+ rewrite Nat2Z.inj_pred by apply Pos2Nat.is_pos.
+ rewrite positive_nat_Z.
+ rewrite <- Z.sub_1_r.
+ assert (F2:= (get_height_correct (ZnZ.digits (dom_op 0)) (plength p))).
+ apply Z.lt_le_trans with (Zpos (Pos.succ p)).
+   rewrite Pos2Z.inj_succ; auto with zarith.
+  apply Z.le_trans with (1 := plength_pred_correct (Pos.succ p)).
+ rewrite Pos.pred_succ.
+ apply Z.pow_le_mono_r; auto with zarith.
+ Qed.
+
+ Definition of_pos (x:positive) : t  :=
+  let n := pheight x in
+  reduce n (snd (ZnZ.of_pos x)).
+
+ Theorem spec_of_pos: forall x,
+   [of_pos x] = Zpos x.
+ Proof.
+ intros x; unfold of_pos.
+ rewrite spec_reduce.
+ simpl.
+ apply ZnZ.of_pos_correct.
+ unfold base.
+ apply Z.lt_le_trans with (1 := pheight_correct x).
+ apply Z.pow_le_mono_r; auto with zarith.
+ rewrite (digits_dom_op (_ _)), Pshiftl_nat_Zpower. auto with zarith.
+ Qed.
+
+ Definition of_N (x:N) : t :=
   match x with
   | BinNat.N0 => zero
   | Npos p => of_pos p
   end.
 
  Theorem spec_of_N: forall x,
-   [of_N x] = Z_of_N x.
+   [of_N x] = Z.of_N x.
  Proof.
  intros x; case x.
-  simpl of_N.
-  unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto.
+  simpl of_N. exact spec_0.
  intros p; exact (spec_of_pos p).
  Qed.
 
+ (** * [head0] and [tail0]
 
- (** * Shift *)
+     Number of zero at the beginning and at the end of
+     the representation of the number.
+     NB: these functions are not morphism for setoid [eq].
+ *)
 
- Definition shiftr n x :=
-   match compare n (Ndigits x) with
-   |  Lt => unsafe_shiftr n x
-   | _ => N0 w_0
-   end.
+ Local Notation head0n := (fun n =>
+   let head0 := ZnZ.head0 in
+   fun x => reduce n (head0 x)).
+
+ Definition head0 : t -> t := Eval red_t in iter_t head0n.
+
+ Lemma head0_fold : head0 = iter_t head0n.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_head00: forall x, [x] = 0 -> [head0 x] = Zpos (digits x).
+ Proof.
+ intros x. rewrite head0_fold, digits_fold. destr_t x as (n,x).
+ exact (ZnZ.spec_head00 x).
+ Qed.
+
+ Lemma pow2_pos_minus_1 : forall z, 0<z -> 2^(z-1) = 2^z / 2.
+ Proof.
+  intros. apply Zdiv_unique with 0; auto with zarith.
+  change 2 with (2^1) at 2.
+  rewrite <- Zpower_exp; auto with zarith.
+  rewrite Z.add_0_r. f_equal. auto with zarith.
+ Qed.
+
+ Theorem spec_head0: forall x, 0 < [x] ->
+   2 ^ (Zpos (digits x) - 1) <= 2 ^ [head0 x] * [x] < 2 ^ Zpos (digits x).
+ Proof.
+ intros x. rewrite pow2_pos_minus_1 by (red; auto).
+ rewrite head0_fold, digits_fold. destr_t x as (n,x). exact (ZnZ.spec_head0 x).
+ Qed.
+
+ Local Notation tail0n := (fun n =>
+  let tail0 := ZnZ.tail0 in
+  fun x => reduce n (tail0 x)).
+
+ Definition tail0 : t -> t := Eval red_t in iter_t tail0n.
+
+ Lemma tail0_fold : tail0 = iter_t tail0n.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_tail00: forall x, [x] = 0 -> [tail0 x] = Zpos (digits x).
+ Proof.
+ intros x. rewrite tail0_fold, digits_fold. destr_t x as (n,x).
+ exact (ZnZ.spec_tail00 x).
+ Qed.
+
+ Theorem spec_tail0: forall x,
+   0 < [x] -> exists y, 0 <= y /\ [x] = (2 * y + 1) * 2 ^ [tail0 x].
+ Proof.
+ intros x. rewrite tail0_fold. destr_t x as (n,x). exact (ZnZ.spec_tail0 x).
+ Qed.
+
+ (** * [Ndigits]
+
+     Same as [digits] but encoded using large integers
+     NB: this function is not a morphism for setoid [eq].
+ *)
+
+ Local Notation Ndigitsn := (fun n =>
+  let d := reduce n (ZnZ.zdigits (dom_op n)) in
+  fun _ => d).
+
+ Definition Ndigits : t -> t := Eval red_t in iter_t Ndigitsn.
+
+ Lemma Ndigits_fold : Ndigits = iter_t Ndigitsn.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_Ndigits: forall x, [Ndigits x] = Zpos (digits x).
+ Proof.
+ intros x. rewrite Ndigits_fold, digits_fold. destr_t x as (n,x).
+ apply ZnZ.spec_zdigits.
+ Qed.
+
+ (** * Binary logarithm *)
+
+ Local Notation log2n := (fun n =>
+  let op := dom_op n in
+  let zdigits := ZnZ.zdigits op in
+  let head0 := ZnZ.head0 in
+  let sub_carry := ZnZ.sub_carry in
+  fun x => reduce n (sub_carry zdigits (head0 x))).
+
+ Definition log2 : t -> t := Eval red_t in
+   let log2 := iter_t log2n in
+   fun x => if eqb x zero then zero else log2 x.
+
+ Lemma log2_fold :
+   log2 = fun x => if eqb x zero then zero else iter_t log2n x.
+ Proof. red_t; reflexivity. Qed.
+
+ Lemma spec_log2_0 : forall x, [x] = 0 -> [log2 x] = 0.
+ Proof.
+ intros x H. rewrite log2_fold.
+ rewrite spec_eqb, H. rewrite spec_0. simpl. exact spec_0.
+ Qed.
+
+ Lemma head0_zdigits : forall n (x : dom_t n),
+  0 < ZnZ.to_Z x ->
+  ZnZ.to_Z (ZnZ.head0 x) < ZnZ.to_Z (ZnZ.zdigits (dom_op n)).
+ Proof.
+ intros n x H.
+ destruct (ZnZ.spec_head0 x H) as (_,H0).
+ intros.
+ assert (H1 := ZnZ.spec_to_Z (ZnZ.head0 x)).
+ assert (H2 := ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))).
+ unfold base in *.
+ rewrite ZnZ.spec_zdigits in H2 |- *.
+ set (h := ZnZ.to_Z (ZnZ.head0 x)) in *; clearbody h.
+ set (d := ZnZ.digits (dom_op n)) in *; clearbody d.
+ destruct (Z_lt_le_dec h (Zpos d)); auto. exfalso.
+ assert (1 * 2^Zpos d <= ZnZ.to_Z x * 2^h).
+  apply Z.mul_le_mono_nonneg; auto with zarith.
+  apply Z.pow_le_mono_r; auto with zarith.
+ rewrite Z.mul_comm in H0. auto with zarith.
+ Qed.
+
+ Lemma spec_log2_pos : forall x, [x]<>0 ->
+   2^[log2 x] <= [x] < 2^([log2 x]+1).
+ Proof.
+ intros x H. rewrite log2_fold.
+ rewrite spec_eqb. rewrite spec_0.
+ case Z.eqb_spec.
+ auto with zarith.
+ clear H.
+ destr_t x as (n,x). intros H.
+ rewrite ZnZ.spec_sub_carry.
+ assert (H0 := ZnZ.spec_to_Z x).
+ assert (H1 := ZnZ.spec_to_Z (ZnZ.head0 x)).
+ assert (H2 := ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))).
+ assert (H3 := head0_zdigits n x).
+ rewrite Zmod_small by auto with zarith.
+ rewrite Z.sub_simpl_r.
+ rewrite (Z.mul_lt_mono_pos_l (2^(ZnZ.to_Z (ZnZ.head0 x))));
+  auto with zarith.
+ rewrite (Z.mul_le_mono_pos_l _ _ (2^(ZnZ.to_Z (ZnZ.head0 x))));
+  auto with zarith.
+ rewrite <- 2 Zpower_exp; auto with zarith.
+ rewrite !Z.add_sub_assoc, !Z.add_simpl_l.
+ rewrite ZnZ.spec_zdigits.
+ rewrite pow2_pos_minus_1 by (red; auto).
+ apply ZnZ.spec_head0; auto with zarith.
+ Qed.
+
+ Lemma spec_log2 : forall x, [log2 x] = Z.log2 [x].
+ Proof.
+  intros. destruct (Z_lt_ge_dec 0 [x]).
+  symmetry. apply Z.log2_unique. apply spec_pos.
+  apply spec_log2_pos. intro EQ; rewrite EQ in *; auto with zarith.
+  rewrite spec_log2_0. rewrite Z.log2_nonpos; auto with zarith.
+  generalize (spec_pos x); auto with zarith.
+ Qed.
+
+ Lemma log2_digits_head0 : forall x, 0 < [x] ->
+   [log2 x] = Zpos (digits x) - [head0 x] - 1.
+ Proof.
+ intros. rewrite log2_fold.
+ rewrite spec_eqb. rewrite spec_0.
+ case Z.eqb_spec.
+ auto with zarith.
+ intros _. revert H. rewrite digits_fold, head0_fold. destr_t x as (n,x).
+ rewrite ZnZ.spec_sub_carry.
+ intros.
+ generalize (head0_zdigits n x H).
+ generalize (ZnZ.spec_to_Z (ZnZ.head0 x)).
+ generalize (ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))).
+ rewrite ZnZ.spec_zdigits. intros. apply Zmod_small.
+ auto with zarith.
+ Qed.
+
+ (** * Right shift *)
+
+ Local Notation shiftrn := (fun n =>
+   let op := dom_op n in
+   let zdigits := ZnZ.zdigits op in
+   let sub_c := ZnZ.sub_c in
+   let add_mul_div := ZnZ.add_mul_div in
+   let zzero := ZnZ.zero in
+   fun x p => match sub_c zdigits p with
+   | C0 d => reduce n (add_mul_div d zzero x)
+   | C1 _ => zero
+   end).
+
+ Definition shiftr : t -> t -> t := Eval red_t in
+   same_level shiftrn.
+
+ Lemma shiftr_fold : shiftr = same_level shiftrn.
+ Proof. red_t; reflexivity. Qed.
+
+ Lemma div_pow2_bound :forall x y z,
+   0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z.
+ Proof.
+   intros x y z HH HH1 HH2.
+   split; auto with zarith.
+   apply Z.le_lt_trans with (2 := HH2); auto with zarith.
+   apply Zdiv_le_upper_bound; auto with zarith.
+   pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith.
+   apply Z.mul_le_mono_nonneg_l; auto.
+   apply Z.pow_le_mono_r; auto with zarith.
+   rewrite Z.pow_0_r; ring.
+ Qed.
+
+ Theorem spec_shiftr_pow2 : forall x n,
+  [shiftr x n] = [x] / 2 ^ [n].
+ Proof.
+  intros x y. rewrite shiftr_fold. apply spec_same_level. clear x y.
+  intros n x p. simpl.
+  assert (Hx := ZnZ.spec_to_Z x).
+  assert (Hy := ZnZ.spec_to_Z p).
+  generalize (ZnZ.spec_sub_c (ZnZ.zdigits (dom_op n)) p).
+  case ZnZ.sub_c; intros d H; unfold interp_carry in *; simpl.
+  (** Subtraction without underflow : [ p <= digits ] *)
+  rewrite spec_reduce.
+  rewrite ZnZ.spec_zdigits in H.
+  rewrite ZnZ.spec_add_mul_div by auto with zarith.
+  rewrite ZnZ.spec_0, Z.mul_0_l, Z.add_0_l.
+  rewrite Zmod_small.
+  f_equal. f_equal. auto with zarith.
+  split. auto with zarith.
+  apply div_pow2_bound; auto with zarith.
+  (** Subtraction with underflow : [ digits < p ] *)
+  rewrite ZnZ.spec_0. symmetry.
+  apply Zdiv_small.
+  split; auto with zarith.
+  apply Z.lt_le_trans with (base (ZnZ.digits (dom_op n))); auto with zarith.
+  unfold base. apply Z.pow_le_mono_r; auto with zarith.
+  rewrite ZnZ.spec_zdigits in H.
+  generalize (ZnZ.spec_to_Z d); auto with zarith.
+ Qed.
+
+ Lemma spec_shiftr: forall x p, [shiftr x p] = Z.shiftr [x] [p].
+ Proof.
+  intros.
+  now rewrite spec_shiftr_pow2, Z.shiftr_div_pow2 by apply spec_pos.
+ Qed.
+
+ (** * Left shift *)
+
+ (** First an unsafe version, working correctly only if
+     the representation is large enough *)
+
+ Local Notation unsafe_shiftln := (fun n =>
+   let op := dom_op n in
+   let add_mul_div := ZnZ.add_mul_div in
+   let zero := ZnZ.zero in
+   fun x p => reduce n (add_mul_div p x zero)).
+
+ Definition unsafe_shiftl : t -> t -> t := Eval red_t in
+   same_level unsafe_shiftln.
+
+ Lemma unsafe_shiftl_fold : unsafe_shiftl = same_level unsafe_shiftln.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_unsafe_shiftl_aux : forall x p K,
+  0 <= K ->
+  [x] < 2^K ->
+  [p] + K <= Zpos (digits x) ->
+  [unsafe_shiftl x p] = [x] * 2 ^ [p].
+ Proof.
+ intros x p.
+ rewrite unsafe_shiftl_fold. rewrite digits_level.
+ apply spec_same_level_dep.
+ intros n m z z' r LE H K HK H1 H2. apply (H K); auto.
+  transitivity (Zpos (ZnZ.digits (dom_op n))); auto.
+  apply digits_dom_op_incr; auto.
+ clear x p.
+ intros n x p K HK Hx Hp. simpl. rewrite spec_reduce.
+ destruct (ZnZ.spec_to_Z x).
+ destruct (ZnZ.spec_to_Z p).
+ rewrite ZnZ.spec_add_mul_div by (omega with *).
+ rewrite ZnZ.spec_0, Zdiv_0_l, Z.add_0_r.
+ apply Zmod_small. unfold base.
+ split; auto with zarith.
+ rewrite Z.mul_comm.
+ apply Z.lt_le_trans with (2^(ZnZ.to_Z p + K)).
+ rewrite Zpower_exp; auto with zarith.
+ apply Z.mul_lt_mono_pos_l; auto with zarith.
+ apply Z.pow_le_mono_r; auto with zarith.
+ Qed.
+
+ Theorem spec_unsafe_shiftl: forall x p,
+  [p] <= [head0 x] -> [unsafe_shiftl x p] = [x] * 2 ^ [p].
+ Proof.
+ intros.
+ destruct (Z.eq_dec [x] 0) as [EQ|NEQ].
+ (* [x] = 0 *)
+ apply spec_unsafe_shiftl_aux with 0; auto with zarith.
+ now rewrite EQ.
+ rewrite spec_head00 in *; auto with zarith.
+ (* [x] <> 0 *)
+ apply spec_unsafe_shiftl_aux with ([log2 x] + 1); auto with zarith.
+ generalize (spec_pos (log2 x)); auto with zarith.
+ destruct (spec_log2_pos x); auto with zarith.
+ rewrite log2_digits_head0; auto with zarith.
+ generalize (spec_pos x); auto with zarith.
+ Qed.
+
+ (** Then we define a function doubling the size of the representation
+     but without changing the value of the number. *)
+
+ Local Notation double_size_n := (fun n =>
+  let zero := ZnZ.zero in
+  fun x => mk_t_S n (WW zero x)).
+
+ Definition double_size : t -> t := Eval red_t in
+   iter_t double_size_n.
+
+ Lemma double_size_fold : double_size = iter_t double_size_n.
+ Proof. red_t; reflexivity. Qed.
 
- Theorem spec_shiftr: forall n x,
-   [shiftr n x] = [x] / 2 ^ [n].
- Proof.
- intros n x; unfold shiftr;
-    generalize (spec_compare_aux n (Ndigits x)); case compare; intros H.
- apply trans_equal with (1 := spec_0 w0_spec).
- apply sym_equal; apply Zdiv_small; rewrite H.
- rewrite spec_Ndigits; exact (spec_digits x).
- rewrite <- spec_unsafe_shiftr; auto with zarith.
- apply trans_equal with (1 := spec_0 w0_spec).
- apply sym_equal; apply Zdiv_small.
- rewrite spec_Ndigits in H; case (spec_digits x); intros H1 H2.
- split; auto.
- apply Zlt_le_trans with (1 := H2).
- apply Zpower_le_monotone; auto with zarith.
- Qed.
-
- Definition shiftl_aux_body cont n x :=
-   match compare n (head0 x)  with
-      Gt => cont n (double_size x)
-   |  _ => unsafe_shiftl n x
+ Lemma double_size_level : forall x, level (double_size x) = S (level x).
+ Proof.
+ intros x. rewrite double_size_fold; unfold level at 2. destr_t x as (n,x).
+ apply mk_t_S_level.
+ Qed.
+
+ Theorem spec_double_size_digits:
+   forall x, Zpos (digits (double_size x)) = 2 * (Zpos (digits x)).
+ Proof.
+ intros x. rewrite ! digits_level, double_size_level.
+ rewrite 2 digits_dom_op, 2 Pshiftl_nat_Zpower,
+         Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith.
+ ring.
+ Qed.
+
+ Theorem spec_double_size: forall x, [double_size x] = [x].
+ Proof.
+ intros x. rewrite double_size_fold. destr_t x as (n,x).
+ rewrite spec_mk_t_S. simpl. rewrite ZnZ.spec_0. auto with zarith.
+ Qed.
+
+ Theorem spec_double_size_head0:
+   forall x, 2 * [head0 x] <= [head0 (double_size x)].
+ Proof.
+ intros x.
+ assert (F1:= spec_pos (head0 x)).
+ assert (F2: 0 < Zpos (digits x)).
+   red; auto.
+ assert (HH := spec_pos x). Z.le_elim HH.
+ generalize HH; rewrite <- (spec_double_size x); intros HH1.
+ case (spec_head0 x HH); intros _ HH2.
+ case (spec_head0 _ HH1).
+ rewrite (spec_double_size x); rewrite (spec_double_size_digits x).
+ intros HH3 _.
+ case (Z.le_gt_cases ([head0 (double_size x)]) (2 * [head0 x])); auto; intros HH4.
+ absurd (2 ^ (2 * [head0 x] )* [x] < 2 ^ [head0 (double_size x)] * [x]); auto.
+ apply Z.le_ngt.
+ apply Z.mul_le_mono_nonneg_r; auto with zarith.
+ apply Z.pow_le_mono_r; auto; auto with zarith.
+ assert (HH5: 2 ^[head0 x] <= 2 ^(Zpos (digits x) - 1)).
+ { apply Z.le_succ_l in HH. change (1 <= [x]) in HH.
+   Z.le_elim HH.
+   - apply Z.mul_le_mono_pos_r with (2 ^ 1); auto with zarith.
+     rewrite <- (fun x y z => Z.pow_add_r x (y - z)); auto with zarith.
+     rewrite Z.sub_add.
+     apply Z.le_trans with (2 := Z.lt_le_incl _ _ HH2).
+     apply Z.mul_le_mono_nonneg_l; auto with zarith.
+     rewrite Z.pow_1_r; auto with zarith.
+   - apply Z.pow_le_mono_r; auto with zarith.
+     case (Z.le_gt_cases (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6.
+     absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith.
+     rewrite <- HH; rewrite Z.mul_1_r.
+     apply Z.pow_le_mono_r; auto with zarith. }
+ rewrite (Z.mul_comm 2).
+ rewrite Z.pow_mul_r; auto with zarith.
+ rewrite Z.pow_2_r.
+ apply Z.lt_le_trans with (2 := HH3).
+ rewrite <- Z.mul_assoc.
+ replace (2 * Zpos (digits x) - 1) with
+   ((Zpos (digits x) - 1) + (Zpos (digits x))).
+ rewrite Zpower_exp; auto with zarith.
+ apply Zmult_lt_compat2; auto with zarith.
+ split; auto with zarith.
+ apply Z.mul_pos_pos; auto with zarith.
+ rewrite Pos2Z.inj_xO; ring.
+ apply Z.lt_le_incl; auto.
+ repeat rewrite spec_head00; auto.
+ rewrite spec_double_size_digits.
+ rewrite Pos2Z.inj_xO; auto with zarith.
+ rewrite spec_double_size; auto.
+ Qed.
+
+ Theorem spec_double_size_head0_pos:
+   forall x, 0 < [head0 (double_size x)].
+ Proof.
+ intros x.
+ assert (F := Pos2Z.is_pos (digits x)).
+ assert (F0 := spec_pos (head0 (double_size x))).
+ Z.le_elim F0; auto.
+ assert (F1 := spec_pos (head0 x)).
+ Z.le_elim F1.
+  apply Z.lt_le_trans with (2 := (spec_double_size_head0 x)); auto with zarith.
+ assert (F3 := spec_pos x).
+ Z.le_elim F3.
+ generalize F3; rewrite <- (spec_double_size x); intros F4.
+ absurd (2 ^ (Zpos (xO (digits x)) - 1) < 2 ^ (Zpos (digits x))).
+ { apply Z.le_ngt.
+   apply Z.pow_le_mono_r; auto with zarith.
+   rewrite Pos2Z.inj_xO; auto with zarith. }
+ case (spec_head0 x F3).
+ rewrite <- F1; rewrite Z.pow_0_r; rewrite Z.mul_1_l; intros _ HH.
+ apply Z.le_lt_trans with (2 := HH).
+ case (spec_head0 _ F4).
+ rewrite (spec_double_size x); rewrite (spec_double_size_digits x).
+ rewrite <- F0; rewrite Z.pow_0_r; rewrite Z.mul_1_l; auto.
+ generalize F1; rewrite (spec_head00 _ (eq_sym F3)); auto with zarith.
+ Qed.
+
+ (** Finally we iterate [double_size] enough before [unsafe_shiftl]
+     in order to get a fully correct [shiftl]. *)
+
+ Definition shiftl_aux_body cont x n :=
+   match compare n (head0 x) with
+      Gt => cont (double_size x) n
+   |  _ => unsafe_shiftl x n
    end.
 
- Theorem spec_shiftl_aux_body: forall n p x cont,
+ Theorem spec_shiftl_aux_body: forall n x p cont,
        2^ Zpos p  <=  [head0 x]  ->
       (forall x, 2 ^ (Zpos p + 1) <= [head0 x]->
-         [cont n x] = [x] * 2 ^ [n]) ->
-      [shiftl_aux_body cont n x] = [x] * 2 ^ [n].
+         [cont x n] = [x] * 2 ^ [n]) ->
+      [shiftl_aux_body cont x n] = [x] * 2 ^ [n].
  Proof.
- intros n p x cont H1 H2; unfold shiftl_aux_body.
- generalize (spec_compare_aux n (head0 x)); case compare; intros H.
+ intros n x p cont H1 H2; unfold shiftl_aux_body.
+ rewrite spec_compare; case Z.compare_spec; intros H.
   apply spec_unsafe_shiftl; auto with zarith.
   apply spec_unsafe_shiftl; auto with zarith.
  rewrite H2.
  rewrite spec_double_size; auto.
- rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith.
- apply Zle_trans with (2 := spec_double_size_head0 x).
- rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith.
+ rewrite Z.add_comm; rewrite Zpower_exp; auto with zarith.
+ apply Z.le_trans with (2 := spec_double_size_head0 x).
+ rewrite Z.pow_1_r; apply Z.mul_le_mono_nonneg_l; auto with zarith.
  Qed.
 
- Fixpoint shiftl_aux p cont n x  {struct p} :=
+ Fixpoint shiftl_aux p cont x n :=
    shiftl_aux_body
-       (fun n x => match p with
-        | xH => cont n x
-        | xO p => shiftl_aux p (shiftl_aux p cont) n x
-        | xI p => shiftl_aux p (shiftl_aux p cont) n x
-        end) n x.
+       (fun x n => match p with
+        | xH => cont x n
+        | xO p => shiftl_aux p (shiftl_aux p cont) x n
+        | xI p => shiftl_aux p (shiftl_aux p cont) x n
+        end) x n.
 
- Theorem spec_shiftl_aux: forall p q n x cont,
+ Theorem spec_shiftl_aux: forall p q x n cont,
     2 ^ (Zpos q) <= [head0 x] ->
       (forall x, 2 ^ (Zpos p + Zpos q) <= [head0 x] ->
-         [cont n x] = [x] * 2 ^ [n]) ->
-      [shiftl_aux p cont n x] = [x] * 2 ^ [n].
+         [cont x n] = [x] * 2 ^ [n]) ->
+      [shiftl_aux p cont x n] = [x] * 2 ^ [n].
  Proof.
  intros p; elim p; unfold shiftl_aux; fold shiftl_aux; clear p.
- intros p Hrec q n x cont H1 H2.
+ intros p Hrec q x n cont H1 H2.
  apply spec_shiftl_aux_body with (q); auto.
  intros x1 H3; apply Hrec with (q + 1)%positive; auto.
  intros x2 H4; apply Hrec with (p + q + 1)%positive; auto.
- rewrite <- Pplus_assoc.
- rewrite Zpos_plus_distr; auto.
+ rewrite <- Pos.add_assoc.
+ rewrite Pos2Z.inj_add; auto.
  intros x3 H5; apply H2.
- rewrite Zpos_xI.
+ rewrite Pos2Z.inj_xI.
  replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1));
    auto.
- repeat rewrite Zpos_plus_distr; ring.
+ rewrite !Pos2Z.inj_add; ring.
  intros p Hrec q n x cont H1 H2.
  apply spec_shiftl_aux_body with (q); auto.
  intros x1 H3; apply Hrec with (q); auto.
- apply Zle_trans with (2 := H3); auto with zarith.
- apply Zpower_le_monotone; auto with zarith.
+ apply Z.le_trans with (2 := H3); auto with zarith.
+ apply Z.pow_le_mono_r; auto with zarith.
  intros x2 H4; apply Hrec with (p + q)%positive; auto.
  intros x3 H5; apply H2.
- rewrite (Zpos_xO p).
+ rewrite (Pos2Z.inj_xO p).
  replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q));
    auto.
- repeat rewrite Zpos_plus_distr; ring.
+ rewrite Pos2Z.inj_add; ring.
  intros q n x cont H1 H2.
  apply spec_shiftl_aux_body with (q); auto.
- rewrite Zplus_comm; auto.
+ rewrite Z.add_comm; auto.
  Qed.
 
- Definition shiftl n x :=
+ Definition shiftl x n :=
   shiftl_aux_body
    (shiftl_aux_body
-    (shiftl_aux (digits n) unsafe_shiftl)) n x.
+    (shiftl_aux (digits n) unsafe_shiftl)) x n.
 
- Theorem spec_shiftl: forall n x,
-   [shiftl n x] = [x] * 2 ^ [n].
+ Theorem spec_shiftl_pow2 : forall x n,
+   [shiftl x n] = [x] * 2 ^ [n].
  Proof.
- intros n x; unfold shiftl, shiftl_aux_body.
- generalize (spec_compare_aux n (head0 x)); case compare; intros H.
+ intros x n; unfold shiftl, shiftl_aux_body.
+ rewrite spec_compare; case Z.compare_spec; intros H.
   apply spec_unsafe_shiftl; auto with zarith.
   apply spec_unsafe_shiftl; auto with zarith.
  rewrite <- (spec_double_size x).
- generalize (spec_compare_aux n (head0 (double_size x))); case compare; intros H1.
+ rewrite spec_compare; case Z.compare_spec; intros H1.
   apply spec_unsafe_shiftl; auto with zarith.
   apply spec_unsafe_shiftl; auto with zarith.
  rewrite <- (spec_double_size (double_size x)).
  apply spec_shiftl_aux with 1%positive.
- apply Zle_trans with (2 := spec_double_size_head0 (double_size x)).
+ apply Z.le_trans with (2 := spec_double_size_head0 (double_size x)).
  replace (2 ^ 1) with (2 * 1).
- apply Zmult_le_compat_l; auto with zarith.
+ apply Z.mul_le_mono_nonneg_l; auto with zarith.
  generalize (spec_double_size_head0_pos x); auto with zarith.
- rewrite Zpower_1_r; ring.
+ rewrite Z.pow_1_r; ring.
  intros x1 H2; apply spec_unsafe_shiftl.
- apply Zle_trans with (2 := H2).
- apply Zle_trans with (2 ^ Zpos (digits n)); auto with zarith.
+ apply Z.le_trans with (2 := H2).
+ apply Z.le_trans with (2 ^ Zpos (digits n)); auto with zarith.
  case (spec_digits n); auto with zarith.
- apply Zpower_le_monotone; auto with zarith.
+ apply Z.pow_le_mono_r; auto with zarith.
  Qed.
 
+ Lemma spec_shiftl: forall x p, [shiftl x p] = Z.shiftl [x] [p].
+ Proof.
+  intros.
+  now rewrite spec_shiftl_pow2, Z.shiftl_mul_pow2 by apply spec_pos.
+ Qed.
 
- (** * Zero and One *)
+ (** Other bitwise operations *)
 
- Theorem spec_0: [zero] = 0.
+ Definition testbit x n := odd (shiftr x n).
+
+ Lemma spec_testbit: forall x p, testbit x p = Z.testbit [x] [p].
  Proof.
- exact (spec_0 w0_spec).
+  intros. unfold testbit. symmetry.
+  rewrite spec_odd, spec_shiftr. apply Z.testbit_odd.
  Qed.
 
- Theorem spec_1: [one] = 1.
+ Definition div2 x := shiftr x one.
+
+ Lemma spec_div2: forall x, [div2 x] = Z.div2 [x].
+ Proof.
+  intros. unfold div2. symmetry.
+  rewrite spec_shiftr, spec_1. apply Z.div2_spec.
+ Qed.
+
+ (** TODO : provide efficient versions instead of just converting
+   from/to N (see with Laurent) *)
+
+ Definition lor x y := of_N (N.lor (to_N x) (to_N y)).
+ Definition land x y := of_N (N.land (to_N x) (to_N y)).
+ Definition ldiff x y := of_N (N.ldiff (to_N x) (to_N y)).
+ Definition lxor x y := of_N (N.lxor (to_N x) (to_N y)).
+
+ Lemma spec_land: forall x y, [land x y] = Z.land [x] [y].
  Proof.
- exact (spec_1 w0_spec).
+  intros x y. unfold land. rewrite spec_of_N. unfold to_N.
+  generalize (spec_pos x), (spec_pos y).
+  destruct [x], [y]; trivial; (now destruct 1) || (now destruct 2).
  Qed.
 
+ Lemma spec_lor: forall x y, [lor x y] = Z.lor [x] [y].
+ Proof.
+  intros x y. unfold lor. rewrite spec_of_N. unfold to_N.
+  generalize (spec_pos x), (spec_pos y).
+  destruct [x], [y]; trivial; (now destruct 1) || (now destruct 2).
+ Qed.
+
+ Lemma spec_ldiff: forall x y, [ldiff x y] = Z.ldiff [x] [y].
+ Proof.
+  intros x y. unfold ldiff. rewrite spec_of_N. unfold to_N.
+  generalize (spec_pos x), (spec_pos y).
+  destruct [x], [y]; trivial; (now destruct 1) || (now destruct 2).
+ Qed.
+
+ Lemma spec_lxor: forall x y, [lxor x y] = Z.lxor [x] [y].
+ Proof.
+  intros x y. unfold lxor. rewrite spec_of_N. unfold to_N.
+  generalize (spec_pos x), (spec_pos y).
+  destruct [x], [y]; trivial; (now destruct 1) || (now destruct 2).
+ Qed.
 
 End Make.
diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml
index 67a62c40..278cc8bf 100644
--- a/theories/Numbers/Natural/BigN/NMake_gen.ml
+++ b/theories/Numbers/Natural/BigN/NMake_gen.ml
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,100 +8,88 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: NMake_gen.ml 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(*S NMake_gen.ml : this file generates NMake_gen.v *)
 
-(*S NMake_gen.ml : this file generates NMake.v *)
 
-
-(*s The two parameters that control the generation: *)
+(*s The parameter that control the generation: *)
 
 let size = 6 (* how many times should we repeat the Z/nZ --> Z/2nZ
                 process before relying on a generic construct *)
-let gen_proof = true  (* should we generate proofs ? *)
-
 
 (*s Some utilities *)
 
-let t = "t"
-let c = "N"
-let pz n = if n == 0 then "w_0" else "W0"
-let rec gen2 n = if n == 0 then "1" else if n == 1 then "2"
-                 else "2 * " ^ (gen2 (n - 1))
-let rec genxO n s =
-  if n == 0 then s else " (xO" ^ (genxO (n - 1) s) ^ ")"
+let rec iter_str n s = if n = 0 then "" else (iter_str (n-1) s) ^ s
 
-(* NB: in ocaml >= 3.10, we could use Printf.ifprintf for printing to
-   /dev/null, but for being compatible with earlier ocaml and not
-   relying on system-dependent stuff like open_out "/dev/null",
-   let's use instead a magical hack *)
+let rec iter_str_gen n f = if n < 0 then "" else (iter_str_gen (n-1) f) ^ (f n)
 
-(* Standard printer, with a final newline *)
-let pr s = Printf.printf (s^^"\n")
-(* Printing to /dev/null *)
-let pn = (fun s -> Obj.magic (fun _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> ())
-	  : ('a, out_channel, unit) format -> 'a)
-(* Proof printer : prints iff gen_proof is true *)
-let pp = if gen_proof then pr else pn
-(* Printer for admitted parts : prints iff gen_proof is false *)
-let pa = if not gen_proof then pr else pn
-(* Same as before, but without the final newline *)
-let pr0 = Printf.printf
-let pp0 = if gen_proof then pr0 else pn
+let rec iter_name i j base sep =
+  if i >= j then base^(string_of_int i)
+  else (iter_name i (j-1) base sep)^sep^" "^base^(string_of_int j)
 
+let pr s = Printf.printf (s^^"\n")
 
 (*s The actual printing *)
 
 let _ =
 
-  pr "(************************************************************************)";
-  pr "(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)";
-  pr "(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)";
-  pr "(*   \\VV/  **************************************************************)";
-  pr "(*    //   *      This file is distributed under the terms of the       *)";
-  pr "(*         *       GNU Lesser General Public License Version 2.1        *)";
-  pr "(************************************************************************)";
-  pr "(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)";
-  pr "(************************************************************************)";
-  pr "";
-  pr "(** * NMake *)";
-  pr "";
-  pr "(** From a cyclic Z/nZ representation to arbitrary precision natural numbers.*)";
-  pr "";
-  pr "(** Remark: File automatically generated by NMake_gen.ml, DO NOT EDIT ! *)";
-  pr "";
-  pr "Require Import BigNumPrelude ZArith CyclicAxioms";
-  pr " DoubleType DoubleMul DoubleDivn1 DoubleCyclic Nbasic";
-  pr " Wf_nat StreamMemo.";
-  pr "";
-  pr "Module Make (Import W0:CyclicType).";
-  pr "";
+pr
+"(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
+(*   \\VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+(*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
+(************************************************************************)
 
-  pr " Definition w0 := W0.w.";
-  for i = 1 to size do
-    pr " Definition w%i := zn2z w%i." i (i-1)
-  done;
-  pr "";
+(** * NMake_gen *)
 
-  pr " Definition w0_op := W0.w_op.";
-  for i = 1 to 3 do
-    pr " Definition w%i_op := mk_zn2z_op w%i_op." i (i-1)
-  done;
-  for i = 4 to size + 3 do
-    pr " Definition w%i_op := mk_zn2z_op_karatsuba w%i_op." i (i-1)
-  done;
-  pr "";
+(** From a cyclic Z/nZ representation to arbitrary precision natural numbers.*)
+
+(** Remark: File automatically generated by NMake_gen.ml, DO NOT EDIT ! *)
+
+Require Import BigNumPrelude ZArith Ndigits CyclicAxioms
+ DoubleType DoubleMul DoubleDivn1 DoubleCyclic Nbasic
+ Wf_nat StreamMemo.
+
+Module Make (W0:CyclicType) <: NAbstract.
+
+ (** * The word types *)
+";
+
+pr " Local Notation w0 := W0.t.";
+for i = 1 to size do
+  pr " Definition w%i := zn2z w%i." i (i-1)
+done;
+pr "";
+
+pr " (** * The operation type classes for the word types *)
+";
+
+pr " Local Notation w0_op := W0.ops.";
+for i = 1 to min 3 size do
+  pr " Instance w%i_op : ZnZ.Ops w%i := mk_zn2z_ops w%i_op." i i (i-1)
+done;
+for i = 4 to size do
+  pr " Instance w%i_op : ZnZ.Ops w%i := mk_zn2z_ops_karatsuba w%i_op." i i (i-1)
+done;
+for i = size+1 to size+3 do
+  pr " Instance w%i_op : ZnZ.Ops (word w%i %i) := mk_zn2z_ops_karatsuba w%i_op." i size (i-size) (i-1)
+done;
+pr "";
 
   pr " Section Make_op.";
-  pr "  Variable mk : forall w', znz_op w' -> znz_op (zn2z w').";
+  pr "  Variable mk : forall w', ZnZ.Ops w' -> ZnZ.Ops (zn2z w').";
   pr "";
-  pr "  Fixpoint make_op_aux (n:nat) : znz_op (word w%i (S n)):=" size;
-  pr "   match n return znz_op (word w%i (S n)) with" size;
+  pr "  Fixpoint make_op_aux (n:nat) : ZnZ.Ops (word w%i (S n)):=" size;
+  pr "   match n return ZnZ.Ops (word w%i (S n)) with" size;
   pr "   | O => w%i_op" (size+1);
   pr "   | S n1 =>";
-  pr "     match n1 return znz_op (word w%i (S (S n1))) with" size;
+  pr "     match n1 return ZnZ.Ops (word w%i (S (S n1))) with" size;
   pr "     | O => w%i_op" (size+2);
   pr "     | S n2 =>";
-  pr "       match n2 return znz_op (word w%i (S (S (S n2)))) with" size;
+  pr "       match n2 return ZnZ.Ops (word w%i (S (S (S n2)))) with" size;
   pr "       | O => w%i_op" (size+3);
   pr "       | S n3 => mk _ (mk _ (mk _ (make_op_aux n3)))";
   pr "       end";
@@ -110,2565 +98,912 @@ let _ =
   pr "";
   pr " End Make_op.";
   pr "";
-  pr " Definition omake_op := make_op_aux mk_zn2z_op_karatsuba.";
+  pr " Definition omake_op := make_op_aux mk_zn2z_ops_karatsuba.";
   pr "";
   pr "";
   pr " Definition make_op_list := dmemo_list _ omake_op.";
   pr "";
-  pr " Definition make_op n := dmemo_get _ omake_op n make_op_list.";
-  pr "";
-  pr " Lemma make_op_omake: forall n, make_op n = omake_op n.";
-  pr " intros n; unfold make_op, make_op_list.";
-  pr " refine (dmemo_get_correct _ _ _).";
-  pr " Qed.";
+  pr " Instance make_op n : ZnZ.Ops (word w%i (S n))" size;
+  pr "  := dmemo_get _ omake_op n make_op_list.";
   pr "";
 
-  pr " Inductive %s_ :=" t;
-  for i = 0 to size do
-    pr "  | %s%i : w%i -> %s_" c i i t
-  done;
-  pr "  | %sn : forall n, word w%i (S n) -> %s_." c size t;
-  pr "";
-  pr " Definition %s := %s_." t t;
-  pr "";
-  pr " Definition w_0 := w0_op.(znz_0).";
-  pr "";
+pr " Ltac unfold_ops := unfold omake_op, make_op_aux, w%i_op, w%i_op." (size+3) (size+2);
 
-  for i = 0 to size do
-    pr " Definition one%i := w%i_op.(znz_1)." i i
-  done;
-  pr "";
+pr
+"
+ Lemma make_op_omake: forall n, make_op n = omake_op n.
+ Proof.
+ intros n; unfold make_op, make_op_list.
+ refine (dmemo_get_correct _ _ _).
+ Qed.
 
+ Theorem make_op_S: forall n,
+   make_op (S n) = mk_zn2z_ops_karatsuba (make_op n).
+ Proof.
+ intros n. do 2 rewrite make_op_omake.
+ revert n. fix IHn 1.
+ do 3 (destruct n; [unfold_ops; reflexivity|]).
+ simpl mk_zn2z_ops_karatsuba. simpl word in *.
+ rewrite <- (IHn n). auto.
+ Qed.
 
-  pr " Definition zero := %s0 w_0." c;
-  pr " Definition one := %s0 one0." c;
-  pr "";
+ (** * The main type [t], isomorphic with [exists n, word w0 n] *)
+";
 
-  pr " Definition to_Z x :=";
-  pr "  match x with";
+  pr " Inductive t' :=";
   for i = 0 to size do
-    pr "  | %s%i wx => w%i_op.(znz_to_Z) wx" c i i
+    pr "  | N%i : w%i -> t'" i i
   done;
-  pr "  | %sn n wx => (make_op n).(znz_to_Z) wx" c;
-  pr "  end.";
+  pr "  | Nn : forall n, word w%i (S n) -> t'." size;
   pr "";
-
-  pr " Open Scope Z_scope.";
-  pr " Notation \"[ x ]\" := (to_Z x).";
-  pr "";
-
-  pr " Definition to_N x := Zabs_N (to_Z x).";
+  pr " Definition t := t'.";
   pr "";
-
-  pr " Definition eq x y := (to_Z x = to_Z y).";
-  pr "";
-
-  pp " (* Regular make op (no karatsuba) *)";
-  pp " Fixpoint nmake_op (ww:Type) (ww_op: znz_op ww) (n: nat) :";
-  pp "       znz_op (word ww n) :=";
-  pp "  match n return znz_op (word ww n) with";
-  pp "   O => ww_op";
-  pp "  | S n1 => mk_zn2z_op (nmake_op ww ww_op n1)";
-  pp "  end.";
-  pp "";
-  pp " (* Simplification by rewriting for nmake_op *)";
-  pp " Theorem nmake_op_S: forall ww (w_op: znz_op ww) x,";
-  pp "   nmake_op _ w_op (S x) = mk_zn2z_op (nmake_op _ w_op x).";
-  pp " auto.";
-  pp " Qed.";
-  pp "";
-
-
-  pr " (* Eval and extend functions for each level *)";
-  for i = 0 to size do
-    pp " Let nmake_op%i := nmake_op _ w%i_op." i i;
-    pp " Let eval%in n := znz_to_Z  (nmake_op%i n)." i i;
-    if i == 0 then
-      pr " Let extend%i := DoubleBase.extend  (WW w_0)." i
-    else
-      pr " Let extend%i := DoubleBase.extend  (WW (W0: w%i))." i i;
-  done;
+  pr " Bind Scope abstract_scope with t t'.";
   pr "";
 
-
-  pp " Theorem digits_doubled:forall n ww (w_op: znz_op ww),";
-  pp "    znz_digits (nmake_op _ w_op n) =";
-  pp "    DoubleBase.double_digits (znz_digits w_op) n.";
-  pp " Proof.";
-  pp " intros n; elim n; auto; clear n.";
-  pp " intros n Hrec ww ww_op; simpl DoubleBase.double_digits.";
-  pp " rewrite <- Hrec; auto.";
-  pp " Qed.";
-  pp "";
-  pp " Theorem nmake_double: forall n ww (w_op: znz_op ww),";
-  pp "    znz_to_Z (nmake_op _ w_op n) =";
-  pp "    @DoubleBase.double_to_Z _ (znz_digits w_op) (znz_to_Z w_op) n.";
-  pp " Proof.";
-  pp " intros n; elim n; auto; clear n.";
-  pp " intros n Hrec ww ww_op; simpl DoubleBase.double_to_Z; unfold zn2z_to_Z.";
-  pp " rewrite <- Hrec; auto.";
-  pp " unfold DoubleBase.double_wB; rewrite <- digits_doubled; auto.";
-  pp " Qed.";
-  pp "";
-
-
-  pp " Theorem digits_nmake:forall n ww (w_op: znz_op ww),";
-  pp "    znz_digits (nmake_op _ w_op (S n)) =";
-  pp "    xO (znz_digits (nmake_op _ w_op n)).";
-  pp " Proof.";
-  pp " auto.";
-  pp " Qed.";
-  pp "";
-
-
-  pp " Theorem znz_nmake_op: forall ww ww_op n xh xl,";
-  pp "  znz_to_Z (nmake_op ww ww_op (S n)) (WW xh xl) =";
-  pp "   znz_to_Z (nmake_op ww ww_op n) xh *";
-  pp "    base (znz_digits (nmake_op ww ww_op n)) +";
-  pp "   znz_to_Z (nmake_op ww ww_op n) xl.";
-  pp " Proof.";
-  pp " auto.";
-  pp " Qed.";
-  pp "";
-
-  pp " Theorem make_op_S: forall n,";
-  pp "   make_op (S n) = mk_zn2z_op_karatsuba (make_op n).";
-  pp " intro n.";
-  pp " do 2 rewrite make_op_omake.";
-  pp " pattern n; apply lt_wf_ind; clear n.";
-  pp " intros n; case n; clear n.";
-  pp "   intros _; unfold omake_op, make_op_aux, w%i_op; apply refl_equal." (size + 2);
-  pp " intros n; case n; clear n.";
-  pp "   intros _; unfold omake_op, make_op_aux, w%i_op; apply refl_equal." (size + 3);
-  pp " intros n; case n; clear n.";
-  pp "   intros _; unfold omake_op, make_op_aux, w%i_op, w%i_op; apply refl_equal." (size + 3) (size + 2);
-  pp " intros n Hrec.";
-  pp "   change (omake_op (S (S (S (S n))))) with";
-  pp "          (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op (S n))))).";
-  pp "   change (omake_op (S (S (S n)))) with";
-  pp "         (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op n)))).";
-  pp "   rewrite Hrec; auto with arith.";
-  pp " Qed.";
-  pp "";
-
-
-  for i = 1 to size + 2 do
-    pp " Let znz_to_Z_%i: forall x y," i;
-    pp "   znz_to_Z w%i_op (WW x y) =" i;
-    pp "    znz_to_Z w%i_op x * base (znz_digits w%i_op) + znz_to_Z w%i_op y." (i-1) (i-1) (i-1);
-    pp " Proof.";
-    pp " auto.";
-    pp " Qed.";
-    pp "";
-  done;
-
-  pp " Let znz_to_Z_n: forall n x y,";
-  pp "   znz_to_Z (make_op (S n)) (WW x y) =";
-  pp "    znz_to_Z (make_op n) x * base (znz_digits (make_op n)) + znz_to_Z (make_op n) y.";
-  pp " Proof.";
-  pp " intros n x y; rewrite make_op_S; auto.";
-  pp " Qed.";
-  pp "";
-
-  pp " Let w0_spec: znz_spec w0_op := W0.w_spec.";
-  for i = 1 to 3 do
-    pp " Let w%i_spec: znz_spec w%i_op := mk_znz2_spec w%i_spec." i i (i-1)
-  done;
-  for i = 4 to size + 3 do
-    pp " Let w%i_spec : znz_spec w%i_op := mk_znz2_karatsuba_spec w%i_spec." i i (i-1)
-  done;
-  pp "";
-
-  pp " Let wn_spec: forall n, znz_spec (make_op n).";
-  pp "  intros n; elim n; clear n.";
-  pp "    exact w%i_spec." (size + 1);
-  pp "  intros n Hrec; rewrite make_op_S.";
-  pp "  exact (mk_znz2_karatsuba_spec Hrec).";
-  pp " Qed.";
-  pp "";
-
-  for i = 0 to size do
-    pr " Definition w%i_eq0 := w%i_op.(znz_eq0)." i i;
-    pr " Let spec_w%i_eq0: forall x, if w%i_eq0 x then [%s%i x] = 0 else True." i i c i;
-    pa " Admitted.";
-    pp " Proof.";
-    pp " intros x; unfold w%i_eq0, to_Z; generalize (spec_eq0 w%i_spec x);" i i;
-    pp "    case znz_eq0; auto.";
-    pp " Qed.";
-    pr "";
-  done;
+  pr " (** * A generic toolbox for building and deconstructing [t] *)";
   pr "";
 
-
-  for i = 0 to size do
-    pp " Theorem digits_w%i:  znz_digits w%i_op = znz_digits (nmake_op _ w0_op %i)." i i i;
-    if i == 0 then
-      pp " auto."
-    else
-      pp " rewrite digits_nmake; rewrite <- digits_w%i; auto." (i - 1);
-    pp " Qed.";
-    pp "";
-    pp " Let spec_double_eval%in: forall n, eval%in n = DoubleBase.double_to_Z (znz_digits w%i_op) (znz_to_Z w%i_op) n." i i i i;
-    pp " Proof.";
-    pp "  intros n; exact (nmake_double n w%i w%i_op)." i i;
-    pp " Qed.";
-    pp "";
-  done;
-
-  for i = 0 to size do
-    for j = 0 to (size - i) do
-      pp " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i)." i j (i + j) i j;
-      pp " Proof.";
-      if j == 0 then
-        if i == 0 then
-          pp " auto."
-        else
-          begin
-            pp " apply trans_equal with (xO (znz_digits w%i_op))." (i + j -1);
-            pp "  auto.";
-            pp "  unfold nmake_op; auto.";
-          end
-      else
-        begin
-          pp " apply trans_equal with (xO (znz_digits w%i_op))." (i + j -1);
-          pp "  auto.";
-          pp " rewrite digits_nmake.";
-          pp " rewrite digits_w%in%i." i (j - 1);
-          pp " auto.";
-        end;
-      pp " Qed.";
-      pp "";
-      pp " Let spec_eval%in%i: forall x, [%s%i x] = eval%in %i x." i j c (i + j) i j;
-      pp " Proof.";
-      if j == 0 then
-        pp " intros x; rewrite spec_double_eval%in; unfold DoubleBase.double_to_Z, to_Z; auto." i
-      else
-        begin
-          pp " intros x; case x.";
-          pp "   auto.";
-          pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (i + j);
-          pp " rewrite digits_w%in%i." i (j - 1);
-          pp " generalize (spec_eval%in%i); unfold to_Z; intros HH; repeat rewrite HH." i (j - 1);
-          pp " unfold eval%in, nmake_op%i." i i;
-          pp " rewrite (znz_nmake_op _ w%i_op %i); auto." i (j - 1);
-        end;
-      pp " Qed.";
-      if i + j <> size  then
-        begin
-          pp " Let spec_extend%in%i: forall x, [%s%i x] = [%s%i (extend%i %i x)]." i (i + j + 1) c i c (i + j + 1) i j;
-          if j == 0 then
-            begin
-              pp " intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x)." i (i + j);
-              pp " unfold to_Z; rewrite znz_to_Z_%i." (i + j + 1);
-              pp " rewrite (spec_0 w%i_spec); auto." (i + j);
-            end
-          else
-            begin
-              pp " intros x; change (extend%i %i x) with (WW (znz_0 w%i_op) (extend%i %i x))." i j (i + j) i (j - 1);
-              pp " unfold to_Z; rewrite znz_to_Z_%i." (i + j + 1);
-              pp " rewrite (spec_0 w%i_spec)." (i + j);
-              pp " generalize (spec_extend%in%i x); unfold to_Z." i (i + j);
-              pp " intros HH; rewrite <- HH; auto.";
-            end;
-          pp " Qed.";
-          pp "";
-        end;
-    done;
-
-    pp " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i)." i (size - i + 1) (size + 1) i (size - i + 1);
-    pp " Proof.";
-    pp " apply trans_equal with (xO (znz_digits w%i_op))." size;
-    pp "  auto.";
-    pp " rewrite digits_nmake.";
-    pp " rewrite digits_w%in%i." i (size - i);
-    pp " auto.";
-    pp " Qed.";
-    pp "";
-
-    pp " Let spec_eval%in%i: forall x, [%sn 0  x] = eval%in %i x." i (size - i + 1) c i (size - i + 1);
-    pp " Proof.";
-    pp " intros x; case x.";
-    pp "   auto.";
-    pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (size + 1);
-    pp " rewrite digits_w%in%i." i (size - i);
-    pp " generalize (spec_eval%in%i); unfold to_Z; intros HH; repeat rewrite HH." i (size - i);
-    pp " unfold eval%in, nmake_op%i." i i;
-    pp " rewrite (znz_nmake_op _ w%i_op %i); auto." i (size - i);
-    pp " Qed.";
-    pp "";
-
-    pp " Let spec_eval%in%i: forall x, [%sn 1  x] = eval%in %i x." i (size - i + 2) c i (size - i + 2);
-    pp " intros x; case x.";
-    pp "   auto.";
-    pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (size + 2);
-    pp " rewrite digits_w%in%i." i (size + 1 - i);
-    pp " generalize (spec_eval%in%i); unfold to_Z; change (make_op 0) with (w%i_op); intros HH; repeat rewrite HH." i (size + 1 - i) (size + 1);
-    pp " unfold eval%in, nmake_op%i." i i;
-    pp " rewrite (znz_nmake_op _ w%i_op %i); auto." i (size + 1 - i);
-    pp " Qed.";
-    pp "";
-  done;
-
-  pp " Let digits_w%in: forall n," size;
-  pp "   znz_digits (make_op n) = znz_digits (nmake_op _ w%i_op (S n))." size;
-  pp " intros n; elim n; clear n.";
-  pp "  change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op))." size;
-  pp "  rewrite nmake_op_S; apply sym_equal; auto.";
-  pp "  intros  n Hrec.";
-  pp "  replace (znz_digits (make_op (S n))) with (xO (znz_digits (make_op n))).";
-  pp "  rewrite Hrec.";
-  pp "  rewrite nmake_op_S; apply sym_equal; auto.";
-  pp "  rewrite make_op_S; apply sym_equal; auto.";
-  pp " Qed.";
-  pp "";
-
-  pp " Let spec_eval%in: forall n x, [%sn n x] = eval%in (S n) x." size c size;
-  pp " intros n; elim n; clear n.";
-  pp "   exact spec_eval%in1." size;
-  pp " intros n Hrec x; case x; clear x.";
-  pp "  unfold to_Z, eval%in, nmake_op%i." size size;
-  pp "    rewrite make_op_S; rewrite nmake_op_S; auto.";
-  pp " intros xh xl.";
-  pp "  unfold to_Z in Hrec |- *.";
-  pp "  rewrite znz_to_Z_n.";
-  pp "  rewrite digits_w%in." size;
-  pp "  repeat rewrite Hrec.";
-  pp "  unfold eval%in, nmake_op%i." size size;
-  pp "  apply sym_equal; rewrite nmake_op_S; auto.";
-  pp " Qed.";
-  pp "";
-
-  pp " Let spec_extend%in: forall n x, [%s%i x] = [%sn n (extend%i n x)]." size c size c size ;
-  pp " intros n; elim n; clear n.";
-  pp "   intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x)." size size;
-  pp "   unfold to_Z.";
-  pp "   change (make_op 0) with w%i_op." (size + 1);
-  pp "   rewrite znz_to_Z_%i; rewrite (spec_0 w%i_spec); auto." (size + 1) size;
-  pp " intros n Hrec x.";
-  pp "   change (extend%i (S n) x) with (WW W0 (extend%i n x))." size size;
-  pp "   unfold to_Z in Hrec |- *; rewrite znz_to_Z_n; auto.";
-  pp "   rewrite <- Hrec.";
-  pp "  replace (znz_to_Z (make_op n) W0) with 0; auto.";
-  pp "  case n; auto; intros; rewrite make_op_S; auto.";
-  pp " Qed.";
-  pp "";
-
-  pr " Theorem spec_pos: forall x, 0 <= [x].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; clear x.";
-  for i = 0 to size do
-    pp " intros x; case (spec_to_Z w%i_spec x); auto." i;
-  done;
-  pp " intros n x; case (spec_to_Z (wn_spec n) x); auto.";
-  pp " Qed.";
+  pr " Local Notation SizePlus n := %sn%s."
+    (iter_str size "(S ") (iter_str size ")");
+  pr " Local Notation Size := (SizePlus O).";
   pr "";
 
-  pp " Let spec_extendn_0: forall n wx, [%sn n (extend n _ wx)] = [%sn 0 wx]." c c;
-  pp " intros n; elim n; auto.";
-  pp " intros n1 Hrec wx; simpl extend; rewrite <- Hrec; auto.";
-  pp " unfold to_Z.";
-  pp " case n1; auto; intros n2; repeat rewrite make_op_S; auto.";
-  pp " Qed.";
-  pp "";
-  pp " Let spec_extendn0_0: forall n wx, [%sn (S n) (WW W0 wx)] = [%sn n wx]." c c;
-  pp " Proof.";
-  pp " intros n x; unfold to_Z.";
-  pp " rewrite znz_to_Z_n.";
-  pp " rewrite <- (Zplus_0_l (znz_to_Z (make_op n) x)).";
-  pp " apply (f_equal2 Zplus); auto.";
-  pp " case n; auto.";
-  pp " intros n1; rewrite make_op_S; auto.";
-  pp " Qed.";
-  pp "";
-  pp " Let spec_extend_tr: forall m n (w: word _ (S n)),";
-  pp " [%sn (m + n) (extend_tr w m)] = [%sn n w]." c c;
-  pp " Proof.";
-  pp " induction m; auto.";
-  pp " intros n x; simpl extend_tr.";
-  pp " simpl plus; rewrite spec_extendn0_0; auto.";
-  pp " Qed.";
-  pp "";
-  pp " Let spec_cast_l: forall n m x1,";
-  pp " [%sn (Max.max n m)" c;
-  pp " (castm (diff_r n m) (extend_tr x1 (snd (diff n m))))] =";
-  pp " [%sn n x1]." c;
-  pp " Proof.";
-  pp " intros n m x1; case (diff_r n m); simpl castm.";
-  pp " rewrite spec_extend_tr; auto.";
-  pp " Qed.";
-  pp "";
-  pp " Let spec_cast_r: forall n m x1,";
-  pp " [%sn (Max.max n m)" c;
-  pp "  (castm (diff_l n m) (extend_tr x1 (fst (diff n m))))] =";
-  pp " [%sn m x1]." c;
-  pp " Proof.";
-  pp " intros n m x1; case (diff_l n m); simpl castm.";
-  pp " rewrite spec_extend_tr; auto.";
-  pp " Qed.";
-  pp "";
-
-
-  pr " Section LevelAndIter.";
-  pr "";
-  pr "  Variable res: Type.";
-  pr "  Variable xxx: res.";
-  pr "  Variable P: Z -> Z -> res -> Prop.";
-  pr "  (* Abstraction function for each level *)";
-  for i = 0 to size do
-    pr "  Variable f%i: w%i -> w%i -> res." i i i;
-    pr "  Variable f%in: forall n, w%i -> word w%i (S n) -> res." i i i;
-    pr "  Variable fn%i: forall n, word w%i (S n) -> w%i -> res." i i i;
-    pp "  Variable Pf%i: forall x y, P [%s%i x] [%s%i y] (f%i x y)." i c i c i i;
-    if i == size then
-      begin
-        pp "  Variable Pf%in: forall n x y, P [%s%i x] (eval%in (S n) y) (f%in n x y)." i c i i i;
-        pp "  Variable Pfn%i: forall n x y, P (eval%in (S n) x) [%s%i y] (fn%i n x y)." i i c i i;
-      end
-    else
-      begin
-        pp "  Variable Pf%in: forall n x y, Z_of_nat n <= %i -> P [%s%i x] (eval%in (S n) y) (f%in n x y)." i (size - i) c i i i;
-        pp "  Variable Pfn%i: forall n x y, Z_of_nat n <= %i -> P (eval%in (S n) x) [%s%i y] (fn%i n x y)." i (size - i) i c i i;
-      end;
-    pr "";
-  done;
-  pr "  Variable fnn: forall n, word w%i (S n) -> word w%i (S n) -> res." size size;
-  pp "  Variable Pfnn: forall n x y, P [%sn n x] [%sn n y] (fnn n x y)." c c;
-  pr "  Variable fnm: forall n m, word w%i (S n) -> word w%i (S m) -> res." size size;
-  pp "  Variable Pfnm: forall n m x y, P [%sn n x] [%sn m y] (fnm n m x y)." c c;
-  pr "";
-  pr "  (* Special zero functions *)";
-  pr "  Variable f0t:  t_ -> res.";
-  pp "  Variable Pf0t: forall x, P 0 [x] (f0t x).";
-  pr "  Variable ft0:  t_ -> res.";
-  pp "  Variable Pft0: forall x, P [x] 0 (ft0 x).";
+  pr " Tactic Notation \"do_size\" tactic(t) := do %i t." (size+1);
   pr "";
 
-
-  pr "  (* We level the two arguments before applying *)";
-  pr "  (* the functions at each leval                *)";
-  pr "  Definition same_level (x y: t_): res :=";
-  pr0 "    Eval lazy zeta beta iota delta [";
-  for i = 0 to size do
-    pr0 "extend%i " i;
-  done;
-  pr "";
-  pr "                                         DoubleBase.extend DoubleBase.extend_aux";
-  pr "                                         ] in";
-  pr "  match x, y with";
+  pr " Definition dom_t n := match n with";
   for i = 0 to size do
-    for j = 0 to i - 1 do
-      pr "  | %s%i wx, %s%i wy => f%i wx (extend%i %i wy)" c i c j i j (i - j -1);
-    done;
-    pr "  | %s%i wx, %s%i wy => f%i wx wy" c i c i i;
-    for j = i + 1 to size do
-      pr "  | %s%i wx, %s%i wy => f%i (extend%i %i wx) wy" c i c j j i (j - i - 1);
-    done;
-    if i == size then
-      pr "  | %s%i wx, %sn m wy => fnn m (extend%i m wx) wy" c size c size
-    else
-      pr "  | %s%i wx, %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy" c i c size i (size - i - 1);
+    pr "  | %i => w%i" i i;
   done;
-  for i = 0 to size do
-    if i == size then
-      pr "  | %sn n wx, %s%i wy => fnn n wx (extend%i n wy)" c c size size
-    else
-      pr "  | %sn n wx, %s%i wy => fnn n wx (extend%i n (extend%i %i wy))" c c i size i (size - i - 1);
-  done;
-  pr "  | %sn n wx, Nn m wy =>" c;
-  pr "    let mn := Max.max n m in";
-  pr "    let d := diff n m in";
-  pr "     fnn mn";
-  pr "       (castm (diff_r n m) (extend_tr wx (snd d)))";
-  pr "       (castm (diff_l n m) (extend_tr wy (fst d)))";
-  pr "  end.";
+  pr "  | %sn => word w%i n" (if size=0 then "" else "SizePlus ") size;
+  pr " end.";
   pr "";
 
-  pp "  Lemma spec_same_level: forall x y, P [x] [y] (same_level x y).";
-  pp "  Proof.";
-  pp "  intros x; case x; clear x; unfold same_level.";
-  for i = 0 to size do
-    pp "    intros x y; case y; clear y.";
-    for j = 0 to i - 1 do
-      pp "     intros y; rewrite spec_extend%in%i; apply Pf%i." j i i;
-    done;
-    pp "     intros y; apply Pf%i." i;
-    for j = i + 1 to size do
-      pp "     intros y; rewrite spec_extend%in%i; apply Pf%i." i j j;
-    done;
-    if i == size then
-      pp "     intros m y; rewrite (spec_extend%in m); apply Pfnn." size
-    else
-      pp "     intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn." i size size;
-  done;
-  pp "    intros n x y; case y; clear y.";
-  for i = 0 to size do
-    if i == size then
-      pp "    intros y; rewrite (spec_extend%in n); apply Pfnn." size
-    else
-      pp "    intros y; rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." i size size;
-  done;
-  pp "    intros m y; rewrite <- (spec_cast_l n m x);";
-  pp "          rewrite <- (spec_cast_r n m y); apply Pfnn.";
-  pp "  Qed.";
-  pp "";
-
-  pr "  (* We level the two arguments before applying      *)";
-  pr "  (* the functions at each level (special zero case) *)";
-  pr "  Definition same_level0 (x y: t_): res :=";
-  pr0 "    Eval lazy zeta beta iota delta [";
-  for i = 0 to size do
-    pr0 "extend%i " i;
-  done;
-  pr "";
-  pr "                                         DoubleBase.extend DoubleBase.extend_aux";
-  pr "                                         ] in";
-  pr "  match x with";
-  for i = 0 to size do
-    pr "  | %s%i wx =>" c i;
-    if i == 0 then
-      pr "    if w0_eq0 wx then f0t y else";
-    pr "    match y with";
-    for j = 0 to i - 1 do
-      pr "    | %s%i wy =>" c j;
-      if j == 0 then
-        pr "       if w0_eq0 wy then ft0 x else";
-      pr "       f%i wx (extend%i %i wy)" i j (i - j -1);
-    done;
-    pr "    | %s%i wy => f%i wx wy" c i i;
-    for j = i + 1 to size do
-      pr "    | %s%i wy => f%i (extend%i %i wx) wy" c j j i (j - i - 1);
-    done;
-    if i == size then
-      pr "    | %sn m wy => fnn m (extend%i m wx) wy" c size
-    else
-      pr "    | %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy" c size i (size - i - 1);
-    pr"    end";
-  done;
-  pr "  |  %sn n wx =>" c;
-  pr "     match y with";
-  for i = 0 to size do
-    pr "     | %s%i wy =>" c i;
-    if i == 0 then
-      pr "      if w0_eq0 wy then ft0 x else";
-    if i == size then
-      pr "      fnn n wx (extend%i n wy)" size
-    else
-      pr "      fnn n wx (extend%i n (extend%i %i wy))" size i (size - i - 1);
-  done;
-  pr "        | %sn m wy =>" c;
-  pr "            let mn := Max.max n m in";
-  pr "            let d := diff n m in";
-  pr "              fnn mn";
-  pr "              (castm (diff_r n m) (extend_tr wx (snd d)))";
-  pr "              (castm (diff_l n m) (extend_tr wy (fst d)))";
-  pr "    end";
-  pr "  end.";
-  pr "";
+pr
+" Instance dom_op n : ZnZ.Ops (dom_t n) | 10.
+ Proof.
+  do_size (destruct n; [simpl;auto with *|]).
+  unfold dom_t. auto with *.
+ Defined.
+";
 
-  pp "  Lemma spec_same_level0: forall x y, P [x] [y] (same_level0 x y).";
-  pp "  Proof.";
-  pp "  intros x; case x; clear x; unfold same_level0.";
-  for i = 0 to size do
-    pp "    intros x.";
-    if i == 0 then
-      begin
-        pp "    generalize (spec_w0_eq0 x); case w0_eq0; intros H.";
-        pp "      intros y; rewrite H; apply Pf0t.";
-        pp "    clear H.";
-      end;
-    pp "    intros y; case y; clear y.";
-    for j = 0 to i - 1 do
-      pp "     intros y.";
-      if j == 0 then
-        begin
-          pp "     generalize (spec_w0_eq0 y); case w0_eq0; intros H.";
-          pp "       rewrite H; apply Pft0.";
-          pp "     clear H.";
-        end;
-      pp "     rewrite spec_extend%in%i; apply Pf%i." j i i;
-    done;
-    pp "     intros y; apply Pf%i." i;
-    for j = i + 1 to size do
-      pp "     intros y; rewrite spec_extend%in%i; apply Pf%i." i j j;
-    done;
-    if i == size then
-      pp "     intros m y; rewrite (spec_extend%in m); apply Pfnn." size
-    else
-      pp "     intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn." i size size;
-  done;
-  pp "    intros n x y; case y; clear y.";
+  pr " Definition iter_t {A:Type}(f : forall n, dom_t n -> A) : t -> A :=";
   for i = 0 to size do
-    pp "    intros y.";
-    if i = 0 then
-      begin
-        pp "     generalize (spec_w0_eq0 y); case w0_eq0; intros H.";
-        pp "       rewrite H; apply Pft0.";
-        pp "     clear H.";
-      end;
-    if i == size then
-      pp "    rewrite (spec_extend%in n); apply Pfnn." size
-    else
-      pp "    rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." i size size;
+   pr "  let f%i := f %i in" i i;
   done;
-  pp "  intros m y; rewrite <- (spec_cast_l n m x);";
-  pp "          rewrite <- (spec_cast_r n m y); apply Pfnn.";
-  pp "  Qed.";
-  pp "";
-
-  pr "  (* We iter the smaller argument with the bigger  *)";
-  pr "  Definition iter (x y: t_): res :=";
-  pr0 "    Eval lazy zeta beta iota delta [";
+  pr "  let fn n := f (SizePlus (S n)) in";
+  pr "  fun x => match x with";
   for i = 0 to size do
-    pr0 "extend%i " i;
+    pr "   | N%i wx => f%i wx" i i;
   done;
-  pr "";
-  pr "                                         DoubleBase.extend DoubleBase.extend_aux";
-  pr "                                         ] in";
-  pr "  match x, y with";
-  for i = 0 to size do
-    for j = 0 to i - 1 do
-      pr "  | %s%i wx, %s%i wy => fn%i %i wx wy" c i c j j (i - j - 1);
-    done;
-    pr "  | %s%i wx, %s%i wy => f%i wx wy" c i c i i;
-    for j = i + 1 to size do
-      pr "  | %s%i wx, %s%i wy => f%in %i wx wy" c i c j i (j - i - 1);
-    done;
-    if i == size then
-      pr "  | %s%i wx, %sn m wy => f%in m wx wy" c size c size
-    else
-      pr "  | %s%i wx, %sn m wy => f%in m (extend%i %i wx) wy" c i c size i (size - i - 1);
-  done;
-  for i = 0 to size do
-    if i == size then
-      pr "  | %sn n wx, %s%i wy => fn%i n wx wy" c c size size
-    else
-      pr "  | %sn n wx, %s%i wy => fn%i n wx (extend%i %i wy)" c c i size i (size - i - 1);
-  done;
-  pr "  | %sn n wx, %sn m wy => fnm n m wx wy" c c;
+  pr "   | Nn n wx => fn n wx";
   pr "  end.";
   pr "";
 
-  pp "  Ltac zg_tac := try";
-  pp "    (red; simpl Zcompare; auto;";
-  pp "     let t := fresh \"H\" in (intros t; discriminate t)).";
-  pp "";
-  pp "  Lemma spec_iter: forall x y, P [x] [y] (iter x y).";
-  pp "  Proof.";
-  pp "  intros x; case x; clear x; unfold iter.";
-  for i = 0 to size do
-    pp "    intros x y; case y; clear y.";
-    for j = 0 to i - 1 do
-      pp "     intros y; rewrite spec_eval%in%i;  apply (Pfn%i %i); zg_tac." j (i - j) j (i - j - 1);
-    done;
-    pp "     intros y; apply Pf%i." i;
-    for j = i + 1 to size do
-      pp "     intros y; rewrite spec_eval%in%i; apply (Pf%in %i); zg_tac." i (j - i) i (j - i - 1);
-    done;
-    if i == size then
-      pp "     intros m y; rewrite spec_eval%in; apply Pf%in." size size
-    else
-      pp "     intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in." i size size size;
-  done;
-  pp "    intros n x y; case y; clear y.";
-  for i = 0 to size do
-    if i == size then
-      pp "     intros y; rewrite spec_eval%in; apply Pfn%i." size size
-    else
-      pp "      intros y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i." i size size size;
-  done;
-  pp "  intros m y; apply Pfnm.";
-  pp "  Qed.";
-  pp "";
-
-
-  pr "  (* We iter the smaller argument with the bigger  (zero case) *)";
-  pr "  Definition iter0 (x y: t_): res :=";
-  pr0 "    Eval lazy zeta beta iota delta [";
-  for i = 0 to size do
-    pr0 "extend%i " i;
-  done;
-  pr "";
-  pr "                                         DoubleBase.extend DoubleBase.extend_aux";
-  pr "                                         ] in";
-  pr "  match x with";
-  for i = 0 to size do
-    pr "  | %s%i wx =>" c i;
-    if i == 0 then
-      pr "    if w0_eq0 wx then f0t y else";
-    pr "    match y with";
-    for j = 0 to i - 1 do
-      pr "    | %s%i wy =>" c j;
-      if j == 0 then
-        pr "       if w0_eq0 wy then ft0 x else";
-      pr "       fn%i %i wx wy" j (i - j - 1);
-    done;
-    pr "    | %s%i wy => f%i wx wy" c i i;
-    for j = i + 1 to size do
-      pr "    | %s%i wy => f%in %i wx wy" c j i (j - i - 1);
-    done;
-    if i == size then
-      pr "    | %sn m wy => f%in m wx wy" c size
-    else
-      pr "    | %sn m wy => f%in m (extend%i %i wx) wy" c size i (size - i - 1);
-    pr "    end";
-  done;
-  pr "  | %sn n wx =>" c;
-  pr "    match y with";
+  pr " Definition mk_t (n:nat) : dom_t n -> t :=";
+  pr "  match n as n' return dom_t n' -> t with";
   for i = 0 to size do
-    pr "    | %s%i wy =>" c i;
-    if i == 0 then
-      pr "      if w0_eq0 wy then ft0 x else";
-    if i == size then
-      pr "      fn%i n wx wy" size
-    else
-      pr "      fn%i n wx (extend%i %i wy)" size i (size - i - 1);
+    pr "   | %i => N%i" i i;
   done;
-  pr "    | %sn m wy => fnm n m wx wy" c;
-  pr "    end";
+  pr "   | %s(S n) => Nn n" (if size=0 then "" else "SizePlus ");
   pr "  end.";
   pr "";
 
-  pp "  Lemma spec_iter0: forall x y, P [x] [y] (iter0 x y).";
-  pp "  Proof.";
-  pp "  intros x; case x; clear x; unfold iter0.";
-  for i = 0 to size do
-    pp "    intros x.";
-    if i == 0 then
-      begin
-        pp "    generalize (spec_w0_eq0 x); case w0_eq0; intros H.";
-        pp "      intros y; rewrite H; apply Pf0t.";
-        pp "    clear H.";
-      end;
-    pp "    intros y; case y; clear y.";
-    for j = 0 to i - 1 do
-      pp "     intros y.";
-      if j == 0 then
-        begin
-          pp "     generalize (spec_w0_eq0 y); case w0_eq0; intros H.";
-          pp "       rewrite H; apply Pft0.";
-          pp "     clear H.";
-        end;
-      pp "     rewrite spec_eval%in%i;  apply (Pfn%i %i); zg_tac." j (i - j) j (i - j - 1);
-    done;
-    pp "     intros y; apply Pf%i." i;
-    for j = i + 1 to size do
-      pp "     intros y; rewrite spec_eval%in%i; apply (Pf%in %i); zg_tac." i (j - i) i (j - i - 1);
-    done;
-    if i == size then
-      pp "     intros m y; rewrite spec_eval%in; apply Pf%in." size size
-    else
-      pp "     intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in." i size size size;
-  done;
-  pp "    intros n x y; case y; clear y.";
-  for i = 0 to size do
-    pp "    intros y.";
-    if i = 0 then
-      begin
-        pp "     generalize (spec_w0_eq0 y); case w0_eq0; intros H.";
-        pp "       rewrite H; apply Pft0.";
-        pp "     clear H.";
-      end;
-    if i == size then
-      pp "     rewrite spec_eval%in; apply Pfn%i." size size
-    else
-      pp "      rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i." i size size size;
-  done;
-  pp "  intros m y; apply Pfnm.";
-  pp "  Qed.";
-  pp "";
-
-
-  pr "  End LevelAndIter.";
-  pr "";
+pr
+" Definition level := iter_t (fun n _ => n).
 
+ Inductive View_t : t -> Prop :=
+  Mk_t : forall n (x : dom_t n), View_t (mk_t n x).
+
+ Lemma destr_t : forall x, View_t x.
+ Proof.
+ intros x. generalize (Mk_t (level x)). destruct x; simpl; auto.
+ Defined.
+
+ Lemma iter_mk_t : forall A (f:forall n, dom_t n -> A),
+ forall n x, iter_t f (mk_t n x) = f n x.
+ Proof.
+ do_size (destruct n; try reflexivity).
+ Qed.
+
+ (** * Projection to ZArith *)
+
+ Definition to_Z : t -> Z :=
+  Eval lazy beta iota delta [iter_t dom_t dom_op] in
+  iter_t (fun _ x => ZnZ.to_Z x).
+
+ Notation \"[ x ]\" := (to_Z x).
+
+ Theorem spec_mk_t : forall n (x:dom_t n), [mk_t n x] = ZnZ.to_Z x.
+ Proof.
+ intros. change to_Z with (iter_t (fun _ x => ZnZ.to_Z x)).
+ rewrite iter_mk_t; auto.
+ Qed.
+
+ (** * Regular make op, without memoization or karatsuba
+
+     This will normally never be used for actual computations,
+     but only for specification purpose when using
+     [word (dom_t n) m] intermediate values. *)
+
+ Fixpoint nmake_op (ww:Type) (ww_op: ZnZ.Ops ww) (n: nat) :
+       ZnZ.Ops (word ww n) :=
+  match n return ZnZ.Ops (word ww n) with
+   O => ww_op
+  | S n1 => mk_zn2z_ops (nmake_op ww ww_op n1)
+  end.
+
+ Let eval n m := ZnZ.to_Z (Ops:=nmake_op _ (dom_op n) m).
+
+ Theorem nmake_op_S: forall ww (w_op: ZnZ.Ops ww) x,
+   nmake_op _ w_op (S x) = mk_zn2z_ops (nmake_op _ w_op x).
+ Proof.
+ auto.
+ Qed.
+
+ Theorem digits_nmake_S :forall n ww (w_op: ZnZ.Ops ww),
+    ZnZ.digits (nmake_op _ w_op (S n)) =
+    xO (ZnZ.digits (nmake_op _ w_op n)).
+ Proof.
+ auto.
+ Qed.
+
+ Theorem digits_nmake : forall n ww (w_op: ZnZ.Ops ww),
+    ZnZ.digits (nmake_op _ w_op n) = Pos.shiftl_nat (ZnZ.digits w_op) n.
+ Proof.
+ induction n. auto.
+ intros ww ww_op. rewrite Pshiftl_nat_S, <- IHn; auto.
+ Qed.
+
+ Theorem nmake_double: forall n ww (w_op: ZnZ.Ops ww),
+    ZnZ.to_Z (Ops:=nmake_op _ w_op n) =
+    @DoubleBase.double_to_Z _ (ZnZ.digits w_op) (ZnZ.to_Z (Ops:=w_op)) n.
+ Proof.
+ intros n; elim n; auto; clear n.
+ intros n Hrec ww ww_op; simpl DoubleBase.double_to_Z; unfold zn2z_to_Z.
+ rewrite <- Hrec; auto.
+ unfold DoubleBase.double_wB; rewrite <- digits_nmake; auto.
+ Qed.
+
+ Theorem nmake_WW: forall ww ww_op n xh xl,
+  (ZnZ.to_Z (Ops:=nmake_op ww ww_op (S n)) (WW xh xl) =
+   ZnZ.to_Z (Ops:=nmake_op ww ww_op n) xh *
+    base (ZnZ.digits (nmake_op ww ww_op n)) +
+   ZnZ.to_Z (Ops:=nmake_op ww ww_op n) xl)%%Z.
+ Proof.
+ auto.
+ Qed.
+
+ (** * The specification proofs for the word operators *)
+";
+
+  if size <> 0 then
+  pr " Typeclasses Opaque %s." (iter_name 1 size "w" "");
+  pr "";
+
+  pr " Instance w0_spec: ZnZ.Specs w0_op := W0.specs.";
+  for i = 1 to min 3 size do
+    pr " Instance w%i_spec: ZnZ.Specs w%i_op := mk_zn2z_specs w%i_spec." i i (i-1)
+  done;
+  for i = 4 to size do
+    pr " Instance w%i_spec: ZnZ.Specs w%i_op := mk_zn2z_specs_karatsuba w%i_spec." i i (i-1)
+  done;
+  pr " Instance w%i_spec: ZnZ.Specs w%i_op := mk_zn2z_specs_karatsuba w%i_spec." (size+1) (size+1) size;
+
+
+pr "
+ Instance wn_spec (n:nat) : ZnZ.Specs (make_op n).
+ Proof.
+  induction n.
+  rewrite make_op_omake; simpl; auto with *.
+  rewrite make_op_S. exact (mk_zn2z_specs_karatsuba IHn).
+ Qed.
+
+ Instance dom_spec n : ZnZ.Specs (dom_op n) | 10.
+ Proof.
+  do_size (destruct n; auto with *). apply wn_spec.
+ Qed.
+
+ Let make_op_WW : forall n x y,
+   (ZnZ.to_Z (Ops:=make_op (S n)) (WW x y) =
+    ZnZ.to_Z (Ops:=make_op n) x * base (ZnZ.digits (make_op n))
+     + ZnZ.to_Z (Ops:=make_op n) y)%%Z.
+ Proof.
+ intros n x y; rewrite make_op_S; auto.
+ Qed.
+
+ (** * Zero *)
+
+ Definition zero0 : w0 := ZnZ.zero.
+
+ Definition zeron n : dom_t n :=
+  match n with
+   | O => zero0
+   | SizePlus (S n) => W0
+   | _ => W0
+  end.
+
+ Lemma spec_zeron : forall n, ZnZ.to_Z (zeron n) = 0%%Z.
+ Proof.
+  do_size (destruct n; [exact ZnZ.spec_0|]).
+  destruct n; auto. simpl. rewrite make_op_S. exact ZnZ.spec_0.
+ Qed.
+
+ (** * Digits *)
+
+ Lemma digits_make_op_0 : forall n,
+  ZnZ.digits (make_op n) = Pos.shiftl_nat (ZnZ.digits (dom_op Size)) (S n).
+ Proof.
+ induction n.
+ auto.
+ replace (ZnZ.digits (make_op (S n))) with (xO (ZnZ.digits (make_op n))).
+  rewrite IHn; auto.
+ rewrite make_op_S; auto.
+ Qed.
+
+ Lemma digits_make_op : forall n,
+  ZnZ.digits (make_op n) = Pos.shiftl_nat (ZnZ.digits w0_op) (SizePlus (S n)).
+ Proof.
+ intros. rewrite digits_make_op_0.
+ replace (SizePlus (S n)) with (S n + Size) by (rewrite <- plus_comm; auto).
+ rewrite Pshiftl_nat_plus. auto.
+ Qed.
+
+ Lemma digits_dom_op : forall n,
+  ZnZ.digits (dom_op n) = Pos.shiftl_nat (ZnZ.digits w0_op) n.
+ Proof.
+ do_size (destruct n; try reflexivity).
+ exact (digits_make_op n).
+ Qed.
+
+ Lemma digits_dom_op_nmake : forall n m,
+  ZnZ.digits (dom_op (m+n)) = ZnZ.digits (nmake_op _ (dom_op n) m).
+ Proof.
+ intros. rewrite digits_nmake, 2 digits_dom_op. apply Pshiftl_nat_plus.
+ Qed.
+
+ (** * Conversion between [zn2z (dom_t n)] and [dom_t (S n)].
+
+     These two types are provably equal, but not convertible,
+     hence we need some work. We now avoid using generic casts
+     (i.e. rewrite via proof of equalities in types), since
+     proving things with them is a mess.
+ *)
+
+ Definition succ_t n : zn2z (dom_t n) -> dom_t (S n) :=
+  match n with
+   | SizePlus (S _) => fun x => x
+   | _ => fun x => x
+  end.
+
+ Lemma spec_succ_t : forall n x,
+  ZnZ.to_Z (succ_t n x) =
+  zn2z_to_Z (base (ZnZ.digits (dom_op n))) ZnZ.to_Z x.
+ Proof.
+ do_size (destruct n ; [reflexivity|]).
+ intros. simpl. rewrite make_op_S. simpl. auto.
+ Qed.
+
+ Definition pred_t n : dom_t (S n) -> zn2z (dom_t n) :=
+  match n with
+   | SizePlus (S _) => fun x => x
+   | _ => fun x => x
+  end.
+
+ Lemma succ_pred_t : forall n x, succ_t n (pred_t n x) = x.
+ Proof.
+ do_size (destruct n ; [reflexivity|]). reflexivity.
+ Qed.
+
+ (** We can hence project from [zn2z (dom_t n)] to [t] : *)
+
+ Definition mk_t_S n (x : zn2z (dom_t n)) : t :=
+  mk_t (S n) (succ_t n x).
+
+ Lemma spec_mk_t_S : forall n x,
+  [mk_t_S n x] = zn2z_to_Z (base (ZnZ.digits (dom_op n))) ZnZ.to_Z x.
+ Proof.
+ intros. unfold mk_t_S. rewrite spec_mk_t. apply spec_succ_t.
+ Qed.
+
+ Lemma mk_t_S_level : forall n x, level (mk_t_S n x) = S n.
+ Proof.
+ intros. unfold mk_t_S, level. rewrite iter_mk_t; auto.
+ Qed.
+
+ (** * Conversion from [word (dom_t n) m] to [dom_t (m+n)].
+
+     Things are more complex here. We start with a naive version
+     that breaks zn2z-trees and reconstruct them. Doing this is
+     quite unfortunate, but I don't know how to fully avoid that.
+     (cast someday ?). Then we build an optimized version where
+     all basic cases (n<=6 or m<=7) are nicely handled.
+ *)
+
+ Definition zn2z_map {A} {B} (f:A->B) (x:zn2z A) : zn2z B :=
+  match x with
+   | W0 => W0
+   | WW h l => WW (f h) (f l)
+  end.
+
+ Lemma zn2z_map_id : forall A f (x:zn2z A), (forall u, f u = u) ->
+   zn2z_map f x = x.
+ Proof.
+  destruct x; auto; intros.
+  simpl; f_equal; auto.
+ Qed.
+
+ (** The naive version *)
+
+ Fixpoint plus_t n m : word (dom_t n) m -> dom_t (m+n) :=
+  match m as m' return word (dom_t n) m' -> dom_t (m'+n) with
+   | O => fun x => x
+   | S m => fun x => succ_t _ (zn2z_map (plus_t n m) x)
+  end.
+
+ Theorem spec_plus_t : forall n m (x:word (dom_t n) m),
+  ZnZ.to_Z (plus_t n m x) = eval n m x.
+ Proof.
+ unfold eval.
+ induction m.
+ simpl; auto.
+ intros.
+ simpl plus_t; simpl plus. rewrite spec_succ_t.
+ destruct x.
+ simpl; auto.
+ fold word in w, w0.
+ simpl. rewrite 2 IHm. f_equal. f_equal. f_equal.
+ apply digits_dom_op_nmake.
+ Qed.
+
+ Definition mk_t_w n m (x:word (dom_t n) m) : t :=
+   mk_t (m+n) (plus_t n m x).
+
+ Theorem spec_mk_t_w : forall n m (x:word (dom_t n) m),
+  [mk_t_w n m x] = eval n m x.
+ Proof.
+ intros. unfold mk_t_w. rewrite spec_mk_t. apply spec_plus_t.
+ Qed.
+
+ (** The optimized version.
+
+     NB: the last particular case for m could depend on n,
+     but it's simplier to just expand everywhere up to m=7
+     (cf [mk_t_w'] later).
+ *)
+
+ Definition plus_t' n : forall m, word (dom_t n) m -> dom_t (m+n) :=
+   match n return (forall m, word (dom_t n) m -> dom_t (m+n)) with
+     | SizePlus (S n') as n => plus_t n
+     | _ as n =>
+         fun m => match m return (word (dom_t n) m -> dom_t (m+n)) with
+                    | SizePlus (S (S m')) as m => plus_t n m
+                    | _ => fun x => x
+                  end
+   end.
+
+ Lemma plus_t_equiv : forall n m x,
+  plus_t' n m x = plus_t n m x.
+ Proof.
+  (do_size try destruct n); try reflexivity;
+   (do_size try destruct m); try destruct m; try reflexivity;
+     simpl; symmetry; repeat (intros; apply zn2z_map_id; trivial).
+ Qed.
+
+ Lemma spec_plus_t' : forall n m x,
+  ZnZ.to_Z (plus_t' n m x) = eval n m x.
+ Proof.
+ intros; rewrite plus_t_equiv. apply spec_plus_t.
+ Qed.
+
+ (** Particular cases [Nk x] = eval i j x with specific k,i,j
+     can be solved by the following tactic *)
+
+ Ltac solve_eval :=
+  intros; rewrite <- spec_plus_t'; unfold to_Z; simpl dom_op; reflexivity.
+
+ (** The last particular case that remains useful *)
+
+ Lemma spec_eval_size : forall n x, [Nn n x] = eval Size (S n) x.
+ Proof.
+ induction n.
+ solve_eval.
+ destruct x as [ | xh xl ].
+  simpl. unfold eval. rewrite make_op_S. rewrite nmake_op_S. auto.
+ simpl word in xh, xl |- *.
+ unfold to_Z in *. rewrite make_op_WW.
+ unfold eval in *. rewrite nmake_WW.
+ f_equal; auto.
+ f_equal; auto.
+ f_equal.
+ rewrite <- digits_dom_op_nmake. rewrite plus_comm; auto.
+ Qed.
+
+ (** An optimized [mk_t_w].
+
+     We could say mk_t_w' := mk_t _ (plus_t' n m x)
+     (TODO: WHY NOT, BTW ??).
+     Instead we directly define functions for all intersting [n],
+     reverting to naive [mk_t_w] at places that should normally
+     never be used (see [mul] and [div_gt]).
+ *)
+";
+
+for i = 0 to size-1 do
+let pattern = (iter_str (size+1-i) "(S ") ^ "_" ^ (iter_str (size+1-i) ")") in
+pr
+" Let mk_t_%iw m := Eval cbv beta zeta iota delta [ mk_t plus ] in
+  match m return word w%i (S m) -> t with
+    | %s as p => mk_t_w %i (S p)
+    | p => mk_t (%i+p)
+  end.
+" i i pattern i (i+1)
+done;
+
+pr
+" Let mk_t_w' n : forall m, word (dom_t n) (S m) -> t :=
+  match n return (forall m, word (dom_t n) (S m) -> t) with";
+for i = 0 to size-1 do pr "    | %i => mk_t_%iw" i i done;
+pr
+"    | Size => Nn
+    | _ as n' => fun m => mk_t_w n' (S m)
+  end.
+";
+
+pr
+" Ltac solve_spec_mk_t_w' :=
+  rewrite <- spec_plus_t';
+  match goal with _ : word (dom_t ?n) ?m |- _ => apply (spec_mk_t (n+m)) end.
+
+ Theorem spec_mk_t_w' :
+  forall n m x, [mk_t_w' n m x] = eval n (S m) x.
+ Proof.
+ intros.
+ repeat (apply spec_mk_t_w || (destruct n;
+  [repeat (apply spec_mk_t_w || (destruct m; [solve_spec_mk_t_w'|]))|])).
+ apply spec_eval_size.
+ Qed.
+
+ (** * Extend : injecting [dom_t n] into [word (dom_t n) (S m)] *)
+
+ Definition extend n m (x:dom_t n) : word (dom_t n) (S m) :=
+  DoubleBase.extend_aux m (WW (zeron n) x).
+
+ Lemma spec_extend : forall n m x,
+  [mk_t n x] = eval n (S m) (extend n m x).
+ Proof.
+ intros. unfold eval, extend.
+ rewrite spec_mk_t.
+ assert (H : forall (x:dom_t n),
+              (ZnZ.to_Z (zeron n) * base (ZnZ.digits (dom_op n)) + ZnZ.to_Z x =
+              ZnZ.to_Z x)%%Z).
+  clear; intros; rewrite spec_zeron; auto.
+ rewrite <- (@DoubleBase.spec_extend _
+              (WW (zeron n)) (ZnZ.digits (dom_op n)) ZnZ.to_Z H m x).
+ simpl. rewrite digits_nmake, <- nmake_double. auto.
+ Qed.
+
+ (** A particular case of extend, used in [same_level]:
+     [extend_size] is [extend Size] *)
+
+ Definition extend_size := DoubleBase.extend (WW (W0:dom_t Size)).
+
+ Lemma spec_extend_size : forall n x, [mk_t Size x] = [Nn n (extend_size n x)].
+ Proof.
+ intros. rewrite spec_eval_size. apply (spec_extend Size n).
+ Qed.
+
+ (** Misc results about extensions *)
+
+ Let spec_extend_WW : forall n x,
+  [Nn (S n) (WW W0 x)] = [Nn n x].
+ Proof.
+ intros n x.
+ set (N:=SizePlus (S n)).
+ change ([Nn (S n) (extend N 0 x)]=[mk_t N x]).
+ rewrite (spec_extend N 0).
+ solve_eval.
+ Qed.
+
+ Let spec_extend_tr: forall m n w,
+ [Nn (m + n) (extend_tr w m)] = [Nn n w].
+ Proof.
+ induction m; auto.
+ intros n x; simpl extend_tr.
+ simpl plus; rewrite spec_extend_WW; auto.
+ Qed.
+
+ Let spec_cast_l: forall n m x1,
+ [Nn n x1] =
+ [Nn (Max.max n m) (castm (diff_r n m) (extend_tr x1 (snd (diff n m))))].
+ Proof.
+ intros n m x1; case (diff_r n m); simpl castm.
+ rewrite spec_extend_tr; auto.
+ Qed.
+
+ Let spec_cast_r: forall n m x1,
+ [Nn m x1] =
+ [Nn (Max.max n m) (castm (diff_l n m) (extend_tr x1 (fst (diff n m))))].
+ Proof.
+ intros n m x1; case (diff_l n m); simpl castm.
+ rewrite spec_extend_tr; auto.
+ Qed.
+
+ Ltac unfold_lets :=
+  match goal with
+   | h : _ |- _ => unfold h; clear h; unfold_lets
+   | _ => idtac
+  end.
+
+ (** * [same_level]
+
+     Generic binary operator construction, by extending the smaller
+     argument to the level of the other.
+ *)
+
+ Section SameLevel.
+
+  Variable res: Type.
+  Variable P : Z -> Z -> res -> Prop.
+  Variable f : forall n, dom_t n -> dom_t n -> res.
+  Variable Pf : forall n x y, P (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y).
+";
+
+for i = 0 to size do
+pr "  Let f%i : w%i -> w%i -> res := f %i." i i i i
+done;
+pr
+"  Let fn n := f (SizePlus (S n)).
+
+  Let Pf' :
+   forall n x y u v, u = [mk_t n x] -> v = [mk_t n y] -> P u v (f n x y).
+  Proof.
+  intros. subst. rewrite 2 spec_mk_t. apply Pf.
+  Qed.
+";
+
+let ext i j s =
+  if j <= i then s else Printf.sprintf "(extend %i %i %s)" i (j-i-1) s
+in
+
+pr "  Notation same_level_folded := (fun x y => match x, y with";
+for i = 0 to size do
+  for j = 0 to size do
+    pr "  | N%i wx, N%i wy => f%i %s %s" i j (max i j) (ext i j "wx") (ext j i "wy")
+  done;
+  pr "  | N%i wx, Nn m wy => fn m (extend_size m %s) wy" i (ext i size "wx")
+done;
+for i = 0 to size do
+  pr "  | Nn n wx, N%i wy => fn n wx (extend_size n %s)" i (ext i size "wy")
+done;
+pr
+"  | Nn n wx, Nn m wy =>
+    let mn := Max.max n m in
+    let d := diff n m in
+     fn mn
+       (castm (diff_r n m) (extend_tr wx (snd d)))
+       (castm (diff_l n m) (extend_tr wy (fst d)))
+  end).
+";
+
+pr
+"  Definition same_level := Eval lazy beta iota delta
+   [ DoubleBase.extend DoubleBase.extend_aux extend zeron ]
+  in same_level_folded.
+
+  Lemma spec_same_level_0: forall x y, P [x] [y] (same_level x y).
+  Proof.
+  change same_level with same_level_folded. unfold_lets.
+  destruct x, y; apply Pf'; simpl mk_t; rewrite <- ?spec_extend_size;
+  match goal with
+   | |- context [ extend ?n ?m _ ] => apply (spec_extend n m)
+   | |- context [ castm _ _ ] => apply spec_cast_l || apply spec_cast_r
+   | _ => reflexivity
+  end.
+  Qed.
+
+ End SameLevel.
+
+ Arguments same_level [res] f x y.
+
+ Theorem spec_same_level_dep :
+  forall res
+   (P : nat -> Z -> Z -> res -> Prop)
+   (Pantimon : forall n m z z' r, n <= m -> P m z z' r -> P n z z' r)
+   (f : forall n, dom_t n -> dom_t n -> res)
+   (Pf: forall n x y, P n (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y)),
+   forall x y, P (level x) [x] [y] (same_level f x y).
+ Proof.
+ intros res P Pantimon f Pf.
+ set (f' := fun n x y => (n, f n x y)).
+ set (P' := fun z z' r => P (fst r) z z' (snd r)).
+ assert (FST : forall x y, level x <= fst (same_level f' x y))
+  by (destruct x, y; simpl; omega with * ).
+ assert (SND : forall x y, same_level f x y = snd (same_level f' x y))
+  by (destruct x, y; reflexivity).
+ intros. eapply Pantimon; [eapply FST|].
+ rewrite SND. eapply (@spec_same_level_0 _ P' f'); eauto.
+ Qed.
+
+ (** * [iter]
+
+     Generic binary operator construction, by splitting the larger
+     argument in blocks and applying the smaller argument to them.
+ *)
+
+ Section Iter.
+
+  Variable res: Type.
+  Variable P: Z -> Z -> res -> Prop.
+
+  Variable f : forall n, dom_t n -> dom_t n -> res.
+  Variable Pf : forall n x y, P (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y).
+
+  Variable fd : forall n m, dom_t n -> word (dom_t n) (S m) -> res.
+  Variable fg : forall n m, word (dom_t n) (S m) -> dom_t n -> res.
+  Variable Pfd : forall n m x y, P (ZnZ.to_Z x) (eval n (S m) y) (fd n m x y).
+  Variable Pfg : forall n m x y, P (eval n (S m) x) (ZnZ.to_Z y) (fg n m x y).
+
+  Variable fnm: forall n m, word (dom_t Size) (S n) -> word (dom_t Size) (S m) -> res.
+  Variable Pfnm: forall n m x y, P [Nn n x] [Nn m y] (fnm n m x y).
+
+  Let Pf' :
+   forall n x y u v, u = [mk_t n x] -> v = [mk_t n y] -> P u v (f n x y).
+  Proof.
+  intros. subst. rewrite 2 spec_mk_t. apply Pf.
+  Qed.
+
+  Let Pfd' : forall n m x y u v, u = [mk_t n x] -> v = eval n (S m) y ->
+   P u v (fd n m x y).
+  Proof.
+  intros. subst. rewrite spec_mk_t. apply Pfd.
+  Qed.
+
+  Let Pfg' : forall n m x y u v, u = eval n (S m) x -> v = [mk_t n y] ->
+   P u v (fg n m x y).
+  Proof.
+  intros. subst. rewrite spec_mk_t. apply Pfg.
+  Qed.
+";
+
+for i = 0 to size do
+pr "  Let f%i := f %i." i i
+done;
+
+for i = 0 to size do
+pr "  Let f%in := fd %i." i i;
+pr "  Let fn%i := fg %i." i i;
+done;
+
+pr "  Notation iter_folded := (fun x y => match x, y with";
+for i = 0 to size do
+  for j = 0 to size do
+    pr "  | N%i wx, N%i wy => f%s wx wy" i j
+      (if i = j then string_of_int i
+       else if i < j then string_of_int i ^ "n " ^ string_of_int (j-i-1)
+       else "n" ^ string_of_int j ^ " " ^ string_of_int (i-j-1))
+  done;
+  pr "  | N%i wx, Nn m wy => f%in m %s wy" i size (ext i size "wx")
+done;
+for i = 0 to size do
+  pr "  | Nn n wx, N%i wy => fn%i n wx %s" i size (ext i size "wy")
+done;
+pr
+"  | Nn n wx, Nn m wy => fnm n m wx wy
+  end).
+";
+
+pr
+"  Definition iter := Eval lazy beta iota delta
+   [extend DoubleBase.extend DoubleBase.extend_aux zeron]
+   in iter_folded.
+
+  Lemma spec_iter: forall x y, P [x] [y] (iter x y).
+  Proof.
+  change iter with iter_folded; unfold_lets.
+  destruct x; destruct y; apply Pf' || apply Pfd' || apply Pfg' || apply Pfnm;
+  simpl mk_t;
+  match goal with
+   | |- ?x = ?x => reflexivity
+   | |- [Nn _ _] = _ => apply spec_eval_size
+   | |- context [extend ?n ?m _] => apply (spec_extend n m)
+   | _ => idtac
+  end;
+  unfold to_Z; rewrite <- spec_plus_t'; simpl dom_op; reflexivity.
+  Qed.
+
+  End Iter.
+";
+
+pr
+"  Definition switch
+  (P:nat->Type)%s
+  (fn:forall n, P n) n :=
+  match n return P n with"
+  (iter_str_gen size (fun i -> Printf.sprintf "(f%i:P %i)" i i));
+for i = 0 to size do pr "   | %i => f%i" i i done;
+pr
+"   | n => fn n
+  end.
+";
+
+pr
+"  Lemma spec_switch : forall P (f:forall n, P n) n,
+   switch P %sf n = f n.
+  Proof.
+  repeat (destruct n; try reflexivity).
+  Qed.
+" (iter_str_gen size (fun i -> Printf.sprintf "(f %i) " i));
+
+pr
+"  (** * [iter_sym]
+
+    A variant of [iter] for symmetric functions, or pseudo-symmetric
+    functions (when f y x can be deduced from f x y).
+  *)
+
+  Section IterSym.
+
+  Variable res: Type.
+  Variable P: Z -> Z -> res -> Prop.
+
+  Variable f : forall n, dom_t n -> dom_t n -> res.
+  Variable Pf : forall n x y, P (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y).
+
+  Variable fg : forall n m, word (dom_t n) (S m) -> dom_t n -> res.
+  Variable Pfg : forall n m x y, P (eval n (S m) x) (ZnZ.to_Z y) (fg n m x y).
+
+  Variable fnm: forall n m, word (dom_t Size) (S n) -> word (dom_t Size) (S m) -> res.
+  Variable Pfnm: forall n m x y, P [Nn n x] [Nn m y] (fnm n m x y).
+
+  Variable opp: res -> res.
+  Variable Popp : forall u v r, P u v r -> P v u (opp r).
+";
+
+for i = 0 to size do
+pr "  Let f%i := f %i." i i
+done;
+
+for i = 0 to size do
+pr "  Let fn%i := fg %i." i i;
+done;
+
+pr "  Let f' := switch _ %s f." (iter_name 0 size "f" "");
+pr "  Let fg' := switch _ %s fg." (iter_name 0 size "fn" "");
+
+pr
+"  Local Notation iter_sym_folded :=
+   (iter res f' (fun n m x y => opp (fg' n m y x)) fg' fnm).
+
+  Definition iter_sym :=
+   Eval lazy beta zeta iota delta [iter f' fg' switch] in iter_sym_folded.
+
+  Lemma spec_iter_sym: forall x y, P [x] [y] (iter_sym x y).
+  Proof.
+  intros. change iter_sym with iter_sym_folded. apply spec_iter; clear x y.
+  unfold_lets.
+  intros. rewrite spec_switch. auto.
+  intros. apply Popp. unfold_lets. rewrite spec_switch; auto.
+  intros. unfold_lets. rewrite spec_switch; auto.
+  auto.
+  Qed.
+
+  End IterSym.
+
+ (** * Reduction
+
+     [reduce] can be used instead of [mk_t], it will choose the
+     lowest possible level. NB: We only search and remove leftmost
+     W0's via ZnZ.eq0, any non-W0 block ends the process, even
+     if its value is 0.
+ *)
+
+ (** First, a direct version ... *)
+
+ Fixpoint red_t n : dom_t n -> t :=
+  match n return dom_t n -> t with
+   | O => N0
+   | S n => fun x =>
+     let x' := pred_t n x in
+     reduce_n1 _ _ (N0 zero0) ZnZ.eq0 (red_t n) (mk_t_S n) x'
+  end.
+
+ Lemma spec_red_t : forall n x, [red_t n x] = [mk_t n x].
+ Proof.
+ induction n.
+ reflexivity.
+ intros.
+ simpl red_t. unfold reduce_n1.
+ rewrite <- (succ_pred_t n x) at 2.
+ remember (pred_t n x) as x'.
+ rewrite spec_mk_t, spec_succ_t.
+ destruct x' as [ | xh xl]. simpl. apply ZnZ.spec_0.
+ generalize (ZnZ.spec_eq0 xh); case ZnZ.eq0; intros H.
+ rewrite IHn, spec_mk_t. simpl. rewrite H; auto.
+ apply spec_mk_t_S.
+ Qed.
+
+ (** ... then a specialized one *)
+";
+
+for i = 0 to size do
+pr " Definition eq0%i := @ZnZ.eq0 _ w%i_op." i i;
+done;
+
+pr "
+ Definition reduce_0 := N0.";
+for i = 1 to size do
+  pr " Definition reduce_%i :=" i;
+  pr "  Eval lazy beta iota delta [reduce_n1] in";
+  pr "   reduce_n1 _ _ (N0 zero0) eq0%i reduce_%i N%i." (i-1) (i-1) i
+done;
 
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Reduction                         *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  pr " Definition reduce_0 (x:w) := %s0 x." c;
-  pr " Definition reduce_1 :=";
-  pr "  Eval lazy beta iota delta[reduce_n1] in";
-  pr "   reduce_n1 _ _ zero w0_eq0 %s0 %s1." c c;
-  for i = 2 to size do
-    pr " Definition reduce_%i :=" i;
-    pr "  Eval lazy beta iota delta[reduce_n1] in";
-    pr "   reduce_n1 _ _ zero w%i_eq0 reduce_%i %s%i."
-      (i-1) (i-1)  c i
-  done;
   pr " Definition reduce_%i :=" (size+1);
-  pr "  Eval lazy beta iota delta[reduce_n1] in";
-  pr "   reduce_n1 _ _ zero w%i_eq0 reduce_%i (%sn 0)."
-    size size c;
+  pr "  Eval lazy beta iota delta [reduce_n1] in";
+  pr "   reduce_n1 _ _ (N0 zero0) eq0%i reduce_%i (Nn 0)." size size;
 
   pr " Definition reduce_n n :=";
-  pr "  Eval lazy beta iota delta[reduce_n] in";
-  pr "   reduce_n _ _ zero reduce_%i %sn n." (size + 1) c;
-  pr "";
-
-  pp " Let spec_reduce_0: forall x, [reduce_0 x] = [%s0 x]." c;
-  pp " Proof.";
-  pp " intros x; unfold to_Z, reduce_0.";
-  pp " auto.";
-  pp " Qed.";
-  pp "";
-
-  for i = 1 to size + 1 do
-    if i == size + 1 then
-      pp " Let spec_reduce_%i: forall x, [reduce_%i x] = [%sn 0 x]." i i c
-    else
-      pp " Let spec_reduce_%i: forall x, [reduce_%i x] = [%s%i x]." i i c i;
-    pp " Proof.";
-    pp " intros x; case x; unfold reduce_%i." i;
-    pp " exact (spec_0 w0_spec).";
-    pp " intros x1 y1.";
-    pp " generalize (spec_w%i_eq0 x1);" (i - 1);
-    pp "   case w%i_eq0; intros H1; auto." (i - 1);
-    if i <> 1 then
-      pp " rewrite spec_reduce_%i." (i - 1);
-    pp " unfold to_Z; rewrite znz_to_Z_%i." i;
-    pp " unfold to_Z in H1; rewrite H1; auto.";
-    pp " Qed.";
-    pp "";
-  done;
-
-  pp " Let spec_reduce_n: forall n x, [reduce_n n x] = [%sn n x]." c;
-  pp " Proof.";
-  pp " intros n; elim n; simpl reduce_n.";
-  pp "   intros x; rewrite <- spec_reduce_%i; auto." (size + 1);
-  pp " intros n1 Hrec x; case x.";
-  pp " unfold to_Z; rewrite make_op_S; auto.";
-  pp " exact (spec_0 w0_spec).";
-  pp " intros x1 y1; case x1; auto.";
-  pp " rewrite Hrec.";
-  pp " rewrite spec_extendn0_0; auto.";
-  pp " Qed.";
-  pp "";
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Successor                         *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_succ_c := w%i_op.(znz_succ_c)." i i
-  done;
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_succ := w%i_op.(znz_succ)." i i
-  done;
-  pr "";
-
-  pr " Definition succ x :=";
-  pr "  match x with";
-  for i = 0 to size-1 do
-    pr "  | %s%i wx =>" c i;
-    pr "    match w%i_succ_c wx with" i;
-    pr "    | C0 r => %s%i r" c i;
-    pr "    | C1 r => %s%i (WW one%i r)" c (i+1) i;
-    pr "    end";
-  done;
-  pr "  | %s%i wx =>" c size;
-  pr "    match w%i_succ_c wx with" size;
-  pr "    | C0 r => %s%i r" c size;
-  pr "    | C1 r => %sn 0 (WW one%i r)" c size ;
-  pr "    end";
-  pr "  | %sn n wx =>" c;
-  pr "    let op := make_op n in";
-  pr "    match op.(znz_succ_c) wx with";
-  pr "    | C0 r => %sn n r" c;
-  pr "    | C1 r => %sn (S n) (WW op.(znz_1) r)" c;
-  pr "    end";
-  pr "  end.";
-  pr "";
-
-  pr " Theorem spec_succ: forall n, [succ n] = [n] + 1.";
-  pa " Admitted.";
-  pp " Proof.";
-  pp "  intros n; case n; unfold succ, to_Z.";
-  for i = 0 to size do
-    pp  "  intros n1; generalize (spec_succ_c w%i_spec n1);" i;
-    pp  "  unfold succ, to_Z, w%i_succ_c; case znz_succ_c; auto." i;
-    pp  "     intros ww H; rewrite <- H.";
-    pp "     (rewrite znz_to_Z_%i; unfold interp_carry;" (i + 1);
-    pp "           apply f_equal2 with (f := Zplus); auto;";
-    pp "           apply f_equal2 with (f := Zmult); auto;";
-    pp "           exact (spec_1 w%i_spec))." i;
-  done;
-  pp "  intros k n1; generalize (spec_succ_c (wn_spec k) n1).";
-  pp "  unfold succ, to_Z; case znz_succ_c; auto.";
-  pp "  intros ww H; rewrite <- H.";
-  pp "     (rewrite (znz_to_Z_n k); unfold interp_carry;";
-  pp "           apply f_equal2 with (f := Zplus); auto;";
-  pp "           apply f_equal2 with (f := Zmult); auto;";
-  pp "           exact (spec_1 (wn_spec k))).";
-  pp " Qed.";
-  pr "";
-
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Adddition                         *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_add_c := znz_add_c w%i_op." i i;
-    pr " Definition w%i_add x y :=" i;
-    pr "  match w%i_add_c x y with" i;
-    pr "  | C0 r => %s%i r" c i;
-    if i == size then
-      pr "  | C1 r => %sn 0 (WW one%i r)" c size
-    else
-      pr "  | C1 r => %s%i (WW one%i r)" c (i + 1) i;
-    pr "  end.";
-    pr "";
-  done ;
-  pr " Definition addn n (x y : word w%i (S n)) :=" size;
-  pr "  let op := make_op n in";
-  pr "  match op.(znz_add_c) x y with";
-  pr "  | C0 r => %sn n r" c;
-  pr "  | C1 r => %sn (S n) (WW op.(znz_1) r)  end." c;
-  pr "";
-
-
-  for i = 0 to size do
-    pp " Let spec_w%i_add: forall x y, [w%i_add x y] = [%s%i x] + [%s%i y]." i i c i c i;
-    pp " Proof.";
-    pp " intros n m; unfold to_Z, w%i_add, w%i_add_c." i i;
-    pp "  generalize (spec_add_c w%i_spec n m); case znz_add_c; auto." i;
-    pp " intros ww H; rewrite <- H.";
-    pp "    rewrite znz_to_Z_%i; unfold interp_carry;" (i + 1);
-    pp "    apply f_equal2 with (f := Zplus); auto;";
-    pp "    apply f_equal2 with (f := Zmult); auto;";
-    pp "    exact (spec_1 w%i_spec)." i;
-    pp " Qed.";
-    pp "";
-  done;
-  pp " Let spec_wn_add: forall n x y, [addn n x y] = [%sn n x] + [%sn n y]." c c;
-  pp " Proof.";
-  pp " intros k n m; unfold to_Z, addn.";
-  pp "  generalize (spec_add_c (wn_spec k) n m); case znz_add_c; auto.";
-  pp " intros ww H; rewrite <- H.";
-  pp " rewrite (znz_to_Z_n k); unfold interp_carry;";
-  pp "        apply f_equal2 with (f := Zplus); auto;";
-  pp "        apply f_equal2 with (f := Zmult); auto;";
-  pp "        exact (spec_1 (wn_spec k)).";
-  pp " Qed.";
-
-  pr " Definition add := Eval lazy beta delta [same_level] in";
-  pr0 "   (same_level t_ ";
-  for i = 0 to size do
-    pr0 "w%i_add " i;
-  done;
-  pr "addn).";
-  pr "";
-
-  pr " Theorem spec_add: forall x y, [add x y] = [x] + [y].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " unfold add.";
-  pp " generalize (spec_same_level t_ (fun x y res => [res] = x + y)).";
-  pp " unfold same_level; intros HH; apply HH; clear HH.";
-  for i = 0 to size do
-    pp " exact spec_w%i_add." i;
-  done;
-  pp " exact spec_wn_add.";
-  pp " Qed.";
-  pr "";
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Predecessor                       *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_pred_c := w%i_op.(znz_pred_c)." i i
-  done;
-  pr "";
-
-  pr " Definition pred x :=";
-  pr "  match x with";
-  for i = 0 to size do
-    pr "  | %s%i wx =>" c i;
-    pr "    match w%i_pred_c wx with" i;
-    pr "    | C0 r => reduce_%i r" i;
-    pr "    | C1 r => zero";
-    pr "    end";
-  done;
-  pr "  | %sn n wx =>" c;
-  pr "    let op := make_op n in";
-  pr "    match op.(znz_pred_c) wx with";
-  pr "    | C0 r => reduce_n n r";
-  pr "    | C1 r => zero";
-  pr "    end";
-  pr "  end.";
-  pr "";
-
-  pr " Theorem spec_pred_pos : forall x, 0 < [x] -> [pred x] = [x] - 1.";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; unfold pred.";
-  for i = 0 to size do
-    pp " intros x1 H1; unfold w%i_pred_c;" i;
-    pp " generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1." i;
-    pp " rewrite spec_reduce_%i; auto." i;
-    pp " unfold interp_carry; unfold to_Z.";
-    pp " case (spec_to_Z w%i_spec x1); intros HH1 HH2." i;
-    pp " case (spec_to_Z w%i_spec y1); intros HH3 HH4 HH5." i;
-    pp " assert (znz_to_Z w%i_op x1 - 1 < 0); auto with zarith." i;
-    pp " unfold to_Z in H1; auto with zarith.";
-  done;
-  pp " intros n x1 H1;";
-  pp "   generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1.";
-  pp "   rewrite spec_reduce_n; auto.";
-  pp " unfold interp_carry; unfold to_Z.";
-  pp " case (spec_to_Z (wn_spec n) x1); intros HH1 HH2.";
-  pp " case (spec_to_Z (wn_spec n) y1); intros HH3 HH4 HH5.";
-  pp " assert (znz_to_Z (make_op n) x1 - 1 < 0); auto with zarith.";
-  pp " unfold to_Z in H1; auto with zarith.";
-  pp " Qed.";
-  pp "";
-
-  pp " Let spec_pred0: forall x, [x] = 0 -> [pred x] = 0.";
-  pp " Proof.";
-  pp " intros x; case x; unfold pred.";
-  for i = 0 to size do
-    pp " intros x1 H1; unfold w%i_pred_c;" i;
-    pp "   generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1." i;
-    pp " unfold interp_carry; unfold to_Z.";
-    pp " unfold to_Z in H1; auto with zarith.";
-    pp " case (spec_to_Z w%i_spec y1); intros HH3 HH4; auto with zarith." i;
-    pp " intros; exact (spec_0 w0_spec).";
-  done;
-  pp " intros n x1 H1;";
-  pp "   generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1.";
-  pp " unfold interp_carry; unfold to_Z.";
-  pp " unfold to_Z in H1; auto with zarith.";
-  pp " case (spec_to_Z (wn_spec n) y1); intros HH3 HH4; auto with zarith.";
-  pp " intros; exact (spec_0 w0_spec).";
-  pp " Qed.";
-  pr "";
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Subtraction                       *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_sub_c := w%i_op.(znz_sub_c)." i i
-  done;
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_sub x y :=" i;
-    pr "  match w%i_sub_c x y with" i;
-    pr "  | C0 r => reduce_%i r" i;
-    pr "  | C1 r => zero";
-    pr "  end."
-  done;
-  pr "";
-
-  pr " Definition subn n (x y : word w%i (S n)) :=" size;
-  pr "  let op := make_op n in";
-  pr "  match op.(znz_sub_c) x y with";
-  pr "  | C0 r => %sn n r" c;
-  pr "  | C1 r => N0 w_0";
-  pr "  end.";
-  pr "";
-
-  for i = 0 to size do
-    pp " Let spec_w%i_sub: forall x y, [%s%i y] <= [%s%i x] -> [w%i_sub x y] = [%s%i x] - [%s%i y]." i c i c i i c i c i;
-    pp " Proof.";
-    pp " intros n m; unfold w%i_sub, w%i_sub_c." i i;
-    pp "  generalize (spec_sub_c w%i_spec n m); case znz_sub_c;" i;
-    if i == 0 then
-      pp "    intros x; auto."
-    else
-      pp "   intros x; try rewrite spec_reduce_%i; auto." i;
-    pp " unfold interp_carry; unfold zero, w_0, to_Z.";
-    pp " rewrite (spec_0 w0_spec).";
-    pp " case (spec_to_Z w%i_spec x); intros; auto with zarith." i;
-    pp " Qed.";
-    pp "";
-  done;
-
-  pp " Let spec_wn_sub: forall n x y, [%sn n y] <= [%sn n x] -> [subn n x y] = [%sn n x] - [%sn n y]." c c c c;
-  pp " Proof.";
-  pp " intros k n m; unfold subn.";
-  pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c;";
-  pp "   intros x; auto.";
-  pp " unfold interp_carry, to_Z.";
-  pp " case (spec_to_Z (wn_spec k) x); intros; auto with zarith.";
-  pp " Qed.";
-  pp "";
-
-  pr " Definition sub := Eval lazy beta delta [same_level] in";
-  pr0 "   (same_level t_ ";
-  for i = 0 to size do
-    pr0 "w%i_sub " i;
-  done;
-  pr "subn).";
-  pr "";
-
-  pr " Theorem spec_sub_pos : forall x y, [y] <= [x] -> [sub x y] = [x] - [y].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " unfold sub.";
-  pp " generalize (spec_same_level t_ (fun x y res => y <= x -> [res] = x - y)).";
-  pp " unfold same_level; intros HH; apply HH; clear HH.";
-  for i = 0 to size do
-    pp " exact spec_w%i_sub." i;
-  done;
-  pp " exact spec_wn_sub.";
-  pp " Qed.";
-  pr "";
-
-  for i = 0 to size do
-    pp " Let spec_w%i_sub0: forall x y, [%s%i x] < [%s%i y] -> [w%i_sub x y] = 0." i c i c i i;
-    pp " Proof.";
-    pp " intros n m; unfold w%i_sub, w%i_sub_c." i i;
-    pp "  generalize (spec_sub_c w%i_spec n m); case znz_sub_c;" i;
-    pp "   intros x; unfold interp_carry.";
-    pp "   unfold to_Z; case (spec_to_Z w%i_spec x); intros; auto with zarith." i;
-    pp " intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto.";
-    pp " Qed.";
-    pp "";
-  done;
-
-  pp " Let spec_wn_sub0: forall n x y, [%sn n x] < [%sn n y] -> [subn n x y] = 0." c c;
-  pp " Proof.";
-  pp " intros k n m; unfold subn.";
-  pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c;";
-  pp "   intros x; unfold interp_carry.";
-  pp "   unfold to_Z; case (spec_to_Z (wn_spec k) x); intros; auto with zarith.";
-  pp " intros; unfold to_Z, w_0; rewrite (spec_0 (w0_spec)); auto.";
-  pp " Qed.";
-  pp "";
-
-  pr " Theorem spec_sub0: forall x y, [x] < [y] -> [sub x y] = 0.";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " unfold sub.";
-  pp " generalize (spec_same_level t_ (fun x y res => x < y -> [res] = 0)).";
-  pp " unfold same_level; intros HH; apply HH; clear HH.";
-  for i = 0 to size do
-    pp " exact spec_w%i_sub0." i;
-  done;
-  pp " exact spec_wn_sub0.";
-  pp " Qed.";
-  pr "";
-
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Comparison                        *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition compare_%i := w%i_op.(znz_compare)." i i;
-    pr " Definition comparen_%i :=" i;
-    pr "  compare_mn_1 w%i w%i %s compare_%i (compare_%i %s) compare_%i." i i (pz i) i i (pz i) i
-  done;
-  pr "";
-
-  pr " Definition comparenm n m wx wy :=";
-  pr "    let mn := Max.max n m in";
-  pr "    let d := diff n m in";
-  pr "    let op := make_op mn in";
-  pr "     op.(znz_compare)";
-  pr "       (castm (diff_r n m) (extend_tr wx (snd d)))";
-  pr "       (castm (diff_l n m) (extend_tr wy (fst d))).";
-  pr "";
-
-  pr " Definition compare := Eval lazy beta delta [iter] in";
-  pr "   (iter _";
-  for i = 0 to size do
-    pr "      compare_%i" i;
-    pr "      (fun n x y => CompOpp (comparen_%i (S n) y x))" i;
-    pr "      (fun n => comparen_%i (S n))" i;
-  done;
-  pr "      comparenm).";
-  pr "";
-
-  for i = 0 to size do
-    pp " Let spec_compare_%i: forall x y," i;
-    pp "    match compare_%i x y with" i;
-    pp "      Eq => [%s%i x] = [%s%i y]" c i c i;
-    pp "    | Lt => [%s%i x] < [%s%i y]" c i c i;
-    pp "    | Gt => [%s%i x] > [%s%i y]" c i c i;
-    pp "    end.";
-    pp "  Proof.";
-    pp "  unfold compare_%i, to_Z; exact (spec_compare w%i_spec)." i i;
-    pp "  Qed.";
-    pp "";
-
-    pp "  Let spec_comparen_%i:" i;
-    pp "  forall (n : nat) (x : word w%i n) (y : w%i)," i i;
-    pp "  match comparen_%i n x y with" i;
-    pp "  | Eq => eval%in n x = [%s%i y]" i c i;
-    pp "  | Lt => eval%in n x < [%s%i y]" i c i;
-    pp "  | Gt => eval%in n x > [%s%i y]" i c i;
-    pp "  end.";
-    pp "  intros n x y.";
-    pp "  unfold comparen_%i, to_Z; rewrite spec_double_eval%in." i i;
-    pp "  apply spec_compare_mn_1.";
-    pp "  exact (spec_0 w%i_spec)." i;
-    pp "  intros x1; exact (spec_compare w%i_spec %s x1)." i (pz i);
-    pp "  exact (spec_to_Z w%i_spec)." i;
-    pp "  exact (spec_compare w%i_spec)." i;
-    pp "  exact (spec_compare w%i_spec)." i;
-    pp "  exact (spec_to_Z w%i_spec)." i;
-    pp "  Qed.";
-    pp "";
-  done;
-
-  pp " Let spec_opp_compare: forall c (u v: Z),";
-  pp "  match c with Eq => u = v | Lt => u < v | Gt => u > v end ->";
-  pp "  match CompOpp c with Eq => v = u | Lt => v < u | Gt => v > u end.";
-  pp " Proof.";
-  pp " intros c u v; case c; unfold CompOpp; auto with zarith.";
-  pp " Qed.";
-  pp "";
-
-
-  pr " Theorem spec_compare_aux: forall x y,";
-  pr "    match compare x y with";
-  pr "      Eq => [x] = [y]";
-  pr "    | Lt => [x] < [y]";
-  pr "    | Gt => [x] > [y]";
-  pr "    end.";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " refine (spec_iter _ (fun x y res =>";
-  pp "                       match res with";
-  pp "                        Eq => x = y";
-  pp "                      | Lt => x < y";
-  pp "                      | Gt => x > y";
-  pp "                      end)";
-  for i = 0 to size do
-    pp "      compare_%i" i;
-    pp "      (fun n x y => CompOpp (comparen_%i (S n) y x))" i;
-    pp "      (fun n => comparen_%i (S n)) _ _ _" i;
-  done;
-  pp "      comparenm _).";
-
-  for i = 0 to size - 1 do
-    pp "  exact spec_compare_%i." i;
-    pp "  intros n x y H;apply spec_opp_compare; apply spec_comparen_%i." i;
-    pp "  intros n x y H; exact (spec_comparen_%i (S n) x y)." i;
-  done;
-  pp "  exact spec_compare_%i." size;
-  pp "  intros n x y;apply spec_opp_compare; apply spec_comparen_%i." size;
-  pp "  intros n; exact (spec_comparen_%i (S n))." size;
-  pp "  intros n m x y; unfold comparenm.";
-  pp "  rewrite <- (spec_cast_l n m x); rewrite <- (spec_cast_r n m y).";
-  pp "  unfold to_Z; apply (spec_compare  (wn_spec (Max.max n m))).";
-  pp "  Qed.";
-  pr "";
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Multiplication                    *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_mul_c := w%i_op.(znz_mul_c)." i i
-  done;
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_mul_add :=" i;
-    pr "   Eval lazy beta delta [w_mul_add] in";
-    pr "     @w_mul_add w%i %s w%i_succ w%i_add_c w%i_mul_c." i (pz i) i i i
-  done;
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_0W := znz_0W w%i_op." i i
-  done;
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_WW := znz_WW w%i_op." i i
-  done;
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_mul_add_n1 :=" i;
-    pr "  @double_mul_add_n1 w%i %s w%i_WW w%i_0W w%i_mul_add."  i (pz i) i i i
-  done;
-  pr "";
-
-  for i = 0 to size - 1 do
-    pr "  Let to_Z%i n :=" i;
-    pr "  match n return word w%i (S n) -> t_ with" i;
-    for j = 0 to size - i do
-      if (i + j) == size then
-        begin
-          pr "  | %i%s => fun x => %sn 0 x" j "%nat" c;
-          pr "  | %i%s => fun x => %sn 1 x" (j + 1) "%nat" c
-        end
-      else
-        pr "  | %i%s => fun x => %s%i x" j "%nat" c (i + j + 1)
-    done;
-    pr   "  | _   => fun _ => N0 w_0";
-    pr "  end.";
-    pr "";
-  done;
-
-
-  for i = 0 to size - 1 do
-    pp "Theorem to_Z%i_spec:" i;
-    pp "  forall n x, Z_of_nat n <= %i -> [to_Z%i n x] = znz_to_Z (nmake_op _ w%i_op (S n)) x." (size + 1 - i) i i;
-    for j = 1 to size + 2 - i do
-      pp " intros n; case n; clear n.";
-      pp "   unfold to_Z%i." i;
-      pp "   intros x H; rewrite spec_eval%in%i; auto." i j;
-    done;
-    pp " intros n x.";
-    pp " repeat rewrite inj_S; unfold Zsucc; auto with zarith.";
-    pp " Qed.";
-    pp "";
-  done;
-
-
-  for i = 0 to size do
-    pr " Definition w%i_mul n x y :=" i;
-    pr " let (w,r) := w%i_mul_add_n1 (S n) x y %s in" i (pz i);
-    if i == size then
-      begin
-        pr " if w%i_eq0 w then %sn n r" i c;
-        pr " else %sn (S n) (WW (extend%i n w) r)." c i;
-      end
-    else
-      begin
-        pr " if w%i_eq0 w then to_Z%i n r" i i;
-        pr " else to_Z%i (S n) (WW (extend%i n w) r)." i i;
-      end;
-    pr "";
-  done;
-
-  pr " Definition mulnm n m x y :=";
-  pr "    let mn := Max.max n m in";
-  pr "    let d := diff n m in";
-  pr "    let op := make_op mn in";
-  pr "     reduce_n (S mn) (op.(znz_mul_c)";
-  pr "       (castm (diff_r n m) (extend_tr x (snd d)))";
-  pr "       (castm (diff_l n m) (extend_tr y (fst d)))).";
-  pr "";
-
-  pr " Definition mul := Eval lazy beta delta [iter0] in";
-  pr "  (iter0 t_";
-  for i = 0 to size do
-    pr "    (fun x y => reduce_%i (w%i_mul_c x y))" (i + 1) i;
-    pr "    (fun n x y => w%i_mul n y x)" i;
-    pr "    w%i_mul" i;
-  done;
-  pr "    mulnm";
-  pr "    (fun _ => N0 w_0)";
-  pr "    (fun _ => N0 w_0)";
-  pr "  ).";
-  pr "";
-  for i = 0 to size do
-    pp " Let spec_w%i_mul_add: forall x y z," i;
-    pp "  let (q,r) := w%i_mul_add x y z in" i;
-    pp "  znz_to_Z w%i_op q * (base (znz_digits w%i_op))  +  znz_to_Z w%i_op r =" i i i;
-    pp "  znz_to_Z w%i_op x * znz_to_Z w%i_op y + znz_to_Z w%i_op z :=" i i i ;
-    pp "   (spec_mul_add w%i_spec)." i;
-    pp "";
-  done;
-
-  for i = 0 to size do
-    pp " Theorem spec_w%i_mul_add_n1: forall n x y z," i;
-    pp "  let (q,r) := w%i_mul_add_n1 n x y z in" i;
-    pp "  znz_to_Z w%i_op q * (base (znz_digits (nmake_op _ w%i_op n)))  +" i i;
-    pp "  znz_to_Z (nmake_op _ w%i_op n) r =" i;
-    pp "  znz_to_Z (nmake_op _ w%i_op n) x * znz_to_Z w%i_op y +" i i;
-    pp "  znz_to_Z w%i_op z." i;
-    pp " Proof.";
-    pp " intros n x y z; unfold w%i_mul_add_n1." i;
-    pp " rewrite nmake_double.";
-    pp " rewrite digits_doubled.";
-    pp " change (base (DoubleBase.double_digits (znz_digits w%i_op) n)) with" i;
-    pp "        (DoubleBase.double_wB (znz_digits w%i_op) n)." i;
-    pp " apply spec_double_mul_add_n1; auto.";
-    if i == 0 then pp " exact (spec_0 w%i_spec)." i;
-    pp " exact (spec_WW w%i_spec)." i;
-    pp " exact (spec_0W w%i_spec)." i;
-    pp " exact (spec_mul_add w%i_spec)." i;
-    pp " Qed.";
-    pp "";
-  done;
-
-  pp "  Lemma nmake_op_WW: forall ww ww1 n x y,";
-  pp "    znz_to_Z (nmake_op ww ww1 (S n)) (WW x y) =";
-  pp "    znz_to_Z (nmake_op ww ww1 n) x * base (znz_digits (nmake_op ww ww1 n)) +";
-  pp "    znz_to_Z (nmake_op ww ww1 n) y.";
-  pp "    auto.";
-  pp "  Qed.";
-  pp "";
-
-  for i = 0 to size do
-    pp "  Lemma extend%in_spec: forall n x1," i;
-    pp "  znz_to_Z (nmake_op _ w%i_op (S n)) (extend%i n x1) =" i i;
-    pp "  znz_to_Z w%i_op x1." i;
-    pp "  Proof.";
-    pp "    intros n1 x2; rewrite nmake_double.";
-    pp "    unfold extend%i." i;
-    pp "    rewrite DoubleBase.spec_extend; auto.";
-    if i == 0 then
-      pp "    intros l; simpl; unfold w_0; rewrite (spec_0 w0_spec); ring.";
-    pp "  Qed.";
-    pp "";
-  done;
-
-  pp "  Lemma spec_muln:";
-  pp "    forall n (x: word _ (S n)) y,";
-  pp "     [%sn (S n) (znz_mul_c (make_op n) x y)] = [%sn n x] * [%sn n y]." c c c;
-  pp "  Proof.";
-  pp "    intros n x y; unfold to_Z.";
-  pp "    rewrite <- (spec_mul_c (wn_spec n)).";
-  pp "    rewrite make_op_S.";
-  pp "    case znz_mul_c; auto.";
-  pp "  Qed.";
-  pr "";
-
-  pr "  Theorem spec_mul: forall x y, [mul x y] = [x] * [y].";
-  pa "  Admitted.";
-  pp "  Proof.";
-  for i = 0 to size do
-    pp "    assert(F%i:" i;
-    pp "    forall n x y,";
-    if i <> size then
-      pp0 "    Z_of_nat n <= %i -> "   (size - i);
-    pp "    [w%i_mul n x y] = eval%in (S n) x * [%s%i y])." i i c i;
-    if i == size then
-      pp "    intros n x y; unfold w%i_mul." i
-    else
-      pp "    intros n x y H; unfold w%i_mul." i;
-    pp "    generalize (spec_w%i_mul_add_n1 (S n) x y %s)." i (pz i);
-    pp "    case w%i_mul_add_n1; intros x1 y1." i;
-    pp "    change (znz_to_Z (nmake_op _ w%i_op (S n)) x) with (eval%in (S n) x)." i i;
-    pp "    change (znz_to_Z w%i_op y) with ([%s%i y])." i c i;
-    if i == 0 then
-      pp "    unfold w_0; rewrite (spec_0 w0_spec); rewrite Zplus_0_r."
-    else
-      pp "    change (znz_to_Z w%i_op W0) with 0; rewrite Zplus_0_r." i;
-    pp "    intros H1; rewrite <- H1; clear H1.";
-    pp "    generalize (spec_w%i_eq0 x1); case w%i_eq0; intros HH." i i;
-    pp "    unfold to_Z in HH; rewrite HH.";
-    if i == size then
-      begin
-        pp "    rewrite spec_eval%in; unfold eval%in, nmake_op%i; auto." i i i;
-        pp "    rewrite spec_eval%in; unfold eval%in, nmake_op%i." i i i
-      end
-    else
-      begin
-        pp "    rewrite to_Z%i_spec; auto with zarith." i;
-        pp "    rewrite to_Z%i_spec; try (rewrite inj_S; auto with zarith)." i
-      end;
-    pp "    rewrite nmake_op_WW; rewrite extend%in_spec; auto." i;
-  done;
-  pp "    refine (spec_iter0 t_ (fun x y res => [res] = x * y)";
-  for i = 0 to size do
-    pp "    (fun x y => reduce_%i (w%i_mul_c x y))" (i + 1) i;
-    pp "    (fun n x y => w%i_mul n y x)" i;
-    pp "    w%i_mul _ _ _" i;
-  done;
-  pp "    mulnm _";
-  pp "    (fun _ => N0 w_0) _";
-  pp "    (fun _ => N0 w_0) _";
-  pp "  ).";
-  for i = 0 to size do
-    pp "    intros x y; rewrite spec_reduce_%i." (i + 1);
-    pp "    unfold w%i_mul_c, to_Z." i;
-    pp "    generalize (spec_mul_c w%i_spec x y)." i;
-    pp "    intros HH; rewrite <- HH; clear HH; auto.";
-    if i == size then
-      begin
-        pp "    intros n x y; rewrite F%i; auto with zarith." i;
-        pp "    intros n x y; rewrite F%i; auto with zarith." i;
-      end
-    else
-      begin
-        pp "    intros n x y H; rewrite F%i; auto with zarith." i;
-        pp "    intros n x y H; rewrite F%i; auto with zarith." i;
-      end;
-  done;
-  pp "    intros n m x y; unfold mulnm.";
-  pp "    rewrite spec_reduce_n.";
-  pp "    rewrite <- (spec_cast_l n m x).";
-  pp "    rewrite <- (spec_cast_r n m y).";
-  pp "    rewrite spec_muln; rewrite spec_cast_l; rewrite spec_cast_r; auto.";
-  pp "    intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring.";
-  pp "    intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring.";
-  pp "  Qed.";
-  pr "";
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Square                            *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_square_c := w%i_op.(znz_square_c)." i i
-  done;
-  pr "";
-
-  pr " Definition square x :=";
-  pr "  match x with";
-  pr "  | %s0 wx => reduce_1 (w0_square_c wx)" c;
-  for i = 1 to size - 1 do
-    pr "  | %s%i wx => %s%i (w%i_square_c wx)" c i c (i+1) i
-  done;
-  pr "  | %s%i wx => %sn 0 (w%i_square_c wx)" c size c size;
-  pr "  | %sn n wx =>" c;
-  pr "    let op := make_op n in";
-  pr "    %sn (S n) (op.(znz_square_c) wx)" c;
-  pr "  end.";
-  pr "";
-
-  pr " Theorem spec_square: forall x, [square x] = [x] * [x].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp "  intros x; case x; unfold square; clear x.";
-  pp "  intros x; rewrite spec_reduce_1; unfold to_Z.";
-  pp "   exact (spec_square_c w%i_spec x)." 0;
-  for i = 1 to size do
-    pp "  intros x; unfold to_Z.";
-    pp "    exact (spec_square_c w%i_spec x)." i;
-  done;
-  pp "  intros n x; unfold to_Z.";
-  pp "    rewrite make_op_S.";
-  pp "    exact (spec_square_c (wn_spec n) x).";
-  pp "Qed.";
-  pr "";
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Square root                       *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_sqrt := w%i_op.(znz_sqrt)." i i
-  done;
-  pr "";
-
-  pr " Definition sqrt x :=";
-  pr "  match x with";
-  for i = 0 to size do
-    pr "  | %s%i wx => reduce_%i (w%i_sqrt wx)" c i i i;
-  done;
-  pr "  | %sn n wx =>" c;
-  pr "    let op := make_op n in";
-  pr "    reduce_n n (op.(znz_sqrt) wx)";
-  pr "  end.";
-  pr "";
-
-  pr " Theorem spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2.";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; unfold sqrt; case x; clear x.";
-  for i = 0 to size do
-    pp " intros x; rewrite spec_reduce_%i; exact (spec_sqrt w%i_spec x)." i i;
-  done;
-  pp " intros n x; rewrite spec_reduce_n; exact (spec_sqrt (wn_spec n) x).";
-  pp " Qed.";
-  pr "";
-
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Division                          *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_div_gt := w%i_op.(znz_div_gt)." i i
-  done;
-  pr "";
-
-  pp " Let spec_divn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) :=";
-  pp "   (spec_double_divn1";
-  pp "    ww_op.(znz_zdigits) ww_op.(znz_0)";
-  pp "    (znz_WW ww_op) ww_op.(znz_head0)";
-  pp "    ww_op.(znz_add_mul_div) ww_op.(znz_div21)";
-  pp "    ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)";
-  pp "    (spec_to_Z ww_spec)";
-  pp "    (spec_zdigits ww_spec)";
-  pp "   (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)";
-  pp "   (spec_add_mul_div ww_spec) (spec_div21 ww_spec)";
-  pp "    (CyclicAxioms.spec_compare ww_spec) (CyclicAxioms.spec_sub ww_spec)).";
-  pp "";
-
-  for i = 0 to size do
-    pr " Definition w%i_divn1 n x y :="  i;
-    pr "  let (u, v) :=";
-    pr "  double_divn1 w%i_op.(znz_zdigits) w%i_op.(znz_0)" i i;
-    pr "    (znz_WW w%i_op) w%i_op.(znz_head0)" i i;
-    pr "    w%i_op.(znz_add_mul_div) w%i_op.(znz_div21)" i i;
-    pr "    w%i_op.(znz_compare) w%i_op.(znz_sub) (S n) x y in" i i;
-    if i == size then
-      pr "   (%sn _ u, %s%i v)." c c i
-    else
-      pr "   (to_Z%i _ u, %s%i v)." i c i;
-  done;
-  pr "";
-
-  for i = 0 to size do
-    pp " Lemma spec_get_end%i: forall n x y," i;
-    pp "    eval%in n x  <= [%s%i y] ->" i c i;
-    pp "     [%s%i (DoubleBase.get_low %s n x)] = eval%in n x." c i (pz i) i;
-    pp " Proof.";
-    pp " intros n x y H.";
-    pp " rewrite spec_double_eval%in; unfold to_Z." i;
-    pp " apply DoubleBase.spec_get_low.";
-    pp " exact (spec_0 w%i_spec)." i;
-    pp " exact (spec_to_Z w%i_spec)." i;
-    pp " apply Zle_lt_trans with [%s%i y]; auto." c i;
-    pp "   rewrite <- spec_double_eval%in; auto." i;
-    pp " unfold to_Z; case (spec_to_Z w%i_spec y); auto." i;
-    pp " Qed.";
-    pp "";
-  done;
-
-  for i = 0 to size do
-    pr " Let div_gt%i x y := let (u,v) := (w%i_div_gt x y) in (reduce_%i u, reduce_%i v)." i i i i;
-  done;
-  pr "";
-
-
-  pr " Let div_gtnm n m wx wy :=";
-  pr "    let mn := Max.max n m in";
-  pr "    let d := diff n m in";
-  pr "    let op := make_op mn in";
-  pr "    let (q, r):= op.(znz_div_gt)";
-  pr "         (castm (diff_r n m) (extend_tr wx (snd d)))";
-  pr "         (castm (diff_l n m) (extend_tr wy (fst d))) in";
-  pr "    (reduce_n mn q, reduce_n mn r).";
-  pr "";
-
-  pr " Definition div_gt := Eval lazy beta delta [iter] in";
-  pr "   (iter _";
-  for i = 0 to size do
-    pr "      div_gt%i" i;
-    pr "      (fun n x y => div_gt%i x (DoubleBase.get_low %s (S n) y))" i (pz i);
-    pr "      w%i_divn1" i;
-  done;
-  pr "      div_gtnm).";
-  pr "";
-
-  pr " Theorem spec_div_gt: forall x y,";
-  pr "       [x] > [y] -> 0 < [y] ->";
-  pr "      let (q,r) := div_gt x y in";
-  pr "      [q] = [x] / [y] /\\ [r] = [x] mod [y].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " assert (FO:";
-  pp "   forall x y, [x] > [y] -> 0 < [y] ->";
-  pp "      let (q,r) := div_gt x y in";
-  pp "      [x] = [q] * [y] + [r] /\\ 0 <= [r] < [y]).";
-  pp "  refine (spec_iter (t_*t_) (fun x y res => x > y -> 0 < y ->";
-  pp "      let (q,r) := res in";
-  pp "      x = [q] * y + [r] /\\ 0 <= [r] < y)";
-  for i = 0 to size do
-    pp "      div_gt%i" i;
-    pp "      (fun n x y => div_gt%i x (DoubleBase.get_low %s (S n) y))" i (pz i);
-    pp "      w%i_divn1 _ _ _" i;
-  done;
-  pp "      div_gtnm _).";
-  for i = 0 to size do
-    pp "  intros x y H1 H2; unfold div_gt%i, w%i_div_gt." i i;
-    pp "    generalize (spec_div_gt w%i_spec x y H1 H2); case znz_div_gt." i;
-    pp "    intros xx yy; repeat rewrite spec_reduce_%i; auto." i;
-    if i == size then
-      pp "  intros n x y H2 H3; unfold div_gt%i, w%i_div_gt." i i
-    else
-      pp "  intros n x y H1 H2 H3; unfold div_gt%i, w%i_div_gt." i i;
-    pp "    generalize (spec_div_gt w%i_spec x" i;
-    pp "                (DoubleBase.get_low %s (S n) y))." (pz i);
-    pp0 "";
-    for j = 0 to i do
-      pp0 "unfold w%i; " (i-j);
-    done;
-    pp "case znz_div_gt.";
-    pp "    intros xx yy H4; repeat rewrite spec_reduce_%i." i;
-    pp "    generalize (spec_get_end%i (S n) y x); unfold to_Z; intros H5." i;
-    pp "    unfold to_Z in H2; rewrite H5 in H4; auto with zarith.";
-    if i == size then
-      pp "  intros n x y H2 H3."
-    else
-      pp "  intros n x y H1 H2 H3.";
-    pp "    generalize";
-    pp "     (spec_divn1 w%i w%i_op w%i_spec (S n) x y H3)." i i i;
-    pp0 "    unfold w%i_divn1; " i;
-    for j = 0 to i do
-      pp0 "unfold w%i; " (i-j);
-    done;
-    pp "case double_divn1.";
-    pp "    intros xx yy H4.";
-    if i == size then
-      begin
-        pp "    repeat rewrite <- spec_double_eval%in in H4; auto." i;
-        pp "    rewrite spec_eval%in; auto." i;
-      end
-    else
-      begin
-        pp "    rewrite to_Z%i_spec; auto with zarith." i;
-        pp "    repeat rewrite <- spec_double_eval%in in H4; auto." i;
-      end;
-  done;
-  pp "  intros n m x y H1 H2; unfold div_gtnm.";
-  pp "    generalize (spec_div_gt (wn_spec (Max.max n m))";
-  pp "                   (castm (diff_r n m)";
-  pp "                     (extend_tr x (snd (diff n m))))";
-  pp "                   (castm (diff_l n m)";
-  pp "                     (extend_tr y (fst (diff n m))))).";
-  pp "    case znz_div_gt.";
-  pp "    intros xx yy HH.";
-  pp "    repeat rewrite spec_reduce_n.";
-  pp "    rewrite <- (spec_cast_l n m x).";
-  pp "    rewrite <- (spec_cast_r n m y).";
-  pp "    unfold to_Z; apply HH.";
-  pp "    rewrite <- (spec_cast_l n m x) in H1; auto.";
-  pp "    rewrite <- (spec_cast_r n m y) in H1; auto.";
-  pp "    rewrite <- (spec_cast_r n m y) in H2; auto.";
-  pp "  intros x y H1 H2; generalize (FO x y H1 H2); case div_gt.";
-  pp "  intros q r (H3, H4); split.";
-  pp "  apply (Zdiv_unique [x] [y] [q] [r]); auto.";
-  pp "  rewrite Zmult_comm; auto.";
-  pp "  apply (Zmod_unique [x] [y] [q] [r]); auto.";
-  pp "  rewrite Zmult_comm; auto.";
-  pp "  Qed.";
-  pr "";
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                        Modulo                            *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_mod_gt := w%i_op.(znz_mod_gt)." i i
-  done;
-  pr "";
-
-  for i = 0 to size do
-    pr " Definition w%i_modn1 :=" i;
-    pr "  double_modn1 w%i_op.(znz_zdigits) w%i_op.(znz_0)" i i;
-    pr "    w%i_op.(znz_head0) w%i_op.(znz_add_mul_div) w%i_op.(znz_div21)" i i i;
-    pr "    w%i_op.(znz_compare) w%i_op.(znz_sub)." i i;
-  done;
-  pr "";
-
-  pr " Let mod_gtnm n m wx wy :=";
-  pr "    let mn := Max.max n m in";
-  pr "    let d := diff n m in";
-  pr "    let op := make_op mn in";
-  pr "    reduce_n mn (op.(znz_mod_gt)";
-  pr "         (castm (diff_r n m) (extend_tr wx (snd d)))";
-  pr "         (castm (diff_l n m) (extend_tr wy (fst d)))).";
-  pr "";
-
-  pr " Definition mod_gt := Eval lazy beta delta[iter] in";
-  pr "   (iter _";
-  for i = 0 to size do
-    pr "      (fun x y => reduce_%i (w%i_mod_gt x y))" i i;
-    pr "      (fun n x y => reduce_%i (w%i_mod_gt x (DoubleBase.get_low %s (S n) y)))" i i (pz i);
-    pr "      (fun n x y => reduce_%i (w%i_modn1 (S n) x y))" i i;
-  done;
-  pr "      mod_gtnm).";
-  pr "";
-
-  pp " Let spec_modn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) :=";
-  pp "   (spec_double_modn1";
-  pp "    ww_op.(znz_zdigits) ww_op.(znz_0)";
-  pp "    (znz_WW ww_op) ww_op.(znz_head0)";
-  pp "    ww_op.(znz_add_mul_div) ww_op.(znz_div21)";
-  pp "    ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)";
-  pp "    (spec_to_Z ww_spec)";
-  pp "    (spec_zdigits ww_spec)";
-  pp "   (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)";
-  pp "   (spec_add_mul_div ww_spec) (spec_div21 ww_spec)";
-  pp "    (CyclicAxioms.spec_compare ww_spec) (CyclicAxioms.spec_sub ww_spec)).";
-  pp "";
-
-  pr " Theorem spec_mod_gt:";
-  pr "   forall x y, [x] > [y] -> 0 < [y] -> [mod_gt x y] = [x] mod [y].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " refine (spec_iter _ (fun x y res => x > y -> 0 < y ->";
-  pp "      [res] = x mod y)";
-  for i = 0 to size do
-    pp "      (fun x y => reduce_%i (w%i_mod_gt x y))" i i;
-    pp "      (fun n x y => reduce_%i (w%i_mod_gt x (DoubleBase.get_low %s (S n) y)))" i i (pz i);
-    pp "      (fun n x y => reduce_%i (w%i_modn1 (S n) x y)) _ _ _" i i;
-  done;
-  pp "      mod_gtnm _).";
-  for i = 0 to size do
-    pp " intros x y H1 H2; rewrite spec_reduce_%i." i;
-    pp "   exact (spec_mod_gt w%i_spec x y H1 H2)." i;
-    if i == size then
-      pp " intros n x y H2 H3; rewrite spec_reduce_%i." i
-    else
-      pp " intros n x y H1 H2 H3; rewrite spec_reduce_%i." i;
-    pp " unfold w%i_mod_gt." i;
-    pp " rewrite <- (spec_get_end%i (S n) y x); auto with zarith." i;
-    pp " unfold to_Z; apply (spec_mod_gt w%i_spec); auto." i;
-    pp " rewrite <- (spec_get_end%i (S n) y x) in H2; auto with zarith." i;
-    pp " rewrite <- (spec_get_end%i (S n) y x) in H3; auto with zarith." i;
-    if i == size then
-      pp " intros n x y H2 H3; rewrite spec_reduce_%i." i
-    else
-      pp " intros n x y H1 H2 H3; rewrite spec_reduce_%i." i;
-    pp " unfold w%i_modn1, to_Z; rewrite spec_double_eval%in." i i;
-    pp " apply (spec_modn1 _ _ w%i_spec); auto." i;
-  done;
-  pp " intros n m x y H1 H2; unfold mod_gtnm.";
-  pp "    repeat rewrite spec_reduce_n.";
-  pp "    rewrite <- (spec_cast_l n m x).";
-  pp "    rewrite <- (spec_cast_r n m y).";
-  pp "    unfold to_Z; apply (spec_mod_gt (wn_spec (Max.max n m))).";
-  pp "    rewrite <- (spec_cast_l n m x) in H1; auto.";
-  pp "    rewrite <- (spec_cast_r n m y) in H1; auto.";
-  pp "    rewrite <- (spec_cast_r n m y) in H2; auto.";
-  pp " Qed.";
-  pr "";
-
-  pr " (** digits: a measure for gcd *)";
-  pr "";
-
-  pr " Definition digits x :=";
-  pr "  match x with";
-  for i = 0 to size do
-    pr "  | %s%i _ => w%i_op.(znz_digits)" c i i;
-  done;
-  pr "  | %sn n _ => (make_op n).(znz_digits)" c;
-  pr "  end.";
-  pr "";
-
-  pr " Theorem spec_digits: forall x, 0 <= [x] < 2 ^  Zpos (digits x).";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; clear x.";
-  for i = 0 to size do
-    pp "  intros x; unfold to_Z, digits;";
-    pp "   generalize (spec_to_Z w%i_spec x); unfold base; intros H; exact H." i;
-  done;
-  pp "  intros n x; unfold to_Z, digits;";
-  pp "   generalize (spec_to_Z (wn_spec n) x); unfold base; intros H; exact H.";
-  pp " Qed.";
-  pr "";
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                       Conversion                         *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  pr " Definition pheight p :=";
-  pr "   Peano.pred (nat_of_P (get_height w0_op.(znz_digits) (plength p))).";
-  pr "";
-
-  pr " Theorem pheight_correct: forall p,";
-  pr "    Zpos p < 2 ^ (Zpos (znz_digits w0_op) * 2 ^ (Z_of_nat (pheight p))).";
-  pr " Proof.";
-  pr " intros p; unfold pheight.";
-  pr " assert (F1: forall x, Z_of_nat (Peano.pred (nat_of_P x)) = Zpos x - 1).";
-  pr "  intros x.";
-  pr "  assert (Zsucc (Z_of_nat (Peano.pred (nat_of_P x))) = Zpos x); auto with zarith.";
-  pr "    rewrite <- inj_S.";
-  pr "    rewrite <- (fun x => S_pred x 0); auto with zarith.";
-  pr "    rewrite Zpos_eq_Z_of_nat_o_nat_of_P; auto.";
-  pr "    apply lt_le_trans with 1%snat; auto with zarith." "%";
-  pr "    exact (le_Pmult_nat x 1).";
-  pr "  rewrite F1; clear F1.";
-  pr " assert (F2:= (get_height_correct (znz_digits w0_op) (plength p))).";
-  pr " apply Zlt_le_trans with (Zpos (Psucc p)).";
-  pr "   rewrite Zpos_succ_morphism; auto with zarith.";
-  pr "  apply Zle_trans with (1 := plength_pred_correct (Psucc p)).";
-  pr " rewrite Ppred_succ.";
-  pr " apply Zpower_le_monotone; auto with zarith.";
-  pr " Qed.";
-  pr "";
-
-  pr " Definition of_pos x :=";
-  pr "  let h := pheight x in";
-  pr "  match h with";
-  for i = 0 to size do
-    pr "  | %i%snat => reduce_%i (snd (w%i_op.(znz_of_pos) x))" i "%" i i;
-  done;
-  pr "  | _ =>";
-  pr "    let n := minus h %i in" (size + 1);
-  pr "    reduce_n n (snd ((make_op n).(znz_of_pos) x))";
-  pr "  end.";
-  pr "";
-
-  pr " Theorem spec_of_pos: forall x,";
-  pr "   [of_pos x] = Zpos x.";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " assert (F := spec_more_than_1_digit w0_spec).";
-  pp " intros x; unfold of_pos; case_eq (pheight x).";
-  for i = 0 to size do
-    if i <> 0 then
-      pp " intros n; case n; clear n.";
-    pp " intros H1; rewrite spec_reduce_%i; unfold to_Z." i;
-    pp " apply (znz_of_pos_correct w%i_spec)." i;
-    pp " apply Zlt_le_trans with (1 := pheight_correct x).";
-    pp "   rewrite H1; simpl Z_of_nat; change (2^%i) with (%s)." i (gen2 i);
-    pp "   unfold base.";
-    pp "   apply Zpower_le_monotone; split; auto with zarith.";
-    if i <> 0 then
-      begin
-        pp "   rewrite Zmult_comm; repeat rewrite <- Zmult_assoc.";
-        pp "     repeat rewrite <- Zpos_xO.";
-        pp "   refine (Zle_refl _).";
-      end;
-  done;
-  pp " intros n.";
-  pp " intros H1; rewrite spec_reduce_n; unfold to_Z.";
-  pp " simpl minus; rewrite <- minus_n_O.";
-  pp " apply (znz_of_pos_correct (wn_spec n)).";
-  pp " apply Zlt_le_trans with (1 := pheight_correct x).";
-  pp "   unfold base.";
-  pp "   apply Zpower_le_monotone; auto with zarith.";
-  pp "   split; auto with zarith.";
-  pp "   rewrite H1.";
-  pp "  elim n; clear n H1.";
-  pp "   simpl Z_of_nat; change (2^%i) with (%s)." (size + 1) (gen2 (size + 1));
-  pp "   rewrite Zmult_comm; repeat rewrite <- Zmult_assoc.";
-  pp "     repeat rewrite <- Zpos_xO.";
-  pp "   refine (Zle_refl _).";
-  pp "  intros n Hrec.";
-  pp "  rewrite make_op_S.";
-  pp "  change (@znz_digits (word _ (S (S n))) (mk_zn2z_op_karatsuba (make_op n))) with";
-  pp "    (xO (znz_digits (make_op n))).";
-  pp "  rewrite (fun x y => (Zpos_xO (@znz_digits x y))).";
-  pp "  rewrite inj_S; unfold Zsucc.";
-  pp "  rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith.";
-  pp "  rewrite Zpower_1_r.";
-  pp "  assert (tmp: forall x y z, x * (y * z) = y * (x * z));";
-  pp "   [intros; ring | rewrite tmp; clear tmp].";
-  pp "  apply Zmult_le_compat_l; auto with zarith.";
-  pp "  Qed.";
-  pr "";
-
-  pr " (***************************************************************)";
-  pr " (*                                                             *)";
-  pr " (** *                       Shift                              *)";
-  pr " (*                                                             *)";
-  pr " (***************************************************************)";
-  pr "";
-
-  (* Head0 *)
-  pr " Definition head0 w := match w with";
-  for i = 0 to size do
-    pr " | %s%i w=> reduce_%i (w%i_op.(znz_head0) w)"  c i i i;
-  done;
-  pr " | %sn n w=> reduce_n n ((make_op n).(znz_head0) w)" c;
-  pr " end.";
-  pr "";
-
-  pr " Theorem spec_head00: forall x, [x] = 0 ->[head0 x] = Zpos (digits x).";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; unfold head0; clear x.";
-  for i = 0 to size do
-    pp "   intros x; rewrite spec_reduce_%i; exact (spec_head00 w%i_spec x)." i i;
-  done;
-  pp " intros n x; rewrite spec_reduce_n; exact (spec_head00 (wn_spec n) x).";
-  pp " Qed.";
-  pr "";
-
-  pr " Theorem spec_head0: forall x, 0 < [x] ->";
-  pr "   2 ^ (Zpos (digits x) - 1) <= 2 ^ [head0 x] * [x] < 2 ^ Zpos (digits x).";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " assert (F0: forall x, (x - 1) + 1 = x).";
-  pp "   intros; ring.";
-  pp " intros x; case x; unfold digits, head0; clear x.";
-  for i = 0 to size do
-    pp " intros x Hx; rewrite spec_reduce_%i." i;
-    pp " assert (F1:= spec_more_than_1_digit w%i_spec)." i;
-    pp " generalize (spec_head0 w%i_spec x Hx)." i;
-    pp " unfold base.";
-    pp " pattern (Zpos (znz_digits w%i_op)) at 1;" i;
-    pp " rewrite <- (fun x => (F0 (Zpos x))).";
-    pp " rewrite Zpower_exp; auto with zarith.";
-    pp " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith.";
-  done;
-  pp " intros n x Hx; rewrite spec_reduce_n.";
-  pp " assert (F1:= spec_more_than_1_digit (wn_spec n)).";
-  pp " generalize (spec_head0 (wn_spec n) x Hx).";
-  pp " unfold base.";
-  pp " pattern (Zpos (znz_digits (make_op n))) at 1;";
-  pp " rewrite <- (fun x => (F0 (Zpos x))).";
-  pp " rewrite Zpower_exp; auto with zarith.";
-  pp " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith.";
-  pp " Qed.";
-  pr "";
-
-
-  (* Tail0 *)
-  pr " Definition tail0 w := match w with";
-  for i = 0 to size do
-    pr " | %s%i w=> reduce_%i (w%i_op.(znz_tail0) w)"  c i i i;
-  done;
-  pr " | %sn n w=> reduce_n n ((make_op n).(znz_tail0) w)" c;
-  pr " end.";
-  pr "";
-
-
-  pr " Theorem spec_tail00: forall x, [x] = 0 ->[tail0 x] = Zpos (digits x).";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; unfold tail0; clear x.";
-  for i = 0 to size do
-    pp "   intros x; rewrite spec_reduce_%i; exact (spec_tail00 w%i_spec x)." i i;
-  done;
-  pp " intros n x; rewrite spec_reduce_n; exact (spec_tail00 (wn_spec n) x).";
-  pp " Qed.";
-  pr "";
-
-
-  pr " Theorem spec_tail0: forall x,";
-  pr "   0 < [x] -> exists y, 0 <= y /\\ [x] = (2 * y + 1) * 2 ^ [tail0 x].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; clear x; unfold tail0.";
-  for i = 0 to size do
-    pp " intros x Hx; rewrite spec_reduce_%i; exact (spec_tail0 w%i_spec x Hx)." i  i;
-  done;
-  pp " intros n x Hx; rewrite spec_reduce_n; exact (spec_tail0 (wn_spec n) x Hx).";
-  pp " Qed.";
-  pr "";
-
-
-  (* Number of digits *)
-  pr " Definition %sdigits x :=" c;
-  pr "  match x with";
-  pr "  | %s0 _ => %s0 w0_op.(znz_zdigits)" c c;
-  for i = 1 to size do
-    pr "  | %s%i _ => reduce_%i w%i_op.(znz_zdigits)" c i i i;
-  done;
-  pr "  | %sn n _ => reduce_n n (make_op n).(znz_zdigits)" c;
-  pr "  end.";
-  pr "";
-
-  pr " Theorem spec_Ndigits: forall x, [Ndigits x] = Zpos (digits x).";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; clear x; unfold Ndigits, digits.";
-  for i = 0 to size do
-    pp " intros _; try rewrite spec_reduce_%i; exact (spec_zdigits w%i_spec)." i i;
-  done;
-  pp " intros n _; try rewrite spec_reduce_n; exact (spec_zdigits (wn_spec n)).";
-  pp " Qed.";
-  pr "";
-
-
-  (* Shiftr *)
-  for i = 0 to size do
-    pr " Definition unsafe_shiftr%i n x := w%i_op.(znz_add_mul_div) (w%i_op.(znz_sub) w%i_op.(znz_zdigits) n) w%i_op.(znz_0) x." i i i i i;
-  done;
-  pr " Definition unsafe_shiftrn n p x := (make_op n).(znz_add_mul_div) ((make_op n).(znz_sub) (make_op n).(znz_zdigits) p) (make_op n).(znz_0) x.";
-  pr "";
-
-  pr " Definition unsafe_shiftr := Eval lazy beta delta [same_level] in";
-  pr "     same_level _ (fun n x => %s0 (unsafe_shiftr0 n x))" c;
-  for i = 1 to size do
-    pr "           (fun n x => reduce_%i (unsafe_shiftr%i n x))" i i;
-  done;
-  pr "           (fun n p x => reduce_n n (unsafe_shiftrn n p x)).";
-  pr "";
-
-
-  pr " Theorem spec_unsafe_shiftr: forall n x,";
-  pr "  [n] <= [Ndigits x] -> [unsafe_shiftr n x] = [x] / 2 ^ [n].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " assert (F0: forall x y, x - (x - y) = y).";
-  pp "   intros; ring.";
-  pp " assert (F2: forall x y z, 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z).";
-  pp "   intros x y z HH HH1 HH2.";
-  pp "   split; auto with zarith.";
-  pp "   apply Zle_lt_trans with (2 := HH2); auto with zarith.";
-  pp "   apply Zdiv_le_upper_bound; auto with zarith.";
-  pp "   pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith.";
-  pp "   apply Zmult_le_compat_l; auto.";
-  pp "   apply Zpower_le_monotone; auto with zarith.";
-  pp "   rewrite Zpower_0_r; ring.";
-  pp "  assert (F3: forall x y, 0 <= y -> y <= x -> 0 <= x - y < 2 ^ x).";
-  pp "    intros xx y HH HH1.";
-  pp "    split; auto with zarith.";
-  pp "    apply Zle_lt_trans with xx; auto with zarith.";
-  pp "    apply Zpower2_lt_lin; auto with zarith.";
-  pp "  assert (F4: forall ww ww1 ww2";
-  pp "         (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)";
-  pp "           xx yy xx1 yy1,";
-  pp "  znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_zdigits ww1_op) ->";
-  pp "  znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) ->";
-  pp "  znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op ->";
-  pp "  znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx ->";
-  pp "  znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy ->";
-  pp "  znz_to_Z ww_op";
-  pp "  (znz_add_mul_div ww_op (znz_sub ww_op (znz_zdigits ww_op)  yy1)";
-  pp "     (znz_0 ww_op) xx1) = znz_to_Z ww1_op xx / 2 ^ znz_to_Z ww2_op yy).";
-  pp "  intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy.";
-  pp "     case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2.";
-  pp "     case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4.";
-  pp "     rewrite <- Hx.";
-  pp "     rewrite <- Hy.";
-  pp "     generalize (spec_add_mul_div Hw";
-  pp "                  (znz_0 ww_op) xx1";
-  pp "                  (znz_sub ww_op (znz_zdigits ww_op)";
-  pp "                    yy1)";
-  pp "                ).";
-  pp "     rewrite (spec_0 Hw).";
-  pp "     rewrite Zmult_0_l; rewrite Zplus_0_l.";
-  pp "     rewrite (CyclicAxioms.spec_sub Hw).";
-  pp "     rewrite Zmod_small; auto with zarith.";
-  pp "     rewrite (spec_zdigits Hw).";
-  pp "     rewrite F0.";
-  pp "     rewrite Zmod_small; auto with zarith.";
-  pp "     unfold base; rewrite (spec_zdigits Hw) in Hl1 |- *;";
-  pp "      auto with zarith.";
-  pp "  assert (F5: forall n m, (n <= m)%snat ->" "%";
-  pp "     Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m))).";
-  pp "    intros n m HH; elim HH; clear m HH; auto with zarith.";
-  pp "    intros m HH Hrec; apply Zle_trans with (1 := Hrec).";
-  pp "    rewrite make_op_S.";
-  pp "    match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end.";
-  pp "    rewrite Zpos_xO.";
-  pp "    assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith.";
-  pp "  assert (F6: forall n, Zpos (znz_digits w%i_op) <= Zpos (znz_digits (make_op n)))." size;
-  pp "    intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0))).";
-  pp "    change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op))." size;
-  pp "    rewrite Zpos_xO.";
-  pp "    assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." size;
-  pp "    apply F5; auto with arith.";
-  pp "  intros x; case x; clear x; unfold unsafe_shiftr, same_level.";
-  for i = 0 to size do
-    pp "    intros x y; case y; clear y.";
-    for j = 0 to i - 1 do
-      pp "     intros y; unfold unsafe_shiftr%i, Ndigits." i;
-      pp "       repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j;
-      pp "       apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i j i;
-      pp "       rewrite (spec_zdigits w%i_spec)." i;
-      pp "       rewrite (spec_zdigits w%i_spec)." j;
-      pp "       change (znz_digits w%i_op) with %s." i (genxO (i - j) (" (znz_digits w"^(string_of_int j)^"_op)"));
-      pp "       repeat rewrite (fun x => Zpos_xO (xO x)).";
-      pp "       repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)).";
-      pp "       assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." j;
-      pp "       try (apply sym_equal; exact (spec_extend%in%i y))." j i;
-
-    done;
-    pp "     intros y; unfold unsafe_shiftr%i, Ndigits." i;
-    pp "     repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i;
-    pp "       apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i i i;
-    for j = i + 1 to size do
-      pp "     intros y; unfold unsafe_shiftr%i, Ndigits." j;
-      pp "       repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j;
-      pp "       apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." j j i;
-      pp "       try (apply sym_equal; exact (spec_extend%in%i x))." i j;
-    done;
-    if i == size then
-      begin
-        pp "     intros m y; unfold unsafe_shiftrn, Ndigits.";
-        pp "       repeat rewrite spec_reduce_n; unfold to_Z; intros H1.";
-        pp "       apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." size;
-        pp "       try (apply sym_equal; exact (spec_extend%in m x))." size;
-      end
-    else
-      begin
-        pp "     intros m y; unfold unsafe_shiftrn, Ndigits.";
-        pp "       repeat rewrite spec_reduce_n; unfold to_Z; intros H1.";
-        pp "       apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." i;
-        pp "       change ([Nn m (extend%i m (extend%i %i x))] = [N%i x])." size i (size - i - 1) i;
-        pp "       rewrite <- (spec_extend%in m); rewrite <- spec_extend%in%i; auto." size i size;
-      end
-  done;
-  pp "    intros n x y; case y; clear y;";
-  pp "     intros y; unfold unsafe_shiftrn, Ndigits; try rewrite spec_reduce_n.";
-  for i = 0 to size do
-    pp "     try rewrite spec_reduce_%i; unfold to_Z; intros H1." i;
-    pp "       apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith." i;
-    pp "       rewrite (spec_zdigits w%i_spec)." i;
-    pp "       rewrite (spec_zdigits (wn_spec n)).";
-    pp "       apply Zle_trans with (2 := F6 n).";
-    pp "       change (znz_digits w%i_op) with %s." size (genxO (size - i) ("(znz_digits w" ^ (string_of_int i) ^ "_op)"));
-    pp "       repeat rewrite (fun x => Zpos_xO (xO x)).";
-    pp "       repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)).";
-    pp "       assert (H: 0 <= Zpos (znz_digits w%i_op)); auto with zarith." i;
-    if i == size then
-      pp "       change ([Nn n (extend%i n y)] = [N%i y])." size i
-    else
-      pp "       change ([Nn n (extend%i n (extend%i %i y))] = [N%i y])." size i (size - i - 1) i;
-    pp "       rewrite <- (spec_extend%in n); auto." size;
-    if i <> size then
-      pp "       try (rewrite <- spec_extend%in%i; auto)." i size;
-  done;
-  pp "     generalize y; clear y; intros m y.";
-  pp "     rewrite spec_reduce_n; unfold to_Z; intros H1.";
-  pp "       apply F4 with (3:=(wn_spec (Max.max n m)))(4:=wn_spec m)(5:=wn_spec n); auto with zarith.";
-  pp "     rewrite (spec_zdigits (wn_spec m)).";
-  pp "     rewrite (spec_zdigits (wn_spec (Max.max n m))).";
-  pp "     apply F5; auto with arith.";
-  pp "     exact (spec_cast_r n m y).";
-  pp "     exact (spec_cast_l n m x).";
-  pp " Qed.";
-  pr "";
-
-  (* Unsafe_Shiftl *)
-  for i = 0 to size do
-    pr " Definition unsafe_shiftl%i n x := w%i_op.(znz_add_mul_div) n x w%i_op.(znz_0)." i i i
-  done;
-  pr " Definition unsafe_shiftln n p x := (make_op n).(znz_add_mul_div) p x (make_op n).(znz_0).";
-  pr " Definition unsafe_shiftl := Eval lazy beta delta [same_level] in";
-  pr "    same_level _ (fun n x => %s0 (unsafe_shiftl0 n x))" c;
-  for i = 1 to size do
-    pr "           (fun n x => reduce_%i (unsafe_shiftl%i n x))" i i;
-  done;
-  pr "           (fun n p x => reduce_n n (unsafe_shiftln n p x)).";
-  pr "";
-  pr "";
-
-
-  pr " Theorem spec_unsafe_shiftl: forall n x,";
-  pr "  [n] <= [head0 x] -> [unsafe_shiftl n x] = [x] * 2 ^ [n].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " assert (F0: forall x y, x - (x - y) = y).";
-  pp "   intros; ring.";
-  pp " assert (F2: forall x y z, 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z).";
-  pp "   intros x y z HH HH1 HH2.";
-  pp "   split; auto with zarith.";
-  pp "   apply Zle_lt_trans with (2 := HH2); auto with zarith.";
-  pp "   apply Zdiv_le_upper_bound; auto with zarith.";
-  pp "   pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith.";
-  pp "   apply Zmult_le_compat_l; auto.";
-  pp "   apply Zpower_le_monotone; auto with zarith.";
-  pp "   rewrite Zpower_0_r; ring.";
-  pp "  assert (F3: forall x y, 0 <= y -> y <= x -> 0 <= x - y < 2 ^ x).";
-  pp "    intros xx y HH HH1.";
-  pp "    split; auto with zarith.";
-  pp "    apply Zle_lt_trans with xx; auto with zarith.";
-  pp "    apply Zpower2_lt_lin; auto with zarith.";
-  pp "  assert (F4: forall ww ww1 ww2";
-  pp "         (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)";
-  pp "           xx yy xx1 yy1,";
-  pp "  znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_head0 ww1_op xx) ->";
-  pp "  znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) ->";
-  pp "  znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op ->";
-  pp "  znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx ->";
-  pp "  znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy ->";
-  pp "  znz_to_Z ww_op";
-  pp "  (znz_add_mul_div ww_op yy1";
-  pp "     xx1 (znz_0 ww_op)) = znz_to_Z ww1_op xx * 2 ^ znz_to_Z ww2_op yy).";
-  pp "  intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy.";
-  pp "     case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2.";
-  pp "     case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4.";
-  pp "     rewrite <- Hx.";
-  pp "     rewrite <- Hy.";
-  pp "     generalize (spec_add_mul_div Hw xx1 (znz_0 ww_op) yy1).";
-  pp "     rewrite (spec_0 Hw).";
-  pp "     assert (F1: znz_to_Z ww1_op (znz_head0 ww1_op xx) <= Zpos (znz_digits ww1_op)).";
-  pp "     case (Zle_lt_or_eq _ _ HH1); intros HH5.";
-  pp "     apply Zlt_le_weak.";
-  pp "     case (CyclicAxioms.spec_head0 Hw1 xx).";
-  pp "       rewrite <- Hx; auto.";
-  pp "     intros _ Hu; unfold base in Hu.";
-  pp "     case (Zle_or_lt (Zpos (znz_digits ww1_op))";
-  pp "                     (znz_to_Z ww1_op (znz_head0 ww1_op xx))); auto; intros H1.";
-  pp "     absurd (2 ^  (Zpos (znz_digits ww1_op)) <= 2 ^ (znz_to_Z ww1_op (znz_head0 ww1_op xx))).";
-  pp "       apply Zlt_not_le.";
-  pp "       case (spec_to_Z Hw1 xx); intros HHx3 HHx4.";
-  pp "       rewrite <- (Zmult_1_r (2 ^ znz_to_Z ww1_op (znz_head0 ww1_op xx))).";
-  pp "       apply Zle_lt_trans with (2 := Hu).";
-  pp "       apply Zmult_le_compat_l; auto with zarith.";
-  pp "     apply Zpower_le_monotone; auto with zarith.";
-  pp "     rewrite (CyclicAxioms.spec_head00 Hw1 xx); auto with zarith.";
-  pp "     rewrite Zdiv_0_l; auto with zarith.";
-  pp "     rewrite Zplus_0_r.";
-  pp "     case (Zle_lt_or_eq _ _ HH1); intros HH5.";
-  pp "     rewrite Zmod_small; auto with zarith.";
-  pp "     intros HH; apply HH.";
-  pp "     rewrite Hy; apply Zle_trans with (1:= Hl).";
-  pp "     rewrite <- (spec_zdigits Hw).";
-  pp "     apply Zle_trans with (2 := Hl1); auto.";
-  pp "     rewrite  (spec_zdigits Hw1); auto with zarith.";
-  pp "     split; auto with zarith .";
-  pp "     apply Zlt_le_trans with (base (znz_digits ww1_op)).";
-  pp "     rewrite Hx.";
-  pp "     case (CyclicAxioms.spec_head0 Hw1 xx); auto.";
-  pp "       rewrite <- Hx; auto.";
-  pp "     intros _ Hu; rewrite Zmult_comm in Hu.";
-  pp "     apply Zle_lt_trans with (2 := Hu).";
-  pp "     apply Zmult_le_compat_l; auto with zarith.";
-  pp "     apply Zpower_le_monotone; auto with zarith.";
-  pp "     unfold base; apply Zpower_le_monotone; auto with zarith.";
-  pp "     split; auto with zarith.";
-  pp "     rewrite <- (spec_zdigits Hw); auto with zarith.";
-  pp "     rewrite <- (spec_zdigits Hw1); auto with zarith.";
-  pp "     rewrite <- HH5.";
-  pp "     rewrite Zmult_0_l.";
-  pp "     rewrite Zmod_small; auto with zarith.";
-  pp "     intros HH; apply HH.";
-  pp "     rewrite Hy; apply Zle_trans with (1 := Hl).";
-  pp "     rewrite (CyclicAxioms.spec_head00 Hw1 xx); auto with zarith.";
-  pp "     rewrite <- (spec_zdigits Hw); auto with zarith.";
-  pp "     rewrite <- (spec_zdigits Hw1); auto with zarith.";
-  pp "  assert (F5: forall n m, (n <= m)%snat ->" "%";
-  pp "     Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m))).";
-  pp "    intros n m HH; elim HH; clear m HH; auto with zarith.";
-  pp "    intros m HH Hrec; apply Zle_trans with (1 := Hrec).";
-  pp "    rewrite make_op_S.";
-  pp "    match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end.";
-  pp "    rewrite Zpos_xO.";
-  pp "    assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith.";
-  pp "  assert (F6: forall n, Zpos (znz_digits w%i_op) <= Zpos (znz_digits (make_op n)))." size;
-  pp "    intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0))).";
-  pp "    change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op))." size;
-  pp "    rewrite Zpos_xO.";
-  pp "    assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." size;
-  pp "    apply F5; auto with arith.";
-  pp "  intros x; case x; clear x; unfold unsafe_shiftl, same_level.";
-  for i = 0 to size do
-    pp "    intros x y; case y; clear y.";
-    for j = 0 to i - 1 do
-      pp "     intros y; unfold unsafe_shiftl%i, head0." i;
-      pp "       repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j;
-      pp "       apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i j i;
-      pp "       rewrite (spec_zdigits w%i_spec)." i;
-      pp "       rewrite (spec_zdigits w%i_spec)." j;
-      pp "       change (znz_digits w%i_op) with %s." i (genxO (i - j) (" (znz_digits w"^(string_of_int j)^"_op)"));
-      pp "       repeat rewrite (fun x => Zpos_xO (xO x)).";
-      pp "       repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)).";
-      pp "       assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." j;
-      pp "       try (apply sym_equal; exact (spec_extend%in%i y))." j i;
-    done;
-    pp "     intros y; unfold unsafe_shiftl%i, head0." i;
-    pp "     repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i;
-    pp "       apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i i i;
-    for j = i + 1 to size do
-      pp "     intros y; unfold unsafe_shiftl%i, head0." j;
-      pp "       repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j;
-      pp "       apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." j j i;
-      pp "       try (apply sym_equal; exact (spec_extend%in%i x))." i j;
-    done;
-    if i == size then
-      begin
-        pp "     intros m y; unfold unsafe_shiftln, head0.";
-        pp "       repeat rewrite spec_reduce_n; unfold to_Z; intros H1.";
-        pp "       apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." size;
-        pp "       try (apply sym_equal; exact (spec_extend%in m x))." size;
-      end
-    else
-      begin
-        pp "     intros m y; unfold unsafe_shiftln, head0.";
-        pp "       repeat rewrite spec_reduce_n; unfold to_Z; intros H1.";
-        pp "       apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." i;
-        pp "       change ([Nn m (extend%i m (extend%i %i x))] = [N%i x])." size i (size - i - 1) i;
-        pp "       rewrite <- (spec_extend%in m); rewrite <- spec_extend%in%i; auto." size i size;
-      end
-  done;
-  pp "    intros n x y; case y; clear y;";
-  pp "     intros y; unfold unsafe_shiftln, head0; try rewrite spec_reduce_n.";
-  for i = 0 to size do
-    pp "     try rewrite spec_reduce_%i; unfold to_Z; intros H1." i;
-    pp "       apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith." i;
-    pp "       rewrite (spec_zdigits w%i_spec)." i;
-    pp "       rewrite (spec_zdigits (wn_spec n)).";
-    pp "       apply Zle_trans with (2 := F6 n).";
-    pp "       change (znz_digits w%i_op) with %s." size (genxO (size - i) ("(znz_digits w" ^ (string_of_int i) ^ "_op)"));
-    pp "       repeat rewrite (fun x => Zpos_xO (xO x)).";
-    pp "       repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)).";
-    pp "       assert (H: 0 <= Zpos (znz_digits w%i_op)); auto with zarith." i;
-    if i == size then
-      pp "       change ([Nn n (extend%i n y)] = [N%i y])." size i
-    else
-      pp "       change ([Nn n (extend%i n (extend%i %i y))] = [N%i y])." size i (size - i - 1) i;
-    pp "       rewrite <- (spec_extend%in n); auto." size;
-    if i <> size then
-      pp "       try (rewrite <- spec_extend%in%i; auto)." i size;
-  done;
-  pp "     generalize y; clear y; intros m y.";
-  pp "     repeat rewrite spec_reduce_n; unfold to_Z; intros H1.";
-  pp "       apply F4 with (3:=(wn_spec (Max.max n m)))(4:=wn_spec m)(5:=wn_spec n); auto with zarith.";
-  pp "     rewrite (spec_zdigits (wn_spec m)).";
-  pp "     rewrite (spec_zdigits (wn_spec (Max.max n m))).";
-  pp "     apply F5; auto with arith.";
-  pp "     exact (spec_cast_r n m y).";
-  pp "     exact (spec_cast_l n m x).";
-  pp " Qed.";
-  pr "";
-
-  (* Double size *)
-  pr " Definition double_size w := match w with";
-  for i = 0 to size-1 do
-    pr " | %s%i x => %s%i (WW (znz_0 w%i_op) x)" c i c (i + 1) i;
-  done;
-  pr " | %s%i x => %sn 0 (WW (znz_0 w%i_op) x)" c size c size;
-  pr " | %sn n x => %sn (S n) (WW (znz_0 (make_op n)) x)" c c;
-  pr " end.";
-  pr "";
-
-  pr " Theorem spec_double_size_digits:";
-  pr "   forall x, digits (double_size x) = xO (digits x).";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; unfold double_size, digits; clear x; auto.";
-  pp " intros n x; rewrite make_op_S; auto.";
-  pp " Qed.";
-  pr "";
-
-
-  pr " Theorem spec_double_size: forall x, [double_size x] = [x].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; unfold double_size; clear x.";
-  for i = 0 to size do
-    pp "   intros x; unfold to_Z, make_op;";
-    pp "     rewrite znz_to_Z_%i; rewrite (spec_0 w%i_spec); auto with zarith." (i + 1) i;
-  done;
-  pp "   intros n x; unfold to_Z;";
-  pp "     generalize (znz_to_Z_n n); simpl word.";
-  pp "     intros HH; rewrite HH; clear HH.";
-  pp "     generalize (spec_0 (wn_spec n)); simpl word.";
-  pp "     intros HH; rewrite HH; clear HH; auto with zarith.";
-  pp " Qed.";
-  pr "";
-
-
-  pr " Theorem spec_double_size_head0:";
-  pr "   forall x, 2 * [head0 x] <= [head0 (double_size x)].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x.";
-  pp " assert (F1:= spec_pos (head0 x)).";
-  pp " assert (F2: 0 < Zpos (digits x)).";
-  pp "   red; auto.";
-  pp " case (Zle_lt_or_eq _ _ (spec_pos x)); intros HH.";
-  pp " generalize HH; rewrite <- (spec_double_size x); intros HH1.";
-  pp " case (spec_head0 x HH); intros _ HH2.";
-  pp " case (spec_head0 _ HH1).";
-  pp " rewrite (spec_double_size x); rewrite (spec_double_size_digits x).";
-  pp " intros HH3 _.";
-  pp " case (Zle_or_lt ([head0 (double_size x)]) (2 * [head0 x])); auto; intros HH4.";
-  pp " absurd (2 ^ (2 * [head0 x] )* [x] < 2 ^ [head0 (double_size x)] * [x]); auto.";
-  pp " apply Zle_not_lt.";
-  pp " apply Zmult_le_compat_r; auto with zarith.";
-  pp " apply Zpower_le_monotone; auto; auto with zarith.";
-  pp " generalize (spec_pos (head0 (double_size x))); auto with zarith.";
-  pp " assert (HH5: 2 ^[head0 x] <= 2 ^(Zpos (digits x) - 1)).";
-  pp "   case (Zle_lt_or_eq 1 [x]); auto with zarith; intros HH5.";
-  pp "   apply Zmult_le_reg_r with (2 ^ 1); auto with zarith.";
-  pp "   rewrite <- (fun x y z => Zpower_exp x (y - z)); auto with zarith.";
-  pp "   assert (tmp: forall x, x - 1 + 1 = x); [intros; ring | rewrite tmp; clear tmp].";
-  pp "   apply Zle_trans with (2 := Zlt_le_weak _ _ HH2).";
-  pp "   apply Zmult_le_compat_l; auto with zarith.";
-  pp "   rewrite Zpower_1_r; auto with zarith.";
-  pp "   apply Zpower_le_monotone; auto with zarith.";
-  pp "   split; auto with zarith.";
-  pp "   case (Zle_or_lt (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6.";
-  pp "   absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith.";
-  pp "   rewrite <- HH5; rewrite Zmult_1_r.";
-  pp "   apply Zpower_le_monotone; auto with zarith.";
-  pp " rewrite (Zmult_comm 2).";
-  pp " rewrite Zpower_mult; auto with zarith.";
-  pp " rewrite Zpower_2.";
-  pp " apply Zlt_le_trans with (2 := HH3).";
-  pp " rewrite <- Zmult_assoc.";
-  pp " replace (Zpos (xO (digits x)) - 1) with";
-  pp "   ((Zpos (digits x) - 1) + (Zpos (digits x))).";
-  pp " rewrite Zpower_exp; auto with zarith.";
-  pp " apply Zmult_lt_compat2; auto with zarith.";
-  pp " split; auto with zarith.";
-  pp " apply Zmult_lt_0_compat; auto with zarith.";
-  pp " rewrite Zpos_xO; ring.";
-  pp " apply Zlt_le_weak; auto.";
-  pp " repeat rewrite spec_head00; auto.";
-  pp " rewrite spec_double_size_digits.";
-  pp " rewrite Zpos_xO; auto with zarith.";
-  pp " rewrite spec_double_size; auto.";
-  pp " Qed.";
-  pr "";
-
-  pr " Theorem spec_double_size_head0_pos:";
-  pr "   forall x, 0 < [head0 (double_size x)].";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x.";
-  pp " assert (F: 0 < Zpos (digits x)).";
-  pp "  red; auto.";
-  pp " case (Zle_lt_or_eq _ _ (spec_pos (head0 (double_size x)))); auto; intros F0.";
-  pp " case (Zle_lt_or_eq _ _ (spec_pos (head0 x))); intros F1.";
-  pp "   apply Zlt_le_trans with (2 := (spec_double_size_head0 x)); auto with zarith.";
-  pp " case (Zle_lt_or_eq _ _ (spec_pos x)); intros F3.";
-  pp " generalize F3; rewrite <- (spec_double_size x); intros F4.";
-  pp " absurd (2 ^ (Zpos (xO (digits x)) - 1) < 2 ^ (Zpos (digits x))).";
-  pp "   apply Zle_not_lt.";
-  pp "   apply Zpower_le_monotone; auto with zarith.";
-  pp "   split; auto with zarith.";
-  pp "   rewrite Zpos_xO; auto with zarith.";
-  pp " case (spec_head0 x F3).";
-  pp " rewrite <- F1; rewrite Zpower_0_r; rewrite Zmult_1_l; intros _ HH.";
-  pp " apply Zle_lt_trans with (2 := HH).";
-  pp " case (spec_head0 _ F4).";
-  pp " rewrite (spec_double_size x); rewrite (spec_double_size_digits x).";
-  pp " rewrite <- F0; rewrite Zpower_0_r; rewrite Zmult_1_l; auto.";
-  pp " generalize F1; rewrite (spec_head00 _ (sym_equal F3)); auto with zarith.";
-  pp " Qed.";
-  pr "";
-
-  (* even *)
-  pr " Definition is_even x :=";
-  pr "  match x with";
-  for i = 0 to size do
-    pr "  | %s%i wx => w%i_op.(znz_is_even) wx" c i i
-  done;
-  pr "  | %sn n wx => (make_op n).(znz_is_even) wx" c;
-  pr "  end.";
-  pr "";
-
-
-  pr " Theorem spec_is_even: forall x,";
-  pr "   if is_even x then [x] mod 2 = 0 else [x] mod 2 = 1.";
-  pa " Admitted.";
-  pp " Proof.";
-  pp " intros x; case x; unfold is_even, to_Z; clear x.";
-  for i = 0 to size do
-    pp "   intros x; exact (spec_is_even w%i_spec x)." i;
-  done;
-  pp "  intros n x; exact (spec_is_even (wn_spec n) x).";
-  pp " Qed.";
-  pr "";
-
-  pr "End Make.";
-  pr "";
-
+  pr "  Eval lazy beta iota delta [reduce_n] in";
+  pr "   reduce_n _ _ (N0 zero0) reduce_%i Nn n." (size + 1);
+  pr "";
+
+pr " Definition reduce n : dom_t n -> t :=";
+pr "  match n with";
+for i = 0 to size do
+pr "   | %i => reduce_%i" i i;
+done;
+pr "   | %s(S n) => reduce_n n" (if size=0 then "" else "SizePlus ");
+pr "  end.";
+pr "";
+
+pr " Ltac unfold_red := unfold reduce, %s." (iter_name 1 size "reduce_" ",");
+
+pr "
+ Ltac solve_red :=
+ let H := fresh in let G := fresh in
+ match goal with
+  | |- ?P (S ?n) => assert (H:P n) by solve_red
+  | _ => idtac
+ end;
+ intros n G x; destruct (le_lt_eq_dec _ _ G) as [LT|EQ];
+ solve [
+  apply (H _ (lt_n_Sm_le _ _ LT)) |
+  inversion LT |
+  subst; change (reduce 0 x = red_t 0 x); reflexivity |
+  specialize (H (pred n)); subst; destruct x;
+   [|unfold_red; rewrite H; auto]; reflexivity
+ ].
+
+ Lemma reduce_equiv : forall n x, n <= Size -> reduce n x = red_t n x.
+ Proof.
+ set (P N := forall n, n <= N -> forall x, reduce n x = red_t n x).
+ intros n x H. revert n H x. change (P Size). solve_red.
+ Qed.
+
+ Lemma spec_reduce_n : forall n x, [reduce_n n x] = [Nn n x].
+ Proof.
+ assert (H : forall x, reduce_%i x = red_t (SizePlus 1) x).
+  destruct x; [|unfold reduce_%i; rewrite (reduce_equiv Size)]; auto.
+ induction n.
+   intros. rewrite H. apply spec_red_t.
+ destruct x as [|xh xl].
+ simpl. rewrite make_op_S. exact ZnZ.spec_0.
+ fold word in *.
+ destruct xh; auto.
+ simpl reduce_n.
+ rewrite IHn.
+ rewrite spec_extend_WW; auto.
+ Qed.
+" (size+1) (size+1);
+
+pr
+" Lemma spec_reduce : forall n x, [reduce n x] = ZnZ.to_Z x.
+ Proof.
+ do_size (destruct n;
+       [intros; rewrite reduce_equiv;[apply spec_red_t|auto with arith]|]).
+ apply spec_reduce_n.
+ Qed.
+
+End Make.
+";
diff --git a/theories/Numbers/Natural/BigN/Nbasic.v b/theories/Numbers/Natural/BigN/Nbasic.v
index cdd41647..5bde1008 100644
--- a/theories/Numbers/Natural/BigN/Nbasic.v
+++ b/theories/Numbers/Natural/BigN/Nbasic.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,9 +8,7 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: Nbasic.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import ZArith.
+Require Import ZArith Ndigits.
 Require Import BigNumPrelude.
 Require Import Max.
 Require Import DoubleType.
@@ -18,44 +16,64 @@ Require Import DoubleBase.
 Require Import CyclicAxioms.
 Require Import DoubleCyclic.
 
+Arguments mk_zn2z_ops [t] ops.
+Arguments mk_zn2z_ops_karatsuba [t] ops.
+Arguments mk_zn2z_specs [t ops] specs.
+Arguments mk_zn2z_specs_karatsuba [t ops] specs.
+Arguments ZnZ.digits [t] Ops.
+Arguments ZnZ.zdigits [t] Ops.
+
+Lemma Pshiftl_nat_Zpower : forall n p,
+  Zpos (Pos.shiftl_nat p n) = Zpos p * 2 ^ Z.of_nat n.
+Proof.
+ intros.
+ rewrite Z.mul_comm.
+ induction n. simpl; auto.
+ transitivity (2 * (2 ^ Z.of_nat n * Zpos p)).
+ rewrite <- IHn. auto.
+ rewrite Z.mul_assoc.
+ rewrite Nat2Z.inj_succ.
+ rewrite <- Z.pow_succ_r; auto with zarith.
+Qed.
+
 (* To compute the necessary height *)
 
 Fixpoint plength (p: positive) : positive :=
   match p with
     xH => xH
-  | xO p1 => Psucc (plength p1)
-  | xI p1 => Psucc (plength p1)
+  | xO p1 => Pos.succ (plength p1)
+  | xI p1 => Pos.succ (plength p1)
   end.
 
 Theorem plength_correct: forall p, (Zpos p < 2 ^ Zpos (plength p))%Z.
-assert (F: (forall p, 2 ^ (Zpos (Psucc p)) = 2 * 2 ^ Zpos p)%Z).
-intros p; replace (Zpos (Psucc p)) with (1 + Zpos p)%Z.
+assert (F: (forall p, 2 ^ (Zpos (Pos.succ p)) = 2 * 2 ^ Zpos p)%Z).
+intros p; replace (Zpos (Pos.succ p)) with (1 + Zpos p)%Z.
 rewrite Zpower_exp; auto with zarith.
-rewrite Zpos_succ_morphism; unfold Zsucc; auto with zarith.
+rewrite Pos2Z.inj_succ; unfold Z.succ; auto with zarith.
 intros p; elim p; simpl plength; auto.
-intros p1 Hp1; rewrite F; repeat rewrite Zpos_xI.
+intros p1 Hp1; rewrite F; repeat rewrite Pos2Z.inj_xI.
 assert (tmp: (forall p, 2 * p = p + p)%Z);
   try repeat rewrite tmp; auto with zarith.
-intros p1 Hp1; rewrite F; rewrite (Zpos_xO p1).
+intros p1 Hp1; rewrite F; rewrite (Pos2Z.inj_xO p1).
 assert (tmp: (forall p, 2 * p = p + p)%Z);
   try repeat rewrite tmp; auto with zarith.
-rewrite Zpower_1_r; auto with zarith.
+rewrite Z.pow_1_r; auto with zarith.
 Qed.
 
-Theorem plength_pred_correct: forall p, (Zpos p <= 2 ^ Zpos (plength (Ppred p)))%Z.
-intros p; case (Psucc_pred p); intros H1.
+Theorem plength_pred_correct: forall p, (Zpos p <= 2 ^ Zpos (plength (Pos.pred p)))%Z.
+intros p; case (Pos.succ_pred_or p); intros H1.
 subst; simpl plength.
-rewrite Zpower_1_r; auto with zarith.
+rewrite Z.pow_1_r; auto with zarith.
 pattern p at 1; rewrite <- H1.
-rewrite Zpos_succ_morphism; unfold Zsucc; auto with zarith.
-generalize (plength_correct (Ppred p)); auto with zarith.
+rewrite Pos2Z.inj_succ; unfold Z.succ; auto with zarith.
+generalize (plength_correct (Pos.pred p)); auto with zarith.
 Qed.
 
 Definition Pdiv p q :=
-  match Zdiv (Zpos p) (Zpos q) with
+  match Z.div (Zpos p) (Zpos q) with
     Zpos q1 => match (Zpos p) - (Zpos q) * (Zpos q1) with
                  Z0 => q1
-               | _ => (Psucc q1)
+               | _ => (Pos.succ q1)
                end
   |  _ => xH
   end.
@@ -67,20 +85,20 @@ unfold Pdiv.
 assert (H1: Zpos q > 0); auto with zarith.
 assert (H1b: Zpos p >= 0); auto with zarith.
 generalize (Z_div_ge0 (Zpos p) (Zpos q) H1 H1b).
-generalize (Z_div_mod_eq (Zpos p) (Zpos q) H1); case Zdiv.
-  intros HH _; rewrite HH; rewrite Zmult_0_r; rewrite Zmult_1_r; simpl.
+generalize (Z_div_mod_eq (Zpos p) (Zpos q) H1); case Z.div.
+  intros HH _; rewrite HH; rewrite Z.mul_0_r; rewrite Z.mul_1_r; simpl.
 case (Z_mod_lt (Zpos p) (Zpos q) H1); auto with zarith.
 intros q1 H2.
 replace (Zpos p - Zpos q * Zpos q1) with (Zpos p mod Zpos q).
   2: pattern (Zpos p) at 2; rewrite H2; auto with zarith.
 generalize H2 (Z_mod_lt (Zpos p) (Zpos q) H1); clear H2;
-  case Zmod.
+  case Z.modulo.
   intros HH _; rewrite HH; auto with zarith.
-  intros r1 HH (_,HH1); rewrite HH; rewrite Zpos_succ_morphism.
-  unfold Zsucc; rewrite Zmult_plus_distr_r; auto with zarith.
+  intros r1 HH (_,HH1); rewrite HH; rewrite Pos2Z.inj_succ.
+  unfold Z.succ; rewrite Z.mul_add_distr_l; auto with zarith.
   intros r1 _ (HH,_); case HH; auto.
 intros q1 HH; rewrite HH.
-unfold Zge; simpl Zcompare; intros HH1; case HH1; auto.
+unfold Z.ge; simpl Z.compare; intros HH1; case HH1; auto.
 Qed.
 
 Definition is_one p := match p with xH => true | _ => false end.
@@ -91,7 +109,7 @@ Qed.
 
 Definition get_height digits p :=
   let r := Pdiv p digits in
-   if is_one r then xH else Psucc (plength (Ppred r)).
+   if is_one r then xH else Pos.succ (plength (Pos.pred r)).
 
 Theorem get_height_correct:
   forall digits N,
@@ -101,13 +119,13 @@ unfold get_height.
 assert (H1 := Pdiv_le N digits).
 case_eq (is_one (Pdiv N digits)); intros H2.
 rewrite (is_one_one _ H2) in H1.
-rewrite Zmult_1_r in H1.
-change (2^(1-1))%Z with 1; rewrite Zmult_1_r; auto.
+rewrite Z.mul_1_r in H1.
+change (2^(1-1))%Z with 1; rewrite Z.mul_1_r; auto.
 clear H2.
-apply Zle_trans with (1 := H1).
-apply Zmult_le_compat_l; auto with zarith.
-rewrite Zpos_succ_morphism; unfold Zsucc.
-rewrite Zplus_comm; rewrite Zminus_plus.
+apply Z.le_trans with (1 := H1).
+apply Z.mul_le_mono_nonneg_l; auto with zarith.
+rewrite Pos2Z.inj_succ; unfold Z.succ.
+rewrite Z.add_comm; rewrite Z.add_simpl_l.
 apply plength_pred_correct.
 Qed.
 
@@ -134,18 +152,18 @@ Open Scope nat_scope.
 
 Fixpoint plusnS (n m: nat) {struct n} : (n + S m = S (n + m))%nat :=
   match n return  (n + S m = S (n + m))%nat with
-  | 0 => refl_equal (S m)
+  | 0 => eq_refl (S m)
   | S n1 =>
       let v := S (S n1 + m) in
-      eq_ind_r (fun n => S n = v) (refl_equal v) (plusnS n1 m)
+      eq_ind_r (fun n => S n = v) (eq_refl v) (plusnS n1 m)
   end.
 
 Fixpoint plusn0 n : n + 0 = n :=
   match n return (n + 0 = n) with
-  | 0 => refl_equal 0
+  | 0 => eq_refl 0
   | S n1 =>
       let v := S n1 in
-      eq_ind_r (fun n : nat => S n = v) (refl_equal v) (plusn0 n1)
+      eq_ind_r (fun n : nat => S n = v) (eq_refl v) (plusn0 n1)
   end.
 
  Fixpoint diff (m n: nat) {struct m}: nat * nat :=
@@ -159,8 +177,8 @@ Fixpoint diff_l (m n : nat) {struct m} : fst (diff m n) + n = max m n :=
   match m return fst (diff m n) + n = max m n with
   | 0 =>
       match n return (n = max 0 n) with
-      | 0 => refl_equal _
-      | S n0 => refl_equal _
+      | 0 => eq_refl _
+      | S n0 => eq_refl _
       end
   | S m1 =>
       match n return (fst (diff (S m1) n) + n = max (S m1) n)
@@ -170,7 +188,7 @@ Fixpoint diff_l (m n : nat) {struct m} : fst (diff m n) + n = max m n :=
           let v := fst (diff m1 n1) + n1 in
           let v1 := fst (diff m1 n1) + S n1 in
           eq_ind v (fun n => v1 = S n)
-            (eq_ind v1 (fun n => v1 = n) (refl_equal v1) (S v) (plusnS _ _))
+            (eq_ind v1 (fun n => v1 = n) (eq_refl v1) (S v) (plusnS _ _))
             _ (diff_l _ _)
       end
   end.
@@ -179,17 +197,17 @@ Fixpoint diff_r (m n: nat) {struct m}: snd (diff m n) + m = max m n :=
   match m return (snd (diff m n) + m = max m n) with
   | 0 =>
       match n return (snd (diff 0 n) + 0 = max 0 n) with
-      | 0 => refl_equal _
+      | 0 => eq_refl _
       | S _ => plusn0 _
       end
   | S m =>
       match n return (snd (diff (S m) n) + S m = max (S m) n) with
-      | 0 => refl_equal (snd (diff (S m) 0) + S m)
+      | 0 => eq_refl (snd (diff (S m) 0) + S m)
       | S n1 =>
           let v := S (max m n1) in
           eq_ind_r (fun n => n = v)
             (eq_ind_r (fun n => S n = v)
-               (refl_equal v) (diff_r _ _)) (plusnS _ _)
+               (eq_refl v) (diff_r _ _)) (plusnS _ _)
       end
   end.
 
@@ -198,7 +216,7 @@ Fixpoint diff_r (m n: nat) {struct m}: snd (diff m n) + m = max m n :=
  Definition castm (m n: nat) (H: m = n) (x: word w (S m)):
      (word w (S n)) :=
  match H in (_ = y) return (word w (S y)) with
- | refl_equal => x
+ | eq_refl => x
  end.
 
 Variable m: nat.
@@ -212,8 +230,8 @@ Fixpoint extend_tr (n : nat) {struct n}: (word w (S (n + m))) :=
 
 End ExtendMax.
 
-Implicit Arguments extend_tr[w m].
-Implicit Arguments castm[w m n].
+Arguments extend_tr [w m] v n.
+Arguments castm     [w m n] H x.
 
 
 
@@ -287,11 +305,7 @@ Section CompareRec.
  Variable w_to_Z: w -> Z.
  Variable w_to_Z_0: w_to_Z w_0 = 0.
  Variable spec_compare0_m: forall x,
-    match compare0_m x with
-      Eq => w_to_Z w_0 = wm_to_Z x
-    | Lt => w_to_Z w_0 < wm_to_Z x
-    | Gt => w_to_Z w_0 > wm_to_Z x
-    end.
+   compare0_m x = (w_to_Z w_0 ?= wm_to_Z x).
  Variable wm_to_Z_pos: forall x, 0 <= wm_to_Z x < base wm_base.
 
  Let double_to_Z := double_to_Z wm_base wm_to_Z.
@@ -300,7 +314,7 @@ Section CompareRec.
  Lemma base_xO: forall n, base (xO n) = (base n)^2.
  Proof.
  intros n1; unfold base.
- rewrite (Zpos_xO n1); rewrite Zmult_comm; rewrite Zpower_mult; auto with zarith.
+ rewrite (Pos2Z.inj_xO n1); rewrite Z.mul_comm; rewrite Z.pow_mul_r; auto with zarith.
  Qed.
 
  Let double_to_Z_pos: forall n x, 0 <= double_to_Z n x < double_wB n :=
@@ -308,29 +322,25 @@ Section CompareRec.
 
 
  Lemma spec_compare0_mn: forall n x,
-    match compare0_mn n x with
-      Eq => 0 = double_to_Z n x
-    | Lt => 0 < double_to_Z n x
-    | Gt => 0 > double_to_Z n x
-    end.
-  Proof.
+   compare0_mn n x = (0 ?= double_to_Z n x).
+ Proof.
   intros n; elim n; clear n; auto.
-  intros x; generalize (spec_compare0_m x); rewrite w_to_Z_0; auto.
+  intros x; rewrite spec_compare0_m; rewrite w_to_Z_0; auto.
   intros n Hrec x; case x; unfold compare0_mn; fold compare0_mn; auto.
+  fold word in *.
   intros xh xl.
-  generalize (Hrec xh); case compare0_mn; auto.
-  generalize (Hrec xl); case compare0_mn; auto.
-  simpl double_to_Z; intros H1 H2; rewrite H1; rewrite <- H2; auto.
-  simpl double_to_Z; intros H1 H2; rewrite <- H2; auto.
+  rewrite 2 Hrec.
+  simpl double_to_Z.
+  set (wB := DoubleBase.double_wB wm_base n).
+  case Z.compare_spec; intros Cmp.
+  rewrite <- Cmp. reflexivity.
+  symmetry. apply Z.gt_lt, Z.lt_gt. (* ;-) *)
+  assert (0 < wB).
+   unfold wB, DoubleBase.double_wB, base; auto with zarith.
+  change 0 with (0 + 0); apply Z.add_lt_le_mono; auto with zarith.
+  apply Z.mul_pos_pos; auto with zarith.
   case (double_to_Z_pos n xl); auto with zarith.
-  intros H1; simpl double_to_Z.
-  set (u := DoubleBase.double_wB wm_base n).
-  case (double_to_Z_pos n xl); intros H2 H3.
-  assert (0 < u); auto with zarith.
-  unfold u, DoubleBase.double_wB, base; auto with zarith.
-  change 0 with (0 + 0); apply Zplus_lt_le_compat; auto with zarith.
-  apply Zmult_lt_0_compat; auto with zarith.
-  case (double_to_Z_pos n xh); auto with zarith.
+  case (double_to_Z_pos n xh); intros; exfalso; omega.
   Qed.
 
  Fixpoint compare_mn_1 (n:nat) : word wm n -> w -> comparison :=
@@ -348,17 +358,9 @@ Section CompareRec.
   end.
 
  Variable spec_compare: forall x y,
-   match compare x y with
-     Eq => w_to_Z x = w_to_Z y
-   | Lt => w_to_Z x < w_to_Z y
-   | Gt => w_to_Z x > w_to_Z y
-   end.
+   compare x y = Z.compare (w_to_Z x) (w_to_Z y).
  Variable spec_compare_m: forall x y,
-   match compare_m x y with
-     Eq => wm_to_Z x = w_to_Z y
-   | Lt => wm_to_Z x < w_to_Z y
-   | Gt => wm_to_Z x > w_to_Z y
-   end.
+   compare_m x y = Z.compare (wm_to_Z x) (w_to_Z y).
  Variable wm_base_lt: forall x,
    0 <= w_to_Z x < base (wm_base).
 
@@ -367,39 +369,36 @@ Section CompareRec.
  Proof.
  intros n x; elim n; simpl; auto; clear n.
  intros n (H0, H); split; auto.
- apply Zlt_le_trans with (1:= H).
+ apply Z.lt_le_trans with (1:= H).
  unfold double_wB, DoubleBase.double_wB; simpl.
- rewrite base_xO.
- set (u := base (double_digits wm_base n)).
+ rewrite Pshiftl_nat_S, base_xO.
+ set (u := base (Pos.shiftl_nat wm_base n)).
  assert (0 < u).
   unfold u, base; auto with zarith.
  replace (u^2) with (u * u); simpl; auto with zarith.
- apply Zle_trans with (1 * u); auto with zarith.
- unfold Zpower_pos; simpl; ring.
+ apply Z.le_trans with (1 * u); auto with zarith.
+ unfold Z.pow_pos; simpl; ring.
  Qed.
 
 
  Lemma spec_compare_mn_1: forall n x y,
-   match compare_mn_1 n x y with
-     Eq => double_to_Z n x = w_to_Z y
-   | Lt => double_to_Z n x < w_to_Z y
-   | Gt => double_to_Z n x > w_to_Z y
-   end.
+   compare_mn_1 n x y = Z.compare (double_to_Z n x) (w_to_Z y).
  Proof.
  intros n; elim n; simpl; auto; clear n.
  intros n Hrec x; case x; clear x; auto.
- intros y; generalize (spec_compare w_0 y); rewrite w_to_Z_0; case compare; auto.
- intros xh xl y; simpl; generalize (spec_compare0_mn n xh); case compare0_mn; intros H1b.
- rewrite <- H1b; rewrite Zmult_0_l; rewrite Zplus_0_l; auto.
- apply Hrec.
- apply Zlt_gt.
+ intros y; rewrite spec_compare; rewrite w_to_Z_0. reflexivity.
+ intros xh xl y; simpl;
+ rewrite spec_compare0_mn, Hrec. case Z.compare_spec.
+ intros H1b.
+ rewrite <- H1b; rewrite Z.mul_0_l; rewrite Z.add_0_l; auto.
+ symmetry. apply Z.lt_gt.
  case (double_wB_lt n y); intros _ H0.
- apply Zlt_le_trans with (1:= H0).
+ apply Z.lt_le_trans with (1:= H0).
  fold double_wB.
  case (double_to_Z_pos n xl); intros H1 H2.
- apply Zle_trans with (double_to_Z n xh * double_wB n); auto with zarith.
- apply Zle_trans with (1 * double_wB n); auto with zarith.
- case (double_to_Z_pos n xh); auto with zarith.
+ apply Z.le_trans with (double_to_Z n xh * double_wB n); auto with zarith.
+ apply Z.le_trans with (1 * double_wB n); auto with zarith.
+ case (double_to_Z_pos n xh); intros; exfalso; omega.
  Qed.
 
 End CompareRec.
@@ -433,22 +432,6 @@ Section AddS.
 
 End AddS.
 
-
- Lemma spec_opp: forall u x y,
-  match u with
-  | Eq => y = x
-  | Lt => y < x
-  | Gt => y > x
-  end ->
-  match CompOpp u with
-  | Eq => x = y
-  | Lt => x < y
-  | Gt => x > y
-  end.
- Proof.
- intros u x y; case u; simpl; auto with zarith.
- Qed.
-
  Fixpoint length_pos x :=
   match x with xH => O | xO x1 => S (length_pos x1) | xI x1 => S (length_pos x1) end.
 
@@ -457,8 +440,8 @@ End AddS.
  Proof.
  intros x; elim x; clear x; [intros x1 Hrec | intros x1 Hrec | idtac];
    intros y; case y; clear y; intros y1 H || intros H; simpl length_pos;
-   try (rewrite (Zpos_xI x1) || rewrite (Zpos_xO x1));
-   try (rewrite (Zpos_xI y1) || rewrite (Zpos_xO y1));
+   try (rewrite (Pos2Z.inj_xI x1) || rewrite (Pos2Z.inj_xO x1));
+   try (rewrite (Pos2Z.inj_xI y1) || rewrite (Pos2Z.inj_xO y1));
    try (inversion H; fail);
    try (assert (Zpos x1 < Zpos y1); [apply Hrec; apply lt_S_n | idtac]; auto with zarith);
    assert (0 < Zpos y1); auto with zarith; red; auto.
@@ -474,34 +457,112 @@ End AddS.
 
  Variable w: Type.
 
- Theorem digits_zop: forall w (x: znz_op w),
-  znz_digits (mk_zn2z_op x) = xO (znz_digits x).
+ Theorem digits_zop: forall t (ops : ZnZ.Ops t),
+  ZnZ.digits (mk_zn2z_ops ops) = xO (ZnZ.digits ops).
+ Proof.
  intros ww x; auto.
  Qed.
 
- Theorem digits_kzop: forall w (x: znz_op w),
-  znz_digits (mk_zn2z_op_karatsuba x) = xO (znz_digits x).
+ Theorem digits_kzop: forall t (ops : ZnZ.Ops t),
+  ZnZ.digits (mk_zn2z_ops_karatsuba ops) = xO (ZnZ.digits ops).
+ Proof.
  intros ww x; auto.
  Qed.
 
- Theorem make_zop: forall w (x: znz_op w),
-  znz_to_Z (mk_zn2z_op x) =
+ Theorem make_zop: forall t (ops : ZnZ.Ops t),
+  @ZnZ.to_Z _ (mk_zn2z_ops ops) =
     fun z => match z with
-                W0 => 0
-             | WW xh xl => znz_to_Z x xh * base (znz_digits x)
-                                + znz_to_Z x xl
+             | W0 => 0
+             | WW xh xl => ZnZ.to_Z xh * base (ZnZ.digits ops)
+                                + ZnZ.to_Z xl
              end.
+ Proof.
  intros ww x; auto.
  Qed.
 
- Theorem make_kzop: forall w (x: znz_op w),
-  znz_to_Z (mk_zn2z_op_karatsuba x) =
+ Theorem make_kzop: forall t (ops: ZnZ.Ops t),
+  @ZnZ.to_Z _ (mk_zn2z_ops_karatsuba ops) =
     fun z => match z with
-                W0 => 0
-             | WW xh xl => znz_to_Z x xh * base (znz_digits x)
-                                + znz_to_Z x xl
+             | W0 => 0
+             | WW xh xl => ZnZ.to_Z xh * base (ZnZ.digits ops)
+                                + ZnZ.to_Z xl
              end.
+ Proof.
  intros ww x; auto.
  Qed.
 
  End SimplOp.
+
+(** Abstract vision of a datatype of arbitrary-large numbers.
+    Concrete operations can be derived from these generic
+    fonctions, in particular from [iter_t] and [same_level].
+*)
+
+Module Type NAbstract.
+
+(** The domains: a sequence of [Z/nZ] structures *)
+
+Parameter dom_t : nat -> Type.
+Declare Instance dom_op n : ZnZ.Ops (dom_t n).
+Declare Instance dom_spec n : ZnZ.Specs (dom_op n).
+
+Axiom digits_dom_op : forall n,
+  ZnZ.digits (dom_op n) = Pos.shiftl_nat (ZnZ.digits (dom_op 0)) n.
+
+(** The type [t] of arbitrary-large numbers, with abstract constructor [mk_t]
+    and destructor [destr_t] and iterator [iter_t] *)
+
+Parameter t : Type.
+
+Parameter mk_t : forall (n:nat), dom_t n -> t.
+
+Inductive View_t : t -> Prop :=
+ Mk_t : forall n (x : dom_t n), View_t (mk_t n x).
+
+Axiom destr_t : forall x, View_t x. (* i.e. every x is a (mk_t n xw) *)
+
+Parameter iter_t : forall {A:Type}(f : forall n, dom_t n -> A), t -> A.
+
+Axiom iter_mk_t : forall A (f:forall n, dom_t n -> A),
+ forall n x, iter_t f (mk_t n x) = f n x.
+
+(** Conversion to [ZArith] *)
+
+Parameter to_Z : t -> Z.
+Local Notation "[ x ]" := (to_Z x).
+
+Axiom spec_mk_t : forall n x, [mk_t n x] = ZnZ.to_Z x.
+
+(** [reduce] is like [mk_t], but try to minimise the level of the number *)
+
+Parameter reduce : forall (n:nat), dom_t n -> t.
+Axiom spec_reduce : forall n x, [reduce n x] = ZnZ.to_Z x.
+
+(** Number of level in the tree representation of a number.
+    NB: This function isn't a morphism for setoid [eq]. *)
+
+Definition level := iter_t (fun n _ => n).
+
+(** [same_level] and its rich specification, indexed by [level] *)
+
+Parameter same_level : forall {A:Type}
+ (f : forall n, dom_t n -> dom_t n -> A), t -> t -> A.
+
+Axiom spec_same_level_dep :
+  forall res
+   (P : nat -> Z -> Z -> res -> Prop)
+   (Pantimon : forall n m z z' r, (n <= m)%nat -> P m z z' r -> P n z z' r)
+   (f : forall n, dom_t n -> dom_t n -> res)
+   (Pf: forall n x y, P n (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y)),
+   forall x y, P (level x) [x] [y] (same_level f x y).
+
+(** [mk_t_S] : building a number of the next level *)
+
+Parameter mk_t_S : forall (n:nat), zn2z (dom_t n) -> t.
+
+Axiom spec_mk_t_S : forall n (x:zn2z (dom_t n)),
+  [mk_t_S n x] = zn2z_to_Z (base (ZnZ.digits (dom_op n))) ZnZ.to_Z x.
+
+Axiom mk_t_S_level : forall n x, level (mk_t_S n x) = S n.
+
+End NAbstract.
diff --git a/theories/Numbers/Natural/Binary/NBinary.v b/theories/Numbers/Natural/Binary/NBinary.v
index 029fdfca..3150c561 100644
--- a/theories/Numbers/Natural/Binary/NBinary.v
+++ b/theories/Numbers/Natural/Binary/NBinary.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,150 +8,15 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NBinary.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import BinPos.
 Require Export BinNat.
 Require Import NAxioms NProperties.
 
 Local Open Scope N_scope.
 
-(** * Implementation of [NAxiomsSig] module type via [BinNat.N] *)
-
-Module NBinaryAxiomsMod <: NAxiomsSig.
-
-(** Bi-directional induction. *)
-
-Theorem bi_induction :
-  forall A : N -> Prop, Proper (eq==>iff) A ->
-    A N0 -> (forall n, A n <-> A (Nsucc n)) -> forall n : N, A n.
-Proof.
-intros A A_wd A0 AS. apply Nrect. assumption. intros; now apply -> AS.
-Qed.
-
-(** Basic operations. *)
-
-Definition eq_equiv : Equivalence (@eq N) := eq_equivalence.
-Local Obligation Tactic := simpl_relation.
-Program Instance succ_wd : Proper (eq==>eq) Nsucc.
-Program Instance pred_wd : Proper (eq==>eq) Npred.
-Program Instance add_wd : Proper (eq==>eq==>eq) Nplus.
-Program Instance sub_wd : Proper (eq==>eq==>eq) Nminus.
-Program Instance mul_wd : Proper (eq==>eq==>eq) Nmult.
-
-Definition pred_succ := Npred_succ.
-Definition add_0_l := Nplus_0_l.
-Definition add_succ_l := Nplus_succ.
-Definition sub_0_r := Nminus_0_r.
-Definition sub_succ_r := Nminus_succ_r.
-Definition mul_0_l := Nmult_0_l.
-Definition mul_succ_l n m := eq_trans (Nmult_Sn_m n m) (Nplus_comm _ _).
-
-(** Order *)
-
-Program Instance lt_wd : Proper (eq==>eq==>iff) Nlt.
-
-Definition lt_eq_cases := Nle_lteq.
-Definition lt_irrefl := Nlt_irrefl.
-
-Theorem lt_succ_r : forall n m, n < (Nsucc m) <-> n <= m.
-Proof.
-intros n m; unfold Nlt, Nle; destruct n as [| p]; destruct m as [| q]; simpl;
-split; intro H; try reflexivity; try discriminate.
-destruct p; simpl; intros; discriminate. exfalso; now apply H.
-apply -> Pcompare_p_Sq in H. destruct H as [H | H].
-now rewrite H. now rewrite H, Pcompare_refl.
-apply <- Pcompare_p_Sq. case_eq ((p ?= q)%positive Eq); intro H1.
-right; now apply Pcompare_Eq_eq. now left. exfalso; now apply H.
-Qed.
-
-Theorem min_l : forall n m, n <= m -> Nmin n m = n.
-Proof.
-unfold Nmin, Nle; intros n m H.
-destruct (n ?= m); try reflexivity. now elim H.
-Qed.
-
-Theorem min_r : forall n m, m <= n -> Nmin n m = m.
-Proof.
-unfold Nmin, Nle; intros n m H.
-case_eq (n ?= m); intro H1; try reflexivity.
-now apply -> Ncompare_eq_correct.
-rewrite <- Ncompare_antisym, H1 in H; elim H; auto.
-Qed.
-
-Theorem max_l : forall n m, m <= n -> Nmax n m = n.
-Proof.
-unfold Nmax, Nle; intros n m H.
-case_eq (n ?= m); intro H1; try reflexivity.
-symmetry; now apply -> Ncompare_eq_correct.
-rewrite <- Ncompare_antisym, H1 in H; elim H; auto.
-Qed.
-
-Theorem max_r : forall n m : N, n <= m -> Nmax n m = m.
-Proof.
-unfold Nmax, Nle; intros n m H.
-destruct (n ?= m); try reflexivity. now elim H.
-Qed.
-
-(** Part specific to natural numbers, not integers. *)
-
-Theorem pred_0 : Npred 0 = 0.
-Proof.
-reflexivity.
-Qed.
-
-Definition recursion (A : Type) : A -> (N -> A -> A) -> N -> A :=
-  Nrect (fun _ => A).
-Implicit Arguments recursion [A].
-
-Instance recursion_wd A (Aeq : relation A) :
- Proper (Aeq==>(eq==>Aeq==>Aeq)==>eq==>Aeq) (@recursion A).
-Proof.
-intros a a' Eaa' f f' Eff'.
-intro x; pattern x; apply Nrect.
-intros x' H; now rewrite <- H.
-clear x.
-intros x IH x' H; rewrite <- H.
-unfold recursion in *. do 2 rewrite Nrect_step.
-now apply Eff'; [| apply IH].
-Qed.
-
-Theorem recursion_0 :
-  forall (A : Type) (a : A) (f : N -> A -> A), recursion a f N0 = a.
-Proof.
-intros A a f; unfold recursion; now rewrite Nrect_base.
-Qed.
-
-Theorem recursion_succ :
-  forall (A : Type) (Aeq : relation A) (a : A) (f : N -> A -> A),
-    Aeq a a -> Proper (eq==>Aeq==>Aeq) f ->
-      forall n : N, Aeq (recursion a f (Nsucc n)) (f n (recursion a f n)).
-Proof.
-unfold recursion; intros A Aeq a f EAaa f_wd n; pattern n; apply Nrect.
-rewrite Nrect_step; rewrite Nrect_base; now apply f_wd.
-clear n; intro n; do 2 rewrite Nrect_step; intro IH. apply f_wd; [reflexivity|].
-now rewrite Nrect_step.
-Qed.
-
-(** The instantiation of operations.
-    Placing them at the very end avoids having indirections in above lemmas. *)
-
-Definition t := N.
-Definition eq := @eq N.
-Definition zero := N0.
-Definition succ := Nsucc.
-Definition pred := Npred.
-Definition add := Nplus.
-Definition sub := Nminus.
-Definition mul := Nmult.
-Definition lt := Nlt.
-Definition le := Nle.
-Definition min := Nmin.
-Definition max := Nmax.
-
-End NBinaryAxiomsMod.
+(** * [BinNat.N] already implements [NAxiomSig] *)
 
-Module Export NBinaryPropMod := NPropFunct NBinaryAxiomsMod.
+Module N <: NAxiomsSig := N.
 
 (*
 Require Import NDefOps.
@@ -166,8 +31,8 @@ Time Eval vm_compute in (log 500000). (* 11 sec *)
 Fixpoint binposlog (p : positive) : N :=
 match p with
 | xH => 0
-| xO p' => Nsucc (binposlog p')
-| xI p' => Nsucc (binposlog p')
+| xO p' => N.succ (binposlog p')
+| xI p' => N.succ (binposlog p')
 end.
 
 Definition binlog (n : N) : N :=
diff --git a/theories/Numbers/Natural/Peano/NPeano.v b/theories/Numbers/Natural/Peano/NPeano.v
index fbc63c04..a510b3ae 100644
--- a/theories/Numbers/Natural/Peano/NPeano.v
+++ b/theories/Numbers/Natural/Peano/NPeano.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,13 +8,571 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NPeano.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+Require Import
+ Bool Peano Peano_dec Compare_dec Plus Mult Minus Le Lt EqNat Div2 Wf_nat
+ NAxioms NProperties.
 
-Require Import Arith MinMax NAxioms NProperties.
+(** Functions not already defined *)
+
+Fixpoint leb n m :=
+  match n, m with
+    | O, _ => true
+    | _, O => false
+    | S n', S m' => leb n' m'
+  end.
+
+Definition ltb n m := leb (S n) m.
+
+Infix "<=?" := leb (at level 70) : nat_scope.
+Infix "<?" := ltb (at level 70) : nat_scope.
+
+Lemma leb_le n m : (n <=? m) = true <-> n <= m.
+Proof.
+ revert m.
+ induction n. split; auto with arith.
+ destruct m; simpl. now split.
+ rewrite IHn. split; auto with arith.
+Qed.
+
+Lemma ltb_lt n m : (n <? m) = true <-> n < m.
+Proof.
+ unfold ltb, lt. apply leb_le.
+Qed.
+
+Fixpoint pow n m :=
+  match m with
+    | O => 1
+    | S m => n * (pow n m)
+  end.
+
+Infix "^" := pow : nat_scope.
+
+Lemma pow_0_r : forall a, a^0 = 1.
+Proof. reflexivity. Qed.
+
+Lemma pow_succ_r : forall a b, 0<=b -> a^(S b) = a * a^b.
+Proof. reflexivity. Qed.
+
+Definition square n := n * n.
+
+Lemma square_spec n : square n = n * n.
+Proof. reflexivity. Qed.
+
+Definition Even n := exists m, n = 2*m.
+Definition Odd n := exists m, n = 2*m+1.
+
+Fixpoint even n :=
+  match n with
+    | O => true
+    | 1 => false
+    | S (S n') => even n'
+  end.
+
+Definition odd n := negb (even n).
+
+Lemma even_spec : forall n, even n = true <-> Even n.
+Proof.
+ fix 1.
+  destruct n as [|[|n]]; simpl; try rewrite even_spec; split.
+  now exists 0.
+  trivial.
+  discriminate.
+  intros (m,H). destruct m. discriminate.
+   simpl in H. rewrite <- plus_n_Sm in H. discriminate.
+  intros (m,H). exists (S m). rewrite H. simpl. now rewrite plus_n_Sm.
+  intros (m,H). destruct m. discriminate. exists m.
+   simpl in H. rewrite <- plus_n_Sm in H. inversion H. reflexivity.
+Qed.
+
+Lemma odd_spec : forall n, odd n = true <-> Odd n.
+Proof.
+ unfold odd.
+ fix 1.
+  destruct n as [|[|n]]; simpl; try rewrite odd_spec; split.
+  discriminate.
+  intros (m,H). rewrite <- plus_n_Sm in H; discriminate.
+  now exists 0.
+  trivial.
+  intros (m,H). exists (S m). rewrite H. simpl. now rewrite <- (plus_n_Sm m).
+  intros (m,H). destruct m. discriminate. exists m.
+   simpl in H. rewrite <- plus_n_Sm in H. inversion H. simpl.
+   now rewrite <- !plus_n_Sm, <- !plus_n_O.
+Qed.
+
+Lemma Even_equiv : forall n, Even n <-> Even.even n.
+Proof.
+ split. intros (p,->). apply Even.even_mult_l. do 3 constructor.
+ intros H. destruct (even_2n n H) as (p,->).
+ exists p. unfold double. simpl. now rewrite <- plus_n_O.
+Qed.
+
+Lemma Odd_equiv : forall n, Odd n <-> Even.odd n.
+Proof.
+ split. intros (p,->). rewrite <- plus_n_Sm, <- plus_n_O.
+ apply Even.odd_S. apply Even.even_mult_l. do 3 constructor.
+ intros H. destruct (odd_S2n n H) as (p,->).
+ exists p. unfold double. simpl. now rewrite <- plus_n_Sm, <- !plus_n_O.
+Qed.
+
+(* A linear, tail-recursive, division for nat.
+
+   In [divmod], [y] is the predecessor of the actual divisor,
+   and [u] is [y] minus the real remainder
+*)
+
+Fixpoint divmod x y q u :=
+  match x with
+    | 0 => (q,u)
+    | S x' => match u with
+                | 0 => divmod x' y (S q) y
+                | S u' => divmod x' y q u'
+              end
+  end.
+
+Definition div x y :=
+  match y with
+    | 0 => y
+    | S y' => fst (divmod x y' 0 y')
+  end.
+
+Definition modulo x y :=
+  match y with
+    | 0 => y
+    | S y' => y' - snd (divmod x y' 0 y')
+  end.
+
+Infix "/" := div : nat_scope.
+Infix "mod" := modulo (at level 40, no associativity) : nat_scope.
+
+Lemma divmod_spec : forall x y q u, u <= y ->
+ let (q',u') := divmod x y q u in
+ x + (S y)*q + (y-u) = (S y)*q' + (y-u') /\ u' <= y.
+Proof.
+ induction x. simpl. intuition.
+ intros y q u H. destruct u; simpl divmod.
+ generalize (IHx y (S q) y (le_n y)). destruct divmod as (q',u').
+ intros (EQ,LE); split; trivial.
+ rewrite <- EQ, <- minus_n_O, minus_diag, <- plus_n_O.
+ now rewrite !plus_Sn_m, plus_n_Sm, <- plus_assoc, mult_n_Sm.
+ generalize (IHx y q u (le_Sn_le _ _ H)). destruct divmod as (q',u').
+ intros (EQ,LE); split; trivial.
+ rewrite <- EQ.
+ rewrite !plus_Sn_m, plus_n_Sm. f_equal. now apply minus_Sn_m.
+Qed.
+
+Lemma div_mod : forall x y, y<>0 -> x = y*(x/y) + x mod y.
+Proof.
+ intros x y Hy.
+ destruct y; [ now elim Hy | clear Hy ].
+ unfold div, modulo.
+ generalize (divmod_spec x y 0 y (le_n y)).
+ destruct divmod as (q,u).
+ intros (U,V).
+ simpl in *.
+ now rewrite <- mult_n_O, minus_diag, <- !plus_n_O in U.
+Qed.
+
+Lemma mod_bound_pos : forall x y, 0<=x -> 0<y -> 0 <= x mod y < y.
+Proof.
+ intros x y Hx Hy. split. auto with arith.
+ destruct y; [ now elim Hy | clear Hy ].
+ unfold modulo.
+ apply le_n_S, le_minus.
+Qed.
+
+(** Square root *)
+
+(** The following square root function is linear (and tail-recursive).
+  With Peano representation, we can't do better. For faster algorithm,
+  see Psqrt/Zsqrt/Nsqrt...
+
+  We search the square root of n = k + p^2 + (q - r)
+  with q = 2p and 0<=r<=q. We start with p=q=r=0, hence
+  looking for the square root of n = k. Then we progressively
+  decrease k and r. When k = S k' and r=0, it means we can use (S p)
+  as new sqrt candidate, since (S k')+p^2+2p = k'+(S p)^2.
+  When k reaches 0, we have found the biggest p^2 square contained
+  in n, hence the square root of n is p.
+*)
+
+Fixpoint sqrt_iter k p q r :=
+  match k with
+    | O => p
+    | S k' => match r with
+                | O => sqrt_iter k' (S p) (S (S q)) (S (S q))
+                | S r' => sqrt_iter k' p q r'
+              end
+  end.
+
+Definition sqrt n := sqrt_iter n 0 0 0.
+
+Lemma sqrt_iter_spec : forall k p q r,
+ q = p+p -> r<=q ->
+ let s := sqrt_iter k p q r in
+ s*s <= k + p*p + (q - r) < (S s)*(S s).
+Proof.
+ induction k.
+ (* k = 0 *)
+ simpl; intros p q r Hq Hr.
+ split.
+ apply le_plus_l.
+ apply le_lt_n_Sm.
+ rewrite <- mult_n_Sm.
+ rewrite plus_assoc, (plus_comm p), <- plus_assoc.
+ apply plus_le_compat; trivial.
+ rewrite <- Hq. apply le_minus.
+ (* k = S k' *)
+ destruct r.
+ (* r = 0 *)
+ intros Hq _.
+ replace (S k + p*p + (q-0)) with (k + (S p)*(S p) + (S (S q) - S (S q))).
+ apply IHk.
+ simpl. rewrite <- plus_n_Sm. congruence.
+ auto with arith.
+ rewrite minus_diag, <- minus_n_O, <- plus_n_O. simpl.
+ rewrite <- plus_n_Sm; f_equal. rewrite <- plus_assoc; f_equal.
+ rewrite <- mult_n_Sm, (plus_comm p), <- plus_assoc. congruence.
+ (* r = S r' *)
+ intros Hq Hr.
+ replace (S k + p*p + (q-S r)) with (k + p*p + (q - r)).
+ apply IHk; auto with arith.
+ simpl. rewrite plus_n_Sm. f_equal. rewrite minus_Sn_m; auto.
+Qed.
+
+Lemma sqrt_spec : forall n,
+ (sqrt n)*(sqrt n) <= n < S (sqrt n) * S (sqrt n).
+Proof.
+ intros.
+ set (s:=sqrt n).
+ replace n with (n + 0*0 + (0-0)).
+ apply sqrt_iter_spec; auto.
+ simpl. now rewrite <- 2 plus_n_O.
+Qed.
+
+(** A linear tail-recursive base-2 logarithm
+
+  In [log2_iter], we maintain the logarithm [p] of the counter [q],
+  while [r] is the distance between [q] and the next power of 2,
+  more precisely [q + S r = 2^(S p)] and [r<2^p]. At each
+  recursive call, [q] goes up while [r] goes down. When [r]
+  is 0, we know that [q] has almost reached a power of 2,
+  and we increase [p] at the next call, while resetting [r]
+  to [q].
+
+  Graphically (numbers are [q], stars are [r]) :
+
+<<
+                    10
+                  9
+                8
+              7   *
+            6       *
+          5           ...
+        4
+      3   *
+    2       *
+  1   *       *
+0   *   *       *
+>>
+
+  We stop when [k], the global downward counter reaches 0.
+  At that moment, [q] is the number we're considering (since
+  [k+q] is invariant), and [p] its logarithm.
+*)
+
+Fixpoint log2_iter k p q r :=
+  match k with
+    | O => p
+    | S k' => match r with
+                | O => log2_iter k' (S p) (S q) q
+                | S r' => log2_iter k' p (S q) r'
+              end
+  end.
+
+Definition log2 n := log2_iter (pred n) 0 1 0.
+
+Lemma log2_iter_spec : forall k p q r,
+ 2^(S p) = q + S r -> r < 2^p ->
+ let s := log2_iter k p q r in
+ 2^s <= k + q < 2^(S s).
+Proof.
+ induction k.
+ (* k = 0 *)
+ intros p q r EQ LT. simpl log2_iter. cbv zeta.
+ split.
+ rewrite plus_O_n.
+ apply plus_le_reg_l with (2^p).
+ simpl pow in EQ. rewrite <- plus_n_O in EQ. rewrite EQ.
+ rewrite plus_comm. apply plus_le_compat_r. now apply lt_le_S.
+ rewrite EQ, plus_comm. apply plus_lt_compat_l. apply lt_0_Sn.
+ (* k = S k' *)
+ intros p q r EQ LT. destruct r.
+ (* r = 0 *)
+ rewrite <- plus_n_Sm, <- plus_n_O in EQ.
+ rewrite plus_Sn_m, plus_n_Sm. apply IHk.
+ rewrite <- EQ. remember (S p) as p'; simpl. now rewrite <- plus_n_O.
+ unfold lt. now rewrite EQ.
+ (* r = S r' *)
+ rewrite plus_Sn_m, plus_n_Sm. apply IHk.
+ now rewrite plus_Sn_m, plus_n_Sm.
+ unfold lt.
+ now apply lt_le_weak.
+Qed.
+
+Lemma log2_spec : forall n, 0<n ->
+ 2^(log2 n) <= n < 2^(S (log2 n)).
+Proof.
+ intros.
+ set (s:=log2 n).
+ replace n with (pred n + 1).
+ apply log2_iter_spec; auto.
+ rewrite <- plus_n_Sm, <- plus_n_O.
+ symmetry. now apply S_pred with 0.
+Qed.
+
+Lemma log2_nonpos : forall n, n<=0 -> log2 n = 0.
+Proof.
+ inversion 1; now subst.
+Qed.
+
+(** * Gcd *)
+
+(** We use Euclid algorithm, which is normally not structural,
+    but Coq is now clever enough to accept this (behind modulo
+    there is a subtraction, which now preserves being a subterm)
+*)
+
+Fixpoint gcd a b :=
+  match a with
+   | O => b
+   | S a' => gcd (b mod (S a')) (S a')
+  end.
+
+Definition divide x y := exists z, y=z*x.
+Notation "( x | y )" := (divide x y) (at level 0) : nat_scope.
+
+Lemma gcd_divide : forall a b, (gcd a b | a) /\ (gcd a b | b).
+Proof.
+ fix 1.
+ intros [|a] b; simpl.
+ split.
+  now exists 0.
+  exists 1. simpl. now rewrite <- plus_n_O.
+ fold (b mod (S a)).
+ destruct (gcd_divide (b mod (S a)) (S a)) as (H,H').
+ set (a':=S a) in *.
+ split; auto.
+ rewrite (div_mod b a') at 2 by discriminate.
+ destruct H as (u,Hu), H' as (v,Hv).
+ rewrite mult_comm.
+ exists ((b/a')*v + u).
+ rewrite mult_plus_distr_r.
+ now rewrite <- mult_assoc, <- Hv, <- Hu.
+Qed.
+
+Lemma gcd_divide_l : forall a b, (gcd a b | a).
+Proof.
+ intros. apply gcd_divide.
+Qed.
+
+Lemma gcd_divide_r : forall a b, (gcd a b | b).
+Proof.
+ intros. apply gcd_divide.
+Qed.
+
+Lemma gcd_greatest : forall a b c, (c|a) -> (c|b) -> (c|gcd a b).
+Proof.
+ fix 1.
+ intros [|a] b; simpl; auto.
+ fold (b mod (S a)).
+ intros c H H'. apply gcd_greatest; auto.
+ set (a':=S a) in *.
+ rewrite (div_mod b a') in H' by discriminate.
+ destruct H as (u,Hu), H' as (v,Hv).
+ exists (v - (b/a')*u).
+ rewrite mult_comm in Hv.
+ now rewrite mult_minus_distr_r, <- Hv, <-mult_assoc, <-Hu, minus_plus.
+Qed.
+
+(** * Bitwise operations *)
+
+(** We provide here some bitwise operations for unary numbers.
+  Some might be really naive, they are just there for fullfiling
+  the same interface as other for natural representations. As
+  soon as binary representations such as NArith are available,
+  it is clearly better to convert to/from them and use their ops.
+*)
+
+Fixpoint testbit a n :=
+ match n with
+   | O => odd a
+   | S n => testbit (div2 a) n
+ end.
+
+Definition shiftl a n := iter_nat n _ double a.
+Definition shiftr a n := iter_nat n _ div2 a.
+
+Fixpoint bitwise (op:bool->bool->bool) n a b :=
+ match n with
+  | O => O
+  | S n' =>
+    (if op (odd a) (odd b) then 1 else 0) +
+    2*(bitwise op n' (div2 a) (div2 b))
+ end.
+
+Definition land a b := bitwise andb a a b.
+Definition lor a b := bitwise orb (max a b) a b.
+Definition ldiff a b := bitwise (fun b b' => b && negb b') a a b.
+Definition lxor a b := bitwise xorb (max a b) a b.
+
+Lemma double_twice : forall n, double n = 2*n.
+Proof.
+ simpl; intros. now rewrite <- plus_n_O.
+Qed.
+
+Lemma testbit_0_l : forall n, testbit 0 n = false.
+Proof.
+ now induction n.
+Qed.
+
+Lemma testbit_odd_0 a : testbit (2*a+1) 0 = true.
+Proof.
+ unfold testbit. rewrite odd_spec. now exists a.
+Qed.
+
+Lemma testbit_even_0 a : testbit (2*a) 0 = false.
+Proof.
+ unfold testbit, odd. rewrite (proj2 (even_spec _)); trivial.
+ now exists a.
+Qed.
+
+Lemma testbit_odd_succ a n : testbit (2*a+1) (S n) = testbit a n.
+Proof.
+ unfold testbit; fold testbit.
+ rewrite <- plus_n_Sm, <- plus_n_O. f_equal.
+ apply div2_double_plus_one.
+Qed.
+
+Lemma testbit_even_succ a n : testbit (2*a) (S n) = testbit a n.
+Proof.
+ unfold testbit; fold testbit. f_equal. apply div2_double.
+Qed.
+
+Lemma shiftr_spec : forall a n m,
+ testbit (shiftr a n) m = testbit a (m+n).
+Proof.
+ induction n; intros m. trivial.
+ now rewrite <- plus_n_O.
+ now rewrite <- plus_n_Sm, <- plus_Sn_m, <- IHn.
+Qed.
+
+Lemma shiftl_spec_high : forall a n m, n<=m ->
+ testbit (shiftl a n) m = testbit a (m-n).
+Proof.
+ induction n; intros m H. trivial.
+ now rewrite <- minus_n_O.
+ destruct m. inversion H.
+ simpl. apply le_S_n in H.
+ change (shiftl a (S n)) with (double (shiftl a n)).
+ rewrite double_twice, div2_double. now apply IHn.
+Qed.
+
+Lemma shiftl_spec_low : forall a n m, m<n ->
+ testbit (shiftl a n) m = false.
+Proof.
+ induction n; intros m H. inversion H.
+ change (shiftl a (S n)) with (double (shiftl a n)).
+ destruct m; simpl.
+ unfold odd. apply negb_false_iff.
+ apply even_spec. exists (shiftl a n). apply double_twice.
+ rewrite double_twice, div2_double. apply IHn.
+ now apply lt_S_n.
+Qed.
+
+Lemma div2_bitwise : forall op n a b,
+ div2 (bitwise op (S n) a b) = bitwise op n (div2 a) (div2 b).
+Proof.
+ intros. unfold bitwise; fold bitwise.
+ destruct (op (odd a) (odd b)).
+ now rewrite div2_double_plus_one.
+ now rewrite plus_O_n, div2_double.
+Qed.
+
+Lemma odd_bitwise : forall op n a b,
+ odd (bitwise op (S n) a b) = op (odd a) (odd b).
+Proof.
+ intros. unfold bitwise; fold bitwise.
+ destruct (op (odd a) (odd b)).
+ apply odd_spec. rewrite plus_comm. eexists; eauto.
+ unfold odd. apply negb_false_iff. apply even_spec.
+ rewrite plus_O_n; eexists; eauto.
+Qed.
+
+Lemma div2_decr : forall a n, a <= S n -> div2 a <= n.
+Proof.
+ destruct a; intros. apply le_0_n.
+ apply le_trans with a.
+ apply lt_n_Sm_le, lt_div2, lt_0_Sn. now apply le_S_n.
+Qed.
+
+Lemma testbit_bitwise_1 : forall op, (forall b, op false b = false) ->
+ forall n m a b, a<=n ->
+ testbit (bitwise op n a b) m = op (testbit a m) (testbit b m).
+Proof.
+ intros op Hop.
+ induction n; intros m a b Ha.
+ simpl. inversion Ha; subst. now rewrite testbit_0_l.
+ destruct m.
+ apply odd_bitwise.
+ unfold testbit; fold testbit. rewrite div2_bitwise.
+ apply IHn; now apply div2_decr.
+Qed.
+
+Lemma testbit_bitwise_2 : forall op, op false false = false ->
+ forall n m a b, a<=n -> b<=n ->
+ testbit (bitwise op n a b) m = op (testbit a m) (testbit b m).
+Proof.
+ intros op Hop.
+ induction n; intros m a b Ha Hb.
+ simpl. inversion Ha; inversion Hb; subst. now rewrite testbit_0_l.
+ destruct m.
+ apply odd_bitwise.
+ unfold testbit; fold testbit. rewrite div2_bitwise.
+ apply IHn; now apply div2_decr.
+Qed.
+
+Lemma land_spec : forall a b n,
+ testbit (land a b) n = testbit a n && testbit b n.
+Proof.
+ intros. unfold land. apply testbit_bitwise_1; trivial.
+Qed.
+
+Lemma ldiff_spec : forall a b n,
+ testbit (ldiff a b) n = testbit a n && negb (testbit b n).
+Proof.
+ intros. unfold ldiff. apply testbit_bitwise_1; trivial.
+Qed.
+
+Lemma lor_spec : forall a b n,
+ testbit (lor a b) n = testbit a n || testbit b n.
+Proof.
+ intros. unfold lor. apply testbit_bitwise_2. trivial.
+ destruct (le_ge_dec a b). now rewrite max_r. now rewrite max_l.
+ destruct (le_ge_dec a b). now rewrite max_r. now rewrite max_l.
+Qed.
+
+Lemma lxor_spec : forall a b n,
+ testbit (lxor a b) n = xorb (testbit a n) (testbit b n).
+Proof.
+ intros. unfold lxor. apply testbit_bitwise_2. trivial.
+ destruct (le_ge_dec a b). now rewrite max_r. now rewrite max_l.
+ destruct (le_ge_dec a b). now rewrite max_r. now rewrite max_l.
+Qed.
 
 (** * Implementation of [NAxiomsSig] by [nat] *)
 
-Module NPeanoAxiomsMod <: NAxiomsSig.
+Module Nat
+ <: NAxiomsSig <: UsualDecidableTypeFull <: OrderedTypeFull <: TotalOrder.
 
 (** Bi-directional induction. *)
 
@@ -40,6 +598,16 @@ Proof.
 reflexivity.
 Qed.
 
+Theorem one_succ : 1 = S 0.
+Proof.
+reflexivity.
+Qed.
+
+Theorem two_succ : 2 = S 1.
+Proof.
+reflexivity.
+Qed.
+
 Theorem add_0_l : forall n : nat, 0 + n = n.
 Proof.
 reflexivity.
@@ -57,7 +625,7 @@ Qed.
 
 Theorem sub_succ_r : forall n m : nat, n - (S m) = pred (n - m).
 Proof.
-intros n m; induction n m using nat_double_ind; simpl; auto. apply sub_0_r.
+induction n; destruct m; simpl; auto. apply sub_0_r.
 Qed.
 
 Theorem mul_0_l : forall n : nat, 0 * n = 0.
@@ -67,49 +635,32 @@ Qed.
 
 Theorem mul_succ_l : forall n m : nat, S n * m = n * m + m.
 Proof.
-intros n m; now rewrite plus_comm.
+assert (add_S_r : forall n m, n+S m = S(n+m)) by (induction n; auto).
+assert (add_comm : forall n m, n+m = m+n).
+ induction n; simpl; auto. intros; rewrite add_S_r; auto.
+intros n m; now rewrite add_comm.
 Qed.
 
 (** Order on natural numbers *)
 
 Program Instance lt_wd : Proper (eq==>eq==>iff) lt.
 
-Theorem lt_eq_cases : forall n m : nat, n <= m <-> n < m \/ n = m.
-Proof.
-intros n m; split.
-apply le_lt_or_eq.
-intro H; destruct H as [H | H].
-now apply lt_le_weak. rewrite H; apply le_refl.
-Qed.
-
-Theorem lt_irrefl : forall n : nat, ~ (n < n).
-Proof.
-exact lt_irrefl.
-Qed.
-
 Theorem lt_succ_r : forall n m : nat, n < S m <-> n <= m.
 Proof.
-intros n m; split; [apply lt_n_Sm_le | apply le_lt_n_Sm].
+unfold lt; split. apply le_S_n. induction 1; auto.
 Qed.
 
-Theorem min_l : forall n m : nat, n <= m -> min n m = n.
-Proof.
-exact min_l.
-Qed.
-
-Theorem min_r : forall n m : nat, m <= n -> min n m = m.
-Proof.
-exact min_r.
-Qed.
 
-Theorem max_l : forall n m : nat, m <= n -> max n m = n.
+Theorem lt_eq_cases : forall n m : nat, n <= m <-> n < m \/ n = m.
 Proof.
-exact max_l.
+split.
+inversion 1; auto. rewrite lt_succ_r; auto.
+destruct 1; [|subst; auto]. rewrite <- lt_succ_r; auto.
 Qed.
 
-Theorem max_r : forall n m : nat, n <= m -> max n m = m.
+Theorem lt_irrefl : forall n : nat, ~ (n < n).
 Proof.
-exact max_r.
+induction n. intro H; inversion H. rewrite lt_succ_r; auto.
 Qed.
 
 (** Facts specific to natural numbers, not integers. *)
@@ -119,25 +670,26 @@ Proof.
 reflexivity.
 Qed.
 
-Definition recursion (A : Type) : A -> (nat -> A -> A) -> nat -> A :=
+(** Recursion fonction *)
+
+Definition recursion {A} : A -> (nat -> A -> A) -> nat -> A :=
   nat_rect (fun _ => A).
-Implicit Arguments recursion [A].
 
-Instance recursion_wd (A : Type) (Aeq : relation A) :
- Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A).
+Instance recursion_wd {A} (Aeq : relation A) :
+ Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) recursion.
 Proof.
 intros a a' Ha f f' Hf n n' Hn. subst n'.
 induction n; simpl; auto. apply Hf; auto.
 Qed.
 
 Theorem recursion_0 :
-  forall (A : Type) (a : A) (f : nat -> A -> A), recursion a f 0 = a.
+  forall {A} (a : A) (f : nat -> A -> A), recursion a f 0 = a.
 Proof.
 reflexivity.
 Qed.
 
 Theorem recursion_succ :
-  forall (A : Type) (Aeq : relation A) (a : A) (f : nat -> A -> A),
+  forall {A} (Aeq : relation A) (a : A) (f : nat -> A -> A),
     Aeq a a -> Proper (eq==>Aeq==>Aeq) f ->
       forall n : nat, Aeq (recursion a f (S n)) (f n (recursion a f n)).
 Proof.
@@ -149,7 +701,11 @@ Qed.
 
 Definition t := nat.
 Definition eq := @eq nat.
+Definition eqb := beq_nat.
+Definition compare := nat_compare.
 Definition zero := 0.
+Definition one := 1.
+Definition two := 2.
 Definition succ := S.
 Definition pred := pred.
 Definition add := plus.
@@ -157,81 +713,101 @@ Definition sub := minus.
 Definition mul := mult.
 Definition lt := lt.
 Definition le := le.
+Definition ltb := ltb.
+Definition leb := leb.
+
 Definition min := min.
 Definition max := max.
-
-End NPeanoAxiomsMod.
-
-(** Now we apply the largest property functor *)
-
-Module Export NPeanoPropMod := NPropFunct NPeanoAxiomsMod.
-
-
-
-(** Euclidean Division *)
-
-Definition divF div x y := if leb y x then S (div (x-y) y) else 0.
-Definition modF mod x y := if leb y x then mod (x-y) y else x.
-Definition initF (_ _ : nat) := 0.
-
-Fixpoint loop {A} (F:A->A)(i:A) (n:nat) : A :=
- match n with
-  | 0 => i
-  | S n => F (loop F i n)
- end.
-
-Definition div x y := loop divF initF x x y.
-Definition modulo x y := loop modF initF x x y.
-Infix "/" := div : nat_scope.
-Infix "mod" := modulo (at level 40, no associativity) : nat_scope.
-
-Lemma div_mod : forall x y, y<>0 -> x = y*(x/y) + x mod y.
-Proof.
- cut (forall n x y, y<>0 -> x<=n ->
-       x = y*(loop divF initF n x y) + (loop modF initF n x y)).
- intros H x y Hy. apply H; auto.
- induction n.
- simpl; unfold initF; simpl. intros. nzsimpl. auto with arith.
- simpl; unfold divF at 1, modF at 1.
- intros.
- destruct (leb y x) as [ ]_eqn:L;
-  [apply leb_complete in L | apply leb_complete_conv in L].
- rewrite mul_succ_r, <- add_assoc, (add_comm y), add_assoc.
- rewrite <- IHn; auto.
- symmetry; apply sub_add; auto.
- rewrite <- NPeanoAxiomsMod.lt_succ_r.
- apply lt_le_trans with x; auto.
- apply lt_minus; auto. rewrite <- neq_0_lt_0; auto.
- nzsimpl; auto.
-Qed.
-
-Lemma mod_upper_bound : forall x y, y<>0 -> x mod y < y.
-Proof.
- cut (forall n x y, y<>0 -> x<=n -> loop modF initF n x y < y).
- intros H x y Hy. apply H; auto.
- induction n.
- simpl; unfold initF. intros. rewrite <- neq_0_lt_0; auto.
- simpl; unfold modF at 1.
- intros.
- destruct (leb y x) as [ ]_eqn:L;
-  [apply leb_complete in L | apply leb_complete_conv in L]; auto.
- apply IHn; auto.
- rewrite <- NPeanoAxiomsMod.lt_succ_r.
- apply lt_le_trans with x; auto.
- apply lt_minus; auto. rewrite <- neq_0_lt_0; auto.
-Qed.
-
-Require Import NDiv.
-
-Module NDivMod <: NDivSig.
- Include NPeanoAxiomsMod.
- Definition div := div.
- Definition modulo := modulo.
- Definition div_mod := div_mod.
- Definition mod_upper_bound := mod_upper_bound.
- Local Obligation Tactic := simpl_relation.
- Program Instance div_wd : Proper (eq==>eq==>eq) div.
- Program Instance mod_wd : Proper (eq==>eq==>eq) modulo.
-End NDivMod.
-
-Module Export NDivPropMod := NDivPropFunct NDivMod NPeanoPropMod.
+Definition max_l := max_l.
+Definition max_r := max_r.
+Definition min_l := min_l.
+Definition min_r := min_r.
+
+Definition eqb_eq := beq_nat_true_iff.
+Definition compare_spec := nat_compare_spec.
+Definition eq_dec := eq_nat_dec.
+Definition leb_le := leb_le.
+Definition ltb_lt := ltb_lt.
+
+Definition Even := Even.
+Definition Odd := Odd.
+Definition even := even.
+Definition odd := odd.
+Definition even_spec := even_spec.
+Definition odd_spec := odd_spec.
+
+Program Instance pow_wd : Proper (eq==>eq==>eq) pow.
+Definition pow_0_r := pow_0_r.
+Definition pow_succ_r := pow_succ_r.
+Lemma pow_neg_r : forall a b, b<0 -> a^b = 0. inversion 1. Qed.
+Definition pow := pow.
+
+Definition square := square.
+Definition square_spec := square_spec.
+
+Definition log2_spec := log2_spec.
+Definition log2_nonpos := log2_nonpos.
+Definition log2 := log2.
+
+Definition sqrt_spec a (Ha:0<=a) := sqrt_spec a.
+Lemma sqrt_neg : forall a, a<0 -> sqrt a = 0. inversion 1. Qed.
+Definition sqrt := sqrt.
+
+Definition div := div.
+Definition modulo := modulo.
+Program Instance div_wd : Proper (eq==>eq==>eq) div.
+Program Instance mod_wd : Proper (eq==>eq==>eq) modulo.
+Definition div_mod := div_mod.
+Definition mod_bound_pos := mod_bound_pos.
+
+Definition divide := divide.
+Definition gcd := gcd.
+Definition gcd_divide_l := gcd_divide_l.
+Definition gcd_divide_r := gcd_divide_r.
+Definition gcd_greatest := gcd_greatest.
+Lemma gcd_nonneg : forall a b, 0<=gcd a b.
+Proof. intros. apply le_O_n. Qed.
+
+Definition testbit := testbit.
+Definition shiftl := shiftl.
+Definition shiftr := shiftr.
+Definition lxor := lxor.
+Definition land := land.
+Definition lor := lor.
+Definition ldiff := ldiff.
+Definition div2 := div2.
+
+Program Instance testbit_wd : Proper (eq==>eq==>Logic.eq) testbit.
+Definition testbit_odd_0 := testbit_odd_0.
+Definition testbit_even_0 := testbit_even_0.
+Definition testbit_odd_succ a n (_:0<=n) := testbit_odd_succ a n.
+Definition testbit_even_succ a n (_:0<=n) := testbit_even_succ a n.
+Lemma testbit_neg_r a n (H:n<0) : testbit a n = false.
+Proof. inversion H. Qed.
+Definition shiftl_spec_low := shiftl_spec_low.
+Definition shiftl_spec_high a n m (_:0<=m) := shiftl_spec_high a n m.
+Definition shiftr_spec a n m (_:0<=m) := shiftr_spec a n m.
+Definition lxor_spec := lxor_spec.
+Definition land_spec := land_spec.
+Definition lor_spec := lor_spec.
+Definition ldiff_spec := ldiff_spec.
+Definition div2_spec a : div2 a = shiftr a 1 := eq_refl _.
+
+(** Generic Properties *)
+
+Include NProp
+ <+ UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
+
+End Nat.
+
+(** [Nat] contains an [order] tactic for natural numbers *)
+
+(** Note that [Nat.order] is domain-agnostic: it will not prove
+    [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
+
+Section TestOrder.
+ Let test : forall x y, x<=y -> y<=x -> x=y.
+ Proof.
+ Nat.order.
+ Qed.
+End TestOrder.
diff --git a/theories/Numbers/Natural/SpecViaZ/NSig.v b/theories/Numbers/Natural/SpecViaZ/NSig.v
index 7893a82d..0b8bded0 100644
--- a/theories/Numbers/Natural/SpecViaZ/NSig.v
+++ b/theories/Numbers/Natural/SpecViaZ/NSig.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,9 +8,7 @@
 (*            Benjamin Gregoire, Laurent Thery, INRIA, 2007             *)
 (************************************************************************)
 
-(*i $Id: NSig.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import ZArith Znumtheory.
+Require Import BinInt.
 
 Open Scope Z_scope.
 
@@ -29,60 +27,83 @@ Module Type NType.
  Parameter spec_pos: forall x, 0 <= [x].
 
  Parameter of_N : N -> t.
- Parameter spec_of_N: forall x, to_Z (of_N x) = Z_of_N x.
- Definition to_N n := Zabs_N (to_Z n).
+ Parameter spec_of_N: forall x, to_Z (of_N x) = Z.of_N x.
+ Definition to_N n := Z.to_N (to_Z n).
 
  Definition eq n m := [n] = [m].
  Definition lt n m := [n] < [m].
  Definition le n m := [n] <= [m].
 
  Parameter compare : t -> t -> comparison.
- Parameter eq_bool : t -> t -> bool.
+ Parameter eqb : t -> t -> bool.
+ Parameter ltb : t -> t -> bool.
+ Parameter leb : t -> t -> bool.
  Parameter max : t -> t -> t.
  Parameter min : t -> t -> t.
  Parameter zero : t.
  Parameter one : t.
+ Parameter two : t.
  Parameter succ : t -> t.
  Parameter pred : t -> t.
  Parameter add  : t -> t -> t.
  Parameter sub : t -> t -> t.
  Parameter mul : t -> t -> t.
  Parameter square : t -> t.
- Parameter power_pos : t -> positive -> t.
- Parameter power : t -> N -> t.
+ Parameter pow_pos : t -> positive -> t.
+ Parameter pow_N : t -> N -> t.
+ Parameter pow : t -> t -> t.
  Parameter sqrt : t -> t.
+ Parameter log2 : t -> t.
  Parameter div_eucl : t -> t -> t * t.
  Parameter div : t -> t -> t.
  Parameter modulo : t -> t -> t.
  Parameter gcd : t -> t -> t.
+ Parameter even : t -> bool.
+ Parameter odd : t -> bool.
+ Parameter testbit : t -> t -> bool.
  Parameter shiftr : t -> t -> t.
  Parameter shiftl : t -> t -> t.
- Parameter is_even : t -> bool.
+ Parameter land : t -> t -> t.
+ Parameter lor : t -> t -> t.
+ Parameter ldiff : t -> t -> t.
+ Parameter lxor : t -> t -> t.
+ Parameter div2 : t -> t.
 
- Parameter spec_compare: forall x y, compare x y = Zcompare [x] [y].
- Parameter spec_eq_bool: forall x y, eq_bool x y = Zeq_bool [x] [y].
- Parameter spec_max : forall x y, [max x y] = Zmax [x] [y].
- Parameter spec_min : forall x y, [min x y] = Zmin [x] [y].
+ Parameter spec_compare: forall x y, compare x y = ([x] ?= [y]).
+ Parameter spec_eqb : forall x y, eqb x y = ([x] =? [y]).
+ Parameter spec_ltb : forall x y, ltb x y = ([x] <? [y]).
+ Parameter spec_leb : forall x y, leb x y = ([x] <=? [y]).
+ Parameter spec_max : forall x y, [max x y] = Z.max [x] [y].
+ Parameter spec_min : forall x y, [min x y] = Z.min [x] [y].
  Parameter spec_0: [zero] = 0.
  Parameter spec_1: [one] = 1.
+ Parameter spec_2: [two] = 2.
  Parameter spec_succ: forall n, [succ n] = [n] + 1.
  Parameter spec_add: forall x y, [add x y] = [x] + [y].
- Parameter spec_pred: forall x, [pred x] = Zmax 0 ([x] - 1).
- Parameter spec_sub: forall x y, [sub x y] = Zmax 0 ([x] - [y]).
+ Parameter spec_pred: forall x, [pred x] = Z.max 0 ([x] - 1).
+ Parameter spec_sub: forall x y, [sub x y] = Z.max 0 ([x] - [y]).
  Parameter spec_mul: forall x y, [mul x y] = [x] * [y].
- Parameter spec_square: forall x, [square x] = [x] *  [x].
- Parameter spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n.
- Parameter spec_power: forall x n, [power x n] = [x] ^ Z_of_N n.
- Parameter spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2.
+ Parameter spec_square: forall x, [square x] = [x] * [x].
+ Parameter spec_pow_pos: forall x n, [pow_pos x n] = [x] ^ Zpos n.
+ Parameter spec_pow_N: forall x n, [pow_N x n] = [x] ^ Z.of_N n.
+ Parameter spec_pow: forall x n, [pow x n] = [x] ^ [n].
+ Parameter spec_sqrt: forall x, [sqrt x] = Z.sqrt [x].
+ Parameter spec_log2: forall x, [log2 x] = Z.log2 [x].
  Parameter spec_div_eucl: forall x y,
-  let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y].
+  let (q,r) := div_eucl x y in ([q], [r]) = Z.div_eucl [x] [y].
  Parameter spec_div: forall x y, [div x y] = [x] / [y].
  Parameter spec_modulo: forall x y, [modulo x y] = [x] mod [y].
- Parameter spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b].
- Parameter spec_shiftr: forall p x, [shiftr p x] = [x] / 2^[p].
- Parameter spec_shiftl: forall p x, [shiftl p x] = [x] * 2^[p].
- Parameter spec_is_even: forall x,
-  if is_even x then [x] mod 2 = 0 else [x] mod 2 = 1.
+ Parameter spec_gcd: forall a b, [gcd a b] = Z.gcd [a] [b].
+ Parameter spec_even: forall x, even x = Z.even [x].
+ Parameter spec_odd: forall x, odd x = Z.odd [x].
+ Parameter spec_testbit: forall x p, testbit x p = Z.testbit [x] [p].
+ Parameter spec_shiftr: forall x p, [shiftr x p] = Z.shiftr [x] [p].
+ Parameter spec_shiftl: forall x p, [shiftl x p] = Z.shiftl [x] [p].
+ Parameter spec_land: forall x y, [land x y] = Z.land [x] [y].
+ Parameter spec_lor: forall x y, [lor x y] = Z.lor [x] [y].
+ Parameter spec_ldiff: forall x y, [ldiff x y] = Z.ldiff [x] [y].
+ Parameter spec_lxor: forall x y, [lxor x y] = Z.lxor [x] [y].
+ Parameter spec_div2: forall x, [div2 x] = Z.div2 [x].
 
 End NType.
 
@@ -90,9 +111,12 @@ Module Type NType_Notation (Import N:NType).
  Notation "[ x ]" := (to_Z x).
  Infix "==" := eq (at level 70).
  Notation "0" := zero.
+ Notation "1" := one.
+ Notation "2" := two.
  Infix "+" := add.
  Infix "-" := sub.
  Infix "*" := mul.
+ Infix "^" := pow.
  Infix "<=" := le.
  Infix "<" := lt.
 End NType_Notation.
diff --git a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
index a0e096be..37d5db10 100644
--- a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
+++ b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
@@ -1,27 +1,28 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: NSigNAxioms.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import ZArith Nnat NAxioms NDiv NSig.
+Require Import ZArith OrdersFacts Nnat NAxioms NSig.
 
 (** * The interface [NSig.NType] implies the interface [NAxiomsSig] *)
 
-Module NTypeIsNAxioms (Import N : NType').
+Module NTypeIsNAxioms (Import NN : NType').
 
 Hint Rewrite
- spec_0 spec_succ spec_add spec_mul spec_pred spec_sub
- spec_div spec_modulo spec_gcd spec_compare spec_eq_bool
- spec_max spec_min spec_power_pos spec_power
+ spec_0 spec_1 spec_2 spec_succ spec_add spec_mul spec_pred spec_sub
+ spec_div spec_modulo spec_gcd spec_compare spec_eqb spec_ltb spec_leb
+ spec_square spec_sqrt spec_log2 spec_max spec_min spec_pow_pos spec_pow_N
+ spec_pow spec_even spec_odd spec_testbit spec_shiftl spec_shiftr
+ spec_land spec_lor spec_ldiff spec_lxor spec_div2 spec_of_N
  : nsimpl.
 Ltac nsimpl := autorewrite with nsimpl.
-Ltac ncongruence := unfold eq; repeat red; intros; nsimpl; congruence.
-Ltac zify := unfold eq, lt, le in *; nsimpl.
+Ltac ncongruence := unfold eq, to_N; repeat red; intros; nsimpl; congruence.
+Ltac zify := unfold eq, lt, le, to_N in *; nsimpl.
+Ltac omega_pos n := generalize (spec_pos n); omega with *.
 
 Local Obligation Tactic := ncongruence.
 
@@ -36,14 +37,29 @@ Program Instance mul_wd : Proper (eq==>eq==>eq) mul.
 
 Theorem pred_succ : forall n, pred (succ n) == n.
 Proof.
-intros. zify. generalize (spec_pos n); omega with *.
+intros. zify. omega_pos n.
 Qed.
 
-Definition N_of_Z z := of_N (Zabs_N z).
+Theorem one_succ : 1 == succ 0.
+Proof.
+now zify.
+Qed.
+
+Theorem two_succ : 2 == succ 1.
+Proof.
+now zify.
+Qed.
+
+Definition N_of_Z z := of_N (Z.to_N z).
+
+Lemma spec_N_of_Z z : (0<=z)%Z -> [N_of_Z z] = z.
+Proof.
+ unfold N_of_Z. zify. apply Z2N.id.
+Qed.
 
 Section Induction.
 
-Variable A : N.t -> Prop.
+Variable A : NN.t -> Prop.
 Hypothesis A_wd : Proper (eq==>iff) A.
 Hypothesis A0 : A 0.
 Hypothesis AS : forall n, A n <-> A (succ n).
@@ -62,9 +78,7 @@ Proof.
 intros z H1 H2.
 unfold B in *. apply -> AS in H2.
 setoid_replace (N_of_Z (z + 1)) with (succ (N_of_Z z)); auto.
-unfold eq. rewrite spec_succ.
-unfold N_of_Z.
-rewrite 2 spec_of_N, 2 Z_of_N_abs, 2 Zabs_eq; auto with zarith.
+unfold eq. rewrite spec_succ, 2 spec_N_of_Z; auto with zarith.
 Qed.
 
 Lemma B_holds : forall z : Z, (0 <= z)%Z -> B z.
@@ -76,9 +90,7 @@ Theorem bi_induction : forall n, A n.
 Proof.
 intro n. setoid_replace n with (N_of_Z (to_Z n)).
 apply B_holds. apply spec_pos.
-red; unfold N_of_Z.
-rewrite spec_of_N, Z_of_N_abs, Zabs_eq; auto.
-apply spec_pos.
+red. now rewrite spec_N_of_Z by apply spec_pos.
 Qed.
 
 End Induction.
@@ -95,7 +107,7 @@ Qed.
 
 Theorem sub_0_r : forall n, n - 0 == n.
 Proof.
-intros. zify. generalize (spec_pos n); omega with *.
+intros. zify. omega_pos n.
 Qed.
 
 Theorem sub_succ_r : forall n m, n - (succ m) == pred (n - m).
@@ -115,39 +127,69 @@ Qed.
 
 (** Order *)
 
-Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y).
+Lemma eqb_eq x y : eqb x y = true <-> x == y.
+Proof.
+ zify. apply Z.eqb_eq.
+Qed.
+
+Lemma leb_le x y : leb x y = true <-> x <= y.
+Proof.
+ zify. apply Z.leb_le.
+Qed.
+
+Lemma ltb_lt x y : ltb x y = true <-> x < y.
+Proof.
+ zify. apply Z.ltb_lt.
+Qed.
+
+Lemma compare_eq_iff n m : compare n m = Eq <-> n == m.
 Proof.
- intros. zify. destruct (Zcompare_spec [x] [y]); auto.
+ intros. zify. apply Z.compare_eq_iff.
 Qed.
 
-Definition eqb := eq_bool.
+Lemma compare_lt_iff n m : compare n m = Lt <-> n < m.
+Proof.
+ intros. zify. reflexivity.
+Qed.
 
-Lemma eqb_eq : forall x y, eq_bool x y = true <-> x == y.
+Lemma compare_le_iff n m : compare n m <> Gt <-> n <= m.
 Proof.
- intros. zify. symmetry. apply Zeq_is_eq_bool.
+ intros. zify. reflexivity.
 Qed.
 
+Lemma compare_antisym n m : compare m n = CompOpp (compare n m).
+Proof.
+ intros. zify. apply Z.compare_antisym.
+Qed.
+
+Include BoolOrderFacts NN NN NN [no inline].
+
 Instance compare_wd : Proper (eq ==> eq ==> Logic.eq) compare.
 Proof.
-intros x x' Hx y y' Hy. rewrite 2 spec_compare, Hx, Hy; intuition.
+intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
 Qed.
 
-Instance lt_wd : Proper (eq ==> eq ==> iff) lt.
+Instance eqb_wd : Proper (eq ==> eq ==> Logic.eq) eqb.
 Proof.
-intros x x' Hx y y' Hy; unfold lt; rewrite Hx, Hy; intuition.
+intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
 Qed.
 
-Theorem lt_eq_cases : forall n m, n <= m <-> n < m \/ n == m.
+Instance ltb_wd : Proper (eq ==> eq ==> Logic.eq) ltb.
 Proof.
-intros. zify. omega.
+intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
 Qed.
 
-Theorem lt_irrefl : forall n, ~ n < n.
+Instance leb_wd : Proper (eq ==> eq ==> Logic.eq) leb.
 Proof.
-intros. zify. omega.
+intros x x' Hx y y' Hy. zify. now rewrite Hx, Hy.
 Qed.
 
-Theorem lt_succ_r : forall n m, n < (succ m) <-> n <= m.
+Instance lt_wd : Proper (eq ==> eq ==> iff) lt.
+Proof.
+intros x x' Hx y y' Hy; unfold lt; rewrite Hx, Hy; intuition.
+Qed.
+
+Theorem lt_succ_r : forall n m, n < succ m <-> n <= m.
 Proof.
 intros. zify. omega.
 Qed.
@@ -179,24 +221,231 @@ Proof.
 zify. auto.
 Qed.
 
+(** Power *)
+
+Program Instance pow_wd : Proper (eq==>eq==>eq) pow.
+
+Lemma pow_0_r : forall a, a^0 == 1.
+Proof.
+ intros. now zify.
+Qed.
+
+Lemma pow_succ_r : forall a b, 0<=b -> a^(succ b) == a * a^b.
+Proof.
+ intros a b. zify. intros. now Z.nzsimpl.
+Qed.
+
+Lemma pow_neg_r : forall a b, b<0 -> a^b == 0.
+Proof.
+ intros a b. zify. intro Hb. exfalso. omega_pos b.
+Qed.
+
+Lemma pow_pow_N : forall a b, a^b == pow_N a (to_N b).
+Proof.
+ intros. zify. f_equal.
+ now rewrite Z2N.id by apply spec_pos.
+Qed.
+
+Lemma pow_N_pow : forall a b, pow_N a b == a^(of_N b).
+Proof.
+ intros. now zify.
+Qed.
+
+Lemma pow_pos_N : forall a p, pow_pos a p == pow_N a (Npos p).
+Proof.
+ intros. now zify.
+Qed.
+
+(** Square *)
+
+Lemma square_spec n : square n == n * n.
+Proof.
+ now zify.
+Qed.
+
+(** Sqrt *)
+
+Lemma sqrt_spec : forall n, 0<=n ->
+ (sqrt n)*(sqrt n) <= n /\ n < (succ (sqrt n))*(succ (sqrt n)).
+Proof.
+ intros n. zify. apply Z.sqrt_spec.
+Qed.
+
+Lemma sqrt_neg : forall n, n<0 -> sqrt n == 0.
+Proof.
+ intros n. zify. intro H. exfalso. omega_pos n.
+Qed.
+
+(** Log2 *)
+
+Lemma log2_spec : forall n, 0<n ->
+ 2^(log2 n) <= n /\ n < 2^(succ (log2 n)).
+Proof.
+ intros n. zify. change (Z.log2 [n]+1)%Z with (Z.succ (Z.log2 [n])).
+ apply Z.log2_spec.
+Qed.
+
+Lemma log2_nonpos : forall n, n<=0 -> log2 n == 0.
+Proof.
+ intros n. zify. apply Z.log2_nonpos.
+Qed.
+
+(** Even / Odd *)
+
+Definition Even n := exists m, n == 2*m.
+Definition Odd n := exists m, n == 2*m+1.
+
+Lemma even_spec n : even n = true <-> Even n.
+Proof.
+ unfold Even. zify. rewrite Z.even_spec.
+ split; intros (m,Hm).
+ - exists (N_of_Z m). zify. rewrite spec_N_of_Z; trivial. omega_pos n.
+ - exists [m]. revert Hm; now zify.
+Qed.
+
+Lemma odd_spec n : odd n = true <-> Odd n.
+Proof.
+ unfold Odd. zify. rewrite Z.odd_spec.
+ split; intros (m,Hm).
+ - exists (N_of_Z m). zify. rewrite spec_N_of_Z; trivial. omega_pos n.
+ - exists [m]. revert Hm; now zify.
+Qed.
+
+(** Div / Mod *)
+
 Program Instance div_wd : Proper (eq==>eq==>eq) div.
 Program Instance mod_wd : Proper (eq==>eq==>eq) modulo.
 
 Theorem div_mod : forall a b, ~b==0 -> a == b*(div a b) + (modulo a b).
 Proof.
-intros a b. zify. intros. apply Z_div_mod_eq_full; auto.
+intros a b. zify. intros. apply Z.div_mod; auto.
+Qed.
+
+Theorem mod_bound_pos : forall a b, 0<=a -> 0<b ->
+ 0 <= modulo a b /\ modulo a b < b.
+Proof.
+intros a b. zify. apply Z.mod_bound_pos.
+Qed.
+
+(** Gcd *)
+
+Definition divide n m := exists p, m == p*n.
+Local Notation "( x | y )" := (divide x y) (at level 0).
+
+Lemma spec_divide : forall n m, (n|m) <-> Z.divide [n] [m].
+Proof.
+ intros n m. split.
+ - intros (p,H). exists [p]. revert H; now zify.
+ - intros (z,H). exists (of_N (Z.abs_N z)). zify.
+   rewrite N2Z.inj_abs_N.
+   rewrite <- (Z.abs_eq [m]), <- (Z.abs_eq [n]) by apply spec_pos.
+   now rewrite H, Z.abs_mul.
 Qed.
 
-Theorem mod_upper_bound : forall a b, ~b==0 -> modulo a b < b.
+Lemma gcd_divide_l : forall n m, (gcd n m | n).
 Proof.
-intros a b. zify. intros.
-destruct (Z_mod_lt [a] [b]); auto.
-generalize (spec_pos b); auto with zarith.
+ intros n m. apply spec_divide. zify. apply Z.gcd_divide_l.
 Qed.
 
-Definition recursion (A : Type) (a : A) (f : N.t -> A -> A) (n : N.t) :=
-  Nrect (fun _ => A) a (fun n a => f (N.of_N n) a) (N.to_N n).
-Implicit Arguments recursion [A].
+Lemma gcd_divide_r : forall n m, (gcd n m | m).
+Proof.
+ intros n m. apply spec_divide. zify. apply Z.gcd_divide_r.
+Qed.
+
+Lemma gcd_greatest : forall n m p, (p|n) -> (p|m) -> (p|gcd n m).
+Proof.
+ intros n m p. rewrite !spec_divide. zify. apply Z.gcd_greatest.
+Qed.
+
+Lemma gcd_nonneg : forall n m, 0 <= gcd n m.
+Proof.
+ intros. zify. apply Z.gcd_nonneg.
+Qed.
+
+(** Bitwise operations *)
+
+Program Instance testbit_wd : Proper (eq==>eq==>Logic.eq) testbit.
+
+Lemma testbit_odd_0 : forall a, testbit (2*a+1) 0 = true.
+Proof.
+ intros. zify. apply Z.testbit_odd_0.
+Qed.
+
+Lemma testbit_even_0 : forall a, testbit (2*a) 0 = false.
+Proof.
+ intros. zify. apply Z.testbit_even_0.
+Qed.
+
+Lemma testbit_odd_succ : forall a n, 0<=n ->
+ testbit (2*a+1) (succ n) = testbit a n.
+Proof.
+ intros a n. zify. apply Z.testbit_odd_succ.
+Qed.
+
+Lemma testbit_even_succ : forall a n, 0<=n ->
+ testbit (2*a) (succ n) = testbit a n.
+Proof.
+ intros a n. zify. apply Z.testbit_even_succ.
+Qed.
+
+Lemma testbit_neg_r : forall a n, n<0 -> testbit a n = false.
+Proof.
+ intros a n. zify. apply Z.testbit_neg_r.
+Qed.
+
+Lemma shiftr_spec : forall a n m, 0<=m ->
+ testbit (shiftr a n) m = testbit a (m+n).
+Proof.
+ intros a n m. zify. apply Z.shiftr_spec.
+Qed.
+
+Lemma shiftl_spec_high : forall a n m, 0<=m -> n<=m ->
+ testbit (shiftl a n) m = testbit a (m-n).
+Proof.
+ intros a n m. zify. intros Hn H. rewrite Z.max_r by auto with zarith.
+ now apply Z.shiftl_spec_high.
+Qed.
+
+Lemma shiftl_spec_low : forall a n m, m<n ->
+ testbit (shiftl a n) m = false.
+Proof.
+ intros a n m. zify. intros H. now apply Z.shiftl_spec_low.
+Qed.
+
+Lemma land_spec : forall a b n,
+ testbit (land a b) n = testbit a n && testbit b n.
+Proof.
+ intros a n m. zify. now apply Z.land_spec.
+Qed.
+
+Lemma lor_spec : forall a b n,
+ testbit (lor a b) n = testbit a n || testbit b n.
+Proof.
+ intros a n m. zify. now apply Z.lor_spec.
+Qed.
+
+Lemma ldiff_spec : forall a b n,
+ testbit (ldiff a b) n = testbit a n && negb (testbit b n).
+Proof.
+ intros a n m. zify. now apply Z.ldiff_spec.
+Qed.
+
+Lemma lxor_spec : forall a b n,
+ testbit (lxor a b) n = xorb (testbit a n) (testbit b n).
+Proof.
+ intros a n m. zify. now apply Z.lxor_spec.
+Qed.
+
+Lemma div2_spec : forall a, div2 a == shiftr a 1.
+Proof.
+ intros a. zify. now apply Z.div2_spec.
+Qed.
+
+(** Recursion *)
+
+Definition recursion (A : Type) (a : A) (f : NN.t -> A -> A) (n : NN.t) :=
+  N.peano_rect (fun _ => A) a (fun n a => f (NN.of_N n) a) (NN.to_N n).
+Arguments recursion [A] a f n.
 
 Instance recursion_wd (A : Type) (Aeq : relation A) :
  Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A).
@@ -204,53 +453,35 @@ Proof.
 unfold eq.
 intros a a' Eaa' f f' Eff' x x' Exx'.
 unfold recursion.
-unfold N.to_N.
+unfold NN.to_N.
 rewrite <- Exx'; clear x' Exx'.
-replace (Zabs_N [x]) with (N_of_nat (Zabs_nat [x])).
-induction (Zabs_nat [x]).
+induction (Z.to_N [x]) using N.peano_ind.
 simpl; auto.
-rewrite N_of_S, 2 Nrect_step; auto. apply Eff'; auto.
-destruct [x]; simpl; auto.
-change (nat_of_P p) with (nat_of_N (Npos p)); apply N_of_nat_of_N.
-change (nat_of_P p) with (nat_of_N (Npos p)); apply N_of_nat_of_N.
+rewrite 2 N.peano_rect_succ. now apply Eff'.
 Qed.
 
 Theorem recursion_0 :
-  forall (A : Type) (a : A) (f : N.t -> A -> A), recursion a f 0 = a.
+  forall (A : Type) (a : A) (f : NN.t -> A -> A), recursion a f 0 = a.
 Proof.
-intros A a f; unfold recursion, N.to_N; rewrite N.spec_0; simpl; auto.
+intros A a f; unfold recursion, NN.to_N; rewrite NN.spec_0; simpl; auto.
 Qed.
 
 Theorem recursion_succ :
-  forall (A : Type) (Aeq : relation A) (a : A) (f : N.t -> A -> A),
+  forall (A : Type) (Aeq : relation A) (a : A) (f : NN.t -> A -> A),
     Aeq a a -> Proper (eq==>Aeq==>Aeq) f ->
       forall n, Aeq (recursion a f (succ n)) (f n (recursion a f n)).
 Proof.
-unfold N.eq, recursion; intros A Aeq a f EAaa f_wd n.
-replace (N.to_N (succ n)) with (Nsucc (N.to_N n)).
-rewrite Nrect_step.
+unfold eq, recursion; intros A Aeq a f EAaa f_wd n.
+replace (to_N (succ n)) with (N.succ (to_N n)) by
+ (zify; now rewrite <- Z2N.inj_succ by apply spec_pos).
+rewrite N.peano_rect_succ.
 apply f_wd; auto.
-unfold N.to_N.
-rewrite N.spec_of_N, Z_of_N_abs, Zabs_eq; auto.
- apply N.spec_pos.
-
-fold (recursion a f n).
-apply recursion_wd; auto.
-red; auto.
-unfold N.to_N.
-
-rewrite N.spec_succ.
-change ([n]+1)%Z with (Zsucc [n]).
-apply Z_of_N_eq_rev.
-rewrite Z_of_N_succ.
-rewrite 2 Z_of_N_abs.
-rewrite 2 Zabs_eq; auto.
-generalize (spec_pos n); auto with zarith.
-apply spec_pos; auto.
+zify. now rewrite Z2N.id by apply spec_pos.
+fold (recursion a f n). apply recursion_wd; auto. red; auto.
 Qed.
 
 End NTypeIsNAxioms.
 
-Module NType_NAxioms (N : NType)
- <: NAxiomsSig <: NDivSig <: HasCompare N <: HasEqBool N <: HasMinMax N
- := N <+ NTypeIsNAxioms.
+Module NType_NAxioms (NN : NType)
+ <: NAxiomsSig <: OrderFunctions NN <: HasMinMax NN
+ := NN <+ NTypeIsNAxioms.
diff --git a/theories/Numbers/NumPrelude.v b/theories/Numbers/NumPrelude.v
index 124faba1..d637295e 100644
--- a/theories/Numbers/NumPrelude.v
+++ b/theories/Numbers/NumPrelude.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -8,132 +8,17 @@
 (*                      Evgeny Makarov, INRIA, 2007                     *)
 (************************************************************************)
 
-(*i $Id: NumPrelude.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Export Setoid Morphisms.
+Require Export Setoid Morphisms Morphisms_Prop.
 
 Set Implicit Arguments.
-(*
-Contents:
-- Coercion from bool to Prop
-- Extension of the tactics stepl and stepr
-- Extentional properties of predicates, relations and functions
-  (well-definedness and equality)
-- Relations on cartesian product
-- Miscellaneous
-*)
-
-(** Coercion from bool to Prop *)
-
-(*Definition eq_bool := (@eq bool).*)
-
-(*Inductive eq_true : bool -> Prop := is_eq_true : eq_true true.*)
-(* This has been added to theories/Datatypes.v *)
-(*Coercion eq_true : bool >-> Sortclass.*)
-
-(*Theorem eq_true_unfold_pos : forall b : bool, b <-> b = true.
-Proof.
-intro b; split; intro H. now inversion H. now rewrite H.
-Qed.
-
-Theorem eq_true_unfold_neg : forall b : bool, ~ b <-> b = false.
-Proof.
-intros b; destruct b; simpl; rewrite eq_true_unfold_pos.
-split; intro H; [elim (H (refl_equal true)) | discriminate H].
-split; intro H; [reflexivity | discriminate].
-Qed.
-
-Theorem eq_true_or : forall b1 b2 : bool, b1 || b2 <-> b1 \/ b2.
-Proof.
-destruct b1; destruct b2; simpl; tauto.
-Qed.
-
-Theorem eq_true_and : forall b1 b2 : bool, b1 && b2 <-> b1 /\ b2.
-Proof.
-destruct b1; destruct b2; simpl; tauto.
-Qed.
-
-Theorem eq_true_neg : forall b : bool, negb b <-> ~ b.
-Proof.
-destruct b; simpl; rewrite eq_true_unfold_pos; rewrite eq_true_unfold_neg;
-split; now intro.
-Qed.
-
-Theorem eq_true_iff : forall b1 b2 : bool, b1 = b2 <-> (b1 <-> b2).
-Proof.
-intros b1 b2; split; intro H.
-now rewrite H.
-destruct b1; destruct b2; simpl; try reflexivity.
-apply -> eq_true_unfold_neg. rewrite H. now intro.
-symmetry; apply -> eq_true_unfold_neg. rewrite <- H; now intro.
-Qed.*)
-
-(** Extension of the tactics stepl and stepr to make them
-applicable to hypotheses *)
-
-Tactic Notation "stepl" constr(t1') "in" hyp(H) :=
-match (type of H) with
-| ?R ?t1 ?t2 =>
-  let H1 := fresh in
-  cut (R t1' t2); [clear H; intro H | stepl t1; [assumption |]]
-| _ => fail 1 ": the hypothesis" H "does not have the form (R t1 t2)"
-end.
-
-Tactic Notation "stepl" constr(t1') "in" hyp(H) "by" tactic(r) := stepl t1' in H; [| r].
-
-Tactic Notation "stepr" constr(t2') "in" hyp(H) :=
-match (type of H) with
-| ?R ?t1 ?t2 =>
-  let H1 := fresh in
-  cut (R t1 t2'); [clear H; intro H | stepr t2; [assumption |]]
-| _ => fail 1 ": the hypothesis" H "does not have the form (R t1 t2)"
-end.
-
-Tactic Notation "stepr" constr(t2') "in" hyp(H) "by" tactic(r) := stepr t2' in H; [| r].
-
-(** Predicates, relations, functions *)
-
-Definition predicate (A : Type) := A -> Prop.
-
-Instance well_founded_wd A :
- Proper (@relation_equivalence A ==> iff) (@well_founded A).
-Proof.
-intros R1 R2 H.
-split; intros WF a; induction (WF a) as [x _ WF']; constructor;
-intros y Ryx; apply WF'; destruct (H y x); auto.
-Qed.
-
-(** [solve_predicate_wd] solves the goal [Proper (?==>iff) P]
-    for P consisting of morphisms and quantifiers *)
-
-Ltac solve_predicate_wd :=
-let x := fresh "x" in
-let y := fresh "y" in
-let H := fresh "H" in
-  intros x y H; setoid_rewrite H; reflexivity.
-
-(** [solve_relation_wd] solves the goal [Proper (?==>?==>iff) R]
-    for R consisting of morphisms and quantifiers *)
-
-Ltac solve_relation_wd :=
-let x1 := fresh "x" in
-let y1 := fresh "y" in
-let H1 := fresh "H" in
-let x2 := fresh "x" in
-let y2 := fresh "y" in
-let H2 := fresh "H" in
-  intros x1 y1 H1 x2 y2 H2;
-  rewrite H1; setoid_rewrite H2; reflexivity.
 
-(* The following tactic uses solve_predicate_wd to solve the goals
-relating to well-defidedness that are produced by applying induction.
+(* The following tactic uses solve_proper to solve the goals
+relating to well-definedness that are produced by applying induction.
 We declare it to take the tactic that applies the induction theorem
 and not the induction theorem itself because the tactic may, for
 example, supply additional arguments, as does NZinduct_center in
 NZBase.v *)
 
 Ltac induction_maker n t :=
-  try intros until n;
-  pattern n; t; clear n;
-  [solve_predicate_wd | ..].
+  try intros until n; pattern n; t; clear n; [solve_proper | ..].
 
diff --git a/theories/Numbers/Rational/BigQ/BigQ.v b/theories/Numbers/Rational/BigQ/BigQ.v
index 82190f94..a2bc5e26 100644
--- a/theories/Numbers/Rational/BigQ/BigQ.v
+++ b/theories/Numbers/Rational/BigQ/BigQ.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -26,56 +26,31 @@ Module BigN_BigZ <: NType_ZType BigN.BigN BigZ.
  reflexivity.
  Qed.
  Definition Zabs_N := BigZ.to_N.
- Lemma spec_Zabs_N : forall z, BigN.to_Z (Zabs_N z) = Zabs (BigZ.to_Z z).
+ Lemma spec_Zabs_N : forall z, BigN.to_Z (Zabs_N z) = Z.abs (BigZ.to_Z z).
  Proof.
  unfold Zabs_N; intros.
- rewrite BigZ.spec_to_Z, Zmult_comm; apply Zsgn_Zabs.
+ rewrite BigZ.spec_to_Z, Z.mul_comm; apply Z.sgn_abs.
  Qed.
 End BigN_BigZ.
 
 (** This allows to build [BigQ] out of [BigN] and [BigQ] via [QMake] *)
 
-Module BigQ <: QType <: OrderedTypeFull <: TotalOrder :=
- QMake.Make BigN BigZ BigN_BigZ <+ !QProperties <+ HasEqBool2Dec
- <+ !MinMaxLogicalProperties <+ !MinMaxDecProperties.
+Delimit Scope bigQ_scope with bigQ.
 
-(** Notations about [BigQ] *)
+Module BigQ <: QType <: OrderedTypeFull <: TotalOrder.
+ Include QMake.Make BigN BigZ BigN_BigZ [scope abstract_scope to bigQ_scope].
+ Bind Scope bigQ_scope with t t_.
+ Include !QProperties <+ HasEqBool2Dec
+  <+ !MinMaxLogicalProperties <+ !MinMaxDecProperties.
+ Ltac order := Private_Tac.order.
+End BigQ.
 
-Notation bigQ := BigQ.t.
+(** Notations about [BigQ] *)
 
-Delimit Scope bigQ_scope with bigQ.
-Bind Scope bigQ_scope with bigQ.
-Bind Scope bigQ_scope with BigQ.t.
-Bind Scope bigQ_scope with BigQ.t_.
-(* Bind Scope has no retroactive effect, let's declare scopes by hand. *)
-Arguments Scope BigQ.Qz [bigZ_scope].
-Arguments Scope BigQ.Qq [bigZ_scope bigN_scope].
-Arguments Scope BigQ.to_Q [bigQ_scope].
-Arguments Scope BigQ.red [bigQ_scope].
-Arguments Scope BigQ.opp [bigQ_scope].
-Arguments Scope BigQ.inv [bigQ_scope].
-Arguments Scope BigQ.square [bigQ_scope].
-Arguments Scope BigQ.add [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.sub [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.mul [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.div [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.eq [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.lt [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.le [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.eq [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.compare [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.min [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.max [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.eq_bool [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.power_pos [bigQ_scope positive_scope].
-Arguments Scope BigQ.power [bigQ_scope Z_scope].
-Arguments Scope BigQ.inv_norm [bigQ_scope].
-Arguments Scope BigQ.add_norm [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.sub_norm [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.mul_norm [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.div_norm [bigQ_scope bigQ_scope].
-Arguments Scope BigQ.power_norm [bigQ_scope bigQ_scope].
+Local Open Scope bigQ_scope.
 
+Notation bigQ := BigQ.t.
+Bind Scope bigQ_scope with bigQ BigQ.t BigQ.t_.
 (** As in QArith, we use [#] to denote fractions *)
 Notation "p # q" := (BigQ.Qq p q) (at level 55, no associativity) : bigQ_scope.
 Local Notation "0" := BigQ.zero : bigQ_scope.
@@ -88,19 +63,17 @@ Infix "/" := BigQ.div : bigQ_scope.
 Infix "^" := BigQ.power : bigQ_scope.
 Infix "?=" := BigQ.compare : bigQ_scope.
 Infix "==" := BigQ.eq : bigQ_scope.
-Notation "x != y" := (~x==y)%bigQ (at level 70, no associativity) : bigQ_scope.
+Notation "x != y" := (~x==y) (at level 70, no associativity) : bigQ_scope.
 Infix "<" := BigQ.lt : bigQ_scope.
 Infix "<=" := BigQ.le : bigQ_scope.
-Notation "x > y" := (BigQ.lt y x)(only parsing) : bigQ_scope.
-Notation "x >= y" := (BigQ.le y x)(only parsing) : bigQ_scope.
-Notation "x < y < z" := (x<y /\ y<z)%bigQ : bigQ_scope.
-Notation "x < y <= z" := (x<y /\ y<=z)%bigQ : bigQ_scope.
-Notation "x <= y < z" := (x<=y /\ y<z)%bigQ : bigQ_scope.
-Notation "x <= y <= z" := (x<=y /\ y<=z)%bigQ : bigQ_scope.
+Notation "x > y" := (BigQ.lt y x) (only parsing) : bigQ_scope.
+Notation "x >= y" := (BigQ.le y x) (only parsing) : bigQ_scope.
+Notation "x < y < z" := (x<y /\ y<z) : bigQ_scope.
+Notation "x < y <= z" := (x<y /\ y<=z) : bigQ_scope.
+Notation "x <= y < z" := (x<=y /\ y<z) : bigQ_scope.
+Notation "x <= y <= z" := (x<=y /\ y<=z) : bigQ_scope.
 Notation "[ q ]" := (BigQ.to_Q q) : bigQ_scope.
 
-Local Open Scope bigQ_scope.
-
 (** [BigQ] is a field *)
 
 Lemma BigQfieldth :
@@ -117,10 +90,10 @@ exact BigQ.div_mul_inv. exact BigQ.mul_inv_diag_l.
 Qed.
 
 Lemma BigQpowerth :
- power_theory 1 BigQ.mul BigQ.eq Z_of_N BigQ.power.
+ power_theory 1 BigQ.mul BigQ.eq Z.of_N BigQ.power.
 Proof.
 constructor. intros. BigQ.qify.
-replace ([r] ^ Z_of_N n)%Q with (pow_N 1 Qmult [r] n)%Q by (now destruct n).
+replace ([r] ^ Z.of_N n)%Q with (pow_N 1 Qmult [r] n)%Q by (now destruct n).
 destruct n. reflexivity.
 induction p; simpl; auto; rewrite ?BigQ.spec_mul, ?IHp; reflexivity.
 Qed.
@@ -172,8 +145,7 @@ End TestField.
 
 (** [BigQ] can also benefit from an "order" tactic *)
 
-Module BigQ_Order := !OrdersTac.MakeOrderTac BigQ.
-Ltac bigQ_order := BigQ_Order.order.
+Ltac bigQ_order := BigQ.order.
 
 Section TestOrder.
 Let test : forall x y : bigQ, x<=y -> y<=x -> x==y.
diff --git a/theories/Numbers/Rational/BigQ/QMake.v b/theories/Numbers/Rational/BigQ/QMake.v
index 49e9d075..a13bb511 100644
--- a/theories/Numbers/Rational/BigQ/QMake.v
+++ b/theories/Numbers/Rational/BigQ/QMake.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -19,14 +19,14 @@ Require Import NSig ZSig QSig.
     denominators. But first we will need some glue between [NType] and
     [ZType]. *)
 
-Module Type NType_ZType (N:NType)(Z:ZType).
- Parameter Z_of_N : N.t -> Z.t.
- Parameter spec_Z_of_N : forall n, Z.to_Z (Z_of_N n) = N.to_Z n.
- Parameter Zabs_N : Z.t -> N.t.
- Parameter spec_Zabs_N : forall z, N.to_Z (Zabs_N z) = Zabs (Z.to_Z z).
+Module Type NType_ZType (NN:NType)(ZZ:ZType).
+ Parameter Z_of_N : NN.t -> ZZ.t.
+ Parameter spec_Z_of_N : forall n, ZZ.to_Z (Z_of_N n) = NN.to_Z n.
+ Parameter Zabs_N : ZZ.t -> NN.t.
+ Parameter spec_Zabs_N : forall z, NN.to_Z (Zabs_N z) = Z.abs (ZZ.to_Z z).
 End NType_ZType.
 
-Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
+Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
 
  (** The notation of a rational number is either an integer x,
      interpreted as itself or a pair (x,y) of an integer x and a natural
@@ -34,58 +34,52 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
      interpreted as 0. *)
 
  Inductive t_ :=
-  | Qz : Z.t -> t_
-  | Qq : Z.t -> N.t -> t_.
+  | Qz : ZZ.t -> t_
+  | Qq : ZZ.t -> NN.t -> t_.
 
  Definition t := t_.
 
+ Bind Scope abstract_scope with t t_.
+
  (** Specification with respect to [QArith] *)
 
  Local Open Scope Q_scope.
 
- Definition of_Z x: t := Qz (Z.of_Z x).
+ Definition of_Z x: t := Qz (ZZ.of_Z x).
 
  Definition of_Q (q:Q) : t :=
   let (x,y) := q in
   match y with
-    | 1%positive => Qz (Z.of_Z x)
-    | _ => Qq (Z.of_Z x) (N.of_N (Npos y))
+    | 1%positive => Qz (ZZ.of_Z x)
+    | _ => Qq (ZZ.of_Z x) (NN.of_N (Npos y))
   end.
 
  Definition to_Q (q: t) :=
  match q with
-   | Qz x => Z.to_Z x # 1
-   | Qq x y => if N.eq_bool y N.zero then 0
-               else Z.to_Z x # Z2P (N.to_Z y)
+   | Qz x => ZZ.to_Z x # 1
+   | Qq x y => if NN.eqb y NN.zero then 0
+               else ZZ.to_Z x # Z.to_pos (NN.to_Z y)
  end.
 
  Notation "[ x ]" := (to_Q x).
 
  Lemma N_to_Z_pos :
-  forall x, (N.to_Z x <> N.to_Z N.zero)%Z -> (0 < N.to_Z x)%Z.
+  forall x, (NN.to_Z x <> NN.to_Z NN.zero)%Z -> (0 < NN.to_Z x)%Z.
  Proof.
- intros x; rewrite N.spec_0; generalize (N.spec_pos x). romega.
+ intros x; rewrite NN.spec_0; generalize (NN.spec_pos x). romega.
  Qed.
-(*
- Lemma if_fun_commut : forall A B (f:A->B)(b:bool) a a',
- f (if b then a else a') = if b then f a else f a'.
- Proof. now destruct b. Qed.
 
- Lemma if_fun_commut' : forall A B C D (f:A->B)(b:{C}+{D}) a a',
- f (if b then a else a') = if b then f a else f a'.
- Proof. now destruct b. Qed.
-*)
+ Ltac destr_zcompare := case Z.compare_spec; intros ?H.
+
  Ltac destr_eqb :=
   match goal with
-   | |- context [Z.eq_bool ?x ?y] =>
-     rewrite (Z.spec_eq_bool x y);
-     generalize (Zeq_bool_if (Z.to_Z x) (Z.to_Z y));
-     case (Zeq_bool (Z.to_Z x) (Z.to_Z y));
+   | |- context [ZZ.eqb ?x ?y] =>
+     rewrite (ZZ.spec_eqb x y);
+     case (Z.eqb_spec (ZZ.to_Z x) (ZZ.to_Z y));
      destr_eqb
-   | |- context [N.eq_bool ?x ?y] =>
-     rewrite (N.spec_eq_bool x y);
-     generalize (Zeq_bool_if (N.to_Z x) (N.to_Z y));
-     case (Zeq_bool (N.to_Z x) (N.to_Z y));
+   | |- context [NN.eqb ?x ?y] =>
+     rewrite (NN.spec_eqb x y);
+     case (Z.eqb_spec (NN.to_Z x) (NN.to_Z y));
      [ | let H:=fresh "H" in
          try (intro H;generalize (N_to_Z_pos _ H); clear H)];
      destr_eqb
@@ -93,24 +87,25 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
   end.
 
  Hint Rewrite
-  Zplus_0_r Zplus_0_l Zmult_0_r Zmult_0_l Zmult_1_r Zmult_1_l
-  Z.spec_0 N.spec_0 Z.spec_1 N.spec_1 Z.spec_m1 Z.spec_opp
-  Z.spec_compare N.spec_compare
-  Z.spec_add N.spec_add Z.spec_mul N.spec_mul Z.spec_div N.spec_div
-  Z.spec_gcd N.spec_gcd Zgcd_Zabs Zgcd_1
+  Z.add_0_r Z.add_0_l Z.mul_0_r Z.mul_0_l Z.mul_1_r Z.mul_1_l
+  ZZ.spec_0 NN.spec_0 ZZ.spec_1 NN.spec_1 ZZ.spec_m1 ZZ.spec_opp
+  ZZ.spec_compare NN.spec_compare
+  ZZ.spec_add NN.spec_add ZZ.spec_mul NN.spec_mul ZZ.spec_div NN.spec_div
+  ZZ.spec_gcd NN.spec_gcd Z.gcd_abs_l Z.gcd_1_r
   spec_Z_of_N spec_Zabs_N
  : nz.
+
  Ltac nzsimpl := autorewrite with nz in *.
 
  Ltac qsimpl := try red; unfold to_Q; simpl; intros;
   destr_eqb; simpl; nzsimpl; intros;
-  rewrite ?Z2P_correct by auto;
+  rewrite ?Z2Pos.id by auto;
   auto.
 
  Theorem strong_spec_of_Q: forall q: Q, [of_Q q] = q.
  Proof.
- intros(x,y); destruct y; simpl; rewrite ?Z.spec_of_Z; auto;
-  destr_eqb; now rewrite ?N.spec_0, ?N.spec_of_N.
+ intros(x,y); destruct y; simpl; rewrite ?ZZ.spec_of_Z; auto;
+  destr_eqb; now rewrite ?NN.spec_0, ?NN.spec_of_N.
  Qed.
 
  Theorem spec_of_Q: forall q: Q, [of_Q q] == q.
@@ -120,9 +115,9 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
 
  Definition eq x y := [x] == [y].
 
- Definition zero: t := Qz Z.zero.
- Definition one: t := Qz Z.one.
- Definition minus_one: t := Qz Z.minus_one.
+ Definition zero: t := Qz ZZ.zero.
+ Definition one: t := Qz ZZ.one.
+ Definition minus_one: t := Qz ZZ.minus_one.
 
  Lemma spec_0: [zero] == 0.
  Proof.
@@ -141,20 +136,20 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
 
  Definition compare (x y: t) :=
   match x, y with
-  | Qz zx, Qz zy => Z.compare zx zy
+  | Qz zx, Qz zy => ZZ.compare zx zy
   | Qz zx, Qq ny dy =>
-    if N.eq_bool dy N.zero then Z.compare zx Z.zero
-    else Z.compare (Z.mul zx (Z_of_N dy)) ny
+    if NN.eqb dy NN.zero then ZZ.compare zx ZZ.zero
+    else ZZ.compare (ZZ.mul zx (Z_of_N dy)) ny
   | Qq nx dx, Qz zy =>
-    if N.eq_bool dx N.zero then Z.compare Z.zero zy
-    else Z.compare nx (Z.mul zy (Z_of_N dx))
+    if NN.eqb dx NN.zero then ZZ.compare ZZ.zero zy
+    else ZZ.compare nx (ZZ.mul zy (Z_of_N dx))
   | Qq nx dx, Qq ny dy =>
-    match N.eq_bool dx N.zero, N.eq_bool dy N.zero with
+    match NN.eqb dx NN.zero, NN.eqb dy NN.zero with
     | true, true => Eq
-    | true, false => Z.compare Z.zero ny
-    | false, true => Z.compare nx Z.zero
-    | false, false => Z.compare (Z.mul nx (Z_of_N dy))
-                                (Z.mul ny (Z_of_N dx))
+    | true, false => ZZ.compare ZZ.zero ny
+    | false, true => ZZ.compare nx ZZ.zero
+    | false, false => ZZ.compare (ZZ.mul nx (Z_of_N dy))
+                                (ZZ.mul ny (Z_of_N dx))
     end
   end.
 
@@ -193,7 +188,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  (** [check_int] : is a reduced fraction [n/d] in fact a integer ? *)
 
  Definition check_int n d :=
-  match N.compare N.one d with
+  match NN.compare NN.one d with
   | Lt => Qq n d
   | Eq => Qz n
   | Gt => zero  (* n/0 encodes 0 *)
@@ -212,9 +207,9 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  (** Normalisation function *)
 
  Definition norm n d : t :=
-  let gcd := N.gcd (Zabs_N n) d in
-  match N.compare N.one gcd with
-  | Lt => check_int (Z.div n (Z_of_N gcd)) (N.div d gcd)
+  let gcd := NN.gcd (Zabs_N n) d in
+  match NN.compare NN.one gcd with
+  | Lt => check_int (ZZ.div n (Z_of_N gcd)) (NN.div d gcd)
   | Eq => check_int n d
   | Gt => zero (* gcd = 0 => both numbers are 0 *)
   end.
@@ -222,8 +217,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  Theorem spec_norm: forall n q, [norm n q] == [Qq n q].
  Proof.
  intros p q; unfold norm.
- assert (Hp := N.spec_pos (Zabs_N p)).
- assert (Hq := N.spec_pos q).
+ assert (Hp := NN.spec_pos (Zabs_N p)).
+ assert (Hq := NN.spec_pos q).
  nzsimpl.
  destr_zcompare.
  (* Eq *)
@@ -231,15 +226,15 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  (* Lt *)
  rewrite strong_spec_check_int.
  qsimpl.
- generalize (Zgcd_div_pos (Z.to_Z p) (N.to_Z q)). romega.
- replace (N.to_Z q) with 0%Z in * by assumption.
+ generalize (Zgcd_div_pos (ZZ.to_Z p) (NN.to_Z q)). romega.
+ replace (NN.to_Z q) with 0%Z in * by assumption.
  rewrite Zdiv_0_l in *; auto with zarith.
  apply Zgcd_div_swap0; romega.
  (* Gt *)
  qsimpl.
- assert (H' : Zgcd (Z.to_Z p) (N.to_Z q) = 0%Z).
-  generalize (Zgcd_is_pos (Z.to_Z p) (N.to_Z q)); romega.
- symmetry; apply (Zgcd_inv_0_l _ _ H'); auto.
+ assert (H' : Z.gcd (ZZ.to_Z p) (NN.to_Z q) = 0%Z).
+  generalize (Z.gcd_nonneg (ZZ.to_Z p) (NN.to_Z q)); romega.
+ symmetry; apply (Z.gcd_eq_0_l _ _ H'); auto.
  Qed.
 
  Theorem strong_spec_norm : forall p q, [norm p q] = Qred [Qq p q].
@@ -249,8 +244,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
   (apply Qred_complete; apply spec_norm).
  symmetry; apply Qred_identity.
  unfold norm.
- assert (Hp := N.spec_pos (Zabs_N p)).
- assert (Hq := N.spec_pos q).
+ assert (Hp := NN.spec_pos (Zabs_N p)).
+ assert (Hq := NN.spec_pos q).
  nzsimpl.
  destr_zcompare; rewrite ?strong_spec_check_int.
  (* Eq *)
@@ -258,10 +253,10 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  (* Lt *)
  qsimpl.
  rewrite Zgcd_1_rel_prime.
- destruct (Z_lt_le_dec 0 (N.to_Z q)).
+ destruct (Z_lt_le_dec 0 (NN.to_Z q)).
  apply Zis_gcd_rel_prime; auto with zarith.
  apply Zgcd_is_gcd.
- replace (N.to_Z q) with 0%Z in * by romega.
+ replace (NN.to_Z q) with 0%Z in * by romega.
  rewrite Zdiv_0_l in *; romega.
  (* Gt *)
  simpl; auto with zarith.
@@ -297,20 +292,20 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
   match x with
   | Qz zx =>
     match y with
-    | Qz zy => Qz (Z.add zx zy)
+    | Qz zy => Qz (ZZ.add zx zy)
     | Qq ny dy =>
-      if N.eq_bool dy N.zero then x
-      else Qq (Z.add (Z.mul zx (Z_of_N dy)) ny) dy
+      if NN.eqb dy NN.zero then x
+      else Qq (ZZ.add (ZZ.mul zx (Z_of_N dy)) ny) dy
     end
   | Qq nx dx =>
-    if N.eq_bool dx N.zero then y
+    if NN.eqb dx NN.zero then y
     else match y with
-    | Qz zy => Qq (Z.add nx (Z.mul zy (Z_of_N dx))) dx
+    | Qz zy => Qq (ZZ.add nx (ZZ.mul zy (Z_of_N dx))) dx
     | Qq ny dy =>
-      if N.eq_bool dy N.zero then x
+      if NN.eqb dy NN.zero then x
       else
-       let n := Z.add (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) in
-       let d := N.mul dx dy in
+       let n := ZZ.add (ZZ.mul nx (Z_of_N dy)) (ZZ.mul ny (Z_of_N dx)) in
+       let d := NN.mul dx dy in
        Qq n d
     end
   end.
@@ -319,30 +314,30 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  Proof.
  intros [x | nx dx] [y | ny dy]; unfold Qplus; qsimpl;
   auto with zarith.
- rewrite Pmult_1_r, Z2P_correct; auto.
- rewrite Pmult_1_r, Z2P_correct; auto.
- destruct (Zmult_integral (N.to_Z dx) (N.to_Z dy)); intuition.
- rewrite Zpos_mult_morphism, 2 Z2P_correct; auto.
+ rewrite Pos.mul_1_r, Z2Pos.id; auto.
+ rewrite Pos.mul_1_r, Z2Pos.id; auto.
+ rewrite Z.mul_eq_0 in *; intuition.
+ rewrite Pos2Z.inj_mul, 2 Z2Pos.id; auto.
  Qed.
 
  Definition add_norm (x y: t): t :=
   match x with
   | Qz zx =>
     match y with
-    | Qz zy => Qz (Z.add zx zy)
+    | Qz zy => Qz (ZZ.add zx zy)
     | Qq ny dy =>
-      if N.eq_bool dy N.zero then x
-      else norm (Z.add (Z.mul zx (Z_of_N dy)) ny) dy
+      if NN.eqb dy NN.zero then x
+      else norm (ZZ.add (ZZ.mul zx (Z_of_N dy)) ny) dy
     end
   | Qq nx dx =>
-    if N.eq_bool dx N.zero then y
+    if NN.eqb dx NN.zero then y
     else match y with
-    | Qz zy => norm (Z.add nx (Z.mul zy (Z_of_N dx))) dx
+    | Qz zy => norm (ZZ.add nx (ZZ.mul zy (Z_of_N dx))) dx
     | Qq ny dy =>
-      if N.eq_bool dy N.zero then x
+      if NN.eqb dy NN.zero then x
       else
-       let n := Z.add (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) in
-       let d := N.mul dx dy in
+       let n := ZZ.add (ZZ.mul nx (Z_of_N dy)) (ZZ.mul ny (Z_of_N dx)) in
+       let d := NN.mul dx dy in
        norm n d
     end
   end.
@@ -368,18 +363,18 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
 
  Definition opp (x: t): t :=
   match x with
-  | Qz zx => Qz (Z.opp zx)
-  | Qq nx dx => Qq (Z.opp nx) dx
+  | Qz zx => Qz (ZZ.opp zx)
+  | Qq nx dx => Qq (ZZ.opp nx) dx
   end.
 
  Theorem strong_spec_opp: forall q, [opp q] = -[q].
  Proof.
  intros [z | x y]; simpl.
- rewrite Z.spec_opp; auto.
- match goal with  |- context[N.eq_bool ?X ?Y] =>
-  generalize (N.spec_eq_bool X Y); case N.eq_bool
- end; auto; rewrite N.spec_0.
- rewrite Z.spec_opp; auto.
+ rewrite ZZ.spec_opp; auto.
+ match goal with  |- context[NN.eqb ?X ?Y] =>
+  generalize (NN.spec_eqb X Y); case NN.eqb
+ end; auto; rewrite NN.spec_0.
+ rewrite ZZ.spec_opp; auto.
  Qed.
 
  Theorem spec_opp : forall q, [opp q] == -[q].
@@ -421,69 +416,72 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
 
  Definition mul (x y: t): t :=
   match x, y with
-  | Qz zx, Qz zy => Qz (Z.mul zx zy)
-  | Qz zx, Qq ny dy => Qq (Z.mul zx ny) dy
-  | Qq nx dx, Qz zy => Qq (Z.mul nx zy) dx
-  | Qq nx dx, Qq ny dy => Qq (Z.mul nx ny) (N.mul dx dy)
+  | Qz zx, Qz zy => Qz (ZZ.mul zx zy)
+  | Qz zx, Qq ny dy => Qq (ZZ.mul zx ny) dy
+  | Qq nx dx, Qz zy => Qq (ZZ.mul nx zy) dx
+  | Qq nx dx, Qq ny dy => Qq (ZZ.mul nx ny) (NN.mul dx dy)
   end.
 
+ Ltac nsubst :=
+  match goal with E : NN.to_Z _ = _ |- _ => rewrite E in * end.
+
  Theorem spec_mul : forall x y, [mul x y] == [x] * [y].
  Proof.
  intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl; qsimpl.
- rewrite Pmult_1_r, Z2P_correct; auto.
- destruct (Zmult_integral (N.to_Z dx) (N.to_Z dy)); intuition.
- rewrite H0 in H1; auto with zarith.
- rewrite H0 in H1; auto with zarith.
- rewrite H in H1; nzsimpl; auto with zarith.
- rewrite Zpos_mult_morphism, 2 Z2P_correct; auto.
+ rewrite Pos.mul_1_r, Z2Pos.id; auto.
+ rewrite Z.mul_eq_0 in *; intuition.
+ nsubst; auto with zarith.
+ nsubst; auto with zarith.
+ nsubst; nzsimpl; auto with zarith.
+ rewrite Pos2Z.inj_mul, 2 Z2Pos.id; auto.
  Qed.
 
  Definition norm_denum n d :=
-  if N.eq_bool d N.one then Qz n else Qq n d.
+  if NN.eqb d NN.one then Qz n else Qq n d.
 
  Lemma spec_norm_denum : forall n d,
   [norm_denum n d] == [Qq n d].
  Proof.
  unfold norm_denum; intros; simpl; qsimpl.
  congruence.
- rewrite H0 in *; auto with zarith.
+ nsubst; auto with zarith.
  Qed.
 
  Definition irred n d :=
-   let gcd := N.gcd (Zabs_N n) d in
-   match N.compare gcd N.one with
-     | Gt => (Z.div n (Z_of_N gcd), N.div d gcd)
+   let gcd := NN.gcd (Zabs_N n) d in
+   match NN.compare gcd NN.one with
+     | Gt => (ZZ.div n (Z_of_N gcd), NN.div d gcd)
      | _ => (n, d)
    end.
 
  Lemma spec_irred : forall n d, exists g,
   let (n',d') := irred n d in
-  (Z.to_Z n' * g = Z.to_Z n)%Z /\ (N.to_Z d' * g = N.to_Z d)%Z.
+  (ZZ.to_Z n' * g = ZZ.to_Z n)%Z /\ (NN.to_Z d' * g = NN.to_Z d)%Z.
  Proof.
  intros.
  unfold irred; nzsimpl; simpl.
  destr_zcompare.
  exists 1%Z; nzsimpl; auto.
  exists 0%Z; nzsimpl.
- assert (Zgcd (Z.to_Z n) (N.to_Z d) = 0%Z).
-  generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega.
+ assert (Z.gcd (ZZ.to_Z n) (NN.to_Z d) = 0%Z).
+  generalize (Z.gcd_nonneg (ZZ.to_Z n) (NN.to_Z d)); romega.
  clear H.
  split.
- symmetry; apply (Zgcd_inv_0_l _ _ H0).
- symmetry; apply (Zgcd_inv_0_r _ _ H0).
- exists (Zgcd (Z.to_Z n) (N.to_Z d)).
+ symmetry; apply (Z.gcd_eq_0_l _ _ H0).
+ symmetry; apply (Z.gcd_eq_0_r _ _ H0).
+ exists (Z.gcd (ZZ.to_Z n) (NN.to_Z d)).
  simpl.
  split.
  nzsimpl.
- destruct (Zgcd_is_gcd (Z.to_Z n) (N.to_Z d)).
- rewrite Zmult_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith.
+ destruct (Zgcd_is_gcd (ZZ.to_Z n) (NN.to_Z d)).
+ rewrite Z.mul_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith.
  nzsimpl.
- destruct (Zgcd_is_gcd (Z.to_Z n) (N.to_Z d)).
- rewrite Zmult_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith.
+ destruct (Zgcd_is_gcd (ZZ.to_Z n) (NN.to_Z d)).
+ rewrite Z.mul_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith.
  Qed.
 
  Lemma spec_irred_zero : forall n d,
-   (N.to_Z d = 0)%Z <-> (N.to_Z (snd (irred n d)) = 0)%Z.
+   (NN.to_Z d = 0)%Z <-> (NN.to_Z (snd (irred n d)) = 0)%Z.
  Proof.
  intros.
  unfold irred.
@@ -496,8 +494,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  nzsimpl; destr_zcompare; simpl; auto.
  nzsimpl.
  intros.
- generalize (N.spec_pos d); intros.
- destruct (N.to_Z d); auto.
+ generalize (NN.spec_pos d); intros.
+ destruct (NN.to_Z d); auto.
  assert (0 < 0)%Z.
   rewrite <- H0 at 2.
   apply Zgcd_div_pos; auto with zarith.
@@ -507,60 +505,60 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  Qed.
 
  Lemma strong_spec_irred : forall n d,
-  (N.to_Z d <> 0%Z) ->
-  let (n',d') := irred n d in Zgcd (Z.to_Z n') (N.to_Z d') = 1%Z.
+  (NN.to_Z d <> 0%Z) ->
+  let (n',d') := irred n d in Z.gcd (ZZ.to_Z n') (NN.to_Z d') = 1%Z.
  Proof.
  unfold irred; intros.
  nzsimpl.
  destr_zcompare; simpl; auto.
  elim H.
- apply (Zgcd_inv_0_r (Z.to_Z n)).
- generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega.
+ apply (Z.gcd_eq_0_r (ZZ.to_Z n)).
+ generalize (Z.gcd_nonneg (ZZ.to_Z n) (NN.to_Z d)); romega.
 
  nzsimpl.
  rewrite Zgcd_1_rel_prime.
  apply Zis_gcd_rel_prime.
- generalize (N.spec_pos d); romega.
- generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega.
+ generalize (NN.spec_pos d); romega.
+ generalize (Z.gcd_nonneg (ZZ.to_Z n) (NN.to_Z d)); romega.
  apply Zgcd_is_gcd; auto.
  Qed.
 
  Definition mul_norm_Qz_Qq z n d :=
-   if Z.eq_bool z Z.zero then zero
+   if ZZ.eqb z ZZ.zero then zero
    else
-    let gcd := N.gcd (Zabs_N z) d in
-    match N.compare gcd N.one with
+    let gcd := NN.gcd (Zabs_N z) d in
+    match NN.compare gcd NN.one with
       | Gt =>
-        let z := Z.div z (Z_of_N gcd) in
-        let d := N.div d gcd in
-        norm_denum (Z.mul z n) d
-      | _  => Qq (Z.mul z n) d
+        let z := ZZ.div z (Z_of_N gcd) in
+        let d := NN.div d gcd in
+        norm_denum (ZZ.mul z n) d
+      | _  => Qq (ZZ.mul z n) d
     end.
 
  Definition mul_norm (x y: t): t :=
  match x, y with
- | Qz zx, Qz zy => Qz (Z.mul zx zy)
+ | Qz zx, Qz zy => Qz (ZZ.mul zx zy)
  | Qz zx, Qq ny dy => mul_norm_Qz_Qq zx ny dy
  | Qq nx dx, Qz zy => mul_norm_Qz_Qq zy nx dx
  | Qq nx dx, Qq ny dy =>
     let (nx, dy) := irred nx dy in
     let (ny, dx) := irred ny dx in
-    norm_denum (Z.mul ny nx) (N.mul dx dy)
+    norm_denum (ZZ.mul ny nx) (NN.mul dx dy)
  end.
 
  Lemma spec_mul_norm_Qz_Qq : forall z n d,
-   [mul_norm_Qz_Qq z n d] == [Qq (Z.mul z n) d].
+   [mul_norm_Qz_Qq z n d] == [Qq (ZZ.mul z n) d].
  Proof.
  intros z n d; unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt.
  destr_eqb; nzsimpl; intros Hz.
  qsimpl; rewrite Hz; auto.
- destruct Z_le_gt_dec; intros.
+ destruct Z_le_gt_dec as [LE|GT].
  qsimpl.
  rewrite spec_norm_denum.
  qsimpl.
- rewrite Zdiv_gcd_zero in z0; auto with zarith.
- rewrite H in *. rewrite Zdiv_0_l in *; discriminate.
- rewrite <- Zmult_assoc, (Zmult_comm (Z.to_Z n)), Zmult_assoc.
+ rewrite Zdiv_gcd_zero in GT; auto with zarith.
+ nsubst. rewrite Zdiv_0_l in *; discriminate.
+ rewrite <- Z.mul_assoc, (Z.mul_comm (ZZ.to_Z n)), Z.mul_assoc.
  rewrite Zgcd_div_swap0; try romega.
  ring.
  Qed.
@@ -584,34 +582,34 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  destr_eqb; simpl; nzsimpl; auto.
  nzsimpl; rewrite Hd, Zdiv_0_l; auto with zarith.
 
- rewrite Z2P_correct in H; auto.
+ rewrite Z2Pos.id in H; auto.
  unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt.
  destr_eqb; intros Hz; simpl; nzsimpl; simpl; auto.
  destruct Z_le_gt_dec as [H'|H'].
  simpl; nzsimpl.
  destr_eqb; simpl; nzsimpl; auto.
  intros.
- rewrite Z2P_correct; auto.
+ rewrite Z2Pos.id; auto.
  apply Zgcd_mult_rel_prime; auto.
-  generalize (Zgcd_inv_0_l (Z.to_Z z) (N.to_Z d))
-    (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega.
+  generalize (Z.gcd_eq_0_l (ZZ.to_Z z) (NN.to_Z d))
+    (Z.gcd_nonneg (ZZ.to_Z z) (NN.to_Z d)); romega.
  destr_eqb; simpl; nzsimpl; auto.
  unfold norm_denum.
  destr_eqb; nzsimpl; simpl; destr_eqb; simpl; auto.
  intros; nzsimpl.
- rewrite Z2P_correct; auto.
+ rewrite Z2Pos.id; auto.
  apply Zgcd_mult_rel_prime.
  rewrite Zgcd_1_rel_prime.
  apply Zis_gcd_rel_prime.
- generalize (N.spec_pos d); romega.
- generalize (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega.
+ generalize (NN.spec_pos d); romega.
+ generalize (Z.gcd_nonneg (ZZ.to_Z z) (NN.to_Z d)); romega.
  apply Zgcd_is_gcd.
- destruct (Zgcd_is_gcd (Z.to_Z z) (N.to_Z d)) as [ (z0,Hz0) (d0,Hd0) Hzd].
- replace (N.to_Z d / Zgcd (Z.to_Z z) (N.to_Z d))%Z with d0.
+ destruct (Zgcd_is_gcd (ZZ.to_Z z) (NN.to_Z d)) as [ (z0,Hz0) (d0,Hd0) Hzd].
+ replace (NN.to_Z d / Z.gcd (ZZ.to_Z z) (NN.to_Z d))%Z with d0.
  rewrite Zgcd_1_rel_prime in *.
  apply bezout_rel_prime.
  destruct (rel_prime_bezout _ _ H) as [u v Huv].
- apply Bezout_intro with u (v*(Zgcd (Z.to_Z z) (N.to_Z d)))%Z.
+ apply Bezout_intro with u (v*(Z.gcd (ZZ.to_Z z) (NN.to_Z d)))%Z.
  rewrite <- Huv; rewrite Hd0 at 2; ring.
  rewrite Hd0 at 1.
  symmetry; apply Z_div_mult_full; auto with zarith.
@@ -635,13 +633,15 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  rewrite spec_norm_denum.
  qsimpl.
 
- destruct (Zmult_integral _ _ H0) as [Eq|Eq].
+ match goal with E : (_ * _ = 0)%Z |- _ =>
+  rewrite Z.mul_eq_0 in E; destruct E as [Eq|Eq] end.
  rewrite Eq in *; simpl in *.
  rewrite <- Hg2' in *; auto with zarith.
  rewrite Eq in *; simpl in *.
  rewrite <- Hg2 in *; auto with zarith.
 
- destruct (Zmult_integral _ _ H) as [Eq|Eq].
+ match goal with E : (_ * _ = 0)%Z |- _ =>
+  rewrite Z.mul_eq_0 in E; destruct E as [Eq|Eq] end.
  rewrite Hz' in Eq; rewrite Eq in *; auto with zarith.
  rewrite Hz in Eq; rewrite Eq in *; auto with zarith.
 
@@ -671,31 +671,31 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
 
  unfold norm_denum; qsimpl.
 
- assert (NEQ : N.to_Z dy <> 0%Z) by
+ assert (NEQ : NN.to_Z dy <> 0%Z) by
   (rewrite Hz; intros EQ; rewrite EQ in *; romega).
  specialize (Hgc NEQ).
 
- assert (NEQ' : N.to_Z dx <> 0%Z) by
+ assert (NEQ' : NN.to_Z dx <> 0%Z) by
   (rewrite Hz'; intro EQ; rewrite EQ in *; romega).
  specialize (Hgc' NEQ').
 
  revert H H0.
  rewrite 2 strong_spec_red, 2 Qred_iff; simpl.
  destr_eqb; simpl; nzsimpl; try romega; intros.
- rewrite Z2P_correct in *; auto.
+ rewrite Z2Pos.id in *; auto.
 
- apply Zgcd_mult_rel_prime; rewrite Zgcd_comm;
-  apply Zgcd_mult_rel_prime; rewrite Zgcd_comm; auto.
+ apply Zgcd_mult_rel_prime; rewrite Z.gcd_comm;
+  apply Zgcd_mult_rel_prime; rewrite Z.gcd_comm; auto.
 
  rewrite Zgcd_1_rel_prime in *.
  apply bezout_rel_prime.
- destruct (rel_prime_bezout _ _ H4) as [u v Huv].
+ destruct (rel_prime_bezout (ZZ.to_Z ny) (NN.to_Z dy)) as [u v Huv]; trivial.
  apply Bezout_intro with (u*g')%Z (v*g)%Z.
  rewrite <- Huv, <- Hg1', <- Hg2. ring.
 
  rewrite Zgcd_1_rel_prime in *.
  apply bezout_rel_prime.
- destruct (rel_prime_bezout _ _ H3) as [u v Huv].
+ destruct (rel_prime_bezout (ZZ.to_Z nx) (NN.to_Z dx)) as [u v Huv]; trivial.
  apply Bezout_intro with (u*g)%Z (v*g')%Z.
  rewrite <- Huv, <- Hg2', <- Hg1. ring.
  Qed.
@@ -703,16 +703,16 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  Definition inv (x: t): t :=
  match x with
  | Qz z =>
-   match Z.compare Z.zero z with
+   match ZZ.compare ZZ.zero z with
      | Eq => zero
-     | Lt => Qq Z.one (Zabs_N z)
-     | Gt => Qq Z.minus_one (Zabs_N z)
+     | Lt => Qq ZZ.one (Zabs_N z)
+     | Gt => Qq ZZ.minus_one (Zabs_N z)
    end
  | Qq n d =>
-   match Z.compare Z.zero n with
+   match ZZ.compare ZZ.zero n with
      | Eq => zero
      | Lt => Qq (Z_of_N d) (Zabs_N n)
-     | Gt => Qq (Z.opp (Z_of_N d)) (Zabs_N n)
+     | Gt => Qq (ZZ.opp (Z_of_N d)) (Zabs_N n)
    end
  end.
 
@@ -721,29 +721,29 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  destruct x as [ z | n d ].
  (* Qz z *)
  simpl.
- rewrite Z.spec_compare; destr_zcompare.
+ rewrite ZZ.spec_compare; destr_zcompare.
  (* 0 = z *)
  rewrite <- H.
  simpl; nzsimpl; compute; auto.
  (* 0 < z *)
  simpl.
- destr_eqb; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ].
- set (z':=Z.to_Z z) in *; clearbody z'.
+ destr_eqb; nzsimpl; [ intros; rewrite Z.abs_eq in *; romega | intros _ ].
+ set (z':=ZZ.to_Z z) in *; clearbody z'.
  red; simpl.
- rewrite Zabs_eq by romega.
- rewrite Z2P_correct by auto.
+ rewrite Z.abs_eq by romega.
+ rewrite Z2Pos.id by auto.
  unfold Qinv; simpl; destruct z'; simpl; auto; discriminate.
  (* 0 > z *)
  simpl.
- destr_eqb; nzsimpl; [ intros; rewrite Zabs_non_eq in *; romega | intros _ ].
- set (z':=Z.to_Z z) in *; clearbody z'.
+ destr_eqb; nzsimpl; [ intros; rewrite Z.abs_neq in *; romega | intros _ ].
+ set (z':=ZZ.to_Z z) in *; clearbody z'.
  red; simpl.
- rewrite Zabs_non_eq by romega.
- rewrite Z2P_correct by romega.
+ rewrite Z.abs_neq by romega.
+ rewrite Z2Pos.id by romega.
  unfold Qinv; simpl; destruct z'; simpl; auto; discriminate.
  (* Qq n d *)
  simpl.
- rewrite Z.spec_compare; destr_zcompare.
+ rewrite ZZ.spec_compare; destr_zcompare.
  (* 0 = n *)
  rewrite <- H.
  simpl; nzsimpl.
@@ -751,56 +751,51 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  (* 0 < n *)
  simpl.
  destr_eqb; nzsimpl; intros.
- intros; rewrite Zabs_eq in *; romega.
- intros; rewrite Zabs_eq in *; romega.
- clear H1.
- rewrite H0.
- compute; auto.
- clear H1.
- set (n':=Z.to_Z n) in *; clearbody n'.
- rewrite Zabs_eq by romega.
+ intros; rewrite Z.abs_eq in *; romega.
+ intros; rewrite Z.abs_eq in *; romega.
+ nsubst; compute; auto.
+ set (n':=ZZ.to_Z n) in *; clearbody n'.
+ rewrite Z.abs_eq by romega.
  red; simpl.
- rewrite Z2P_correct by auto.
+ rewrite Z2Pos.id by auto.
  unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate.
- rewrite Zpos_mult_morphism, Z2P_correct; auto.
+ rewrite Pos2Z.inj_mul, Z2Pos.id; auto.
  (* 0 > n *)
  simpl.
  destr_eqb; nzsimpl; intros.
- intros; rewrite Zabs_non_eq in *; romega.
- intros; rewrite Zabs_non_eq in *; romega.
- clear H1.
- red; nzsimpl; rewrite H0; compute; auto.
- clear H1.
- set (n':=Z.to_Z n) in *; clearbody n'.
+ intros; rewrite Z.abs_neq in *; romega.
+ intros; rewrite Z.abs_neq in *; romega.
+ nsubst; compute; auto.
+ set (n':=ZZ.to_Z n) in *; clearbody n'.
  red; simpl; nzsimpl.
- rewrite Zabs_non_eq by romega.
- rewrite Z2P_correct by romega.
+ rewrite Z.abs_neq by romega.
+ rewrite Z2Pos.id by romega.
  unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate.
- assert (T : forall x, Zneg x = Zopp (Zpos x)) by auto.
- rewrite T, Zpos_mult_morphism, Z2P_correct; auto; ring.
+ assert (T : forall x, Zneg x = Z.opp (Zpos x)) by auto.
+ rewrite T, Pos2Z.inj_mul, Z2Pos.id; auto; ring.
  Qed.
 
  Definition inv_norm (x: t): t :=
    match x with
      | Qz z =>
-       match Z.compare Z.zero z with
+       match ZZ.compare ZZ.zero z with
          | Eq => zero
-         | Lt => Qq Z.one (Zabs_N z)
-         | Gt => Qq Z.minus_one (Zabs_N z)
+         | Lt => Qq ZZ.one (Zabs_N z)
+         | Gt => Qq ZZ.minus_one (Zabs_N z)
        end
      | Qq n d =>
-       if N.eq_bool d N.zero then zero else
-       match Z.compare Z.zero n with
+       if NN.eqb d NN.zero then zero else
+       match ZZ.compare ZZ.zero n with
          | Eq => zero
          | Lt =>
-           match Z.compare n Z.one with
+           match ZZ.compare n ZZ.one with
              | Gt => Qq (Z_of_N d) (Zabs_N n)
              | _ => Qz (Z_of_N d)
            end
          | Gt =>
-           match Z.compare n Z.minus_one with
-             | Lt => Qq (Z.opp (Z_of_N d)) (Zabs_N n)
-             | _ => Qz (Z.opp (Z_of_N d))
+           match ZZ.compare n ZZ.minus_one with
+             | Lt => Qq (ZZ.opp (Z_of_N d)) (Zabs_N n)
+             | _ => Qz (ZZ.opp (Z_of_N d))
            end
        end
    end.
@@ -812,7 +807,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  destruct x as [ z | n d ].
  (* Qz z *)
  simpl.
- rewrite Z.spec_compare; destr_zcompare; auto with qarith.
+ rewrite ZZ.spec_compare; destr_zcompare; auto with qarith.
  (* Qq n d *)
  simpl; nzsimpl; destr_eqb.
  destr_zcompare; simpl; auto with qarith.
@@ -823,12 +818,12 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  (* 0 < n *)
  destr_zcompare; auto with qarith.
  destr_zcompare; nzsimpl; simpl; auto with qarith; intros.
- destr_eqb; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ].
+ destr_eqb; nzsimpl; [ intros; rewrite Z.abs_eq in *; romega | intros _ ].
  rewrite H0; auto with qarith.
  romega.
  (* 0 > n *)
  destr_zcompare; nzsimpl; simpl; auto with qarith.
- destr_eqb; nzsimpl; [ intros; rewrite Zabs_non_eq in *; romega | intros _ ].
+ destr_eqb; nzsimpl; [ intros; rewrite Z.abs_neq in *; romega | intros _ ].
  rewrite H0; auto with qarith.
  romega.
  Qed.
@@ -852,36 +847,36 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  (* 0 < n *)
  destr_zcompare; simpl; nzsimpl; auto.
  destr_eqb; nzsimpl; simpl; auto.
- rewrite Zabs_eq; romega.
+ rewrite Z.abs_eq; romega.
  intros _.
  rewrite strong_spec_norm; simpl; nzsimpl.
  destr_eqb; nzsimpl.
- rewrite Zabs_eq; romega.
+ rewrite Z.abs_eq; romega.
  intros _.
  rewrite Qred_iff.
  simpl.
- rewrite Zabs_eq; auto with zarith.
- rewrite Z2P_correct in *; auto.
- rewrite Zgcd_comm; auto.
+ rewrite Z.abs_eq; auto with zarith.
+ rewrite Z2Pos.id in *; auto.
+ rewrite Z.gcd_comm; auto.
  (* 0 > n *)
  destr_eqb; nzsimpl; simpl; auto; intros.
  destr_zcompare; simpl; nzsimpl; auto.
  destr_eqb; nzsimpl.
- rewrite Zabs_non_eq; romega.
+ rewrite Z.abs_neq; romega.
  intros _.
  rewrite strong_spec_norm; simpl; nzsimpl.
  destr_eqb; nzsimpl.
- rewrite Zabs_non_eq; romega.
+ rewrite Z.abs_neq; romega.
  intros _.
  rewrite Qred_iff.
  simpl.
- rewrite Z2P_correct in *; auto.
+ rewrite Z2Pos.id in *; auto.
  intros.
- rewrite Zgcd_comm, Zgcd_Zabs, Zgcd_comm.
+ rewrite Z.gcd_comm, Z.gcd_abs_l, Z.gcd_comm.
  apply Zis_gcd_gcd; auto with zarith.
  apply Zis_gcd_minus.
- rewrite Zopp_involutive, <- H1; apply Zgcd_is_gcd.
- rewrite Zabs_non_eq; romega.
+ rewrite Z.opp_involutive, <- H1; apply Zgcd_is_gcd.
+ rewrite Z.abs_neq; romega.
  Qed.
 
  Definition div x y := mul x (inv y).
@@ -914,31 +909,30 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
 
  Definition square (x: t): t :=
   match x with
-  | Qz zx => Qz (Z.square zx)
-  | Qq nx dx => Qq (Z.square nx) (N.square dx)
+  | Qz zx => Qz (ZZ.square zx)
+  | Qq nx dx => Qq (ZZ.square nx) (NN.square dx)
   end.
 
  Theorem spec_square : forall x, [square x] == [x] ^ 2.
  Proof.
  destruct x as [ z | n d ].
- simpl; rewrite Z.spec_square; red; auto.
+ simpl; rewrite ZZ.spec_square; red; auto.
  simpl.
  destr_eqb; nzsimpl; intros.
  apply Qeq_refl.
- rewrite N.spec_square in *; nzsimpl.
- elim (Zmult_integral _ _ H0); romega.
- rewrite N.spec_square in *; nzsimpl.
- rewrite H in H0; romega.
- rewrite Z.spec_square, N.spec_square.
+ rewrite NN.spec_square in *; nzsimpl.
+ rewrite Z.mul_eq_0 in *; romega.
+ rewrite NN.spec_square in *; nzsimpl; nsubst; romega.
+ rewrite ZZ.spec_square, NN.spec_square.
  red; simpl.
- rewrite Zpos_mult_morphism; rewrite !Z2P_correct; auto.
- apply Zmult_lt_0_compat; auto.
+ rewrite Pos2Z.inj_mul; rewrite !Z2Pos.id; auto.
+ apply Z.mul_pos_pos; auto.
  Qed.
 
  Definition power_pos (x : t) p : t :=
   match x with
-  | Qz zx => Qz (Z.power_pos zx p)
-  | Qq nx dx => Qq (Z.power_pos nx p) (N.power_pos dx p)
+  | Qz zx => Qz (ZZ.pow_pos zx p)
+  | Qq nx dx => Qq (ZZ.pow_pos nx p) (NN.pow_pos dx p)
   end.
 
  Theorem spec_power_pos : forall x p, [power_pos x p] == [x] ^ Zpos p.
@@ -946,25 +940,26 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  intros [ z | n d ] p; unfold power_pos.
  (* Qz *)
  simpl.
- rewrite Z.spec_power_pos.
- rewrite Qpower_decomp.
+ rewrite ZZ.spec_pow_pos, Qpower_decomp.
  red; simpl; f_equal.
- rewrite Zpower_pos_1_l; auto.
+ now rewrite Pos2Z.inj_pow, Z.pow_1_l.
  (* Qq *)
  simpl.
- rewrite Z.spec_power_pos.
+ rewrite ZZ.spec_pow_pos.
  destr_eqb; nzsimpl; intros.
- apply Qeq_sym; apply Qpower_positive_0.
- rewrite N.spec_power_pos in *.
- assert (0 < N.to_Z d ^ ' p)%Z by
-  (apply Zpower_gt_0; auto with zarith).
- romega.
- rewrite N.spec_power_pos, H in *.
- rewrite Zpower_0_l in H0; [romega|discriminate].
- rewrite Qpower_decomp.
- red; simpl; do 3 f_equal.
- rewrite Z2P_correct by (generalize (N.spec_pos d); romega).
- rewrite N.spec_power_pos. auto.
+ - apply Qeq_sym; apply Qpower_positive_0.
+ - rewrite NN.spec_pow_pos in *.
+   assert (0 < NN.to_Z d ^ ' p)%Z by
+    (apply Z.pow_pos_nonneg; auto with zarith).
+   romega.
+ - exfalso.
+   rewrite NN.spec_pow_pos in *. nsubst.
+   rewrite Z.pow_0_l' in *; [romega|discriminate].
+ - rewrite Qpower_decomp.
+   red; simpl; do 3 f_equal.
+   apply Pos2Z.inj. rewrite Pos2Z.inj_pow.
+   rewrite 2 Z2Pos.id by (generalize (NN.spec_pos d); romega).
+   now rewrite NN.spec_pow_pos.
  Qed.
 
  Instance strong_spec_power_pos x p `(Reduced x) : Reduced (power_pos x p).
@@ -979,10 +974,11 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  revert H.
  unfold Reduced; rewrite strong_spec_red, Qred_iff; simpl.
  destr_eqb; nzsimpl; simpl; intros.
- rewrite N.spec_power_pos in H0.
- rewrite H, Zpower_0_l in *; [romega|discriminate].
- rewrite Z2P_correct in *; auto.
- rewrite N.spec_power_pos, Z.spec_power_pos; auto.
+ exfalso.
+ rewrite NN.spec_pow_pos in *. nsubst.
+ rewrite Z.pow_0_l' in *; [romega|discriminate].
+ rewrite Z2Pos.id in *; auto.
+ rewrite NN.spec_pow_pos, ZZ.spec_pow_pos; auto.
  rewrite Zgcd_1_rel_prime in *.
  apply rel_prime_Zpower; auto with zarith.
  Qed.
@@ -1089,7 +1085,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
   [[add x y]] = [[x]] + [[y]].
  Proof.
  unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
+ transitivity (!! ([x] + [y])).
  unfold Q2Qc.
  apply Qc_decomp; intros _ _; unfold this.
  apply Qred_complete; apply spec_add; auto.
@@ -1103,7 +1099,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
   [[add_norm x y]] = [[x]] + [[y]].
  Proof.
  unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
+ transitivity (!! ([x] + [y])).
  unfold Q2Qc.
  apply Qc_decomp; intros _ _; unfold this.
  apply Qred_complete; apply spec_add_norm; auto.
@@ -1151,7 +1147,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
   [[mul x y]] = [[x]] * [[y]].
  Proof.
  unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
+ transitivity (!! ([x] * [y])).
  unfold Q2Qc.
  apply Qc_decomp; intros _ _; unfold this.
  apply Qred_complete; apply spec_mul; auto.
@@ -1165,7 +1161,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
    [[mul_norm x y]] = [[x]] * [[y]].
  Proof.
  unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
+ transitivity (!! ([x] * [y])).
  unfold Q2Qc.
  apply Qc_decomp; intros _ _; unfold this.
  apply Qred_complete; apply spec_mul_norm; auto.
@@ -1189,7 +1185,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
    [[inv x]] =  /[[x]].
  Proof.
  unfold to_Qc.
- apply trans_equal with (!! (/[x])).
+ transitivity (!! (/[x])).
  unfold Q2Qc.
  apply Qc_decomp; intros _ _; unfold this.
  apply Qred_complete; apply spec_inv; auto.
@@ -1203,7 +1199,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
    [[inv_norm x]] =  /[[x]].
  Proof.
  unfold to_Qc.
- apply trans_equal with (!! (/[x])).
+ transitivity (!! (/[x])).
  unfold Q2Qc.
  apply Qc_decomp; intros _ _; unfold this.
  apply Qred_complete; apply spec_inv_norm; auto.
@@ -1251,7 +1247,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  Theorem spec_squarec x: [[square x]] = [[x]]^2.
  Proof.
  unfold to_Qc.
- apply trans_equal with (!! ([x]^2)).
+ transitivity (!! ([x]^2)).
  unfold Q2Qc.
  apply Qc_decomp; intros _ _; unfold this.
  apply Qred_complete; apply spec_square; auto.
@@ -1265,24 +1261,24 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
  Qed.
 
  Theorem spec_power_posc x p:
-   [[power_pos x p]] = [[x]] ^ nat_of_P p.
+   [[power_pos x p]] = [[x]] ^ Pos.to_nat p.
  Proof.
  unfold to_Qc.
- apply trans_equal with (!! ([x]^Zpos p)).
+ transitivity (!! ([x]^Zpos p)).
  unfold Q2Qc.
  apply Qc_decomp; intros _ _; unfold this.
  apply Qred_complete; apply spec_power_pos; auto.
- induction p using Pind.
+ induction p using Pos.peano_ind.
  simpl; ring.
- rewrite nat_of_P_succ_morphism; simpl Qcpower.
+ rewrite Pos2Nat.inj_succ; simpl Qcpower.
  rewrite <- IHp; clear IHp.
  unfold Qcmult, Q2Qc.
  apply Qc_decomp; intros _ _; unfold this.
  apply Qred_complete.
- setoid_replace ([x] ^ ' Psucc p)%Q with ([x] * [x] ^ ' p)%Q.
+ setoid_replace ([x] ^ ' Pos.succ p)%Q with ([x] * [x] ^ ' p)%Q.
  apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
  simpl.
- rewrite Pplus_one_succ_l.
+ rewrite <- Pos.add_1_l.
  rewrite Qpower_plus_positive; simpl; apply Qeq_refl.
  Qed.
 
diff --git a/theories/Numbers/Rational/SpecViaQ/QSig.v b/theories/Numbers/Rational/SpecViaQ/QSig.v
index 0fea26df..e199c713 100644
--- a/theories/Numbers/Rational/SpecViaQ/QSig.v
+++ b/theories/Numbers/Rational/SpecViaQ/QSig.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: QSig.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import QArith Qpower Qminmax Orders RelationPairs GenericMinMax.
 
 Open Scope Q_scope.
@@ -117,7 +115,7 @@ Ltac solve_wd2 := intros x x' Hx y y' Hy; qify; now rewrite Hx, Hy.
 Local Obligation Tactic := solve_wd2 || solve_wd1.
 
 Instance : Measure to_Q.
-Instance eq_equiv : Equivalence eq.
+Instance eq_equiv : Equivalence eq := {}.
 
 Program Instance lt_wd : Proper (eq==>eq==>iff) lt.
 Program Instance le_wd : Proper (eq==>eq==>iff) le.
@@ -137,13 +135,13 @@ Program Instance power_wd : Proper (eq==>Logic.eq==>eq) power.
 
 (** Let's implement [HasCompare] *)
 
-Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y).
+Lemma compare_spec : forall x y, CompareSpec (x==y) (x<y) (y<x) (compare x y).
 Proof. intros. qify. destruct (Qcompare_spec [x] [y]); auto. Qed.
 
 (** Let's implement [TotalOrder] *)
 
 Definition lt_compat := lt_wd.
-Instance lt_strorder : StrictOrder lt.
+Instance lt_strorder : StrictOrder lt := {}.
 
 Lemma le_lteq : forall x y, x<=y <-> x<y \/ x==y.
 Proof. intros. qify. apply Qle_lteq. Qed.
@@ -222,4 +220,4 @@ End QProperties.
 
 Module QTypeExt (Q : QType)
  <: QType <: TotalOrder <: HasCompare Q <: HasMinMax Q <: HasEqBool Q
- := Q <+ QProperties.
\ No newline at end of file
+ := Q <+ QProperties.
diff --git a/theories/Numbers/vo.itarget b/theories/Numbers/vo.itarget
index 175a15e9..c69af03f 100644
--- a/theories/Numbers/vo.itarget
+++ b/theories/Numbers/vo.itarget
@@ -1,3 +1,4 @@
+BinNums.vo
 BigNumPrelude.vo
 Cyclic/Abstract/CyclicAxioms.vo
 Cyclic/Abstract/NZCyclic.vo
@@ -23,10 +24,16 @@ Integer/Abstract/ZLt.vo
 Integer/Abstract/ZMulOrder.vo
 Integer/Abstract/ZMul.vo
 Integer/Abstract/ZSgnAbs.vo
-Integer/Abstract/ZProperties.vo
 Integer/Abstract/ZDivFloor.vo
 Integer/Abstract/ZDivTrunc.vo
 Integer/Abstract/ZDivEucl.vo
+Integer/Abstract/ZMaxMin.vo
+Integer/Abstract/ZParity.vo
+Integer/Abstract/ZPow.vo
+Integer/Abstract/ZGcd.vo
+Integer/Abstract/ZLcm.vo
+Integer/Abstract/ZBits.vo
+Integer/Abstract/ZProperties.vo
 Integer/BigZ/BigZ.vo
 Integer/BigZ/ZMake.vo
 Integer/Binary/ZBinary.vo
@@ -43,7 +50,13 @@ NatInt/NZMul.vo
 NatInt/NZOrder.vo
 NatInt/NZProperties.vo
 NatInt/NZDomain.vo
+NatInt/NZParity.vo
 NatInt/NZDiv.vo
+NatInt/NZPow.vo
+NatInt/NZSqrt.vo
+NatInt/NZLog.vo
+NatInt/NZGcd.vo
+NatInt/NZBits.vo
 Natural/Abstract/NAddOrder.vo
 Natural/Abstract/NAdd.vo
 Natural/Abstract/NAxioms.vo
@@ -56,6 +69,14 @@ Natural/Abstract/NStrongRec.vo
 Natural/Abstract/NSub.vo
 Natural/Abstract/NProperties.vo
 Natural/Abstract/NDiv.vo
+Natural/Abstract/NMaxMin.vo
+Natural/Abstract/NParity.vo
+Natural/Abstract/NPow.vo
+Natural/Abstract/NSqrt.vo
+Natural/Abstract/NLog.vo
+Natural/Abstract/NGcd.vo
+Natural/Abstract/NLcm.vo
+Natural/Abstract/NBits.vo
 Natural/BigN/BigN.vo
 Natural/BigN/Nbasic.vo
 Natural/BigN/NMake_gen.vo
diff --git a/theories/PArith/BinPos.v b/theories/PArith/BinPos.v
new file mode 100644
index 00000000..be585871
--- /dev/null
+++ b/theories/PArith/BinPos.v
@@ -0,0 +1,2134 @@
+(* -*- coding: utf-8 -*- *)
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Export BinNums.
+Require Import Eqdep_dec EqdepFacts RelationClasses Morphisms Setoid
+ Equalities Orders OrdersFacts GenericMinMax Le Plus.
+
+Require Export BinPosDef.
+
+(**********************************************************************)
+(** * Binary positive numbers, operations and properties *)
+(**********************************************************************)
+
+(** Initial development by Pierre Crégut, CNET, Lannion, France *)
+
+(** The type [positive] and its constructors [xI] and [xO] and [xH]
+    are now defined in [BinNums.v] *)
+
+Local Open Scope positive_scope.
+Local Unset Boolean Equality Schemes.
+Local Unset Case Analysis Schemes.
+
+(** Every definitions and early properties about positive numbers
+    are placed in a module [Pos] for qualification purpose. *)
+
+Module Pos
+ <: UsualOrderedTypeFull
+ <: UsualDecidableTypeFull
+ <: TotalOrder.
+
+(** * Definitions of operations, now in a separate file *)
+
+Include BinPosDef.Pos.
+
+(** In functor applications that follow, we only inline t and eq *)
+
+Set Inline Level 30.
+
+(** * Logical Predicates *)
+
+Definition eq := @Logic.eq positive.
+Definition eq_equiv := @eq_equivalence positive.
+Include BackportEq.
+
+Definition lt x y := (x ?= y) = Lt.
+Definition gt x y := (x ?= y) = Gt.
+Definition le x y := (x ?= y) <> Gt.
+Definition ge x y := (x ?= y) <> Lt.
+
+Infix "<=" := le : positive_scope.
+Infix "<" := lt : positive_scope.
+Infix ">=" := ge : positive_scope.
+Infix ">" := gt : positive_scope.
+
+Notation "x <= y <= z" := (x <= y /\ y <= z) : positive_scope.
+Notation "x <= y < z" := (x <= y /\ y < z) : positive_scope.
+Notation "x < y < z" := (x < y /\ y < z) : positive_scope.
+Notation "x < y <= z" := (x < y /\ y <= z) : positive_scope.
+
+(**********************************************************************)
+(** * Properties of operations over positive numbers *)
+
+(** ** Decidability of equality on binary positive numbers *)
+
+Lemma eq_dec : forall x y:positive, {x = y} + {x <> y}.
+Proof.
+  decide equality.
+Defined.
+
+(**********************************************************************)
+(** * Properties of successor on binary positive numbers *)
+
+(** ** Specification of [xI] in term of [succ] and [xO] *)
+
+Lemma xI_succ_xO p : p~1 = succ p~0.
+Proof.
+  reflexivity.
+Qed.
+
+Lemma succ_discr p : p <> succ p.
+Proof.
+  now destruct p.
+Qed.
+
+(** ** Successor and double *)
+
+Lemma pred_double_spec p : pred_double p = pred (p~0).
+Proof.
+  reflexivity.
+Qed.
+
+Lemma succ_pred_double p : succ (pred_double p) = p~0.
+Proof.
+  induction p; simpl; now f_equal.
+Qed.
+
+Lemma pred_double_succ p : pred_double (succ p) = p~1.
+Proof.
+  induction p; simpl; now f_equal.
+Qed.
+
+Lemma double_succ p : (succ p)~0 = succ (succ p~0).
+Proof.
+  now destruct p.
+Qed.
+
+Lemma pred_double_xO_discr p : pred_double p <> p~0.
+Proof.
+  now destruct p.
+Qed.
+
+(** ** Successor and predecessor *)
+
+Lemma succ_not_1 p : succ p <> 1.
+Proof.
+  now destruct p.
+Qed.
+
+Lemma pred_succ p : pred (succ p) = p.
+Proof.
+  destruct p; simpl; trivial. apply pred_double_succ.
+Qed.
+
+Lemma succ_pred_or p : p = 1 \/ succ (pred p) = p.
+Proof.
+  destruct p; simpl; auto.
+  right; apply succ_pred_double.
+Qed.
+
+Lemma succ_pred p : p <> 1 -> succ (pred p) = p.
+Proof.
+  destruct p; intros H; simpl; trivial.
+  apply succ_pred_double.
+  now destruct H.
+Qed.
+
+(** ** Injectivity of successor *)
+
+Lemma succ_inj p q : succ p = succ q -> p = q.
+Proof.
+  revert q.
+  induction p; intros [q|q| ] H; simpl in H; destr_eq H; f_equal; auto.
+  elim (succ_not_1 p); auto.
+  elim (succ_not_1 q); auto.
+Qed.
+
+(** ** Predecessor to [N] *)
+
+Lemma pred_N_succ p : pred_N (succ p) = Npos p.
+Proof.
+ destruct p; simpl; trivial. f_equal. apply pred_double_succ.
+Qed.
+
+
+(**********************************************************************)
+(** * Properties of addition on binary positive numbers *)
+
+(** ** Specification of [succ] in term of [add] *)
+
+Lemma add_1_r p : p + 1 = succ p.
+Proof.
+  now destruct p.
+Qed.
+
+Lemma add_1_l p : 1 + p = succ p.
+Proof.
+  now destruct p.
+Qed.
+
+(** ** Specification of [add_carry] *)
+
+Theorem add_carry_spec p q : add_carry p q = succ (p + q).
+Proof.
+  revert q. induction p; destruct q; simpl; now f_equal.
+Qed.
+
+(** ** Commutativity *)
+
+Theorem add_comm p q : p + q = q + p.
+Proof.
+  revert q. induction p; destruct q; simpl; f_equal; trivial.
+  rewrite 2 add_carry_spec; now f_equal.
+Qed.
+
+(** ** Permutation of [add] and [succ] *)
+
+Theorem add_succ_r p q : p + succ q = succ (p + q).
+Proof.
+  revert q.
+  induction p; destruct q; simpl; f_equal;
+   auto using add_1_r; rewrite add_carry_spec; auto.
+Qed.
+
+Theorem add_succ_l p q : succ p + q = succ (p + q).
+Proof.
+  rewrite add_comm, (add_comm p). apply add_succ_r.
+Qed.
+
+(** ** No neutral elements for addition *)
+
+Lemma add_no_neutral p q : q + p <> p.
+Proof.
+  revert q.
+  induction p as [p IHp|p IHp| ]; intros [q|q| ] H;
+   destr_eq H; apply (IHp q H).
+Qed.
+
+(** ** Simplification *)
+
+Lemma add_carry_add p q r s :
+  add_carry p r = add_carry q s -> p + r = q + s.
+Proof.
+  intros H; apply succ_inj; now rewrite <- 2 add_carry_spec.
+Qed.
+
+Lemma add_reg_r p q r : p + r = q + r -> p = q.
+Proof.
+  revert p q. induction r.
+  intros [p|p| ] [q|q| ] H; simpl; destr_eq H; f_equal;
+   auto using add_carry_add; contradict H;
+   rewrite add_carry_spec, <- add_succ_r; auto using add_no_neutral.
+  intros [p|p| ] [q|q| ] H; simpl; destr_eq H; f_equal; auto;
+    contradict H; auto using add_no_neutral.
+  intros p q H. apply succ_inj. now rewrite <- 2 add_1_r.
+Qed.
+
+Lemma add_reg_l p q r : p + q = p + r -> q = r.
+Proof.
+  rewrite 2 (add_comm p). now apply add_reg_r.
+Qed.
+
+Lemma add_cancel_r p q r : p + r = q + r <-> p = q.
+Proof.
+ split. apply add_reg_r. congruence.
+Qed.
+
+Lemma add_cancel_l p q r : r + p = r + q <-> p = q.
+Proof.
+ split. apply add_reg_l. congruence.
+Qed.
+
+Lemma add_carry_reg_r p q r :
+  add_carry p r = add_carry q r -> p = q.
+Proof.
+ intros H. apply add_reg_r with (r:=r); now apply add_carry_add.
+Qed.
+
+Lemma add_carry_reg_l p q r :
+  add_carry p q = add_carry p r -> q = r.
+Proof.
+  intros H; apply add_reg_r with (r:=p);
+  rewrite (add_comm r), (add_comm q); now apply add_carry_add.
+Qed.
+
+(** ** Addition is associative *)
+
+Theorem add_assoc p q r : p + (q + r) = p + q + r.
+Proof.
+  revert q r. induction p.
+  intros [q|q| ] [r|r| ]; simpl; f_equal; trivial;
+    rewrite ?add_carry_spec, ?add_succ_r, ?add_succ_l, ?add_1_r;
+    f_equal; trivial.
+  intros [q|q| ] [r|r| ]; simpl; f_equal; trivial;
+    rewrite ?add_carry_spec, ?add_succ_r, ?add_succ_l, ?add_1_r;
+    f_equal; trivial.
+  intros q r; rewrite 2 add_1_l, add_succ_l; auto.
+Qed.
+
+(** ** Commutation of addition and double *)
+
+Lemma add_xO p q : (p + q)~0 = p~0 + q~0.
+Proof.
+  now destruct p, q.
+Qed.
+
+Lemma add_xI_pred_double p q :
+  (p + q)~0 = p~1 + pred_double q.
+Proof.
+  change (p~1) with (p~0 + 1).
+  now rewrite <- add_assoc, add_1_l, succ_pred_double.
+Qed.
+
+Lemma add_xO_pred_double p q :
+  pred_double (p + q) = p~0 + pred_double q.
+Proof.
+  revert q. induction p as [p IHp| p IHp| ]; destruct q; simpl;
+   rewrite ?add_carry_spec, ?pred_double_succ, ?add_xI_pred_double;
+   try reflexivity.
+  rewrite IHp; auto.
+  rewrite <- succ_pred_double, <- add_1_l. reflexivity.
+Qed.
+
+(** ** Miscellaneous *)
+
+Lemma add_diag p : p + p = p~0.
+Proof.
+  induction p as [p IHp| p IHp| ]; simpl;
+  now rewrite ?add_carry_spec, ?IHp.
+Qed.
+
+(**********************************************************************)
+(** * Peano induction and recursion on binary positive positive numbers *)
+
+(** The Peano-like recursor function for [positive] (due to Daniel Schepler) *)
+
+Fixpoint peano_rect (P:positive->Type) (a:P 1)
+  (f: forall p:positive, P p -> P (succ p)) (p:positive) : P p :=
+let f2 := peano_rect (fun p:positive => P (p~0)) (f _ a)
+  (fun (p:positive) (x:P (p~0)) => f _ (f _ x))
+in
+match p with
+  | q~1 => f _ (f2 q)
+  | q~0 => f2 q
+  | 1 => a
+end.
+
+Theorem peano_rect_succ (P:positive->Type) (a:P 1)
+  (f:forall p, P p -> P (succ p)) (p:positive) :
+  peano_rect P a f (succ p) = f _ (peano_rect P a f p).
+Proof.
+ revert P a f. induction p; trivial.
+ intros. simpl. now rewrite IHp.
+Qed.
+
+Theorem peano_rect_base (P:positive->Type) (a:P 1)
+  (f:forall p, P p -> P (succ p)) :
+  peano_rect P a f 1 = a.
+Proof.
+  trivial.
+Qed.
+
+Definition peano_rec (P:positive->Set) := peano_rect P.
+
+(** Peano induction *)
+
+Definition peano_ind (P:positive->Prop) := peano_rect P.
+
+(** Peano case analysis *)
+
+Theorem peano_case :
+  forall P:positive -> Prop,
+    P 1 -> (forall n:positive, P (succ n)) -> forall p:positive, P p.
+Proof.
+  intros; apply peano_ind; auto.
+Qed.
+
+(** Earlier, the Peano-like recursor was built and proved in a way due to
+    Conor McBride, see "The view from the left" *)
+
+Inductive PeanoView : positive -> Type :=
+| PeanoOne : PeanoView 1
+| PeanoSucc : forall p, PeanoView p -> PeanoView (succ p).
+
+Fixpoint peanoView_xO p (q:PeanoView p) : PeanoView (p~0) :=
+  match q in PeanoView x return PeanoView (x~0) with
+    | PeanoOne => PeanoSucc _ PeanoOne
+    | PeanoSucc _ q => PeanoSucc _ (PeanoSucc _ (peanoView_xO _ q))
+  end.
+
+Fixpoint peanoView_xI p (q:PeanoView p) : PeanoView (p~1) :=
+  match q in PeanoView x return PeanoView (x~1) with
+    | PeanoOne => PeanoSucc _ (PeanoSucc _ PeanoOne)
+    | PeanoSucc _ q => PeanoSucc _ (PeanoSucc _ (peanoView_xI _ q))
+  end.
+
+Fixpoint peanoView p : PeanoView p :=
+  match p return PeanoView p with
+    | 1 => PeanoOne
+    | p~0 => peanoView_xO p (peanoView p)
+    | p~1 => peanoView_xI p (peanoView p)
+  end.
+
+Definition PeanoView_iter (P:positive->Type)
+  (a:P 1) (f:forall p, P p -> P (succ p)) :=
+  (fix iter p (q:PeanoView p) : P p :=
+    match q in PeanoView p return P p with
+      | PeanoOne => a
+      | PeanoSucc _ q => f _ (iter _ q)
+    end).
+
+Theorem eq_dep_eq_positive :
+  forall (P:positive->Type) (p:positive) (x y:P p),
+    eq_dep positive P p x p y -> x = y.
+Proof.
+  apply eq_dep_eq_dec.
+  decide equality.
+Qed.
+
+Theorem PeanoViewUnique : forall p (q q':PeanoView p), q = q'.
+Proof.
+  intros.
+  induction q as [ | p q IHq ].
+  apply eq_dep_eq_positive.
+  cut (1=1). pattern 1 at 1 2 5, q'. destruct q'. trivial.
+  destruct p; intros; discriminate.
+  trivial.
+  apply eq_dep_eq_positive.
+  cut (succ p=succ p). pattern (succ p) at 1 2 5, q'. destruct q'.
+  intro. destruct p; discriminate.
+  intro. apply succ_inj in H.
+  generalize q'. rewrite H. intro.
+  rewrite (IHq q'0).
+  trivial.
+  trivial.
+Qed.
+
+Lemma peano_equiv (P:positive->Type) (a:P 1) (f:forall p, P p -> P (succ p)) p :
+   PeanoView_iter P a f p (peanoView p) = peano_rect P a f p.
+Proof.
+  revert P a f. induction p using peano_rect.
+  trivial.
+  intros; simpl. rewrite peano_rect_succ.
+  rewrite (PeanoViewUnique _ (peanoView (succ p)) (PeanoSucc _ (peanoView p))).
+  simpl; now f_equal.
+Qed.
+
+(**********************************************************************)
+(** * Properties of multiplication on binary positive numbers *)
+
+(** ** One is neutral for multiplication *)
+
+Lemma mul_1_l p : 1 * p = p.
+Proof.
+  reflexivity.
+Qed.
+
+Lemma mul_1_r p : p * 1 = p.
+Proof.
+  induction p; simpl; now f_equal.
+Qed.
+
+(** ** Right reduction properties for multiplication *)
+
+Lemma mul_xO_r p q : p * q~0 = (p * q)~0.
+Proof.
+  induction p; simpl; f_equal; f_equal; trivial.
+Qed.
+
+Lemma mul_xI_r p q : p * q~1 = p + (p * q)~0.
+Proof.
+  induction p as [p IHp|p IHp| ]; simpl; f_equal; trivial.
+  now rewrite IHp, 2 add_assoc, (add_comm p).
+Qed.
+
+(** ** Commutativity of multiplication *)
+
+Theorem mul_comm p q : p * q = q * p.
+Proof.
+  induction q as [q IHq|q IHq| ]; simpl; rewrite <- ? IHq;
+  auto using mul_xI_r, mul_xO_r, mul_1_r.
+Qed.
+
+(** ** Distributivity of multiplication over addition *)
+
+Theorem mul_add_distr_l p q r :
+  p * (q + r) = p * q + p * r.
+Proof.
+  induction p as [p IHp|p IHp| ]; simpl.
+  rewrite IHp. set (m:=(p*q)~0). set (n:=(p*r)~0).
+  change ((p*q+p*r)~0) with (m+n).
+  rewrite 2 add_assoc; f_equal.
+  rewrite <- 2 add_assoc; f_equal.
+  apply add_comm.
+  f_equal; auto.
+  reflexivity.
+Qed.
+
+Theorem mul_add_distr_r p q r :
+  (p + q) * r = p * r + q * r.
+Proof.
+  rewrite 3 (mul_comm _ r); apply mul_add_distr_l.
+Qed.
+
+(** ** Associativity of multiplication *)
+
+Theorem mul_assoc p q r : p * (q * r) = p * q * r.
+Proof.
+  induction p as [p IHp| p IHp | ]; simpl; rewrite ?IHp; trivial.
+  now rewrite mul_add_distr_r.
+Qed.
+
+(** ** Successor and multiplication *)
+
+Lemma mul_succ_l p q : (succ p) * q = q + p * q.
+Proof.
+  induction p as [p IHp | p IHp | ]; simpl; trivial.
+  now rewrite IHp, add_assoc, add_diag, <-add_xO.
+  symmetry; apply add_diag.
+Qed.
+
+Lemma mul_succ_r p q : p * (succ q) = p + p * q.
+Proof.
+  rewrite mul_comm, mul_succ_l. f_equal. apply mul_comm.
+Qed.
+
+(** ** Parity properties of multiplication *)
+
+Lemma mul_xI_mul_xO_discr p q r : p~1 * r <> q~0 * r.
+Proof.
+  induction r; try discriminate.
+  rewrite 2 mul_xO_r; intro H; destr_eq H; auto.
+Qed.
+
+Lemma mul_xO_discr p q : p~0 * q <> q.
+Proof.
+  induction q; try discriminate.
+  rewrite mul_xO_r; injection; assumption.
+Qed.
+
+(** ** Simplification properties of multiplication *)
+
+Theorem mul_reg_r p q r : p * r = q * r -> p = q.
+Proof.
+  revert q r.
+  induction p as [p IHp| p IHp| ]; intros [q|q| ] r H;
+    reflexivity || apply f_equal || exfalso.
+  apply IHp with (r~0). simpl in *.
+    rewrite 2 mul_xO_r. apply add_reg_l with (1:=H).
+  contradict H. apply mul_xI_mul_xO_discr.
+  contradict H. simpl. rewrite add_comm. apply add_no_neutral.
+  symmetry in H. contradict H. apply mul_xI_mul_xO_discr.
+  apply IHp with (r~0). simpl. now rewrite 2 mul_xO_r.
+  contradict H. apply mul_xO_discr.
+  symmetry in H. contradict H. simpl. rewrite add_comm.
+   apply add_no_neutral.
+  symmetry in H. contradict H. apply mul_xO_discr.
+Qed.
+
+Theorem mul_reg_l p q r : r * p = r * q -> p = q.
+Proof.
+  rewrite 2 (mul_comm r). apply mul_reg_r.
+Qed.
+
+Lemma mul_cancel_r p q r : p * r = q * r <-> p = q.
+Proof.
+ split. apply mul_reg_r. congruence.
+Qed.
+
+Lemma mul_cancel_l p q r : r * p = r * q <-> p = q.
+Proof.
+ split. apply mul_reg_l. congruence.
+Qed.
+
+(** ** Inversion of multiplication *)
+
+Lemma mul_eq_1_l p q : p * q = 1 -> p = 1.
+Proof.
+  now destruct p, q.
+Qed.
+
+Lemma mul_eq_1_r p q : p * q = 1 -> q = 1.
+Proof.
+  now destruct p, q.
+Qed.
+
+Notation mul_eq_1 := mul_eq_1_l.
+
+(** ** Square *)
+
+Lemma square_xO p : p~0 * p~0 = (p*p)~0~0.
+Proof.
+ simpl. now rewrite mul_comm.
+Qed.
+
+Lemma square_xI p : p~1 * p~1 = (p*p+p)~0~1.
+Proof.
+ simpl. rewrite mul_comm. simpl. f_equal.
+ rewrite add_assoc, add_diag. simpl. now rewrite add_comm.
+Qed.
+
+(** ** Properties of [iter] *)
+
+Lemma iter_swap_gen : forall A B (f:A->B)(g:A->A)(h:B->B),
+ (forall a, f (g a) = h (f a)) -> forall p a,
+ f (iter p g a) = iter p h (f a).
+Proof.
+ induction p; simpl; intros; now rewrite ?H, ?IHp.
+Qed.
+
+Theorem iter_swap :
+  forall p (A:Type) (f:A -> A) (x:A),
+    iter p f (f x) = f (iter p f x).
+Proof.
+ intros. symmetry. now apply iter_swap_gen.
+Qed.
+
+Theorem iter_succ :
+  forall p (A:Type) (f:A -> A) (x:A),
+    iter (succ p) f x = f (iter p f x).
+Proof.
+ induction p as [p IHp|p IHp|]; intros; simpl; trivial.
+ now rewrite !IHp, iter_swap.
+Qed.
+
+Theorem iter_add :
+  forall p q (A:Type) (f:A -> A) (x:A),
+    iter (p+q) f x = iter p f (iter q f x).
+Proof.
+ induction p using peano_ind; intros.
+ now rewrite add_1_l, iter_succ.
+ now rewrite add_succ_l, !iter_succ, IHp.
+Qed.
+
+Theorem iter_invariant :
+  forall (p:positive) (A:Type) (f:A -> A) (Inv:A -> Prop),
+    (forall x:A, Inv x -> Inv (f x)) ->
+    forall x:A, Inv x -> Inv (iter p f x).
+Proof.
+ induction p as [p IHp|p IHp|]; simpl; trivial.
+ intros A f Inv H x H0. apply H, IHp, IHp; trivial.
+ intros A f Inv H x H0. apply IHp, IHp; trivial.
+Qed.
+
+(** ** Properties of power *)
+
+Lemma pow_1_r p : p^1 = p.
+Proof.
+ unfold pow. simpl. now rewrite mul_comm.
+Qed.
+
+Lemma pow_succ_r p q : p^(succ q) = p * p^q.
+Proof.
+ unfold pow. now rewrite iter_succ.
+Qed.
+
+(** ** Properties of square *)
+
+Lemma square_spec p : square p = p * p.
+Proof.
+ induction p.
+ - rewrite square_xI. simpl. now rewrite IHp.
+ - rewrite square_xO. simpl. now rewrite IHp.
+ - trivial.
+Qed.
+
+(** ** Properties of [sub_mask] *)
+
+Lemma sub_mask_succ_r p q :
+  sub_mask p (succ q) = sub_mask_carry p q.
+Proof.
+ revert q. induction p; destruct q; simpl; f_equal; trivial; now destruct p.
+Qed.
+
+Theorem sub_mask_carry_spec p q :
+  sub_mask_carry p q = pred_mask (sub_mask p q).
+Proof.
+  revert q. induction p as [p IHp|p IHp| ]; destruct q; simpl;
+   try reflexivity; try rewrite IHp;
+   destruct (sub_mask p q) as [|[r|r| ]|] || destruct p; auto.
+Qed.
+
+Inductive SubMaskSpec (p q : positive) : mask -> Prop :=
+ | SubIsNul : p = q -> SubMaskSpec p q IsNul
+ | SubIsPos : forall r, q + r = p -> SubMaskSpec p q (IsPos r)
+ | SubIsNeg : forall r, p + r = q -> SubMaskSpec p q IsNeg.
+
+Theorem sub_mask_spec p q : SubMaskSpec p q (sub_mask p q).
+Proof.
+ revert q. induction p; destruct q; simpl; try constructor; trivial.
+ (* p~1 q~1 *)
+ destruct (IHp q); subst; try now constructor.
+  now apply SubIsNeg with r~0.
+ (* p~1 q~0 *)
+ destruct (IHp q); subst; try now constructor.
+  apply SubIsNeg with (pred_double r). symmetry. apply add_xI_pred_double.
+ (* p~0 q~1 *)
+ rewrite sub_mask_carry_spec.
+ destruct (IHp q); subst; try constructor.
+  now apply SubIsNeg with 1.
+  destruct r; simpl; try constructor; simpl.
+   now rewrite add_carry_spec, <- add_succ_r.
+   now rewrite add_carry_spec, <- add_succ_r, succ_pred_double.
+   now rewrite add_1_r.
+  now apply SubIsNeg with r~1.
+ (* p~0 q~0 *)
+ destruct (IHp q); subst; try now constructor.
+  now apply SubIsNeg with r~0.
+ (* p~0 1 *)
+ now rewrite add_1_l, succ_pred_double.
+ (* 1 q~1 *)
+ now apply SubIsNeg with q~0.
+ (* 1 q~0 *)
+ apply SubIsNeg with (pred_double q). now rewrite add_1_l, succ_pred_double.
+Qed.
+
+Theorem sub_mask_nul_iff p q : sub_mask p q = IsNul <-> p = q.
+Proof.
+ split.
+ now case sub_mask_spec.
+ intros <-. induction p; simpl; now rewrite ?IHp.
+Qed.
+
+Theorem sub_mask_diag p : sub_mask p p = IsNul.
+Proof.
+  now apply sub_mask_nul_iff.
+Qed.
+
+Lemma sub_mask_add p q r : sub_mask p q = IsPos r -> q + r = p.
+Proof.
+ case sub_mask_spec; congruence.
+Qed.
+
+Lemma sub_mask_add_diag_l p q : sub_mask (p+q) p = IsPos q.
+Proof.
+ case sub_mask_spec.
+ intros H. rewrite add_comm in H. elim (add_no_neutral _ _ H).
+ intros r H. apply add_cancel_l in H. now f_equal.
+ intros r H. rewrite <- add_assoc, add_comm in H. elim (add_no_neutral _ _ H).
+Qed.
+
+Lemma sub_mask_pos_iff p q r : sub_mask p q = IsPos r <-> q + r = p.
+Proof.
+ split. apply sub_mask_add. intros <-; apply sub_mask_add_diag_l.
+Qed.
+
+Lemma sub_mask_add_diag_r p q : sub_mask p (p+q) = IsNeg.
+Proof.
+ case sub_mask_spec; trivial.
+ intros H. symmetry in H; rewrite add_comm in H. elim (add_no_neutral _ _ H).
+ intros r H. rewrite <- add_assoc, add_comm in H. elim (add_no_neutral _ _ H).
+Qed.
+
+Lemma sub_mask_neg_iff p q : sub_mask p q = IsNeg <-> exists r, p + r = q.
+Proof.
+ split.
+ case sub_mask_spec; try discriminate. intros r Hr _; now exists r.
+ intros (r,<-). apply sub_mask_add_diag_r.
+Qed.
+
+(*********************************************************************)
+(** * Properties of boolean comparisons *)
+
+Theorem eqb_eq p q : (p =? q) = true <-> p=q.
+Proof.
+ revert q. induction p; destruct q; simpl; rewrite ?IHp; split; congruence.
+Qed.
+
+Theorem ltb_lt p q : (p <? q) = true <-> p < q.
+Proof.
+  unfold ltb, lt. destruct compare; easy'.
+Qed.
+
+Theorem leb_le p q : (p <=? q) = true <-> p <= q.
+Proof.
+  unfold leb, le. destruct compare; easy'.
+Qed.
+
+(** More about [eqb] *)
+
+Include BoolEqualityFacts.
+
+(**********************************************************************)
+(** * Properties of comparison on binary positive numbers *)
+
+(** First, we express [compare_cont] in term of [compare] *)
+
+Definition switch_Eq c c' :=
+ match c' with
+  | Eq => c
+  | Lt => Lt
+  | Gt => Gt
+ end.
+
+Lemma compare_cont_spec p q c :
+  compare_cont p q c = switch_Eq c (p ?= q).
+Proof.
+  unfold compare.
+  revert q c.
+  induction p; destruct q; simpl; trivial.
+  intros c.
+  rewrite 2 IHp. now destruct (compare_cont p q Eq).
+  intros c.
+  rewrite 2 IHp. now destruct (compare_cont p q Eq).
+Qed.
+
+(** From this general result, we now describe particular cases
+    of [compare_cont p q c = c'] :
+    - When [c=Eq], this is directly [compare]
+    - When [c<>Eq], we'll show first that [c'<>Eq]
+    - That leaves only 4 lemmas for [c] and [c'] being [Lt] or [Gt]
+*)
+
+Theorem compare_cont_Eq p q c :
+ compare_cont p q c = Eq -> c = Eq.
+Proof.
+  rewrite compare_cont_spec. now destruct (p ?= q).
+Qed.
+
+Lemma compare_cont_Lt_Gt p q :
+  compare_cont p q Lt = Gt <-> p > q.
+Proof.
+  rewrite compare_cont_spec. unfold gt. destruct (p ?= q); now split.
+Qed.
+
+Lemma compare_cont_Lt_Lt p q :
+  compare_cont p q Lt = Lt <-> p <= q.
+Proof.
+  rewrite compare_cont_spec. unfold le. destruct (p ?= q); easy'.
+Qed.
+
+Lemma compare_cont_Gt_Lt p q :
+  compare_cont p q Gt = Lt <-> p < q.
+Proof.
+  rewrite compare_cont_spec. unfold lt. destruct (p ?= q); now split.
+Qed.
+
+Lemma compare_cont_Gt_Gt p q :
+  compare_cont p q Gt = Gt <-> p >= q.
+Proof.
+  rewrite compare_cont_spec. unfold ge. destruct (p ?= q); easy'.
+Qed.
+
+(** We can express recursive equations for [compare] *)
+
+Lemma compare_xO_xO p q : (p~0 ?= q~0) = (p ?= q).
+Proof. reflexivity. Qed.
+
+Lemma compare_xI_xI p q : (p~1 ?= q~1) = (p ?= q).
+Proof. reflexivity. Qed.
+
+Lemma compare_xI_xO p q :
+ (p~1 ?= q~0) = switch_Eq Gt (p ?= q).
+Proof. exact (compare_cont_spec p q Gt). Qed.
+
+Lemma compare_xO_xI p q :
+ (p~0 ?= q~1) = switch_Eq Lt (p ?= q).
+Proof. exact (compare_cont_spec p q Lt). Qed.
+
+Hint Rewrite compare_xO_xO compare_xI_xI compare_xI_xO compare_xO_xI : compare.
+
+Ltac simpl_compare := autorewrite with compare.
+Ltac simpl_compare_in H := autorewrite with compare in H.
+
+(** Relation between [compare] and [sub_mask] *)
+
+Definition mask2cmp (p:mask) : comparison :=
+ match p with
+  | IsNul => Eq
+  | IsPos _ => Gt
+  | IsNeg => Lt
+ end.
+
+Lemma compare_sub_mask p q : (p ?= q) = mask2cmp (sub_mask p q).
+Proof.
+  revert q.
+  induction p as [p IHp| p IHp| ]; intros [q|q| ]; simpl; trivial;
+  specialize (IHp q); rewrite ?sub_mask_carry_spec;
+  destruct (sub_mask p q) as [|r|]; simpl in *;
+  try clear r; try destruct r; simpl; trivial;
+  simpl_compare; now rewrite IHp.
+Qed.
+
+(** Alternative characterisation of strict order in term of addition *)
+
+Lemma lt_iff_add p q : p < q <-> exists r, p + r = q.
+Proof.
+ unfold "<". rewrite <- sub_mask_neg_iff, compare_sub_mask.
+ destruct sub_mask; now split.
+Qed.
+
+Lemma gt_iff_add p q : p > q <-> exists r, q + r = p.
+Proof.
+ unfold ">". rewrite compare_sub_mask.
+ split.
+ case_eq (sub_mask p q); try discriminate; intros r Hr _.
+  exists r. now apply sub_mask_pos_iff.
+ intros (r,Hr). apply sub_mask_pos_iff in Hr. now rewrite Hr.
+Qed.
+
+(** Basic facts about [compare_cont] *)
+
+Theorem compare_cont_refl p c :
+  compare_cont p p c = c.
+Proof.
+  now induction p.
+Qed.
+
+Lemma compare_cont_antisym p q c :
+  CompOpp (compare_cont p q c) = compare_cont q p (CompOpp c).
+Proof.
+  revert q c.
+  induction p as [p IHp|p IHp| ]; intros [q|q| ] c; simpl;
+   trivial; apply IHp.
+Qed.
+
+(** Basic facts about [compare] *)
+
+Lemma compare_eq_iff p q : (p ?= q) = Eq <-> p = q.
+Proof.
+ rewrite compare_sub_mask, <- sub_mask_nul_iff.
+ destruct sub_mask; now split.
+Qed.
+
+Lemma compare_antisym p q : (q ?= p) = CompOpp (p ?= q).
+Proof.
+  unfold compare. now rewrite compare_cont_antisym.
+Qed.
+
+Lemma compare_lt_iff p q : (p ?= q) = Lt <-> p < q.
+Proof. reflexivity. Qed.
+
+Lemma compare_le_iff p q : (p ?= q) <> Gt <-> p <= q.
+Proof. reflexivity. Qed.
+
+(** More properties about [compare] and boolean comparisons,
+  including [compare_spec] and [lt_irrefl] and [lt_eq_cases]. *)
+
+Include BoolOrderFacts.
+
+Definition le_lteq := lt_eq_cases.
+
+(** ** Facts about [gt] and [ge] *)
+
+(** The predicates [lt] and [le] are now favored in the statements
+  of theorems, the use of [gt] and [ge] is hence not recommended.
+  We provide here the bare minimal results to related them with
+  [lt] and [le]. *)
+
+Lemma gt_lt_iff p q : p > q <-> q < p.
+Proof.
+ unfold lt, gt. now rewrite compare_antisym, CompOpp_iff.
+Qed.
+
+Lemma gt_lt p q : p > q -> q < p.
+Proof.
+ apply gt_lt_iff.
+Qed.
+
+Lemma lt_gt p q : p < q -> q > p.
+Proof.
+ apply gt_lt_iff.
+Qed.
+
+Lemma ge_le_iff p q : p >= q <-> q <= p.
+Proof.
+ unfold le, ge. now rewrite compare_antisym, CompOpp_iff.
+Qed.
+
+Lemma ge_le p q : p >= q -> q <= p.
+Proof.
+ apply ge_le_iff.
+Qed.
+
+Lemma le_ge p q : p <= q -> q >= p.
+Proof.
+ apply ge_le_iff.
+Qed.
+
+(** ** Comparison and the successor *)
+
+Lemma compare_succ_r p q :
+  switch_Eq Gt (p ?= succ q) = switch_Eq Lt (p ?= q).
+Proof.
+  revert q.
+  induction p as [p IH|p IH| ]; intros [q|q| ]; simpl;
+   simpl_compare; rewrite ?IH; trivial;
+   (now destruct compare) || (now destruct p).
+Qed.
+
+Lemma compare_succ_l p q :
+  switch_Eq Lt (succ p ?= q) = switch_Eq Gt (p ?= q).
+Proof.
+  rewrite 2 (compare_antisym q). generalize (compare_succ_r q p).
+  now do 2 destruct compare.
+Qed.
+
+Theorem lt_succ_r p q : p < succ q <-> p <= q.
+Proof.
+  unfold lt, le. generalize (compare_succ_r p q).
+  do 2 destruct compare; try discriminate; now split.
+Qed.
+
+Lemma lt_succ_diag_r p : p < succ p.
+Proof.
+ rewrite lt_iff_add. exists 1. apply add_1_r.
+Qed.
+
+Lemma compare_succ_succ p q : (succ p ?= succ q) = (p ?= q).
+Proof.
+ revert q.
+ induction p; destruct q; simpl; simpl_compare; trivial;
+  apply compare_succ_l || apply compare_succ_r ||
+  (now destruct p) || (now destruct q).
+Qed.
+
+(** ** 1 is the least positive number *)
+
+Lemma le_1_l p : 1 <= p.
+Proof.
+  now destruct p.
+Qed.
+
+Lemma nlt_1_r p : ~ p < 1.
+Proof.
+  now destruct p.
+Qed.
+
+Lemma lt_1_succ p : 1 < succ p.
+Proof.
+  apply lt_succ_r, le_1_l.
+Qed.
+
+(** ** Properties of the order *)
+
+Lemma le_nlt p q : p <= q <-> ~ q < p.
+Proof.
+  now rewrite <- ge_le_iff.
+Qed.
+
+Lemma lt_nle p q : p < q <-> ~ q <= p.
+Proof.
+ intros. unfold lt, le. rewrite compare_antisym.
+ destruct compare; split; auto; easy'.
+Qed.
+
+Lemma lt_le_incl p q : p<q -> p<=q.
+Proof.
+  intros. apply le_lteq. now left.
+Qed.
+
+Lemma lt_lt_succ n m : n < m -> n < succ m.
+Proof.
+  intros. now apply lt_succ_r, lt_le_incl.
+Qed.
+
+Lemma succ_lt_mono n m : n < m <-> succ n < succ m.
+Proof.
+  unfold lt. now rewrite compare_succ_succ.
+Qed.
+
+Lemma succ_le_mono n m : n <= m <-> succ n <= succ m.
+Proof.
+  unfold le. now rewrite compare_succ_succ.
+Qed.
+
+Lemma lt_trans n m p : n < m -> m < p -> n < p.
+Proof.
+ rewrite 3 lt_iff_add. intros (r,Hr) (s,Hs).
+ exists (r+s). now rewrite add_assoc, Hr, Hs.
+Qed.
+
+Theorem lt_ind : forall (A : positive -> Prop) (n : positive),
+  A (succ n) ->
+    (forall m : positive, n < m -> A m -> A (succ m)) ->
+      forall m : positive, n < m -> A m.
+Proof.
+  intros A n AB AS m. induction m using peano_ind; intros H.
+  elim (nlt_1_r _ H).
+  apply lt_succ_r, le_lteq in H. destruct H as [H|H]; subst; auto.
+Qed.
+
+Instance lt_strorder : StrictOrder lt.
+Proof. split. exact lt_irrefl. exact lt_trans. Qed.
+
+Instance lt_compat : Proper (Logic.eq==>Logic.eq==>iff) lt.
+Proof. repeat red. intros. subst; auto. Qed.
+
+Lemma lt_total p q : p < q \/ p = q \/ q < p.
+Proof.
+ case (compare_spec p q); intuition.
+Qed.
+
+Lemma le_refl p : p <= p.
+Proof.
+ intros. unfold le. now rewrite compare_refl.
+Qed.
+
+Lemma le_lt_trans n m p : n <= m -> m < p -> n < p.
+Proof.
+ intros H H'. apply le_lteq in H. destruct H.
+ now apply lt_trans with m. now subst.
+Qed.
+
+Lemma lt_le_trans n m p : n < m -> m <= p -> n < p.
+Proof.
+ intros H H'. apply le_lteq in H'. destruct H'.
+ now apply lt_trans with m. now subst.
+Qed.
+
+Lemma le_trans n m p : n <= m -> m <= p -> n <= p.
+Proof.
+ intros H H'.
+ apply le_lteq in H. destruct H.
+ apply le_lteq; left. now apply lt_le_trans with m.
+ now subst.
+Qed.
+
+Lemma le_succ_l n m : succ n <= m <-> n < m.
+Proof.
+ rewrite <- lt_succ_r. symmetry. apply succ_lt_mono.
+Qed.
+
+Lemma le_antisym p q : p <= q -> q <= p -> p = q.
+Proof.
+ rewrite le_lteq; destruct 1; auto.
+ rewrite le_lteq; destruct 1; auto.
+ elim (lt_irrefl p). now transitivity q.
+Qed.
+
+Instance le_preorder : PreOrder le.
+Proof. split. exact le_refl. exact le_trans. Qed.
+
+Instance le_partorder : PartialOrder Logic.eq le.
+Proof.
+ intros x y. change (x=y <-> x <= y <= x).
+ split. intros; now subst.
+ destruct 1; now apply le_antisym.
+Qed.
+
+(** ** Comparison and addition *)
+
+Lemma add_compare_mono_l p q r : (p+q ?= p+r) = (q ?= r).
+Proof.
+ revert p q r. induction p using peano_ind; intros q r.
+ rewrite 2 add_1_l. apply compare_succ_succ.
+ now rewrite 2 add_succ_l, compare_succ_succ.
+Qed.
+
+Lemma add_compare_mono_r p q r : (q+p ?= r+p) = (q ?= r).
+Proof.
+ rewrite 2 (add_comm _ p). apply add_compare_mono_l.
+Qed.
+
+(** ** Order and addition *)
+
+Lemma lt_add_diag_r p q : p < p + q.
+Proof.
+ rewrite lt_iff_add. now exists q.
+Qed.
+
+Lemma add_lt_mono_l p q r : q<r <-> p+q < p+r.
+Proof.
+ unfold lt. rewrite add_compare_mono_l. apply iff_refl.
+Qed.
+
+Lemma add_lt_mono_r p q r : q<r <-> q+p < r+p.
+Proof.
+ unfold lt. rewrite add_compare_mono_r. apply iff_refl.
+Qed.
+
+Lemma add_lt_mono p q r s : p<q -> r<s -> p+r<q+s.
+Proof.
+ intros. apply lt_trans with (p+s).
+ now apply add_lt_mono_l.
+ now apply add_lt_mono_r.
+Qed.
+
+Lemma add_le_mono_l p q r : q<=r <-> p+q<=p+r.
+Proof.
+ unfold le. rewrite add_compare_mono_l. apply iff_refl.
+Qed.
+
+Lemma add_le_mono_r p q r : q<=r <-> q+p<=r+p.
+Proof.
+ unfold le. rewrite add_compare_mono_r. apply iff_refl.
+Qed.
+
+Lemma add_le_mono p q r s : p<=q -> r<=s -> p+r <= q+s.
+Proof.
+ intros. apply le_trans with (p+s).
+ now apply add_le_mono_l.
+ now apply add_le_mono_r.
+Qed.
+
+(** ** Comparison and multiplication *)
+
+Lemma mul_compare_mono_l p q r : (p*q ?= p*r) = (q ?= r).
+Proof.
+ revert q r. induction p; simpl; trivial.
+ intros q r. specialize (IHp q r).
+ destruct (compare_spec q r).
+ subst. apply compare_refl.
+ now apply add_lt_mono.
+ now apply lt_gt, add_lt_mono, gt_lt.
+Qed.
+
+Lemma mul_compare_mono_r p q r : (q*p ?= r*p) = (q ?= r).
+Proof.
+ rewrite 2 (mul_comm _ p). apply mul_compare_mono_l.
+Qed.
+
+(** ** Order and multiplication *)
+
+Lemma mul_lt_mono_l p q r : q<r <-> p*q < p*r.
+Proof.
+ unfold lt. rewrite mul_compare_mono_l. apply iff_refl.
+Qed.
+
+Lemma mul_lt_mono_r p q r : q<r <-> q*p < r*p.
+Proof.
+ unfold lt. rewrite mul_compare_mono_r. apply iff_refl.
+Qed.
+
+Lemma mul_lt_mono p q r s : p<q -> r<s -> p*r < q*s.
+Proof.
+ intros. apply lt_trans with (p*s).
+ now apply mul_lt_mono_l.
+ now apply mul_lt_mono_r.
+Qed.
+
+Lemma mul_le_mono_l p q r : q<=r <-> p*q<=p*r.
+Proof.
+ unfold le. rewrite mul_compare_mono_l. apply iff_refl.
+Qed.
+
+Lemma mul_le_mono_r p q r : q<=r <-> q*p<=r*p.
+Proof.
+ unfold le. rewrite mul_compare_mono_r. apply iff_refl.
+Qed.
+
+Lemma mul_le_mono p q r s : p<=q -> r<=s -> p*r <= q*s.
+Proof.
+ intros. apply le_trans with (p*s).
+ now apply mul_le_mono_l.
+ now apply mul_le_mono_r.
+Qed.
+
+Lemma lt_add_r p q : p < p+q.
+Proof.
+ induction q using peano_ind.
+ rewrite add_1_r. apply lt_succ_diag_r.
+ apply lt_trans with (p+q); auto.
+ apply add_lt_mono_l, lt_succ_diag_r.
+Qed.
+
+Lemma lt_not_add_l p q : ~ p+q < p.
+Proof.
+ intro H. elim (lt_irrefl p).
+ apply lt_trans with (p+q); auto using lt_add_r.
+Qed.
+
+Lemma pow_gt_1 n p : 1<n -> 1<n^p.
+Proof.
+ intros H. induction p using peano_ind.
+ now rewrite pow_1_r.
+ rewrite pow_succ_r.
+ apply lt_trans with (n*1).
+ now rewrite mul_1_r.
+ now apply mul_lt_mono_l.
+Qed.
+
+(**********************************************************************)
+(** * Properties of subtraction on binary positive numbers *)
+
+Lemma sub_1_r p : sub p 1 = pred p.
+Proof.
+  now destruct p.
+Qed.
+
+Lemma pred_sub p : pred p = sub p 1.
+Proof.
+  symmetry. apply sub_1_r.
+Qed.
+
+Theorem sub_succ_r p q : p - (succ q) = pred (p - q).
+Proof.
+  unfold sub; rewrite sub_mask_succ_r, sub_mask_carry_spec.
+  destruct (sub_mask p q) as [|[r|r| ]|]; auto.
+Qed.
+
+(** ** Properties of subtraction without underflow *)
+
+Lemma sub_mask_pos' p q :
+  q < p -> exists r, sub_mask p q = IsPos r /\ q + r = p.
+Proof.
+ rewrite lt_iff_add. intros (r,Hr). exists r. split; trivial.
+ now apply sub_mask_pos_iff.
+Qed.
+
+Lemma sub_mask_pos p q :
+  q < p -> exists r, sub_mask p q = IsPos r.
+Proof.
+ intros H. destruct (sub_mask_pos' p q H) as (r & Hr & _). now exists r.
+Qed.
+
+Theorem sub_add p q : q < p -> (p-q)+q = p.
+Proof.
+  intros H. destruct (sub_mask_pos p q H) as (r,U).
+  unfold sub. rewrite U. rewrite add_comm. now apply sub_mask_add.
+Qed.
+
+Lemma add_sub p q : (p+q)-q = p.
+Proof.
+ intros. apply add_reg_r with q.
+ rewrite sub_add; trivial.
+ rewrite add_comm. apply lt_add_r.
+Qed.
+
+Lemma mul_sub_distr_l p q r : r<q -> p*(q-r) = p*q-p*r.
+Proof.
+ intros H.
+ apply add_reg_r with (p*r).
+ rewrite <- mul_add_distr_l.
+ rewrite sub_add; trivial.
+ symmetry. apply sub_add; trivial.
+ now apply mul_lt_mono_l.
+Qed.
+
+Lemma mul_sub_distr_r p q r : q<p -> (p-q)*r = p*r-q*r.
+Proof.
+ intros H. rewrite 3 (mul_comm _ r). now apply mul_sub_distr_l.
+Qed.
+
+Lemma sub_lt_mono_l p q r: q<p -> p<r -> r-p < r-q.
+Proof.
+ intros Hqp Hpr.
+ apply (add_lt_mono_r p).
+ rewrite sub_add by trivial.
+ apply le_lt_trans with ((r-q)+q).
+ rewrite sub_add by (now apply lt_trans with p).
+ apply le_refl.
+ now apply add_lt_mono_l.
+Qed.
+
+Lemma sub_compare_mono_l p q r :
+ q<p -> r<p -> (p-q ?= p-r) = (r ?= q).
+Proof.
+ intros Hqp Hrp.
+ case (compare_spec r q); intros H. subst. apply compare_refl.
+ apply sub_lt_mono_l; trivial.
+ apply lt_gt, sub_lt_mono_l; trivial.
+Qed.
+
+Lemma sub_compare_mono_r p q r :
+ p<q -> p<r -> (q-p ?= r-p) = (q ?= r).
+Proof.
+ intros. rewrite <- (add_compare_mono_r p), 2 sub_add; trivial.
+Qed.
+
+Lemma sub_lt_mono_r p q r : q<p -> r<q -> q-r < p-r.
+Proof.
+ intros. unfold lt. rewrite sub_compare_mono_r; trivial.
+ now apply lt_trans with q.
+Qed.
+
+Lemma sub_decr n m : m<n -> n-m < n.
+Proof.
+ intros.
+ apply add_lt_mono_r with m.
+ rewrite sub_add; trivial.
+ apply lt_add_r.
+Qed.
+
+Lemma add_sub_assoc p q r : r<q -> p+(q-r) = p+q-r.
+Proof.
+ intros.
+ apply add_reg_r with r.
+ rewrite <- add_assoc, !sub_add; trivial.
+ rewrite add_comm. apply lt_trans with q; trivial using lt_add_r.
+Qed.
+
+Lemma sub_add_distr p q r : q+r < p -> p-(q+r) = p-q-r.
+Proof.
+ intros.
+ assert (q < p)
+  by (apply lt_trans with (q+r); trivial using lt_add_r).
+ rewrite (add_comm q r) in *.
+ apply add_reg_r with (r+q).
+ rewrite sub_add by trivial.
+ rewrite add_assoc, !sub_add; trivial.
+ apply (add_lt_mono_r q). rewrite sub_add; trivial.
+Qed.
+
+Lemma sub_sub_distr p q r : r<q -> q-r < p -> p-(q-r) = p+r-q.
+Proof.
+ intros.
+ apply add_reg_r with ((q-r)+r).
+ rewrite add_assoc, !sub_add; trivial.
+ rewrite <- (sub_add q r); trivial.
+ now apply add_lt_mono_r.
+Qed.
+
+(** Recursive equations for [sub] *)
+
+Lemma sub_xO_xO n m : m<n -> n~0 - m~0 = (n-m)~0.
+Proof.
+ intros H. unfold sub. simpl.
+ now destruct (sub_mask_pos n m H) as (p, ->).
+Qed.
+
+Lemma sub_xI_xI n m : m<n -> n~1 - m~1 = (n-m)~0.
+Proof.
+ intros H. unfold sub. simpl.
+ now destruct (sub_mask_pos n m H) as (p, ->).
+Qed.
+
+Lemma sub_xI_xO n m : m<n -> n~1 - m~0 = (n-m)~1.
+Proof.
+ intros H. unfold sub. simpl.
+ now destruct (sub_mask_pos n m) as (p, ->).
+Qed.
+
+Lemma sub_xO_xI n m : n~0 - m~1 = pred_double (n-m).
+Proof.
+ unfold sub. simpl. rewrite sub_mask_carry_spec.
+ now destruct (sub_mask n m) as [|[r|r|]|].
+Qed.
+
+(** Properties of subtraction with underflow *)
+
+Lemma sub_mask_neg_iff' p q : sub_mask p q = IsNeg <-> p < q.
+Proof.
+  rewrite lt_iff_add. apply sub_mask_neg_iff.
+Qed.
+
+Lemma sub_mask_neg p q : p<q -> sub_mask p q = IsNeg.
+Proof.
+  apply sub_mask_neg_iff'.
+Qed.
+
+Lemma sub_le p q : p<=q -> p-q = 1.
+Proof.
+  unfold le, sub. rewrite compare_sub_mask.
+  destruct sub_mask; easy'.
+Qed.
+
+Lemma sub_lt p q : p<q -> p-q = 1.
+Proof.
+  intros. now apply sub_le, lt_le_incl.
+Qed.
+
+Lemma sub_diag p : p-p = 1.
+Proof.
+  unfold sub. now rewrite sub_mask_diag.
+Qed.
+
+(** ** Results concerning [size] and [size_nat] *)
+
+Lemma size_nat_monotone p q : p<q -> (size_nat p <= size_nat q)%nat.
+Proof.
+  assert (le0 : forall n, (0<=n)%nat) by (induction n; auto).
+  assert (leS : forall n m, (n<=m -> S n <= S m)%nat) by (induction 1; auto).
+  revert q.
+  induction p; destruct q; simpl; intros; auto; easy || apply leS;
+   red in H; simpl_compare_in H.
+  apply IHp. red. now destruct (p?=q).
+  destruct (compare_spec p q); subst; now auto.
+Qed.
+
+Lemma size_gt p : p < 2^(size p).
+Proof.
+ induction p; simpl; try rewrite pow_succ_r; try easy.
+ apply le_succ_l in IHp. now apply le_succ_l.
+Qed.
+
+Lemma size_le p : 2^(size p) <= p~0.
+Proof.
+ induction p; simpl; try rewrite pow_succ_r; try easy.
+ apply mul_le_mono_l.
+ apply le_lteq; left. rewrite xI_succ_xO. apply lt_succ_r, IHp.
+Qed.
+
+(** ** Properties of [min] and [max] *)
+
+(** First, the specification *)
+
+Lemma max_l : forall x y, y<=x -> max x y = x.
+Proof.
+ intros x y H. unfold max. case compare_spec; auto.
+ intros H'. apply le_nlt in H. now elim H.
+Qed.
+
+Lemma max_r : forall x y, x<=y -> max x y = y.
+Proof.
+ unfold le, max. intros x y. destruct compare; easy'.
+Qed.
+
+Lemma min_l : forall x y, x<=y -> min x y = x.
+Proof.
+ unfold le, min. intros x y. destruct compare; easy'.
+Qed.
+
+Lemma min_r : forall x y, y<=x -> min x y = y.
+Proof.
+ intros x y H. unfold min. case compare_spec; auto.
+ intros H'. apply le_nlt in H. now elim H'.
+Qed.
+
+(** We hence obtain all the generic properties of [min] and [max]. *)
+
+Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
+
+Ltac order := Private_Tac.order.
+
+(** Minimum, maximum and constant one *)
+
+Lemma max_1_l n : max 1 n = n.
+Proof.
+ unfold max. case compare_spec; auto.
+ intros H. apply lt_nle in H. elim H. apply le_1_l.
+Qed.
+
+Lemma max_1_r n : max n 1 = n.
+Proof. rewrite max_comm. apply max_1_l. Qed.
+
+Lemma min_1_l n : min 1 n = 1.
+Proof.
+ unfold min. case compare_spec; auto.
+ intros H. apply lt_nle in H. elim H. apply le_1_l.
+Qed.
+
+Lemma min_1_r n : min n 1 = 1.
+Proof. rewrite min_comm. apply min_1_l. Qed.
+
+(** Minimum, maximum and operations (consequences of monotonicity) *)
+
+Lemma succ_max_distr n m : succ (max n m) = max (succ n) (succ m).
+Proof.
+ symmetry. apply max_monotone.
+ intros x x'. apply succ_le_mono.
+Qed.
+
+Lemma succ_min_distr n m : succ (min n m) = min (succ n) (succ m).
+Proof.
+ symmetry. apply min_monotone.
+ intros x x'. apply succ_le_mono.
+Qed.
+
+Lemma add_max_distr_l n m p : max (p + n) (p + m) = p + max n m.
+Proof.
+ apply max_monotone. intros x x'. apply add_le_mono_l.
+Qed.
+
+Lemma add_max_distr_r n m p : max (n + p) (m + p) = max n m + p.
+Proof.
+ rewrite 3 (add_comm _ p). apply add_max_distr_l.
+Qed.
+
+Lemma add_min_distr_l n m p : min (p + n) (p + m) = p + min n m.
+Proof.
+ apply min_monotone. intros x x'. apply add_le_mono_l.
+Qed.
+
+Lemma add_min_distr_r n m p : min (n + p) (m + p) = min n m + p.
+Proof.
+ rewrite 3 (add_comm _ p). apply add_min_distr_l.
+Qed.
+
+Lemma mul_max_distr_l n m p : max (p * n) (p * m) = p * max n m.
+Proof.
+ apply max_monotone. intros x x'. apply mul_le_mono_l.
+Qed.
+
+Lemma mul_max_distr_r n m p : max (n * p) (m * p) = max n m * p.
+Proof.
+ rewrite 3 (mul_comm _ p). apply mul_max_distr_l.
+Qed.
+
+Lemma mul_min_distr_l n m p : min (p * n) (p * m) = p * min n m.
+Proof.
+ apply min_monotone. intros x x'. apply mul_le_mono_l.
+Qed.
+
+Lemma mul_min_distr_r n m p : min (n * p) (m * p) = min n m * p.
+Proof.
+ rewrite 3 (mul_comm _ p). apply mul_min_distr_l.
+Qed.
+
+
+(** ** Results concerning [iter_op] *)
+
+Lemma iter_op_succ : forall A (op:A->A->A),
+ (forall x y z, op x (op y z) = op (op x y) z) ->
+ forall p a,
+ iter_op op (succ p) a = op a (iter_op op p a).
+Proof.
+ induction p; simpl; intros; trivial.
+ rewrite H. apply IHp.
+Qed.
+
+(** ** Results about [of_nat] and [of_succ_nat] *)
+
+Lemma of_nat_succ (n:nat) : of_succ_nat n = of_nat (S n).
+Proof.
+ induction n. trivial. simpl. f_equal. now rewrite IHn.
+Qed.
+
+Lemma pred_of_succ_nat (n:nat) : pred (of_succ_nat n) = of_nat n.
+Proof.
+ destruct n. trivial. simpl pred. rewrite pred_succ. apply of_nat_succ.
+Qed.
+
+Lemma succ_of_nat (n:nat) : n<>O -> succ (of_nat n) = of_succ_nat n.
+Proof.
+ rewrite of_nat_succ. destruct n; trivial. now destruct 1.
+Qed.
+
+(** ** Correctness proofs for the square root function *)
+
+Inductive SqrtSpec : positive*mask -> positive -> Prop :=
+ | SqrtExact s x : x=s*s -> SqrtSpec (s,IsNul) x
+ | SqrtApprox s r x : x=s*s+r -> r <= s~0 -> SqrtSpec (s,IsPos r) x.
+
+Lemma sqrtrem_step_spec f g p x :
+ (f=xO \/ f=xI) -> (g=xO \/ g=xI) ->
+ SqrtSpec p x -> SqrtSpec (sqrtrem_step f g p) (g (f x)).
+Proof.
+intros Hf Hg [ s _ -> | s r _ -> Hr ].
+(* exact *)
+unfold sqrtrem_step.
+destruct Hf,Hg; subst; simpl; constructor; now rewrite ?square_xO.
+(* approx *)
+assert (Hfg : forall p q, g (f (p+q)) = p~0~0 + g (f q))
+ by (intros; destruct Hf, Hg; now subst).
+unfold sqrtrem_step, leb.
+case compare_spec; [intros EQ | intros LT | intros GT].
+(* - EQ *)
+rewrite <- EQ, sub_mask_diag. constructor.
+destruct Hg; subst g; destr_eq EQ.
+destruct Hf; subst f; destr_eq EQ.
+subst. now rewrite square_xI.
+(* - LT *)
+destruct (sub_mask_pos' _ _ LT) as (y & -> & H). constructor.
+rewrite Hfg, <- H. now rewrite square_xI, add_assoc. clear Hfg.
+rewrite <- lt_succ_r in Hr. change (r < s~1) in Hr.
+rewrite <- lt_succ_r, (add_lt_mono_l (s~0~1)), H. simpl.
+rewrite add_carry_spec, add_diag. simpl.
+destruct Hf,Hg; subst; red; simpl_compare; now rewrite Hr.
+(* - GT *)
+constructor. now rewrite Hfg, square_xO. apply lt_succ_r, GT.
+Qed.
+
+Lemma sqrtrem_spec p : SqrtSpec (sqrtrem p) p.
+Proof.
+revert p. fix 1.
+ destruct p; try destruct p; try (constructor; easy);
+  apply sqrtrem_step_spec; auto.
+Qed.
+
+Lemma sqrt_spec p :
+ let s := sqrt p in s*s <= p < (succ s)*(succ s).
+Proof.
+ simpl.
+ assert (H:=sqrtrem_spec p).
+ unfold sqrt in *. destruct sqrtrem as (s,rm); simpl.
+ inversion_clear H; subst.
+ (* exact *)
+ split. reflexivity. apply mul_lt_mono; apply lt_succ_diag_r.
+ (* approx *)
+ split.
+ apply lt_le_incl, lt_add_r.
+ rewrite <- add_1_l, mul_add_distr_r, !mul_add_distr_l, !mul_1_r, !mul_1_l.
+ rewrite add_assoc, (add_comm _ r). apply add_lt_mono_r.
+ now rewrite <- add_assoc, add_diag, add_1_l, lt_succ_r.
+Qed.
+
+(** ** Correctness proofs for the gcd function *)
+
+Lemma divide_add_cancel_l p q r : (p | r) -> (p | q + r) -> (p | q).
+Proof.
+ intros (s,Hs) (t,Ht).
+ exists (t-s).
+ rewrite mul_sub_distr_r.
+ rewrite <- Hs, <- Ht.
+ symmetry. apply add_sub.
+ apply mul_lt_mono_r with p.
+ rewrite <- Hs, <- Ht, add_comm.
+ apply lt_add_r.
+Qed.
+
+Lemma divide_xO_xI p q r : (p | q~0) -> (p | r~1) -> (p | q).
+Proof.
+ intros (s,Hs) (t,Ht).
+ destruct p.
+ destruct s; try easy. simpl in Hs. destr_eq Hs. now exists s.
+ rewrite mul_xO_r in Ht; discriminate.
+ exists q; now rewrite mul_1_r.
+Qed.
+
+Lemma divide_xO_xO p q : (p~0|q~0) <-> (p|q).
+Proof.
+ split; intros (r,H); simpl in *.
+ rewrite mul_xO_r in H. destr_eq H. now exists r.
+ exists r; simpl. rewrite mul_xO_r. f_equal; auto.
+Qed.
+
+Lemma divide_mul_l p q r : (p|q) -> (p|q*r).
+Proof.
+ intros (s,H). exists (s*r).
+ rewrite <- mul_assoc, (mul_comm r p), mul_assoc. now f_equal.
+Qed.
+
+Lemma divide_mul_r p q r : (p|r) -> (p|q*r).
+Proof.
+ rewrite mul_comm. apply divide_mul_l.
+Qed.
+
+(** The first component of ggcd is gcd *)
+
+Lemma ggcdn_gcdn : forall n a b,
+  fst (ggcdn n a b) = gcdn n a b.
+Proof.
+ induction n.
+ simpl; auto.
+ destruct a, b; simpl; auto; try case compare_spec; simpl; trivial;
+  rewrite <- IHn; destruct ggcdn as (g,(u,v)); simpl; auto.
+Qed.
+
+Lemma ggcd_gcd : forall a b, fst (ggcd a b) = gcd a b.
+Proof.
+ unfold ggcd, gcd. intros. apply ggcdn_gcdn.
+Qed.
+
+(** The other components of ggcd are indeed the correct factors. *)
+
+Ltac destr_pggcdn IHn :=
+ match goal with |- context [ ggcdn _ ?x ?y ] =>
+  generalize (IHn x y); destruct ggcdn as (g,(u,v)); simpl
+ end.
+
+Lemma ggcdn_correct_divisors : forall n a b,
+  let '(g,(aa,bb)) := ggcdn n a b in
+  a = g*aa /\ b = g*bb.
+Proof.
+ induction n.
+ simpl; auto.
+ destruct a, b; simpl; auto; try case compare_spec; try destr_pggcdn IHn.
+ (* Eq *)
+ intros ->. now rewrite mul_comm.
+ (* Lt *)
+ intros (H',H) LT; split; auto.
+ rewrite mul_add_distr_l, mul_xO_r, <- H, <- H'.
+ simpl. f_equal. symmetry.
+ rewrite add_comm. now apply sub_add.
+ (* Gt *)
+ intros (H',H) LT; split; auto.
+ rewrite mul_add_distr_l, mul_xO_r, <- H, <- H'.
+ simpl. f_equal. symmetry.
+ rewrite add_comm. now apply sub_add.
+ (* Then... *)
+ intros (H,H'); split; auto. rewrite mul_xO_r, H'; auto.
+ intros (H,H'); split; auto. rewrite mul_xO_r, H; auto.
+ intros (H,H'); split; subst; auto.
+Qed.
+
+Lemma ggcd_correct_divisors : forall a b,
+  let '(g,(aa,bb)) := ggcd a b in
+  a=g*aa /\ b=g*bb.
+Proof.
+ unfold ggcd. intros. apply ggcdn_correct_divisors.
+Qed.
+
+(** We can use this fact to prove a part of the gcd correctness *)
+
+Lemma gcd_divide_l : forall a b, (gcd a b | a).
+Proof.
+ intros a b. rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b).
+ destruct ggcd as (g,(aa,bb)); simpl. intros (H,_). exists aa.
+  now rewrite mul_comm.
+Qed.
+
+Lemma gcd_divide_r : forall a b, (gcd a b | b).
+Proof.
+ intros a b. rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b).
+ destruct ggcd as (g,(aa,bb)); simpl. intros (_,H). exists bb.
+  now rewrite mul_comm.
+Qed.
+
+(** We now prove directly that gcd is the greatest amongst common divisors *)
+
+Lemma gcdn_greatest : forall n a b, (size_nat a + size_nat b <= n)%nat ->
+ forall p, (p|a) -> (p|b) -> (p|gcdn n a b).
+Proof.
+ induction n.
+ destruct a, b; simpl; inversion 1.
+ destruct a, b; simpl; try case compare_spec; simpl; auto.
+ (* Lt *)
+ intros LT LE p Hp1 Hp2. apply IHn; clear IHn; trivial.
+ apply le_S_n in LE. eapply Le.le_trans; [|eapply LE].
+ rewrite plus_comm, <- plus_n_Sm, <- plus_Sn_m.
+ apply plus_le_compat; trivial.
+ apply size_nat_monotone, sub_decr, LT.
+ apply divide_xO_xI with a; trivial.
+ apply (divide_add_cancel_l p _ a~1); trivial.
+ now rewrite <- sub_xI_xI, sub_add.
+ (* Gt *)
+ intros LT LE p Hp1 Hp2. apply IHn; clear IHn; trivial.
+ apply le_S_n in LE. eapply Le.le_trans; [|eapply LE].
+ apply plus_le_compat; trivial.
+ apply size_nat_monotone, sub_decr, LT.
+ apply divide_xO_xI with b; trivial.
+ apply (divide_add_cancel_l p _ b~1); trivial.
+ now rewrite <- sub_xI_xI, sub_add.
+ (* a~1 b~0 *)
+ intros LE p Hp1 Hp2. apply IHn; clear IHn; trivial.
+ apply le_S_n in LE. simpl. now rewrite plus_n_Sm.
+ apply divide_xO_xI with a; trivial.
+ (* a~0 b~1 *)
+ intros LE p Hp1 Hp2. apply IHn; clear IHn; trivial.
+ simpl. now apply le_S_n.
+ apply divide_xO_xI with b; trivial.
+ (* a~0 b~0 *)
+ intros LE p Hp1 Hp2.
+ destruct p.
+ change (gcdn n a b)~0 with (2*(gcdn n a b)).
+ apply divide_mul_r.
+ apply IHn; clear IHn.
+ apply le_S_n in LE. apply le_Sn_le. now rewrite plus_n_Sm.
+ apply divide_xO_xI with p; trivial. now exists 1.
+ apply divide_xO_xI with p; trivial. now exists 1.
+ apply divide_xO_xO.
+ apply IHn; clear IHn.
+ apply le_S_n in LE. apply le_Sn_le. now rewrite plus_n_Sm.
+ now apply divide_xO_xO.
+ now apply divide_xO_xO.
+ exists (gcdn n a b)~0. now rewrite mul_1_r.
+Qed.
+
+Lemma gcd_greatest : forall a b p, (p|a) -> (p|b) -> (p|gcd a b).
+Proof.
+ intros. apply gcdn_greatest; auto.
+Qed.
+
+(** As a consequence, the rests after division by gcd are relatively prime *)
+
+Lemma ggcd_greatest : forall a b,
+ let (aa,bb) := snd (ggcd a b) in
+ forall p, (p|aa) -> (p|bb) -> p=1.
+Proof.
+ intros. generalize (gcd_greatest a b) (ggcd_correct_divisors a b).
+ rewrite <- ggcd_gcd. destruct ggcd as (g,(aa,bb)); simpl.
+ intros H (EQa,EQb) p Hp1 Hp2; subst.
+ assert (H' : (g*p | g)).
+  apply H.
+  destruct Hp1 as (r,Hr). exists r.
+   now rewrite mul_assoc, (mul_comm r g), <- mul_assoc, <- Hr.
+  destruct Hp2 as (r,Hr). exists r.
+   now rewrite mul_assoc, (mul_comm r g), <- mul_assoc, <- Hr.
+ destruct H' as (q,H').
+ rewrite (mul_comm g p), mul_assoc in H'.
+ apply mul_eq_1 with q; rewrite mul_comm.
+ now apply mul_reg_r with g.
+Qed.
+
+End Pos.
+
+(** Exportation of notations *)
+
+Infix "+" := Pos.add : positive_scope.
+Infix "-" := Pos.sub : positive_scope.
+Infix "*" := Pos.mul : positive_scope.
+Infix "^" := Pos.pow : positive_scope.
+Infix "?=" := Pos.compare (at level 70, no associativity) : positive_scope.
+Infix "=?" := Pos.eqb (at level 70, no associativity) : positive_scope.
+Infix "<=?" := Pos.leb (at level 70, no associativity) : positive_scope.
+Infix "<?" := Pos.ltb (at level 70, no associativity) : positive_scope.
+Infix "<=" := Pos.le : positive_scope.
+Infix "<" := Pos.lt : positive_scope.
+Infix ">=" := Pos.ge : positive_scope.
+Infix ">" := Pos.gt : positive_scope.
+
+Notation "x <= y <= z" := (x <= y /\ y <= z) : positive_scope.
+Notation "x <= y < z" := (x <= y /\ y < z) : positive_scope.
+Notation "x < y < z" := (x < y /\ y < z) : positive_scope.
+Notation "x < y <= z" := (x < y /\ y <= z) : positive_scope.
+
+Notation "( p | q )" := (Pos.divide p q) (at level 0) : positive_scope.
+
+(** Compatibility notations *)
+
+Notation positive := positive (only parsing).
+Notation positive_rect := positive_rect (only parsing).
+Notation positive_rec := positive_rec (only parsing).
+Notation positive_ind := positive_ind (only parsing).
+Notation xI := xI (only parsing).
+Notation xO := xO (only parsing).
+Notation xH := xH (only parsing).
+
+Notation IsNul := Pos.IsNul (only parsing).
+Notation IsPos := Pos.IsPos (only parsing).
+Notation IsNeg := Pos.IsNeg (only parsing).
+
+Notation Psucc := Pos.succ (compat "8.3").
+Notation Pplus := Pos.add (compat "8.3").
+Notation Pplus_carry := Pos.add_carry (compat "8.3").
+Notation Ppred := Pos.pred (compat "8.3").
+Notation Piter_op := Pos.iter_op (compat "8.3").
+Notation Piter_op_succ := Pos.iter_op_succ (compat "8.3").
+Notation Pmult_nat := (Pos.iter_op plus) (compat "8.3").
+Notation nat_of_P := Pos.to_nat (compat "8.3").
+Notation P_of_succ_nat := Pos.of_succ_nat (compat "8.3").
+Notation Pdouble_minus_one := Pos.pred_double (compat "8.3").
+Notation positive_mask := Pos.mask (compat "8.3").
+Notation positive_mask_rect := Pos.mask_rect (compat "8.3").
+Notation positive_mask_ind := Pos.mask_ind (compat "8.3").
+Notation positive_mask_rec := Pos.mask_rec (compat "8.3").
+Notation Pdouble_plus_one_mask := Pos.succ_double_mask (compat "8.3").
+Notation Pdouble_mask := Pos.double_mask (compat "8.3").
+Notation Pdouble_minus_two := Pos.double_pred_mask (compat "8.3").
+Notation Pminus_mask := Pos.sub_mask (compat "8.3").
+Notation Pminus_mask_carry := Pos.sub_mask_carry (compat "8.3").
+Notation Pminus := Pos.sub (compat "8.3").
+Notation Pmult := Pos.mul (compat "8.3").
+Notation iter_pos := @Pos.iter (compat "8.3").
+Notation Ppow := Pos.pow (compat "8.3").
+Notation Pdiv2 := Pos.div2 (compat "8.3").
+Notation Pdiv2_up := Pos.div2_up (compat "8.3").
+Notation Psize := Pos.size_nat (compat "8.3").
+Notation Psize_pos := Pos.size (compat "8.3").
+Notation Pcompare := Pos.compare_cont (compat "8.3").
+Notation Plt := Pos.lt (compat "8.3").
+Notation Pgt := Pos.gt (compat "8.3").
+Notation Ple := Pos.le (compat "8.3").
+Notation Pge := Pos.ge (compat "8.3").
+Notation Pmin := Pos.min (compat "8.3").
+Notation Pmax := Pos.max (compat "8.3").
+Notation Peqb := Pos.eqb (compat "8.3").
+Notation positive_eq_dec := Pos.eq_dec (compat "8.3").
+Notation xI_succ_xO := Pos.xI_succ_xO (compat "8.3").
+Notation Psucc_discr := Pos.succ_discr (compat "8.3").
+Notation Psucc_o_double_minus_one_eq_xO :=
+ Pos.succ_pred_double (compat "8.3").
+Notation Pdouble_minus_one_o_succ_eq_xI :=
+ Pos.pred_double_succ (compat "8.3").
+Notation xO_succ_permute := Pos.double_succ (compat "8.3").
+Notation double_moins_un_xO_discr :=
+ Pos.pred_double_xO_discr (compat "8.3").
+Notation Psucc_not_one := Pos.succ_not_1 (compat "8.3").
+Notation Ppred_succ := Pos.pred_succ (compat "8.3").
+Notation Psucc_pred := Pos.succ_pred_or (compat "8.3").
+Notation Psucc_inj := Pos.succ_inj (compat "8.3").
+Notation Pplus_carry_spec := Pos.add_carry_spec (compat "8.3").
+Notation Pplus_comm := Pos.add_comm (compat "8.3").
+Notation Pplus_succ_permute_r := Pos.add_succ_r (compat "8.3").
+Notation Pplus_succ_permute_l := Pos.add_succ_l (compat "8.3").
+Notation Pplus_no_neutral := Pos.add_no_neutral (compat "8.3").
+Notation Pplus_carry_plus := Pos.add_carry_add (compat "8.3").
+Notation Pplus_reg_r := Pos.add_reg_r (compat "8.3").
+Notation Pplus_reg_l := Pos.add_reg_l (compat "8.3").
+Notation Pplus_carry_reg_r := Pos.add_carry_reg_r (compat "8.3").
+Notation Pplus_carry_reg_l := Pos.add_carry_reg_l (compat "8.3").
+Notation Pplus_assoc := Pos.add_assoc (compat "8.3").
+Notation Pplus_xO := Pos.add_xO (compat "8.3").
+Notation Pplus_xI_double_minus_one := Pos.add_xI_pred_double (compat "8.3").
+Notation Pplus_xO_double_minus_one := Pos.add_xO_pred_double (compat "8.3").
+Notation Pplus_diag := Pos.add_diag (compat "8.3").
+Notation PeanoView := Pos.PeanoView (compat "8.3").
+Notation PeanoOne := Pos.PeanoOne (compat "8.3").
+Notation PeanoSucc := Pos.PeanoSucc (compat "8.3").
+Notation PeanoView_rect := Pos.PeanoView_rect (compat "8.3").
+Notation PeanoView_ind := Pos.PeanoView_ind (compat "8.3").
+Notation PeanoView_rec := Pos.PeanoView_rec (compat "8.3").
+Notation peanoView_xO := Pos.peanoView_xO (compat "8.3").
+Notation peanoView_xI := Pos.peanoView_xI (compat "8.3").
+Notation peanoView := Pos.peanoView (compat "8.3").
+Notation PeanoView_iter := Pos.PeanoView_iter (compat "8.3").
+Notation eq_dep_eq_positive := Pos.eq_dep_eq_positive (compat "8.3").
+Notation PeanoViewUnique := Pos.PeanoViewUnique (compat "8.3").
+Notation Prect := Pos.peano_rect (compat "8.3").
+Notation Prect_succ := Pos.peano_rect_succ (compat "8.3").
+Notation Prect_base := Pos.peano_rect_base (compat "8.3").
+Notation Prec := Pos.peano_rec (compat "8.3").
+Notation Pind := Pos.peano_ind (compat "8.3").
+Notation Pcase := Pos.peano_case (compat "8.3").
+Notation Pmult_1_r := Pos.mul_1_r (compat "8.3").
+Notation Pmult_Sn_m := Pos.mul_succ_l (compat "8.3").
+Notation Pmult_xO_permute_r := Pos.mul_xO_r (compat "8.3").
+Notation Pmult_xI_permute_r := Pos.mul_xI_r (compat "8.3").
+Notation Pmult_comm := Pos.mul_comm (compat "8.3").
+Notation Pmult_plus_distr_l := Pos.mul_add_distr_l (compat "8.3").
+Notation Pmult_plus_distr_r := Pos.mul_add_distr_r (compat "8.3").
+Notation Pmult_assoc := Pos.mul_assoc (compat "8.3").
+Notation Pmult_xI_mult_xO_discr := Pos.mul_xI_mul_xO_discr (compat "8.3").
+Notation Pmult_xO_discr := Pos.mul_xO_discr (compat "8.3").
+Notation Pmult_reg_r := Pos.mul_reg_r (compat "8.3").
+Notation Pmult_reg_l := Pos.mul_reg_l (compat "8.3").
+Notation Pmult_1_inversion_l := Pos.mul_eq_1_l (compat "8.3").
+Notation Psquare_xO := Pos.square_xO (compat "8.3").
+Notation Psquare_xI := Pos.square_xI (compat "8.3").
+Notation iter_pos_swap_gen := Pos.iter_swap_gen (compat "8.3").
+Notation iter_pos_swap := Pos.iter_swap (compat "8.3").
+Notation iter_pos_succ := Pos.iter_succ (compat "8.3").
+Notation iter_pos_plus := Pos.iter_add (compat "8.3").
+Notation iter_pos_invariant := Pos.iter_invariant (compat "8.3").
+Notation Ppow_1_r := Pos.pow_1_r (compat "8.3").
+Notation Ppow_succ_r := Pos.pow_succ_r (compat "8.3").
+Notation Peqb_refl := Pos.eqb_refl (compat "8.3").
+Notation Peqb_eq := Pos.eqb_eq (compat "8.3").
+Notation Pcompare_refl_id := Pos.compare_cont_refl (compat "8.3").
+Notation Pcompare_eq_iff := Pos.compare_eq_iff (compat "8.3").
+Notation Pcompare_Gt_Lt := Pos.compare_cont_Gt_Lt (compat "8.3").
+Notation Pcompare_eq_Lt := Pos.compare_lt_iff (compat "8.3").
+Notation Pcompare_Lt_Gt := Pos.compare_cont_Lt_Gt (compat "8.3").
+
+Notation Pcompare_antisym := Pos.compare_cont_antisym (compat "8.3").
+Notation ZC1 := Pos.gt_lt (compat "8.3").
+Notation ZC2 := Pos.lt_gt (compat "8.3").
+Notation Pcompare_spec := Pos.compare_spec (compat "8.3").
+Notation Pcompare_p_Sp := Pos.lt_succ_diag_r (compat "8.3").
+Notation Pcompare_succ_succ := Pos.compare_succ_succ (compat "8.3").
+Notation Pcompare_1 := Pos.nlt_1_r (compat "8.3").
+Notation Plt_1 := Pos.nlt_1_r (compat "8.3").
+Notation Plt_1_succ := Pos.lt_1_succ (compat "8.3").
+Notation Plt_lt_succ := Pos.lt_lt_succ (compat "8.3").
+Notation Plt_irrefl := Pos.lt_irrefl (compat "8.3").
+Notation Plt_trans := Pos.lt_trans (compat "8.3").
+Notation Plt_ind := Pos.lt_ind (compat "8.3").
+Notation Ple_lteq := Pos.le_lteq (compat "8.3").
+Notation Ple_refl := Pos.le_refl (compat "8.3").
+Notation Ple_lt_trans := Pos.le_lt_trans (compat "8.3").
+Notation Plt_le_trans := Pos.lt_le_trans (compat "8.3").
+Notation Ple_trans := Pos.le_trans (compat "8.3").
+Notation Plt_succ_r := Pos.lt_succ_r (compat "8.3").
+Notation Ple_succ_l := Pos.le_succ_l (compat "8.3").
+Notation Pplus_compare_mono_l := Pos.add_compare_mono_l (compat "8.3").
+Notation Pplus_compare_mono_r := Pos.add_compare_mono_r (compat "8.3").
+Notation Pplus_lt_mono_l := Pos.add_lt_mono_l (compat "8.3").
+Notation Pplus_lt_mono_r := Pos.add_lt_mono_r (compat "8.3").
+Notation Pplus_lt_mono := Pos.add_lt_mono (compat "8.3").
+Notation Pplus_le_mono_l := Pos.add_le_mono_l (compat "8.3").
+Notation Pplus_le_mono_r := Pos.add_le_mono_r (compat "8.3").
+Notation Pplus_le_mono := Pos.add_le_mono (compat "8.3").
+Notation Pmult_compare_mono_l := Pos.mul_compare_mono_l (compat "8.3").
+Notation Pmult_compare_mono_r := Pos.mul_compare_mono_r (compat "8.3").
+Notation Pmult_lt_mono_l := Pos.mul_lt_mono_l (compat "8.3").
+Notation Pmult_lt_mono_r := Pos.mul_lt_mono_r (compat "8.3").
+Notation Pmult_lt_mono := Pos.mul_lt_mono (compat "8.3").
+Notation Pmult_le_mono_l := Pos.mul_le_mono_l (compat "8.3").
+Notation Pmult_le_mono_r := Pos.mul_le_mono_r (compat "8.3").
+Notation Pmult_le_mono := Pos.mul_le_mono (compat "8.3").
+Notation Plt_plus_r := Pos.lt_add_r (compat "8.3").
+Notation Plt_not_plus_l := Pos.lt_not_add_l (compat "8.3").
+Notation Ppow_gt_1 := Pos.pow_gt_1 (compat "8.3").
+Notation Ppred_mask := Pos.pred_mask (compat "8.3").
+Notation Pminus_mask_succ_r := Pos.sub_mask_succ_r (compat "8.3").
+Notation Pminus_mask_carry_spec := Pos.sub_mask_carry_spec (compat "8.3").
+Notation Pminus_succ_r := Pos.sub_succ_r (compat "8.3").
+Notation Pminus_mask_diag := Pos.sub_mask_diag (compat "8.3").
+
+Notation Pplus_minus_eq := Pos.add_sub (compat "8.3").
+Notation Pmult_minus_distr_l := Pos.mul_sub_distr_l (compat "8.3").
+Notation Pminus_lt_mono_l := Pos.sub_lt_mono_l (compat "8.3").
+Notation Pminus_compare_mono_l := Pos.sub_compare_mono_l (compat "8.3").
+Notation Pminus_compare_mono_r := Pos.sub_compare_mono_r (compat "8.3").
+Notation Pminus_lt_mono_r := Pos.sub_lt_mono_r (compat "8.3").
+Notation Pminus_decr := Pos.sub_decr (compat "8.3").
+Notation Pminus_xI_xI := Pos.sub_xI_xI (compat "8.3").
+Notation Pplus_minus_assoc := Pos.add_sub_assoc (compat "8.3").
+Notation Pminus_plus_distr := Pos.sub_add_distr (compat "8.3").
+Notation Pminus_minus_distr := Pos.sub_sub_distr (compat "8.3").
+Notation Pminus_mask_Lt := Pos.sub_mask_neg (compat "8.3").
+Notation Pminus_Lt := Pos.sub_lt (compat "8.3").
+Notation Pminus_Eq := Pos.sub_diag (compat "8.3").
+Notation Psize_monotone := Pos.size_nat_monotone (compat "8.3").
+Notation Psize_pos_gt := Pos.size_gt (compat "8.3").
+Notation Psize_pos_le := Pos.size_le (compat "8.3").
+
+(** More complex compatibility facts, expressed as lemmas
+    (to preserve scopes for instance) *)
+
+Lemma Peqb_true_eq x y : Pos.eqb x y = true -> x=y.
+Proof. apply Pos.eqb_eq. Qed.
+Lemma Pcompare_eq_Gt p q : (p ?= q) = Gt <-> p > q.
+Proof. reflexivity. Qed.
+Lemma Pplus_one_succ_r p : Pos.succ p = p + 1.
+Proof (eq_sym (Pos.add_1_r p)).
+Lemma Pplus_one_succ_l p : Pos.succ p = 1 + p.
+Proof (eq_sym (Pos.add_1_l p)).
+Lemma Pcompare_refl p : Pos.compare_cont p p Eq = Eq.
+Proof (Pos.compare_cont_refl p Eq).
+Lemma Pcompare_Eq_eq : forall p q, Pos.compare_cont p q Eq = Eq -> p = q.
+Proof Pos.compare_eq.
+Lemma ZC4 p q : Pos.compare_cont p q Eq = CompOpp (Pos.compare_cont q p Eq).
+Proof (Pos.compare_antisym q p).
+Lemma Ppred_minus p : Pos.pred p = p - 1.
+Proof (eq_sym (Pos.sub_1_r p)).
+
+Lemma Pminus_mask_Gt p q :
+  p > q ->
+  exists h : positive,
+   Pos.sub_mask p q = IsPos h /\
+   q + h = p /\ (h = 1 \/ Pos.sub_mask_carry p q = IsPos (Pos.pred h)).
+Proof.
+ intros H. apply Pos.gt_lt in H.
+ destruct (Pos.sub_mask_pos p q H) as (r & U).
+ exists r. repeat split; trivial.
+ now apply Pos.sub_mask_pos_iff.
+ destruct (Pos.eq_dec r 1) as [EQ|NE]; [now left|right].
+ rewrite Pos.sub_mask_carry_spec, U. destruct r; trivial. now elim NE.
+Qed.
+
+Lemma Pplus_minus : forall p q, p > q -> q+(p-q) = p.
+Proof.
+ intros. rewrite Pos.add_comm. now apply Pos.sub_add, Pos.gt_lt.
+Qed.
+
+(** Discontinued results of little interest and little/zero use
+    in user contributions:
+
+    Pplus_carry_no_neutral
+    Pplus_carry_pred_eq_plus
+    Pcompare_not_Eq
+    Pcompare_Lt_Lt
+    Pcompare_Lt_eq_Lt
+    Pcompare_Gt_Gt
+    Pcompare_Gt_eq_Gt
+    Psucc_lt_compat
+    Psucc_le_compat
+    ZC3
+    Pcompare_p_Sq
+    Pminus_mask_carry_diag
+    Pminus_mask_IsNeg
+    ZL10
+    ZL11
+    double_eq_zero_inversion
+    double_plus_one_zero_discr
+    double_plus_one_eq_one_inversion
+    double_eq_one_discr
+
+    Infix "/" := Pdiv2 : positive_scope.
+*)
+
+(** Old stuff, to remove someday *)
+
+Lemma Dcompare : forall r:comparison, r = Eq \/ r = Lt \/ r = Gt.
+Proof.
+  destruct r; auto.
+Qed.
+
+(** Incompatibilities :
+
+ - [(_ ?= _)%positive] expects no arg now, and designates [Pos.compare]
+   which is convertible but syntactically distinct to
+   [Pos.compare_cont .. .. Eq].
+
+ - [Pmult_nat] cannot be unfolded (unfold [Pos.iter_op] instead).
+
+*)
diff --git a/theories/PArith/BinPosDef.v b/theories/PArith/BinPosDef.v
new file mode 100644
index 00000000..4beeea31
--- /dev/null
+++ b/theories/PArith/BinPosDef.v
@@ -0,0 +1,562 @@
+(* -*- coding: utf-8 -*- *)
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(**********************************************************************)
+(** * Binary positive numbers, operations *)
+(**********************************************************************)
+
+(** Initial development by Pierre Crégut, CNET, Lannion, France *)
+
+(** The type [positive] and its constructors [xI] and [xO] and [xH]
+    are now defined in [BinNums.v] *)
+
+Require Export BinNums.
+
+(** Postfix notation for positive numbers, allowing to mimic
+    the position of bits in a big-endian representation.
+    For instance, we can write [1~1~0] instead of [(xO (xI xH))]
+    for the number 6 (which is 110 in binary notation).
+*)
+
+Notation "p ~ 1" := (xI p)
+ (at level 7, left associativity, format "p '~' '1'") : positive_scope.
+Notation "p ~ 0" := (xO p)
+ (at level 7, left associativity, format "p '~' '0'") : positive_scope.
+
+Local Open Scope positive_scope.
+Local Unset Boolean Equality Schemes.
+Local Unset Case Analysis Schemes.
+
+Module Pos.
+
+Definition t := positive.
+
+(** * Operations over positive numbers *)
+
+(** ** Successor *)
+
+Fixpoint succ x :=
+  match x with
+    | p~1 => (succ p)~0
+    | p~0 => p~1
+    | 1 => 1~0
+  end.
+
+(** ** Addition *)
+
+Fixpoint add x y :=
+  match x, y with
+    | p~1, q~1 => (add_carry p q)~0
+    | p~1, q~0 => (add p q)~1
+    | p~1, 1 => (succ p)~0
+    | p~0, q~1 => (add p q)~1
+    | p~0, q~0 => (add p q)~0
+    | p~0, 1 => p~1
+    | 1, q~1 => (succ q)~0
+    | 1, q~0 => q~1
+    | 1, 1 => 1~0
+  end
+
+with add_carry x y :=
+  match x, y with
+    | p~1, q~1 => (add_carry p q)~1
+    | p~1, q~0 => (add_carry p q)~0
+    | p~1, 1 => (succ p)~1
+    | p~0, q~1 => (add_carry p q)~0
+    | p~0, q~0 => (add p q)~1
+    | p~0, 1 => (succ p)~0
+    | 1, q~1 => (succ q)~1
+    | 1, q~0 => (succ q)~0
+    | 1, 1 => 1~1
+  end.
+
+Infix "+" := add : positive_scope.
+
+(** ** Operation [x -> 2*x-1] *)
+
+Fixpoint pred_double x :=
+  match x with
+    | p~1 => p~0~1
+    | p~0 => (pred_double p)~1
+    | 1 => 1
+  end.
+
+(** ** Predecessor *)
+
+Definition pred x :=
+  match x with
+    | p~1 => p~0
+    | p~0 => pred_double p
+    | 1 => 1
+  end.
+
+(** ** The predecessor of a positive number can be seen as a [N] *)
+
+Definition pred_N x :=
+  match x with
+    | p~1 => Npos (p~0)
+    | p~0 => Npos (pred_double p)
+    | 1 => N0
+  end.
+
+(** ** An auxiliary type for subtraction *)
+
+Inductive mask : Set :=
+| IsNul : mask
+| IsPos : positive -> mask
+| IsNeg : mask.
+
+(** ** Operation [x -> 2*x+1] *)
+
+Definition succ_double_mask (x:mask) : mask :=
+  match x with
+    | IsNul => IsPos 1
+    | IsNeg => IsNeg
+    | IsPos p => IsPos p~1
+  end.
+
+(** ** Operation [x -> 2*x] *)
+
+Definition double_mask (x:mask) : mask :=
+  match x with
+    | IsNul => IsNul
+    | IsNeg => IsNeg
+    | IsPos p => IsPos p~0
+  end.
+
+(** ** Operation [x -> 2*x-2] *)
+
+Definition double_pred_mask x : mask :=
+  match x with
+    | p~1 => IsPos p~0~0
+    | p~0 => IsPos (pred_double p)~0
+    | 1 => IsNul
+  end.
+
+(** ** Predecessor with mask *)
+
+Definition pred_mask (p : mask) : mask :=
+  match p with
+    | IsPos 1 => IsNul
+    | IsPos q => IsPos (pred q)
+    | IsNul => IsNeg
+    | IsNeg => IsNeg
+  end.
+
+(** ** Subtraction, result as a mask *)
+
+Fixpoint sub_mask (x y:positive) {struct y} : mask :=
+  match x, y with
+    | p~1, q~1 => double_mask (sub_mask p q)
+    | p~1, q~0 => succ_double_mask (sub_mask p q)
+    | p~1, 1 => IsPos p~0
+    | p~0, q~1 => succ_double_mask (sub_mask_carry p q)
+    | p~0, q~0 => double_mask (sub_mask p q)
+    | p~0, 1 => IsPos (pred_double p)
+    | 1, 1 => IsNul
+    | 1, _ => IsNeg
+  end
+
+with sub_mask_carry (x y:positive) {struct y} : mask :=
+  match x, y with
+    | p~1, q~1 => succ_double_mask (sub_mask_carry p q)
+    | p~1, q~0 => double_mask (sub_mask p q)
+    | p~1, 1 => IsPos (pred_double p)
+    | p~0, q~1 => double_mask (sub_mask_carry p q)
+    | p~0, q~0 => succ_double_mask (sub_mask_carry p q)
+    | p~0, 1 => double_pred_mask p
+    | 1, _ => IsNeg
+  end.
+
+(** ** Subtraction, result as a positive, returning 1 if [x<=y] *)
+
+Definition sub x y :=
+  match sub_mask x y with
+    | IsPos z => z
+    | _ => 1
+  end.
+
+Infix "-" := sub : positive_scope.
+
+(** ** Multiplication *)
+
+Fixpoint mul x y :=
+  match x with
+    | p~1 => y + (mul p y)~0
+    | p~0 => (mul p y)~0
+    | 1 => y
+  end.
+
+Infix "*" := mul : positive_scope.
+
+(** ** Iteration over a positive number *)
+
+Fixpoint iter (n:positive) {A} (f:A -> A) (x:A) : A :=
+  match n with
+    | xH => f x
+    | xO n' => iter n' f (iter n' f x)
+    | xI n' => f (iter n' f (iter n' f x))
+  end.
+
+(** ** Power *)
+
+Definition pow (x y:positive) := iter y (mul x) 1.
+
+Infix "^" := pow : positive_scope.
+
+(** ** Square *)
+
+Fixpoint square p :=
+  match p with
+    | p~1 => (square p + p)~0~1
+    | p~0 => (square p)~0~0
+    | 1 => 1
+  end.
+
+(** ** Division by 2 rounded below but for 1 *)
+
+Definition div2 p :=
+  match p with
+    | 1 => 1
+    | p~0 => p
+    | p~1 => p
+  end.
+
+(** Division by 2 rounded up *)
+
+Definition div2_up p :=
+ match p with
+   | 1 => 1
+   | p~0 => p
+   | p~1 => succ p
+ end.
+
+(** ** Number of digits in a positive number *)
+
+Fixpoint size_nat p : nat :=
+  match p with
+    | 1 => S O
+    | p~1 => S (size_nat p)
+    | p~0 => S (size_nat p)
+  end.
+
+(** Same, with positive output *)
+
+Fixpoint size p :=
+  match p with
+    | 1 => 1
+    | p~1 => succ (size p)
+    | p~0 => succ (size p)
+  end.
+
+(** ** Comparison on binary positive numbers *)
+
+Fixpoint compare_cont (x y:positive) (r:comparison) {struct y} : comparison :=
+  match x, y with
+    | p~1, q~1 => compare_cont p q r
+    | p~1, q~0 => compare_cont p q Gt
+    | p~1, 1 => Gt
+    | p~0, q~1 => compare_cont p q Lt
+    | p~0, q~0 => compare_cont p q r
+    | p~0, 1 => Gt
+    | 1, q~1 => Lt
+    | 1, q~0 => Lt
+    | 1, 1 => r
+  end.
+
+Definition compare x y := compare_cont x y Eq.
+
+Infix "?=" := compare (at level 70, no associativity) : positive_scope.
+
+Definition min p p' :=
+ match p ?= p' with
+ | Lt | Eq => p
+ | Gt => p'
+ end.
+
+Definition max p p' :=
+ match p ?= p' with
+ | Lt | Eq => p'
+ | Gt => p
+ end.
+
+(** ** Boolean equality and comparisons *)
+
+Fixpoint eqb p q {struct q} :=
+  match p, q with
+    | p~1, q~1 => eqb p q
+    | p~0, q~0 => eqb p q
+    | 1, 1 => true
+    | _, _ => false
+  end.
+
+Definition leb x y :=
+ match x ?= y with Gt => false | _ => true end.
+
+Definition ltb x y :=
+ match x ?= y with Lt => true | _ => false end.
+
+Infix "=?" := eqb (at level 70, no associativity) : positive_scope.
+Infix "<=?" := leb (at level 70, no associativity) : positive_scope.
+Infix "<?" := ltb (at level 70, no associativity) : positive_scope.
+
+(** ** A Square Root function for positive numbers *)
+
+(** We procede by blocks of two digits : if p is written qbb'
+    then sqrt(p) will be sqrt(q)~0 or sqrt(q)~1.
+    For deciding easily in which case we are, we store the remainder
+    (as a mask, since it can be null).
+    Instead of copy-pasting the following code four times, we
+    factorize as an auxiliary function, with f and g being either
+    xO or xI depending of the initial digits.
+    NB: (sub_mask (g (f 1)) 4) is a hack, morally it's g (f 0).
+*)
+
+Definition sqrtrem_step (f g:positive->positive) p :=
+ match p with
+  | (s, IsPos r) =>
+    let s' := s~0~1 in
+    let r' := g (f r) in
+    if s' <=? r' then (s~1, sub_mask r' s')
+    else (s~0, IsPos r')
+  | (s,_)  => (s~0, sub_mask (g (f 1)) 4)
+ end.
+
+Fixpoint sqrtrem p : positive * mask :=
+ match p with
+  | 1 => (1,IsNul)
+  | 2 => (1,IsPos 1)
+  | 3 => (1,IsPos 2)
+  | p~0~0 => sqrtrem_step xO xO (sqrtrem p)
+  | p~0~1 => sqrtrem_step xO xI (sqrtrem p)
+  | p~1~0 => sqrtrem_step xI xO (sqrtrem p)
+  | p~1~1 => sqrtrem_step xI xI (sqrtrem p)
+ end.
+
+Definition sqrt p := fst (sqrtrem p).
+
+
+(** ** Greatest Common Divisor *)
+
+Definition divide p q := exists r, q = r*p.
+Notation "( p | q )" := (divide p q) (at level 0) : positive_scope.
+
+(** Instead of the Euclid algorithm, we use here the Stein binary
+   algorithm, which is faster for this representation. This algorithm
+   is almost structural, but in the last cases we do some recursive
+   calls on subtraction, hence the need for a counter.
+*)
+
+Fixpoint gcdn (n : nat) (a b : positive) : positive :=
+  match n with
+    | O => 1
+    | S n =>
+      match a,b with
+	| 1, _ => 1
+	| _, 1 => 1
+	| a~0, b~0 => (gcdn n a b)~0
+	| _  , b~0 => gcdn n a b
+	| a~0, _   => gcdn n a b
+	| a'~1, b'~1 =>
+          match a' ?= b' with
+	    | Eq => a
+	    | Lt => gcdn n (b'-a') a
+	    | Gt => gcdn n (a'-b') b
+          end
+      end
+  end.
+
+(** We'll show later that we need at most (log2(a.b)) loops *)
+
+Definition gcd (a b : positive) := gcdn (size_nat a + size_nat b)%nat a b.
+
+(** Generalized Gcd, also computing the division of a and b by the gcd *)
+
+Fixpoint ggcdn (n : nat) (a b : positive) : (positive*(positive*positive)) :=
+  match n with
+    | O => (1,(a,b))
+    | S n =>
+      match a,b with
+	| 1, _ => (1,(1,b))
+	| _, 1 => (1,(a,1))
+	| a~0, b~0 =>
+           let (g,p) := ggcdn n a b in
+           (g~0,p)
+	| _, b~0 =>
+           let '(g,(aa,bb)) := ggcdn n a b in
+           (g,(aa, bb~0))
+	| a~0, _ =>
+           let '(g,(aa,bb)) := ggcdn n a b in
+           (g,(aa~0, bb))
+	| a'~1, b'~1 =>
+           match a' ?= b' with
+	     | Eq => (a,(1,1))
+	     | Lt =>
+	        let '(g,(ba,aa)) := ggcdn n (b'-a') a in
+	        (g,(aa, aa + ba~0))
+	     | Gt =>
+		let '(g,(ab,bb)) := ggcdn n (a'-b') b in
+		(g,(bb + ab~0, bb))
+	   end
+      end
+  end.
+
+Definition ggcd (a b: positive) := ggcdn (size_nat a + size_nat b)%nat a b.
+
+(** Local copies of the not-yet-available [N.double] and [N.succ_double] *)
+
+Definition Nsucc_double x :=
+  match x with
+  | N0 => Npos 1
+  | Npos p => Npos p~1
+  end.
+
+Definition Ndouble n :=
+  match n with
+  | N0 => N0
+  | Npos p => Npos p~0
+  end.
+
+(** Operation over bits. *)
+
+(** Logical [or] *)
+
+Fixpoint lor (p q : positive) : positive :=
+  match p, q with
+    | 1, q~0 => q~1
+    | 1, _ => q
+    | p~0, 1 => p~1
+    | _, 1 => p
+    | p~0, q~0 => (lor p q)~0
+    | p~0, q~1 => (lor p q)~1
+    | p~1, q~0 => (lor p q)~1
+    | p~1, q~1 => (lor p q)~1
+  end.
+
+(** Logical [and] *)
+
+Fixpoint land (p q : positive) : N :=
+  match p, q with
+    | 1, q~0 => N0
+    | 1, _ => Npos 1
+    | p~0, 1 => N0
+    | _, 1 => Npos 1
+    | p~0, q~0 => Ndouble (land p q)
+    | p~0, q~1 => Ndouble (land p q)
+    | p~1, q~0 => Ndouble (land p q)
+    | p~1, q~1 => Nsucc_double (land p q)
+  end.
+
+(** Logical [diff] *)
+
+Fixpoint ldiff (p q:positive) : N :=
+  match p, q with
+    | 1, q~0 => Npos 1
+    | 1, _ => N0
+    | _~0, 1 => Npos p
+    | p~1, 1 => Npos (p~0)
+    | p~0, q~0 => Ndouble (ldiff p q)
+    | p~0, q~1 => Ndouble (ldiff p q)
+    | p~1, q~1 => Ndouble (ldiff p q)
+    | p~1, q~0 => Nsucc_double (ldiff p q)
+  end.
+
+(** [xor] *)
+
+Fixpoint lxor (p q:positive) : N :=
+  match p, q with
+    | 1, 1 => N0
+    | 1, q~0 => Npos (q~1)
+    | 1, q~1 => Npos (q~0)
+    | p~0, 1 => Npos (p~1)
+    | p~0, q~0 => Ndouble (lxor p q)
+    | p~0, q~1 => Nsucc_double (lxor p q)
+    | p~1, 1 => Npos (p~0)
+    | p~1, q~0 => Nsucc_double (lxor p q)
+    | p~1, q~1 => Ndouble (lxor p q)
+  end.
+
+(** Shifts. NB: right shift of 1 stays at 1. *)
+
+Definition shiftl_nat (p:positive)(n:nat) := nat_iter n xO p.
+Definition shiftr_nat (p:positive)(n:nat) := nat_iter n div2 p.
+
+Definition shiftl (p:positive)(n:N) :=
+  match n with
+    | N0 => p
+    | Npos n => iter n xO p
+  end.
+
+Definition shiftr (p:positive)(n:N) :=
+  match n with
+    | N0 => p
+    | Npos n => iter n div2 p
+  end.
+
+(** Checking whether a particular bit is set or not *)
+
+Fixpoint testbit_nat (p:positive) : nat -> bool :=
+  match p with
+    | 1 => fun n => match n with
+                      | O => true
+                      | S _ => false
+                    end
+    | p~0 => fun n => match n with
+                        | O => false
+                        | S n' => testbit_nat p n'
+                      end
+    | p~1 => fun n => match n with
+                        | O => true
+                        | S n' => testbit_nat p n'
+                      end
+  end.
+
+(** Same, but with index in N *)
+
+Fixpoint testbit (p:positive)(n:N) :=
+  match p, n with
+    | p~0, N0 => false
+    | _, N0 => true
+    | 1, _ => false
+    | p~0, Npos n => testbit p (pred_N n)
+    | p~1, Npos n => testbit p (pred_N n)
+  end.
+
+(** ** From binary positive numbers to Peano natural numbers *)
+
+Definition iter_op {A}(op:A->A->A) :=
+  fix iter (p:positive)(a:A) : A :=
+  match p with
+    | 1 => a
+    | p~0 => iter p (op a a)
+    | p~1 => op a (iter p (op a a))
+  end.
+
+Definition to_nat (x:positive) : nat := iter_op plus x (S O).
+
+(** ** From Peano natural numbers to binary positive numbers *)
+
+(** A version preserving positive numbers, and sending 0 to 1. *)
+
+Fixpoint of_nat (n:nat) : positive :=
+ match n with
+   | O => 1
+   | S O => 1
+   | S x => succ (of_nat x)
+ end.
+
+(* Another version that converts [n] into [n+1] *)
+
+Fixpoint of_succ_nat (n:nat) : positive :=
+  match n with
+    | O => 1
+    | S x => succ (of_succ_nat x)
+  end.
+
+End Pos.
\ No newline at end of file
diff --git a/theories/PArith/PArith.v b/theories/PArith/PArith.v
new file mode 100644
index 00000000..9d294026
--- /dev/null
+++ b/theories/PArith/PArith.v
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Library for positive natural numbers *)
+
+Require Export BinNums BinPos Pnat POrderedType.
diff --git a/theories/NArith/POrderedType.v b/theories/PArith/POrderedType.v
index 0ff03c31..4aae6271 100644
--- a/theories/NArith/POrderedType.v
+++ b/theories/PArith/POrderedType.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -12,39 +12,15 @@ Local Open Scope positive_scope.
 
 (** * DecidableType structure for [positive] numbers *)
 
-Module Positive_as_UBE <: UsualBoolEq.
- Definition t := positive.
- Definition eq := @eq positive.
- Definition eqb := Peqb.
- Definition eqb_eq := Peqb_eq.
-End Positive_as_UBE.
-
-Module Positive_as_DT <: UsualDecidableTypeFull
- := Make_UDTF Positive_as_UBE.
+Module Positive_as_DT <: UsualDecidableTypeFull := Pos.
 
 (** Note that the last module fulfills by subtyping many other
     interfaces, such as [DecidableType] or [EqualityType]. *)
 
 
-
 (** * OrderedType structure for [positive] numbers *)
 
-Module Positive_as_OT <: OrderedTypeFull.
- Include Positive_as_DT.
- Definition lt := Plt.
- Definition le := Ple.
- Definition compare p q := Pcompare p q Eq.
-
- Instance lt_strorder : StrictOrder Plt.
- Proof. split; [ exact Plt_irrefl | exact Plt_trans ]. Qed.
-
- Instance lt_compat : Proper (Logic.eq==>Logic.eq==>iff) Plt.
- Proof. repeat red; intros; subst; auto. Qed.
-
- Definition le_lteq := Ple_lteq.
- Definition compare_spec := Pcompare_spec.
-
-End Positive_as_OT.
+Module Positive_as_OT <: OrderedTypeFull := Pos.
 
 (** Note that [Positive_as_OT] can also be seen as a [UsualOrderedType]
    and a [OrderedType] (and also as a [DecidableType]). *)
diff --git a/theories/PArith/Pnat.v b/theories/PArith/Pnat.v
new file mode 100644
index 00000000..31e88a40
--- /dev/null
+++ b/theories/PArith/Pnat.v
@@ -0,0 +1,484 @@
+(* -*- coding: utf-8 -*- *)
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import BinPos Le Lt Gt Plus Mult Minus Compare_dec.
+
+(** Properties of the injection from binary positive numbers
+    to Peano natural numbers *)
+
+(** Original development by Pierre Crégut, CNET, Lannion, France *)
+
+Local Open Scope positive_scope.
+Local Open Scope nat_scope.
+
+Module Pos2Nat.
+ Import Pos.
+
+(** [Pos.to_nat] is a morphism for successor, addition, multiplication *)
+
+Lemma inj_succ p : to_nat (succ p) = S (to_nat p).
+Proof.
+ unfold to_nat. rewrite iter_op_succ. trivial.
+ apply plus_assoc.
+Qed.
+
+Theorem inj_add p q : to_nat (p + q) = to_nat p + to_nat q.
+Proof.
+ revert q. induction p using peano_ind; intros q.
+ now rewrite add_1_l, inj_succ.
+ now rewrite add_succ_l, !inj_succ, IHp.
+Qed.
+
+Theorem inj_mul p q : to_nat (p * q) = to_nat p * to_nat q.
+Proof.
+ revert q. induction p using peano_ind; simpl; intros; trivial.
+ now rewrite mul_succ_l, inj_add, IHp, inj_succ.
+Qed.
+
+(** Mapping of xH, xO and xI through [Pos.to_nat] *)
+
+Lemma inj_1 : to_nat 1 = 1.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma inj_xO p : to_nat (xO p) = 2 * to_nat p.
+Proof.
+ exact (inj_mul 2 p).
+Qed.
+
+Lemma inj_xI p : to_nat (xI p) = S (2 * to_nat p).
+Proof.
+ now rewrite xI_succ_xO, inj_succ, inj_xO.
+Qed.
+
+(** [Pos.to_nat] maps to the strictly positive subset of [nat] *)
+
+Lemma is_succ : forall p, exists n, to_nat p = S n.
+Proof.
+ induction p using peano_ind.
+ now exists 0.
+ destruct IHp as (n,Hn). exists (S n). now rewrite inj_succ, Hn.
+Qed.
+
+(** [Pos.to_nat] is strictly positive *)
+
+Lemma is_pos p : 0 < to_nat p.
+Proof.
+ destruct (is_succ p) as (n,->). auto with arith.
+Qed.
+
+(** [Pos.to_nat] is a bijection between [positive] and
+    non-zero [nat], with [Pos.of_nat] as reciprocal.
+    See [Nat2Pos.id] below for the dual equation. *)
+
+Theorem id p : of_nat (to_nat p) = p.
+Proof.
+ induction p using peano_ind. trivial.
+ rewrite inj_succ. rewrite <- IHp at 2.
+ now destruct (is_succ p) as (n,->).
+Qed.
+
+(** [Pos.to_nat] is hence injective *)
+
+Lemma inj p q : to_nat p = to_nat q -> p = q.
+Proof.
+ intros H. now rewrite <- (id p), <- (id q), H.
+Qed.
+
+Lemma inj_iff p q : to_nat p = to_nat q <-> p = q.
+Proof.
+ split. apply inj. intros; now subst.
+Qed.
+
+(** [Pos.to_nat] is a morphism for comparison *)
+
+Lemma inj_compare p q : (p ?= q) = nat_compare (to_nat p) (to_nat q).
+Proof.
+ revert q. induction p as [ |p IH] using peano_ind; intros q.
+ destruct (succ_pred_or q) as [Hq|Hq]; [now subst|].
+ rewrite <- Hq, lt_1_succ, inj_succ, inj_1, nat_compare_S.
+ symmetry. apply nat_compare_lt, is_pos.
+ destruct (succ_pred_or q) as [Hq|Hq]; [subst|].
+ rewrite compare_antisym, lt_1_succ, inj_succ. simpl.
+ symmetry. apply nat_compare_gt, is_pos.
+ now rewrite <- Hq, 2 inj_succ, compare_succ_succ, IH.
+Qed.
+
+(** [Pos.to_nat] is a morphism for [lt], [le], etc *)
+
+Lemma inj_lt p q : (p < q)%positive <-> to_nat p < to_nat q.
+Proof.
+ unfold lt. now rewrite inj_compare, nat_compare_lt.
+Qed.
+
+Lemma inj_le p q : (p <= q)%positive <-> to_nat p <= to_nat q.
+Proof.
+ unfold le. now rewrite inj_compare, nat_compare_le.
+Qed.
+
+Lemma inj_gt p q : (p > q)%positive <-> to_nat p > to_nat q.
+Proof.
+ unfold gt. now rewrite inj_compare, nat_compare_gt.
+Qed.
+
+Lemma inj_ge p q : (p >= q)%positive <-> to_nat p >= to_nat q.
+Proof.
+ unfold ge. now rewrite inj_compare, nat_compare_ge.
+Qed.
+
+(** [Pos.to_nat] is a morphism for subtraction *)
+
+Theorem inj_sub p q : (q < p)%positive ->
+ to_nat (p - q) = to_nat p - to_nat q.
+Proof.
+ intro H; apply plus_reg_l with (to_nat q); rewrite le_plus_minus_r.
+ now rewrite <- inj_add, add_comm, sub_add.
+ now apply lt_le_weak, inj_lt.
+Qed.
+
+Theorem inj_sub_max p q :
+ to_nat (p - q) = Peano.max 1 (to_nat p - to_nat q).
+Proof.
+ destruct (ltb_spec q p).
+ rewrite <- inj_sub by trivial.
+ now destruct (is_succ (p - q)) as (m,->).
+ rewrite sub_le by trivial.
+ replace (to_nat p - to_nat q) with 0; trivial.
+ apply le_n_0_eq.
+ rewrite <- (minus_diag (to_nat p)).
+ now apply minus_le_compat_l, inj_le.
+Qed.
+
+Theorem inj_pred p : (1 < p)%positive ->
+ to_nat (pred p) = Peano.pred (to_nat p).
+Proof.
+ intros H. now rewrite <- Pos.sub_1_r, inj_sub, pred_of_minus.
+Qed.
+
+Theorem inj_pred_max p :
+ to_nat (pred p) = Peano.max 1 (Peano.pred (to_nat p)).
+Proof.
+ rewrite <- Pos.sub_1_r, pred_of_minus. apply inj_sub_max.
+Qed.
+
+(** [Pos.to_nat] and other operations *)
+
+Lemma inj_min p q :
+ to_nat (min p q) = Peano.min (to_nat p) (to_nat q).
+Proof.
+ unfold min. rewrite inj_compare.
+ case nat_compare_spec; intros H; symmetry.
+ apply Peano.min_l. now rewrite H.
+ now apply Peano.min_l, lt_le_weak.
+ now apply Peano.min_r, lt_le_weak.
+Qed.
+
+Lemma inj_max p q :
+ to_nat (max p q) = Peano.max (to_nat p) (to_nat q).
+Proof.
+ unfold max. rewrite inj_compare.
+ case nat_compare_spec; intros H; symmetry.
+ apply Peano.max_r. now rewrite H.
+ now apply Peano.max_r, lt_le_weak.
+ now apply Peano.max_l, lt_le_weak.
+Qed.
+
+Theorem inj_iter :
+  forall p {A} (f:A->A) (x:A),
+    Pos.iter p f x = nat_iter (to_nat p) f x.
+Proof.
+ induction p using peano_ind. trivial.
+ intros. rewrite inj_succ, iter_succ. simpl. now f_equal.
+Qed.
+
+End Pos2Nat.
+
+Module Nat2Pos.
+
+(** [Pos.of_nat] is a bijection between non-zero [nat] and
+    [positive], with [Pos.to_nat] as reciprocal.
+    See [Pos2Nat.id] above for the dual equation. *)
+
+Theorem id (n:nat) : n<>0 -> Pos.to_nat (Pos.of_nat n) = n.
+Proof.
+ induction n as [|n H]; trivial. now destruct 1.
+ intros _. simpl. destruct n. trivial.
+ rewrite Pos2Nat.inj_succ. f_equal. now apply H.
+Qed.
+
+Theorem id_max (n:nat) : Pos.to_nat (Pos.of_nat n) = max 1 n.
+Proof.
+ destruct n. trivial. now rewrite id.
+Qed.
+
+(** [Pos.of_nat] is hence injective for non-zero numbers *)
+
+Lemma inj (n m : nat) : n<>0 -> m<>0 -> Pos.of_nat n = Pos.of_nat m -> n = m.
+Proof.
+ intros Hn Hm H. now rewrite <- (id n), <- (id m), H.
+Qed.
+
+Lemma inj_iff (n m : nat) : n<>0 -> m<>0 ->
+ (Pos.of_nat n = Pos.of_nat m <-> n = m).
+Proof.
+ split. now apply inj. intros; now subst.
+Qed.
+
+(** Usual operations are morphisms with respect to [Pos.of_nat]
+    for non-zero numbers. *)
+
+Lemma inj_succ (n:nat) : n<>0 -> Pos.of_nat (S n) = Pos.succ (Pos.of_nat n).
+Proof.
+intro H. apply Pos2Nat.inj. now rewrite Pos2Nat.inj_succ, !id.
+Qed.
+
+Lemma inj_pred (n:nat) : Pos.of_nat (pred n) = Pos.pred (Pos.of_nat n).
+Proof.
+ destruct n as [|[|n]]; trivial. simpl. now rewrite Pos.pred_succ.
+Qed.
+
+Lemma inj_add (n m : nat) : n<>0 -> m<>0 ->
+ Pos.of_nat (n+m) = (Pos.of_nat n + Pos.of_nat m)%positive.
+Proof.
+intros Hn Hm. apply Pos2Nat.inj.
+rewrite Pos2Nat.inj_add, !id; trivial.
+intros H. destruct n. now destruct Hn. now simpl in H.
+Qed.
+
+Lemma inj_mul (n m : nat) : n<>0 -> m<>0 ->
+ Pos.of_nat (n*m) = (Pos.of_nat n * Pos.of_nat m)%positive.
+Proof.
+intros Hn Hm. apply Pos2Nat.inj.
+rewrite Pos2Nat.inj_mul, !id; trivial.
+intros H. apply mult_is_O in H. destruct H. now elim Hn. now elim Hm.
+Qed.
+
+Lemma inj_compare (n m : nat) : n<>0 -> m<>0 ->
+ nat_compare n m = (Pos.of_nat n ?= Pos.of_nat m).
+Proof.
+intros Hn Hm. rewrite Pos2Nat.inj_compare, !id; trivial.
+Qed.
+
+Lemma inj_sub (n m : nat) : m<>0 ->
+ Pos.of_nat (n-m) = (Pos.of_nat n - Pos.of_nat m)%positive.
+Proof.
+ intros Hm.
+ apply Pos2Nat.inj.
+ rewrite Pos2Nat.inj_sub_max.
+ rewrite (id m) by trivial. rewrite !id_max.
+ destruct n, m; trivial.
+Qed.
+
+Lemma inj_min (n m : nat) :
+ Pos.of_nat (min n m) = Pos.min (Pos.of_nat n) (Pos.of_nat m).
+Proof.
+ destruct n as [|n]. simpl. symmetry. apply Pos.min_l, Pos.le_1_l.
+ destruct m as [|m]. simpl. symmetry. apply Pos.min_r, Pos.le_1_l.
+ unfold Pos.min. rewrite <- inj_compare by easy.
+ case nat_compare_spec; intros H; f_equal; apply min_l || apply min_r.
+ rewrite H; auto. now apply lt_le_weak. now apply lt_le_weak.
+Qed.
+
+Lemma inj_max (n m : nat) :
+ Pos.of_nat (max n m) = Pos.max (Pos.of_nat n) (Pos.of_nat m).
+Proof.
+ destruct n as [|n]. simpl. symmetry. apply Pos.max_r, Pos.le_1_l.
+ destruct m as [|m]. simpl. symmetry. apply Pos.max_l, Pos.le_1_l.
+ unfold Pos.max. rewrite <- inj_compare by easy.
+ case nat_compare_spec; intros H; f_equal; apply max_l || apply max_r.
+ rewrite H; auto. now apply lt_le_weak. now apply lt_le_weak.
+Qed.
+
+End Nat2Pos.
+
+(**********************************************************************)
+(** Properties of the shifted injection from Peano natural numbers
+    to binary positive numbers *)
+
+Module Pos2SuccNat.
+
+(** Composition of [Pos.to_nat] and [Pos.of_succ_nat] is successor
+    on [positive] *)
+
+Theorem id_succ p : Pos.of_succ_nat (Pos.to_nat p) = Pos.succ p.
+Proof.
+rewrite Pos.of_nat_succ, <- Pos2Nat.inj_succ. apply Pos2Nat.id.
+Qed.
+
+(** Composition of [Pos.to_nat], [Pos.of_succ_nat] and [Pos.pred]
+    is identity on [positive] *)
+
+Theorem pred_id p : Pos.pred (Pos.of_succ_nat (Pos.to_nat p)) = p.
+Proof.
+now rewrite id_succ, Pos.pred_succ.
+Qed.
+
+End Pos2SuccNat.
+
+Module SuccNat2Pos.
+
+(** Composition of [Pos.of_succ_nat] and [Pos.to_nat] is successor on [nat] *)
+
+Theorem id_succ (n:nat) : Pos.to_nat (Pos.of_succ_nat n) = S n.
+Proof.
+rewrite Pos.of_nat_succ. now apply Nat2Pos.id.
+Qed.
+
+Theorem pred_id (n:nat) : pred (Pos.to_nat (Pos.of_succ_nat n)) = n.
+Proof.
+now rewrite id_succ.
+Qed.
+
+(** [Pos.of_succ_nat] is hence injective *)
+
+Lemma inj (n m : nat) : Pos.of_succ_nat n = Pos.of_succ_nat m -> n = m.
+Proof.
+ intro H. apply (f_equal Pos.to_nat) in H. rewrite !id_succ in H.
+ now injection H.
+Qed.
+
+Lemma inj_iff (n m : nat) : Pos.of_succ_nat n = Pos.of_succ_nat m <-> n = m.
+Proof.
+ split. apply inj. intros; now subst.
+Qed.
+
+(** Another formulation *)
+
+Theorem inv n p : Pos.to_nat p = S n -> Pos.of_succ_nat n = p.
+Proof.
+ intros H. apply Pos2Nat.inj. now rewrite id_succ.
+Qed.
+
+(** Successor and comparison are morphisms with respect to
+    [Pos.of_succ_nat] *)
+
+Lemma inj_succ n : Pos.of_succ_nat (S n) = Pos.succ (Pos.of_succ_nat n).
+Proof.
+apply Pos2Nat.inj. now rewrite Pos2Nat.inj_succ, !id_succ.
+Qed.
+
+Lemma inj_compare n m :
+ nat_compare n m = (Pos.of_succ_nat n ?= Pos.of_succ_nat m).
+Proof.
+rewrite Pos2Nat.inj_compare, !id_succ; trivial.
+Qed.
+
+(** Other operations, for instance [Pos.add] and [plus] aren't
+    directly related this way (we would need to compensate for
+    the successor hidden in [Pos.of_succ_nat] *)
+
+End SuccNat2Pos.
+
+(** For compatibility, old names and old-style lemmas *)
+
+Notation Psucc_S := Pos2Nat.inj_succ (compat "8.3").
+Notation Pplus_plus := Pos2Nat.inj_add (compat "8.3").
+Notation Pmult_mult := Pos2Nat.inj_mul (compat "8.3").
+Notation Pcompare_nat_compare := Pos2Nat.inj_compare (compat "8.3").
+Notation nat_of_P_xH := Pos2Nat.inj_1 (compat "8.3").
+Notation nat_of_P_xO := Pos2Nat.inj_xO (compat "8.3").
+Notation nat_of_P_xI := Pos2Nat.inj_xI (compat "8.3").
+Notation nat_of_P_is_S := Pos2Nat.is_succ (compat "8.3").
+Notation nat_of_P_pos := Pos2Nat.is_pos (compat "8.3").
+Notation nat_of_P_inj_iff := Pos2Nat.inj_iff (compat "8.3").
+Notation nat_of_P_inj := Pos2Nat.inj (compat "8.3").
+Notation Plt_lt := Pos2Nat.inj_lt (compat "8.3").
+Notation Pgt_gt := Pos2Nat.inj_gt (compat "8.3").
+Notation Ple_le := Pos2Nat.inj_le (compat "8.3").
+Notation Pge_ge := Pos2Nat.inj_ge (compat "8.3").
+Notation Pminus_minus := Pos2Nat.inj_sub (compat "8.3").
+Notation iter_nat_of_P := @Pos2Nat.inj_iter (compat "8.3").
+
+Notation nat_of_P_of_succ_nat := SuccNat2Pos.id_succ (compat "8.3").
+Notation P_of_succ_nat_of_P := Pos2SuccNat.id_succ (compat "8.3").
+
+Notation nat_of_P_succ_morphism := Pos2Nat.inj_succ (compat "8.3").
+Notation nat_of_P_plus_morphism := Pos2Nat.inj_add (compat "8.3").
+Notation nat_of_P_mult_morphism := Pos2Nat.inj_mul (compat "8.3").
+Notation nat_of_P_compare_morphism := Pos2Nat.inj_compare (compat "8.3").
+Notation lt_O_nat_of_P := Pos2Nat.is_pos (compat "8.3").
+Notation ZL4 := Pos2Nat.is_succ (compat "8.3").
+Notation nat_of_P_o_P_of_succ_nat_eq_succ := SuccNat2Pos.id_succ (compat "8.3").
+Notation P_of_succ_nat_o_nat_of_P_eq_succ := Pos2SuccNat.id_succ (compat "8.3").
+Notation pred_o_P_of_succ_nat_o_nat_of_P_eq_id := Pos2SuccNat.pred_id (compat "8.3").
+
+Lemma nat_of_P_minus_morphism p q :
+ Pos.compare_cont p q Eq = Gt ->
+  Pos.to_nat (p - q) = Pos.to_nat p - Pos.to_nat q.
+Proof (fun H => Pos2Nat.inj_sub p q (Pos.gt_lt _ _ H)).
+
+Lemma nat_of_P_lt_Lt_compare_morphism p q :
+ Pos.compare_cont p q Eq = Lt -> Pos.to_nat p < Pos.to_nat q.
+Proof (proj1 (Pos2Nat.inj_lt p q)).
+
+Lemma nat_of_P_gt_Gt_compare_morphism p q :
+ Pos.compare_cont p q Eq = Gt -> Pos.to_nat p > Pos.to_nat q.
+Proof (proj1 (Pos2Nat.inj_gt p q)).
+
+Lemma nat_of_P_lt_Lt_compare_complement_morphism p q :
+ Pos.to_nat p < Pos.to_nat q -> Pos.compare_cont p q Eq = Lt.
+Proof (proj2 (Pos2Nat.inj_lt p q)).
+
+Definition nat_of_P_gt_Gt_compare_complement_morphism p q :
+ Pos.to_nat p > Pos.to_nat q -> Pos.compare_cont p q Eq = Gt.
+Proof (proj2 (Pos2Nat.inj_gt p q)).
+
+(** Old intermediate results about [Pmult_nat] *)
+
+Section ObsoletePmultNat.
+
+Lemma Pmult_nat_mult : forall p n,
+ Pmult_nat p n = Pos.to_nat p * n.
+Proof.
+ induction p; intros n; unfold Pos.to_nat; simpl.
+ f_equal. rewrite 2 IHp. rewrite <- mult_assoc.
+  f_equal. simpl. now rewrite <- plus_n_O.
+ rewrite 2 IHp. rewrite <- mult_assoc.
+  f_equal. simpl. now rewrite <- plus_n_O.
+ simpl. now rewrite <- plus_n_O.
+Qed.
+
+Lemma Pmult_nat_succ_morphism :
+ forall p n, Pmult_nat (Pos.succ p) n = n + Pmult_nat p n.
+Proof.
+ intros. now rewrite !Pmult_nat_mult, Pos2Nat.inj_succ.
+Qed.
+
+Theorem Pmult_nat_l_plus_morphism :
+ forall p q n, Pmult_nat (p + q) n = Pmult_nat p n + Pmult_nat q n.
+Proof.
+ intros. rewrite !Pmult_nat_mult, Pos2Nat.inj_add. apply mult_plus_distr_r.
+Qed.
+
+Theorem Pmult_nat_plus_carry_morphism :
+ forall p q n, Pmult_nat (Pos.add_carry p q) n = n + Pmult_nat (p + q) n.
+Proof.
+ intros. now rewrite Pos.add_carry_spec, Pmult_nat_succ_morphism.
+Qed.
+
+Lemma Pmult_nat_r_plus_morphism :
+ forall p n, Pmult_nat p (n + n) = Pmult_nat p n + Pmult_nat p n.
+Proof.
+ intros. rewrite !Pmult_nat_mult. apply mult_plus_distr_l.
+Qed.
+
+Lemma ZL6 : forall p, Pmult_nat p 2 = Pos.to_nat p + Pos.to_nat p.
+Proof.
+ intros. rewrite Pmult_nat_mult, mult_comm. simpl. now rewrite <- plus_n_O.
+Qed.
+
+Lemma le_Pmult_nat : forall p n, n <= Pmult_nat p n.
+Proof.
+ intros. rewrite Pmult_nat_mult.
+ apply le_trans with (1*n). now rewrite mult_1_l.
+ apply mult_le_compat_r. apply Pos2Nat.is_pos.
+Qed.
+
+End ObsoletePmultNat.
diff --git a/theories/PArith/intro.tex b/theories/PArith/intro.tex
new file mode 100644
index 00000000..ffce881e
--- /dev/null
+++ b/theories/PArith/intro.tex
@@ -0,0 +1,4 @@
+\section{Binary positive integers : PArith}\label{PArith}
+
+Here are defined various arithmetical notions and their properties,
+similar to those of {\tt Arith}.
diff --git a/theories/PArith/vo.itarget b/theories/PArith/vo.itarget
new file mode 100644
index 00000000..73044e2c
--- /dev/null
+++ b/theories/PArith/vo.itarget
@@ -0,0 +1,5 @@
+BinPosDef.vo
+BinPos.vo
+Pnat.vo
+POrderedType.vo
+PArith.vo
\ No newline at end of file
diff --git a/theories/Program/Basics.v b/theories/Program/Basics.v
index 37c4d94d..22436de6 100644
--- a/theories/Program/Basics.v
+++ b/theories/Program/Basics.v
@@ -1,13 +1,11 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(* $Id: Basics.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Standard functions and combinators.
 
    Proofs about them require functional extensionality and can be found
@@ -19,7 +17,7 @@
 
 (** The polymorphic identity function is defined in [Datatypes]. *)
 
-Implicit Arguments id [[A]].
+Arguments id {A} x.
 
 (** Function composition. *)
 
@@ -31,7 +29,7 @@ Hint Unfold compose.
 Notation " g ∘ f " := (compose g f)
   (at level 40, left associativity) : program_scope.
 
-Open Local Scope program_scope.
+Local Open Scope program_scope.
 
 (** The non-dependent function space between [A] and [B]. *)
 
@@ -55,5 +53,5 @@ Definition apply {A B} (f : A -> B) (x : A) := f x.
 
 (** Curryfication of [prod] is defined in [Logic.Datatypes]. *)
 
-Implicit Arguments prod_curry [[A] [B] [C]].
-Implicit Arguments prod_uncurry [[A] [B] [C]].
+Arguments prod_curry   {A B C} f p.
+Arguments prod_uncurry {A B C} f x y.
diff --git a/theories/Program/Combinators.v b/theories/Program/Combinators.v
index f446b455..dcf09251 100644
--- a/theories/Program/Combinators.v
+++ b/theories/Program/Combinators.v
@@ -1,13 +1,11 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(* $Id: Combinators.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** * Proofs about standard combinators, exports functional extensionality.
 
    Author: Matthieu Sozeau
diff --git a/theories/Program/Equality.v b/theories/Program/Equality.v
index f63aad43..323e80cc 100644
--- a/theories/Program/Equality.v
+++ b/theories/Program/Equality.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Equality.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Tactics related to (dependent) equality and proof irrelevance. *)
 
 Require Export ProofIrrelevance.
@@ -15,9 +13,6 @@ Require Export JMeq.
 
 Require Import Coq.Program.Tactics.
 
-Local Notation "'Π'  x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity) : type_scope.
-
 Ltac is_ground_goal := 
   match goal with
     |- ?T => is_ground T
@@ -33,18 +28,12 @@ Hint Extern 10 => is_ground_goal ; progress exfalso : exfalso.
 Definition block {A : Type} (a : A) := a.
 
 Ltac block_goal := match goal with [ |- ?T ] => change (block T) end.
-Ltac unblock_goal := unfold block at 1.
-Ltac unblock_all := unfold block in *.
+Ltac unblock_goal := unfold block in *.
 
 (** Notation for heterogenous equality. *)
 
 Notation " x ~= y " := (@JMeq _ x _ y) (at level 70, no associativity).
 
-(** Notation for the single element of [x = x] and [x ~= x]. *)
-
-Implicit Arguments eq_refl [[A] [x]] [A].
-Implicit Arguments JMeq_refl [[A] [x]] [A].
-
 (** Do something on an heterogeneous equality appearing in the context. *)
 
 Ltac on_JMeq tac :=
@@ -177,15 +166,15 @@ Hint Rewrite <- eq_rect_eq : refl_id.
    [coerce_* t eq_refl = t]. *)
 
 Lemma JMeq_eq_refl {A} (x : A) : JMeq_eq (@JMeq_refl _ x) = eq_refl.
-Proof. intros. apply proof_irrelevance. Qed.
+Proof. apply proof_irrelevance. Qed.
 
-Lemma UIP_refl_refl : Π A (x : A),
+Lemma UIP_refl_refl A (x : A) :
   Eqdep.EqdepTheory.UIP_refl A x eq_refl = eq_refl.
-Proof. intros. apply UIP_refl. Qed.
+Proof. apply UIP_refl. Qed.
 
-Lemma inj_pairT2_refl : Π A (x : A) (P : A -> Type) (p : P x),
+Lemma inj_pairT2_refl A (x : A) (P : A -> Type) (p : P x) :
   Eqdep.EqdepTheory.inj_pairT2 A P x p p eq_refl = eq_refl.
-Proof. intros. apply UIP_refl. Qed.
+Proof. apply UIP_refl. Qed.
 
 Hint Rewrite @JMeq_eq_refl @UIP_refl_refl @inj_pairT2_refl : refl_id.
 
@@ -225,7 +214,8 @@ Ltac simplify_eqs :=
 
 Ltac simplify_IH_hyps := repeat
   match goal with
-    | [ hyp : context [ block _ ] |- _ ] => specialize_eqs hyp ; unfold block in hyp
+    | [ hyp : context [ block _ ] |- _ ] => 
+      specialize_eqs hyp
   end.
 
 (** We split substitution tactics in the two directions depending on which 
@@ -285,27 +275,33 @@ Ltac elim_ind p := elim_tac ltac:(fun p el => induction p using el) p.
 
 (** Lemmas used by the simplifier, mainly rephrasings of [eq_rect], [eq_ind]. *)
 
-Lemma solution_left : Π A (B : A -> Type) (t : A), B t -> (Π x, x = t -> B x).
-Proof. intros; subst. apply X. Defined.
+Lemma solution_left A (B : A -> Type) (t : A) :
+  B t -> (forall x, x = t -> B x).
+Proof. intros; subst; assumption. Defined.
 
-Lemma solution_right : Π A (B : A -> Type) (t : A), B t -> (Π x, t = x -> B x).
-Proof. intros; subst; apply X. Defined.
+Lemma solution_right A (B : A -> Type) (t : A) :
+  B t -> (forall x, t = x -> B x).
+Proof. intros; subst; assumption. Defined.
 
-Lemma deletion : Π A B (t : A), B -> (t = t -> B).
+Lemma deletion A B (t : A) : B -> (t = t -> B).
 Proof. intros; assumption. Defined.
 
-Lemma simplification_heq : Π A B (x y : A), (x = y -> B) -> (JMeq x y -> B).
-Proof. intros; apply X; apply (JMeq_eq H). Defined.
+Lemma simplification_heq A B (x y : A) :
+  (x = y -> B) -> (JMeq x y -> B).
+Proof. intros H J; apply H; apply (JMeq_eq J). Defined.
 
-Lemma simplification_existT2 : Π A (P : A -> Type) B (p : A) (x y : P p),
-  (x = y -> B) -> (existT P p x = existT P p y -> B).
-Proof. intros. apply X. apply inj_pair2. exact H. Defined.
+Definition conditional_eq {A} (x y : A) := eq x y.
 
-Lemma simplification_existT1 : Π A (P : A -> Type) B (p q : A) (x : P p) (y : P q),
-  (p = q -> existT P p x = existT P q y -> B) -> (existT P p x = existT P q y -> B).
-Proof. intros. injection H. intros ; auto. Defined.
-  
-Lemma simplification_K : Π A (x : A) (B : x = x -> Type), B eq_refl -> (Π p : x = x, B p).
+Lemma simplification_existT2 A (P : A -> Type) B (p : A) (x y : P p) :
+  (x = y -> B) -> (conditional_eq (existT P p x) (existT P p y) -> B).
+Proof. intros H E. apply H. apply inj_pair2. assumption. Defined.
+
+Lemma simplification_existT1 A (P : A -> Type) B (p q : A) (x : P p) (y : P q) :
+  (p = q -> conditional_eq (existT P p x) (existT P q y) -> B) -> (existT P p x = existT P q y -> B).
+Proof. injection 2. auto. Defined.
+
+Lemma simplification_K A (x : A) (B : x = x -> Type) :
+  B eq_refl -> (forall p : x = x, B p).
 Proof. intros. rewrite (UIP_refl A). assumption. Defined.
 
 (** This hint database and the following tactic can be used with [autounfold] to 
@@ -320,35 +316,22 @@ Hint Unfold solution_left solution_right deletion simplification_heq
    constructor forms). Compare with the lemma 16 of the paper.
    We don't have a [noCycle] procedure yet. *)
 
-Ltac block_equality id :=
-  match type of id with
-    | @eq ?A ?t ?u => change (block (@eq A t u)) in id
-    | _ => idtac
-  end.
-
-Ltac revert_blocking_until id := 
-  Tactics.on_last_hyp ltac:(fun id' =>
-    match id' with
-      | id => idtac
-      | _ => block_equality id' ; revert id' ; revert_blocking_until id
-    end).
-
 Ltac simplify_one_dep_elim_term c :=
   match c with
     | @JMeq _ _ _ _ -> _ => refine (simplification_heq _ _ _ _ _)
     | ?t = ?t -> _ => intros _ || refine (simplification_K _ t _ _)
-    | eq (existT _ ?p _) (existT _ ?q _) -> _ =>
-      refine (simplification_existT2 _ _ _ _ _ _ _) ||
-        match goal with
-          | H : p = q |- _ => intro
-          | _ => refine (simplification_existT1 _ _ _ _ _ _ _ _)
-        end
+    | eq (existT _ _ _) (existT _ _ _) -> _ =>
+        refine (simplification_existT1 _ _ _ _ _ _ _ _)
+    | conditional_eq (existT _ _ _) (existT _ _ _) -> _ =>
+        refine (simplification_existT2 _ _ _ _ _ _ _) ||
+               (unfold conditional_eq; intro)
     | ?x = ?y -> _ => (* variables case *)
+      (unfold x) || (unfold y) ||
       (let hyp := fresh in intros hyp ;
-        move hyp before x ; revert_blocking_until hyp ; generalize dependent x ;
+        move hyp before x ; revert_until hyp ; generalize dependent x ;
           refine (solution_left _ _ _ _)(*  ; intros until 0 *)) ||
       (let hyp := fresh in intros hyp ;
-        move hyp before y ; revert_blocking_until hyp ; generalize dependent y ;
+        move hyp before y ; revert_until hyp ; generalize dependent y ;
           refine (solution_right _ _ _ _)(*  ; intros until 0 *))
     | ?f ?x = ?g ?y -> _ => let H := fresh in progress (intros H ; injection H ; clear H)
     | ?t = ?u -> _ => let hyp := fresh in
@@ -399,25 +382,34 @@ Ltac is_introduced H :=
   end.
 
 Tactic Notation "intro_block" hyp(H) :=
-  (is_introduced H ; block_goal ; revert_until H) ||
+  (is_introduced H ; block_goal ; revert_until H ; block_goal) ||
     (let H' := fresh H in intros until H' ; block_goal) || (intros ; block_goal).
 
 Tactic Notation "intro_block_id" ident(H) :=
-  (is_introduced H ; block_goal ; revert_until H) ||
+  (is_introduced H ; block_goal ; revert_until H; block_goal) ||
     (let H' := fresh H in intros until H' ; block_goal) || (intros ; block_goal).
 
-Ltac simpl_dep_elim := simplify_dep_elim ; simplify_IH_hyps ; unblock_all.
+Ltac unblock_dep_elim :=
+  match goal with
+    | |- block ?T => 
+      match T with context [ block _ ] => 
+        change T ; intros ; unblock_goal
+      end
+    | _ => unblock_goal
+  end.
+
+Ltac simpl_dep_elim := simplify_dep_elim ; simplify_IH_hyps ; unblock_dep_elim.
 
 Ltac do_intros H :=
   (try intros until H) ; (intro_block_id H || intro_block H).
 
-Ltac do_depelim_nosimpl tac H := do_intros H ; generalize_eqs H ; block_goal ; tac H ; unblock_goal.
+Ltac do_depelim_nosimpl tac H := do_intros H ; generalize_eqs H ; tac H.
 
 Ltac do_depelim tac H := do_depelim_nosimpl tac H ; simpl_dep_elim.
 
 Ltac do_depind tac H := 
-  do_intros H ; generalize_eqs_vars H ; block_goal ; tac H ; 
-  unblock_goal ; simplify_dep_elim ; simplify_IH_hyps ; unblock_all.
+  (try intros until H) ; intro_block H ;
+  generalize_eqs_vars H ; tac H ; simpl_dep_elim.
 
 (** To dependent elimination on some hyp. *)
 
@@ -433,26 +425,26 @@ Ltac depind id := do_depind ltac:(fun hyp => do_ind hyp) id.
 
 (** A variant where generalized variables should be given by the user. *)
 
-Ltac do_depelim' tac H :=
-  (try intros until H) ; block_goal ; generalize_eqs H ; block_goal ; tac H ; unblock_goal ;
-    simplify_dep_elim ; simplify_IH_hyps ; unblock_all.
+Ltac do_depelim' rev tac H :=
+  (try intros until H) ; block_goal ; rev H ;
+  (try revert_until H ; block_goal) ; generalize_eqs H ; tac H ; simpl_dep_elim.
 
 (** Calls [destruct] on the generalized hypothesis, results should be similar to inversion.
    By default, we don't try to generalize the hyp by its variable indices.  *)
 
 Tactic Notation "dependent" "destruction" ident(H) := 
-  do_depelim' ltac:(fun hyp => do_case hyp) H.
+  do_depelim' ltac:(fun hyp => idtac) ltac:(fun hyp => do_case hyp) H.
 
 Tactic Notation "dependent" "destruction" ident(H) "using" constr(c) := 
-  do_depelim' ltac:(fun hyp => destruct hyp using c) H.
+  do_depelim' ltac:(fun hyp => idtac) ltac:(fun hyp => destruct hyp using c) H.
 
 (** This tactic also generalizes the goal by the given variables before the elimination. *)
 
 Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) := 
-  do_depelim' ltac:(fun hyp => revert l ; do_case hyp) H.
+  do_depelim' ltac:(fun hyp => revert l) ltac:(fun hyp => do_case hyp) H.
 
 Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := 
-  do_depelim' ltac:(fun hyp => revert l ; destruct hyp using c) H.
+  do_depelim' ltac:(fun hyp => revert l) ltac:(fun hyp => destruct hyp using c) H.
 
 (** Then we have wrappers for usual calls to induction. One can customize the induction tactic by 
    writting another wrapper calling do_depelim. We suppose the hyp has to be generalized before
@@ -467,7 +459,7 @@ Tactic Notation "dependent" "induction" ident(H) "using" constr(c) :=
 (** This tactic also generalizes the goal by the given variables before the induction. *)
 
 Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) := 
-  do_depelim' ltac:(fun hyp => generalize l ; clear l ; do_ind hyp) H.
+  do_depelim' ltac:(fun hyp => revert l) ltac:(fun hyp => do_ind hyp) H.
 
 Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := 
-  do_depelim' ltac:(fun hyp => generalize l ; clear l ; induction hyp using c) H.
+  do_depelim' ltac:(fun hyp => revert l) ltac:(fun hyp => induction hyp using c) H.
diff --git a/theories/Program/Program.v b/theories/Program/Program.v
index 2b6dd864..be8d9a47 100644
--- a/theories/Program/Program.v
+++ b/theories/Program/Program.v
@@ -1,16 +1,14 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(* $Id: Program.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Export Coq.Program.Utils.
 Require Export Coq.Program.Wf.
 Require Export Coq.Program.Equality.
 Require Export Coq.Program.Subset.
 Require Export Coq.Program.Basics.
 Require Export Coq.Program.Combinators.
-Require Export Coq.Program.Syntax.
\ No newline at end of file
+Require Export Coq.Program.Syntax.
diff --git a/theories/Program/Subset.v b/theories/Program/Subset.v
index d0a76d3f..34c27ed8 100644
--- a/theories/Program/Subset.v
+++ b/theories/Program/Subset.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(* $Id: Subset.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Tactics related to subsets and proof irrelevance. *)
 
 Require Import Coq.Program.Utils.
 Require Import Coq.Program.Equality.
 
-Open Local Scope program_scope.
+Local Open Scope program_scope.
 
 (** The following tactics implement a poor-man's solution for proof-irrelevance: it tries to
    factorize every proof of the same proposition in a goal so that equality of such proofs becomes trivial. *)
@@ -108,7 +106,7 @@ Ltac rewrite_match_eq H :=
     [ |- ?T ] =>
     match T with
       context [ match_eq ?A ?B ?t ?f ] =>
-      rewrite (match_eq_rewrite A B t f (exist _ _ (sym_eq H)))
+      rewrite (match_eq_rewrite A B t f (exist _ _ (eq_sym H)))
     end
   end.
 
diff --git a/theories/Program/Syntax.v b/theories/Program/Syntax.v
index 582bc461..a2948074 100644
--- a/theories/Program/Syntax.v
+++ b/theories/Program/Syntax.v
@@ -1,12 +1,10 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(* $Id: Syntax.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Custom notations and implicits for Coq prelude definitions.
 
    Author: Matthieu Sozeau
@@ -20,48 +18,23 @@ Notation " () " := tt.
 
 (** Set maximally inserted implicit arguments for standard definitions. *)
 
-Implicit Arguments Some [[A]].
-Implicit Arguments None [[A]].
-
-Implicit Arguments inl [[A] [B]] [A].
-Implicit Arguments inr [[A] [B]] [B].
-
-Implicit Arguments left [[A] [B]] [A].
-Implicit Arguments right [[A] [B]] [B].
-
-Implicit Arguments pair [[A] [B]].
-Implicit Arguments fst [[A] [B]].
-Implicit Arguments snd [[A] [B]].
-
-Require Import Coq.Lists.List.
+Arguments Some {A} _.
+Arguments None {A}.
 
-Implicit Arguments nil [[A]].
-Implicit Arguments cons [[A]].
+Arguments pair {A B} _ _.
+Arguments fst {A B} _.
+Arguments snd {A B} _.
 
-(** Standard notations for lists. *)
+Arguments nil {A}.
+Arguments cons {A} _ _.
 
-Notation " [ ] " := nil : list_scope.
-Notation " [ x ] " := (cons x nil) : list_scope.
-Notation " [ x ; .. ; y ] " := (cons x .. (cons y nil) ..) : list_scope.
-
-(** Implicit arguments for vectors. *)
+Require List.
+Export List.ListNotations.
 
 Require Import Bvector.
 
-Implicit Arguments Vnil [[A]] [].
-Implicit Arguments Vcons [[A] [n]] [].
-
 (** Treating n-ary exists *)
 
-Notation " 'exists' x y , p" := (ex (fun x => (ex (fun y => p))))
-  (at level 200, x ident, y ident, right associativity) : type_scope.
-
-Notation " 'exists' x y z , p" := (ex (fun x => (ex (fun y => (ex (fun z => p))))))
-  (at level 200, x ident, y ident, z ident, right associativity) : type_scope.
-
-Notation " 'exists' x y z w , p" := (ex (fun x => (ex (fun y => (ex (fun z => (ex (fun w => p))))))))
-  (at level 200, x ident, y ident, z ident, w ident, right associativity) : type_scope.
-
 Tactic Notation "exists" constr(x) := exists x.
 Tactic Notation "exists" constr(x) constr(y) := exists x ; exists y.
 Tactic Notation "exists" constr(x) constr(y) constr(z) := exists x ; exists y ; exists z.
diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v
index f62ff703..9aba9f53 100644
--- a/theories/Program/Tactics.v
+++ b/theories/Program/Tactics.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Tactics.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This module implements various tactics used to simplify the goals produced by Program,
    which are also generally useful. *)
 
@@ -61,12 +59,20 @@ Ltac destruct_pairs := repeat (destruct_one_pair).
 
 Ltac destruct_one_ex :=
   let tac H := let ph := fresh "H" in (destruct H as [H ph]) in
+  let tac2 H := let ph := fresh "H" in let ph' := fresh "H" in 
+    (destruct H as [H ph ph']) 
+  in
   let tacT H := let ph := fresh "X" in (destruct H as [H ph]) in
+  let tacT2 H := let ph := fresh "X" in let ph' := fresh "X" in 
+    (destruct H as [H ph ph']) 
+  in
     match goal with
       | [H : (ex _) |- _] => tac H
       | [H : (sig ?P) |- _ ] => tac H
       | [H : (sigT ?P) |- _ ] => tacT H
-      | [H : (ex2 _) |- _] => tac H
+      | [H : (ex2 _ _) |- _] => tac2 H
+      | [H : (sig2 ?P _) |- _ ] => tac2 H
+      | [H : (sigT2 ?P _) |- _ ] => tacT2 H
     end.
 
 (** Repeateadly destruct existentials. *)
@@ -304,18 +310,22 @@ Ltac refine_hyp c :=
    possibly using [program_simplify] to use standard goal-cleaning tactics. *)
 
 Ltac program_simplify :=
-  simpl in |- *; intros ; destruct_all_rec_calls ; repeat (destruct_conjs; simpl proj1_sig in *);
+simpl; intros ; destruct_all_rec_calls ; repeat (destruct_conjs; simpl proj1_sig in * );
   subst*; autoinjections ; try discriminates ;
     try (solve [ red ; intros ; destruct_conjs ; autoinjections ; discriminates ]).
 
-(** We only try to solve proposition goals automatically. *)
+(** Restrict automation to propositional obligations. *)
 
-Ltac program_solve :=
+Ltac program_solve_wf :=
   match goal with
     | |- well_founded _ => auto with *
     | |- ?T => match type of T with Prop => auto end
   end.
 
-Ltac program_simpl := program_simplify ; try program_solve.
+Create HintDb program discriminated.
+
+Ltac program_simpl := program_simplify ; try typeclasses eauto with program ; try program_solve_wf.
 
 Obligation Tactic := program_simpl.
+
+Definition obligation (A : Type) {a : A} := a.
\ No newline at end of file
diff --git a/theories/Program/Utils.v b/theories/Program/Utils.v
index 1e57a74b..94e88d57 100644
--- a/theories/Program/Utils.v
+++ b/theories/Program/Utils.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Utils.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Various syntaxic shortands that are useful with [Program]. *)
 
 Require Export Coq.Program.Tactics.
diff --git a/theories/Program/Wf.v b/theories/Program/Wf.v
index 3afaf5e8..6a030c7f 100644
--- a/theories/Program/Wf.v
+++ b/theories/Program/Wf.v
@@ -1,12 +1,10 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(* $Id: Wf.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Reformulation of the Wf module using subsets where possible, providing
    the support for [Program]'s treatment of well-founded definitions. *)
 
@@ -14,7 +12,7 @@ Require Import Coq.Init.Wf.
 Require Import Coq.Program.Utils.
 Require Import ProofIrrelevance.
 
-Open Local Scope program_scope.
+Local Open Scope program_scope.
 
 Section Well_founded.
   Variable A : Type.
@@ -54,7 +52,7 @@ Section Well_founded.
 
   Lemma Fix_eq : forall x:A, Fix_sub x = F_sub x (fun (y:A|R y x) => Fix_sub (proj1_sig y)).
   Proof.
-    intro x; unfold Fix_sub in |- *.
+    intro x; unfold Fix_sub.
     rewrite <- (Fix_F_eq ).
     apply F_ext; intros.
     apply Fix_F_inv.
diff --git a/theories/QArith/QArith.v b/theories/QArith/QArith.v
index 2255cd41..5d36ff12 100644
--- a/theories/QArith/QArith.v
+++ b/theories/QArith/QArith.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: QArith.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export QArith_base.
 Require Export Qring.
 Require Export Qreduction.
diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v
index 18b8823d..cf5bb3f2 100644
--- a/theories/QArith/QArith_base.v
+++ b/theories/QArith/QArith_base.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: QArith_base.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export ZArith.
 Require Export ZArithRing.
 Require Export Morphisms Setoid Bool.
@@ -20,16 +18,16 @@ Record Q : Set := Qmake {Qnum : Z; Qden : positive}.
 
 Delimit Scope Q_scope with Q.
 Bind Scope Q_scope with Q.
-Arguments Scope Qmake [Z_scope positive_scope].
+Arguments Qmake _%Z _%positive.
 Open Scope Q_scope.
-Ltac simpl_mult := repeat rewrite Zpos_mult_morphism.
+Ltac simpl_mult := rewrite ?Pos2Z.inj_mul.
 
 (** [a#b] denotes the fraction [a] over [b]. *)
 
 Notation "a # b" := (Qmake a b) (at level 55, no associativity) : Q_scope.
 
 Definition inject_Z (x : Z) := Qmake x 1.
-Arguments Scope inject_Z [Z_scope].
+Arguments inject_Z x%Z.
 
 Notation QDen p := (Zpos (Qden p)).
 Notation " 0 " := (0#1) : Q_scope.
@@ -48,84 +46,77 @@ Notation "x > y" := (Qlt y x)(only parsing) : Q_scope.
 Notation "x >= y" := (Qle y x)(only parsing) : Q_scope.
 Notation "x <= y <= z" := (x<=y/\y<=z) : Q_scope.
 
+(** injection from Z is injective. *)
+
+Lemma inject_Z_injective (a b: Z): inject_Z a == inject_Z b <-> a = b.
+Proof.
+ unfold Qeq. simpl. omega.
+Qed.
+
 (** Another approach : using Qcompare for defining order relations. *)
 
 Definition Qcompare (p q : Q) := (Qnum p * QDen q ?= Qnum q * QDen p)%Z.
 Notation "p ?= q" := (Qcompare p q) : Q_scope.
 
-Lemma Qeq_alt : forall p q, (p == q) <-> (p ?= q) = Eq.
+Lemma Qeq_alt p q : (p == q) <-> (p ?= q) = Eq.
 Proof.
-unfold Qeq, Qcompare; intros; split; intros.
-rewrite H; apply Zcompare_refl.
-apply Zcompare_Eq_eq; auto.
+symmetry. apply Z.compare_eq_iff.
 Qed.
 
-Lemma Qlt_alt : forall p q, (p<q) <-> (p?=q = Lt).
+Lemma Qlt_alt p q : (p<q) <-> (p?=q = Lt).
 Proof.
-unfold Qlt, Qcompare, Zlt; split; auto.
+reflexivity.
 Qed.
 
-Lemma Qgt_alt : forall p q, (p>q) <-> (p?=q = Gt).
+Lemma Qgt_alt p q : (p>q) <-> (p?=q = Gt).
 Proof.
-unfold Qlt, Qcompare, Zlt.
-intros; rewrite Zcompare_Gt_Lt_antisym; split; auto.
+symmetry. apply Z.gt_lt_iff.
 Qed.
 
-Lemma Qle_alt : forall p q, (p<=q) <-> (p?=q <> Gt).
+Lemma Qle_alt p q : (p<=q) <-> (p?=q <> Gt).
 Proof.
-unfold Qle, Qcompare, Zle; split; auto.
+reflexivity.
 Qed.
 
-Lemma Qge_alt : forall p q, (p>=q) <-> (p?=q <> Lt).
+Lemma Qge_alt p q : (p>=q) <-> (p?=q <> Lt).
 Proof.
-unfold Qle, Qcompare, Zle.
-split; intros; contradict H.
-rewrite Zcompare_Gt_Lt_antisym; auto.
-rewrite Zcompare_Gt_Lt_antisym in H; auto.
+symmetry. apply Z.ge_le_iff.
 Qed.
 
 Hint Unfold Qeq Qlt Qle : qarith.
 Hint Extern 5 (?X1 <> ?X2) => intro; discriminate: qarith.
 
-Lemma Qcompare_antisym : forall x y, CompOpp (x ?= y) = (y ?= x).
+Lemma Qcompare_antisym x y : CompOpp (x ?= y) = (y ?= x).
 Proof.
- unfold "?=". intros. apply Zcompare_antisym.
+ symmetry. apply Z.compare_antisym.
 Qed.
 
-Lemma Qcompare_spec : forall x y, CompSpec Qeq Qlt x y (x ?= y).
+Lemma Qcompare_spec x y : CompareSpec (x==y) (x<y) (y<x) (x ?= y).
 Proof.
- intros.
- destruct (x ?= y) as [ ]_eqn:H; constructor; auto.
- rewrite Qeq_alt; auto.
- rewrite Qlt_alt, <- Qcompare_antisym, H; auto.
+ unfold Qeq, Qlt, Qcompare. case Z.compare_spec; now constructor.
 Qed.
 
 (** * Properties of equality. *)
 
-Theorem Qeq_refl : forall x, x == x.
+Theorem Qeq_refl x : x == x.
 Proof.
  auto with qarith.
 Qed.
 
-Theorem Qeq_sym : forall x y, x == y -> y == x.
+Theorem Qeq_sym x y : x == y -> y == x.
 Proof.
  auto with qarith.
 Qed.
 
-Theorem Qeq_trans : forall x y z, x == y -> y == z -> x == z.
+Theorem Qeq_trans x y z : x == y -> y == z -> x == z.
 Proof.
-unfold Qeq; intros.
-apply Zmult_reg_l with (QDen y).
-auto with qarith.
-transitivity (Qnum x * QDen y * QDen z)%Z; try ring.
-rewrite H.
-transitivity (Qnum y * QDen z * QDen x)%Z; try ring.
-rewrite H0; ring.
+unfold Qeq; intros XY YZ.
+apply Z.mul_reg_r with (QDen y); [auto with qarith|].
+now rewrite Z.mul_shuffle0, XY, Z.mul_shuffle0, YZ, Z.mul_shuffle0.
 Qed.
 
-Hint Resolve Qeq_refl : qarith.
-Hint Resolve Qeq_sym : qarith.
-Hint Resolve Qeq_trans : qarith.
+Hint Immediate Qeq_sym : qarith.
+Hint Resolve Qeq_refl Qeq_trans : qarith.
 
 (** In a word, [Qeq] is a setoid equality. *)
 
@@ -134,50 +125,48 @@ Proof. split; red; eauto with qarith. Qed.
 
 (** Furthermore, this equality is decidable: *)
 
-Theorem Qeq_dec : forall x y, {x==y} + {~ x==y}.
+Theorem Qeq_dec x y : {x==y} + {~ x==y}.
 Proof.
- intros; case (Z_eq_dec (Qnum x * QDen y) (Qnum y * QDen x)); auto.
+ apply Z.eq_dec.
 Defined.
 
 Definition Qeq_bool x y :=
   (Zeq_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z.
 
 Definition Qle_bool x y :=
-  (Zle_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z.
+  (Z.leb (Qnum x * QDen y) (Qnum y * QDen x))%Z.
 
-Lemma Qeq_bool_iff : forall x y, Qeq_bool x y = true <-> x == y.
+Lemma Qeq_bool_iff x y : Qeq_bool x y = true <-> x == y.
 Proof.
-  unfold Qeq_bool, Qeq; intros.
   symmetry; apply Zeq_is_eq_bool.
 Qed.
 
-Lemma Qeq_bool_eq : forall x y, Qeq_bool x y = true -> x == y.
+Lemma Qeq_bool_eq x y : Qeq_bool x y = true -> x == y.
 Proof.
-  intros; rewrite <- Qeq_bool_iff; auto.
+  apply Qeq_bool_iff.
 Qed.
 
-Lemma Qeq_eq_bool : forall x y, x == y -> Qeq_bool x y = true.
+Lemma Qeq_eq_bool x y : x == y -> Qeq_bool x y = true.
 Proof.
-  intros; rewrite Qeq_bool_iff; auto.
+  apply Qeq_bool_iff.
 Qed.
 
-Lemma Qeq_bool_neq : forall x y, Qeq_bool x y = false -> ~ x == y.
+Lemma Qeq_bool_neq x y : Qeq_bool x y = false -> ~ x == y.
 Proof.
-  intros x y H; rewrite <- Qeq_bool_iff, H; discriminate.
+  rewrite <- Qeq_bool_iff. now intros ->.
 Qed.
 
-Lemma Qle_bool_iff : forall x y, Qle_bool x y = true <-> x <= y.
+Lemma Qle_bool_iff x y : Qle_bool x y = true <-> x <= y.
 Proof.
-  unfold Qle_bool, Qle; intros.
   symmetry; apply Zle_is_le_bool.
 Qed.
 
-Lemma Qle_bool_imp_le : forall x y, Qle_bool x y = true -> x <= y.
+Lemma Qle_bool_imp_le x y : Qle_bool x y = true -> x <= y.
 Proof.
-  intros; rewrite <- Qle_bool_iff; auto.
+  apply Qle_bool_iff.
 Qed.
 
-Theorem Qnot_eq_sym : forall x y, ~x == y -> ~y == x.
+Theorem Qnot_eq_sym x y : ~x == y -> ~y == x.
 Proof.
  auto with qarith.
 Qed.
@@ -218,12 +207,9 @@ Infix "/" := Qdiv : Q_scope.
 
 Notation " ' x " := (Zpos x) (at level 20, no associativity) : Z_scope.
 
-Lemma Qmake_Qdiv : forall a b, a#b==inject_Z a/inject_Z ('b).
+Lemma Qmake_Qdiv a b : a#b==inject_Z a/inject_Z ('b).
 Proof.
-intros a b.
-unfold Qeq.
-simpl.
-ring.
+unfold Qeq. simpl. ring.
 Qed.
 
 (** * Setoid compatibility results *)
@@ -276,17 +262,13 @@ Instance Qinv_comp : Proper (Qeq==>Qeq) Qinv.
 Proof.
   unfold Qeq, Qinv; simpl.
   Open Scope Z_scope.
-  intros (p1, p2) (q1, q2); simpl.
-  case p1; simpl.
-  intros.
-  assert (q1 = 0).
-  elim (Zmult_integral q1 ('p2)); auto with zarith.
-  intros; discriminate.
-  subst; auto.
-  case q1; simpl; intros; try discriminate.
-  rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto.
-  case q1; simpl; intros; try discriminate.
-  rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto.
+  intros (p1, p2) (q1, q2) EQ; simpl in *.
+  destruct q1; simpl in *.
+  - apply Z.mul_eq_0 in EQ. destruct EQ; now subst.
+  - destruct p1; simpl in *; try discriminate.
+    now rewrite Pos.mul_comm, <- EQ, Pos.mul_comm.
+  - destruct p1; simpl in *; try discriminate.
+    now rewrite Pos.mul_comm, <- EQ, Pos.mul_comm.
   Close Scope Z_scope.
 Qed.
 
@@ -363,7 +345,7 @@ Qed.
 Lemma Qplus_0_r : forall x, x+0 == x.
 Proof.
   intros (x1, x2); unfold Qeq, Qplus; simpl.
-  rewrite Pmult_comm; simpl; ring.
+  rewrite Pos.mul_comm; simpl; ring.
 Qed.
 
 (** Commutativity of addition: *)
@@ -371,7 +353,7 @@ Qed.
 Theorem Qplus_comm : forall x y, x+y == y+x.
 Proof.
   intros (x1, x2); unfold Qeq, Qplus; simpl.
-  intros; rewrite Pmult_comm; ring.
+  intros; rewrite Pos.mul_comm; ring.
 Qed.
 
 
@@ -387,6 +369,26 @@ Proof.
   red; simpl; intro; ring.
 Qed.
 
+(** Injectivity of addition (uses theory about Qopp above): *)
+
+Lemma Qplus_inj_r (x y z: Q):
+  x + z == y + z <-> x == y.
+Proof.
+ split; intro E.
+  rewrite <- (Qplus_0_r x), <- (Qplus_0_r y).
+  rewrite <- (Qplus_opp_r z); auto.
+  do 2 rewrite Qplus_assoc.
+  rewrite E. reflexivity.
+ rewrite E. reflexivity.
+Qed.
+
+Lemma Qplus_inj_l (x y z: Q):
+  z + x == z + y <-> x == y.
+Proof.
+ rewrite (Qplus_comm z x), (Qplus_comm z y).
+ apply Qplus_inj_r.
+Qed.
+
 
 (** * Properties of [Qmult] *)
 
@@ -394,7 +396,7 @@ Qed.
 
 Theorem Qmult_assoc : forall n m p, n*(m*p)==(n*m)*p.
 Proof.
-  intros; red; simpl; rewrite Pmult_assoc; ring.
+  intros; red; simpl; rewrite Pos.mul_assoc; ring.
 Qed.
 
 (** multiplication and zero *)
@@ -419,15 +421,15 @@ Qed.
 Theorem Qmult_1_r : forall n, n*1==n.
 Proof.
   intro; red; simpl.
-  rewrite Zmult_1_r with (n := Qnum n).
-  rewrite Pmult_comm; simpl; trivial.
+  rewrite Z.mul_1_r with (n := Qnum n).
+  rewrite Pos.mul_comm; simpl; trivial.
 Qed.
 
 (** Commutativity of multiplication *)
 
 Theorem Qmult_comm : forall x y, x*y==y*x.
 Proof.
-  intros; red; simpl; rewrite Pmult_comm; ring.
+  intros; red; simpl; rewrite Pos.mul_comm; ring.
 Qed.
 
 (** Distributivity over [Qadd] *)
@@ -449,19 +451,32 @@ Qed.
 Theorem Qmult_integral : forall x y, x*y==0 -> x==0 \/ y==0.
 Proof.
   intros (x1,x2) (y1,y2).
-  unfold Qeq, Qmult; simpl; intros.
-  destruct (Zmult_integral (x1*1)%Z (y1*1)%Z); auto.
-  rewrite <- H; ring.
+  unfold Qeq, Qmult; simpl.
+  now rewrite <- Z.mul_eq_0, !Z.mul_1_r.
 Qed.
 
 Theorem Qmult_integral_l : forall x y, ~ x == 0 -> x*y == 0 -> y == 0.
 Proof.
   intros (x1, x2) (y1, y2).
-  unfold Qeq, Qmult; simpl; intros.
-  apply Zmult_integral_l with x1; auto with zarith.
-  rewrite <- H0; ring.
+  unfold Qeq, Qmult; simpl.
+  rewrite !Z.mul_1_r, Z.mul_eq_0. intuition.
 Qed.
 
+
+(** * inject_Z is a ring homomorphism: *)
+
+Lemma inject_Z_plus (x y: Z): inject_Z (x + y) = inject_Z x + inject_Z y.
+Proof.
+ unfold Qplus, inject_Z. simpl. f_equal. ring.
+Qed.
+
+Lemma inject_Z_mult (x y: Z): inject_Z (x * y) = inject_Z x * inject_Z y.
+Proof. reflexivity. Qed.
+
+Lemma inject_Z_opp (x: Z): inject_Z (- x) = - inject_Z x.
+Proof. reflexivity. Qed.
+
+
 (** * Inverse and division. *)
 
 Lemma Qinv_involutive : forall q, (/ / q) == q.
@@ -500,14 +515,33 @@ Proof.
   apply Qdiv_mult_l; auto.
 Qed.
 
+(** Injectivity of Qmult (requires theory about Qinv above): *)
+
+Lemma Qmult_inj_r (x y z: Q): ~ z == 0 -> (x * z == y * z <-> x == y).
+Proof.
+ intro z_ne_0.
+ split; intro E.
+  rewrite <- (Qmult_1_r x), <- (Qmult_1_r y).
+  rewrite <- (Qmult_inv_r z); auto.
+  do 2 rewrite Qmult_assoc.
+  rewrite E. reflexivity.
+ rewrite E. reflexivity.
+Qed.
+
+Lemma Qmult_inj_l (x y z: Q): ~ z == 0 -> (z * x == z * y <-> x == y).
+Proof.
+ rewrite (Qmult_comm z x), (Qmult_comm z y).
+ apply Qmult_inj_r.
+Qed.
+
 (** * Properties of order upon Q. *)
 
-Lemma Qle_refl : forall x, x<=x.
+Lemma Qle_refl x : x<=x.
 Proof.
   unfold Qle; auto with zarith.
 Qed.
 
-Lemma Qle_antisym : forall x y, x<=y -> y<=x -> x==y.
+Lemma Qle_antisym x y : x<=y -> y<=x -> x==y.
 Proof.
   unfold Qle, Qeq; auto with zarith.
 Qed.
@@ -516,39 +550,46 @@ Lemma Qle_trans : forall x y z, x<=y -> y<=z -> x<=z.
 Proof.
   unfold Qle; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
   Open Scope Z_scope.
-  apply Zmult_le_reg_r with ('y2).
-  red; trivial.
-  apply Zle_trans with (y1 * 'x2 * 'z2).
-  replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
-  apply Zmult_le_compat_r; auto with zarith.
-  replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
-  replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
-  apply Zmult_le_compat_r; auto with zarith.
+  apply Z.mul_le_mono_pos_r with ('y2); [easy|].
+  apply Z.le_trans with (y1 * 'x2 * 'z2).
+  - rewrite Z.mul_shuffle0. now apply Z.mul_le_mono_pos_r.
+  - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1).
+    now apply Z.mul_le_mono_pos_r.
   Close Scope Z_scope.
 Qed.
 
 Hint Resolve Qle_trans : qarith.
 
-Lemma Qlt_irrefl : forall x, ~x<x.
+Lemma Qlt_irrefl x : ~x<x.
 Proof.
  unfold Qlt. auto with zarith.
 Qed.
 
-Lemma Qlt_not_eq : forall x y, x<y -> ~ x==y.
+Lemma Qlt_not_eq x y : x<y -> ~ x==y.
 Proof.
   unfold Qlt, Qeq; auto with zarith.
 Qed.
 
+Lemma Zle_Qle (x y: Z): (x <= y)%Z = (inject_Z x <= inject_Z y).
+Proof.
+ unfold Qle. simpl. now rewrite !Z.mul_1_r.
+Qed.
+
+Lemma Zlt_Qlt (x y: Z): (x < y)%Z = (inject_Z x < inject_Z y).
+Proof.
+ unfold Qlt. simpl. now rewrite !Z.mul_1_r.
+Qed.
+
+
 (** Large = strict or equal *)
 
-Lemma Qle_lteq : forall x y, x<=y <-> x<y \/ x==y.
+Lemma Qle_lteq x y : x<=y <-> x<y \/ x==y.
 Proof.
- intros.
  rewrite Qeq_alt, Qle_alt, Qlt_alt.
  destruct (x ?= y); intuition; discriminate.
 Qed.
 
-Lemma Qlt_le_weak : forall x y, x<y -> x<=y.
+Lemma Qlt_le_weak x y : x<y -> x<=y.
 Proof.
   unfold Qle, Qlt; auto with zarith.
 Qed.
@@ -557,15 +598,11 @@ Lemma Qle_lt_trans : forall x y z, x<=y -> y<z -> x<z.
 Proof.
   unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
   Open Scope Z_scope.
-  apply Zgt_lt.
-  apply Zmult_gt_reg_r with ('y2).
-  red; trivial.
-  apply Zgt_le_trans with (y1 * 'x2 * 'z2).
-  replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
-  replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
-  apply Zmult_gt_compat_r; auto with zarith.
-  replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
-  apply Zmult_le_compat_r; auto with zarith.
+  apply Z.mul_lt_mono_pos_r with ('y2); [easy|].
+  apply Z.le_lt_trans with (y1 * 'x2 * 'z2).
+  - rewrite Z.mul_shuffle0. now apply Z.mul_le_mono_pos_r.
+  - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1).
+    now apply Z.mul_lt_mono_pos_r.
   Close Scope Z_scope.
 Qed.
 
@@ -573,15 +610,11 @@ Lemma Qlt_le_trans : forall x y z, x<y -> y<=z -> x<z.
 Proof.
   unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
   Open Scope Z_scope.
-  apply Zgt_lt.
-  apply Zmult_gt_reg_r with ('y2).
-  red; trivial.
-  apply Zle_gt_trans with (y1 * 'x2 * 'z2).
-  replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
-  replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
-  apply Zmult_le_compat_r; auto with zarith.
-  replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
-  apply Zmult_gt_compat_r; auto with zarith.
+  apply Z.mul_lt_mono_pos_r with ('y2); [easy|].
+  apply Z.lt_le_trans with (y1 * 'x2 * 'z2).
+  - rewrite Z.mul_shuffle0. now apply Z.mul_lt_mono_pos_r.
+  - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1).
+    now apply Z.mul_le_mono_pos_r.
   Close Scope Z_scope.
 Qed.
 
@@ -616,7 +649,7 @@ Qed.
 
 Lemma Qle_lt_or_eq : forall x y, x<=y -> x<y \/ x==y.
 Proof.
-  unfold Qle, Qlt, Qeq; intros; apply Zle_lt_or_eq; auto.
+  unfold Qle, Qlt, Qeq; intros; now apply Z.lt_eq_cases.
 Qed.
 
 Hint Resolve Qle_not_lt Qlt_not_le Qnot_le_lt Qnot_lt_le
@@ -641,7 +674,7 @@ Defined.
 Lemma Qopp_le_compat : forall p q, p<=q -> -q <= -p.
 Proof.
   intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl.
-  do 2 rewrite <- Zopp_mult_distr_l; omega.
+  rewrite !Z.mul_opp_l. omega.
 Qed.
 
 Hint Resolve Qopp_le_compat : qarith.
@@ -649,15 +682,13 @@ Hint Resolve Qopp_le_compat : qarith.
 Lemma Qle_minus_iff : forall p q, p <= q <-> 0 <= q+-p.
 Proof.
   intros (x1,x2) (y1,y2); unfold Qle; simpl.
-  rewrite <- Zopp_mult_distr_l.
-  split; omega.
+  rewrite Z.mul_opp_l. omega.
 Qed.
 
 Lemma Qlt_minus_iff : forall p q, p < q <-> 0 < q+-p.
 Proof.
   intros (x1,x2) (y1,y2); unfold Qlt; simpl.
-  rewrite <- Zopp_mult_distr_l.
-  split; omega.
+  rewrite Z.mul_opp_l. omega.
 Qed.
 
 Lemma Qplus_le_compat :
@@ -668,8 +699,8 @@ Proof.
   Open Scope Z_scope.
   intros.
   match goal with |- ?a <= ?b => ring_simplify a b end.
-  rewrite Zplus_comm.
-  apply Zplus_le_compat.
+  rewrite Z.add_comm.
+  apply Z.add_le_mono.
   match goal with |- ?a <= ?b => ring_simplify z1 t1 ('z2) ('t2) a b end.
   auto with zarith.
   match goal with |- ?a <= ?b => ring_simplify x1 y1 ('x2) ('y2) a b end.
@@ -677,42 +708,117 @@ Proof.
   Close Scope Z_scope.
 Qed.
 
+Lemma Qplus_lt_le_compat :
+  forall x y z t, x<y -> z<=t -> x+z < y+t.
+Proof.
+  unfold Qplus, Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2) (t1, t2);
+    simpl; simpl_mult.
+  Open Scope Z_scope.
+  intros.
+  match goal with |- ?a < ?b => ring_simplify a b end.
+  rewrite Z.add_comm.
+  apply Z.add_le_lt_mono.
+  match goal with |- ?a <= ?b => ring_simplify z1 t1 ('z2) ('t2) a b end.
+  auto with zarith.
+  match goal with |- ?a < ?b => ring_simplify x1 y1 ('x2) ('y2) a b end.
+  do 2 (apply Z.mul_lt_mono_pos_r;try easy).
+  Close Scope Z_scope.
+Qed.
+
+Lemma Qplus_le_l (x y z: Q): x + z <= y + z <-> x <= y.
+Proof.
+ split; intros.
+  rewrite <- (Qplus_0_r x), <- (Qplus_0_r y), <- (Qplus_opp_r z).
+  do 2 rewrite Qplus_assoc.
+  apply Qplus_le_compat; auto with *.
+ apply Qplus_le_compat; auto with *.
+Qed.
+
+Lemma Qplus_le_r (x y z: Q): z + x <= z + y <-> x <= y.
+Proof.
+ rewrite (Qplus_comm z x), (Qplus_comm z y).
+ apply Qplus_le_l.
+Qed.
+
+Lemma Qplus_lt_l (x y z: Q): x + z < y + z <-> x < y.
+Proof.
+ split; intros.
+  rewrite <- (Qplus_0_r x), <- (Qplus_0_r y), <- (Qplus_opp_r z).
+  do 2 rewrite Qplus_assoc.
+  apply Qplus_lt_le_compat; auto with *.
+ apply Qplus_lt_le_compat; auto with *.
+Qed.
+
+Lemma Qplus_lt_r (x y z: Q): z + x < z + y <-> x < y.
+Proof.
+ rewrite (Qplus_comm z x), (Qplus_comm z y).
+ apply Qplus_lt_l.
+Qed.
+
 Lemma Qmult_le_compat_r : forall x y z, x <= y -> 0 <= z -> x*z <= y*z.
 Proof.
   intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl.
   Open Scope Z_scope.
   intros; simpl_mult.
-  replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring.
-  replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring.
-  apply Zmult_le_compat_r; auto with zarith.
+  rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1).
+  apply Z.mul_le_mono_nonneg_r; auto with zarith.
   Close Scope Z_scope.
 Qed.
 
-Lemma Qmult_lt_0_le_reg_r : forall x y z, 0 <  z  -> x*z <= y*z -> x <= y.
+Lemma Qmult_lt_0_le_reg_r : forall x y z, 0 < z  -> x*z <= y*z -> x <= y.
 Proof.
   intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl.
   Open Scope Z_scope.
   simpl_mult.
-  replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring.
-  replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring.
-  intros; apply Zmult_le_reg_r with (c1*'c2); auto with zarith.
+  rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1).
+  intros LT LE.
+  apply Z.mul_le_mono_pos_r in LE; trivial.
+  apply Z.mul_pos_pos; [omega|easy].
   Close Scope Z_scope.
 Qed.
 
+Lemma Qmult_le_r (x y z: Q): 0 < z -> (x*z <= y*z <-> x <= y).
+Proof.
+ split; intro.
+  now apply Qmult_lt_0_le_reg_r with z.
+ apply Qmult_le_compat_r; auto with qarith.
+Qed.
+
+Lemma Qmult_le_l (x y z: Q): 0 < z -> (z*x <= z*y <-> x <= y).
+Proof.
+ rewrite (Qmult_comm z x), (Qmult_comm z y).
+ apply Qmult_le_r.
+Qed.
+
 Lemma Qmult_lt_compat_r : forall x y z, 0 < z  -> x < y -> x*z < y*z.
 Proof.
   intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl.
   Open Scope Z_scope.
   intros; simpl_mult.
-  replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring.
-  replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring.
-  apply Zmult_lt_compat_r; auto with zarith.
-  apply Zmult_lt_0_compat.
-  omega.
-  compute; auto.
+  rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1).
+  apply Z.mul_lt_mono_pos_r; auto with zarith.
+  apply Z.mul_pos_pos; [omega|reflexivity].
   Close Scope Z_scope.
 Qed.
 
+Lemma Qmult_lt_r: forall x y z, 0 < z -> (x*z < y*z <-> x < y).
+Proof.
+ Open Scope Z_scope.
+ intros (a1,a2) (b1,b2) (c1,c2).
+ unfold Qle, Qlt; simpl.
+ simpl_mult.
+ rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1).
+ intro LT. rewrite <- Z.mul_lt_mono_pos_r. reflexivity.
+ apply Z.mul_pos_pos; [omega|reflexivity].
+ Close Scope Z_scope.
+Qed.
+
+Lemma Qmult_lt_l (x y z: Q): 0 < z -> (z*x < z*y <-> x < y).
+Proof.
+ rewrite (Qmult_comm z x), (Qmult_comm z y).
+ apply Qmult_lt_r.
+Qed.
+
 Lemma Qmult_le_0_compat : forall a b, 0 <= a -> 0 <= b -> 0 <= a*b.
 Proof.
 intros a b Ha Hb.
diff --git a/theories/QArith/QOrderedType.v b/theories/QArith/QOrderedType.v
index be894419..e146da25 100644
--- a/theories/QArith/QOrderedType.v
+++ b/theories/QArith/QOrderedType.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
diff --git a/theories/QArith/Qabs.v b/theories/QArith/Qabs.v
index 747c2c3c..50aee530 100644
--- a/theories/QArith/Qabs.v
+++ b/theories/QArith/Qabs.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -11,7 +11,7 @@ Require Export Qreduction.
 
 Hint Resolve Qlt_le_weak : qarith.
 
-Definition Qabs (x:Q) := let (n,d):=x in (Zabs n#d).
+Definition Qabs (x:Q) := let (n,d):=x in (Z.abs n#d).
 
 Lemma Qabs_case : forall (x:Q) (P : Q -> Type), (0 <= x -> P x) -> (x <= 0 -> P (- x)) -> P (Qabs x).
 Proof.
@@ -26,9 +26,9 @@ intros [xn xd] [yn yd] H.
 simpl.
 unfold Qeq in *.
 simpl in *.
-change (' yd)%Z with (Zabs (' yd)).
-change (' xd)%Z with (Zabs (' xd)).
-repeat rewrite <- Zabs_Zmult.
+change (' yd)%Z with (Z.abs (' yd)).
+change (' xd)%Z with (Z.abs (' xd)).
+repeat rewrite <- Z.abs_mul.
 congruence.
 Qed.
 
@@ -61,7 +61,7 @@ auto.
 apply (Qopp_le_compat x 0).
 Qed.
 
-Lemma Zabs_Qabs : forall n d, (Zabs n#d)==Qabs (n#d).
+Lemma Zabs_Qabs : forall n d, (Z.abs n#d)==Qabs (n#d).
 Proof.
 intros [|n|n]; reflexivity.
 Qed.
@@ -85,21 +85,28 @@ intros [xn xd] [yn yd].
 unfold Qplus.
 unfold Qle.
 simpl.
-apply Zmult_le_compat_r;auto with *.
-change (' yd)%Z with (Zabs (' yd)).
-change (' xd)%Z with (Zabs (' xd)).
-repeat rewrite <- Zabs_Zmult.
-apply Zabs_triangle.
+apply Z.mul_le_mono_nonneg_r;auto with *.
+change (' yd)%Z with (Z.abs (' yd)).
+change (' xd)%Z with (Z.abs (' xd)).
+repeat rewrite <- Z.abs_mul.
+apply Z.abs_triangle.
 Qed.
 
 Lemma Qabs_Qmult : forall a b, Qabs (a*b) == (Qabs a)*(Qabs b).
 Proof.
 intros [an ad] [bn bd].
 simpl.
-rewrite Zabs_Zmult.
+rewrite Z.abs_mul.
 reflexivity.
 Qed.
 
+Lemma Qabs_Qminus x y: Qabs (x - y) = Qabs (y - x).
+Proof.
+ unfold Qminus, Qopp. simpl.
+ rewrite Pos.mul_comm, <- Z.abs_opp.
+ do 2 f_equal. ring.
+Qed.
+
 Lemma Qle_Qabs : forall a, a <= Qabs a.
 Proof.
 intros a.
@@ -122,3 +129,31 @@ apply Qabs_triangle.
 apply Qabs_wd.
 ring.
 Qed.
+
+Lemma Qabs_Qle_condition x y: Qabs x <= y <-> -y <= x <= y.
+Proof.
+ split.
+  split.
+   rewrite <- (Qopp_opp x).
+   apply Qopp_le_compat.
+   apply Qle_trans with (Qabs (-x)).
+   apply Qle_Qabs.
+   now rewrite Qabs_opp.
+  apply Qle_trans with (Qabs x); auto using Qle_Qabs.
+ intros (H,H').
+ apply Qabs_case; trivial.
+ intros. rewrite <- (Qopp_opp y). now apply Qopp_le_compat.
+Qed.
+
+Lemma Qabs_diff_Qle_condition x y r: Qabs (x - y) <= r <-> x - r <= y <= x + r.
+Proof.
+ intros. unfold Qminus.
+ rewrite Qabs_Qle_condition.
+ rewrite <- (Qplus_le_l (-r) (x+-y) (y+r)).
+ rewrite <- (Qplus_le_l (x+-y) r (y-r)).
+ setoid_replace (-r + (y + r)) with y by ring.
+ setoid_replace (r + (y - r)) with y by ring.
+ setoid_replace (x + - y + (y + r)) with (x + r) by ring.
+ setoid_replace (x + - y + (y - r)) with (x - r) by ring.
+ intuition.
+Qed.
diff --git a/theories/QArith/Qcanon.v b/theories/QArith/Qcanon.v
index 71a3b474..d1160cbe 100644
--- a/theories/QArith/Qcanon.v
+++ b/theories/QArith/Qcanon.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Qcanon.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Field.
 Require Import QArith.
 Require Import Znumtheory.
@@ -20,43 +18,43 @@ Record Qc : Set := Qcmake { this :> Q ; canon : Qred this = this }.
 
 Delimit Scope Qc_scope with Qc.
 Bind Scope Qc_scope with Qc.
-Arguments Scope Qcmake [Q_scope].
+Arguments Qcmake this%Q _.
 Open Scope Qc_scope.
 
 Lemma Qred_identity :
-  forall q:Q, Zgcd (Qnum q) (QDen q) = 1%Z -> Qred q = q.
+  forall q:Q, Z.gcd (Qnum q) (QDen q) = 1%Z -> Qred q = q.
 Proof.
   unfold Qred; intros (a,b); simpl.
-  generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)).
+  generalize (Z.ggcd_gcd a ('b)) (Z.ggcd_correct_divisors a ('b)).
   intros.
   rewrite H1 in H; clear H1.
-  destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst.
+  destruct (Z.ggcd a ('b)) as (g,(aa,bb)); simpl in *; subst.
   destruct H0.
-  rewrite Zmult_1_l in H, H0.
+  rewrite Z.mul_1_l in H, H0.
   subst; simpl; auto.
 Qed.
 
 Lemma Qred_identity2 :
-  forall q:Q, Qred q = q -> Zgcd (Qnum q) (QDen q) = 1%Z.
+  forall q:Q, Qred q = q -> Z.gcd (Qnum q) (QDen q) = 1%Z.
 Proof.
   unfold Qred; intros (a,b); simpl.
-  generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)) (Zgcd_is_pos a ('b)).
+  generalize (Z.ggcd_gcd a ('b)) (Z.ggcd_correct_divisors a ('b)) (Z.gcd_nonneg a ('b)).
   intros.
   rewrite <- H; rewrite <- H in H1; clear H.
-  destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst.
+  destruct (Z.ggcd a ('b)) as (g,(aa,bb)); simpl in *; subst.
   injection H2; intros; clear H2.
   destruct H0.
   clear H0 H3.
   destruct g as [|g|g]; destruct bb as [|bb|bb]; simpl in *; try discriminate.
   f_equal.
-  apply Pmult_reg_r with bb.
+  apply Pos.mul_reg_r with bb.
   injection H2; intros.
   rewrite <- H0.
   rewrite H; simpl; auto.
   elim H1; auto.
 Qed.
 
-Lemma Qred_iff : forall q:Q, Qred q = q <-> Zgcd (Qnum q) (QDen q) = 1%Z.
+Lemma Qred_iff : forall q:Q, Qred q = q <-> Z.gcd (Qnum q) (QDen q) = 1%Z.
 Proof.
   split; intros.
   apply Qred_identity2; auto.
@@ -71,7 +69,7 @@ Proof.
 Qed.
 
 Definition Q2Qc (q:Q) : Qc := Qcmake (Qred q) (Qred_involutive q).
-Arguments Scope Q2Qc [Q_scope].
+Arguments Q2Qc q%Q.
 Notation " !! " := Q2Qc : Qc_scope.
 
 Lemma Qc_is_canon : forall q q' : Qc, q == q' -> q = q'.
@@ -468,18 +466,16 @@ Proof.
   destruct n; simpl.
   destruct 1; auto.
   intros.
-  apply Qc_is_canon.
-  simpl.
-  compute; auto.
+  now apply Qc_is_canon.
 Qed.
 
 Lemma Qcpower_pos : forall p n, 0 <= p -> 0 <= p^n.
 Proof.
   induction n; simpl; auto with qarith.
-  intros; compute; intro; discriminate.
+  easy.
   intros.
   apply Qcle_trans with (0*(p^n)).
-  compute; intro; discriminate.
+  easy.
   apply Qcmult_le_compat_r; auto.
 Qed.
 
@@ -492,7 +488,7 @@ Definition Qc_eq_bool (x y : Qc) :=
 
 Lemma Qc_eq_bool_correct : forall x y : Qc, Qc_eq_bool x y = true -> x=y.
 Proof.
-  intros x y; unfold Qc_eq_bool in |- *; case (Qc_eq_dec x y); simpl in |- *; auto.
+  intros x y; unfold Qc_eq_bool; case (Qc_eq_dec x y); simpl; auto.
   intros _ H; inversion H.
 Qed.
 
diff --git a/theories/QArith/Qfield.v b/theories/QArith/Qfield.v
index 81d59714..3e162cdc 100644
--- a/theories/QArith/Qfield.v
+++ b/theories/QArith/Qfield.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Qfield.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Field.
 Require Export QArith_base.
 Require Import NArithRing.
@@ -40,7 +38,7 @@ Proof.
   exact Hp.
 Qed.
 
-Lemma Qpower_theory : power_theory 1 Qmult Qeq Z_of_N Qpower.
+Lemma Qpower_theory : power_theory 1 Qmult Qeq Z.of_N Qpower.
 Proof.
 constructor.
 intros r [|n];
@@ -68,7 +66,7 @@ Ltac Qpow_tac t :=
   match t with
   | Z0 => N0
   | Zpos ?n => Ncst (Npos n)
-  | Z_of_N ?n => Ncst n
+  | Z.of_N ?n => Ncst n
   | NtoZ ?n => Ncst n
   | _ => NotConstant
   end.
diff --git a/theories/QArith/Qminmax.v b/theories/QArith/Qminmax.v
index a458fc6e..2b6c3980 100644
--- a/theories/QArith/Qminmax.v
+++ b/theories/QArith/Qminmax.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -64,4 +64,4 @@ Proof.
  apply plus_min_distr_l.
 Qed.
 
-End Q.
\ No newline at end of file
+End Q.
diff --git a/theories/QArith/Qpower.v b/theories/QArith/Qpower.v
index 9568c796..5d494c7c 100644
--- a/theories/QArith/Qpower.v
+++ b/theories/QArith/Qpower.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -101,10 +101,9 @@ Lemma Qpower_plus_positive : forall a n m, Qpower_positive a (n+m) == (Qpower_po
 Proof.
 intros a n m.
 unfold Qpower_positive.
-apply pow_pos_Pplus.
+apply pow_pos_add.
 apply Q_Setoid.
 apply Qmult_comp.
-apply Qmult_comm.
 apply Qmult_assoc.
 Qed.
 
@@ -114,21 +113,18 @@ intros a [|n|n]; simpl; try reflexivity.
 symmetry; apply Qinv_involutive.
 Qed.
 
-Lemma Qpower_minus_positive : forall a (n m:positive), (Pcompare n m Eq=Gt)%positive -> Qpower_positive a (n-m)%positive == (Qpower_positive a n)/(Qpower_positive a m).
+Lemma Qpower_minus_positive : forall a (n m:positive),
+  (m < n)%positive ->
+  Qpower_positive a (n-m)%positive == (Qpower_positive a n)/(Qpower_positive a m).
 Proof.
 intros a n m H.
-destruct (Qeq_dec a 0).
- rewrite q.
- repeat rewrite Qpower_positive_0.
- reflexivity.
-rewrite <- (Qdiv_mult_l (Qpower_positive a (n - m)) (Qpower_positive a m)) by
- (apply Qpower_not_0_positive; assumption).
-apply Qdiv_comp;[|reflexivity].
-rewrite Qmult_comm.
-rewrite <- Qpower_plus_positive.
-rewrite Pplus_minus.
-reflexivity.
-assumption.
+destruct (Qeq_dec a 0) as [EQ|NEQ].
+- now rewrite EQ, !Qpower_positive_0.
+- rewrite <- (Qdiv_mult_l (Qpower_positive a (n - m)) (Qpower_positive a m)) by
+   (now apply Qpower_not_0_positive).
+  f_equiv.
+  rewrite <- Qpower_plus_positive.
+  now rewrite Pos.sub_add.
 Qed.
 
 Lemma Qpower_plus : forall a n m, ~a==0 -> a^(n+m) == a^n*a^m.
@@ -136,12 +132,10 @@ Proof.
 intros a [|n|n] [|m|m] H; simpl; try ring;
 try rewrite Qpower_plus_positive;
 try apply Qinv_mult_distr; try reflexivity;
-case_eq ((n ?= m)%positive Eq); intros H0; simpl;
+rewrite ?Z.pos_sub_spec;
+case Pos.compare_spec; intros H0; simpl; subst;
  try rewrite Qpower_minus_positive;
- try rewrite (Pcompare_Eq_eq _ _ H0);
  try (field; try split; apply Qpower_not_0_positive);
- try assumption;
- apply ZC2;
  assumption.
 Qed.
 
@@ -158,13 +152,14 @@ apply Qpower_plus.
 assumption.
 Qed.
 
-Lemma Qpower_mult_positive : forall a n m, Qpower_positive a (n*m) == Qpower_positive (Qpower_positive a n) m.
+Lemma Qpower_mult_positive : forall a n m,
+  Qpower_positive a (n*m) == Qpower_positive (Qpower_positive a n) m.
 Proof.
 intros a n m.
-induction n using Pind.
+induction n using Pos.peano_ind.
  reflexivity.
-rewrite Pmult_Sn_m.
-rewrite Pplus_one_succ_l.
+rewrite Pos.mul_succ_l.
+rewrite <- Pos.add_1_l.
 do 2 rewrite Qpower_plus_positive.
 rewrite IHn.
 rewrite Qmult_power_positive.
@@ -184,11 +179,11 @@ Qed.
 Lemma Zpower_Qpower : forall (a n:Z), (0<=n)%Z -> inject_Z (a^n) == (inject_Z a)^n.
 Proof.
 intros a [|n|n] H;[reflexivity| |elim H; reflexivity].
-induction n using Pind.
+induction n using Pos.peano_ind.
  replace (a^1)%Z with a by ring.
  ring.
-rewrite Zpos_succ_morphism.
-unfold Zsucc.
+rewrite Pos2Z.inj_succ.
+unfold Z.succ.
 rewrite Zpower_exp; auto with *; try discriminate.
 rewrite Qpower_plus' by discriminate.
 rewrite <- IHn by discriminate.
@@ -209,31 +204,20 @@ setoid_replace (0+ - a) with (-a) in A by ring.
 apply Qmult_le_0_compat; assumption.
 Qed.
 
-Theorem Qpower_decomp: forall p x y,
-  Qpower_positive (x #y) p == x ^ Zpos p # (Z2P ((Zpos y) ^ Zpos p)).
-Proof.
-induction p; intros; unfold Qmult; simpl.
-(* xI *)
-rewrite IHp, xI_succ_xO, <-Pplus_diag, Pplus_one_succ_l.
-repeat rewrite Zpower_pos_is_exp.
-red; unfold Qmult, Qnum, Qden, Zpower.
-repeat rewrite Zpos_mult_morphism.
-repeat rewrite Z2P_correct.
-repeat rewrite Zpower_pos_1_r; ring.
-apply Zpower_pos_pos; red; auto.
-repeat apply Zmult_lt_0_compat; red; auto;
- apply Zpower_pos_pos; red; auto.
-(* xO *)
-rewrite IHp, <-Pplus_diag.
-repeat rewrite Zpower_pos_is_exp.
-red; unfold Qmult, Qnum, Qden, Zpower.
-repeat rewrite Zpos_mult_morphism.
-repeat rewrite Z2P_correct; try ring.
-apply Zpower_pos_pos; red; auto.
-repeat apply Zmult_lt_0_compat; auto;
- apply Zpower_pos_pos; red; auto.
-(* xO *)
-unfold Qmult; simpl.
-red; simpl; rewrite Zpower_pos_1_r;
- rewrite Zpos_mult_morphism; ring.
+Theorem Qpower_decomp p x y :
+  Qpower_positive (x#y) p = x ^ Zpos p # (y ^ p).
+Proof.
+induction p; intros; simpl Qpower_positive; rewrite ?IHp.
+- (* xI *)
+  unfold Qmult, Qnum, Qden. f_equal.
+  + now rewrite <- Z.pow_twice_r, <- Z.pow_succ_r.
+  + apply Pos2Z.inj; rewrite !Pos2Z.inj_mul, !Pos2Z.inj_pow.
+    now rewrite <- Z.pow_twice_r, <- Z.pow_succ_r.
+- (* xO *)
+  unfold Qmult, Qnum, Qden. f_equal.
+  + now rewrite <- Z.pow_twice_r.
+  + apply Pos2Z.inj; rewrite !Pos2Z.inj_mul, !Pos2Z.inj_pow.
+    now rewrite <- Z.pow_twice_r.
+- (* xO *)
+  now rewrite Z.pow_1_r, Pos.pow_1_r.
 Qed.
diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v
index 8a0ebcff..0c7a22bf 100644
--- a/theories/QArith/Qreals.v
+++ b/theories/QArith/Qreals.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Qreals.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Rbase.
 Require Export QArith_base.
 
@@ -23,7 +21,7 @@ Hint Resolve IZR_nz Rmult_integral_contrapositive.
 
 Lemma eqR_Qeq : forall x y : Q, Q2R x = Q2R y -> x==y.
 Proof.
-unfold Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *;
+unfold Qeq, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden;
  intros.
 apply eq_IZR.
 do 2 rewrite mult_IZR.
@@ -38,24 +36,24 @@ Qed.
 
 Lemma Qeq_eqR : forall x y : Q, x==y -> Q2R x = Q2R y.
 Proof.
-unfold Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *;
+unfold Qeq, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden;
  intros.
 set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2);
  set (X2 := IZR (Zpos x2)) in *.
 set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2);
  set (Y2 := IZR (Zpos y2)) in *.
 assert ((X1 * Y2)%R = (Y1 * X2)%R).
- unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR.
+ unfold X1, X2, Y1, Y2; do 2 rewrite <- mult_IZR.
  apply IZR_eq; auto.
 clear H.
 field_simplify_eq; auto.
 ring_simplify X1 Y2 (Y2 * X1)%R.
-rewrite H0 in |- *;  ring.
+rewrite H0;  ring.
 Qed.
 
 Lemma Rle_Qle : forall x y : Q, (Q2R x <= Q2R y)%R -> x<=y.
 Proof.
-unfold Qle, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *;
+unfold Qle, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden;
  intros.
 apply le_IZR.
 do 2 rewrite mult_IZR.
@@ -67,37 +65,37 @@ replace (X1 * Y2)%R with (X1 * / X2 * (X2 * Y2))%R; try (field; auto).
 replace (Y1 * X2)%R with (Y1 * / Y2 * (X2 * Y2))%R; try (field; auto).
 apply Rmult_le_compat_r; auto.
 apply Rmult_le_pos.
-unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_le;
+unfold X2; replace 0%R with (IZR 0); auto; apply IZR_le;
  auto with zarith.
-unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_le;
+unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_le;
  auto with zarith.
 Qed.
 
 Lemma Qle_Rle : forall x y : Q, x<=y -> (Q2R x <= Q2R y)%R.
 Proof.
-unfold Qle, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *;
+unfold Qle, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden;
  intros.
 set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2);
  set (X2 := IZR (Zpos x2)) in *.
 set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2);
  set (Y2 := IZR (Zpos y2)) in *.
 assert (X1 * Y2 <= Y1 * X2)%R.
- unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR.
+ unfold X1, X2, Y1, Y2; do 2 rewrite <- mult_IZR.
  apply IZR_le; auto.
 clear H.
 replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto).
 replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto).
 apply Rmult_le_compat_r; auto.
 apply Rmult_le_pos; apply Rlt_le; apply Rinv_0_lt_compat.
-unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *;
+unfold X2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
  auto with zarith.
-unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *;
+unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
  auto with zarith.
 Qed.
 
 Lemma Rlt_Qlt : forall x y : Q, (Q2R x < Q2R y)%R -> x<y.
 Proof.
-unfold Qlt, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *;
+unfold Qlt, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden;
  intros.
 apply lt_IZR.
 do 2 rewrite mult_IZR.
@@ -109,38 +107,38 @@ replace (X1 * Y2)%R with (X1 * / X2 * (X2 * Y2))%R; try (field; auto).
 replace (Y1 * X2)%R with (Y1 * / Y2 * (X2 * Y2))%R; try (field; auto).
 apply Rmult_lt_compat_r; auto.
 apply Rmult_lt_0_compat.
-unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *;
+unfold X2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
  auto with zarith.
-unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *;
+unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
  auto with zarith.
 Qed.
 
 Lemma Qlt_Rlt : forall x y : Q, x<y -> (Q2R x < Q2R y)%R.
 Proof.
-unfold Qlt, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *;
+unfold Qlt, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden;
  intros.
 set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2);
  set (X2 := IZR (Zpos x2)) in *.
 set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2);
  set (Y2 := IZR (Zpos y2)) in *.
 assert (X1 * Y2 < Y1 * X2)%R.
- unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR.
+ unfold X1, X2, Y1, Y2; do 2 rewrite <- mult_IZR.
  apply IZR_lt; auto.
 clear H.
 replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto).
 replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto).
 apply Rmult_lt_compat_r; auto.
 apply Rmult_lt_0_compat; apply Rinv_0_lt_compat.
-unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *;
+unfold X2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
  auto with zarith.
-unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *;
+unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_lt; red;
  auto with zarith.
 Qed.
 
 Lemma Q2R_plus : forall x y : Q, Q2R (x+y) = (Q2R x + Q2R y)%R.
 Proof.
-unfold Qplus, Qeq, Q2R in |- *; intros (x1, x2) (y1, y2);
- unfold Qden, Qnum in |- *.
+unfold Qplus, Qeq, Q2R; intros (x1, x2) (y1, y2);
+ unfold Qden, Qnum.
 simpl_mult.
 rewrite plus_IZR.
 do 3 rewrite mult_IZR.
@@ -149,8 +147,8 @@ Qed.
 
 Lemma Q2R_mult : forall x y : Q, Q2R (x*y) = (Q2R x * Q2R y)%R.
 Proof.
-unfold Qmult, Qeq, Q2R in |- *; intros (x1, x2) (y1, y2);
- unfold Qden, Qnum in |- *.
+unfold Qmult, Qeq, Q2R; intros (x1, x2) (y1, y2);
+ unfold Qden, Qnum.
 simpl_mult.
 do 2 rewrite mult_IZR.
 field; auto.
@@ -158,24 +156,24 @@ Qed.
 
 Lemma Q2R_opp : forall x : Q, Q2R (- x) = (- Q2R x)%R.
 Proof.
-unfold Qopp, Qeq, Q2R in |- *; intros (x1, x2); unfold Qden, Qnum in |- *.
+unfold Qopp, Qeq, Q2R; intros (x1, x2); unfold Qden, Qnum.
 rewrite Ropp_Ropp_IZR.
 field; auto.
 Qed.
 
 Lemma Q2R_minus : forall x y : Q, Q2R (x-y) = (Q2R x - Q2R y)%R.
-unfold Qminus in |- *; intros; rewrite Q2R_plus; rewrite Q2R_opp; auto.
+unfold Qminus; intros; rewrite Q2R_plus; rewrite Q2R_opp; auto.
 Qed.
 
 Lemma Q2R_inv : forall x : Q, ~ x==0 -> Q2R (/x) = (/ Q2R x)%R.
 Proof.
-unfold Qinv, Q2R, Qeq in |- *; intros (x1, x2); unfold Qden, Qnum in |- *.
+unfold Qinv, Q2R, Qeq; intros (x1, x2); unfold Qden, Qnum.
 case x1.
-simpl in |- *; intros; elim H; trivial.
+simpl; intros; elim H; trivial.
 intros; field; auto.
 intros;
-  change (IZR (Zneg x2)) with (- IZR (' x2))%R in |- *;
-  change (IZR (Zneg p)) with (- IZR (' p))%R in |- *;
+  change (IZR (Zneg x2)) with (- IZR (' x2))%R;
+  change (IZR (Zneg p)) with (- IZR (' p))%R;
   field; (*auto 8 with real.*)
   repeat split; auto; auto with real.
 Qed.
@@ -183,7 +181,7 @@ Qed.
 Lemma Q2R_div :
  forall x y : Q, ~ y==0 -> Q2R (x/y) = (Q2R x / Q2R y)%R.
 Proof.
-unfold Qdiv, Rdiv in |- *.
+unfold Qdiv, Rdiv.
 intros; rewrite Q2R_mult.
 rewrite Q2R_inv; auto.
 Qed.
@@ -207,7 +205,7 @@ Qed.
 Let ex2 : forall x y : Q, ~ y==0 -> (x/y)*y == x.
 intros; QField.
 intro; apply H; apply eqR_Qeq.
-rewrite H0; unfold Q2R in |- *; simpl in |- *; field; auto with real.
+rewrite H0; unfold Q2R; simpl; field; auto with real.
 Qed.
 
-End LegacyQField.
\ No newline at end of file
+End LegacyQField.
diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v
index eb8c1164..3b3a30eb 100644
--- a/theories/QArith/Qreduction.v
+++ b/theories/QArith/Qreduction.v
@@ -1,65 +1,39 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Qreduction.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Normalisation functions for rational numbers. *)
 
 Require Export QArith_base.
 Require Import Znumtheory.
 
-(** First, a function that (tries to) build a positive back from a Z. *)
-
-Definition Z2P (z : Z) :=
-  match z with
-  | Z0 => 1%positive
-  | Zpos p => p
-  | Zneg p => p
-  end.
-
-Lemma Z2P_correct : forall z : Z, (0 < z)%Z -> Zpos (Z2P z) = z.
-Proof.
- simple destruct z; simpl in |- *; auto; intros; discriminate.
-Qed.
-
-Lemma Z2P_correct2 : forall z : Z, 0%Z <> z -> Zpos (Z2P z) = Zabs z.
-Proof.
- simple destruct z; simpl in |- *; auto; intros; elim H; auto.
-Qed.
+Notation Z2P := Z.to_pos (compat "8.3").
+Notation Z2P_correct := Z2Pos.id (compat "8.3").
 
-(** Simplification of fractions using [Zgcd].
+(** Simplification of fractions using [Z.gcd].
   This version can compute within Coq. *)
 
 Definition Qred (q:Q) :=
   let (q1,q2) := q in
-  let (r1,r2) := snd (Zggcd q1 ('q2))
-  in r1#(Z2P r2).
+  let (r1,r2) := snd (Z.ggcd q1 ('q2))
+  in r1#(Z.to_pos r2).
 
 Lemma Qred_correct : forall q, (Qred q) == q.
 Proof.
   unfold Qred, Qeq; intros (n,d); simpl.
-  generalize (Zggcd_gcd n ('d)) (Zgcd_is_pos n ('d))
-    (Zgcd_is_gcd n ('d)) (Zggcd_correct_divisors n ('d)).
-  destruct (Zggcd n (Zpos d)) as (g,(nn,dd)); simpl.
+  generalize (Z.ggcd_gcd n ('d)) (Z.gcd_nonneg n ('d))
+    (Z.ggcd_correct_divisors n ('d)).
+  destruct (Z.ggcd n (Zpos d)) as (g,(nn,dd)); simpl.
   Open Scope Z_scope.
-  intuition.
-  rewrite <- H in H0,H1; clear H.
-  rewrite H3; rewrite H4.
-  assert (0 <> g).
-  intro; subst g; discriminate.
-
-  assert (0 < dd).
-  apply Zmult_gt_0_lt_0_reg_r with g.
-  omega.
-  rewrite Zmult_comm.
-  rewrite <- H4; compute; auto.
-  rewrite Z2P_correct; auto.
-  ring.
+  intros Hg LE (Hn,Hd). rewrite Hd, Hn.
+  rewrite <- Hg in LE; clear Hg.
+  assert (0 <> g) by (intro; subst; discriminate).
+  rewrite Z2Pos.id. ring.
+  rewrite <- (Z.mul_pos_cancel_l g); [now rewrite <- Hd | omega].
   Close Scope Z_scope.
 Qed.
 
@@ -68,71 +42,54 @@ Proof.
   intros (a,b) (c,d).
   unfold Qred, Qeq in *; simpl in *.
   Open Scope Z_scope.
-  generalize (Zggcd_gcd a ('b)) (Zgcd_is_gcd a ('b))
-    (Zgcd_is_pos a ('b)) (Zggcd_correct_divisors a ('b)).
-  destruct (Zggcd a (Zpos b)) as (g,(aa,bb)).
-  generalize (Zggcd_gcd c ('d)) (Zgcd_is_gcd c ('d))
-    (Zgcd_is_pos c ('d)) (Zggcd_correct_divisors c ('d)).
-  destruct (Zggcd c (Zpos d)) as (g',(cc,dd)).
-  simpl.
-  intro H; rewrite <- H; clear H.
-  intros Hg'1 Hg'2 (Hg'3,Hg'4).
-  intro H; rewrite <- H; clear H.
-  intros Hg1 Hg2 (Hg3,Hg4).
-  intros.
-  assert (g <> 0).
-  intro; subst g; discriminate.
-  assert (g' <> 0).
-  intro; subst g'; discriminate.
+  intros H.
+  generalize (Z.ggcd_gcd a ('b)) (Zgcd_is_gcd a ('b))
+    (Z.gcd_nonneg a ('b)) (Z.ggcd_correct_divisors a ('b)).
+  destruct (Z.ggcd a (Zpos b)) as (g,(aa,bb)).
+  simpl. intros <- Hg1 Hg2 (Hg3,Hg4).
+  assert (Hg0 : g <> 0) by (intro; now subst g).
+  generalize (Z.ggcd_gcd c ('d)) (Zgcd_is_gcd c ('d))
+    (Z.gcd_nonneg c ('d)) (Z.ggcd_correct_divisors c ('d)).
+  destruct (Z.ggcd c (Zpos d)) as (g',(cc,dd)).
+  simpl. intros <- Hg'1 Hg'2 (Hg'3,Hg'4).
+  assert (Hg'0 : g' <> 0) by (intro; now subst g').
+
   elim (rel_prime_cross_prod aa bb cc dd).
-  congruence.
-  unfold rel_prime in |- *.
-  (*rel_prime*)
-  constructor.
-  exists aa; auto with zarith.
-  exists bb; auto with zarith.
-  intros.
-  inversion Hg1.
-  destruct (H6 (g*x)).
-  rewrite Hg3.
-  destruct H2 as (xa,Hxa); exists xa; rewrite Hxa; ring.
-  rewrite Hg4.
-  destruct H3 as (xb,Hxb); exists xb; rewrite Hxb; ring.
-  exists q.
-  apply Zmult_reg_l with g; auto.
-  pattern g at 1; rewrite H7; ring.
-  (* /rel_prime *)
-  unfold rel_prime in |- *.
-  (* rel_prime *)
-  constructor.
-  exists cc; auto with zarith.
-  exists dd; auto with zarith.
-  intros.
-  inversion Hg'1.
-  destruct (H6 (g'*x)).
-  rewrite Hg'3.
-  destruct H2 as (xc,Hxc); exists xc; rewrite Hxc; ring.
-  rewrite Hg'4.
-  destruct H3 as (xd,Hxd); exists xd; rewrite Hxd; ring.
-  exists q.
-  apply Zmult_reg_l with g'; auto.
-  pattern g' at 1; rewrite H7; ring.
-    (* /rel_prime *)
-  assert (0<bb); [|auto with zarith].
-  apply Zmult_gt_0_lt_0_reg_r with g.
-  omega.
-  rewrite Zmult_comm.
-  rewrite <- Hg4; compute; auto.
-  assert (0<dd); [|auto with zarith].
-  apply Zmult_gt_0_lt_0_reg_r with g'.
-  omega.
-  rewrite Zmult_comm.
-  rewrite <- Hg'4; compute; auto.
-  apply Zmult_reg_l with (g'*g).
-  intro H2; elim (Zmult_integral _ _ H2); auto.
-  replace (g'*g*(aa*dd)) with ((g*aa)*(g'*dd)); [|ring].
-  replace (g'*g*(bb*cc)) with ((g'*cc)*(g*bb)); [|ring].
-  rewrite <- Hg3; rewrite <- Hg4; rewrite <- Hg'3; rewrite <- Hg'4; auto.
+  - congruence.
+  - (*rel_prime*)
+    constructor.
+    * exists aa; auto with zarith.
+    * exists bb; auto with zarith.
+    * intros x Ha Hb.
+      destruct Hg1 as (Hg11,Hg12,Hg13).
+      destruct (Hg13 (g*x)) as (x',Hx).
+      { rewrite Hg3.
+        destruct Ha as (xa,Hxa); exists xa; rewrite Hxa; ring. }
+      { rewrite Hg4.
+        destruct Hb as (xb,Hxb); exists xb; rewrite Hxb; ring. }
+      exists x'.
+      apply Z.mul_reg_l with g; auto. rewrite Hx at 1; ring.
+  - (* rel_prime *)
+    constructor.
+    * exists cc; auto with zarith.
+    * exists dd; auto with zarith.
+    * intros x Hc Hd.
+      inversion Hg'1 as (Hg'11,Hg'12,Hg'13).
+      destruct (Hg'13 (g'*x)) as (x',Hx).
+      { rewrite Hg'3.
+        destruct Hc as (xc,Hxc); exists xc; rewrite Hxc; ring. }
+      { rewrite Hg'4.
+        destruct Hd as (xd,Hxd); exists xd; rewrite Hxd; ring. }
+      exists x'.
+      apply Z.mul_reg_l with g'; auto. rewrite Hx at 1; ring.
+  - apply Z.lt_gt.
+    rewrite <- (Z.mul_pos_cancel_l g); [now rewrite <- Hg4 | omega].
+  - apply Z.lt_gt.
+    rewrite <- (Z.mul_pos_cancel_l g'); [now rewrite <- Hg'4 | omega].
+  - apply Z.mul_reg_l with (g*g').
+    * rewrite Z.mul_eq_0. now destruct 1.
+    * rewrite Z.mul_shuffle1, <- Hg3, <- Hg'4.
+      now rewrite Z.mul_shuffle1, <- Hg'3, <- Hg4, H, Z.mul_comm.
   Close Scope Z_scope.
 Qed.
 
@@ -149,39 +106,39 @@ Definition Qminus' x y := Qred (Qminus x y).
 
 Lemma Qplus'_correct : forall p q : Q, (Qplus' p q)==(Qplus p q).
 Proof.
-  intros; unfold Qplus' in |- *; apply Qred_correct; auto.
+  intros; unfold Qplus'; apply Qred_correct; auto.
 Qed.
 
 Lemma Qmult'_correct : forall p q : Q, (Qmult' p q)==(Qmult p q).
 Proof.
-  intros; unfold Qmult' in |- *; apply Qred_correct; auto.
+  intros; unfold Qmult'; apply Qred_correct; auto.
 Qed.
 
 Lemma Qminus'_correct : forall p q : Q, (Qminus' p q)==(Qminus p q).
 Proof.
-  intros; unfold Qminus' in |- *; apply Qred_correct; auto.
+  intros; unfold Qminus'; apply Qred_correct; auto.
 Qed.
 
 Add Morphism Qplus' : Qplus'_comp.
 Proof.
-  intros; unfold Qplus' in |- *.
-  rewrite H; rewrite H0; auto with qarith.
+  intros; unfold Qplus'.
+  rewrite H, H0; auto with qarith.
 Qed.
 
 Add Morphism Qmult' : Qmult'_comp.
-  intros; unfold Qmult' in |- *.
-  rewrite H; rewrite H0; auto with qarith.
+  intros; unfold Qmult'.
+  rewrite H, H0; auto with qarith.
 Qed.
 
 Add Morphism Qminus' : Qminus'_comp.
-  intros; unfold Qminus' in |- *.
-  rewrite H; rewrite H0; auto with qarith.
+  intros; unfold Qminus'.
+  rewrite H, H0; auto with qarith.
 Qed.
 
 Lemma Qred_opp: forall q, Qred (-q) = - (Qred q).
 Proof.
   intros (x, y); unfold Qred; simpl.
-  rewrite Zggcd_opp; case Zggcd; intros p1 (p2, p3); simpl.
+  rewrite Z.ggcd_opp; case Z.ggcd; intros p1 (p2, p3); simpl.
   unfold Qopp; auto.
 Qed.
 
@@ -190,4 +147,3 @@ Theorem Qred_compare: forall x y,
 Proof.
   intros x y; apply Qcompare_comp; apply Qeq_sym; apply Qred_correct.
 Qed.
-
diff --git a/theories/QArith/Qring.v b/theories/QArith/Qring.v
index 173136b8..39e023cf 100644
--- a/theories/QArith/Qring.v
+++ b/theories/QArith/Qring.v
@@ -1,11 +1,9 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Qring.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Qfield.
diff --git a/theories/QArith/Qround.v b/theories/QArith/Qround.v
index 01a97870..be328c27 100644
--- a/theories/QArith/Qround.v
+++ b/theories/QArith/Qround.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -11,16 +11,16 @@ Require Import QArith.
 Lemma Qopp_lt_compat: forall p q : Q, p < q -> - q < - p.
 Proof.
 intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl.
-do 2 rewrite <- Zopp_mult_distr_l; omega.
+rewrite !Z.mul_opp_l; omega.
 Qed.
 
 Hint Resolve Qopp_lt_compat : qarith.
 
 (************)
 
-Coercion Local inject_Z : Z >-> Q.
+Local Coercion inject_Z : Z >-> Q.
 
-Definition Qfloor (x:Q) := let (n,d) := x in Zdiv n (Zpos d).
+Definition Qfloor (x:Q) := let (n,d) := x in Z.div n (Zpos d).
 Definition Qceiling (x:Q) := (-(Qfloor (-x)))%Z.
 
 Lemma Qfloor_Z : forall z:Z, Qfloor z = z.
@@ -46,7 +46,7 @@ simpl.
 unfold Qle.
 simpl.
 replace (n*1)%Z with n by ring.
-rewrite Zmult_comm.
+rewrite Z.mul_comm.
 apply Z_mult_div_ge.
 auto with *.
 Qed.
@@ -81,7 +81,7 @@ ring_simplify.
 replace (n / ' d * ' d + ' d)%Z with
   (('d * (n / 'd) + n mod 'd) + 'd - n mod 'd)%Z by ring.
 rewrite <- Z_div_mod_eq; auto with*.
-rewrite <- Zlt_plus_swap.
+rewrite <- Z.lt_add_lt_sub_r.
 destruct (Z_mod_lt n ('d)); auto with *.
 Qed.
 
@@ -107,7 +107,7 @@ unfold Qle in *.
 simpl in *.
 rewrite <- (Zdiv_mult_cancel_r xn ('xd) ('yd)); auto with *.
 rewrite <- (Zdiv_mult_cancel_r yn ('yd) ('xd)); auto with *.
-rewrite (Zmult_comm ('yd) ('xd)).
+rewrite (Z.mul_comm ('yd) ('xd)).
 apply Z_div_le; auto with *.
 Qed.
 
@@ -125,7 +125,7 @@ Hint Resolve Qceiling_resp_le : qarith.
 Add Morphism Qfloor with signature Qeq ==> eq as Qfloor_comp.
 Proof.
 intros x y H.
-apply Zle_antisym.
+apply Z.le_antisymm.
  auto with *.
 symmetry in H; auto with *.
 Qed.
@@ -133,7 +133,18 @@ Qed.
 Add Morphism Qceiling with signature Qeq ==> eq as Qceiling_comp.
 Proof.
 intros x y H.
-apply Zle_antisym.
+apply Z.le_antisymm.
  auto with *.
 symmetry in H; auto with *.
-Qed.
\ No newline at end of file
+Qed.
+
+Lemma Zdiv_Qdiv (n m: Z): (n / m)%Z = Qfloor (n / m).
+Proof.
+ unfold Qfloor. intros. simpl.
+ destruct m as [?|?|p]; simpl.
+  now rewrite Zdiv_0_r, Z.mul_0_r.
+  now rewrite Z.mul_1_r.
+ rewrite <- Z.opp_eq_mul_m1.
+ rewrite <- (Z.opp_involutive (Zpos p)).
+ now rewrite Zdiv_opp_opp.
+Qed.
diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v
index 092eafa3..13b33301 100644
--- a/theories/Reals/Alembert.v
+++ b/theories/Reals/Alembert.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Alembert.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rseries.
@@ -15,7 +13,7 @@ Require Import SeqProp.
 Require Import PartSum.
 Require Import Max.
 
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (***************************************************)
 (* Various versions of the criterion of D'Alembert *)
@@ -33,23 +31,23 @@ Proof.
       { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }).
   intro X; apply X.
   apply completeness.
-  unfold Un_cv in H0; unfold bound in |- *; cut (0 < / 2);
+  unfold Un_cv in H0; unfold bound; cut (0 < / 2);
     [ intro | apply Rinv_0_lt_compat; prove_sup0 ].
   elim (H0 (/ 2) H1); intros.
   exists (sum_f_R0 An x + 2 * An (S x)).
-  unfold is_upper_bound in |- *; intros; unfold EUn in H3; elim H3; intros.
+  unfold is_upper_bound; intros; unfold EUn in H3; elim H3; intros.
   rewrite H4; assert (H5 := lt_eq_lt_dec x1 x).
   elim H5; intros.
   elim a; intro.
   replace (sum_f_R0 An x) with
     (sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)).
-  pattern (sum_f_R0 An x1) at 1 in |- *; rewrite <- Rplus_0_r;
+  pattern (sum_f_R0 An x1) at 1; rewrite <- Rplus_0_r;
     rewrite Rplus_assoc; apply Rplus_le_compat_l.
   left; apply Rplus_lt_0_compat.
   apply tech1; intros; apply H.
   apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
-  symmetry  in |- *; apply tech2; assumption.
-  rewrite b; pattern (sum_f_R0 An x) at 1 in |- *; rewrite <- Rplus_0_r;
+  symmetry ; apply tech2; assumption.
+  rewrite b; pattern (sum_f_R0 An x) at 1; rewrite <- Rplus_0_r;
     apply Rplus_le_compat_l.
   left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
   replace (sum_f_R0 An x1) with
@@ -66,14 +64,14 @@ Proof.
   left; apply H.
   rewrite tech3.
   replace (1 - / 2) with (/ 2).
-  unfold Rdiv in |- *; rewrite Rinv_involutive.
-  pattern 2 at 3 in |- *; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2);
+  unfold Rdiv; rewrite Rinv_involutive.
+  pattern 2 at 3; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2);
     apply Rmult_le_compat_l.
   left; prove_sup0.
   left; apply Rplus_lt_reg_r with ((/ 2) ^ S (x1 - S x)).
   replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1;
     [ idtac | ring ].
-  rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+  rewrite <- (Rplus_comm 1); pattern 1 at 1; rewrite <- Rplus_0_r;
     apply Rplus_lt_compat_l.
   apply pow_lt; apply Rinv_0_lt_compat; prove_sup0.
   discrR.
@@ -82,14 +80,14 @@ Proof.
   ring.
   discrR.
   discrR.
-  pattern 1 at 3 in |- *; replace 1 with (/ 1);
+  pattern 1 at 3; replace 1 with (/ 1);
     [ apply tech7; discrR | apply Rinv_1 ].
   replace (An (S x)) with (An (S x + 0)%nat).
   apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)).
   left; apply Rinv_0_lt_compat; prove_sup0.
   intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n).
   intro; replace (S x + S i)%nat with (S (S x + i)).
-  apply H6; unfold ge in |- *; apply tech8.
+  apply H6; unfold ge; apply tech8.
   apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring.
   intros; unfold R_dist in H2; apply Rmult_lt_reg_l with (/ An n).
   apply Rinv_0_lt_compat; apply H.
@@ -98,20 +96,20 @@ Proof.
   rewrite Rmult_1_r;
     replace (An (S n) * / An n) with (Rabs (Rabs (An (S n) / An n) - 0)).
   apply H2; assumption.
-  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+  unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r;
     rewrite Rabs_Rabsolu; rewrite Rabs_right.
-  unfold Rdiv in |- *; reflexivity.
-  left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *;
+  unfold Rdiv; reflexivity.
+  left; unfold Rdiv; change (0 < An (S n) * / An n);
     apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ].
-  red in |- *; intro; assert (H8 := H n); rewrite H7 in H8;
+  red; intro; assert (H8 := H n); rewrite H7 in H8;
     elim (Rlt_irrefl _ H8).
   replace (S x + 0)%nat with (S x); [ reflexivity | ring ].
-  symmetry  in |- *; apply tech2; assumption.
-  exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity.
+  symmetry ; apply tech2; assumption.
+  exists (sum_f_R0 An 0); unfold EUn; exists 0%nat; reflexivity.
   intro X; elim X; intros.
-  exists x; apply tech10;
-    [ unfold Un_growing in |- *; intro; rewrite tech5;
-      pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
+  exists x; apply Un_cv_crit_lub;
+    [ unfold Un_growing; intro; rewrite tech5;
+      pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r;
 	apply Rplus_le_compat_l; left; apply H
       | apply p ].
 Defined.
@@ -133,14 +131,14 @@ Proof.
   assert (H6 := Alembert_C1 Wn H2 H4).
   elim H5; intros.
   elim H6; intros.
-  exists (x - x0); unfold Un_cv in |- *; unfold Un_cv in p;
+  exists (x - x0); unfold Un_cv; unfold Un_cv in p;
     unfold Un_cv in p0; intros; cut (0 < eps / 2).
   intro; elim (p (eps / 2) H8); clear p; intros.
   elim (p0 (eps / 2) H8); clear p0; intros.
   set (N := max x1 x2).
   exists N; intros;
     replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n).
-  unfold R_dist in |- *;
+  unfold R_dist;
     replace (sum_f_R0 Vn n - sum_f_R0 Wn n - (x - x0)) with
       (sum_f_R0 Vn n - x + - (sum_f_R0 Wn n - x0)); [ idtac | ring ];
       apply Rle_lt_trans with
@@ -148,29 +146,29 @@ Proof.
   apply Rabs_triang.
   rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2).
   apply Rplus_lt_compat.
-  unfold R_dist in H9; apply H9; unfold ge in |- *; apply le_trans with N;
-    [ unfold N in |- *; apply le_max_l | assumption ].
-  unfold R_dist in H10; apply H10; unfold ge in |- *; apply le_trans with N;
-    [ unfold N in |- *; apply le_max_r | assumption ].
-  right; symmetry  in |- *; apply double_var.
-  symmetry  in |- *; apply tech11; intro; unfold Vn, Wn in |- *;
-    unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2));
+  unfold R_dist in H9; apply H9; unfold ge; apply le_trans with N;
+    [ unfold N; apply le_max_l | assumption ].
+  unfold R_dist in H10; apply H10; unfold ge; apply le_trans with N;
+    [ unfold N; apply le_max_r | assumption ].
+  right; symmetry ; apply double_var.
+  symmetry ; apply tech11; intro; unfold Vn, Wn;
+    unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ 2));
       apply Rmult_eq_reg_l with 2.
   rewrite Rmult_minus_distr_l; repeat rewrite <- Rmult_assoc;
     rewrite <- Rinv_r_sym.
   ring.
   discrR.
   discrR.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   cut (forall n:nat, / 2 * Rabs (An n) <= Wn n <= 3 * / 2 * Rabs (An n)).
   intro; cut (forall n:nat, / Wn n <= 2 * / Rabs (An n)).
   intro; cut (forall n:nat, Wn (S n) / Wn n <= 3 * Rabs (An (S n) / An n)).
-  intro; unfold Un_cv in |- *; intros; unfold Un_cv in H0; cut (0 < eps / 3).
+  intro; unfold Un_cv; intros; unfold Un_cv in H0; cut (0 < eps / 3).
   intro; elim (H0 (eps / 3) H8); intros.
   exists x; intros.
   assert (H11 := H9 n H10).
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+  unfold R_dist; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H11;
       unfold Rminus in H11; rewrite Ropp_0 in H11; rewrite Rplus_0_r in H11;
 	rewrite Rabs_Rabsolu in H11; rewrite Rabs_right.
@@ -181,13 +179,13 @@ Proof.
   rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ];
     rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H11;
       exact H11.
-  left; change (0 < Wn (S n) / Wn n) in |- *; unfold Rdiv in |- *;
+  left; change (0 < Wn (S n) / Wn n); unfold Rdiv;
     apply Rmult_lt_0_compat.
   apply H2.
   apply Rinv_0_lt_compat; apply H2.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-  intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc;
+  intro; unfold Rdiv; rewrite Rabs_mult; rewrite <- Rmult_assoc;
     replace 3 with (2 * (3 * / 2));
       [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ];
       apply Rle_trans with (Wn (S n) * 2 * / Rabs (An n)).
@@ -220,32 +218,32 @@ Proof.
   rewrite Rmult_1_l; elim (H4 n); intros; assumption.
   discrR.
   apply Rabs_no_R0; apply H.
-  red in |- *; intro; assert (H6 := H2 n); rewrite H5 in H6;
+  red; intro; assert (H6 := H2 n); rewrite H5 in H6;
     elim (Rlt_irrefl _ H6).
   intro; split.
-  unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+  unfold Wn; unfold Rdiv; rewrite <- (Rmult_comm (/ 2));
     apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; prove_sup0.
-  pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double;
-    unfold Rminus in |- *; rewrite Rplus_assoc; apply Rplus_le_compat_l.
+  pattern (Rabs (An n)) at 1; rewrite <- Rplus_0_r; rewrite double;
+    unfold Rminus; rewrite Rplus_assoc; apply Rplus_le_compat_l.
   apply Rplus_le_reg_l with (An n).
   rewrite Rplus_0_r; rewrite (Rplus_comm (An n)); rewrite Rplus_assoc;
     rewrite Rplus_opp_l; rewrite Rplus_0_r; apply RRle_abs.
-  unfold Wn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2));
+  unfold Wn; unfold Rdiv; repeat rewrite <- (Rmult_comm (/ 2));
     repeat rewrite Rmult_assoc; apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; prove_sup0.
-  unfold Rminus in |- *; rewrite double;
+  unfold Rminus; rewrite double;
     replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n));
       [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l.
   rewrite <- Rabs_Ropp; apply RRle_abs.
   cut (forall n:nat, / 2 * Rabs (An n) <= Vn n <= 3 * / 2 * Rabs (An n)).
   intro; cut (forall n:nat, / Vn n <= 2 * / Rabs (An n)).
   intro; cut (forall n:nat, Vn (S n) / Vn n <= 3 * Rabs (An (S n) / An n)).
-  intro; unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / 3).
+  intro; unfold Un_cv; intros; unfold Un_cv in H1; cut (0 < eps / 3).
   intro; elim (H0 (eps / 3) H7); intros.
   exists x; intros.
   assert (H10 := H8 n H9).
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+  unfold R_dist; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H10;
       unfold Rminus in H10; rewrite Ropp_0 in H10; rewrite Rplus_0_r in H10;
 	rewrite Rabs_Rabsolu in H10; rewrite Rabs_right.
@@ -256,13 +254,13 @@ Proof.
   rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ];
     rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H10;
       exact H10.
-  left; change (0 < Vn (S n) / Vn n) in |- *; unfold Rdiv in |- *;
+  left; change (0 < Vn (S n) / Vn n); unfold Rdiv;
     apply Rmult_lt_0_compat.
   apply H1.
   apply Rinv_0_lt_compat; apply H1.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-  intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc;
+  intro; unfold Rdiv; rewrite Rabs_mult; rewrite <- Rmult_assoc;
     replace 3 with (2 * (3 * / 2));
       [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ];
       apply Rle_trans with (Vn (S n) * 2 * / Rabs (An n)).
@@ -295,44 +293,44 @@ Proof.
   rewrite Rmult_1_l; elim (H3 n); intros; assumption.
   discrR.
   apply Rabs_no_R0; apply H.
-  red in |- *; intro; assert (H5 := H1 n); rewrite H4 in H5;
+  red; intro; assert (H5 := H1 n); rewrite H4 in H5;
     elim (Rlt_irrefl _ H5).
   intro; split.
-  unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+  unfold Vn; unfold Rdiv; rewrite <- (Rmult_comm (/ 2));
     apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; prove_sup0.
-  pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double;
+  pattern (Rabs (An n)) at 1; rewrite <- Rplus_0_r; rewrite double;
     rewrite Rplus_assoc; apply Rplus_le_compat_l.
   apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r;
     rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc;
       rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp;
 	apply RRle_abs.
-  unfold Vn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2));
+  unfold Vn; unfold Rdiv; repeat rewrite <- (Rmult_comm (/ 2));
     repeat rewrite Rmult_assoc; apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; prove_sup0.
-  unfold Rminus in |- *; rewrite double;
+  unfold Rminus; rewrite double;
     replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n));
       [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l;
 	apply RRle_abs.
-  intro; unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2));
+  intro; unfold Wn; unfold Rdiv; rewrite <- (Rmult_0_r (/ 2));
     rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
   apply Rinv_0_lt_compat; prove_sup0.
-  apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus in |- *;
+  apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus;
     rewrite (Rplus_comm (An n)); rewrite Rplus_assoc;
       rewrite Rplus_opp_l; rewrite Rplus_0_r;
 	apply Rle_lt_trans with (Rabs (An n)).
   apply RRle_abs.
-  rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r;
+  rewrite double; pattern (Rabs (An n)) at 1; rewrite <- Rplus_0_r;
     apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H.
-  intro; unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2));
+  intro; unfold Vn; unfold Rdiv; rewrite <- (Rmult_0_r (/ 2));
     rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
   apply Rinv_0_lt_compat; prove_sup0.
-  apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus in |- *;
+  apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus;
     rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc;
       rewrite Rplus_opp_r; rewrite Rplus_0_r;
 	apply Rle_lt_trans with (Rabs (An n)).
   rewrite <- Rabs_Ropp; apply RRle_abs.
-  rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r;
+  rewrite double; pattern (Rabs (An n)) at 1; rewrite <- Rplus_0_r;
     apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H.
 Defined.
 
@@ -349,11 +347,11 @@ Proof.
   intro; assert (H4 := Alembert_C2 Bn H2 H3).
   elim H4; intros.
   exists x0; unfold Bn in p; apply tech12; assumption.
-  unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x).
+  unfold Un_cv; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x).
   intro; elim (H1 (eps / Rabs x) H4); intros.
-  exists x0; intros; unfold R_dist in |- *; unfold Rminus in |- *;
+  exists x0; intros; unfold R_dist; unfold Rminus;
     rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu;
-      unfold Bn in |- *;
+      unfold Bn;
 	replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
   rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x).
   apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
@@ -362,22 +360,22 @@ Proof.
   rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H5;
     replace (Rabs (An (S n) / An n)) with (R_dist (Rabs (An (S n) * / An n)) 0).
   apply H5; assumption.
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
-    rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *;
+  unfold R_dist; unfold Rminus; rewrite Ropp_0;
+    rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv;
       reflexivity.
   apply Rabs_no_R0; assumption.
   replace (S n) with (n + 1)%nat; [ idtac | ring ]; rewrite pow_add;
-    unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+    unfold Rdiv; rewrite Rinv_mult_distr.
   replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with
     (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n));
     [ idtac | ring ]; rewrite <- Rinv_r_sym.
-  simpl in |- *; ring.
+  simpl; ring.
   apply pow_nonzero; assumption.
   apply H0.
   apply pow_nonzero; assumption.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ].
-  intro; unfold Bn in |- *; apply prod_neq_R0;
+  intro; unfold Bn; apply prod_neq_R0;
     [ apply H0 | apply pow_nonzero; assumption ].
 Defined.
 
@@ -385,14 +383,14 @@ Lemma AlembertC3_step2 :
   forall (An:nat -> R) (x:R), x = 0 -> { l:R | Pser An x l }.
 Proof.
   intros; exists (An 0%nat).
-  unfold Pser in |- *; unfold infinite_sum in |- *; intros; exists 0%nat; intros;
+  unfold Pser; unfold infinite_sum; intros; exists 0%nat; intros;
     replace (sum_f_R0 (fun n0:nat => An n0 * x ^ n0) n) with (An 0%nat).
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+  unfold R_dist; unfold Rminus; rewrite Rplus_opp_r;
     rewrite Rabs_R0; assumption.
   induction  n as [| n Hrecn].
-  simpl in |- *; ring.
+  simpl; ring.
   rewrite tech5; rewrite Hrecn;
-    [ rewrite H; simpl in |- *; ring | unfold ge in |- *; apply le_O_n ].
+    [ rewrite H; simpl; ring | unfold ge; apply le_O_n ].
 Qed.
 
 (** A useful criterion of convergence for power series *)
@@ -406,11 +404,11 @@ Proof.
   elim s; intro.
   cut (x <> 0).
   intro; apply AlembertC3_step1; assumption.
-  red in |- *; intro; rewrite H1 in a; elim (Rlt_irrefl _ a).
+  red; intro; rewrite H1 in a; elim (Rlt_irrefl _ a).
   apply AlembertC3_step2; assumption.
   cut (x <> 0).
   intro; apply AlembertC3_step1; assumption.
-  red in |- *; intro; rewrite H1 in r; elim (Rlt_irrefl _ r).
+  red; intro; rewrite H1 in r; elim (Rlt_irrefl _ r).
 Defined.
 
 Lemma Alembert_C4 :
@@ -430,8 +428,8 @@ Proof.
   elim H1; intros.
   elim H2; intros.
   elim H4; intros.
-  unfold bound in |- *; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)).
-  unfold is_upper_bound in |- *; intros; unfold EUn in H6.
+  unfold bound; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)).
+  unfold is_upper_bound; intros; unfold EUn in H6.
   elim H6; intros.
   rewrite H7.
   assert (H8 := lt_eq_lt_dec x2 x0).
@@ -439,7 +437,7 @@ Proof.
   elim a; intro.
   replace (sum_f_R0 An x0) with
     (sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)).
-  pattern (sum_f_R0 An x2) at 1 in |- *; rewrite <- Rplus_0_r.
+  pattern (sum_f_R0 An x2) at 1; rewrite <- Rplus_0_r.
   rewrite Rplus_assoc; apply Rplus_le_compat_l.
   left; apply Rplus_lt_0_compat.
   apply tech1.
@@ -448,8 +446,8 @@ Proof.
   apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
     replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
   apply H.
-  symmetry  in |- *; apply tech2; assumption.
-  rewrite b; pattern (sum_f_R0 An x0) at 1 in |- *; rewrite <- Rplus_0_r;
+  symmetry ; apply tech2; assumption.
+  rewrite b; pattern (sum_f_R0 An x0) at 1; rewrite <- Rplus_0_r;
     apply Rplus_le_compat_l.
   left; apply Rmult_lt_0_compat.
   apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
@@ -467,7 +465,7 @@ Proof.
   rewrite <- (Rmult_comm (An (S x0))); apply Rmult_le_compat_l.
   left; apply H.
   rewrite tech3.
-  unfold Rdiv in |- *; apply Rmult_le_reg_l with (1 - x).
+  unfold Rdiv; apply Rmult_le_reg_l with (1 - x).
   apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
   replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
   do 2 rewrite (Rmult_comm (1 - x)).
@@ -475,17 +473,17 @@ Proof.
   rewrite Rmult_1_r; apply Rplus_le_reg_l with (x ^ S (x2 - S x0)).
   replace (x ^ S (x2 - S x0) + (1 - x ^ S (x2 - S x0))) with 1;
     [ idtac | ring ].
-  rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+  rewrite <- (Rplus_comm 1); pattern 1 at 1; rewrite <- Rplus_0_r;
     apply Rplus_le_compat_l.
   left; apply pow_lt.
   apply Rle_lt_trans with k.
   elim Hyp; intros; assumption.
   elim H3; intros; assumption.
   apply Rminus_eq_contra.
-  red in |- *; intro.
+  red; intro.
   elim H3; intros.
   rewrite H10 in H12; elim (Rlt_irrefl _ H12).
-  red in |- *; intro.
+  red; intro.
   elim H3; intros.
   rewrite H10 in H12; elim (Rlt_irrefl _ H12).
   replace (An (S x0)) with (An (S x0 + 0)%nat).
@@ -498,7 +496,7 @@ Proof.
   intro.
   replace (S x0 + S i)%nat with (S (S x0 + i)).
   apply H9.
-  unfold ge in |- *.
+  unfold ge.
   apply tech8.
   apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR;
     ring.
@@ -512,21 +510,21 @@ Proof.
   replace (An (S n) * / An n) with (Rabs (An (S n) / An n)).
   apply H5; assumption.
   rewrite Rabs_right.
-  unfold Rdiv in |- *; reflexivity.
-  left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *;
+  unfold Rdiv; reflexivity.
+  left; unfold Rdiv; change (0 < An (S n) * / An n);
     apply Rmult_lt_0_compat.
   apply H.
   apply Rinv_0_lt_compat; apply H.
-  red in |- *; intro.
+  red; intro.
   assert (H11 := H n).
   rewrite H10 in H11; elim (Rlt_irrefl _ H11).
   replace (S x0 + 0)%nat with (S x0); [ reflexivity | ring ].
-  symmetry  in |- *; apply tech2; assumption.
-  exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity.
+  symmetry ; apply tech2; assumption.
+  exists (sum_f_R0 An 0); unfold EUn; exists 0%nat; reflexivity.
   intro X; elim X; intros.
-  exists x; apply tech10;
-    [ unfold Un_growing in |- *; intro; rewrite tech5;
-      pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
+  exists x; apply Un_cv_crit_lub;
+    [ unfold Un_growing; intro; rewrite tech5;
+      pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r;
 	apply Rplus_le_compat_l; left; apply H
       | apply p ].
 Qed.
@@ -553,9 +551,9 @@ Proof.
   apply (Alembert_C4 (fun i:nat => Rabs (An i)) k).
   assumption.
   intro; apply Rabs_pos_lt; apply H0.
-  unfold Un_cv in |- *.
+  unfold Un_cv.
   unfold Un_cv in H1.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   intros.
   elim (H1 eps H2); intros.
   exists x; intros.
@@ -592,22 +590,22 @@ Lemma Alembert_C6 :
   elim s; intro.
   eapply Alembert_C5 with (k * Rabs x).
   split.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Rdiv; apply Rmult_le_pos.
   left; assumption.
   left; apply Rabs_pos_lt.
-  red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
+  red; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
   apply Rmult_lt_reg_l with (/ k).
   apply Rinv_0_lt_compat; assumption.
   rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   rewrite Rmult_1_r; assumption.
-  red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
   intro; apply prod_neq_R0.
   apply H0.
   apply pow_nonzero.
-  red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
-  unfold Un_cv in |- *; unfold Un_cv in H1.
+  red; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
+  unfold Un_cv; unfold Un_cv in H1.
   intros.
   cut (0 < eps / Rabs x).
   intro.
@@ -615,7 +613,7 @@ Lemma Alembert_C6 :
   exists x0.
   intros.
   replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
-  unfold R_dist in |- *.
+  unfold R_dist.
   rewrite Rabs_mult.
   replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with
     (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ].
@@ -623,18 +621,18 @@ Lemma Alembert_C6 :
   rewrite Rabs_Rabsolu.
   apply Rmult_lt_reg_l with (/ Rabs x).
   apply Rinv_0_lt_compat; apply Rabs_pos_lt.
-  red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
   rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   rewrite <- (Rmult_comm eps).
   unfold R_dist in H5.
-  unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption.
+  unfold Rdiv; unfold Rdiv in H5; apply H5; assumption.
   apply Rabs_no_R0.
-  red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
-  unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  unfold Rdiv; replace (S n) with (n + 1)%nat; [ idtac | ring ].
   rewrite pow_add.
-  simpl in |- *.
+  simpl.
   rewrite Rmult_1_r.
   rewrite Rinv_mult_distr.
   replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with
@@ -643,46 +641,46 @@ Lemma Alembert_C6 :
   rewrite <- Rinv_r_sym.
   rewrite Rmult_1_r; reflexivity.
   apply pow_nonzero.
-  red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
   apply H0.
   apply pow_nonzero.
-  red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  unfold Rdiv; apply Rmult_lt_0_compat.
   assumption.
   apply Rinv_0_lt_compat; apply Rabs_pos_lt.
-  red in |- *; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  red; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a).
   exists (An 0%nat).
-  unfold Un_cv in |- *.
+  unfold Un_cv.
   intros.
   exists 0%nat.
   intros.
-  unfold R_dist in |- *.
+  unfold R_dist.
   replace (sum_f_R0 (fun i:nat => An i * x ^ i) n) with (An 0%nat).
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
   induction  n as [| n Hrecn].
-  simpl in |- *; ring.
+  simpl; ring.
   rewrite tech5.
   rewrite <- Hrecn.
-  rewrite b; simpl in |- *; ring.
-  unfold ge in |- *; apply le_O_n.
+  rewrite b; simpl; ring.
+  unfold ge; apply le_O_n.
   eapply Alembert_C5 with (k * Rabs x).
   split.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Rdiv; apply Rmult_le_pos.
   left; assumption.
   left; apply Rabs_pos_lt.
-  red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
+  red; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
   apply Rmult_lt_reg_l with (/ k).
   apply Rinv_0_lt_compat; assumption.
   rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   rewrite Rmult_1_r; assumption.
-  red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
   intro; apply prod_neq_R0.
   apply H0.
   apply pow_nonzero.
-  red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
-  unfold Un_cv in |- *; unfold Un_cv in H1.
+  red; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
+  unfold Un_cv; unfold Un_cv in H1.
   intros.
   cut (0 < eps / Rabs x).
   intro.
@@ -690,7 +688,7 @@ Lemma Alembert_C6 :
   exists x0.
   intros.
   replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
-  unfold R_dist in |- *.
+  unfold R_dist.
   rewrite Rabs_mult.
   replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with
     (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ].
@@ -698,18 +696,18 @@ Lemma Alembert_C6 :
   rewrite Rabs_Rabsolu.
   apply Rmult_lt_reg_l with (/ Rabs x).
   apply Rinv_0_lt_compat; apply Rabs_pos_lt.
-  red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
   rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   rewrite <- (Rmult_comm eps).
   unfold R_dist in H5.
-  unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption.
+  unfold Rdiv; unfold Rdiv in H5; apply H5; assumption.
   apply Rabs_no_R0.
-  red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
-  unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  unfold Rdiv; replace (S n) with (n + 1)%nat; [ idtac | ring ].
   rewrite pow_add.
-  simpl in |- *.
+  simpl.
   rewrite Rmult_1_r.
   rewrite Rinv_mult_distr.
   replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with
@@ -718,12 +716,12 @@ Lemma Alembert_C6 :
   rewrite <- Rinv_r_sym.
   rewrite Rmult_1_r; reflexivity.
   apply pow_nonzero.
-  red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
   apply H0.
   apply pow_nonzero.
-  red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  unfold Rdiv; apply Rmult_lt_0_compat.
   assumption.
   apply Rinv_0_lt_compat; apply Rabs_pos_lt.
-  red in |- *; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  red; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r).
 Qed.
diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v
index cab14704..69f29781 100644
--- a/theories/Reals/AltSeries.v
+++ b/theories/Reals/AltSeries.v
@@ -1,20 +1,18 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-  (*i $Id: AltSeries.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rseries.
 Require Import SeqProp.
 Require Import PartSum.
 Require Import Max.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (**********)
 (** * Formalization of alternated series *)
@@ -26,13 +24,13 @@ Lemma CV_ALT_step0 :
     Un_decreasing Un ->
     Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))).
 Proof.
-  intros; unfold Un_growing in |- *; intro.
+  intros; unfold Un_growing; intro.
   cut ((2 * S n)%nat = S (S (2 * n))).
   intro; rewrite H0.
   do 4 rewrite tech5; repeat rewrite Rplus_assoc; apply Rplus_le_compat_l.
-  pattern (tg_alt Un (S (2 * n))) at 1 in |- *; rewrite <- Rplus_0_r.
+  pattern (tg_alt Un (S (2 * n))) at 1; rewrite <- Rplus_0_r.
   apply Rplus_le_compat_l.
-  unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
+  unfold tg_alt; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
     rewrite Rmult_1_l.
   apply Rplus_le_reg_l with (Un (S (2 * S n))).
   rewrite Rplus_0_r;
@@ -48,12 +46,12 @@ Lemma CV_ALT_step1 :
     Un_decreasing Un ->
     Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)).
 Proof.
-  intros; unfold Un_decreasing in |- *; intro.
+  intros; unfold Un_decreasing; intro.
   cut ((2 * S n)%nat = S (S (2 * n))).
   intro; rewrite H0; do 2 rewrite tech5; repeat rewrite Rplus_assoc.
-  pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2 in |- *; rewrite <- Rplus_0_r.
+  pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2; rewrite <- Rplus_0_r.
   apply Rplus_le_compat_l.
-  unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
+  unfold tg_alt; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
     rewrite Rmult_1_l.
   apply Rplus_le_reg_l with (Un (S (2 * n))).
   rewrite Rplus_0_r;
@@ -72,7 +70,7 @@ Lemma CV_ALT_step2 :
     sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r.
+  simpl; unfold tg_alt; simpl; rewrite Rmult_1_r.
   replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ].
   apply Rplus_le_reg_l with (Un 1%nat); rewrite Rplus_0_r.
   replace (Un 1%nat + (-1 * Un 1%nat + Un 2%nat)) with (Un 2%nat);
@@ -80,10 +78,10 @@ Proof.
   cut (S (2 * S N) = S (S (S (2 * N)))).
   intro; rewrite H1; do 2 rewrite tech5.
   apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))).
-  pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2 in |- *;
+  pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2;
     rewrite <- Rplus_0_r.
   rewrite Rplus_assoc; apply Rplus_le_compat_l.
-  unfold tg_alt in |- *; rewrite <- H1.
+  unfold tg_alt; rewrite <- H1.
   rewrite pow_1_odd.
   cut (S (S (2 * S N)) = (2 * S (S N))%nat).
   intro; rewrite H2; rewrite pow_1_even; rewrite Rmult_1_l; rewrite <- H2.
@@ -104,7 +102,7 @@ Lemma CV_ALT_step3 :
     positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r.
+  simpl; unfold tg_alt; simpl; rewrite Rmult_1_r.
   apply Rplus_le_reg_l with (Un 1%nat).
   rewrite Rplus_0_r; replace (Un 1%nat + -1 * Un 1%nat) with 0;
     [ apply H0 | ring ].
@@ -114,10 +112,10 @@ Proof.
   rewrite H3; apply CV_ALT_step2; assumption.
   rewrite H3; rewrite tech5.
   apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))).
-  pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2 in |- *;
+  pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2;
     rewrite <- Rplus_0_r.
   apply Rplus_le_compat_l.
-  unfold tg_alt in |- *; simpl in |- *.
+  unfold tg_alt; simpl.
   replace (x + (x + 0))%nat with (2 * x)%nat; [ idtac | ring ].
   rewrite pow_1_even.
   replace (-1 * (-1 * (-1 * 1)) * Un (S (S (S (2 * x))))) with
@@ -135,15 +133,15 @@ Lemma CV_ALT_step4 :
     positivity_seq Un ->
     has_ub (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))).
 Proof.
-  intros; unfold has_ub in |- *; unfold bound in |- *.
+  intros; unfold has_ub; unfold bound.
   exists (Un 0%nat).
-  unfold is_upper_bound in |- *; intros; elim H1; intros.
+  unfold is_upper_bound; intros; elim H1; intros.
   rewrite H2; rewrite decomp_sum.
   replace (tg_alt Un 0) with (Un 0%nat).
-  pattern (Un 0%nat) at 2 in |- *; rewrite <- Rplus_0_r.
+  pattern (Un 0%nat) at 2; rewrite <- Rplus_0_r.
   apply Rplus_le_compat_l.
   apply CV_ALT_step3; assumption.
-  unfold tg_alt in |- *; simpl in |- *; ring.
+  unfold tg_alt; simpl; ring.
   apply lt_O_Sn.
 Qed.
 
@@ -161,11 +159,11 @@ Proof.
   assert (X := growing_cv _ H2 H3).
   elim X; intros.
   exists x.
-  unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
+  unfold Un_cv; unfold R_dist; unfold Un_cv in H1;
     unfold R_dist in H1; unfold Un_cv in p; unfold R_dist in p.
   intros; cut (0 < eps / 2);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
 	[ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
   elim (H1 (eps / 2) H5); intros N2 H6.
   elim (p (eps / 2) H5); intros N1 H7.
@@ -182,32 +180,32 @@ Proof.
   apply Rabs_triang.
   rewrite (double_var eps); apply Rplus_lt_compat.
   rewrite H12; apply H7; assumption.
-  rewrite Rabs_Ropp; unfold tg_alt in |- *; rewrite Rabs_mult;
+  rewrite Rabs_Ropp; unfold tg_alt; rewrite Rabs_mult;
     rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6;
       rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n)));
 	apply H6.
-  unfold ge in |- *; apply le_trans with n.
-  apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ].
+  unfold ge; apply le_trans with n.
+  apply le_trans with N; [ unfold N; apply le_max_r | assumption ].
   apply le_n_Sn.
   rewrite tech5; ring.
   rewrite H12; apply Rlt_trans with (eps / 2).
   apply H7; assumption.
-  unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+  unfold Rdiv; apply Rmult_lt_reg_l with 2.
   prove_sup0.
   rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
     [ rewrite Rmult_1_r | discrR ].
   rewrite double.
-  pattern eps at 1 in |- *; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l;
+  pattern eps at 1; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l;
     assumption.
   elim H10; intro; apply le_double.
   rewrite <- H11; apply le_trans with N.
-  unfold N in |- *; apply le_trans with (S (2 * N1));
+  unfold N; apply le_trans with (S (2 * N1));
     [ apply le_n_Sn | apply le_max_l ].
   assumption.
   apply lt_n_Sm_le.
   rewrite <- H11.
   apply lt_le_trans with N.
-  unfold N in |- *; apply lt_le_trans with (S (2 * N1)).
+  unfold N; apply lt_le_trans with (S (2 * N1)).
   apply lt_n_Sn.
   apply le_max_l.
   assumption.
@@ -224,7 +222,7 @@ Theorem alternated_series :
 Proof.
   intros; apply CV_ALT.
   assumption.
-  unfold positivity_seq in |- *; apply decreasing_ineq; assumption.
+  unfold positivity_seq; apply decreasing_ineq; assumption.
   assumption.
 Qed.
 
@@ -245,31 +243,31 @@ Proof.
   apply (decreasing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N))).
   apply CV_ALT_step1; assumption.
   assumption.
-  unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
+  unfold Un_cv; unfold R_dist; unfold Un_cv in H1;
     unfold R_dist in H1; intros.
   elim (H1 eps H2); intros.
   exists x; intros.
   apply H3.
-  unfold ge in |- *; apply le_trans with (2 * n)%nat.
+  unfold ge; apply le_trans with (2 * n)%nat.
   apply le_trans with n.
   assumption.
   assert (H5 := mult_O_le n 2).
   elim H5; intro.
   cut (0%nat <> 2%nat);
-    [ intro; elim H7; symmetry  in |- *; assumption | discriminate ].
+    [ intro; elim H7; symmetry ; assumption | discriminate ].
   assumption.
   apply le_n_Sn.
-  unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
+  unfold Un_cv; unfold R_dist; unfold Un_cv in H1;
     unfold R_dist in H1; intros.
   elim (H1 eps H2); intros.
   exists x; intros.
   apply H3.
-  unfold ge in |- *; apply le_trans with n.
+  unfold ge; apply le_trans with n.
   assumption.
   assert (H5 := mult_O_le n 2).
   elim H5; intro.
   cut (0%nat <> 2%nat);
-    [ intro; elim H7; symmetry  in |- *; assumption | discriminate ].
+    [ intro; elim H7; symmetry ; assumption | discriminate ].
   assumption.
 Qed.
 
@@ -281,13 +279,13 @@ Definition PI_tg (n:nat) := / INR (2 * n + 1).
 
 Lemma PI_tg_pos : forall n:nat, 0 <= PI_tg n.
 Proof.
-  intro; unfold PI_tg in |- *; left; apply Rinv_0_lt_compat; apply lt_INR_0;
+  intro; unfold PI_tg; left; apply Rinv_0_lt_compat; apply lt_INR_0;
     replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
 Qed.
 
 Lemma PI_tg_decreasing : Un_decreasing PI_tg.
 Proof.
-  unfold PI_tg, Un_decreasing in |- *; intro.
+  unfold PI_tg, Un_decreasing; intro.
   apply Rmult_le_reg_l with (INR (2 * n + 1)).
   apply lt_INR_0.
   replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
@@ -308,7 +306,7 @@ Qed.
 
 Lemma PI_tg_cv : Un_cv PI_tg 0.
 Proof.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   cut (0 < 2 * eps);
     [ intro | apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ].
   assert (H1 := archimed (/ (2 * eps))).
@@ -318,9 +316,9 @@ Proof.
   cut (0 < N)%nat.
   intro; exists N; intros.
   cut (0 < n)%nat.
-  intro; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+  intro; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r;
     rewrite Rabs_right.
-  unfold PI_tg in |- *; apply Rlt_trans with (/ INR (2 * n)).
+  unfold PI_tg; apply Rlt_trans with (/ INR (2 * n)).
   apply Rmult_lt_reg_l with (INR (2 * n)).
   apply lt_INR_0.
   replace (2 * n)%nat with (n + n)%nat; [ idtac | ring ].
@@ -339,27 +337,27 @@ Proof.
     [ discriminate | ring ].
   replace n with (S (pred n)).
   apply not_O_INR; discriminate.
-  symmetry  in |- *; apply S_pred with 0%nat.
+  symmetry ; apply S_pred with 0%nat.
   assumption.
   apply Rle_lt_trans with (/ INR (2 * N)).
   apply Rmult_le_reg_l with (INR (2 * N)).
   rewrite mult_INR; apply Rmult_lt_0_compat;
-    [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ].
+    [ simpl; prove_sup0 | apply lt_INR_0; assumption ].
   rewrite <- Rinv_r_sym.
   apply Rmult_le_reg_l with (INR (2 * n)).
   rewrite mult_INR; apply Rmult_lt_0_compat;
-    [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ].
+    [ simpl; prove_sup0 | apply lt_INR_0; assumption ].
   rewrite (Rmult_comm (INR (2 * n))); rewrite Rmult_assoc;
     rewrite <- Rinv_l_sym.
   do 2 rewrite Rmult_1_r; apply le_INR.
   apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
   replace n with (S (pred n)).
   apply not_O_INR; discriminate.
-  symmetry  in |- *; apply S_pred with 0%nat.
+  symmetry ; apply S_pred with 0%nat.
   assumption.
   replace N with (S (pred N)).
   apply not_O_INR; discriminate.
-  symmetry  in |- *; apply S_pred with 0%nat.
+  symmetry ; apply S_pred with 0%nat.
   assumption.
   rewrite mult_INR.
   rewrite Rinv_mult_distr.
@@ -376,17 +374,17 @@ Proof.
     replace (/ (2 * eps) * (INR N * (2 * eps))) with
       (INR N * (2 * eps * / (2 * eps))); [ idtac | ring ].
   rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_r; replace (INR N) with (IZR (Z_of_nat N)).
+  rewrite Rmult_1_r; replace (INR N) with (IZR (Z.of_nat N)).
   rewrite <- H4.
   elim H1; intros; assumption.
-  symmetry  in |- *; apply INR_IZR_INZ.
+  symmetry ; apply INR_IZR_INZ.
   apply prod_neq_R0;
-    [ discrR | red in |- *; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ].
+    [ discrR | red; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ].
   apply not_O_INR.
-  red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
+  red; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
   replace (INR 2) with 2; [ discrR | reflexivity ].
   apply not_O_INR.
-  red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
+  red; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
   apply Rle_ge; apply PI_tg_pos.
   apply lt_le_trans with N; assumption.
   elim H1; intros H5 _.
@@ -401,7 +399,7 @@ Proof.
   elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)).
   elim (lt_n_O _ b).
   apply le_IZR.
-  simpl in |- *.
+  simpl.
   left; apply Rlt_trans with (/ (2 * eps)).
   apply Rinv_0_lt_compat; assumption.
   elim H1; intros; assumption.
@@ -416,41 +414,41 @@ Proof.
 Qed.
 
 (** Now, PI is defined *)
-Definition PI : R := 4 * (let (a,_) := exist_PI in a).
+Definition Alt_PI : R := 4 * (let (a,_) := exist_PI in a).
 
 (** We can get an approximation of PI with the following inequality *)
-Lemma PI_ineq :
+Lemma Alt_PI_ineq :
   forall N:nat,
-    sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <=
+    sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= Alt_PI / 4 <=
     sum_f_R0 (tg_alt PI_tg) (2 * N).
 Proof.
   intro; apply alternated_series_ineq.
   apply PI_tg_decreasing.
   apply PI_tg_cv.
-  unfold PI in |- *; case exist_PI; intro.
+  unfold Alt_PI; case exist_PI; intro.
   replace (4 * x / 4) with x.
   trivial.
-  unfold Rdiv in |- *; rewrite (Rmult_comm 4); rewrite Rmult_assoc;
+  unfold Rdiv; rewrite (Rmult_comm 4); rewrite Rmult_assoc;
     rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | discrR ].
 Qed.
 
-Lemma PI_RGT_0 : 0 < PI.
+Lemma Alt_PI_RGT_0 : 0 < Alt_PI.
 Proof.
-  assert (H := PI_ineq 0).
+  assert (H := Alt_PI_ineq 0).
   apply Rmult_lt_reg_l with (/ 4).
   apply Rinv_0_lt_compat; prove_sup0.
   rewrite Rmult_0_r; rewrite Rmult_comm.
   elim H; clear H; intros H _.
   unfold Rdiv in H;
     apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))).
-  simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_l;
+  simpl; unfold tg_alt; simpl; rewrite Rmult_1_l;
     rewrite Rmult_1_r; apply Rplus_lt_reg_r with (PI_tg 1).
   rewrite Rplus_0_r;
     replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0);
-      [ unfold PI_tg in |- * | ring ].
-  simpl in |- *; apply Rinv_lt_contravar.
+      [ unfold PI_tg | ring ].
+  simpl; apply Rinv_lt_contravar.
   rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ].
-  rewrite Rplus_comm; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+  rewrite Rplus_comm; pattern 1 at 1; rewrite <- Rplus_0_r;
     apply Rplus_lt_compat_l; prove_sup0.
   assumption.
 Qed.
diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v
index c378a2e2..c817bdfa 100644
--- a/theories/Reals/ArithProp.v
+++ b/theories/Reals/ArithProp.v
@@ -1,25 +1,23 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-  (*i $Id: ArithProp.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rbasic_fun.
 Require Import Even.
 Require Import Div2.
 Require Import ArithRing.
 
-Open Local Scope Z_scope.
-Open Local Scope R_scope.
+Local Open Scope Z_scope.
+Local Open Scope R_scope.
 
 Lemma minus_neq_O : forall n i:nat, (i < n)%nat -> (n - i)%nat <> 0%nat.
 Proof.
-  intros; red in |- *; intro.
+  intros; red; intro.
   cut (forall n m:nat, (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m).
   intro; assert (H2 := H1 _ _ (lt_le_weak _ _ H) H0); rewrite H2 in H;
     elim (lt_irrefl _ H).
@@ -29,11 +27,11 @@ Proof.
       forall n0 m:nat, (m <= n0)%nat -> (n0 - m)%nat = 0%nat -> n0 = m).
   intro; apply H1.
   apply nat_double_ind.
-  unfold R in |- *; intros; inversion H2; reflexivity.
-  unfold R in |- *; intros; simpl in H3; assumption.
-  unfold R in |- *; intros; simpl in H4; assert (H5 := le_S_n _ _ H3);
+  unfold R; intros; inversion H2; reflexivity.
+  unfold R; intros; simpl in H3; assumption.
+  unfold R; intros; simpl in H4; assert (H5 := le_S_n _ _ H3);
     assert (H6 := H2 H5 H4); rewrite H6; reflexivity.
-  unfold R in |- *; intros; apply H1; assumption.
+  unfold R; intros; apply H1; assumption.
 Qed.
 
 Lemma le_minusni_n : forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat.
@@ -43,20 +41,20 @@ Proof.
     ((forall m n:nat, R m n) -> forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat).
   intro; apply H.
   apply nat_double_ind.
-  unfold R in |- *; intros; simpl in |- *; apply le_n.
-  unfold R in |- *; intros; simpl in |- *; apply le_n.
-  unfold R in |- *; intros; simpl in |- *; apply le_trans with n.
+  unfold R; intros; simpl; apply le_n.
+  unfold R; intros; simpl; apply le_n.
+  unfold R; intros; simpl; apply le_trans with n.
   apply H0; apply le_S_n; assumption.
   apply le_n_Sn.
-  unfold R in |- *; intros; apply H; assumption.
+  unfold R; intros; apply H; assumption.
 Qed.
 
 Lemma lt_minus_O_lt : forall m n:nat, (m < n)%nat -> (0 < n - m)%nat.
 Proof.
-  intros n m; pattern n, m in |- *; apply nat_double_ind;
+  intros n m; pattern n, m; apply nat_double_ind;
     [ intros; rewrite <- minus_n_O; assumption
       | intros; elim (lt_n_O _ H)
-      | intros; simpl in |- *; apply H; apply lt_S_n; assumption ].
+      | intros; simpl; apply H; apply lt_S_n; assumption ].
 Qed.
 
 Lemma even_odd_cor :
@@ -75,7 +73,7 @@ Proof.
   apply H3; assumption.
   right.
   apply H4; assumption.
-  unfold double in |- *;ring.
+  unfold double;ring.
 Qed.
 
   (* 2m <= 2n => m<=n *)
@@ -107,9 +105,9 @@ Proof.
   exists (x - IZR k0 * y).
   split.
   ring.
-  unfold k0 in |- *; case (Rcase_abs y); intro.
-  assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl in |- *;
-    unfold Rminus in |- *.
+  unfold k0; case (Rcase_abs y); intro.
+  assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl;
+    unfold Rminus.
   replace (- ((1 + - IZR (up (x / - y))) * y)) with
     ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ].
   split.
@@ -120,7 +118,7 @@ Proof.
   rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse;
     rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ].
   apply Rplus_le_reg_l with (IZR (up (x / - y)) - x / - y).
-  rewrite Rplus_0_r; unfold Rdiv in |- *; pattern (/ - y) at 4 in |- *;
+  rewrite Rplus_0_r; unfold Rdiv; pattern (/ - y) at 4;
     rewrite <- Ropp_inv_permute; [ idtac | assumption ].
   replace
     (IZR (up (x * / - y)) - x * - / y +
@@ -140,11 +138,11 @@ Proof.
   replace (IZR (up (x / - y)) - 1 + (- (x * / y) + - (IZR (up (x / - y)) - 1)))
     with (- (x * / y)); [ idtac | ring ].
   rewrite <- Ropp_mult_distr_r_reverse; rewrite (Ropp_inv_permute _ H); elim H0;
-    unfold Rdiv in |- *; intros H1 _; exact H1.
+    unfold Rdiv; intros H1 _; exact H1.
   apply Ropp_neq_0_compat; assumption.
-  assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl in |- *;
+  assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl;
     cut (0 < y).
-  intro; unfold Rminus in |- *;
+  intro; unfold Rminus;
     replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y);
       [ idtac | ring ].
   split.
@@ -154,7 +152,7 @@ Proof.
     rewrite Rmult_assoc; rewrite <- Rinv_r_sym;
       [ rewrite Rmult_1_r | assumption ];
       apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y);
-	rewrite Rplus_0_r; unfold Rdiv in |- *;
+	rewrite Rplus_0_r; unfold Rdiv;
 	  replace
 	    (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with
 	    1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2;
@@ -168,12 +166,12 @@ Proof.
 	replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y)));
 	  [ idtac | ring ];
 	  replace (IZR (up (x / y)) - 1 + (x * / y + (1 - IZR (up (x / y))))) with
-	    (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv in |- *;
+	    (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv;
 	      intros H2 _; exact H2.
   case (total_order_T 0 y); intro.
   elim s; intro.
   assumption.
-  elim H; symmetry  in |- *; exact b.
+  elim H; symmetry ; exact b.
   assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)).
 Qed.
 
diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v
index 55c30aec..ad076c48 100644
--- a/theories/Reals/Binomial.v
+++ b/theories/Reals/Binomial.v
@@ -1,24 +1,22 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-  (*i $Id: Binomial.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import PartSum.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Definition C (n p:nat) : R :=
   INR (fact n) / (INR (fact p) * INR (fact (n - p))).
 
 Lemma pascal_step1 : forall n i:nat, (i <= n)%nat -> C n i = C n (n - i).
 Proof.
-  intros; unfold C in |- *; replace (n - (n - i))%nat with i.
+  intros; unfold C; replace (n - (n - i))%nat with i.
   rewrite Rmult_comm.
   reflexivity.
   apply plus_minus; rewrite plus_comm; apply le_plus_minus; assumption.
@@ -28,10 +26,10 @@ Lemma pascal_step2 :
   forall n i:nat,
     (i <= n)%nat -> C (S n) i = INR (S n) / INR (S n - i) * C n i.
 Proof.
-  intros; unfold C in |- *; replace (S n - i)%nat with (S (n - i)).
+  intros; unfold C; replace (S n - i)%nat with (S (n - i)).
   cut (forall n:nat, fact (S n) = (S n * fact n)%nat).
   intro; repeat rewrite H0.
-  unfold Rdiv in |- *; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr.
+  unfold Rdiv; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr.
   ring.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
@@ -48,13 +46,13 @@ Qed.
 Lemma pascal_step3 :
   forall n i:nat, (i < n)%nat -> C n (S i) = INR (n - i) / INR (S i) * C n i.
 Proof.
-  intros; unfold C in |- *.
+  intros; unfold C.
   cut (forall n:nat, fact (S n) = (S n * fact n)%nat).
   intro.
   cut ((n - i)%nat = S (n - S i)).
   intro.
-  pattern (n - i)%nat at 2 in |- *; rewrite H1.
-  repeat rewrite H0; unfold Rdiv in |- *; repeat rewrite mult_INR;
+  pattern (n - i)%nat at 2; rewrite H1.
+  repeat rewrite H0; unfold Rdiv; repeat rewrite mult_INR;
     repeat rewrite Rinv_mult_distr.
   rewrite <- H1; rewrite (Rmult_comm (/ INR (n - i)));
     repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (n - i)));
@@ -70,7 +68,7 @@ Proof.
   apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ].
   apply INR_fact_neq_0.
   rewrite minus_Sn_m.
-  simpl in |- *; reflexivity.
+  simpl; reflexivity.
   apply lt_le_S; assumption.
   intro; reflexivity.
 Qed.
@@ -97,13 +95,13 @@ Proof.
   rewrite <- minus_Sn_m.
   cut ((n - (n - i))%nat = i).
   intro; rewrite H0; reflexivity.
-  symmetry  in |- *; apply plus_minus.
+  symmetry ; apply plus_minus.
   rewrite plus_comm; rewrite le_plus_minus_r.
   reflexivity.
   apply lt_le_weak; assumption.
   apply le_minusni_n; apply lt_le_weak; assumption.
   apply lt_le_weak; assumption.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   repeat rewrite S_INR.
   rewrite minus_INR.
   cut (INR i + 1 <> 0).
@@ -127,18 +125,18 @@ Lemma binomial :
     (x + y) ^ n = sum_f_R0 (fun i:nat => C n i * x ^ i * y ^ (n - i)) n.
 Proof.
   intros; induction  n as [| n Hrecn].
-  unfold C in |- *; simpl in |- *; unfold Rdiv in |- *;
+  unfold C; simpl; unfold Rdiv;
     repeat rewrite Rmult_1_r; rewrite Rinv_1; ring.
-  pattern (S n) at 1 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  pattern (S n) at 1; replace (S n) with (n + 1)%nat; [ idtac | ring ].
   rewrite pow_add; rewrite Hrecn.
-  replace ((x + y) ^ 1) with (x + y); [ idtac | simpl in |- *; ring ].
+  replace ((x + y) ^ 1) with (x + y); [ idtac | simpl; ring ].
   rewrite tech5.
   cut (forall p:nat, C p p = 1).
   cut (forall p:nat, C p 0 = 1).
   intros; rewrite H0; rewrite <- minus_n_n; rewrite Rmult_1_l.
-  replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl in |- *; reflexivity ].
+  replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl; reflexivity ].
   induction  n as [| n Hrecn0].
-  simpl in |- *; do 2 rewrite H; ring.
+  simpl; do 2 rewrite H; ring.
   (* N >= 1 *)
   set (N := S n).
   rewrite Rmult_plus_distr_l.
@@ -160,7 +158,7 @@ Proof.
   rewrite (Rplus_comm (sum_f_R0 An n)).
   repeat rewrite Rplus_assoc.
   rewrite <- tech5.
-  fold N in |- *.
+  fold N.
   set (Cn := fun i:nat => C N i * x ^ i * y ^ (S N - i)).
   cut (forall i:nat, (i < N)%nat -> Cn (S i) = Bn i).
   intro; replace (sum_f_R0 Bn n) with (sum_f_R0 (fun i:nat => Cn (S i)) n).
@@ -168,42 +166,42 @@ Proof.
   rewrite <- Rplus_assoc; rewrite (decomp_sum Cn N).
   replace (pred N) with n.
   ring.
-  unfold N in |- *; simpl in |- *; reflexivity.
-  unfold N in |- *; apply lt_O_Sn.
-  unfold Cn in |- *; rewrite H; simpl in |- *; ring.
+  unfold N; simpl; reflexivity.
+  unfold N; apply lt_O_Sn.
+  unfold Cn; rewrite H; simpl; ring.
   apply sum_eq.
   intros; apply H1.
-  unfold N in |- *; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ].
-  intros; unfold Bn, Cn in |- *.
+  unfold N; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ].
+  intros; unfold Bn, Cn.
   replace (S N - S i)%nat with (N - i)%nat; reflexivity.
-  unfold An in |- *; fold N in |- *; rewrite <- minus_n_n; rewrite H0;
-    simpl in |- *; ring.
+  unfold An; fold N; rewrite <- minus_n_n; rewrite H0;
+    simpl; ring.
   apply sum_eq.
-  intros; unfold An, Bn in |- *; replace (S N - S i)%nat with (N - i)%nat;
+  intros; unfold An, Bn; replace (S N - S i)%nat with (N - i)%nat;
     [ idtac | reflexivity ].
   rewrite <- pascal;
     [ ring
-      | apply le_lt_trans with n; [ assumption | unfold N in |- *; apply lt_n_Sn ] ].
-  unfold N in |- *; reflexivity.
-  unfold N in |- *; apply lt_O_Sn.
+      | apply le_lt_trans with n; [ assumption | unfold N; apply lt_n_Sn ] ].
+  unfold N; reflexivity.
+  unfold N; apply lt_O_Sn.
   rewrite <- (Rmult_comm y); rewrite scal_sum; apply sum_eq.
   intros; replace (S N - i)%nat with (S (N - i)).
   replace (S (N - i)) with (N - i + 1)%nat; [ idtac | ring ].
-  rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl in |- *; ring ];
+  rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl; ring ];
     ring.
   apply minus_Sn_m; assumption.
   rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq.
   intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add;
-    replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ];
+    replace (x ^ 1) with x; [ idtac | simpl; ring ];
       ring.
-  intro; unfold C in |- *.
+  intro; unfold C.
   replace (INR (fact 0)) with 1; [ idtac | reflexivity ].
   replace (p - 0)%nat with p; [ idtac | apply minus_n_O ].
-  rewrite Rmult_1_l; unfold Rdiv in |- *; rewrite <- Rinv_r_sym;
+  rewrite Rmult_1_l; unfold Rdiv; rewrite <- Rinv_r_sym;
     [ reflexivity | apply INR_fact_neq_0 ].
-  intro; unfold C in |- *.
+  intro; unfold C.
   replace (p - p)%nat with 0%nat; [ idtac | apply minus_n_n ].
   replace (INR (fact 0)) with 1; [ idtac | reflexivity ].
-  rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym;
+  rewrite Rmult_1_r; unfold Rdiv; rewrite <- Rinv_r_sym;
     [ reflexivity | apply INR_fact_neq_0 ].
 Qed.
diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v
index 1a2e5eca..f6a48adc 100644
--- a/theories/Reals/Cauchy_prod.v
+++ b/theories/Reals/Cauchy_prod.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-  (*i $Id: Cauchy_prod.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rseries.
 Require Import PartSum.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
   (**********)
 Lemma sum_N_predN :
@@ -23,7 +21,7 @@ Proof.
   replace N with (S (pred N)).
   rewrite tech5.
   reflexivity.
-  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  symmetry ; apply S_pred with 0%nat; assumption.
 Qed.
 
   (**********)
@@ -53,7 +51,7 @@ Proof.
   elim (lt_irrefl _ H).
   cut (N = 0%nat \/ (0 < N)%nat).
   intro; elim H0; intro.
-  rewrite H1; simpl in |- *; ring.
+  rewrite H1; simpl; ring.
   replace (pred (S N)) with (S (pred N)).
   do 5 rewrite tech5.
   rewrite Rmult_plus_distr_r; rewrite Rmult_plus_distr_l; rewrite (HrecN H1).
@@ -68,7 +66,7 @@ Proof.
       repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
   rewrite <- minus_n_n; cut (N = 1%nat \/ (2 <= N)%nat).
   intro; elim H2; intro.
-  rewrite H3; simpl in |- *; ring.
+  rewrite H3; simpl; ring.
   replace
     (sum_f_R0
       (fun k:nat =>
@@ -149,7 +147,7 @@ Proof.
       (pred (pred N))).
   repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
   replace (pred (N - pred N)) with 0%nat.
-  simpl in |- *; rewrite <- minus_n_O.
+  simpl; rewrite <- minus_n_O.
   replace (S (pred N)) with N.
   replace (sum_f_R0 (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))) with
     (sum_f_R0 (fun k:nat => Bn (S k) * An (S N)) (pred (pred N))).
@@ -163,11 +161,11 @@ Proof.
   apply S_pred with 0%nat; assumption.
   replace (N - pred N)%nat with 1%nat.
   reflexivity.
-  pattern N at 1 in |- *; replace N with (S (pred N)).
+  pattern N at 1; replace N with (S (pred N)).
   rewrite <- minus_Sn_m.
   rewrite <- minus_n_n; reflexivity.
   apply le_n.
-  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  symmetry ; apply S_pred with 0%nat; assumption.
   apply sum_eq; intros;
     rewrite
       (sum_N_predN (fun l:nat => An (S (S (l + i))) * Bn (N - l)%nat)
@@ -261,7 +259,7 @@ Proof.
   apply le_n.
   apply (fun p n m:nat => plus_le_reg_l n m p) with 1%nat.
   rewrite le_plus_minus_r.
-  simpl in |- *; assumption.
+  simpl; assumption.
   apply le_trans with 2%nat; [ apply le_n_Sn | assumption ].
   apply le_trans with 2%nat; [ apply le_n_Sn | assumption ].
   simpl; ring.
@@ -276,7 +274,7 @@ Proof.
   apply le_trans with (pred (pred N)).
   assumption.
   apply le_pred_n.
-  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  symmetry ; apply S_pred with 0%nat; assumption.
   apply INR_eq; rewrite S_INR; rewrite plus_INR; reflexivity.
   apply le_trans with (pred (pred N)).
   assumption.
@@ -429,7 +427,7 @@ Proof.
   apply le_trans with (pred (pred N)).
   assumption.
   apply le_pred_n.
-  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  symmetry ; apply S_pred with 0%nat; assumption.
   apply INR_eq; rewrite S_INR; rewrite plus_INR; simpl; ring.
   apply le_trans with (pred (pred N)).
   assumption.
@@ -443,11 +441,11 @@ Proof.
   inversion H1.
   left; reflexivity.
   right; apply le_n_S; assumption.
-  simpl in |- *.
+  simpl.
   replace (S (pred N)) with N.
   reflexivity.
   apply S_pred with 0%nat; assumption.
-  simpl in |- *.
+  simpl.
   cut ((N - pred N)%nat = 1%nat).
   intro; rewrite H2; reflexivity.
   rewrite pred_of_minus.
@@ -455,7 +453,7 @@ Proof.
   simpl; ring.
   apply lt_le_S; assumption.
   rewrite <- pred_of_minus; apply le_pred_n.
-  simpl in |- *; symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  simpl; symmetry ; apply S_pred with 0%nat; assumption.
   inversion H.
   left; reflexivity.
   right; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | exact H1 ].
diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v
index 32480b0b..c296d427 100644
--- a/theories/Reals/Cos_plus.v
+++ b/theories/Reals/Cos_plus.v
@@ -1,21 +1,19 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-  (*i $Id: Cos_plus.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
 Require Import Rtrigo_def.
 Require Import Cos_rel.
 Require Import Max.
-Open Local Scope nat_scope.
-Open Local Scope R_scope.
+Local Open Scope nat_scope.
+Local Open Scope R_scope.
 
 Definition Majxy (x y:R) (n:nat) : R :=
   Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S n) / INR (fact n).
@@ -31,23 +29,23 @@ Proof.
   intro.
   assert (H1 := cv_speed_pow_fact C0).
   unfold Un_cv in H1; unfold R_dist in H1.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   cut (0 < eps / C0);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
 	[ assumption | apply Rinv_0_lt_compat; assumption ] ].
   elim (H1 (eps / C0) H3); intros N0 H4.
   exists N0; intros.
   replace (Majxy x y n) with (C0 ^ S n / INR (fact n)).
-  simpl in |- *.
+  simpl.
   apply Rmult_lt_reg_l with (Rabs (/ C0)).
   apply Rabs_pos_lt.
   apply Rinv_neq_0_compat.
-  red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
+  red; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
   rewrite <- Rabs_mult.
-  unfold Rminus in |- *; rewrite Rmult_plus_distr_l.
+  unfold Rminus; rewrite Rmult_plus_distr_l.
   rewrite Ropp_0; rewrite Rmult_0_r.
-  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  unfold Rdiv; repeat rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   rewrite (Rabs_right (/ C0)).
@@ -56,15 +54,15 @@ Proof.
     [ idtac | ring ].
   unfold Rdiv in H4; apply H4; assumption.
   apply Rle_ge; left; apply Rinv_0_lt_compat; assumption.
-  red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
-  unfold Majxy in |- *.
-  unfold C0 in |- *.
+  red; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
+  unfold Majxy.
+  unfold C0.
   rewrite pow_mult.
-  unfold C in |- *; reflexivity.
-  unfold C0 in |- *; apply pow_lt; assumption.
+  unfold C; reflexivity.
+  unfold C0; apply pow_lt; assumption.
   apply Rlt_le_trans with 1.
   apply Rlt_0_1.
-  unfold C in |- *.
+  unfold C.
   apply RmaxLess1.
 Qed.
 
@@ -74,7 +72,7 @@ Lemma reste1_maj :
 Proof.
   intros.
   set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
-  unfold Reste1 in |- *.
+  unfold Reste1.
   apply Rle_trans with
     (sum_f_R0
       (fun k:nat =>
@@ -122,7 +120,7 @@ Proof.
           C ^ (2 * S (N + k))) (pred (N - k))) (pred N)).
   apply sum_Rle; intros.
   apply sum_Rle; intros.
-  unfold Rdiv in |- *; repeat rewrite Rabs_mult.
+  unfold Rdiv; repeat rewrite Rabs_mult.
   do 2 rewrite pow_1_abs.
   do 2 rewrite Rmult_1_l.
   rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n))))).
@@ -144,7 +142,7 @@ Proof.
   apply pow_incr.
   split.
   apply Rabs_pos.
-  unfold C in |- *.
+  unfold C.
   apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2.
   apply Rle_trans with (C ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))).
   do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0)))).
@@ -152,11 +150,11 @@ Proof.
   apply pow_le.
   apply Rle_trans with 1.
   left; apply Rlt_0_1.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   apply pow_incr.
   split.
   apply Rabs_pos.
-  unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+  unfold C; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
   apply RmaxLess1.
   apply RmaxLess2.
   right.
@@ -205,7 +203,7 @@ Proof.
   left; apply Rinv_0_lt_compat.
   rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0.
   apply Rle_pow.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   replace (4 * N)%nat with (2 * (2 * N))%nat; [ idtac | ring ].
   apply (fun m n p:nat => mult_le_compat_l p n m).
   replace (2 * N)%nat with (S (N + pred N)).
@@ -225,33 +223,33 @@ Proof.
   apply pow_le.
   left; apply Rlt_le_trans with 1.
   apply Rlt_0_1.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   replace (/ INR (fact (2 * S (n0 + n)) * fact (2 * (N - n0)))) with
     (Binomial.C (2 * S (N + n)) (2 * S (n0 + n)) / INR (fact (2 * S (N + n)))).
   apply Rle_trans with
     (Binomial.C (2 * S (N + n)) (S (N + n)) / INR (fact (2 * S (N + n)))).
-  unfold Rdiv in |- *;
+  unfold Rdiv;
     do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (N + n))))).
   apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   apply C_maj.
   omega.
   right.
-  unfold Rdiv in |- *; rewrite Rmult_comm.
-  unfold Binomial.C in |- *.
-  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  unfold Rdiv; rewrite Rmult_comm.
+  unfold Binomial.C.
+  unfold Rdiv; repeat rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   replace (2 * S (N + n) - S (N + n))%nat with (S (N + n)).
   rewrite Rinv_mult_distr.
-  unfold Rsqr in |- *; reflexivity.
+  unfold Rsqr; reflexivity.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   omega.
   apply INR_fact_neq_0.
-  unfold Rdiv in |- *; rewrite Rmult_comm.
-  unfold Binomial.C in |- *.
-  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  unfold Rdiv; rewrite Rmult_comm.
+  unfold Binomial.C.
+  unfold Rdiv; repeat rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat.
@@ -273,17 +271,17 @@ Proof.
   apply pow_le.
   left; apply Rlt_le_trans with 1.
   apply Rlt_0_1.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N).
   apply Rmult_le_compat_l.
   apply Rle_0_sqr.
   apply le_INR.
   omega.
-  rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l.
+  rewrite Rmult_comm; unfold Rdiv; apply Rmult_le_compat_l.
   apply pos_INR.
   apply Rle_trans with (/ INR (fact (S (N + n)))).
-  pattern (/ INR (fact (S (N + n)))) at 2 in |- *; rewrite <- Rmult_1_r.
-  unfold Rsqr in |- *.
+  pattern (/ INR (fact (S (N + n)))) at 2; rewrite <- Rmult_1_r.
+  unfold Rsqr.
   apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   apply Rmult_le_reg_l with (INR (fact (S (N + n)))).
@@ -315,14 +313,14 @@ Proof.
   rewrite sum_cte.
   apply Rle_trans with (C ^ (4 * N) / INR (fact (pred N))).
   rewrite <- (Rmult_comm (C ^ (4 * N))).
-  unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  unfold Rdiv; rewrite Rmult_assoc; apply Rmult_le_compat_l.
   apply pow_le.
   left; apply Rlt_le_trans with 1.
   apply Rlt_0_1.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   cut (S (pred N) = N).
   intro; rewrite H0.
-  pattern N at 2 in |- *; rewrite <- H0.
+  pattern N at 2; rewrite <- H0.
   do 2 rewrite fact_simpl.
   rewrite H0.
   repeat rewrite mult_INR.
@@ -331,7 +329,7 @@ Proof.
   repeat rewrite <- Rmult_assoc.
   rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l.
-  pattern (/ INR (fact (pred N))) at 2 in |- *; rewrite <- Rmult_1_r.
+  pattern (/ INR (fact (pred N))) at 2; rewrite <- Rmult_1_r.
   rewrite Rmult_assoc.
   apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
@@ -342,19 +340,19 @@ Proof.
   apply le_INR; apply le_n_Sn.
   apply not_O_INR; discriminate.
   apply not_O_INR.
-  red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
+  red; intro; rewrite H1 in H; elim (lt_irrefl _ H).
   apply not_O_INR.
-  red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
+  red; intro; rewrite H1 in H; elim (lt_irrefl _ H).
   apply INR_fact_neq_0.
   apply not_O_INR; discriminate.
   apply prod_neq_R0.
   apply not_O_INR.
-  red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
+  red; intro; rewrite H1 in H; elim (lt_irrefl _ H).
   apply INR_fact_neq_0.
-  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  symmetry ; apply S_pred with 0%nat; assumption.
   right.
-  unfold Majxy in |- *.
-  unfold C in |- *.
+  unfold Majxy.
+  unfold C.
   replace (S (pred N)) with N.
   reflexivity.
   apply S_pred with 0%nat; assumption.
@@ -365,7 +363,7 @@ Lemma reste2_maj :
 Proof.
   intros.
   set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
-  unfold Reste2 in |- *.
+  unfold Reste2.
   apply Rle_trans with
     (sum_f_R0
       (fun k:nat =>
@@ -417,7 +415,7 @@ Proof.
 	    pred N)).
   apply sum_Rle; intros.
   apply sum_Rle; intros.
-  unfold Rdiv in |- *; repeat rewrite Rabs_mult.
+  unfold Rdiv; repeat rewrite Rabs_mult.
   do 2 rewrite pow_1_abs.
   do 2 rewrite Rmult_1_l.
   rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n) + 1)))).
@@ -439,7 +437,7 @@ Proof.
   apply pow_incr.
   split.
   apply Rabs_pos.
-  unfold C in |- *.
+  unfold C.
   apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2.
   apply Rle_trans with (C ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)).
   do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0) + 1))).
@@ -447,11 +445,11 @@ Proof.
   apply pow_le.
   apply Rle_trans with 1.
   left; apply Rlt_0_1.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   apply pow_incr.
   split.
   apply Rabs_pos.
-  unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+  unfold C; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
   apply RmaxLess1.
   apply RmaxLess2.
   right.
@@ -479,7 +477,7 @@ Proof.
   left; apply Rinv_0_lt_compat.
   rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0.
   apply Rle_pow.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   replace (4 * S N)%nat with (2 * (2 * S N))%nat; [ idtac | ring ].
   apply (fun m n p:nat => mult_le_compat_l p n m).
   replace (2 * S N)%nat with (S (S (N + N))).
@@ -502,14 +500,14 @@ Proof.
   apply pow_le.
   left; apply Rlt_le_trans with 1.
   apply Rlt_0_1.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   replace (/ INR (fact (2 * S (n0 + n) + 1) * fact (2 * (N - n0) + 1))) with
     (Binomial.C (2 * S (S (N + n))) (2 * S (n0 + n) + 1) /
       INR (fact (2 * S (S (N + n))))).
   apply Rle_trans with
     (Binomial.C (2 * S (S (N + n))) (S (S (N + n))) /
       INR (fact (2 * S (S (N + n))))).
-  unfold Rdiv in |- *;
+  unfold Rdiv;
     do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (S (N + n)))))).
   apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
@@ -520,21 +518,21 @@ Proof.
   ring.
   omega.
   right.
-  unfold Rdiv in |- *; rewrite Rmult_comm.
-  unfold Binomial.C in |- *.
-  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  unfold Rdiv; rewrite Rmult_comm.
+  unfold Binomial.C.
+  unfold Rdiv; repeat rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   replace (2 * S (S (N + n)) - S (S (N + n)))%nat with (S (S (N + n))).
   rewrite Rinv_mult_distr.
-  unfold Rsqr in |- *; reflexivity.
+  unfold Rsqr; reflexivity.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   omega.
   apply INR_fact_neq_0.
-  unfold Rdiv in |- *; rewrite Rmult_comm.
-  unfold Binomial.C in |- *.
-  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  unfold Rdiv; rewrite Rmult_comm.
+  unfold Binomial.C.
+  unfold Rdiv; repeat rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with
@@ -558,7 +556,7 @@ Proof.
   apply pow_le.
   left; apply Rlt_le_trans with 1.
   apply Rlt_0_1.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N).
   apply Rmult_le_compat_l.
   apply Rle_0_sqr.
@@ -566,11 +564,11 @@ Proof.
   apply le_INR.
   omega.
   omega.
-  rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l.
+  rewrite Rmult_comm; unfold Rdiv; apply Rmult_le_compat_l.
   apply pos_INR.
   apply Rle_trans with (/ INR (fact (S (S (N + n))))).
-  pattern (/ INR (fact (S (S (N + n))))) at 2 in |- *; rewrite <- Rmult_1_r.
-  unfold Rsqr in |- *.
+  pattern (/ INR (fact (S (S (N + n))))) at 2; rewrite <- Rmult_1_r.
+  unfold Rsqr.
   apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))).
@@ -601,11 +599,11 @@ Proof.
   rewrite sum_cte.
   apply Rle_trans with (C ^ (4 * S N) / INR (fact N)).
   rewrite <- (Rmult_comm (C ^ (4 * S N))).
-  unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  unfold Rdiv; rewrite Rmult_assoc; apply Rmult_le_compat_l.
   apply pow_le.
   left; apply Rlt_le_trans with 1.
   apply Rlt_0_1.
-  unfold C in |- *; apply RmaxLess1.
+  unfold C; apply RmaxLess1.
   cut (S (pred N) = N).
   intro; rewrite H0.
   do 2 rewrite fact_simpl.
@@ -644,10 +642,10 @@ Proof.
   apply INR_fact_neq_0.
   apply not_O_INR; discriminate.
   apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ].
-  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  symmetry ; apply S_pred with 0%nat; assumption.
   right.
-  unfold Majxy in |- *.
-  unfold C in |- *.
+  unfold Majxy.
+  unfold C.
   reflexivity.
 Qed.
 
@@ -656,10 +654,10 @@ Proof.
   intros.
   assert (H := Majxy_cv_R0 x y).
   unfold Un_cv in H; unfold R_dist in H.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   elim (H eps H0); intros N0 H1.
   exists (S N0); intros.
-  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
+  unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
   apply Rle_lt_trans with (Rabs (Majxy x y (pred n))).
   rewrite (Rabs_right (Majxy x y (pred n))).
   apply reste1_maj.
@@ -667,8 +665,8 @@ Proof.
   apply lt_O_Sn.
   assumption.
   apply Rle_ge.
-  unfold Majxy in |- *.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Majxy.
+  unfold Rdiv; apply Rmult_le_pos.
   apply pow_le.
   apply Rle_trans with 1.
   left; apply Rlt_0_1.
@@ -676,7 +674,7 @@ Proof.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   replace (Majxy x y (pred n)) with (Majxy x y (pred n) - 0); [ idtac | ring ].
   apply H1.
-  unfold ge in |- *; apply le_S_n.
+  unfold ge; apply le_S_n.
   replace (S (pred n)) with n.
   assumption.
   apply S_pred with 0%nat.
@@ -688,10 +686,10 @@ Proof.
   intros.
   assert (H := Majxy_cv_R0 x y).
   unfold Un_cv in H; unfold R_dist in H.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   elim (H eps H0); intros N0 H1.
   exists (S N0); intros.
-  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
+  unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
   apply Rle_lt_trans with (Rabs (Majxy x y n)).
   rewrite (Rabs_right (Majxy x y n)).
   apply reste2_maj.
@@ -699,8 +697,8 @@ Proof.
   apply lt_O_Sn.
   assumption.
   apply Rle_ge.
-  unfold Majxy in |- *.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Majxy.
+  unfold Rdiv; apply Rmult_le_pos.
   apply pow_le.
   apply Rle_trans with 1.
   left; apply Rlt_0_1.
@@ -708,7 +706,7 @@ Proof.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   replace (Majxy x y n) with (Majxy x y n - 0); [ idtac | ring ].
   apply H1.
-  unfold ge in |- *; apply le_trans with (S N0).
+  unfold ge; apply le_trans with (S N0).
   apply le_n_Sn.
   exact H2.
 Qed.
@@ -716,7 +714,7 @@ Qed.
 Lemma reste_cv_R0 : forall x y:R, Un_cv (Reste x y) 0.
 Proof.
   intros.
-  unfold Reste in |- *.
+  unfold Reste.
   set (An := fun n:nat => Reste2 x y n).
   set (Bn := fun n:nat => Reste1 x y (S n)).
   cut
@@ -725,21 +723,21 @@ Proof.
   intro.
   apply H.
   apply CV_minus.
-  unfold An in |- *.
+  unfold An.
   replace (fun n:nat => Reste2 x y n) with (Reste2 x y).
   apply reste2_cv_R0.
   reflexivity.
-  unfold Bn in |- *.
+  unfold Bn.
   assert (H0 := reste1_cv_R0 x y).
   unfold Un_cv in H0; unfold R_dist in H0.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   elim (H0 eps H1); intros N0 H2.
   exists N0; intros.
   apply H2.
-  unfold ge in |- *; apply le_trans with (S N0).
+  unfold ge; apply le_trans with (S N0).
   apply le_n_Sn.
   apply le_n_S; assumption.
-  unfold An, Bn in |- *.
+  unfold An, Bn.
   intro.
   replace 0 with (0 - 0); [ idtac | ring ].
   exact H.
@@ -753,7 +751,7 @@ Proof.
   intros.
   apply UL_sequence with (C1 x y); assumption.
   apply C1_cvg.
-  unfold Un_cv in |- *; unfold R_dist in |- *.
+  unfold Un_cv; unfold R_dist.
   intros.
   assert (H0 := A1_cvg x).
   assert (H1 := A1_cvg y).
@@ -766,7 +764,7 @@ Proof.
   unfold R_dist in H4; unfold R_dist in H5; unfold R_dist in H6.
   cut (0 < eps / 3);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
 	[ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
   elim (H4 (eps / 3) H7); intros N1 H8.
   elim (H5 (eps / 3) H7); intros N2 H9.
@@ -790,8 +788,8 @@ Proof.
   replace eps with (eps / 3 + (eps / 3 + eps / 3)).
   apply Rplus_lt_compat.
   apply H8.
-  unfold ge in |- *; apply le_trans with N.
-  unfold N in |- *.
+  unfold ge; apply le_trans with N.
+  unfold N.
   apply le_trans with (max N1 N2).
   apply le_max_l.
   apply le_trans with (max (max N1 N2) N3).
@@ -806,12 +804,12 @@ Proof.
   rewrite <- Rabs_Ropp.
   rewrite Ropp_minus_distr.
   apply H9.
-  unfold ge in |- *; apply le_trans with (max N1 N2).
+  unfold ge; apply le_trans with (max N1 N2).
   apply le_max_r.
   apply le_S_n.
   rewrite <- H12.
   apply le_trans with N.
-  unfold N in |- *.
+  unfold N.
   apply le_n_S.
   apply le_trans with (max (max N1 N2) N3).
   apply le_max_l.
@@ -819,35 +817,35 @@ Proof.
   assumption.
   replace (Reste x y (pred n)) with (Reste x y (pred n) - 0).
   apply H10.
-  unfold ge in |- *.
+  unfold ge.
   apply le_S_n.
   rewrite <- H12.
   apply le_trans with N.
-  unfold N in |- *.
+  unfold N.
   apply le_n_S.
   apply le_trans with (max (max N1 N2) N3).
   apply le_max_r.
   apply le_n_Sn.
   assumption.
   ring.
-  pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)).
+  pattern eps at 4; replace eps with (3 * (eps / 3)).
   ring.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   rewrite <- Rmult_assoc.
   apply Rinv_r_simpl_m.
   discrR.
   apply lt_le_trans with (pred N).
-  unfold N in |- *; simpl in |- *; apply lt_O_Sn.
+  unfold N; simpl; apply lt_O_Sn.
   apply le_S_n.
   rewrite <- H12.
   replace (S (pred N)) with N.
   assumption.
-  unfold N in |- *; simpl in |- *; reflexivity.
+  unfold N; simpl; reflexivity.
   cut (0 < N)%nat.
   intro.
   cut (0 < n)%nat.
   intro.
   apply S_pred with 0%nat; assumption.
   apply lt_le_trans with N; assumption.
-  unfold N in |- *; apply lt_O_Sn.
+  unfold N; apply lt_O_Sn.
 Qed.
diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v
index dec5abd3..9c7472fe 100644
--- a/theories/Reals/Cos_rel.v
+++ b/theories/Reals/Cos_rel.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Cos_rel.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
 Require Import Rtrigo_def.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Definition A1 (x:R) (N:nat) : R :=
   sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) N.
@@ -52,7 +50,7 @@ Theorem cos_plus_form :
    (0 < n)%nat ->
    A1 x (S n) * A1 y (S n) - B1 x n * B1 y n + Reste x y n = C1 x y (S n).
 intros.
-unfold A1, B1 in |- *.
+unfold A1, B1.
 rewrite
  (cauchy_finite (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k))
     (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * y ^ (2 * k)) (
@@ -62,7 +60,7 @@ rewrite
     (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1))
     (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * y ^ (2 * k + 1)) n H)
  .
-unfold Reste in |- *.
+unfold Reste.
 replace
  (sum_f_R0
     (fun k:nat =>
@@ -121,13 +119,13 @@ replace
             ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) *
              y ^ (2 * (k - p) + 1))) k) n) with (sum_f_R0 sin_nnn (S n)).
 rewrite <- sum_plus.
-unfold C1 in |- *.
+unfold C1.
 apply sum_eq; intros.
 induction  i as [| i Hreci].
-simpl in |- *.
-unfold C in |- *; simpl in |- *.
+simpl.
+unfold C; simpl.
 field; discrR.
-unfold sin_nnn in |- *.
+unfold sin_nnn.
 rewrite <- Rmult_plus_distr_l.
 apply Rmult_eq_compat_l.
 rewrite binomial.
@@ -143,13 +141,13 @@ replace
  (sum_f_R0 (fun l:nat => Wn (S (2 * l))) i).
 apply sum_decomposition.
 apply sum_eq; intros.
-unfold Wn in |- *.
+unfold Wn.
 apply Rmult_eq_compat_l.
 replace (2 * S i - S (2 * i0))%nat with (S (2 * (i - i0))).
 reflexivity.
 omega.
 apply sum_eq; intros.
-unfold Wn in |- *.
+unfold Wn.
 apply Rmult_eq_compat_l.
 replace (2 * S i - 2 * i0)%nat with (2 * (S i - i0))%nat.
 reflexivity.
@@ -179,11 +177,11 @@ change (pred (S n)) with n.
    (* replace (pred (S n)) with n; [ idtac | reflexivity ]. *)
 apply sum_eq; intros.
 rewrite Rmult_comm.
-unfold sin_nnn in |- *.
+unfold sin_nnn.
 rewrite scal_sum.
 rewrite scal_sum.
 apply sum_eq; intros.
-unfold Rdiv in |- *.
+unfold Rdiv.
 (*repeat rewrite Rmult_assoc.*)
 (* rewrite (Rmult_comm (/ INR (fact (2 * S i)))). *)
 repeat rewrite <- Rmult_assoc.
@@ -195,13 +193,13 @@ replace (S (2 * i0)) with (2 * i0 + 1)%nat; [ idtac | ring ].
 replace (S (2 * (i - i0))) with (2 * (i - i0) + 1)%nat; [ idtac | ring ].
 replace ((-1) ^ S i) with (-1 * (-1) ^ i0 * (-1) ^ (i - i0)).
 ring.
-simpl in |- *.
-pattern i at 2 in |- *; replace i with (i0 + (i - i0))%nat.
+simpl.
+pattern i at 2; replace i with (i0 + (i - i0))%nat.
 rewrite pow_add.
 ring.
-symmetry  in |- *; apply le_plus_minus; assumption.
-unfold C in |- *.
-unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+symmetry ; apply le_plus_minus; assumption.
+unfold C.
+unfold Rdiv; repeat rewrite <- Rmult_assoc.
 rewrite <- Rinv_l_sym.
 rewrite Rmult_1_l.
 rewrite Rinv_mult_distr.
@@ -219,7 +217,7 @@ apply lt_O_Sn.
 apply sum_eq; intros.
 rewrite scal_sum.
 apply sum_eq; intros.
-unfold Rdiv in |- *.
+unfold Rdiv.
 repeat rewrite <- Rmult_assoc.
 rewrite <- (Rmult_comm (/ INR (fact (2 * i)))).
 repeat rewrite <- Rmult_assoc.
@@ -227,12 +225,12 @@ replace (/ INR (fact (2 * i)) * C (2 * i) (2 * i0)) with
  (/ INR (fact (2 * i0)) * / INR (fact (2 * (i - i0)))).
 replace ((-1) ^ i) with ((-1) ^ i0 * (-1) ^ (i - i0)).
 ring.
-pattern i at 2 in |- *; replace i with (i0 + (i - i0))%nat.
+pattern i at 2; replace i with (i0 + (i - i0))%nat.
 rewrite pow_add.
 ring.
-symmetry  in |- *; apply le_plus_minus; assumption.
-unfold C in |- *.
-unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+symmetry ; apply le_plus_minus; assumption.
+unfold C.
+unfold Rdiv; repeat rewrite <- Rmult_assoc.
 rewrite <- Rinv_l_sym.
 rewrite Rmult_1_l.
 rewrite Rinv_mult_distr.
@@ -242,12 +240,12 @@ omega.
 apply INR_fact_neq_0.
 apply INR_fact_neq_0.
 apply INR_fact_neq_0.
-unfold Reste2 in |- *; apply sum_eq; intros.
+unfold Reste2; apply sum_eq; intros.
 apply sum_eq; intros.
-unfold Rdiv in |- *; ring.
-unfold Reste1 in |- *; apply sum_eq; intros.
+unfold Rdiv; ring.
+unfold Reste1; apply sum_eq; intros.
 apply sum_eq; intros.
-unfold Rdiv in |- *; ring.
+unfold Rdiv; ring.
 apply lt_O_Sn.
 Qed.
 
@@ -268,10 +266,10 @@ unfold R_dist in p.
 cut (cos x = x0).
 intro.
 rewrite H0.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+unfold Un_cv; unfold R_dist; intros.
 elim (p eps H1); intros.
 exists x1; intros.
-unfold A1 in |- *.
+unfold A1.
 replace
  (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) n) with
  (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * (x * x) ^ i) n).
@@ -281,9 +279,9 @@ intros.
 replace ((x * x) ^ i) with (x ^ (2 * i)).
 reflexivity.
 apply pow_sqr.
-unfold cos in |- *.
+unfold cos.
 case (exist_cos (Rsqr x)).
-unfold Rsqr in |- *; intros.
+unfold Rsqr; intros.
 unfold cos_in in p_i.
 unfold cos_in in c.
 apply uniqueness_sum with (fun i:nat => cos_n i * (x * x) ^ i); assumption.
@@ -300,10 +298,10 @@ unfold R_dist in p.
 cut (cos (x + y) = x0).
 intro.
 rewrite H0.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+unfold Un_cv; unfold R_dist; intros.
 elim (p eps H1); intros.
 exists x1; intros.
-unfold C1 in |- *.
+unfold C1.
 replace
  (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) n)
  with
@@ -315,9 +313,9 @@ intros.
 replace (((x + y) * (x + y)) ^ i) with ((x + y) ^ (2 * i)).
 reflexivity.
 apply pow_sqr.
-unfold cos in |- *.
+unfold cos.
 case (exist_cos (Rsqr (x + y))).
-unfold Rsqr in |- *; intros.
+unfold Rsqr; intros.
 unfold cos_in in p_i.
 unfold cos_in in c.
 apply uniqueness_sum with (fun i:nat => cos_n i * ((x + y) * (x + y)) ^ i);
@@ -329,17 +327,17 @@ intro.
 case (Req_dec x 0); intro.
 rewrite H.
 rewrite sin_0.
-unfold B1 in |- *.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros; exists 0%nat; intros.
+unfold B1.
+unfold Un_cv; unfold R_dist; intros; exists 0%nat; intros.
 replace
  (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k + 1))
     n) with 0.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
 induction  n as [| n Hrecn].
-simpl in |- *; ring.
+simpl; ring.
 rewrite tech5; rewrite <- Hrecn.
-simpl in |- *; ring.
-unfold ge in |- *; apply le_O_n.
+simpl; ring.
+unfold ge; apply le_O_n.
 assert (H0 := exist_sin (x * x)).
 elim H0; intros.
 assert (p_i := p).
@@ -349,14 +347,14 @@ unfold R_dist in p.
 cut (sin x = x * x0).
 intro.
 rewrite H1.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+unfold Un_cv; unfold R_dist; intros.
 cut (0 < eps / Rabs x);
  [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+ | unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ] ].
 elim (p (eps / Rabs x) H3); intros.
 exists x1; intros.
-unfold B1 in |- *.
+unfold B1.
 replace
  (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1))
     n) with
@@ -382,11 +380,11 @@ apply sum_eq.
 intros.
 rewrite pow_add.
 rewrite pow_sqr.
-simpl in |- *.
+simpl.
 ring.
-unfold sin in |- *.
+unfold sin.
 case (exist_sin (Rsqr x)).
-unfold Rsqr in |- *; intros.
+unfold Rsqr; intros.
 unfold sin_in in p_i.
 unfold sin_in in s.
 assert
diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v
index 2cdc121f..1ec399d1 100644
--- a/theories/Reals/DiscrR.v
+++ b/theories/Reals/DiscrR.v
@@ -1,16 +1,14 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i        $Id: DiscrR.v 14641 2011-11-06 11:59:10Z herbelin $       i*)
-
 Require Import RIneq.
 Require Import Omega.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Lemma Rlt_R0_R2 : 0 < 2.
 change 2 with (INR 2); apply lt_INR_0; apply lt_O_Sn.
@@ -23,7 +21,7 @@ intros; rewrite H; reflexivity.
 Qed.
 
 Lemma IZR_neq : forall z1 z2:Z, z1 <> z2 -> IZR z1 <> IZR z2.
-intros; red in |- *; intro; elim H; apply eq_IZR; assumption.
+intros; red; intro; elim H; apply eq_IZR; assumption.
 Qed.
 
 Ltac discrR :=
@@ -47,7 +45,7 @@ Ltac prove_sup0 :=
       repeat
        (apply Rmult_lt_0_compat || apply Rplus_lt_pos;
          try apply Rlt_0_1 || apply Rlt_R0_R2)
-  |  |- (?X1 > 0) => change (0 < X1) in |- *; prove_sup0
+  |  |- (?X1 > 0) => change (0 < X1); prove_sup0
   end.
 
 Ltac omega_sup :=
@@ -61,7 +59,7 @@ Ltac omega_sup :=
 
 Ltac prove_sup :=
   match goal with
-  |  |- (?X1 > ?X2) => change (X2 < X1) in |- *; prove_sup
+  |  |- (?X1 > ?X2) => change (X2 < X1); prove_sup
   |  |- (0 < ?X1) => prove_sup0
   |  |- (- ?X1 < 0) => rewrite <- Ropp_0; prove_sup
   |  |- (- ?X1 < - ?X2) => apply Ropp_lt_gt_contravar; prove_sup
diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v
index 75ea4755..b65ab045 100644
--- a/theories/Reals/Exp_prop.v
+++ b/theories/Reals/Exp_prop.v
@@ -1,33 +1,31 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Exp_prop.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
-Require Import Rtrigo.
+Require Import Rtrigo1.
 Require Import Ranalysis1.
 Require Import PSeries_reg.
 Require Import Div2.
 Require Import Even.
 Require Import Max.
-Open Local Scope nat_scope.
-Open Local Scope R_scope.
+Local Open Scope nat_scope.
+Local Open Scope R_scope.
 
 Definition E1 (x:R) (N:nat) : R :=
   sum_f_R0 (fun k:nat => / INR (fact k) * x ^ k) N.
 
 Lemma E1_cvg : forall x:R, Un_cv (E1 x) (exp x).
 Proof.
-  intro; unfold exp in |- *; unfold projT1 in |- *.
+  intro; unfold exp; unfold projT1.
   case (exist_exp x); intro.
-  unfold exp_in, Un_cv in |- *; unfold infinite_sum, E1 in |- *; trivial.
+  unfold exp_in, Un_cv; unfold infinite_sum, E1; trivial.
 Qed.
 
 Definition Reste_E (x y:R) (N:nat) : R :=
@@ -43,14 +41,14 @@ Lemma exp_form :
   forall (x y:R) (n:nat),
     (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n.
 Proof.
-  intros; unfold E1 in |- *.
+  intros; unfold E1.
   rewrite cauchy_finite.
-  unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc;
+  unfold Reste_E; unfold Rminus; rewrite Rplus_assoc;
     rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq;
       intros.
   rewrite binomial.
   rewrite scal_sum; apply sum_eq; intros.
-  unfold C in |- *; unfold Rdiv in |- *; repeat rewrite Rmult_assoc;
+  unfold C; unfold Rdiv; repeat rewrite Rmult_assoc;
     rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc;
       rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r; rewrite Rinv_mult_distr.
@@ -66,27 +64,13 @@ Definition maj_Reste_E (x y:R) (N:nat) : R :=
   (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * N) /
     Rsqr (INR (fact (div2 (pred N))))).
 
-Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x.
-Proof.
-  intros; apply Rmult_le_reg_l with x.
-  apply H.
-  rewrite <- Rinv_r_sym.
-  apply Rmult_le_reg_l with y.
-  apply H0.
-  rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; apply H1.
-  red in |- *; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0).
-  red in |- *; intro; rewrite H2 in H; elim (Rlt_irrefl _ H).
-Qed.
-
 (**********)
 Lemma div2_double : forall N:nat, div2 (2 * N) = N.
 Proof.
   intro; induction  N as [| N HrecN].
   reflexivity.
   replace (2 * S N)%nat with (S (S (2 * N))).
-  simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity.
+  simpl; simpl in HrecN; rewrite HrecN; reflexivity.
   ring.
 Qed.
 
@@ -95,7 +79,7 @@ Proof.
   intro; induction  N as [| N HrecN].
   reflexivity.
   replace (2 * S N)%nat with (S (S (2 * N))).
-  simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity.
+  simpl; simpl in HrecN; rewrite HrecN; reflexivity.
   ring.
 Qed.
 
@@ -109,7 +93,7 @@ Proof.
   elim H2; intro.
   rewrite <- (even_div2 _ a); apply HrecN; assumption.
   rewrite <- (odd_div2 _ b); apply lt_O_Sn.
-  rewrite H1; simpl in |- *; apply lt_O_Sn.
+  rewrite H1; simpl; apply lt_O_Sn.
   inversion H.
   right; reflexivity.
   left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ].
@@ -126,7 +110,7 @@ Proof.
       (fun k:nat =>
         sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N)))))
         (pred (N - k))) (pred N)).
-  unfold Reste_E in |- *.
+  unfold Reste_E.
   apply Rle_trans with
     (sum_f_R0
       (fun k:nat =>
@@ -205,25 +189,25 @@ Proof.
   apply Rabs_pos.
   apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
   apply RmaxLess1.
-  unfold M in |- *; apply RmaxLess2.
+  unfold M; apply RmaxLess2.
   apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)).
   apply Rmult_le_compat_l.
   apply pow_le; apply Rle_trans with 1.
   left; apply Rlt_0_1.
-  unfold M in |- *; apply RmaxLess1.
+  unfold M; apply RmaxLess1.
   apply pow_incr; split.
   apply Rabs_pos.
   apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
   apply RmaxLess2.
-  unfold M in |- *; apply RmaxLess2.
+  unfold M; apply RmaxLess2.
   rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat.
   apply Rle_pow.
-  unfold M in |- *; apply RmaxLess1.
+  unfold M; apply RmaxLess1.
   replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ].
   apply plus_le_compat_l.
   replace N with (S (pred N)).
   apply le_n_S; apply H0.
-  symmetry  in |- *; apply S_pred with 0%nat; apply H.
+  symmetry ; apply S_pred with 0%nat; apply H.
   apply INR_eq; do 2 rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR;
     rewrite minus_INR.
   ring.
@@ -262,7 +246,7 @@ Proof.
   apply pow_le.
   apply Rle_trans with 1.
   left; apply Rlt_0_1.
-  unfold M in |- *; apply RmaxLess1.
+  unfold M; apply RmaxLess1.
   assert (H2 := even_odd_cor N).
   elim H2; intros N0 H3.
   elim H3; intro.
@@ -278,9 +262,9 @@ Proof.
   apply le_n_Sn.
   replace (/ INR (fact n0) * / INR (fact (N - n0))) with
   (C N n0 / INR (fact N)).
-  pattern N at 1 in |- *; rewrite H4.
+  pattern N at 1; rewrite H4.
   apply Rle_trans with (C N N0 / INR (fact N)).
-  unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact N))).
+  unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ INR (fact N))).
   apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   rewrite H4.
@@ -310,7 +294,7 @@ Proof.
   apply le_pred_n.
   replace (C N N0 / INR (fact N)) with (/ Rsqr (INR (fact N0))).
   rewrite H4; rewrite div2_S_double; right; reflexivity.
-  unfold Rsqr, C, Rdiv in |- *.
+  unfold Rsqr, C, Rdiv.
   repeat rewrite Rinv_mult_distr.
   rewrite (Rmult_comm (INR (fact N))).
   repeat rewrite Rmult_assoc.
@@ -318,7 +302,7 @@ Proof.
   rewrite Rmult_1_r; replace (N - N0)%nat with N0.
   ring.
   replace N with (N0 + N0)%nat.
-  symmetry  in |- *; apply minus_plus.
+  symmetry ; apply minus_plus.
   rewrite H4.
   ring.
   apply INR_fact_neq_0.
@@ -326,7 +310,7 @@ Proof.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
-  unfold C, Rdiv in |- *.
+  unfold C, Rdiv.
   rewrite (Rmult_comm (INR (fact N))).
   repeat rewrite Rmult_assoc.
   rewrite <- Rinv_r_sym.
@@ -338,7 +322,7 @@ Proof.
   replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with
   (C (S N) (S n0) / INR (fact (S N))).
   apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))).
-  unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))).
+  unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))).
   apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   cut (S N = (2 * S N0)%nat).
@@ -373,7 +357,7 @@ Proof.
   replace (C (S N) (S N0) / INR (fact (S N))) with (/ Rsqr (INR (fact (S N0)))).
   rewrite H5; rewrite div2_double.
   right; reflexivity.
-  unfold Rsqr, C, Rdiv in |- *.
+  unfold Rsqr, C, Rdiv.
   repeat rewrite Rinv_mult_distr.
   replace (S N - S N0)%nat with (S N0).
   rewrite (Rmult_comm (INR (fact (S N)))).
@@ -382,14 +366,14 @@ Proof.
   rewrite Rmult_1_r; reflexivity.
   apply INR_fact_neq_0.
   replace (S N) with (S N0 + S N0)%nat.
-  symmetry  in |- *; apply minus_plus.
+  symmetry ; apply minus_plus.
   rewrite H5; ring.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   rewrite H4; ring.
-  unfold C, Rdiv in |- *.
+  unfold C, Rdiv.
   rewrite (Rmult_comm (INR (fact (S N)))).
   rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
   rewrite Rmult_1_r; rewrite Rinv_mult_distr.
@@ -397,8 +381,8 @@ Proof.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
-  unfold maj_Reste_E in |- *.
-  unfold Rdiv in |- *; rewrite (Rmult_comm 4).
+  unfold maj_Reste_E.
+  unfold Rdiv; rewrite (Rmult_comm 4).
   rewrite Rmult_assoc.
   apply Rmult_le_compat_l.
   apply pow_le.
@@ -449,7 +433,7 @@ Proof.
   cut (INR N <= INR (2 * div2 (S N))).
   intro; apply Rmult_le_reg_l with (Rsqr (INR (div2 (S N)))).
   apply Rsqr_pos_lt.
-  apply not_O_INR; red in |- *; intro.
+  apply not_O_INR; red; intro.
   cut (1 < S N)%nat.
   intro; assert (H4 := div2_not_R0 _ H3).
   rewrite H2 in H4; elim (lt_n_O _ H4).
@@ -472,17 +456,17 @@ Proof.
   apply lt_INR_0; apply div2_not_R0.
   apply lt_n_S; apply H.
   cut (1 < S N)%nat.
-  intro; unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; intro;
+  intro; unfold Rsqr; apply prod_neq_R0; apply not_O_INR; intro;
     assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4;
       elim (lt_n_O _ H4).
   apply lt_n_S; apply H.
   assert (H1 := even_odd_cor N).
   elim H1; intros N0 H2.
   elim H2; intro.
-  pattern N at 2 in |- *; rewrite H3.
+  pattern N at 2; rewrite H3.
   rewrite div2_S_double.
   right; rewrite H3; reflexivity.
-  pattern N at 2 in |- *; rewrite H3.
+  pattern N at 2; rewrite H3.
   replace (S (S (2 * N0))) with (2 * S N0)%nat.
   rewrite div2_double.
   rewrite H3.
@@ -491,12 +475,12 @@ Proof.
   rewrite Rmult_plus_distr_l.
   apply Rplus_le_compat_l.
   rewrite Rmult_1_r.
-  simpl in |- *.
-  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+  simpl.
+  pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
     apply Rlt_0_1.
   ring.
-  unfold Rsqr in |- *; apply prod_neq_R0; apply INR_fact_neq_0.
-  unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; discriminate.
+  unfold Rsqr; apply prod_neq_R0; apply INR_fact_neq_0.
+  unfold Rsqr; apply prod_neq_R0; apply not_O_INR; discriminate.
   assert (H0 := even_odd_cor N).
   elim H0; intros N0 H1.
   elim H1; intro.
@@ -522,15 +506,15 @@ Qed.
 Lemma maj_Reste_cv_R0 : forall x y:R, Un_cv (maj_Reste_E x y) 0.
 Proof.
   intros; assert (H := Majxy_cv_R0 x y).
-  unfold Un_cv in H; unfold Un_cv in |- *; intros.
+  unfold Un_cv in H; unfold Un_cv; intros.
   cut (0 < eps / 4);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
   elim (H _ H1); intros N0 H2.
   exists (max (2 * S N0) 2); intros.
-  unfold R_dist in H2; unfold R_dist in |- *; rewrite Rminus_0_r;
-    unfold Majxy in H2; unfold maj_Reste_E in |- *.
+  unfold R_dist in H2; unfold R_dist; rewrite Rminus_0_r;
+    unfold Majxy in H2; unfold maj_Reste_E.
   rewrite Rabs_right.
   apply Rle_lt_trans with
     (4 *
@@ -538,7 +522,7 @@ Proof.
         INR (fact (div2 (pred n))))).
   apply Rmult_le_compat_l.
   left; prove_sup0.
-  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr.
   rewrite (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)));
     rewrite
       (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n)))))
@@ -546,7 +530,7 @@ Proof.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   apply Rle_trans with (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)).
   rewrite Rmult_comm;
-    pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2 in |- *;
+    pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2;
       rewrite <- Rmult_1_r; apply Rmult_le_compat_l.
   apply pow_le; apply Rle_trans with 1.
   left; apply Rlt_0_1.
@@ -600,11 +584,11 @@ Proof.
   (Rabs
     (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
       INR (fact (div2 (pred n))) - 0)).
-  apply H2; unfold ge in |- *.
+  apply H2; unfold ge.
   cut (2 * S N0 <= n)%nat.
   intro; apply le_S_n.
   apply INR_le; apply Rmult_le_reg_l with (INR 2).
-  simpl in |- *; prove_sup0.
+  simpl; prove_sup0.
   do 2 rewrite <- mult_INR; apply le_INR.
   apply le_trans with n.
   apply H4.
@@ -622,12 +606,12 @@ Proof.
   apply S_pred with 0%nat; apply H8.
   replace (2 * N1)%nat with (S (S (2 * pred N1))).
   reflexivity.
-  pattern N1 at 2 in |- *; replace N1 with (S (pred N1)).
+  pattern N1 at 2; replace N1 with (S (pred N1)).
   ring.
-  symmetry  in |- *; apply S_pred with 0%nat; apply H8.
+  symmetry ; apply S_pred with 0%nat; apply H8.
   apply INR_lt.
   apply Rmult_lt_reg_l with (INR 2).
-  simpl in |- *; prove_sup0.
+  simpl; prove_sup0.
   rewrite Rmult_0_r; rewrite <- mult_INR.
   apply lt_INR_0.
   rewrite <- H7.
@@ -648,7 +632,7 @@ Proof.
   apply H3.
   rewrite Rminus_0_r; apply Rabs_right.
   apply Rle_ge.
-  unfold Rdiv in |- *; repeat apply Rmult_le_pos.
+  unfold Rdiv; apply Rmult_le_pos.
   apply pow_le.
   apply Rle_trans with 1.
   left; apply Rlt_0_1.
@@ -656,7 +640,7 @@ Proof.
   left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   discrR.
   apply Rle_ge.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Rdiv; apply Rmult_le_pos.
   left; prove_sup0.
   apply Rmult_le_pos.
   apply pow_le.
@@ -670,9 +654,9 @@ Qed.
 Lemma Reste_E_cv : forall x y:R, Un_cv (Reste_E x y) 0.
 Proof.
   intros; assert (H := maj_Reste_cv_R0 x y).
-  unfold Un_cv in H; unfold Un_cv in |- *; intros; elim (H _ H0); intros.
+  unfold Un_cv in H; unfold Un_cv; intros; elim (H _ H0); intros.
   exists (max x0 1); intros.
-  unfold R_dist in |- *; rewrite Rminus_0_r.
+  unfold R_dist; rewrite Rminus_0_r.
   apply Rle_lt_trans with (maj_Reste_E x y n).
   apply Reste_E_maj.
   apply lt_le_trans with 1%nat.
@@ -682,10 +666,10 @@ Proof.
   apply H2.
   replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) 0).
   apply H1.
-  unfold ge in |- *; apply le_trans with (max x0 1).
+  unfold ge; apply le_trans with (max x0 1).
   apply le_max_l.
   apply H2.
-  unfold R_dist in |- *; rewrite Rminus_0_r; apply Rabs_right.
+  unfold R_dist; rewrite Rminus_0_r; apply Rabs_right.
   apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)).
   apply Rabs_pos.
   apply Reste_E_maj.
@@ -706,13 +690,13 @@ Proof.
   apply H1.
   assert (H2 := CV_mult _ _ _ _ H0 H).
   assert (H3 := CV_minus _ _ _ _ H2 (Reste_E_cv x y)).
-  unfold Un_cv in |- *; unfold Un_cv in H3; intros.
+  unfold Un_cv; unfold Un_cv in H3; intros.
   elim (H3 _ H4); intros.
   exists (S x0); intros.
   rewrite <- (exp_form x y n).
   rewrite Rminus_0_r in H5.
   apply H5.
-  unfold ge in |- *; apply le_trans with (S x0).
+  unfold ge; apply le_trans with (S x0).
   apply le_n_Sn.
   apply H6.
   apply lt_le_trans with (S x0).
@@ -726,15 +710,15 @@ Proof.
   intros; set (An := fun N:nat => / INR (fact N) * x ^ N).
   cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)).
   intro; apply Rlt_le_trans with (sum_f_R0 An 0).
-  unfold An in |- *; simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r;
+  unfold An; simpl; rewrite Rinv_1; rewrite Rmult_1_r;
     apply Rlt_0_1.
   apply sum_incr.
   assumption.
-  intro; unfold An in |- *; left; apply Rmult_lt_0_compat.
+  intro; unfold An; left; apply Rmult_lt_0_compat.
   apply Rinv_0_lt_compat; apply INR_fact_lt_0.
   apply (pow_lt _ n H).
-  unfold exp in |- *; unfold projT1 in |- *; case (exist_exp x); intro.
-  unfold exp_in in |- *; unfold infinite_sum, Un_cv in |- *; trivial.
+  unfold exp; unfold projT1; case (exist_exp x); intro.
+  unfold exp_in; unfold infinite_sum, Un_cv; trivial.
 Qed.
 
 (**********)
@@ -745,12 +729,12 @@ Proof.
   apply (exp_pos_pos _ a).
   rewrite <- b; rewrite exp_0; apply Rlt_0_1.
   replace (exp x) with (1 / exp (- x)).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   apply Rlt_0_1.
   apply Rinv_0_lt_compat; apply exp_pos_pos.
   apply (Ropp_0_gt_lt_contravar _ r).
   cut (exp (- x) <> 0).
-  intro; unfold Rdiv in |- *; apply Rmult_eq_reg_l with (exp (- x)).
+  intro; unfold Rdiv; apply Rmult_eq_reg_l with (exp (- x)).
   rewrite Rmult_1_l; rewrite <- Rinv_r_sym.
   rewrite <- exp_plus.
   rewrite Rplus_opp_l; rewrite exp_0; reflexivity.
@@ -758,7 +742,7 @@ Proof.
   apply H.
   assert (H := exp_plus x (- x)).
   rewrite Rplus_opp_r in H; rewrite exp_0 in H.
-  red in |- *; intro; rewrite H0 in H.
+  red; intro; rewrite H0 in H.
   rewrite Rmult_0_r in H.
   elim R1_neq_R0; assumption.
 Qed.
@@ -766,7 +750,7 @@ Qed.
 (* ((exp h)-1)/h -> 0 quand h->0 *)
 Lemma derivable_pt_lim_exp_0 : derivable_pt_lim exp 0 1.
 Proof.
-  unfold derivable_pt_lim in |- *; intros.
+  unfold derivable_pt_lim; intros.
   set (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))).
   cut (CVN_R fn).
   intro; cut (forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }).
@@ -784,41 +768,41 @@ Proof.
   replace 1 with (SFL fn cv 0).
   apply H5.
   split.
-  unfold D_x, no_cond in |- *; split.
+  unfold D_x, no_cond; split.
   trivial.
-  apply (sym_not_eq H6).
+  apply (not_eq_sym H6).
   rewrite Rminus_0_r; apply H7.
-  unfold SFL in |- *.
+  unfold SFL.
   case (cv 0); intros.
   eapply UL_sequence.
   apply u.
-  unfold Un_cv, SP in |- *.
+  unfold Un_cv, SP.
   intros; exists 1%nat; intros.
-  unfold R_dist in |- *; rewrite decomp_sum.
+  unfold R_dist; rewrite decomp_sum.
   rewrite (Rplus_comm (fn 0%nat 0)).
   replace (fn 0%nat 0) with 1.
-  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r;
+  unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r;
     rewrite Rplus_0_r.
   replace (sum_f_R0 (fun i:nat => fn (S i) 0) (pred n)) with 0.
   rewrite Rabs_R0; apply H8.
-  symmetry  in |- *; apply sum_eq_R0; intros.
-  unfold fn in |- *.
-  simpl in |- *.
-  unfold Rdiv in |- *; do 2 rewrite Rmult_0_l; reflexivity.
-  unfold fn in |- *; simpl in |- *.
-  unfold Rdiv in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
+  symmetry ; apply sum_eq_R0; intros.
+  unfold fn.
+  simpl.
+  unfold Rdiv; do 2 rewrite Rmult_0_l; reflexivity.
+  unfold fn; simpl.
+  unfold Rdiv; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
   apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ].
-  unfold SFL, exp in |- *.
+  unfold SFL, exp.
   case (cv h); case (exist_exp h); simpl; intros.
   eapply UL_sequence.
   apply u.
-  unfold Un_cv in |- *; intros.
+  unfold Un_cv; intros.
   unfold exp_in in e.
   unfold infinite_sum in e.
   cut (0 < eps0 * Rabs h).
   intro; elim (e _ H9); intros N0 H10.
   exists N0; intros.
-  unfold R_dist in |- *.
+  unfold R_dist.
   apply Rmult_lt_reg_l with (Rabs h).
   apply Rabs_pos_lt; assumption.
   rewrite <- Rabs_mult.
@@ -829,47 +813,47 @@ Proof.
   (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x).
   rewrite (Rmult_comm (Rabs h)).
   apply H10.
-  unfold ge in |- *.
+  unfold ge.
   apply le_trans with (S N0).
   apply le_n_Sn.
   apply le_n_S; apply H11.
   rewrite decomp_sum.
   replace (/ INR (fact 0) * h ^ 0) with 1.
-  unfold Rminus in |- *.
+  unfold Rminus.
   rewrite Ropp_plus_distr.
   rewrite Ropp_involutive.
   rewrite <- (Rplus_comm (- x)).
   rewrite <- (Rplus_comm (- x + 1)).
   rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l.
   replace (pred (S n)) with n; [ idtac | reflexivity ].
-  unfold SP in |- *.
+  unfold SP.
   rewrite scal_sum.
   apply sum_eq; intros.
-  unfold fn in |- *.
+  unfold fn.
   replace (h ^ S i) with (h * h ^ i).
-  unfold Rdiv in |- *; ring.
-  simpl in |- *; ring.
-  simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
+  unfold Rdiv; ring.
+  simpl; ring.
+  simpl; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
   apply lt_O_Sn.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   rewrite <- Rmult_assoc.
-  symmetry  in |- *; apply Rinv_r_simpl_m.
+  symmetry ; apply Rinv_r_simpl_m.
   assumption.
   apply Rmult_lt_0_compat.
   apply H8.
   apply Rabs_pos_lt; assumption.
   apply SFL_continuity; assumption.
-  intro; unfold fn in |- *.
+  intro; unfold fn.
   replace (fun x:R => x ^ n / INR (fact (S n))) with
   (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ].
   apply continuity_div.
   apply derivable_continuous; apply (derivable_pow n).
   apply derivable_continuous; apply derivable_const.
-  intro; unfold fct_cte in |- *; apply INR_fact_neq_0.
+  intro; unfold fct_cte; apply INR_fact_neq_0.
   apply (CVN_R_CVS _ X).
   assert (H0 := Alembert_exp).
-  unfold CVN_R in |- *.
-  intro; unfold CVN_r in |- *.
+  unfold CVN_R.
+  intro; unfold CVN_r.
   exists (fun N:nat => r ^ N / INR (fact (S N))).
   cut
     { l:R |
@@ -881,10 +865,10 @@ Proof.
   exists x; intros.
   split.
   apply p.
-  unfold Boule in |- *; intros.
+  unfold Boule; intros.
   rewrite Rminus_0_r in H1.
-  unfold fn in |- *.
-  unfold Rdiv in |- *; rewrite Rabs_mult.
+  unfold fn.
+  unfold Rdiv; rewrite Rabs_mult.
   cut (0 < INR (fact (S n))).
   intro.
   rewrite (Rabs_right (/ INR (fact (S n)))).
@@ -899,14 +883,14 @@ Proof.
   cut ((r:R) <> 0).
   intro; apply Alembert_C2.
   intro; apply Rabs_no_R0.
-  unfold Rdiv in |- *; apply prod_neq_R0.
+  unfold Rdiv; apply prod_neq_R0.
   apply pow_nonzero; assumption.
   apply Rinv_neq_0_compat; apply INR_fact_neq_0.
   unfold Un_cv in H0.
-  unfold Un_cv in |- *; intros.
+  unfold Un_cv; intros.
   cut (0 < eps0 / r);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ].
   elim (H0 _ H3); intros N0 H4.
   exists N0; intros.
@@ -915,7 +899,7 @@ Proof.
   assert (H6 := H4 _ hyp_sn).
   unfold R_dist in H6; rewrite Rminus_0_r in H6.
   rewrite Rabs_Rabsolu in H6.
-  unfold R_dist in |- *; rewrite Rminus_0_r.
+  unfold R_dist; rewrite Rminus_0_r.
   rewrite Rabs_Rabsolu.
   replace
   (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n))))
@@ -929,7 +913,7 @@ Proof.
   apply H6.
   assumption.
   apply Rle_ge; left; apply (cond_pos r).
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   repeat rewrite Rabs_mult.
   repeat rewrite Rabs_Rinv.
   rewrite Rinv_mult_distr.
@@ -942,7 +926,7 @@ Proof.
   rewrite (Rmult_comm r).
   rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))).
   apply Rmult_eq_compat_l.
-  simpl in |- *.
+  simpl.
   rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
   ring.
   apply pow_nonzero; assumption.
@@ -955,10 +939,10 @@ Proof.
   apply Rinv_neq_0_compat; apply Rabs_no_R0; apply INR_fact_neq_0.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
-  unfold ge in |- *; apply le_trans with n.
+  unfold ge; apply le_trans with n.
   apply H5.
   apply le_n_Sn.
-  assert (H1 := cond_pos r); red in |- *; intro; rewrite H2 in H1;
+  assert (H1 := cond_pos r); red; intro; rewrite H2 in H1;
     elim (Rlt_irrefl _ H1).
 Qed.
 
@@ -966,10 +950,10 @@ Qed.
 Lemma derivable_pt_lim_exp : forall x:R, derivable_pt_lim exp x (exp x).
 Proof.
   intro; assert (H0 := derivable_pt_lim_exp_0).
-  unfold derivable_pt_lim in H0; unfold derivable_pt_lim in |- *; intros.
+  unfold derivable_pt_lim in H0; unfold derivable_pt_lim; intros.
   cut (0 < eps / exp x);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ].
   elim (H0 _ H1); intros del H2.
   exists del; intros.
@@ -983,11 +967,11 @@ Proof.
   rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l; rewrite <- (Rmult_comm eps).
   apply H5.
-  assert (H6 := exp_pos x); red in |- *; intro; rewrite H7 in H6;
+  assert (H6 := exp_pos x); red; intro; rewrite H7 in H6;
     elim (Rlt_irrefl _ H6).
   apply Rle_ge; left; apply exp_pos.
   rewrite Rmult_minus_distr_l.
-  rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+  rewrite Rmult_1_r; unfold Rdiv; rewrite <- Rmult_assoc;
     rewrite Rmult_minus_distr_l.
   rewrite Rmult_1_r; rewrite exp_plus; reflexivity.
 Qed.
diff --git a/theories/Reals/Integration.v b/theories/Reals/Integration.v
index 3199a4f8..d7b3ab04 100644
--- a/theories/Reals/Integration.v
+++ b/theories/Reals/Integration.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Integration.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export NewtonInt.
 Require Export RiemannInt_SF.
-Require Export RiemannInt.
\ No newline at end of file
+Require Export RiemannInt.
diff --git a/theories/Reals/LegacyRfield.v b/theories/Reals/LegacyRfield.v
index 32b9699d..c45d1c5f 100644
--- a/theories/Reals/LegacyRfield.v
+++ b/theories/Reals/LegacyRfield.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: LegacyRfield.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Raxioms.
 Require Export LegacyField.
 Import LegacyRing_theory.
@@ -19,9 +17,9 @@ Open Scope R_scope.
 Lemma RLegacyTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false).
   split.
   exact Rplus_comm.
-  symmetry  in |- *; apply Rplus_assoc.
+  symmetry ; apply Rplus_assoc.
   exact Rmult_comm.
-  symmetry  in |- *; apply Rmult_assoc.
+  symmetry ; apply Rmult_assoc.
   intro; apply Rplus_0_l.
   intro; apply Rmult_1_l.
   exact Rplus_opp_r.
diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v
index 36bbb405..2ee22b6d 100644
--- a/theories/Reals/MVT.v
+++ b/theories/Reals/MVT.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: MVT.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Ranalysis1.
 Require Import Rtopology.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (* The Mean Value Theorem *)
 Theorem MVT :
@@ -57,13 +55,13 @@ Proof.
   split.
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
-  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+  unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
     rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H.
   discrR.
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
-  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+  unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
     rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l; rewrite Rplus_comm; rewrite double;
     apply Rplus_lt_compat_l; apply H.
@@ -105,7 +103,7 @@ Proof.
   inversion H13.
   apply H14.
   rewrite H8 in H10; rewrite <- H14 in H10; elim H10; reflexivity.
-  intros; unfold h in |- *;
+  intros; unfold h;
     replace
     (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P))
     with
@@ -117,11 +115,11 @@ Proof.
   rewrite derive_pt_minus; do 2 rewrite derive_pt_mult;
     do 2 rewrite derive_pt_const; do 2 rewrite Rmult_0_l;
       do 2 rewrite Rplus_0_l; reflexivity.
-  unfold h in |- *; ring.
-  intros; unfold h in |- *;
+  unfold h; ring.
+  intros; unfold h;
     change
       (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F)
-        c) in |- *.
+        c).
   apply continuity_pt_minus; apply continuity_pt_mult.
   apply derivable_continuous_pt; apply derivable_const.
   apply H0; apply H3.
@@ -130,7 +128,7 @@ Proof.
   intros;
     change
       (derivable_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F)
-        c) in |- *.
+        c).
   apply derivable_pt_minus; apply derivable_pt_mult.
   apply derivable_pt_const.
   apply (pr1 _ H3).
@@ -180,7 +178,7 @@ Proof.
   cut (derive_pt id x (X2 x x0) = 1).
   cut (derive_pt f x (X0 x x0) = f' x).
   intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3;
-    rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry  in |- *;
+    rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry ;
       assumption.
   apply derive_pt_eq_0; apply H0; elim x0; intros; split; left; assumption.
   apply derive_pt_eq_0; apply derivable_pt_lim_id.
@@ -190,7 +188,7 @@ Proof.
   intros; apply derivable_pt_id.
   intros; apply derivable_continuous_pt; apply X; assumption.
   intros; elim H1; intros; apply X; split; left; assumption.
-  intros; unfold derivable_pt in |- *; exists (f' c); apply H0;
+  intros; unfold derivable_pt; exists (f' c); apply H0;
     apply H1.
 Qed.
 
@@ -223,7 +221,7 @@ Proof.
     unfold id in H6; unfold Rminus in H6; rewrite Rplus_opp_r in H6;
       rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a);
         [ rewrite Rmult_0_r; apply H6
-          | apply Rminus_eq_contra; red in |- *; intro; rewrite H7 in H0;
+          | apply Rminus_eq_contra; red; intro; rewrite H7 in H0;
             elim (Rlt_irrefl _ H0) ].
 Qed.
 
@@ -233,7 +231,7 @@ Lemma nonneg_derivative_1 :
     (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f.
 Proof.
   intros.
-  unfold increasing in |- *.
+  unfold increasing.
   intros.
   case (total_order_T x y); intro.
   elim s; intro.
@@ -270,12 +268,12 @@ Proof.
   intro; decompose [and] H8; intros; generalize (H7 (delta / 2) H9 H12);
     cut ((f (x + delta / 2) - f x) / (delta / 2) <= 0).
   intro; cut (0 < - ((f (x + delta / 2) - f x) / (delta / 2) - l)).
-  intro; unfold Rabs in |- *;
+  intro; unfold Rabs;
     case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
   intros;
     generalize
       (Rplus_lt_compat_r (- l) (- ((f (x + delta / 2) - f x) / (delta / 2) - l))
-        (l / 2) H14); unfold Rminus in |- *.
+        (l / 2) H14); unfold Rminus.
   replace (l / 2 + - l) with (- (l / 2)).
   replace (- ((f (x + delta / 2) + - f x) / (delta / 2) + - l) + - l) with
   (- ((f (x + delta / 2) + - f x) / (delta / 2))).
@@ -292,7 +290,7 @@ Proof.
     (Rlt_irrefl 0
       (Rlt_le_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) 0 H17 H10)).
   ring.
-  pattern l at 3 in |- *; rewrite double_var.
+  pattern l at 3; rewrite double_var.
   ring.
   intros.
   generalize
@@ -305,22 +303,22 @@ Proof.
         H15)).
   replace (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) with
   ((f x - f (x + delta / 2)) / (delta / 2) + l).
-  unfold Rminus in |- *.
+  unfold Rminus.
   apply Rplus_le_lt_0_compat.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Rdiv; apply Rmult_le_pos.
   cut (x <= x + delta * / 2).
   intro; generalize (H0 x (x + delta * / 2) H13); intro;
     generalize
       (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H14);
       rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
-  pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+  pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
     left; assumption.
   left; apply Rinv_0_lt_compat; assumption.
   assumption.
   rewrite Ropp_minus_distr.
-  unfold Rminus in |- *.
+  unfold Rminus.
   rewrite (Rplus_comm l).
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   rewrite <- Ropp_mult_distr_l_reverse.
   rewrite Ropp_plus_distr.
   rewrite Ropp_involutive.
@@ -331,38 +329,38 @@ Proof.
   rewrite <- Ropp_0.
   apply Ropp_ge_le_contravar.
   apply Rle_ge.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Rdiv; apply Rmult_le_pos.
   cut (x <= x + delta * / 2).
   intro; generalize (H0 x (x + delta * / 2) H10); intro.
   generalize
     (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H13);
     rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
-  pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+  pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
     left; assumption.
   left; apply Rinv_0_lt_compat; assumption.
-  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
+  unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse.
   rewrite Ropp_minus_distr.
   reflexivity.
   split.
-  unfold Rdiv in |- *; apply prod_neq_R0.
-  generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H8;
+  unfold Rdiv; apply prod_neq_R0.
+  generalize (cond_pos delta); intro; red; intro H9; rewrite H9 in H8;
     elim (Rlt_irrefl 0 H8).
   apply Rinv_neq_0_compat; discrR.
   split.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
   rewrite Rabs_right.
-  unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+  unfold Rdiv; apply Rmult_lt_reg_l with 2.
   prove_sup0.
   rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_l; rewrite double; pattern (pos delta) at 1 in |- *;
+  rewrite Rmult_1_l; rewrite double; pattern (pos delta) at 1;
     rewrite <- Rplus_0_r.
   apply Rplus_lt_compat_l; apply (cond_pos delta).
   discrR.
-  apply Rle_ge; unfold Rdiv in |- *; left; apply Rmult_lt_0_compat.
+  apply Rle_ge; unfold Rdiv; left; apply Rmult_lt_0_compat.
   apply (cond_pos delta).
   apply Rinv_0_lt_compat; prove_sup0.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ].
 Qed.
 
@@ -370,7 +368,7 @@ Qed.
 Lemma increasing_decreasing_opp :
   forall f:R -> R, increasing f -> decreasing (- f)%F.
 Proof.
-  unfold increasing, decreasing, opp_fct in |- *; intros; generalize (H x y H0);
+  unfold increasing, decreasing, opp_fct; intros; generalize (H x y H0);
     intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption.
 Qed.
 
@@ -383,8 +381,8 @@ Proof.
   cut (forall h:R, - - f h = f h).
   intro.
   generalize (increasing_decreasing_opp (- f)%F).
-  unfold decreasing in |- *.
-  unfold opp_fct in |- *.
+  unfold decreasing.
+  unfold opp_fct.
   intros.
   rewrite <- (H0 x); rewrite <- (H0 y).
   apply H1.
@@ -412,7 +410,7 @@ Lemma positive_derivative :
     (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f.
 Proof.
   intros.
-  unfold strict_increasing in |- *.
+  unfold strict_increasing.
   intros.
   apply Rplus_lt_reg_r with (- f x).
   rewrite Rplus_opp_l; rewrite Rplus_comm.
@@ -431,7 +429,7 @@ Qed.
 Lemma strictincreasing_strictdecreasing_opp :
   forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F.
 Proof.
-  unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros;
+  unfold strict_increasing, strict_decreasing, opp_fct; intros;
     generalize (H x y H0); intro; apply Ropp_lt_gt_contravar;
       assumption.
 Qed.
@@ -445,7 +443,7 @@ Proof.
   cut (forall h:R, - - f h = f h).
   intros.
   generalize (strictincreasing_strictdecreasing_opp (- f)%F).
-  unfold strict_decreasing, opp_fct in |- *.
+  unfold strict_decreasing, opp_fct.
   intros.
   rewrite <- (H0 x).
   rewrite <- (H0 y).
@@ -472,8 +470,8 @@ Proof.
   intros.
   unfold constant in H.
   apply derive_pt_eq_0.
-  intros; exists (mkposreal 1 Rlt_0_1); simpl in |- *; intros.
-  rewrite (H x (x + h)); unfold Rminus in |- *; unfold Rdiv in |- *;
+  intros; exists (mkposreal 1 Rlt_0_1); simpl; intros.
+  rewrite (H x (x + h)); unfold Rminus; unfold Rdiv;
     rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r;
       rewrite Rabs_R0; assumption.
 Qed.
@@ -482,13 +480,13 @@ Qed.
 Lemma increasing_decreasing :
   forall f:R -> R, increasing f -> decreasing f -> constant f.
 Proof.
-  unfold increasing, decreasing, constant in |- *; intros;
+  unfold increasing, decreasing, constant; intros;
     case (Rtotal_order x y); intro.
   generalize (Rlt_le x y H1); intro;
     apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)).
   elim H1; intro.
   rewrite H2; reflexivity.
-  generalize (Rlt_le y x H2); intro; symmetry  in |- *;
+  generalize (Rlt_le y x H2); intro; symmetry ;
     apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)).
 Qed.
 
@@ -504,7 +502,7 @@ Proof.
   assert (H2 := nonneg_derivative_1 f pr H0).
   assert (H3 := nonpos_derivative_1 f pr H1).
   apply increasing_decreasing; assumption.
-  intro; right; symmetry  in |- *; apply (H x).
+  intro; right; symmetry ; apply (H x).
   intro; right; apply (H x).
 Qed.
 
@@ -603,7 +601,7 @@ Proof.
   elim H4; intros.
   split; left; assumption.
   rewrite b0.
-  unfold Rminus in |- *; do 2 rewrite Rplus_opp_r.
+  unfold Rminus; do 2 rewrite Rplus_opp_r.
   rewrite Rmult_0_r; right; reflexivity.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
 Qed.
@@ -650,7 +648,7 @@ Lemma null_derivative_loc :
     (forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) ->
     constant_D_eq f (fun x:R => a <= x <= b) (f a).
 Proof.
-  intros; unfold constant_D_eq in |- *; intros; case (total_order_T a b); intro.
+  intros; unfold constant_D_eq; intros; case (total_order_T a b); intro.
   elim s; intro.
   assert (H2 : forall y:R, a < y < x -> derivable_pt id y).
   intros; apply derivable_pt_id.
@@ -676,7 +674,7 @@ Proof.
   assert (H12 : derive_pt id x0 (H2 x0 x1) = 1).
   apply derive_pt_eq_0; apply derivable_pt_lim_id.
   rewrite H11 in H9; rewrite H12 in H9; rewrite Rmult_0_r in H9;
-    rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry  in |- *;
+    rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry ;
       assumption.
   rewrite H1; reflexivity.
   assert (H2 : x = a).
@@ -693,15 +691,15 @@ Lemma antiderivative_Ucte :
     antiderivative f g2 a b ->
     exists c : R, (forall x:R, a <= x <= b -> g1 x = g2 x + c).
 Proof.
-  unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0;
+  unfold antiderivative; intros; elim H; clear H; intros; elim H0;
     clear H0; intros H0 _; exists (g1 a - g2 a); intros;
       assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x).
-  intros; unfold derivable_pt in |- *; exists (f x0); elim (H x0 H3);
-    intros; eapply derive_pt_eq_1; symmetry  in |- *;
+  intros; unfold derivable_pt; exists (f x0); elim (H x0 H3);
+    intros; eapply derive_pt_eq_1; symmetry ;
       apply H4.
   assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x).
-  intros; unfold derivable_pt in |- *; exists (f x0);
-    elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry  in |- *;
+  intros; unfold derivable_pt; exists (f x0);
+    elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry ;
       apply H5.
   assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x).
   intros; elim H5; intros; apply derivable_pt_minus;
@@ -715,7 +713,7 @@ Proof.
   assert (H9 : a <= x0 <= b).
   split; left; assumption.
   apply derivable_pt_lim_minus; [ elim (H _ H9) | elim (H0 _ H9) ]; intros;
-    eapply derive_pt_eq_1; symmetry  in |- *; apply H10.
+    eapply derive_pt_eq_1; symmetry ; apply H10.
   assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7);
     unfold constant_D_eq in H8; assert (H9 := H8 _ H2);
       unfold minus_fct in H9; rewrite <- H9; ring.
diff --git a/theories/Reals/Machin.v b/theories/Reals/Machin.v
new file mode 100644
index 00000000..6b91719d
--- /dev/null
+++ b/theories/Reals/Machin.v
@@ -0,0 +1,168 @@
+Require Import Fourier.
+Require Import Rbase.
+Require Import Rtrigo1.
+Require Import Ranalysis_reg.
+Require Import Rfunctions.
+Require Import AltSeries.
+Require Import Rseries.
+Require Import SeqProp.
+Require Import PartSum.
+Require Import Ratan.
+
+Local Open Scope R_scope.
+
+(* Proving a few formulas in the style of John Machin to compute Pi *)
+
+Definition atan_sub u v := (u - v)/(1 + u * v).
+
+Lemma atan_sub_correct :
+ forall u v, 1 + u * v <> 0 -> -PI/2 < atan u - atan v < PI/2 ->
+   -PI/2 < atan (atan_sub u v) < PI/2 ->
+   atan u = atan v + atan (atan_sub u v).
+intros u v pn0 uvint aint.
+assert (cos (atan u) <> 0).
+ destruct (atan_bound u); apply Rgt_not_eq, cos_gt_0; auto.
+ rewrite <- Ropp_div; assumption.
+assert (cos (atan v) <> 0).
+ destruct (atan_bound v); apply Rgt_not_eq, cos_gt_0; auto.
+ rewrite <- Ropp_div; assumption.
+assert (t : forall a b c, a - b = c -> a = b + c) by (intros; subst; field).
+apply t, tan_is_inj; clear t; try assumption.
+rewrite tan_minus; auto.
+  rewrite !atan_right_inv; reflexivity.
+apply Rgt_not_eq, cos_gt_0; rewrite <- ?Ropp_div; tauto.
+rewrite !atan_right_inv; assumption.
+Qed.
+
+Lemma tech : forall x y , -1 <= x <= 1 -> -1 < y < 1 -> 
+  -PI/2 < atan x - atan y < PI/2.
+assert (ut := PI_RGT_0).
+intros x y [xm1 x1] [ym1 y1].
+assert (-(PI/4) <= atan x).
+ destruct xm1 as [xm1 | xm1].
+  rewrite <- atan_1, <- atan_opp; apply Rlt_le, atan_increasing.
+  assumption.
+ solve[rewrite <- xm1, atan_opp, atan_1; apply Rle_refl].
+assert (-(PI/4) < atan y).
+ rewrite <- atan_1, <- atan_opp; apply atan_increasing.
+ assumption.
+assert (atan x <= PI/4).
+ destruct x1 as [x1 | x1].
+  rewrite <- atan_1; apply Rlt_le, atan_increasing.
+  assumption.
+ solve[rewrite x1, atan_1; apply Rle_refl].
+assert (atan y < PI/4).
+  rewrite <- atan_1; apply atan_increasing.
+  assumption.
+rewrite Ropp_div; split; fourier.
+Qed.
+
+(* A simple formula, reasonably efficient. *)
+Lemma Machin_2_3 : PI/4 = atan(/2) + atan(/3).
+assert (utility : 0 < PI/2) by (apply PI2_RGT_0).
+rewrite <- atan_1.
+rewrite (atan_sub_correct 1 (/2)).
+   apply f_equal, f_equal; unfold atan_sub; field.
+  apply Rgt_not_eq; fourier.
+ apply tech; try split; try fourier.
+apply atan_bound.
+Qed.
+
+Lemma Machin_4_5_239 : PI/4 = 4 * atan (/5) - atan(/239).
+rewrite <- atan_1.
+rewrite (atan_sub_correct 1 (/5));
+ [ | apply Rgt_not_eq; fourier | apply tech; try split; fourier |
+     apply atan_bound ].
+replace (4 * atan (/5) - atan (/239)) with
+  (atan (/5) + (atan (/5) + (atan (/5) + (atan (/5) + -
+     atan (/239))))) by ring.
+apply f_equal.
+replace (atan_sub 1 (/5)) with (2/3) by
+  (unfold atan_sub; field).
+rewrite (atan_sub_correct (2/3) (/5));
+ [apply f_equal | apply Rgt_not_eq; fourier | apply tech; try split; fourier |
+     apply atan_bound ].
+replace (atan_sub (2/3) (/5)) with (7/17)  by
+  (unfold atan_sub; field).
+rewrite (atan_sub_correct (7/17) (/5));
+ [apply f_equal | apply Rgt_not_eq; fourier | apply tech; try split; fourier |
+     apply atan_bound ].
+replace (atan_sub (7/17) (/5)) with (9/46) by
+  (unfold atan_sub; field).
+rewrite (atan_sub_correct (9/46) (/5));
+ [apply f_equal | apply Rgt_not_eq; fourier | apply tech; try split; fourier |
+     apply atan_bound ].
+rewrite <- atan_opp; apply f_equal.
+unfold atan_sub; field.
+Qed.
+
+Lemma Machin_2_3_7 : PI/4 = 2 * atan(/3) + (atan (/7)).
+rewrite <- atan_1.
+rewrite (atan_sub_correct 1 (/3));
+ [ | apply Rgt_not_eq; fourier | apply tech; try split; fourier |
+     apply atan_bound ].
+replace (2 * atan (/3) + atan (/7)) with
+  (atan (/3) + (atan (/3) + atan (/7))) by ring.
+apply f_equal.
+replace (atan_sub 1 (/3)) with (/2) by
+  (unfold atan_sub; field).
+rewrite (atan_sub_correct (/2) (/3));
+ [apply f_equal | apply Rgt_not_eq; fourier | apply tech; try split; fourier |
+     apply atan_bound ].
+apply f_equal; unfold atan_sub; field.
+Qed.
+
+(* More efficient way to compute approximations of PI. *)
+
+Definition PI_2_3_7_tg n := 
+  2 * Ratan_seq (/3) n + Ratan_seq (/7) n.
+
+Lemma PI_2_3_7_ineq :
+  forall N : nat,
+    sum_f_R0 (tg_alt PI_2_3_7_tg) (S (2 * N)) <= PI / 4 <=
+    sum_f_R0 (tg_alt PI_2_3_7_tg) (2 * N).
+Proof.
+assert (dec3 : 0 <= /3 <= 1) by (split; fourier).
+assert (dec7 : 0 <= /7 <= 1) by (split; fourier).
+assert (decr : Un_decreasing PI_2_3_7_tg).
+ apply Ratan_seq_decreasing in dec3.
+ apply Ratan_seq_decreasing in dec7.
+ intros n; apply Rplus_le_compat.
+  apply Rmult_le_compat_l; [ fourier | exact (dec3 n)].
+ exact (dec7 n).
+assert (cv : Un_cv PI_2_3_7_tg 0).
+ apply Ratan_seq_converging in dec3.
+ apply Ratan_seq_converging in dec7.
+ intros eps ep.
+ assert (ep' : 0 < eps /3) by fourier.
+ destruct (dec3 _ ep') as [N1 Pn1]; destruct (dec7 _ ep') as [N2 Pn2].
+ exists (N1 + N2)%nat; intros n Nn.
+ unfold PI_2_3_7_tg.
+ rewrite <- (Rplus_0_l 0).
+ apply Rle_lt_trans with
+    (1 := R_dist_plus (2 * Ratan_seq (/3) n) 0 (Ratan_seq (/7) n) 0).
+ replace eps with (2 * eps/3 + eps/3) by field.
+ apply Rplus_lt_compat.
+  unfold R_dist, Rminus, Rdiv.
+  rewrite <- (Rmult_0_r 2), <- Ropp_mult_distr_r_reverse.
+  rewrite <- Rmult_plus_distr_l, Rabs_mult, (Rabs_pos_eq 2);[|fourier].
+  rewrite Rmult_assoc; apply Rmult_lt_compat_l;[fourier | ].
+   apply (Pn1 n); omega.
+  apply (Pn2 n); omega.
+rewrite Machin_2_3_7.
+rewrite !atan_eq_ps_atan; try (split; fourier).
+unfold ps_atan; destruct (in_int (/3)); destruct (in_int (/7));
+  try match goal with id : ~ _ |- _ => case id; split; fourier end.
+destruct (ps_atan_exists_1 (/3)) as [v3 Pv3].
+destruct (ps_atan_exists_1 (/7)) as [v7 Pv7].
+assert (main : Un_cv (sum_f_R0 (tg_alt PI_2_3_7_tg)) (2 * v3 + v7)).
+ assert (main :Un_cv (fun n => 2 * sum_f_R0 (tg_alt (Ratan_seq (/3))) n +
+                        sum_f_R0 (tg_alt (Ratan_seq (/7))) n) (2 * v3 + v7)).
+  apply CV_plus;[ | assumption].
+  apply CV_mult;[ | assumption].
+  exists 0%nat; intros; rewrite R_dist_eq; assumption.
+ apply Un_cv_ext with (2 := main).
+ intros n; rewrite scal_sum, <- plus_sum; apply sum_eq; intros.
+ rewrite Rmult_comm; unfold PI_2_3_7_tg, tg_alt; field.
+intros N; apply (alternated_series_ineq _ _ _ decr cv main).
+Qed.
diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v
index 79060771..67e353ee 100644
--- a/theories/Reals/NewtonInt.v
+++ b/theories/Reals/NewtonInt.v
@@ -1,19 +1,17 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: NewtonInt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
-Require Import Rtrigo.
+Require Import Rtrigo1.
 Require Import Ranalysis.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (*******************************************)
 (*            Newton's Integral            *)
@@ -30,8 +28,8 @@ Lemma FTCN_step1 :
   forall (f:Differential) (a b:R),
     Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b.
 Proof.
-  intros f a b; unfold Newton_integrable in |- *; exists (d1 f);
-    unfold antiderivative in |- *; intros; case (Rle_dec a b);
+  intros f a b; unfold Newton_integrable; exists (d1 f);
+    unfold antiderivative; intros; case (Rle_dec a b);
       intro;
         [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ]
           | right; split;
@@ -44,26 +42,26 @@ Lemma FTC_Newton :
     NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b
     (FTCN_step1 f a b) = f b - f a.
 Proof.
-  intros; unfold NewtonInt in |- *; reflexivity.
+  intros; unfold NewtonInt; reflexivity.
 Qed.
 
 (* $\int_a^a f$ exists forall a:R and f:R->R *)
 Lemma NewtonInt_P1 : forall (f:R -> R) (a:R), Newton_integrable f a a.
 Proof.
-  intros f a; unfold Newton_integrable in |- *;
+  intros f a; unfold Newton_integrable;
     exists (fct_cte (f a) * id)%F; left;
-      unfold antiderivative in |- *; split.
+      unfold antiderivative; split.
   intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x).
   apply derivable_pt_mult.
   apply derivable_pt_const.
   apply derivable_pt_id.
   exists H1; assert (H2 : x = a).
   elim H; intros; apply Rle_antisym; assumption.
-  symmetry  in |- *; apply derive_pt_eq_0;
+  symmetry ; apply derive_pt_eq_0;
     replace (f x) with (0 * id x + fct_cte (f a) x * 1);
     [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x);
       [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ]
-      | unfold id, fct_cte in |- *; rewrite H2; ring ].
+      | unfold id, fct_cte; rewrite H2; ring ].
   right; reflexivity.
 Defined.
 
@@ -71,8 +69,8 @@ Defined.
 Lemma NewtonInt_P2 :
   forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0.
 Proof.
-  intros; unfold NewtonInt in |- *; simpl in |- *;
-    unfold mult_fct, fct_cte, id in |- *; ring.
+  intros; unfold NewtonInt; simpl;
+    unfold mult_fct, fct_cte, id; ring.
 Qed.
 
 (* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *)
@@ -80,7 +78,7 @@ Lemma NewtonInt_P3 :
   forall (f:R -> R) (a b:R) (X:Newton_integrable f a b),
     Newton_integrable f b a.
 Proof.
-  unfold Newton_integrable in |- *; intros; elim X; intros g H;
+  unfold Newton_integrable; intros; elim X; intros g H;
     exists g; tauto.
 Defined.
 
@@ -90,7 +88,7 @@ Lemma NewtonInt_P4 :
     NewtonInt f a b pr = - NewtonInt f b a (NewtonInt_P3 f a b pr).
 Proof.
   intros; unfold Newton_integrable in pr; elim pr; intros; elim p; intro.
-  unfold NewtonInt in |- *;
+  unfold NewtonInt;
     case
     (NewtonInt_P3 f a b
       (exist
@@ -108,7 +106,7 @@ Proof.
   assert (H4 : a <= b <= b).
   split; [ assumption | right; reflexivity ].
   assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring.
-  unfold NewtonInt in |- *;
+  unfold NewtonInt;
     case
     (NewtonInt_P3 f a b
       (exist
@@ -134,37 +132,37 @@ Lemma NewtonInt_P5 :
     Newton_integrable g a b ->
     Newton_integrable (fun x:R => l * f x + g x) a b.
 Proof.
-  unfold Newton_integrable in |- *; intros f g l a b X X0;
+  unfold Newton_integrable; intros f g l a b X X0;
     elim X; intros; elim X0; intros;
       exists (fun y:R => l * x y + x0 y).
   elim p; intro.
   elim p0; intro.
-  left; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
+  left; unfold antiderivative; unfold antiderivative in H, H0; elim H;
     clear H; intros; elim H0; clear H0; intros H0 _.
   split.
   intros; elim (H _ H2); elim (H0 _ H2); intros.
   assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
   reg.
-  exists H5; symmetry  in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
+  exists H5; symmetry ; reg; rewrite <- H3; rewrite <- H4; reflexivity.
   assumption.
   unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro.
   elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
-  left; rewrite <- H5; unfold antiderivative in |- *; split.
+  left; rewrite <- H5; unfold antiderivative; split.
   intros; elim H6; intros; assert (H9 : x1 = a).
   apply Rle_antisym; assumption.
   assert (H10 : a <= x1 <= b).
-  split; right; [ symmetry  in |- *; assumption | rewrite <- H5; assumption ].
+  split; right; [ symmetry ; assumption | rewrite <- H5; assumption ].
   assert (H11 : b <= x1 <= a).
-  split; right; [ rewrite <- H5; symmetry  in |- *; assumption | assumption ].
+  split; right; [ rewrite <- H5; symmetry ; assumption | assumption ].
   assert (H12 : derivable_pt x x1).
-  unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H10); intros;
-    eapply derive_pt_eq_1; symmetry  in |- *; apply H12.
+  unfold derivable_pt; exists (f x1); elim (H3 _ H10); intros;
+    eapply derive_pt_eq_1; symmetry ; apply H12.
   assert (H13 : derivable_pt x0 x1).
-  unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H11); intros;
-    eapply derive_pt_eq_1; symmetry  in |- *; apply H13.
+  unfold derivable_pt; exists (g x1); elim (H1 _ H11); intros;
+    eapply derive_pt_eq_1; symmetry ; apply H13.
   assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
   reg.
-  exists H14; symmetry  in |- *; reg.
+  exists H14; symmetry ; reg.
   assert (H15 : derive_pt x0 x1 H13 = g x1).
   elim (H1 _ H11); intros; rewrite H15; apply pr_nu.
   assert (H16 : derive_pt x x1 H12 = f x1).
@@ -174,34 +172,34 @@ Proof.
   elim p0; intro.
   unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro.
   elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
-  left; rewrite H5; unfold antiderivative in |- *; split.
+  left; rewrite H5; unfold antiderivative; split.
   intros; elim H6; intros; assert (H9 : x1 = a).
   apply Rle_antisym; assumption.
   assert (H10 : a <= x1 <= b).
-  split; right; [ symmetry  in |- *; assumption | rewrite H5; assumption ].
+  split; right; [ symmetry ; assumption | rewrite H5; assumption ].
   assert (H11 : b <= x1 <= a).
-  split; right; [ rewrite H5; symmetry  in |- *; assumption | assumption ].
+  split; right; [ rewrite H5; symmetry ; assumption | assumption ].
   assert (H12 : derivable_pt x x1).
-  unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H11); intros;
-    eapply derive_pt_eq_1; symmetry  in |- *; apply H12.
+  unfold derivable_pt; exists (f x1); elim (H3 _ H11); intros;
+    eapply derive_pt_eq_1; symmetry ; apply H12.
   assert (H13 : derivable_pt x0 x1).
-  unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H10); intros;
-    eapply derive_pt_eq_1; symmetry  in |- *; apply H13.
+  unfold derivable_pt; exists (g x1); elim (H1 _ H10); intros;
+    eapply derive_pt_eq_1; symmetry ; apply H13.
   assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
   reg.
-  exists H14; symmetry  in |- *; reg.
+  exists H14; symmetry ; reg.
   assert (H15 : derive_pt x0 x1 H13 = g x1).
   elim (H1 _ H10); intros; rewrite H15; apply pr_nu.
   assert (H16 : derive_pt x x1 H12 = f x1).
   elim (H3 _ H11); intros; rewrite H16; apply pr_nu.
   rewrite H15; rewrite H16; ring.
   right; reflexivity.
-  right; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
+  right; unfold antiderivative; unfold antiderivative in H, H0; elim H;
     clear H; intros; elim H0; clear H0; intros H0 _; split.
   intros; elim (H _ H2); elim (H0 _ H2); intros.
   assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
   reg.
-  exists H5; symmetry  in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
+  exists H5; symmetry ; reg; rewrite <- H3; rewrite <- H4; reflexivity.
   assumption.
 Defined.
 
@@ -212,12 +210,12 @@ Lemma antiderivative_P1 :
     antiderivative g G a b ->
     antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b.
 Proof.
-  unfold antiderivative in |- *; intros; elim H; elim H0; clear H H0; intros;
+  unfold antiderivative; intros; elim H; elim H0; clear H H0; intros;
     split.
   intros; elim (H _ H3); elim (H1 _ H3); intros.
   assert (H6 : derivable_pt (fun x:R => l * F x + G x) x).
   reg.
-  exists H6; symmetry  in |- *; reg; rewrite <- H4; rewrite <- H5; ring.
+  exists H6; symmetry ; reg; rewrite <- H4; rewrite <- H5; ring.
   assumption.
 Qed.
 
@@ -228,7 +226,7 @@ Lemma NewtonInt_P6 :
     NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) =
     l * NewtonInt f a b pr1 + NewtonInt g a b pr2.
 Proof.
-  intros f g l a b pr1 pr2; unfold NewtonInt in |- *;
+  intros f g l a b pr1 pr2; unfold NewtonInt;
     case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1;
       intros; case pr2; intros; case (total_order_T a b);
         intro.
@@ -279,7 +277,7 @@ Lemma antiderivative_P2 :
         | right _ => F1 x + (F0 b - F1 b)
       end) a c.
 Proof.
-  unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0;
+  unfold antiderivative; intros; elim H; clear H; intros; elim H0;
     clear H0; intros; split.
   2: apply Rle_trans with b; assumption.
   intros; elim H3; clear H3; intros; case (total_order_T x b); intro.
@@ -295,25 +293,25 @@ Proof.
             | left _ => F0 x
             | right _ => F1 x + (F0 b - F1 b)
           end) x (f x)).
-  unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F0 x x0 = f x).
-  symmetry  in |- *; assumption.
+  unfold derivable_pt_lim; assert (H7 : derive_pt F0 x x0 = f x).
+  symmetry ; assumption.
   assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8;
     intros; elim (H8 _ H9); intros; set (D := Rmin x1 (b - x)).
   assert (H11 : 0 < D).
-  unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - x)); intro.
+  unfold D; unfold Rmin; case (Rle_dec x1 (b - x)); intro.
   apply (cond_pos x1).
   apply Rlt_Rminus; assumption.
   exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
   case (Rle_dec (x + h) b); intro.
   apply H10.
   assumption.
-  apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
+  apply Rlt_le_trans with D; [ assumption | unfold D; apply Rmin_l ].
   elim n; left; apply Rlt_le_trans with (x + D).
   apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h).
   apply RRle_abs.
   apply H13.
   apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
-    rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *;
+    rewrite Rplus_0_l; rewrite Rplus_comm; unfold D;
       apply Rmin_r.
   elim n; left; assumption.
   assert
@@ -324,16 +322,16 @@ Proof.
           | left _ => F0 x
           | right _ => F1 x + (F0 b - F1 b)
         end) x).
-  unfold derivable_pt in |- *; exists (f x); apply H7.
-  exists H8; symmetry  in |- *; apply derive_pt_eq_0; apply H7.
+  unfold derivable_pt; exists (f x); apply H7.
+  exists H8; symmetry ; apply derive_pt_eq_0; apply H7.
   assert (H5 : a <= x <= b).
   split; [ assumption | right; assumption ].
   assert (H6 : b <= x <= c).
-  split; [ right; symmetry  in |- *; assumption | assumption ].
+  split; [ right; symmetry ; assumption | assumption ].
   elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x).
-  symmetry  in |- *; assumption.
+  symmetry ; assumption.
   assert (H10 : derive_pt F1 x x0 = f x).
-  symmetry  in |- *; assumption.
+  symmetry ; assumption.
   assert (H11 := derive_pt_eq_1 F0 x (f x) x1 H9);
     assert (H12 := derive_pt_eq_1 F1 x (f x) x0 H10);
       assert
@@ -344,21 +342,21 @@ Proof.
               | left _ => F0 x
               | right _ => F1 x + (F0 b - F1 b)
             end) x (f x)).
-  unfold derivable_pt_lim in |- *; unfold derivable_pt_lim in H11, H12; intros;
+  unfold derivable_pt_lim; unfold derivable_pt_lim in H11, H12; intros;
     elim (H11 _ H13); elim (H12 _ H13); intros; set (D := Rmin x2 x3);
       assert (H16 : 0 < D).
-  unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x2 x3); intro.
+  unfold D; unfold Rmin; case (Rle_dec x2 x3); intro.
   apply (cond_pos x2).
   apply (cond_pos x3).
   exists (mkposreal _ H16); intros; case (Rle_dec x b); intro.
   case (Rle_dec (x + h) b); intro.
   apply H15.
   assumption.
-  apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_r ].
+  apply Rlt_le_trans with D; [ assumption | unfold D; apply Rmin_r ].
   replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x).
   apply H14.
   assumption.
-  apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
+  apply Rlt_le_trans with D; [ assumption | unfold D; apply Rmin_l ].
   rewrite b0; ring.
   elim n; right; assumption.
   assert
@@ -369,8 +367,8 @@ Proof.
           | left _ => F0 x
           | right _ => F1 x + (F0 b - F1 b)
         end) x).
-  unfold derivable_pt in |- *; exists (f x); apply H13.
-  exists H14; symmetry  in |- *; apply derive_pt_eq_0; apply H13.
+  unfold derivable_pt; exists (f x); apply H13.
+  exists H14; symmetry ; apply derive_pt_eq_0; apply H13.
   assert (H5 : b <= x <= c).
   split; [ left; assumption | assumption ].
   assert (H6 := H0 _ H5); elim H6; clear H6; intros;
@@ -382,12 +380,12 @@ Proof.
             | left _ => F0 x
             | right _ => F1 x + (F0 b - F1 b)
           end) x (f x)).
-  unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F1 x x0 = f x).
-  symmetry  in |- *; assumption.
+  unfold derivable_pt_lim; assert (H7 : derive_pt F1 x x0 = f x).
+  symmetry ; assumption.
   assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8;
     intros; elim (H8 _ H9); intros; set (D := Rmin x1 (x - b));
       assert (H11 : 0 < D).
-  unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (x - b)); intro.
+  unfold D; unfold Rmin; case (Rle_dec x1 (x - b)); intro.
   apply (cond_pos x1).
   apply Rlt_Rminus; assumption.
   exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
@@ -401,13 +399,13 @@ Proof.
   rewrite <- Rabs_Ropp; apply RRle_abs.
   apply Rlt_le_trans with D.
   apply H13.
-  unfold D in |- *; apply Rmin_r.
+  unfold D; apply Rmin_r.
   replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with
   (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10.
   assumption.
   apply Rlt_le_trans with D.
   assumption.
-  unfold D in |- *; apply Rmin_l.
+  unfold D; apply Rmin_l.
   assert
     (H8 :
       derivable_pt
@@ -416,8 +414,8 @@ Proof.
           | left _ => F0 x
           | right _ => F1 x + (F0 b - F1 b)
         end) x).
-  unfold derivable_pt in |- *; exists (f x); apply H7.
-  exists H8; symmetry  in |- *; apply derive_pt_eq_0; apply H7.
+  unfold derivable_pt; exists (f x); apply H7.
+  exists H8; symmetry ; apply derive_pt_eq_0; apply H7.
 Qed.
 
 Lemma antiderivative_P3 :
@@ -429,15 +427,15 @@ Proof.
   intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
     intros; case (total_order_T a c); intro.
   elim s; intro.
-  right; unfold antiderivative in |- *; split.
+  right; unfold antiderivative; split.
   intros; apply H1; elim H3; intros; split;
     [ assumption | apply Rle_trans with c; assumption ].
   left; assumption.
-  right; unfold antiderivative in |- *; split.
+  right; unfold antiderivative; split.
   intros; apply H1; elim H3; intros; split;
     [ assumption | apply Rle_trans with c; assumption ].
   right; assumption.
-  left; unfold antiderivative in |- *; split.
+  left; unfold antiderivative; split.
   intros; apply H; elim H3; intros; split;
     [ assumption | apply Rle_trans with a; assumption ].
   left; assumption.
@@ -452,15 +450,15 @@ Proof.
   intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
     intros; case (total_order_T c b); intro.
   elim s; intro.
-  right; unfold antiderivative in |- *; split.
+  right; unfold antiderivative; split.
   intros; apply H1; elim H3; intros; split;
     [ apply Rle_trans with c; assumption | assumption ].
   left; assumption.
-  right; unfold antiderivative in |- *; split.
+  right; unfold antiderivative; split.
   intros; apply H1; elim H3; intros; split;
     [ apply Rle_trans with c; assumption | assumption ].
   right; assumption.
-  left; unfold antiderivative in |- *; split.
+  left; unfold antiderivative; split.
   intros; apply H; elim H3; intros; split;
     [ apply Rle_trans with b; assumption | assumption ].
   left; assumption.
@@ -473,7 +471,7 @@ Lemma NewtonInt_P7 :
     Newton_integrable f a b ->
     Newton_integrable f b c -> Newton_integrable f a c.
 Proof.
-  unfold Newton_integrable in |- *; intros f a b c Hab Hbc X X0; elim X;
+  unfold Newton_integrable; intros f a b c Hab Hbc X X0; elim X;
     clear X; intros F0 H0; elim X0; clear X0; intros F1 H1;
       set
         (g :=
@@ -481,7 +479,7 @@ Proof.
             match Rle_dec x b with
               | left _ => F0 x
               | right _ => F1 x + (F0 b - F1 b)
-            end); exists g; left; unfold g in |- *;
+            end); exists g; left; unfold g;
         apply antiderivative_P2.
   elim H0; intro.
   assumption.
@@ -506,7 +504,7 @@ Proof.
   case (total_order_T b c); intro.
   elim s0; intro.
 (* a<b & b<c *)
-  unfold Newton_integrable in |- *;
+  unfold Newton_integrable;
     exists
       (fun x:R =>
         match Rle_dec x b with
@@ -525,7 +523,7 @@ Proof.
 (* a<b & b>c *)
   case (total_order_T a c); intro.
   elim s0; intro.
-  unfold Newton_integrable in |- *; exists F0.
+  unfold Newton_integrable; exists F0.
   left.
   elim H1; intro.
   unfold antiderivative in H; elim H; clear H; intros _ H.
@@ -539,7 +537,7 @@ Proof.
   unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
   rewrite b0; apply NewtonInt_P1.
-  unfold Newton_integrable in |- *; exists F1.
+  unfold Newton_integrable; exists F1.
   right.
   elim H1; intro.
   unfold antiderivative in H; elim H; clear H; intros _ H.
@@ -559,7 +557,7 @@ Proof.
 (* a>b & b<c *)
   case (total_order_T a c); intro.
   elim s0; intro.
-  unfold Newton_integrable in |- *; exists F1.
+  unfold Newton_integrable; exists F1.
   left.
   elim H1; intro.
 (*****************)
@@ -574,7 +572,7 @@ Proof.
   unfold antiderivative in H; elim H; clear H; intros _ H.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
   rewrite b0; apply NewtonInt_P1.
-  unfold Newton_integrable in |- *; exists F0.
+  unfold Newton_integrable; exists F0.
   right.
   elim H0; intro.
   unfold antiderivative in H; elim H; clear H; intros _ H.
@@ -603,7 +601,7 @@ Lemma NewtonInt_P9 :
     NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2) =
     NewtonInt f a b pr1 + NewtonInt f b c pr2.
 Proof.
-  intros; unfold NewtonInt in |- *.
+  intros; unfold NewtonInt.
   case (NewtonInt_P8 f a b c pr1 pr2); intros.
   case pr1; intros.
   case pr2; intros.
@@ -643,7 +641,7 @@ Proof.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
 (* a<b & b=c *)
   rewrite <- b0.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rplus_0_r.
   rewrite <- b0 in o.
   elim o0; intro.
   elim o; intro.
@@ -761,7 +759,7 @@ Proof.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
 (* a>b & b=c *)
   rewrite <- b0.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rplus_0_r.
   rewrite <- b0 in o.
   elim o0; intro.
   unfold antiderivative in H; elim H; clear H; intros _ H.
diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v
index e7182312..d4d91137 100644
--- a/theories/Reals/PSeries_reg.v
+++ b/theories/Reals/PSeries_reg.v
@@ -1,20 +1,18 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: PSeries_reg.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
 Require Import Ranalysis1.
 Require Import Max.
 Require Import Even.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Definition Boule (x:R) (r:posreal) (y:R) : Prop := Rabs (y - x) < r.
 
@@ -46,7 +44,7 @@ Lemma CVN_CVU :
     (cv:forall x:R, {l:R | Un_cv (fun N:nat => SP fn N x) l })
     (r:posreal), CVN_r fn r -> CVU (fun n:nat => SP fn n) (SFL fn cv) 0 r.
 Proof.
-  intros; unfold CVU in |- *; intros.
+  intros; unfold CVU; intros.
   unfold CVN_r in X.
   elim X; intros An X0.
   elim X0; intros s H0.
@@ -60,7 +58,7 @@ Proof.
     rewrite Ropp_minus_distr';
       rewrite (Rabs_right (s - sum_f_R0 (fun k:nat => Rabs (An k)) n)).
   eapply sum_maj1.
-  unfold SFL in |- *; case (cv y); intro.
+  unfold SFL; case (cv y); intro.
   trivial.
   apply H1.
   intro; elim H0; intros.
@@ -71,7 +69,7 @@ Proof.
   apply H8; apply H6.
   apply Rle_ge;
     apply Rplus_le_reg_l with (sum_f_R0 (fun k:nat => Rabs (An k)) n).
-  rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm s);
+  rewrite Rplus_0_r; unfold Rminus; rewrite (Rplus_comm s);
     rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l;
       apply sum_incr.
   apply H1.
@@ -79,10 +77,10 @@ Proof.
   unfold R_dist in H4; unfold Rminus in H4; rewrite Ropp_0 in H4.
   assert (H7 := H4 n H5).
   rewrite Rplus_0_r in H7; apply H7.
-  unfold Un_cv in H1; unfold Un_cv in |- *; intros.
+  unfold Un_cv in H1; unfold Un_cv; intros.
   elim (H1 _ H3); intros.
   exists x; intros.
-  unfold R_dist in |- *; unfold R_dist in H4.
+  unfold R_dist; unfold R_dist in H4.
   rewrite Rminus_0_r; apply H4; assumption.
 Qed.
 
@@ -93,13 +91,13 @@ Lemma CVU_continuity :
     (forall (n:nat) (y:R), Boule x r y -> continuity_pt (fn n) y) ->
     forall y:R, Boule x r y -> continuity_pt f y.
 Proof.
-  intros; unfold continuity_pt in |- *; unfold continue_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
-      simpl in |- *; unfold R_dist in |- *; intros.
+  intros; unfold continuity_pt; unfold continue_in;
+    unfold limit1_in; unfold limit_in;
+      simpl; unfold R_dist; intros.
   unfold CVU in H.
   cut (0 < eps / 3);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
   elim (H _ H3); intros N0 H4.
   assert (H5 := H0 N0 y H1).
@@ -112,7 +110,7 @@ Proof.
   set (del := Rmin del1 del2).
   exists del; intros.
   split.
-  unfold del in |- *; unfold Rmin in |- *; case (Rle_dec del1 del2); intro.
+  unfold del; unfold Rmin; case (Rle_dec del1 del2); intro.
   apply (cond_pos del1).
   elim H8; intros; assumption.
   intros;
@@ -132,27 +130,27 @@ Proof.
   elim H9; intros.
   apply Rlt_le_trans with del.
   assumption.
-  unfold del in |- *; apply Rmin_l.
+  unfold del; apply Rmin_l.
   elim H8; intros.
   apply H11.
   split.
   elim H9; intros; assumption.
   elim H9; intros; apply Rlt_le_trans with del.
   assumption.
-  unfold del in |- *; apply Rmin_r.
+  unfold del; apply Rmin_r.
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H4.
   apply le_n.
   assumption.
   apply Rmult_eq_reg_l with 3.
-  do 2 rewrite Rmult_plus_distr_l; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+  do 2 rewrite Rmult_plus_distr_l; unfold Rdiv; rewrite <- Rmult_assoc;
     rewrite Rinv_r_simpl_m.
   ring.
   discrR.
   discrR.
   cut (0 < r - Rabs (x - y)).
   intro; exists (mkposreal _ H6).
-  simpl in |- *; intros.
-  unfold Boule in |- *; replace (y + h - x) with (h + (y - x));
+  simpl; intros.
+  unfold Boule; replace (y + h - x) with (h + (y - x));
     [ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)).
   apply Rabs_triang.
   apply Rplus_lt_reg_r with (- Rabs (x - y)).
@@ -175,8 +173,8 @@ Lemma continuity_pt_finite_SF :
     continuity_pt (fun y:R => sum_f_R0 (fun k:nat => fn k y) N) x.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; apply (H 0%nat); apply le_n.
-  simpl in |- *;
+  simpl; apply (H 0%nat); apply le_n.
+  simpl;
     replace (fun y:R => sum_f_R0 (fun k:nat => fn k y) N + fn (S N) y) with
     ((fun y:R => sum_f_R0 (fun k:nat => fn k y) N) + (fun y:R => fn (S N) y))%F;
     [ idtac | reflexivity ].
@@ -199,7 +197,7 @@ Proof.
   intros; eapply CVU_continuity.
   apply CVN_CVU.
   apply X.
-  intros; unfold SP in |- *; apply continuity_pt_finite_SF.
+  intros; unfold SP; apply continuity_pt_finite_SF.
   intros; apply H.
   apply H1.
   apply H0.
@@ -210,7 +208,7 @@ Lemma SFL_continuity :
     (cv:forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }),
     CVN_R fn -> (forall n:nat, continuity (fn n)) -> continuity (SFL fn cv).
 Proof.
-  intros; unfold continuity in |- *; intro.
+  intros; unfold continuity; intro.
   cut (0 < Rabs x + 1);
     [ intro | apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ] ].
   cut (Boule 0 (mkposreal _ H0) x).
@@ -218,8 +216,8 @@ Proof.
   apply X.
   intros; apply (H n y).
   apply H1.
-  unfold Boule in |- *; simpl in |- *; rewrite Rminus_0_r;
-    pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r;
+  unfold Boule; simpl; rewrite Rminus_0_r;
+    pattern (Rabs x) at 1; rewrite <- Rplus_0_r;
       apply Rplus_lt_compat_l; apply Rlt_0_1.
 Qed.
 
@@ -229,10 +227,10 @@ Lemma CVN_R_CVS :
     CVN_R fn -> forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }.
 Proof.
   intros; apply R_complete.
-  unfold SP in |- *; set (An := fun N:nat => fn N x).
-  change (Cauchy_crit_series An) in |- *.
+  unfold SP; set (An := fun N:nat => fn N x).
+  change (Cauchy_crit_series An).
   apply cauchy_abs.
-  unfold Cauchy_crit_series in |- *; apply CV_Cauchy.
+  unfold Cauchy_crit_series; apply CV_Cauchy.
   unfold CVN_R in X; cut (0 < Rabs x + 1).
   intro; assert (H0 := X (mkposreal _ H)).
   unfold CVN_r in H0; elim H0; intros Bn H1.
@@ -241,13 +239,13 @@ Proof.
   apply Rseries_CV_comp with Bn.
   intro; split.
   apply Rabs_pos.
-  unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *;
+  unfold An; apply H4; unfold Boule; simpl;
     rewrite Rminus_0_r.
-  pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+  pattern (Rabs x) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
     apply Rlt_0_1.
   exists l.
   cut (forall n:nat, 0 <= Bn n).
-  intro; unfold Un_cv in H3; unfold Un_cv in |- *; intros.
+  intro; unfold Un_cv in H3; unfold Un_cv; intros.
   elim (H3 _ H6); intros.
   exists x0; intros.
   replace (sum_f_R0 Bn n) with (sum_f_R0 (fun k:nat => Rabs (Bn k)) n).
@@ -255,8 +253,8 @@ Proof.
   apply sum_eq; intros; apply Rabs_right; apply Rle_ge; apply H5.
   intro; apply Rle_trans with (Rabs (An n)).
   apply Rabs_pos.
-  unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *;
-    rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *;
+  unfold An; apply H4; unfold Boule; simpl;
+    rewrite Rminus_0_r; pattern (Rabs x) at 1;
       rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1.
   apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ].
 Qed.
diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v
index b2a0e574..d765cf78 100644
--- a/theories/Reals/PartSum.v
+++ b/theories/Reals/PartSum.v
@@ -1,27 +1,25 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: PartSum.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rseries.
 Require Import Rcomplete.
 Require Import Max.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Lemma tech1 :
   forall (An:nat -> R) (N:nat),
     (forall n:nat, (n <= N)%nat -> 0 < An n) -> 0 < sum_f_R0 An N.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; apply H; apply le_n.
-  simpl in |- *; apply Rplus_lt_0_compat.
+  simpl; apply H; apply le_n.
+  simpl; apply Rplus_lt_0_compat.
   apply HrecN; intros; apply H; apply le_S; assumption.
   apply H; apply le_n.
 Qed.
@@ -54,7 +52,7 @@ Proof.
   repeat rewrite S_INR; ring.
   apply le_n_S; apply lt_le_weak; assumption.
   apply lt_le_S; assumption.
-  rewrite H1; rewrite <- minus_n_n; simpl in |- *.
+  rewrite H1; rewrite <- minus_n_n; simpl.
   replace (n + 0)%nat with n; [ reflexivity | ring ].
   inversion H.
   right; reflexivity.
@@ -68,7 +66,7 @@ Lemma tech3 :
 Proof.
   intros; cut (1 - k <> 0).
   intro; induction  N as [| N HrecN].
-  simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym.
+  simpl; rewrite Rmult_1_r; unfold Rdiv; rewrite <- Rinv_r_sym.
   reflexivity.
   apply H0.
   replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with
@@ -77,15 +75,15 @@ Proof.
     replace ((1 - k ^ S N) / (1 - k) + k ^ S N) with
     ((1 - k ^ S N + (1 - k) * k ^ S N) / (1 - k)).
   apply Rmult_eq_reg_l with (1 - k).
-  unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ (1 - k)));
+  unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ (1 - k)));
     repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
-      [ do 2 rewrite Rmult_1_l; simpl in |- *; ring | apply H0 ].
+      [ do 2 rewrite Rmult_1_l; simpl; ring | apply H0 ].
   apply H0.
-  unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k));
+  unfold Rdiv; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k));
     repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
   rewrite Rmult_1_r; reflexivity.
   apply H0.
-  apply Rminus_eq_contra; red in |- *; intro; elim H; symmetry  in |- *;
+  apply Rminus_eq_contra; red; intro; elim H; symmetry ;
     assumption.
 Qed.
 
@@ -94,11 +92,11 @@ Lemma tech4 :
     0 <= k -> (forall i:nat, An (S i) < k * An i) -> An N <= An 0%nat * k ^ N.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; right; ring.
+  simpl; right; ring.
   apply Rle_trans with (k * An N).
   left; apply (H0 N).
   replace (S N) with (N + 1)%nat; [ idtac | ring ].
-  rewrite pow_add; simpl in |- *; rewrite Rmult_1_r;
+  rewrite pow_add; simpl; rewrite Rmult_1_r;
     replace (An 0%nat * (k ^ N * k)) with (k * (An 0%nat * k ^ N));
     [ idtac | ring ]; apply Rmult_le_compat_l.
   assumption.
@@ -118,7 +116,7 @@ Lemma tech6 :
     sum_f_R0 An N <= An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; right; ring.
+  simpl; right; ring.
   apply Rle_trans with (An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N + An (S N)).
   rewrite tech5; do 2 rewrite <- (Rplus_comm (An (S N)));
     apply Rplus_le_compat_l.
@@ -129,13 +127,13 @@ Qed.
 
 Lemma tech7 : forall r1 r2:R, r1 <> 0 -> r2 <> 0 -> r1 <> r2 -> / r1 <> / r2.
 Proof.
-  intros; red in |- *; intro.
+  intros; red; intro.
   assert (H3 := Rmult_eq_compat_l r1 _ _ H2).
   rewrite <- Rinv_r_sym in H3; [ idtac | assumption ].
   assert (H4 := Rmult_eq_compat_l r2 _ _ H3).
   rewrite Rmult_1_r in H4; rewrite <- Rmult_assoc in H4.
   rewrite Rinv_r_simpl_m in H4; [ idtac | assumption ].
-  elim H1; symmetry  in |- *; assumption.
+  elim H1; symmetry ; assumption.
 Qed.
 
 Lemma tech11 :
@@ -144,7 +142,7 @@ Lemma tech11 :
     sum_f_R0 An N = sum_f_R0 Bn N - sum_f_R0 Cn N.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; apply H.
+  simpl; apply H.
   do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring.
 Qed.
 
@@ -153,7 +151,7 @@ Lemma tech12 :
     Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l ->
     Pser An x l.
 Proof.
-  intros; unfold Pser in |- *; unfold infinite_sum in |- *; unfold Un_cv in H;
+  intros; unfold Pser; unfold infinite_sum; unfold Un_cv in H;
     assumption.
 Qed.
 
@@ -162,7 +160,7 @@ Lemma scal_sum :
     x * sum_f_R0 An N = sum_f_R0 (fun i:nat => An i * x) N.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; ring.
+  simpl; ring.
   do 2 rewrite tech5.
   rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring.
 Qed.
@@ -181,14 +179,14 @@ Proof.
   do 2 rewrite tech5.
   replace (S (S (pred N))) with (S N).
   rewrite (HrecN H1); ring.
-  rewrite H2; simpl in |- *; reflexivity.
+  rewrite H2; simpl; reflexivity.
   assert (H2 := O_or_S N).
   elim H2; intros.
   elim a; intros.
   rewrite <- p.
-  simpl in |- *; reflexivity.
+  simpl; reflexivity.
   rewrite <- b in H1; elim (lt_irrefl _ H1).
-  rewrite H1; simpl in |- *; reflexivity.
+  rewrite H1; simpl; reflexivity.
   inversion H.
   right; reflexivity.
   left; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
@@ -199,7 +197,7 @@ Lemma plus_sum :
     sum_f_R0 (fun i:nat => An i + Bn i) N = sum_f_R0 An N + sum_f_R0 Bn N.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; ring.
+  simpl; ring.
   do 3 rewrite tech5; rewrite HrecN; ring.
 Qed.
 
@@ -209,7 +207,7 @@ Lemma sum_eq :
     sum_f_R0 An N = sum_f_R0 Bn N.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; apply H; apply le_n.
+  simpl; apply H; apply le_n.
   do 2 rewrite tech5; rewrite HrecN.
   rewrite (H (S N)); [ reflexivity | apply le_n ].
   intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ].
@@ -220,7 +218,7 @@ Lemma uniqueness_sum :
   forall (An:nat -> R) (l1 l2:R),
     infinite_sum An l1 -> infinite_sum An l2 -> l1 = l2.
 Proof.
-  unfold infinite_sum in |- *; intros.
+  unfold infinite_sum; intros.
   case (Req_dec l1 l2); intro.
   assumption.
   cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ].
@@ -237,19 +235,19 @@ Proof.
   intro; rewrite H12 in H11; assert (H13 := double_var); unfold Rdiv in H13;
     rewrite <- H13 in H11.
   elim (Rlt_irrefl _ H11).
-  apply Rabs_right; left; change (0 < / 2) in |- *; apply Rinv_0_lt_compat;
+  apply Rabs_right; left; change (0 < / 2); apply Rinv_0_lt_compat;
     cut (0%nat <> 2%nat);
-      [ intro H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR in |- *;
+      [ intro H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR;
         intro; assumption
         | discriminate ].
-  unfold R_dist in |- *; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1));
+  unfold R_dist; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1));
     rewrite Ropp_minus_distr'.
   replace (l1 - l2) with (l1 - sum_f_R0 An N + (sum_f_R0 An N - l2));
   [ idtac | ring ].
   apply Rabs_triang.
-  unfold ge in |- *; unfold N in |- *; apply le_max_r.
-  unfold ge in |- *; unfold N in |- *; apply le_max_l.
-  unfold Rdiv in |- *; apply prod_neq_R0.
+  unfold ge; unfold N; apply le_max_r.
+  unfold ge; unfold N; apply le_max_l.
+  unfold Rdiv; apply prod_neq_R0.
   apply Rminus_eq_contra; assumption.
   apply Rinv_neq_0_compat; discrR.
 Qed.
@@ -259,7 +257,7 @@ Lemma minus_sum :
     sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; ring.
+  simpl; ring.
   do 3 rewrite tech5; rewrite HrecN; ring.
 Qed.
 
@@ -270,7 +268,7 @@ Lemma sum_decomposition :
 Proof.
   intros.
   induction  N as [| N HrecN].
-  simpl in |- *; ring.
+  simpl; ring.
   rewrite tech5.
   rewrite (tech5 (fun l:nat => An (S (2 * l))) N).
   replace (2 * S (S N))%nat with (S (S (2 * S N))).
@@ -288,7 +286,7 @@ Lemma sum_Rle :
 Proof.
   intros.
   induction  N as [| N HrecN].
-  simpl in |- *; apply H.
+  simpl; apply H.
   apply le_n.
   do 2 rewrite tech5.
   apply Rle_trans with (sum_f_R0 An N + Bn (S N)).
@@ -308,7 +306,7 @@ Lemma Rsum_abs :
 Proof.
   intros.
   induction  N as [| N HrecN].
-  simpl in |- *.
+  simpl.
   right; reflexivity.
   do 2 rewrite tech5.
   apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))).
@@ -323,7 +321,7 @@ Lemma sum_cte :
 Proof.
   intros.
   induction  N as [| N HrecN].
-  simpl in |- *; ring.
+  simpl; ring.
   rewrite tech5.
   rewrite HrecN; repeat rewrite S_INR; ring.
 Qed.
@@ -335,7 +333,7 @@ Lemma sum_growing :
 Proof.
   intros.
   induction  N as [| N HrecN].
-  simpl in |- *; apply H.
+  simpl; apply H.
   do 2 rewrite tech5.
   apply Rle_trans with (sum_f_R0 An N + Bn (S N)).
   apply Rplus_le_compat_l; apply H.
@@ -350,7 +348,7 @@ Lemma Rabs_triang_gen :
 Proof.
   intros.
   induction  N as [| N HrecN].
-  simpl in |- *.
+  simpl.
   right; reflexivity.
   do 2 rewrite tech5.
   apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))).
@@ -366,7 +364,7 @@ Lemma cond_pos_sum :
 Proof.
   intros.
   induction  N as [| N HrecN].
-  simpl in |- *; apply H.
+  simpl; apply H.
   rewrite tech5.
   apply Rplus_le_le_0_compat.
   apply HrecN.
@@ -382,7 +380,7 @@ Lemma cauchy_abs :
   forall An:nat -> R,
     Cauchy_crit_series (fun i:nat => Rabs (An i)) -> Cauchy_crit_series An.
 Proof.
-  unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
+  unfold Cauchy_crit_series; unfold Cauchy_crit.
   intros.
   elim (H eps H0); intros.
   exists x.
@@ -402,8 +400,8 @@ Proof.
   elim a; intro.
   rewrite (tech2 An n m); [ idtac | assumption ].
   rewrite (tech2 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ].
-  unfold R_dist in |- *.
-  unfold Rminus in |- *.
+  unfold R_dist.
+  unfold Rminus.
   do 2 rewrite Ropp_plus_distr.
   do 2 rewrite <- Rplus_assoc.
   do 2 rewrite Rplus_opp_r.
@@ -416,18 +414,18 @@ Proof.
   replace (fun i:nat => Rabs (An (S n + i)%nat)) with
   (fun i:nat => Rabs (Bn i)).
   apply Rabs_triang_gen.
-  unfold Bn in |- *; reflexivity.
+  unfold Bn; reflexivity.
   apply Rle_ge.
   apply cond_pos_sum.
   intro; apply Rabs_pos.
   rewrite b.
-  unfold R_dist in |- *.
-  unfold Rminus in |- *; do 2 rewrite Rplus_opp_r.
+  unfold R_dist.
+  unfold Rminus; do 2 rewrite Rplus_opp_r.
   rewrite Rabs_R0; right; reflexivity.
   rewrite (tech2 An m n); [ idtac | assumption ].
   rewrite (tech2 (fun i:nat => Rabs (An i)) m n); [ idtac | assumption ].
-  unfold R_dist in |- *.
-  unfold Rminus in |- *.
+  unfold R_dist.
+  unfold Rminus.
   do 2 rewrite Rplus_assoc.
   rewrite (Rplus_comm (sum_f_R0 An m)).
   rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (An i)) m)).
@@ -441,7 +439,7 @@ Proof.
   replace (fun i:nat => Rabs (An (S m + i)%nat)) with
   (fun i:nat => Rabs (Bn i)).
   apply Rabs_triang_gen.
-  unfold Bn in |- *; reflexivity.
+  unfold Bn; reflexivity.
   apply Rle_ge.
   apply cond_pos_sum.
   intro; apply Rabs_pos.
@@ -456,7 +454,7 @@ Proof.
   intros An X.
   elim X; intros.
   unfold Un_cv in p.
-  unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
+  unfold Cauchy_crit_series; unfold Cauchy_crit.
   intros.
   cut (0 < eps / 2).
   intro.
@@ -464,7 +462,7 @@ Proof.
   exists x0.
   intros.
   apply Rle_lt_trans with (R_dist (sum_f_R0 An n) x + R_dist (sum_f_R0 An m) x).
-  unfold R_dist in |- *.
+  unfold R_dist.
   replace (sum_f_R0 An n - sum_f_R0 An m) with
   (sum_f_R0 An n - x + - (sum_f_R0 An m - x)); [ idtac | ring ].
   rewrite <- (Rabs_Ropp (sum_f_R0 An m - x)).
@@ -473,8 +471,8 @@ Proof.
   apply Rplus_lt_compat.
   apply H1; assumption.
   apply H1; assumption.
-  right; symmetry  in |- *; apply double_var.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  right; symmetry ; apply double_var.
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
 Qed.
 
@@ -495,7 +493,7 @@ Lemma sum_eq_R0 :
     (forall n:nat, (n <= N)%nat -> An n = 0) -> sum_f_R0 An N = 0.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; apply H; apply le_n.
+  simpl; apply H; apply le_n.
   rewrite tech5; rewrite HrecN;
     [ rewrite Rplus_0_l; apply H; apply le_n
       | intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ] ].
@@ -532,15 +530,15 @@ Proof.
     [ idtac | ring ]; apply Rle_trans with l1.
   left; apply r.
   apply H6.
-  unfold l1 in |- *; apply Rge_le;
+  unfold l1; apply Rge_le;
     apply (growing_prop (fun k:nat => sum_f_R0 An k)).
   apply H1.
-  unfold ge, N0 in |- *; apply le_max_r.
-  unfold ge, N0 in |- *; apply le_max_l.
+  unfold ge, N0; apply le_max_r.
+  unfold ge, N0; apply le_max_l.
   apply Rplus_lt_reg_r with l; rewrite Rplus_0_r;
     replace (l + (l1 - l)) with l1; [ apply r | ring ].
-  unfold Un_growing in |- *; intro; simpl in |- *;
-    pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
+  unfold Un_growing; intro; simpl;
+    pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r;
       apply Rplus_le_compat_l; apply H0.
 Qed.
 
@@ -574,7 +572,7 @@ Proof.
   apply Rlt_trans with (Rabs l1).
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
-  unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
+  unfold Rdiv; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
     rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply r.
   discrR.
@@ -583,18 +581,18 @@ Proof.
   apply Rplus_lt_reg_r with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)).
   replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with
   (Rabs l1 - Rabs (SP fn N x)).
-  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+  unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l;
     rewrite Rplus_0_r; apply H7.
-  unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
+  unfold Rdiv; rewrite Rmult_plus_distr_r;
     rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l;
-      repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1 in |- *;
-        rewrite double_var; unfold Rdiv in |- *; ring.
+      repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1;
+        rewrite double_var; unfold Rdiv; ring.
   case (Rcase_abs (sum_f_R0 An N - l2)); intro.
   apply Rlt_trans with l2.
   apply (Rminus_lt _ _ r0).
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
-  rewrite (double l2); unfold Rdiv in |- *; rewrite (Rmult_comm 2);
+  rewrite (double l2); unfold Rdiv; rewrite (Rmult_comm 2);
     rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l;
     apply r.
@@ -602,23 +600,23 @@ Proof.
   rewrite (Rabs_right _ r0) in H6; apply Rplus_lt_reg_r with (- l2).
   replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2).
   rewrite Rplus_comm; apply H6.
-  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+  unfold Rdiv; rewrite <- (Rmult_comm (/ 2));
     rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r;
-      pattern l2 at 2 in |- *; rewrite double_var;
+      pattern l2 at 2; rewrite double_var;
         repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr;
-          unfold Rdiv in |- *; ring.
+          unfold Rdiv; ring.
   apply Rle_lt_trans with (Rabs (SP fn N x - l1)).
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply Rabs_triang_inv2.
-  apply H4; unfold ge, N in |- *; apply le_max_l.
-  apply H5; unfold ge, N in |- *; apply le_max_r.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply H4; unfold ge, N; apply le_max_l.
+  apply H5; unfold ge, N; apply le_max_r.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   apply Rplus_lt_reg_r with l2.
   rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1);
     [ apply r | ring ].
   apply Rinv_0_lt_compat; prove_sup0.
   intros; induction  n0 as [| n0 Hrecn0].
-  unfold SP in |- *; simpl in |- *; apply H1.
-  unfold SP in |- *; simpl in |- *.
+  unfold SP; simpl; apply H1.
+  unfold SP; simpl.
   apply Rle_trans with
     (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)).
   apply Rabs_triang.
diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v
index f02db3d4..5fc7d8fb 100644
--- a/theories/Reals/RIneq.v
+++ b/theories/Reals/RIneq.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: RIneq.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (*********************************************************)
 (** * Basic lemmas for the classical real numbers        *)
 (*********************************************************)
@@ -54,13 +52,13 @@ Proof. exact Rlt_irrefl. Qed.
 
 Lemma Rlt_not_eq : forall r1 r2, r1 < r2 -> r1 <> r2.
 Proof.
-  red in |- *; intros r1 r2 H H0; apply (Rlt_irrefl r1).
-  pattern r1 at 2 in |- *; rewrite H0; trivial.
+  red; intros r1 r2 H H0; apply (Rlt_irrefl r1).
+  pattern r1 at 2; rewrite H0; trivial.
 Qed.
 
 Lemma Rgt_not_eq : forall r1 r2, r1 > r2 -> r1 <> r2.
 Proof.
-  intros; apply sym_not_eq; apply Rlt_not_eq; auto with real.
+  intros; apply not_eq_sym; apply Rlt_not_eq; auto with real.
 Qed.
 
 (**********)
@@ -104,7 +102,7 @@ Qed.
 
 Lemma Rlt_le : forall r1 r2, r1 < r2 -> r1 <= r2.
 Proof.
-  intros; red in |- *; tauto.
+  intros; red; tauto.
 Qed.
 Hint Resolve Rlt_le: real.
 
@@ -116,14 +114,14 @@ Qed.
 (**********)
 Lemma Rle_ge : forall r1 r2, r1 <= r2 -> r2 >= r1.
 Proof.
-  destruct 1; red in |- *; auto with real.
+  destruct 1; red; auto with real.
 Qed.
 Hint Immediate Rle_ge: real.
 Hint Resolve Rle_ge: rorders.
 
 Lemma Rge_le : forall r1 r2, r1 >= r2 -> r2 <= r1.
 Proof.
-  destruct 1; red in |- *; auto with real.
+  destruct 1; red; auto with real.
 Qed.
 Hint Resolve Rge_le: real.
 Hint Immediate Rge_le: rorders.
@@ -145,7 +143,7 @@ Hint Immediate Rgt_lt: rorders.
 
 Lemma Rnot_le_lt : forall r1 r2, ~ r1 <= r2 -> r2 < r1.
 Proof.
-  intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto.
+  intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle; tauto.
 Qed.
 Hint Immediate Rnot_le_lt: real.
 
@@ -176,7 +174,7 @@ Proof. eauto using Rnot_gt_ge with rorders. Qed.
 (**********)
 Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2.
 Proof.
-  generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *.
+  generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle.
   intuition eauto 3.
 Qed.
 Hint Immediate Rlt_not_le: real.
@@ -194,7 +192,7 @@ Proof. exact Rlt_not_ge. Qed.
 Lemma Rle_not_lt : forall r1 r2, r2 <= r1 -> ~ r1 < r2.
 Proof.
   intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2).
-  unfold Rle in |- *; intuition.
+  unfold Rle; intuition.
 Qed.
 
 Lemma Rge_not_lt : forall r1 r2, r1 >= r2 -> ~ r1 < r2.
@@ -209,25 +207,25 @@ Proof. do 2 intro; apply Rge_not_lt. Qed.
 (**********)
 Lemma Req_le : forall r1 r2, r1 = r2 -> r1 <= r2.
 Proof.
-  unfold Rle in |- *; tauto.
+  unfold Rle; tauto.
 Qed.
 Hint Immediate Req_le: real.
 
 Lemma Req_ge : forall r1 r2, r1 = r2 -> r1 >= r2.
 Proof.
-  unfold Rge in |- *; tauto.
+  unfold Rge; tauto.
 Qed.
 Hint Immediate Req_ge: real.
 
 Lemma Req_le_sym : forall r1 r2, r2 = r1 -> r1 <= r2.
 Proof.
-  unfold Rle in |- *; auto.
+  unfold Rle; auto.
 Qed.
 Hint Immediate Req_le_sym: real.
 
 Lemma Req_ge_sym : forall r1 r2, r2 = r1 -> r1 >= r2.
 Proof.
-  unfold Rge in |- *; auto.
+  unfold Rge; auto.
 Qed.
 Hint Immediate Req_ge_sym: real.
 
@@ -242,7 +240,7 @@ Proof. do 2 intro; apply Rlt_asym. Qed.
 
 Lemma Rle_antisym : forall r1 r2, r1 <= r2 -> r2 <= r1 -> r1 = r2.
 Proof.
-  intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition.
+  intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle; intuition.
 Qed.
 Hint Resolve Rle_antisym: real.
 
@@ -278,8 +276,8 @@ Proof. intros; red; apply Rlt_eq_compat with (r2:=r4) (r4:=r2); auto. Qed.
 
 Lemma Rle_trans : forall r1 r2 r3, r1 <= r2 -> r2 <= r3 -> r1 <= r3.
 Proof.
-  generalize trans_eq Rlt_trans Rlt_eq_compat.
-  unfold Rle in |- *.
+  generalize eq_trans Rlt_trans Rlt_eq_compat.
+  unfold Rle.
   intuition eauto 2.
 Qed.
 
@@ -293,13 +291,13 @@ Proof. eauto using Rlt_trans with rorders. Qed.
 Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3.
 Proof.
   generalize Rlt_trans Rlt_eq_compat.
-  unfold Rle in |- *.
+  unfold Rle.
   intuition eauto 2.
 Qed.
 
 Lemma Rlt_le_trans : forall r1 r2 r3, r1 < r2 -> r2 <= r3 -> r1 < r3.
 Proof.
-  generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2.
+  generalize Rlt_trans Rlt_eq_compat; unfold Rle; intuition eauto 2.
 Qed.
 
 Lemma Rge_gt_trans : forall r1 r2 r3, r1 >= r2 -> r2 > r3 -> r1 > r3.
@@ -432,7 +430,7 @@ Hint Resolve Rplus_eq_reg_l: real.
 (**********)
 Lemma Rplus_0_r_uniq : forall r r1, r + r1 = r -> r1 = 0.
 Proof.
-  intros r b; pattern r at 2 in |- *; replace r with (r + 0); eauto with real.
+  intros r b; pattern r at 2; replace r with (r + 0); eauto with real.
 Qed.
 
 (***********)
@@ -443,7 +441,7 @@ Proof.
     absurd (0 < a + b).
       rewrite H1; auto with real.
       apply Rle_lt_trans with (a + 0).
-        rewrite Rplus_0_r in |- *; assumption.
+        rewrite Rplus_0_r; assumption.
         auto using Rplus_lt_compat_l with real.
     rewrite <- H0, Rplus_0_r in H1; assumption.
 Qed.
@@ -572,14 +570,14 @@ Qed.
 (**********)
 Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0.
 Proof.
-  intros r1 r2 H; split; red in |- *; intro; apply H; auto with real.
+  intros r1 r2 H; split; red; intro; apply H; auto with real.
 Qed.
 
 (**********)
 Lemma Rmult_integral_contrapositive :
   forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0.
 Proof.
-  red in |- *; intros r1 r2 [H1 H2] H.
+  red; intros r1 r2 [H1 H2] H.
   case (Rmult_integral r1 r2); auto with real.
 Qed.
 Hint Resolve Rmult_integral_contrapositive: real.
@@ -606,12 +604,12 @@ Notation "r ²" := (Rsqr r) (at level 1, format "r ²") : R_scope.
 
 (***********)
 Lemma Rsqr_0 : Rsqr 0 = 0.
-  unfold Rsqr in |- *; auto with real.
+  unfold Rsqr; auto with real.
 Qed.
 
 (***********)
 Lemma Rsqr_0_uniq : forall r, Rsqr r = 0 -> r = 0.
-  unfold Rsqr in |- *; intros; elim (Rmult_integral r r H); trivial.
+  unfold Rsqr; intros; elim (Rmult_integral r r H); trivial.
 Qed.
 
 (*********************************************************)
@@ -649,7 +647,7 @@ Hint Resolve Ropp_involutive: real.
 (*********)
 Lemma Ropp_neq_0_compat : forall r, r <> 0 -> - r <> 0.
 Proof.
-  red in |- *; intros r H H0.
+  red; intros r H H0.
   apply H.
   transitivity (- - r); auto with real.
 Qed.
@@ -722,7 +720,7 @@ Hint Resolve Rminus_diag_eq: real.
 (**********)
 Lemma Rminus_diag_uniq : forall r1 r2, r1 - r2 = 0 -> r1 = r2.
 Proof.
-  intros r1 r2; unfold Rminus in |- *; rewrite Rplus_comm; intro.
+  intros r1 r2; unfold Rminus; rewrite Rplus_comm; intro.
   rewrite <- (Ropp_involutive r2); apply (Rplus_opp_r_uniq (- r2) r1 H).
 Qed.
 Hint Immediate Rminus_diag_uniq: real.
@@ -743,20 +741,20 @@ Hint Resolve Rplus_minus: real.
 (**********)
 Lemma Rminus_eq_contra : forall r1 r2, r1 <> r2 -> r1 - r2 <> 0.
 Proof.
-  red in |- *; intros r1 r2 H H0.
+  red; intros r1 r2 H H0.
   apply H; auto with real.
 Qed.
 Hint Resolve Rminus_eq_contra: real.
 
 Lemma Rminus_not_eq : forall r1 r2, r1 - r2 <> 0 -> r1 <> r2.
 Proof.
-  red in |- *; intros; elim H; apply Rminus_diag_eq; auto.
+  red; intros; elim H; apply Rminus_diag_eq; auto.
 Qed.
 Hint Resolve Rminus_not_eq: real.
 
 Lemma Rminus_not_eq_right : forall r1 r2, r2 - r1 <> 0 -> r1 <> r2.
 Proof.
-  red in |- *; intros; elim H; rewrite H0; ring.
+  red; intros; elim H; rewrite H0; ring.
 Qed.
 Hint Resolve Rminus_not_eq_right: real.
 
@@ -780,7 +778,7 @@ Hint Resolve Rinv_1: real.
 (*********)
 Lemma Rinv_neq_0_compat : forall r, r <> 0 -> / r <> 0.
 Proof.
-  red in |- *; intros; apply R1_neq_R0.
+  red; intros; apply R1_neq_R0.
   replace 1 with (/ r * r); auto with real.
 Qed.
 Hint Resolve Rinv_neq_0_compat: real.
@@ -860,7 +858,7 @@ Proof. do 3 intro; apply Rplus_lt_compat_r. Qed.
 (**********)
 Lemma Rplus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2.
 Proof.
-  unfold Rle in |- *; intros; elim H; intro.
+  unfold Rle; intros; elim H; intro.
   left; apply (Rplus_lt_compat_l r r1 r2 H0).
   right; rewrite <- H0; auto with zarith real.
 Qed.
@@ -872,7 +870,7 @@ Hint Resolve Rplus_ge_compat_l: real.
 (**********)
 Lemma Rplus_le_compat_r : forall r r1 r2, r1 <= r2 -> r1 + r <= r2 + r.
 Proof.
-  unfold Rle in |- *; intros; elim H; intro.
+  unfold Rle; intros; elim H; intro.
   left; apply (Rplus_lt_compat_r r r1 r2 H0).
   right; rewrite <- H0; auto with real.
 Qed.
@@ -933,7 +931,7 @@ Lemma Rplus_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 + r2.
 Proof.
   intros x y; intros; apply Rlt_trans with x;
     [ assumption
-      | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
+      | pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
         assumption ].
 Qed.
 
@@ -941,7 +939,7 @@ Lemma Rplus_le_lt_0_compat : forall r1 r2, 0 <= r1 -> 0 < r2 -> 0 < r1 + r2.
 Proof.
   intros x y; intros; apply Rle_lt_trans with x;
     [ assumption
-      | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
+      | pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
         assumption ].
 Qed.
 
@@ -955,7 +953,7 @@ Lemma Rplus_le_le_0_compat : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2.
 Proof.
   intros x y; intros; apply Rle_trans with x;
     [ assumption
-      | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+      | pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
         assumption ].
 Qed.
 
@@ -983,7 +981,7 @@ Qed.
 
 Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2.
 Proof.
-  unfold Rle in |- *; intros; elim H; intro.
+  unfold Rle; intros; elim H; intro.
   left; apply (Rplus_lt_reg_r r r1 r2 H0).
   right; apply (Rplus_eq_reg_l r r1 r2 H0).
 Qed.
@@ -997,7 +995,7 @@ Qed.
 
 Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2.
 Proof.
-  unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H).
+  unfold Rgt; intros; apply (Rplus_lt_reg_r r r2 r1 H).
 Qed.
 
 Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2.
@@ -1048,7 +1046,7 @@ Qed.
 
 Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2.
 Proof.
-  unfold Rgt in |- *; intros.
+  unfold Rgt; intros.
   apply (Rplus_lt_reg_r (r2 + r1)).
   replace (r2 + r1 + - r1) with r2.
   replace (r2 + r1 + - r2) with r1.
@@ -1060,7 +1058,7 @@ Hint Resolve Ropp_gt_lt_contravar.
 
 Lemma Ropp_lt_gt_contravar : forall r1 r2, r1 < r2 -> - r1 > - r2.
 Proof.
-  unfold Rgt in |- *; auto with real.
+  unfold Rgt; auto with real.
 Qed.
 Hint Resolve Ropp_lt_gt_contravar: real.
 
@@ -1185,7 +1183,7 @@ Proof. eauto using Rmult_lt_compat_l with rorders. Qed.
 Lemma Rmult_le_compat_l :
   forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2.
 Proof.
-  intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle in |- *;
+  intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle;
     auto with real.
   right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity.
 Qed.
@@ -1344,7 +1342,7 @@ Qed.
 (**********)
 Lemma Rle_minus : forall r1 r2, r1 <= r2 -> r1 - r2 <= 0.
 Proof.
-  destruct 1; unfold Rle in |- *; auto with real.
+  destruct 1; unfold Rle; auto with real.
 Qed.
 
 Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0.
@@ -1358,7 +1356,7 @@ Qed.
 Lemma Rminus_lt : forall r1 r2, r1 - r2 < 0 -> r1 < r2.
 Proof.
   intros; replace r1 with (r1 - r2 + r2).
-  pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
+  pattern r2 at 3; replace r2 with (0 + r2); auto with real.
   ring.
 Qed.
 
@@ -1374,7 +1372,7 @@ Qed.
 Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2.
 Proof.
   intros; replace r1 with (r1 - r2 + r2).
-  pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
+  pattern r2 at 3; replace r2 with (0 + r2); auto with real.
   ring.
 Qed.
 
@@ -1389,7 +1387,7 @@ Qed.
 (**********)
 Lemma tech_Rplus : forall r (s:R), 0 <= r -> 0 < s -> r + s <> 0.
 Proof.
-  intros; apply sym_not_eq; apply Rlt_not_eq.
+  intros; apply not_eq_sym; apply Rlt_not_eq.
   rewrite Rplus_comm; replace 0 with (0 + 0); auto with real.
 Qed.
 Hint Immediate tech_Rplus: real.
@@ -1400,7 +1398,7 @@ Hint Immediate tech_Rplus: real.
 
 Lemma Rle_0_sqr : forall r, 0 <= Rsqr r.
 Proof.
-  intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; intro.
+  intro; case (Rlt_le_dec r 0); unfold Rsqr; intro.
   replace (r * r) with (- r * - r); auto with real.
   replace 0 with (- r * 0); auto with real.
   replace 0 with (0 * r); auto with real.
@@ -1409,7 +1407,7 @@ Qed.
 (***********)
 Lemma Rlt_0_sqr : forall r, r <> 0 -> 0 < Rsqr r.
 Proof.
-  intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; intro.
+  intros; case (Rdichotomy r 0); trivial; unfold Rsqr; intro.
   replace (r * r) with (- r * - r); auto with real.
   replace 0 with (- r * 0); auto with real.
   replace 0 with (0 * r); auto with real.
@@ -1439,7 +1437,7 @@ Qed.
 Lemma Rlt_0_1 : 0 < 1.
 Proof.
   replace 1 with (Rsqr 1); auto with real.
-  unfold Rsqr in |- *; auto with real.
+  unfold Rsqr; auto with real.
 Qed.
 Hint Resolve Rlt_0_1: real.
 
@@ -1455,7 +1453,7 @@ Qed.
 
 Lemma Rinv_0_lt_compat : forall r, 0 < r -> 0 < / r.
 Proof.
-  intros; apply Rnot_le_lt; red in |- *; intros.
+  intros; apply Rnot_le_lt; red; intros.
   absurd (1 <= 0); auto with real.
   replace 1 with (r * / r); auto with real.
   replace 0 with (r * 0); auto with real.
@@ -1465,7 +1463,7 @@ Hint Resolve Rinv_0_lt_compat: real.
 (*********)
 Lemma Rinv_lt_0_compat : forall r, r < 0 -> / r < 0.
 Proof.
-  intros; apply Rnot_le_lt; red in |- *; intros.
+  intros; apply Rnot_le_lt; red; intros.
   absurd (1 <= 0); auto with real.
   replace 1 with (r * / r); auto with real.
   replace 0 with (r * 0); auto with real.
@@ -1479,8 +1477,8 @@ Proof.
   case (Rmult_neq_0_reg r1 r2); intros; auto with real.
   replace (r1 * r2 * / r2) with r1.
   replace (r1 * r2 * / r1) with r2; trivial.
-  symmetry  in |- *; auto with real.
-  symmetry  in |- *; auto with real.
+  symmetry ; auto with real.
+  symmetry ; auto with real.
 Qed.
 
 Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1.
@@ -1497,7 +1495,7 @@ Proof.
   rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite (Rmult_comm y (/ y));
     rewrite Rinv_l; auto with real.
   apply Rlt_dichotomy_converse; right.
-  red in |- *; apply Rlt_trans with (r2 := x); auto with real.
+  red; apply Rlt_trans with (r2 := x); auto with real.
 Qed.
 Hint Resolve Rinv_1_lt_contravar: real.
 
@@ -1510,7 +1508,7 @@ Lemma Rle_lt_0_plus_1 : forall r, 0 <= r -> 0 < r + 1.
 Proof.
   intros.
   apply Rlt_le_trans with 1; auto with real.
-  pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real.
+  pattern 1 at 1; replace 1 with (0 + 1); auto with real.
 Qed.
 Hint Resolve Rle_lt_0_plus_1: real.
 
@@ -1518,15 +1516,15 @@ Hint Resolve Rle_lt_0_plus_1: real.
 Lemma Rlt_plus_1 : forall r, r < r + 1.
 Proof.
   intros.
-  pattern r at 1 in |- *; replace r with (r + 0); auto with real.
+  pattern r at 1; replace r with (r + 0); auto with real.
 Qed.
 Hint Resolve Rlt_plus_1: real.
 
 (**********)
 Lemma tech_Rgt_minus : forall r1 r2, 0 < r2 -> r1 > r1 - r2.
 Proof.
-  red in |- *; unfold Rminus in |- *; intros.
-  pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real.
+  red; unfold Rminus; intros.
+  pattern r1 at 2; replace r1 with (r1 + 0); auto with real.
 Qed.
 
 (*********************************************************)
@@ -1542,14 +1540,14 @@ Qed.
 (**********)
 Lemma S_O_plus_INR : forall n:nat, INR (1 + n) = INR 1 + INR n.
 Proof.
-  intro; simpl in |- *; case n; intros; auto with real.
+  intro; simpl; case n; intros; auto with real.
 Qed.
 
 (**********)
 Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m.
 Proof.
   intros n m; induction  n as [| n Hrecn].
-  simpl in |- *; auto with real.
+  simpl; auto with real.
   replace (S n + m)%nat with (S (n + m)); auto with arith.
   repeat rewrite S_INR.
   rewrite Hrecn; ring.
@@ -1559,9 +1557,9 @@ Hint Resolve plus_INR: real.
 (**********)
 Lemma minus_INR : forall n m:nat, (m <= n)%nat -> INR (n - m) = INR n - INR m.
 Proof.
-  intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real.
+  intros n m le; pattern m, n; apply le_elim_rel; auto with real.
   intros; rewrite <- minus_n_O; auto with real.
-  intros; repeat rewrite S_INR; simpl in |- *.
+  intros; repeat rewrite S_INR; simpl.
   rewrite H0; ring.
 Qed.
 Hint Resolve minus_INR: real.
@@ -1570,8 +1568,8 @@ Hint Resolve minus_INR: real.
 Lemma mult_INR : forall n m:nat, INR (n * m) = INR n * INR m.
 Proof.
   intros n m; induction  n as [| n Hrecn].
-  simpl in |- *; auto with real.
-  intros; repeat rewrite S_INR; simpl in |- *.
+  simpl; auto with real.
+  intros; repeat rewrite S_INR; simpl.
   rewrite plus_INR; rewrite Hrecn; ring.
 Qed.
 Hint Resolve mult_INR: real.
@@ -1599,11 +1597,11 @@ Qed.
 Hint Resolve lt_1_INR: real.
 
 (**********)
-Lemma pos_INR_nat_of_P : forall p:positive, 0 < INR (nat_of_P p).
+Lemma pos_INR_nat_of_P : forall p:positive, 0 < INR (Pos.to_nat p).
 Proof.
   intro; apply lt_0_INR.
-  simpl in |- *; auto with real.
-  apply lt_O_nat_of_P.
+  simpl; auto with real.
+  apply Pos2Nat.is_pos.
 Qed.
 Hint Resolve pos_INR_nat_of_P: real.
 
@@ -1611,7 +1609,7 @@ Hint Resolve pos_INR_nat_of_P: real.
 Lemma pos_INR : forall n:nat, 0 <= INR n.
 Proof.
   intro n; case n.
-  simpl in |- *; auto with real.
+  simpl; auto with real.
   auto with arith real.
 Qed.
 Hint Resolve pos_INR: real.
@@ -1619,10 +1617,10 @@ Hint Resolve pos_INR: real.
 Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat.
 Proof.
   double induction n m; intros.
-  simpl in |- *; exfalso; apply (Rlt_irrefl 0); auto.
+  simpl; exfalso; apply (Rlt_irrefl 0); auto.
   auto with arith.
   generalize (pos_INR (S n0)); intro; cut (INR 0 = 0);
-    [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ].
+    [ intro H2; rewrite H2 in H0; idtac | simpl; trivial ].
   generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; exfalso;
     apply (Rlt_irrefl 0); auto.
   do 2 rewrite S_INR in H1; cut (INR n1 < INR n0).
@@ -1644,7 +1642,7 @@ Hint Resolve le_INR: real.
 (**********)
 Lemma INR_not_0 : forall n:nat, INR n <> 0 -> n <> 0%nat.
 Proof.
-  red in |- *; intros n H H1.
+  red; intros n H H1.
   apply H.
   rewrite H1; trivial.
 Qed.
@@ -1656,7 +1654,7 @@ Proof.
   intro n; case n.
   intro; absurd (0%nat = 0%nat); trivial.
   intros; rewrite S_INR.
-  apply Rgt_not_eq; red in |- *; auto with real.
+  apply Rgt_not_eq; red; auto with real.
 Qed.
 Hint Resolve not_0_INR: real.
 
@@ -1666,7 +1664,7 @@ Proof.
   case (le_lt_or_eq _ _ H1); intros H2.
   apply Rlt_dichotomy_converse; auto with real.
   exfalso; auto.
-  apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real.
+  apply not_eq_sym; apply Rlt_dichotomy_converse; auto with real.
 Qed.
 Hint Resolve not_INR: real.
 
@@ -1677,7 +1675,7 @@ Proof.
   cut (n <> m).
   intro H3; generalize (not_INR n m H3); intro H4; exfalso; auto.
   omega.
-  symmetry  in |- *; cut (m <> n).
+  symmetry ; cut (m <> n).
   intro H3; generalize (not_INR m n H3); intro H4; exfalso; auto.
   omega.
 Qed.
@@ -1703,92 +1701,86 @@ Hint Resolve not_1_INR: real.
 
 
 (**********)
-Lemma IZN : forall n:Z, (0 <= n)%Z ->  exists m : nat, n = Z_of_nat m.
+Lemma IZN : forall n:Z, (0 <= n)%Z ->  exists m : nat, n = Z.of_nat m.
 Proof.
   intros z; idtac; apply Z_of_nat_complete; assumption.
 Qed.
 
 (**********)
-Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z_of_nat n).
+Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z.of_nat n).
 Proof.
   simple induction n; auto with real.
-  intros; simpl in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
+  intros; simpl; rewrite SuccNat2Pos.id_succ;
     auto with real.
 Qed.
 
 Lemma plus_IZR_NEG_POS :
   forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q).
 Proof.
-  intros.
-  case (lt_eq_lt_dec (nat_of_P p) (nat_of_P q)).
-  intros [H| H]; simpl in |- *.
-  rewrite nat_of_P_lt_Lt_compare_complement_morphism; simpl in |- *; trivial.
-  rewrite (nat_of_P_minus_morphism q p).
-  rewrite minus_INR; auto with arith; ring.
-  apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
-  rewrite (nat_of_P_inj p q); trivial.
-  rewrite Pcompare_refl; simpl in |- *; auto with real.
-  intro H; simpl in |- *.
-  rewrite nat_of_P_gt_Gt_compare_complement_morphism; simpl in |- *;
-    auto with arith.
-  rewrite (nat_of_P_minus_morphism p q).
-  rewrite minus_INR; auto with arith; ring.
-  apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
+  intros p q; simpl. rewrite Z.pos_sub_spec.
+  case Pos.compare_spec; intros H; simpl.
+  subst. ring.
+  rewrite Pos2Nat.inj_sub by trivial.
+  rewrite minus_INR by (now apply lt_le_weak, Pos2Nat.inj_lt).
+  ring.
+  rewrite Pos2Nat.inj_sub by trivial.
+  rewrite minus_INR by (now apply lt_le_weak, Pos2Nat.inj_lt).
+  ring.
 Qed.
 
 (**********)
 Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m.
 Proof.
   intro z; destruct z; intro t; destruct t; intros; auto with real.
-  simpl in |- *; intros; rewrite nat_of_P_plus_morphism; auto with real.
+  simpl; intros; rewrite Pos2Nat.inj_add; auto with real.
   apply plus_IZR_NEG_POS.
-  rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS.
-  simpl in |- *; intros; rewrite nat_of_P_plus_morphism; rewrite plus_INR;
+  rewrite Z.add_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS.
+  simpl; intros; rewrite Pos2Nat.inj_add; rewrite plus_INR;
     auto with real.
 Qed.
 
 (**********)
 Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m.
 Proof.
-  intros z t; case z; case t; simpl in |- *; auto with real.
-  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
-  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+  intros z t; case z; case t; simpl; auto with real.
+  intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real.
+  intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real.
   rewrite Rmult_comm.
   rewrite Ropp_mult_distr_l_reverse; auto with real.
   apply Ropp_eq_compat; rewrite mult_comm; auto with real.
-  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+  intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real.
   rewrite Ropp_mult_distr_l_reverse; auto with real.
-  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+  intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real.
   rewrite Rmult_opp_opp; auto with real.
 Qed.
 
-Lemma pow_IZR : forall z n, pow (IZR z) n = IZR (Zpower z (Z_of_nat n)).
+Lemma pow_IZR : forall z n, pow (IZR z) n = IZR (Z.pow z (Z.of_nat n)).
 Proof.
  intros z [|n];simpl;trivial.
  rewrite Zpower_pos_nat.
- rewrite nat_of_P_o_P_of_succ_nat_eq_succ. unfold Zpower_nat;simpl.
+ rewrite SuccNat2Pos.id_succ. unfold Zpower_nat;simpl.
  rewrite mult_IZR.
  induction n;simpl;trivial.
  rewrite mult_IZR;ring[IHn].
 Qed.
 
 (**********)
-Lemma succ_IZR : forall n:Z, IZR (Zsucc n) = IZR n + 1.
+Lemma succ_IZR : forall n:Z, IZR (Z.succ n) = IZR n + 1.
 Proof.
-  intro; change 1 with (IZR 1); unfold Zsucc; apply plus_IZR.
+  intro; change 1 with (IZR 1); unfold Z.succ; apply plus_IZR.
 Qed.
 
 (**********)
 Lemma opp_IZR : forall n:Z, IZR (- n) = - IZR n.
 Proof.
-  intro z; case z; simpl in |- *; auto with real.
+  intro z; case z; simpl; auto with real.
 Qed.
 
 Definition Ropp_Ropp_IZR := opp_IZR.
 
 Lemma minus_IZR : forall n m:Z, IZR (n - m) = IZR n - IZR m.
 Proof.
-  intros; unfold Zminus, Rminus.
+  intros; unfold Z.sub, Rminus.
   rewrite <- opp_IZR.
   apply plus_IZR.
 Qed.
@@ -1796,16 +1788,16 @@ Qed.
 (**********)
 Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m).
 Proof.
-  intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *.
-  rewrite <- (Ropp_Ropp_IZR z2); symmetry  in |- *; apply plus_IZR.
+  intros z1 z2; unfold Rminus; unfold Z.sub.
+  rewrite <- (Ropp_Ropp_IZR z2); symmetry ; apply plus_IZR.
 Qed.
 
 (**********)
 Lemma lt_0_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z.
 Proof.
-  intro z; case z; simpl in |- *; intros.
+  intro z; case z; simpl; intros.
   absurd (0 < 0); auto with real.
-  unfold Zlt in |- *; simpl in |- *; trivial.
+  unfold Z.lt; simpl; trivial.
   case Rlt_not_le with (1 := H).
   replace 0 with (-0); auto with real.
 Qed.
@@ -1813,7 +1805,7 @@ Qed.
 (**********)
 Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z.
 Proof.
-  intros z1 z2 H; apply Zlt_0_minus_lt.
+  intros z1 z2 H; apply Z.lt_0_sub.
   apply lt_0_IZR.
   rewrite <- Z_R_minus.
   exact (Rgt_minus (IZR z2) (IZR z1) H).
@@ -1822,10 +1814,10 @@ Qed.
 (**********)
 Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z.
 Proof.
-  intro z; destruct z; simpl in |- *; intros; auto with zarith.
-  case (Rlt_not_eq 0 (INR (nat_of_P p))); auto with real.
-  case (Rlt_not_eq (- INR (nat_of_P p)) 0); auto with real.
-  apply Ropp_lt_gt_0_contravar. unfold Rgt in |- *; apply pos_INR_nat_of_P.
+  intro z; destruct z; simpl; intros; auto with zarith.
+  case (Rlt_not_eq 0 (INR (Pos.to_nat p))); auto with real.
+  case (Rlt_not_eq (- INR (Pos.to_nat p)) 0); auto with real.
+  apply Ropp_lt_gt_0_contravar. unfold Rgt; apply pos_INR_nat_of_P.
 Qed.
 
 (**********)
@@ -1839,23 +1831,23 @@ Qed.
 (**********)
 Lemma not_0_IZR : forall n:Z, n <> 0%Z -> IZR n <> 0.
 Proof.
-  intros z H; red in |- *; intros H0; case H.
+  intros z H; red; intros H0; case H.
   apply eq_IZR; auto.
 Qed.
 
 (*********)
 Lemma le_0_IZR : forall n:Z, 0 <= IZR n -> (0 <= n)%Z.
 Proof.
-  unfold Rle in |- *; intros z [H| H].
-  red in |- *; intro; apply (Zlt_le_weak 0 z (lt_0_IZR z H)); assumption.
+  unfold Rle; intros z [H| H].
+  red; intro; apply (Z.lt_le_incl 0 z (lt_0_IZR z H)); assumption.
   rewrite (eq_IZR_R0 z); auto with zarith real.
 Qed.
 
 (**********)
 Lemma le_IZR : forall n m:Z, IZR n <= IZR m -> (n <= m)%Z.
 Proof.
-  unfold Rle in |- *; intros z1 z2 [H| H].
-  apply (Zlt_le_weak z1 z2); auto with real.
+  unfold Rle; intros z1 z2 [H| H].
+  apply (Z.lt_le_incl z1 z2); auto with real.
   apply lt_IZR; trivial.
   rewrite (eq_IZR z1 z2); auto with zarith real.
 Qed.
@@ -1863,20 +1855,20 @@ Qed.
 (**********)
 Lemma le_IZR_R1 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z.
 Proof.
-  pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto.
+  pattern 1 at 1; replace 1 with (IZR 1); intros; auto.
   apply le_IZR; trivial.
 Qed.
 
 (**********)
 Lemma IZR_ge : forall n m:Z, (n >= m)%Z -> IZR n >= IZR m.
 Proof.
-  intros m n H; apply Rnot_lt_ge; red in |- *; intro.
+  intros m n H; apply Rnot_lt_ge; red; intro.
   generalize (lt_IZR m n H0); intro; omega.
 Qed.
 
 Lemma IZR_le : forall n m:Z, (n <= m)%Z -> IZR n <= IZR m.
 Proof.
-  intros m n H; apply Rnot_gt_le; red in |- *; intro.
+  intros m n H; apply Rnot_gt_le; red; intro.
   unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega.
 Qed.
 
@@ -1891,10 +1883,10 @@ Qed.
 Lemma one_IZR_lt1 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z.
 Proof.
   intros z [H1 H2].
-  apply Zle_antisym.
-  apply Zlt_succ_le; apply lt_IZR; trivial.
-  replace 0%Z with (Zsucc (-1)); trivial.
-  apply Zlt_le_succ; apply lt_IZR; trivial.
+  apply Z.le_antisymm.
+  apply Z.lt_succ_r; apply lt_IZR; trivial.
+  replace 0%Z with (Z.succ (-1)); trivial.
+  apply Z.le_succ_l; apply lt_IZR; trivial.
 Qed.
 
 Lemma one_IZR_r_R1 :
@@ -1905,10 +1897,10 @@ Proof.
   apply one_IZR_lt1.
   rewrite <- Z_R_minus; split.
   replace (-1) with (r - (r + 1)).
-  unfold Rminus in |- *; apply Rplus_lt_le_compat; auto with real.
+  unfold Rminus; apply Rplus_lt_le_compat; auto with real.
   ring.
   replace 1 with (r + 1 - r).
-  unfold Rminus in |- *; apply Rplus_le_lt_compat; auto with real.
+  unfold Rminus; apply Rplus_le_lt_compat; auto with real.
   ring.
 Qed.
 
@@ -1939,6 +1931,20 @@ Proof.
     apply (Rmult_le_compat_l x 0 y H H0).
 Qed.
 
+Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x.
+Proof.
+  intros; apply Rmult_le_reg_l with x.
+  apply H.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_le_reg_l with y.
+  apply H0.
+  rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; apply H1.
+  red; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0).
+  red; intro; rewrite H2 in H; elim (Rlt_irrefl _ H).
+Qed.
+
 Lemma double : forall r1, 2 * r1 = r1 + r1.
 Proof.
   intro; ring.
@@ -1946,10 +1952,10 @@ Qed.
 
 Lemma double_var : forall r1, r1 = r1 / 2 + r1 / 2.
 Proof.
-  intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
-    symmetry  in |- *; apply Rinv_r_simpl_m.
+  intro; rewrite <- double; unfold Rdiv; rewrite <- Rmult_assoc;
+    symmetry ; apply Rinv_r_simpl_m.
   replace 2 with (INR 2);
-  [ apply not_0_INR; discriminate | unfold INR in |- *; ring ].
+  [ apply not_0_INR; discriminate | unfold INR; ring ].
 Qed.
 
 (*********************************************************)
@@ -1984,22 +1990,22 @@ Proof.
   rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption.
   ring.
   replace 2 with (INR 2); [ apply not_0_INR; discriminate | reflexivity ].
-  pattern y at 2 in |- *; replace y with (y / 2 + y / 2).
-  unfold Rminus, Rdiv in |- *.
+  pattern y at 2; replace y with (y / 2 + y / 2).
+  unfold Rminus, Rdiv.
   repeat rewrite Rmult_plus_distr_r.
   ring.
   cut (forall z:R, 2 * z = z + z).
   intro.
   rewrite <- (H4 (y / 2)).
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
   replace 2 with (INR 2).
   apply not_0_INR.
   discriminate.
-  unfold INR in |- *; reflexivity.
+  unfold INR; reflexivity.
   intro; ring.
   cut (0%nat <> 2%nat);
-    [ intro H0; generalize (lt_0_INR 2 (neq_O_lt 2 H0)); unfold INR in |- *;
+    [ intro H0; generalize (lt_0_INR 2 (neq_O_lt 2 H0)); unfold INR;
       intro; assumption
       | discriminate ].
 Qed.
diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v
index 4e4fb378..6d42434a 100644
--- a/theories/Reals/RList.v
+++ b/theories/Reals/RList.v
@@ -1,16 +1,14 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: RList.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Inductive Rlist : Type :=
 | nil : Rlist
@@ -54,19 +52,19 @@ Proof.
   simpl in H; elim H.
   induction  l as [| r0 l Hrecl0].
   simpl in H; elim H; intro.
-  simpl in |- *; right; assumption.
+  simpl; right; assumption.
   elim H0.
   replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))).
   simpl in H; decompose [or] H.
   rewrite H0; apply RmaxLess1.
-  unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
-  apply Hrecl; simpl in |- *; tauto.
+  unfold Rmax; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
+  apply Hrecl; simpl; tauto.
   apply Rle_trans with (MaxRlist (cons r0 l));
-    [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
-  unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
-  apply Hrecl; simpl in |- *; tauto.
+    [ apply Hrecl; simpl; tauto | left; auto with real ].
+  unfold Rmax; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
+  apply Hrecl; simpl; tauto.
   apply Rle_trans with (MaxRlist (cons r0 l));
-    [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
+    [ apply Hrecl; simpl; tauto | left; auto with real ].
   reflexivity.
 Qed.
 
@@ -82,19 +80,19 @@ Proof.
   simpl in H; elim H.
   induction  l as [| r0 l Hrecl0].
   simpl in H; elim H; intro.
-  simpl in |- *; right; symmetry  in |- *; assumption.
+  simpl; right; symmetry ; assumption.
   elim H0.
   replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
   simpl in H; decompose [or] H.
   rewrite H0; apply Rmin_l.
-  unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
+  unfold Rmin; case (Rle_dec r (MinRlist (cons r0 l))); intro.
   apply Rle_trans with (MinRlist (cons r0 l)).
   assumption.
-  apply Hrecl; simpl in |- *; tauto.
-  apply Hrecl; simpl in |- *; tauto.
+  apply Hrecl; simpl; tauto.
+  apply Hrecl; simpl; tauto.
   apply Rle_trans with (MinRlist (cons r0 l)).
   apply Rmin_r.
-  apply Hrecl; simpl in |- *; tauto.
+  apply Hrecl; simpl; tauto.
   reflexivity.
 Qed.
 
@@ -103,7 +101,7 @@ Lemma AbsList_P1 :
 Proof.
   intros; induction  l as [| r l Hrecl].
   elim H.
-  simpl in |- *; simpl in H; elim H; intro.
+  simpl; simpl in H; elim H; intro.
   left; rewrite H0; reflexivity.
   right; apply Hrecl; assumption.
 Qed.
@@ -114,11 +112,11 @@ Proof.
   intros; induction  l as [| r l Hrecl].
   apply Rlt_0_1.
   induction  l as [| r0 l Hrecl0].
-  simpl in |- *; apply H; simpl in |- *; tauto.
+  simpl; apply H; simpl; tauto.
   replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
-  unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
-  apply H; simpl in |- *; tauto.
-  apply Hrecl; intros; apply H; simpl in |- *; simpl in H0; tauto.
+  unfold Rmin; case (Rle_dec r (MinRlist (cons r0 l))); intro.
+  apply H; simpl; tauto.
+  apply Hrecl; intros; apply H; simpl; simpl in H0; tauto.
   reflexivity.
 Qed.
 
@@ -130,10 +128,10 @@ Proof.
   elim H.
   elim H; intro.
   exists r; split.
-  simpl in |- *; tauto.
+  simpl; tauto.
   assumption.
   assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros;
-    exists x0; simpl in |- *; simpl in H2; tauto.
+    exists x0; simpl; simpl in H2; tauto.
 Qed.
 
 Lemma MaxRlist_P2 :
@@ -142,9 +140,9 @@ Proof.
   intros; induction  l as [| r l Hrecl].
   simpl in H; elim H; trivial.
   induction  l as [| r0 l Hrecl0].
-  simpl in |- *; left; reflexivity.
-  change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *;
-    unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l)));
+  simpl; left; reflexivity.
+  change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l)));
+    unfold Rmax; case (Rle_dec r (MaxRlist (cons r0 l)));
       intro.
   right; apply Hrecl; exists r0; left; reflexivity.
   left; reflexivity.
@@ -166,7 +164,7 @@ Lemma pos_Rl_P1 :
 Proof.
   intros; induction  l as [| r l Hrecl];
     [ elim (lt_n_O _ H)
-      | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ].
+      | simpl; case (Rlength l); [ reflexivity | intro; reflexivity ] ].
 Qed.
 
 Lemma pos_Rl_P2 :
@@ -179,14 +177,14 @@ Proof.
   split; intro.
   elim H; intro.
   exists 0%nat; split;
-    [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ].
+    [ simpl; apply lt_O_Sn | simpl; apply H0 ].
   elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros;
     exists (S x0); split;
-      [ simpl in |- *; apply lt_n_S; assumption | simpl in |- *; assumption ].
+      [ simpl; apply lt_n_S; assumption | simpl; assumption ].
   elim H; intros; elim H0; intros; elim (zerop x0); intro.
   rewrite a in H2; simpl in H2; left; assumption.
   right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0).
-  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  symmetry ; apply S_pred with 0%nat; assumption.
   exists (pred x0); split;
     [ simpl in H1; apply lt_S_n; rewrite H5; assumption
       | rewrite <- H5 in H2; simpl in H2; assumption ].
@@ -203,18 +201,18 @@ Proof.
   exists nil; intros; split;
     [ reflexivity | intros; simpl in H0; elim (lt_n_O _ H0) ].
   assert (H0 : In r (cons r l)).
-  simpl in |- *; left; reflexivity.
+  simpl; left; reflexivity.
   assert (H1 := H _ H0);
     assert (H2 : forall x:R, In x l ->  exists y : R, P x y).
-  intros; apply H; simpl in |- *; right; assumption.
+  intros; apply H; simpl; right; assumption.
   assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0);
     intros; elim H5; clear H5; intros; split.
-  simpl in |- *; rewrite H5; reflexivity.
+  simpl; rewrite H5; reflexivity.
   intros; elim (zerop i); intro.
-  rewrite a; simpl in |- *; assumption.
+  rewrite a; simpl; assumption.
   assert (H8 : i = S (pred i)).
   apply S_pred with 0%nat; assumption.
-  rewrite H8; simpl in |- *; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8;
+  rewrite H8; simpl; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8;
     assumption.
 Qed.
 
@@ -273,7 +271,7 @@ Lemma RList_P0 :
 Proof.
   intros; induction  l as [| r l Hrecl];
     [ left; reflexivity
-      | simpl in |- *; case (Rle_dec r a); intro;
+      | simpl; case (Rle_dec r a); intro;
         [ right; reflexivity | left; reflexivity ] ].
 Qed.
 
@@ -281,41 +279,41 @@ Lemma RList_P1 :
   forall (l:Rlist) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a).
 Proof.
   intros; induction  l as [| r l Hrecl].
-  simpl in |- *; unfold ordered_Rlist in |- *; intros; simpl in H0;
+  simpl; unfold ordered_Rlist; intros; simpl in H0;
     elim (lt_n_O _ H0).
-  simpl in |- *; case (Rle_dec r a); intro.
+  simpl; case (Rle_dec r a); intro.
   assert (H1 : ordered_Rlist l).
-  unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros;
+  unfold ordered_Rlist; unfold ordered_Rlist in H; intros;
     assert (H1 : (S i < pred (Rlength (cons r l)))%nat);
-      [ simpl in |- *; replace (Rlength l) with (S (pred (Rlength l)));
+      [ simpl; replace (Rlength l) with (S (pred (Rlength l)));
         [ apply lt_n_S; assumption
-          | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+          | symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red;
             intro; rewrite <- H1 in H0; simpl in H0; elim (lt_n_O _ H0) ]
         | apply (H _ H1) ].
-  assert (H2 := Hrecl H1); unfold ordered_Rlist in |- *; intros;
+  assert (H2 := Hrecl H1); unfold ordered_Rlist; intros;
     induction  i as [| i Hreci].
-  simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro.
+  simpl; assert (H3 := RList_P0 l a); elim H3; intro.
   rewrite H4; assumption.
   induction  l as [| r1 l Hrecl0];
-    [ simpl in |- *; assumption
-      | rewrite H4; apply (H 0%nat); simpl in |- *; apply lt_O_Sn ].
-  simpl in |- *; apply H2; simpl in H0; apply lt_S_n;
+    [ simpl; assumption
+      | rewrite H4; apply (H 0%nat); simpl; apply lt_O_Sn ].
+  simpl; apply H2; simpl in H0; apply lt_S_n;
     replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a));
     [ assumption
-      | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+      | apply S_pred with 0%nat; apply neq_O_lt; red; intro;
         rewrite <- H3 in H0; elim (lt_n_O _ H0) ].
-  unfold ordered_Rlist in |- *; intros; induction  i as [| i Hreci];
-    [ simpl in |- *; auto with real
-      | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)) in |- *; apply H;
-        simpl in H0; simpl in |- *; apply (lt_S_n _ _ H0) ].
+  unfold ordered_Rlist; intros; induction  i as [| i Hreci];
+    [ simpl; auto with real
+      | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)); apply H;
+        simpl in H0; simpl; apply (lt_S_n _ _ H0) ].
 Qed.
 
 Lemma RList_P2 :
   forall l1 l2:Rlist, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2).
 Proof.
   simple induction l1;
-    [ intros; simpl in |- *; apply H
-      | intros; simpl in |- *; apply H; apply RList_P1; assumption ].
+    [ intros; simpl; apply H
+      | intros; simpl; apply H; apply RList_P1; assumption ].
 Qed.
 
 Lemma RList_P3 :
@@ -326,11 +324,11 @@ Proof.
     [ induction  l as [| r l Hrecl] | induction  l as [| r l Hrecl] ].
   elim H.
   elim H; intro;
-    [ exists 0%nat; split; [ apply H0 | simpl in |- *; apply lt_O_Sn ]
+    [ exists 0%nat; split; [ apply H0 | simpl; apply lt_O_Sn ]
       | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split;
-        [ apply H1 | simpl in |- *; apply lt_n_S; assumption ] ].
+        [ apply H1 | simpl; apply lt_n_S; assumption ] ].
   elim H; intros; elim H0; intros; elim (lt_n_O _ H2).
-  simpl in |- *; elim H; intros; elim H0; clear H0; intros;
+  simpl; elim H; intros; elim H0; clear H0; intros;
     induction  x0 as [| x0 Hrecx0];
       [ left; apply H0
         | right; apply Hrecl; exists x0; split;
@@ -340,10 +338,10 @@ Qed.
 Lemma RList_P4 :
   forall (l1:Rlist) (a:R), ordered_Rlist (cons a l1) -> ordered_Rlist l1.
 Proof.
-  intros; unfold ordered_Rlist in |- *; intros; apply (H (S i)); simpl in |- *;
+  intros; unfold ordered_Rlist; intros; apply (H (S i)); simpl;
     replace (Rlength l1) with (S (pred (Rlength l1)));
     [ apply lt_n_S; assumption
-      | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+      | symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red;
         intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ].
 Qed.
 
@@ -352,11 +350,11 @@ Lemma RList_P5 :
 Proof.
   intros; induction  l as [| r l Hrecl];
     [ elim H0
-      | simpl in |- *; elim H0; intro;
+      | simpl; elim H0; intro;
         [ rewrite H1; right; reflexivity
           | apply Rle_trans with (pos_Rl l 0);
-            [ apply (H 0%nat); simpl in |- *; induction  l as [| r0 l Hrecl0];
-              [ elim H1 | simpl in |- *; apply lt_O_Sn ]
+            [ apply (H 0%nat); simpl; induction  l as [| r0 l Hrecl0];
+              [ elim H1 | simpl; apply lt_O_Sn ]
               | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ].
 Qed.
 
@@ -368,13 +366,13 @@ Lemma RList_P6 :
 Proof.
   simple induction l; split; intro.
   intros; right; reflexivity.
-  unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0).
+  unfold ordered_Rlist; intros; simpl in H0; elim (lt_n_O _ H0).
   intros; induction  i as [| i Hreci];
     [ induction  j as [| j Hrecj];
       [ right; reflexivity
-        | simpl in |- *; apply Rle_trans with (pos_Rl r0 0);
-          [ apply (H0 0%nat); simpl in |- *; simpl in H2; apply neq_O_lt;
-            red in |- *; intro; rewrite <- H3 in H2;
+        | simpl; apply Rle_trans with (pos_Rl r0 0);
+          [ apply (H0 0%nat); simpl; simpl in H2; apply neq_O_lt;
+            red; intro; rewrite <- H3 in H2;
               assert (H4 := lt_S_n _ _ H2); elim (lt_n_O _ H4)
             | elim H; intros; apply H3;
               [ apply RList_P4 with r; assumption
@@ -382,12 +380,12 @@ Proof.
                 | simpl in H2; apply lt_S_n; assumption ] ] ]
       | induction  j as [| j Hrecj];
         [ elim (le_Sn_O _ H1)
-          | simpl in |- *; elim H; intros; apply H3;
+          | simpl; elim H; intros; apply H3;
             [ apply RList_P4 with r; assumption
               | apply le_S_n; assumption
               | simpl in H2; apply lt_S_n; assumption ] ] ].
-  unfold ordered_Rlist in |- *; intros; apply H0;
-    [ apply le_n_Sn | simpl in |- *; simpl in H1; apply lt_n_S; assumption ].
+  unfold ordered_Rlist; intros; apply H0;
+    [ apply le_n_Sn | simpl; simpl in H1; apply lt_n_S; assumption ].
 Qed.
 
 Lemma RList_P7 :
@@ -399,11 +397,11 @@ Proof.
       clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4;
         intros; elim H4; clear H4; intros; rewrite H4;
           assert (H6 : Rlength l = S (pred (Rlength l))).
-  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+  apply S_pred with 0%nat; apply neq_O_lt; red; intro;
     rewrite <- H6 in H5; elim (lt_n_O _ H5).
   apply H3;
     [ rewrite H6 in H5; apply lt_n_Sm_le; assumption
-      | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H7 in H5;
+      | apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H7 in H5;
         elim (lt_n_O _ H5) ].
 Qed.
 
@@ -422,7 +420,7 @@ Proof.
           [ left; assumption
             | right; left; assumption
             | right; right; assumption ] ]
-      | simpl in |- *; case (Rle_dec r a); intro;
+      | simpl; case (Rle_dec r a); intro;
         [ simpl in H0; decompose [or] H0;
           [ right; elim (H a x); intros; apply H3; left
             | left
@@ -437,14 +435,14 @@ Proof.
   simple induction l1.
   intros; split; intro;
     [ simpl in H; right; assumption
-      | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ].
+      | simpl; elim H; intro; [ elim H0 | assumption ] ].
   intros; split.
-  simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0);
+  simpl; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0);
     elim H3; intro;
       [ left; right; assumption
         | elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro;
           [ left; left; assumption | right; assumption ] ].
-  intro; simpl in |- *; elim (H (insert l2 r) x); intros _ H1; apply H1;
+  intro; simpl; elim (H (insert l2 r) x); intros _ H1; apply H1;
     elim H0; intro;
       [ elim H2; intro;
         [ right; elim (RList_P8 l2 r x); intros _ H4; apply H4; left; assumption
@@ -457,8 +455,8 @@ Lemma RList_P10 :
 Proof.
   intros; induction  l as [| r l Hrecl];
     [ reflexivity
-      | simpl in |- *; case (Rle_dec r a); intro;
-        [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ].
+      | simpl; case (Rle_dec r a); intro;
+        [ simpl; rewrite Hrecl; reflexivity | reflexivity ] ].
 Qed.
 
 Lemma RList_P11 :
@@ -467,7 +465,7 @@ Lemma RList_P11 :
 Proof.
   simple induction l1;
     [ intro; reflexivity
-      | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10;
+      | intros; simpl; rewrite (H (insert l2 r)); rewrite RList_P10;
         apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR;
           rewrite S_INR; ring ].
 Qed.
@@ -479,7 +477,7 @@ Proof.
   simple induction l;
     [ intros; elim (lt_n_O _ H)
       | intros; induction  i as [| i Hreci];
-        [ reflexivity | simpl in |- *; apply H; apply lt_S_n; apply H0 ] ].
+        [ reflexivity | simpl; apply H; apply lt_S_n; apply H0 ] ].
 Qed.
 
 Lemma RList_P13 :
@@ -496,13 +494,13 @@ Proof.
   change
     (pos_Rl (mid_Rlist (cons r1 r2) r) (S i) =
       (pos_Rl (cons r1 r2) i + pos_Rl (cons r1 r2) (S i)) / 2)
-    in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption.
+   ; apply H0; simpl; apply lt_S_n; assumption.
 Qed.
 
 Lemma RList_P14 : forall (l:Rlist) (a:R), Rlength (mid_Rlist l a) = Rlength l.
 Proof.
   simple induction l; intros;
-    [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ].
+    [ reflexivity | simpl; rewrite (H r); reflexivity ].
 Qed.
 
 Lemma RList_P15 :
@@ -513,7 +511,7 @@ Lemma RList_P15 :
 Proof.
   intros; apply Rle_antisym.
   induction  l1 as [| r l1 Hrecl1];
-    [ simpl in |- *; simpl in H1; right; symmetry  in |- *; assumption
+    [ simpl; simpl in H1; right; symmetry ; assumption
       | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) 0)); intros;
         assert
           (H4 :
@@ -522,7 +520,7 @@ Proof.
             | assert (H5 := H3 H4); apply RList_P5;
               [ apply RList_P2; assumption | assumption ] ] ].
   induction  l1 as [| r l1 Hrecl1];
-    [ simpl in |- *; simpl in H1; right; assumption
+    [ simpl; simpl in H1; right; assumption
       | assert
         (H2 :
           In (pos_Rl (cons_ORlist (cons r l1) l2) 0) (cons_ORlist (cons r l1) l2));
@@ -530,7 +528,7 @@ Proof.
           (RList_P3 (cons_ORlist (cons r l1) l2)
             (pos_Rl (cons_ORlist (cons r l1) l2) 0));
           intros; apply H3; exists 0%nat; split;
-            [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]
+            [ reflexivity | rewrite RList_P11; simpl; apply lt_O_Sn ]
           | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) 0));
             intros; assert (H5 := H3 H2); elim H5; intro;
               [ apply RList_P5; assumption
@@ -547,7 +545,7 @@ Lemma RList_P16 :
 Proof.
   intros; apply Rle_antisym.
   induction  l1 as [| r l1 Hrecl1].
-  simpl in |- *; simpl in H1; right; symmetry  in |- *; assumption.
+  simpl; simpl in H1; right; symmetry ; assumption.
   assert
     (H2 :
       In
@@ -559,7 +557,7 @@ Proof.
         (pos_Rl (cons_ORlist (cons r l1) l2)
           (pred (Rlength (cons_ORlist (cons r l1) l2)))));
       intros; apply H3; exists (pred (Rlength (cons_ORlist (cons r l1) l2)));
-        split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]
+        split; [ reflexivity | rewrite RList_P11; simpl; apply lt_n_Sn ]
       | elim
         (RList_P9 (cons r l1) l2
           (pos_Rl (cons_ORlist (cons r l1) l2)
@@ -567,7 +565,7 @@ Proof.
         intros; assert (H5 := H3 H2); elim H5; intro;
           [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ].
   induction  l1 as [| r l1 Hrecl1].
-  simpl in |- *; simpl in H1; right; assumption.
+  simpl; simpl in H1; right; assumption.
   elim
     (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))));
     intros;
@@ -575,10 +573,10 @@ Proof.
         (H4 :
           In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1) \/
           In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2);
-        [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)) in |- *;
+        [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1));
           elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1)));
             intros; apply H5; exists (Rlength l1); split;
-              [ reflexivity | simpl in |- *; apply lt_n_Sn ]
+              [ reflexivity | simpl; apply lt_n_Sn ]
           | assert (H5 := H3 H4); apply RList_P7;
             [ apply RList_P2; assumption
               | elim
@@ -589,7 +587,7 @@ Proof.
                     (RList_P3 (cons r l1)
                       (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))));
                     intros; apply H9; exists (pred (Rlength (cons r l1)));
-                      split; [ reflexivity | simpl in |- *; apply lt_n_Sn ] ] ].
+                      split; [ reflexivity | simpl; apply lt_n_Sn ] ] ].
 Qed.
 
 Lemma RList_P17 :
@@ -601,14 +599,14 @@ Proof.
   simple induction l1.
   intros; elim H0.
   intros; induction  i as [| i Hreci].
-  simpl in |- *; elim H1; intro;
+  simpl; elim H1; intro;
     [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2)
       | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ].
-  simpl in |- *; simpl in H2; elim H1; intro.
+  simpl; simpl in H2; elim H1; intro.
   rewrite H4 in H2; assert (H5 : r <= pos_Rl r0 i);
     [ apply Rle_trans with (pos_Rl r0 0);
-      [ apply (H0 0%nat); simpl in |- *; simpl in H3; apply neq_O_lt;
-        red in |- *; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3)
+      [ apply (H0 0%nat); simpl; simpl in H3; apply neq_O_lt;
+        red; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3)
         | elim (RList_P6 r0); intros; apply H5;
           [ apply RList_P4 with r; assumption
             | apply le_O_n
@@ -620,7 +618,7 @@ Proof.
       | simpl in H3; apply lt_S_n;
         replace (S (pred (Rlength r0))) with (Rlength r0);
         [ apply H3
-          | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+          | apply S_pred with 0%nat; apply neq_O_lt; red; intro;
             rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ].
 Qed.
 
@@ -628,7 +626,7 @@ Lemma RList_P18 :
   forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l.
 Proof.
   simple induction l; intros;
-    [ reflexivity | simpl in |- *; rewrite H; reflexivity ].
+    [ reflexivity | simpl; rewrite H; reflexivity ].
 Qed.
 
 Lemma RList_P19 :
@@ -668,7 +666,7 @@ Lemma RList_P23 :
     Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat.
 Proof.
   simple induction l1;
-    [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
+    [ intro; reflexivity | intros; simpl; rewrite H; reflexivity ].
 Qed.
 
 Lemma RList_P24 :
@@ -687,9 +685,9 @@ Proof.
     [ replace (Rlength r0 + Rlength (cons r1 l2))%nat with
       (S (Rlength r0 + Rlength l2));
       [ reflexivity
-        | simpl in |- *; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR;
+        | simpl; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR;
           rewrite S_INR; ring ]
-      | simpl in |- *; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR;
+      | simpl; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR;
         rewrite S_INR; ring ].
 Qed.
 
@@ -701,27 +699,27 @@ Lemma RList_P25 :
     ordered_Rlist (cons_Rlist l1 l2).
 Proof.
   simple induction l1.
-  intros; simpl in |- *; assumption.
+  intros; simpl; assumption.
   simple induction r0.
-  intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros;
+  intros; simpl; simpl in H2; unfold ordered_Rlist; intros;
     simpl in H3.
   induction  i as [| i Hreci].
-  simpl in |- *; assumption.
-  change (pos_Rl l2 i <= pos_Rl l2 (S i)) in |- *; apply (H1 i); apply lt_S_n;
+  simpl; assumption.
+  change (pos_Rl l2 i <= pos_Rl l2 (S i)); apply (H1 i); apply lt_S_n;
     replace (S (pred (Rlength l2))) with (Rlength l2);
     [ assumption
-      | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+      | apply S_pred with 0%nat; apply neq_O_lt; red; intro;
         rewrite <- H4 in H3; elim (lt_n_O _ H3) ].
   intros; clear H; assert (H : ordered_Rlist (cons_Rlist (cons r1 r2) l2)).
   apply H0; try assumption.
   apply RList_P4 with r; assumption.
-  unfold ordered_Rlist in |- *; intros; simpl in H4;
+  unfold ordered_Rlist; intros; simpl in H4;
     induction  i as [| i Hreci].
-  simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl; apply (H1 0%nat); simpl; apply lt_O_Sn.
   change
     (pos_Rl (cons_Rlist (cons r1 r2) l2) i <=
-      pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *;
-    apply (H i); simpl in |- *; apply lt_S_n; assumption.
+      pos_Rl (cons_Rlist (cons r1 r2) l2) (S i));
+    apply (H i); simpl; apply lt_S_n; assumption.
 Qed.
 
 Lemma RList_P26 :
@@ -740,13 +738,13 @@ Lemma RList_P27 :
     cons_Rlist l1 (cons_Rlist l2 l3) = cons_Rlist (cons_Rlist l1 l2) l3.
 Proof.
   simple induction l1; intros;
-    [ reflexivity | simpl in |- *; rewrite (H l2 l3); reflexivity ].
+    [ reflexivity | simpl; rewrite (H l2 l3); reflexivity ].
 Qed.
 
 Lemma RList_P28 : forall l:Rlist, cons_Rlist l nil = l.
 Proof.
   simple induction l;
-    [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
+    [ reflexivity | intros; simpl; rewrite H; reflexivity ].
 Qed.
 
 Lemma RList_P29 :
@@ -761,23 +759,23 @@ Proof.
     replace (cons_Rlist l1 (cons r r0)) with
     (cons_Rlist (cons_Rlist l1 (cons r nil)) r0).
   inversion H0.
-  rewrite <- minus_n_n; simpl in |- *; rewrite RList_P26.
+  rewrite <- minus_n_n; simpl; rewrite RList_P26.
   clear l2 r0 H i H0 H1 H2; induction  l1 as [| r0 l1 Hrecl1].
   reflexivity.
-  simpl in |- *; assumption.
-  rewrite RList_P23; rewrite plus_comm; simpl in |- *; apply lt_n_Sn.
+  simpl; assumption.
+  rewrite RList_P23; rewrite plus_comm; simpl; apply lt_n_Sn.
   replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))).
-  rewrite H3; simpl in |- *;
+  rewrite H3; simpl;
     replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))).
   apply (H (cons_Rlist l1 (cons r nil)) i).
-  rewrite RList_P23; rewrite plus_comm; simpl in |- *; rewrite <- H3;
+  rewrite RList_P23; rewrite plus_comm; simpl; rewrite <- H3;
     apply le_n_S; assumption.
-  repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1;
+  repeat rewrite RList_P23; simpl; rewrite RList_P23 in H1;
     rewrite plus_comm in H1; simpl in H1; rewrite (plus_comm (Rlength l1));
-      simpl in |- *; rewrite plus_comm; apply H1.
+      simpl; rewrite plus_comm; apply H1.
   rewrite RList_P23; rewrite plus_comm; reflexivity.
-  change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *;
+  change (S (m - Rlength l1) = (S m - Rlength l1)%nat);
     apply minus_Sn_m; assumption.
   replace (cons r r0) with (cons_Rlist (cons r nil) r0);
-  [ symmetry  in |- *; apply RList_P27 | reflexivity ].
+  [ symmetry ; apply RList_P27 | reflexivity ].
 Qed.
diff --git a/theories/Reals/ROrderedType.v b/theories/Reals/ROrderedType.v
index 87dc07b8..726f1204 100644
--- a/theories/Reals/ROrderedType.v
+++ b/theories/Reals/ROrderedType.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -55,7 +55,7 @@ Definition Rcompare x y :=
   | inright _ => Gt
  end.
 
-Lemma Rcompare_spec : forall x y, CompSpec eq Rlt x y (Rcompare x y).
+Lemma Rcompare_spec : forall x y, CompareSpec (x=y) (x<y) (y<x) (Rcompare x y).
 Proof.
  intros. unfold Rcompare.
  destruct total_order_T as [[H|H]|H]; auto.
diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v
index 8cf36c17..8364e986 100644
--- a/theories/Reals/R_Ifp.v
+++ b/theories/Reals/R_Ifp.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: R_Ifp.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (**********************************************************)
 (** Complements for the reals.Integer and fractional part *)
 (*                                                        *)
@@ -15,7 +13,7 @@
 
 Require Import Rbase.
 Require Import Omega.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (*********************************************************)
 (** *    Fractional part                                 *)
@@ -47,7 +45,7 @@ Proof.
   intros; generalize (Rplus_le_compat_l 1 (IZR z) r H); intro; clear H;
     rewrite (Rplus_comm 1 (IZR z)) in H1; rewrite (Rplus_comm 1 r) in H1;
       cut (1 = IZR 1); auto with zarith real.
-  intro; generalize H1; pattern 1 at 1 in |- *; rewrite H; intro; clear H H1;
+  intro; generalize H1; pattern 1 at 1; rewrite H; intro; clear H H1;
     rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1));
       auto with zarith real.
 Qed.
@@ -55,12 +53,12 @@ Qed.
 (**********)
 Lemma fp_R0 : frac_part 0 = 0.
 Proof.
-  unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros;
-    unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1)));
+  unfold frac_part; unfold Int_part; elim (archimed 0); intros;
+    unfold Rminus; elim (Rplus_ne (- IZR (up 0 - 1)));
       intros a b; rewrite b; clear a b; rewrite <- Z_R_minus;
         cut (up 0 = 1%Z).
   intro; rewrite H1;
-    rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1)));
+    rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (eq_refl (IZR 1)));
       apply Ropp_0.
   elim (archimed 0); intros; clear H2; unfold Rgt in H1;
     rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1);
@@ -83,21 +81,21 @@ Qed.
 (**********)
 Lemma base_fp : forall r:R, frac_part r >= 0 /\ frac_part r < 1.
 Proof.
-  intro; unfold frac_part in |- *; unfold Int_part in |- *; split.
+  intro; unfold frac_part; unfold Int_part; split.
      (*sup a O*)
   cut (r - IZR (up r) >= -1).
-  rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *;
+  rewrite <- Z_R_minus; simpl; intro; unfold Rminus;
     rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
-      fold (r - IZR (up r)) in |- *; fold (r - IZR (up r) - -1) in |- *;
+      fold (r - IZR (up r)); fold (r - IZR (up r) - -1);
         apply Rge_minus; auto with zarith real.
   rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r);
     auto with zarith real.
     (*inf a 1*)
   cut (r - IZR (up r) < 0).
-  rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *;
+  rewrite <- Z_R_minus; simpl; intro; unfold Rminus;
     rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
-      fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive;
-        elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *;
+      fold (r - IZR (up r)); rewrite Ropp_involutive;
+        elim (Rplus_ne 1); intros a b; pattern 1 at 2;
           rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1);
             apply Rplus_lt_compat_l; auto with zarith real.
   elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr;
@@ -112,8 +110,8 @@ Qed.
 Lemma base_Int_part :
   forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1.
 Proof.
-  intro; unfold Int_part in |- *; elim (archimed r); intros.
-  split; rewrite <- (Z_R_minus (up r) 1); simpl in |- *.
+  intro; unfold Int_part; elim (archimed r); intros.
+  split; rewrite <- (Z_R_minus (up r) 1); simpl.
   generalize (Rle_minus (IZR (up r) - r) 1 H0); intro; unfold Rminus in H1;
     rewrite (Rplus_assoc (IZR (up r)) (- r) (-1)) in H1;
       rewrite (Rplus_comm (- r) (-1)) in H1;
@@ -132,31 +130,31 @@ Proof.
 Qed.
 
 (**********)
-Lemma Int_part_INR : forall n:nat, Int_part (INR n) = Z_of_nat n.
+Lemma Int_part_INR : forall n:nat, Int_part (INR n) = Z.of_nat n.
 Proof.
-  intros n; unfold Int_part in |- *.
-  cut (up (INR n) = (Z_of_nat n + Z_of_nat 1)%Z).
-  intros H'; rewrite H'; simpl in |- *; ring.
-  apply sym_equal; apply tech_up; auto.
-  replace (Z_of_nat n + Z_of_nat 1)%Z with (Z_of_nat (S n)).
+  intros n; unfold Int_part.
+  cut (up (INR n) = (Z.of_nat n + Z.of_nat 1)%Z).
+  intros H'; rewrite H'; simpl; ring.
+  symmetry; apply tech_up; auto.
+  replace (Z.of_nat n + Z.of_nat 1)%Z with (Z.of_nat (S n)).
   repeat rewrite <- INR_IZR_INZ.
   apply lt_INR; auto.
-  rewrite Zplus_comm; rewrite <- Znat.inj_plus; simpl in |- *; auto.
-  rewrite plus_IZR; simpl in |- *; auto with real.
+  rewrite Z.add_comm; rewrite <- Znat.Nat2Z.inj_add; simpl; auto.
+  rewrite plus_IZR; simpl; auto with real.
   repeat rewrite <- INR_IZR_INZ; auto with real.
 Qed.
 
 (**********)
 Lemma fp_nat : forall r:R, frac_part r = 0 ->  exists c : Z, r = IZR c.
 Proof.
-  unfold frac_part in |- *; intros; split with (Int_part r);
+  unfold frac_part; intros; split with (Int_part r);
     apply Rminus_diag_uniq; auto with zarith real.
 Qed.
 
 (**********)
 Lemma R0_fp_O : forall r:R, 0 <> frac_part r -> 0 <> r.
 Proof.
-  red in |- *; intros; rewrite <- H0 in H; generalize fp_R0; intro;
+  red; intros; rewrite <- H0 in H; generalize fp_R0; intro;
     auto with zarith real.
 Qed.
 
@@ -245,7 +243,7 @@ Proof.
   intro; rewrite H1 in H; clear H1;
     rewrite <- (plus_IZR (Int_part r1 - Int_part r2) 1) in H;
       generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2) H0 H);
-        intros; clear H H0; unfold Int_part at 1 in |- *;
+        intros; clear H H0; unfold Int_part at 1;
           omega.
 Qed.
 
@@ -338,7 +336,7 @@ Proof.
           generalize (Rlt_le (IZR (Int_part r1 - Int_part r2 - 1)) (r1 - r2) H);
             intro; clear H;
               generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0);
-                intros; clear H0 H1; unfold Int_part at 1 in |- *;
+                intros; clear H0 H1; unfold Int_part at 1;
                   omega.
 Qed.
 
@@ -348,9 +346,9 @@ Lemma Rminus_fp1 :
     frac_part r1 >= frac_part r2 ->
     frac_part (r1 - r2) = frac_part r1 - frac_part r2.
 Proof.
-  intros; unfold frac_part in |- *; generalize (Rminus_Int_part1 r1 r2 H);
+  intros; unfold frac_part; generalize (Rminus_Int_part1 r1 r2 H);
     intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));
-      unfold Rminus in |- *;
+      unfold Rminus;
         rewrite (Ropp_plus_distr (IZR (Int_part r1)) (- IZR (Int_part r2)));
           rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2)));
             rewrite (Ropp_involutive (IZR (Int_part r2)));
@@ -368,17 +366,17 @@ Lemma Rminus_fp2 :
     frac_part r1 < frac_part r2 ->
     frac_part (r1 - r2) = frac_part r1 - frac_part r2 + 1.
 Proof.
-  intros; unfold frac_part in |- *; generalize (Rminus_Int_part2 r1 r2 H);
+  intros; unfold frac_part; generalize (Rminus_Int_part2 r1 r2 H);
     intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1 - Int_part r2) 1);
       rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));
-        unfold Rminus in |- *;
+        unfold Rminus;
           rewrite
             (Ropp_plus_distr (IZR (Int_part r1) + - IZR (Int_part r2)) (- IZR 1))
             ; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2)));
               rewrite (Ropp_involutive (IZR 1));
                 rewrite (Ropp_involutive (IZR (Int_part r2)));
                   rewrite (Ropp_plus_distr (IZR (Int_part r1)));
-                    rewrite (Ropp_involutive (IZR (Int_part r2))); simpl in |- *;
+                    rewrite (Ropp_involutive (IZR (Int_part r2))); simpl;
                       rewrite <-
                         (Rplus_assoc (r1 + - r2) (- IZR (Int_part r1) + IZR (Int_part r2)) 1)
                         ; rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)));
@@ -453,7 +451,7 @@ Proof.
           rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H0;
             rewrite <- (plus_IZR (Int_part r1 + Int_part r2 + 1) 1) in H0;
               generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0);
-                intro; clear H H0; unfold Int_part at 1 in |- *; omega.
+                intro; clear H H0; unfold Int_part at 1; omega.
 Qed.
 
 (**********)
@@ -516,7 +514,7 @@ Proof.
       rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H1;
         rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H1;
           generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2) H0 H1);
-            intro; clear H0 H1; unfold Int_part at 1 in |- *;
+            intro; clear H0 H1; unfold Int_part at 1;
               omega.
 Qed.
 
@@ -526,17 +524,17 @@ Lemma plus_frac_part1 :
     frac_part r1 + frac_part r2 >= 1 ->
     frac_part (r1 + r2) = frac_part r1 + frac_part r2 - 1.
 Proof.
-  intros; unfold frac_part in |- *; generalize (plus_Int_part1 r1 r2 H); intro;
+  intros; unfold frac_part; generalize (plus_Int_part1 r1 r2 H); intro;
     rewrite H0; rewrite (plus_IZR (Int_part r1 + Int_part r2) 1);
-      rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl in |- *;
-        unfold Rminus at 3 4 in |- *;
+      rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl;
+        unfold Rminus at 3 4;
           rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)));
             rewrite (Rplus_comm r2 (- IZR (Int_part r2)));
               rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2);
                 rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2);
                   rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)));
                     rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2)));
-                      unfold Rminus in |- *;
+                      unfold Rminus;
                         rewrite
                           (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-1))
                           ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1);
@@ -549,14 +547,14 @@ Lemma plus_frac_part2 :
     frac_part r1 + frac_part r2 < 1 ->
     frac_part (r1 + r2) = frac_part r1 + frac_part r2.
 Proof.
-  intros; unfold frac_part in |- *; generalize (plus_Int_part2 r1 r2 H); intro;
+  intros; unfold frac_part; generalize (plus_Int_part2 r1 r2 H); intro;
     rewrite H0; rewrite (plus_IZR (Int_part r1) (Int_part r2));
-      unfold Rminus at 2 3 in |- *;
+      unfold Rminus at 2 3;
         rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)));
           rewrite (Rplus_comm r2 (- IZR (Int_part r2)));
             rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2);
               rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2);
                 rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)));
                   rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2)));
-                    unfold Rminus in |- *; trivial with zarith real.
+                    unfold Rminus; trivial with zarith real.
 Qed.
diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v
index df2267d1..d6e18d9d 100644
--- a/theories/Reals/R_sqr.v
+++ b/theories/Reals/R_sqr.v
@@ -1,22 +1,20 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: R_sqr.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rbasic_fun.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (****************************************************)
 (** Rsqr : some results                             *)
 (****************************************************)
 
-Ltac ring_Rsqr := unfold Rsqr in |- *; ring.
+Ltac ring_Rsqr := unfold Rsqr; ring.
 
 Lemma Rsqr_neg : forall x:R, Rsqr x = Rsqr (- x).
 Proof.
@@ -50,29 +48,29 @@ Qed.
 
 Lemma Rsqr_gt_0_0 : forall x:R, 0 < Rsqr x -> x <> 0.
 Proof.
-  intros; red in |- *; intro; rewrite H0 in H; rewrite Rsqr_0 in H;
+  intros; red; intro; rewrite H0 in H; rewrite Rsqr_0 in H;
     elim (Rlt_irrefl 0 H).
 Qed.
 
 Lemma Rsqr_pos_lt : forall x:R, x <> 0 -> 0 < Rsqr x.
 Proof.
   intros; case (Rtotal_order 0 x); intro;
-    [ unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption
+    [ unfold Rsqr; apply Rmult_lt_0_compat; assumption
       | elim H0; intro;
-        [ elim H; symmetry  in |- *; exact H1
+        [ elim H; symmetry ; exact H1
           | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1);
-            rewrite Ropp_0; intro; unfold Rsqr in |- *;
+            rewrite Ropp_0; intro; unfold Rsqr;
               apply Rmult_lt_0_compat; assumption ] ].
 Qed.
 
 Lemma Rsqr_div : forall x y:R, y <> 0 -> Rsqr (x / y) = Rsqr x / Rsqr y.
 Proof.
-  intros; unfold Rsqr in |- *.
-  unfold Rdiv in |- *.
+  intros; unfold Rsqr.
+  unfold Rdiv.
   rewrite Rinv_mult_distr.
   repeat rewrite Rmult_assoc.
   apply Rmult_eq_compat_l.
-  pattern x at 2 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_comm. 
   repeat rewrite Rmult_assoc.
   apply Rmult_eq_compat_l.
   reflexivity.
@@ -82,7 +80,7 @@ Qed.
 
 Lemma Rsqr_eq_0 : forall x:R, Rsqr x = 0 -> x = 0.
 Proof.
-  unfold Rsqr in |- *; intros; generalize (Rmult_integral x x H); intro;
+  unfold Rsqr; intros; generalize (Rmult_integral x x H); intro;
     elim H0; intro; assumption.
 Qed.
 
@@ -124,7 +122,7 @@ Qed.
 Lemma Rsqr_incr_1 :
   forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y.
 Proof.
-  intros; unfold Rsqr in |- *; apply Rmult_le_compat; assumption.
+  intros; unfold Rsqr; apply Rmult_le_compat; assumption.
 Qed.
 
 Lemma Rsqr_incrst_0 :
@@ -142,7 +140,7 @@ Qed.
 Lemma Rsqr_incrst_1 :
   forall x y:R, x < y -> 0 <= x -> 0 <= y -> Rsqr x < Rsqr y.
 Proof.
-  intros; unfold Rsqr in |- *; apply Rmult_le_0_lt_compat; assumption.
+  intros; unfold Rsqr; apply Rmult_le_0_lt_compat; assumption.
 Qed.
 
 Lemma Rsqr_neg_pos_le_0 :
@@ -185,7 +183,7 @@ Qed.
 
 Lemma Rsqr_abs : forall x:R, Rsqr x = Rsqr (Rabs x).
 Proof.
-  intro; unfold Rabs in |- *; case (Rcase_abs x); intro;
+  intro; unfold Rabs; case (Rcase_abs x); intro;
     [ apply Rsqr_neg | reflexivity ].
 Qed.
 
@@ -222,7 +220,7 @@ Qed.
 
 Lemma Rsqr_eq_abs_0 : forall x y:R, Rsqr x = Rsqr y -> Rabs x = Rabs y.
 Proof.
-  intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros.
+  intros; unfold Rabs; case (Rcase_abs x); case (Rcase_abs y); intros.
   rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H;
     generalize (Ropp_lt_gt_contravar y 0 r);
       generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0;
@@ -290,7 +288,7 @@ Qed.
 
 Lemma Rsqr_inv : forall x:R, x <> 0 -> Rsqr (/ x) = / Rsqr x.
 Proof.
-  intros; unfold Rsqr in |- *.
+  intros; unfold Rsqr.
   rewrite Rinv_mult_distr; try reflexivity || assumption.
 Qed.
 
@@ -304,7 +302,7 @@ Proof.
   repeat rewrite Rmult_plus_distr_l.
   repeat rewrite Rplus_assoc.
   apply Rplus_eq_compat_l.
-  unfold Rdiv, Rminus in |- *.
+  unfold Rdiv, Rminus.
   replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ].
   rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))).
   rewrite Rsqr_mult.
@@ -334,7 +332,7 @@ Proof.
   rewrite (Rmult_comm x).
   apply Rplus_eq_compat_l.
   rewrite (Rmult_comm (/ a)).
-  unfold Rsqr in |- *; repeat rewrite Rmult_assoc.
+  unfold Rsqr; repeat rewrite Rmult_assoc.
   rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r.
   ring.
@@ -359,7 +357,7 @@ Proof.
       rewrite Rplus_opp_l; replace (- (y * y) + x * x) with ((x - y) * (x + y)).
   intro; generalize (Rmult_integral (x - y) (x + y) H0); intro; elim H1; intros.
   left; apply Rminus_diag_uniq; assumption.
-  right; apply Rminus_diag_uniq; unfold Rminus in |- *; rewrite Ropp_involutive;
+  right; apply Rminus_diag_uniq; unfold Rminus; rewrite Ropp_involutive;
     assumption.
   ring.
 Qed.
diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v
index 26980c95..2d9419bd 100644
--- a/theories/Reals/R_sqrt.v
+++ b/theories/Reals/R_sqrt.v
@@ -1,17 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: R_sqrt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rsqrt_def.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (** * Continuous extension of Rsqrt on R *)
 Definition sqrt (x:R) : R :=
@@ -38,7 +36,7 @@ Qed.
 Lemma sqrt_sqrt : forall x:R, 0 <= x -> sqrt x * sqrt x = x.
 Proof.
   intros.
-  unfold sqrt in |- *.
+  unfold sqrt.
   case (Rcase_abs x); intro.
   elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)).
   rewrite Rsqrt_Rsqrt; reflexivity.
@@ -46,7 +44,7 @@ Qed.
 
 Lemma sqrt_0 : sqrt 0 = 0.
 Proof.
-  apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity.
+  apply Rsqr_eq_0; unfold Rsqr; apply sqrt_sqrt; right; reflexivity.
 Qed.
 
 Lemma sqrt_1 : sqrt 1 = 1.
@@ -54,7 +52,7 @@ Proof.
   apply (Rsqr_inj (sqrt 1) 1);
     [ apply sqrt_positivity; left
       | left
-      | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ];
+      | unfold Rsqr; rewrite sqrt_sqrt; [ ring | left ] ];
     apply Rlt_0_1.
 Qed.
 
@@ -75,7 +73,7 @@ Proof.
   intros; apply Rsqr_inj;
     [ apply (sqrt_positivity x H)
       | assumption
-      | unfold Rsqr in |- *; rewrite H1; apply (sqrt_sqrt x H) ].
+      | unfold Rsqr; rewrite H1; apply (sqrt_sqrt x H) ].
 Qed.
 
 Lemma sqrt_def : forall x:R, 0 <= x -> sqrt x * sqrt x = x.
@@ -88,12 +86,12 @@ Proof.
   intros;
     apply
       (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (Rle_0_sqr x)) H);
-      unfold Rsqr in |- *; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)).
+      unfold Rsqr; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)).
 Qed.
 
 Lemma sqrt_Rsqr : forall x:R, 0 <= x -> sqrt (Rsqr x) = x.
 Proof.
-  intros; unfold Rsqr in |- *; apply sqrt_square; assumption.
+  intros; unfold Rsqr; apply sqrt_square; assumption.
 Qed.
 
 Lemma sqrt_Rsqr_abs : forall x:R, sqrt (Rsqr x) = Rabs x.
@@ -103,7 +101,7 @@ Qed.
 
 Lemma Rsqr_sqrt : forall x:R, 0 <= x -> Rsqr (sqrt x) = x.
 Proof.
-  intros x H1; unfold Rsqr in |- *; apply (sqrt_sqrt x H1).
+  intros x H1; unfold Rsqr; apply (sqrt_sqrt x H1).
 Qed.
 
 Lemma sqrt_mult_alt :
@@ -302,7 +300,7 @@ Proof.
   intros x H1 H2;
     generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2);
       intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x));
-        intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1 in |- *;
+        intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1;
           rewrite <- (sqrt_def x (Rlt_le 0 x H1));
             apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3).
 Qed.
@@ -312,7 +310,7 @@ Lemma sqrt_cauchy :
     a * c + b * d <= sqrt (Rsqr a + Rsqr b) * sqrt (Rsqr c + Rsqr d).
 Proof.
   intros a b c d; apply Rsqr_incr_0_var;
-    [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr in |- *;
+    [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr;
       [ replace ((a * c + b * d) * (a * c + b * d)) with
         (a * a * c * c + b * b * d * d + 2 * a * b * c * d);
         [ replace ((a * a + b * b) * (c * c + d * d)) with
@@ -321,11 +319,11 @@ Proof.
             replace (a * a * d * d + b * b * c * c) with
             (2 * a * b * c * d +
               (a * a * d * d + b * b * c * c - 2 * a * b * c * d));
-            [ pattern (2 * a * b * c * d) at 1 in |- *; rewrite <- Rplus_0_r;
+            [ pattern (2 * a * b * c * d) at 1; rewrite <- Rplus_0_r;
               apply Rplus_le_compat_l;
                 replace (a * a * d * d + b * b * c * c - 2 * a * b * c * d)
               with (Rsqr (a * d - b * c));
-                [ apply Rle_0_sqr | unfold Rsqr in |- *; ring ]
+                [ apply Rle_0_sqr | unfold Rsqr; ring ]
               | ring ]
             | ring ]
           | ring ]
@@ -357,16 +355,16 @@ Lemma Rsqr_sol_eq_0_1 :
     x = sol_x1 a b c \/ x = sol_x2 a b c -> a * Rsqr x + b * x + c = 0.
 Proof.
   intros; elim H0; intro.
-  unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *;
+  unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv;
     repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg;
       rewrite Rsqr_sqrt.
   rewrite Rsqr_inv.
-  unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr.
+  unfold Rsqr; repeat rewrite Rinv_mult_distr.
   repeat rewrite Rmult_assoc; rewrite (Rmult_comm a).
   repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r; rewrite Rmult_plus_distr_r.
   repeat rewrite Rmult_assoc.
-  pattern 2 at 2 in |- *; rewrite (Rmult_comm 2).
+  pattern 2 at 2; rewrite (Rmult_comm 2).
   repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r.
   rewrite
@@ -378,7 +376,7 @@ Proof.
     (b * (- b * (/ 2 * / a)) +
       (b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + c))) with
   (b * (- b * (/ 2 * / a)) + c).
-  unfold Rminus in |- *; repeat rewrite <- Rplus_assoc.
+  unfold Rminus; repeat rewrite <- Rplus_assoc.
   replace (b * b + b * b) with (2 * (b * b)).
   rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc.
   rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc.
@@ -409,17 +407,17 @@ Proof.
   apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
   apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
   assumption.
-  unfold sol_x2 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *;
+  unfold sol_x2 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv;
     repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg;
       rewrite Rsqr_sqrt.
   rewrite Rsqr_inv.
-  unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr;
+  unfold Rsqr; repeat rewrite Rinv_mult_distr;
     repeat rewrite Rmult_assoc.
   rewrite (Rmult_comm a); repeat rewrite Rmult_assoc.
   rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; unfold Rminus in |- *; rewrite Rmult_plus_distr_r.
+  rewrite Rmult_1_r; unfold Rminus; rewrite Rmult_plus_distr_r.
   rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
-    pattern 2 at 2 in |- *; rewrite (Rmult_comm 2).
+    pattern 2 at 2; rewrite (Rmult_comm 2).
   repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r;
     rewrite
@@ -482,23 +480,23 @@ Proof.
   intro;
     generalize (Rsqr_eq (x + b / (2 * a)) (sqrt (Delta a b c) / (2 * a)) H3);
       intro; elim H4; intro.
-  left; unfold sol_x1 in |- *;
+  left; unfold sol_x1;
     generalize
       (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a))
         (sqrt (Delta a b c) / (2 * a)) H5);
       replace (- (b / (2 * a)) + (x + b / (2 * a))) with x.
-  intro; rewrite H6; unfold Rdiv in |- *; ring.
+  intro; rewrite H6; unfold Rdiv; ring.
   ring.
-  right; unfold sol_x2 in |- *;
+  right; unfold sol_x2;
     generalize
       (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a))
         (- (sqrt (Delta a b c) / (2 * a))) H5);
       replace (- (b / (2 * a)) + (x + b / (2 * a))) with x.
-  intro; rewrite H6; unfold Rdiv in |- *; ring.
+  intro; rewrite H6; unfold Rdiv; ring.
   ring.
   rewrite Rsqr_div.
   rewrite Rsqr_sqrt.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   repeat rewrite Rmult_assoc.
   rewrite (Rmult_comm (/ a)).
   rewrite Rmult_assoc.
@@ -512,9 +510,9 @@ Proof.
   assumption.
   apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ].
   rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-  symmetry  in |- *; apply Rmult_1_l.
+  symmetry ; apply Rmult_1_l.
   apply (cond_nonzero a).
-  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
+  unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse.
   rewrite Ropp_minus_distr.
   reflexivity.
   reflexivity.
diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v
index 39c2271b..ad86a197 100644
--- a/theories/Reals/Ranalysis.v
+++ b/theories/Reals/Ranalysis.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rtrigo.
@@ -28,775 +26,4 @@ Require Export RList.
 Require Export Sqrt_reg.
 Require Export Ranalysis4.
 Require Export Rpower.
-Open Local Scope R_scope.
-
-Axiom AppVar : R.
-
-(**********)
-Ltac intro_hyp_glob trm :=
-  match constr:trm with
-    | (?X1 + ?X2)%F =>
-      match goal with
-        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
-        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
-        | _ => idtac
-      end
-    | (?X1 - ?X2)%F =>
-      match goal with
-        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
-        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
-        | _ => idtac
-      end
-    | (?X1 * ?X2)%F =>
-      match goal with
-        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
-        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
-        | _ => idtac
-      end
-    | (?X1 / ?X2)%F =>
-      let aux := constr:X2 in
-        match goal with
-          | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
-            intro_hyp_glob X1; intro_hyp_glob X2
-          | _:(forall x0:R, aux x0 <> 0) |- (continuity _) =>
-            intro_hyp_glob X1; intro_hyp_glob X2
-          |  |- (derivable _) =>
-            cut (forall x0:R, aux x0 <> 0);
-              [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
-          |  |- (continuity _) =>
-            cut (forall x0:R, aux x0 <> 0);
-              [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
-          | _ => idtac
-        end
-    | (comp ?X1 ?X2) =>
-      match goal with
-        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
-        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
-        | _ => idtac
-      end
-    | (- ?X1)%F =>
-      match goal with
-        |  |- (derivable _) => intro_hyp_glob X1
-        |  |- (continuity _) => intro_hyp_glob X1
-        | _ => idtac
-      end
-    | (/ ?X1)%F =>
-      let aux := constr:X1 in
-        match goal with
-          | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
-            intro_hyp_glob X1
-          | _:(forall x0:R, aux x0 <> 0) |- (continuity _) =>
-            intro_hyp_glob X1
-          |  |- (derivable _) =>
-            cut (forall x0:R, aux x0 <> 0);
-              [ intro; intro_hyp_glob X1 | try assumption ]
-          |  |- (continuity _) =>
-            cut (forall x0:R, aux x0 <> 0);
-              [ intro; intro_hyp_glob X1 | try assumption ]
-          | _ => idtac
-        end
-    | cos => idtac
-    | sin => idtac
-    | cosh => idtac
-    | sinh => idtac
-    | exp => idtac
-    | Rsqr => idtac
-    | sqrt => idtac
-    | id => idtac
-    | (fct_cte _) => idtac
-    | (pow_fct _) => idtac
-    | Rabs => idtac
-    | ?X1 =>
-      let p := constr:X1 in
-        match goal with
-          | _:(derivable p) |- _ => idtac
-          |  |- (derivable p) => idtac
-          |  |- (derivable _) =>
-            cut (True -> derivable p);
-              [ intro HYPPD; cut (derivable p);
-                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-                | idtac ]
-          | _:(continuity p) |- _ => idtac
-          |  |- (continuity p) => idtac
-          |  |- (continuity _) =>
-            cut (True -> continuity p);
-              [ intro HYPPD; cut (continuity p);
-                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-                | idtac ]
-          | _ => idtac
-        end
-  end.
-
-(**********)
-Ltac intro_hyp_pt trm pt :=
-  match constr:trm with
-    | (?X1 + ?X2)%F =>
-      match goal with
-        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-        |  |- (derive_pt _ _ _ = _) =>
-          intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-        | _ => idtac
-      end
-    | (?X1 - ?X2)%F =>
-      match goal with
-        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-        |  |- (derive_pt _ _ _ = _) =>
-          intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-        | _ => idtac
-      end
-    | (?X1 * ?X2)%F =>
-      match goal with
-        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-        |  |- (derive_pt _ _ _ = _) =>
-          intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-        | _ => idtac
-      end
-    | (?X1 / ?X2)%F =>
-      let aux := constr:X2 in
-        match goal with
-          | _:(aux pt <> 0) |- (derivable_pt _ _) =>
-            intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-          | _:(aux pt <> 0) |- (continuity_pt _ _) =>
-            intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-          | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
-            intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-          | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
-            generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-          | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
-            generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-          | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
-            generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-          |  |- (derivable_pt _ _) =>
-            cut (aux pt <> 0);
-              [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
-          |  |- (continuity_pt _ _) =>
-            cut (aux pt <> 0);
-              [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
-          |  |- (derive_pt _ _ _ = _) =>
-            cut (aux pt <> 0);
-              [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
-          | _ => idtac
-        end
-    | (comp ?X1 ?X2) =>
-      match goal with
-        |  |- (derivable_pt _ _) =>
-          let pt_f1 := eval cbv beta in (X2 pt) in
-            (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
-        |  |- (continuity_pt _ _) =>
-          let pt_f1 := eval cbv beta in (X2 pt) in
-            (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
-        |  |- (derive_pt _ _ _ = _) =>
-          let pt_f1 := eval cbv beta in (X2 pt) in
-            (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
-        | _ => idtac
-      end
-    | (- ?X1)%F =>
-      match goal with
-        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt
-        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt
-        |  |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt
-        | _ => idtac
-      end
-    | (/ ?X1)%F =>
-      let aux := constr:X1 in
-        match goal with
-          | _:(aux pt <> 0) |- (derivable_pt _ _) =>
-            intro_hyp_pt X1 pt
-          | _:(aux pt <> 0) |- (continuity_pt _ _) =>
-            intro_hyp_pt X1 pt
-          | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
-            intro_hyp_pt X1 pt
-          | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
-            generalize (id pt); intro; intro_hyp_pt X1 pt
-          | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
-            generalize (id pt); intro; intro_hyp_pt X1 pt
-          | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
-            generalize (id pt); intro; intro_hyp_pt X1 pt
-          |  |- (derivable_pt _ _) =>
-            cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
-          |  |- (continuity_pt _ _) =>
-            cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
-          |  |- (derive_pt _ _ _ = _) =>
-            cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
-          | _ => idtac
-        end
-    | cos => idtac
-    | sin => idtac
-    | cosh => idtac
-    | sinh => idtac
-    | exp => idtac
-    | Rsqr => idtac
-    | id => idtac
-    | (fct_cte _) => idtac
-    | (pow_fct _) => idtac
-    | sqrt =>
-      match goal with
-        |  |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ]
-        |  |- (continuity_pt _ _) =>
-          cut (0 <= pt); [ intro | try assumption ]
-        |  |- (derive_pt _ _ _ = _) =>
-          cut (0 < pt); [ intro | try assumption ]
-        | _ => idtac
-      end
-    | Rabs =>
-      match goal with
-        |  |- (derivable_pt _ _) =>
-          cut (pt <> 0); [ intro | try assumption ]
-        | _ => idtac
-      end
-    | ?X1 =>
-      let p := constr:X1 in
-        match goal with
-          | _:(derivable_pt p pt) |- _ => idtac
-          |  |- (derivable_pt p pt) => idtac
-          |  |- (derivable_pt _ _) =>
-            cut (True -> derivable_pt p pt);
-              [ intro HYPPD; cut (derivable_pt p pt);
-                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-                | idtac ]
-          | _:(continuity_pt p pt) |- _ => idtac
-          |  |- (continuity_pt p pt) => idtac
-          |  |- (continuity_pt _ _) =>
-            cut (True -> continuity_pt p pt);
-              [ intro HYPPD; cut (continuity_pt p pt);
-                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-                | idtac ]
-          |  |- (derive_pt _ _ _ = _) =>
-            cut (True -> derivable_pt p pt);
-              [ intro HYPPD; cut (derivable_pt p pt);
-                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-                | idtac ]
-          | _ => idtac
-        end
-  end.
-
-(**********)
-Ltac is_diff_pt :=
-  match goal with
-    |  |- (derivable_pt Rsqr _) =>
-
-  (* fonctions de base *)
-      apply derivable_pt_Rsqr
-    |  |- (derivable_pt id ?X1) => apply (derivable_pt_id X1)
-    |  |- (derivable_pt (fct_cte _) _) => apply derivable_pt_const
-    |  |- (derivable_pt sin _) => apply derivable_pt_sin
-    |  |- (derivable_pt cos _) => apply derivable_pt_cos
-    |  |- (derivable_pt sinh _) => apply derivable_pt_sinh
-    |  |- (derivable_pt cosh _) => apply derivable_pt_cosh
-    |  |- (derivable_pt exp _) => apply derivable_pt_exp
-    |  |- (derivable_pt (pow_fct _) _) =>
-      unfold pow_fct in |- *; apply derivable_pt_pow
-    |  |- (derivable_pt sqrt ?X1) =>
-      apply (derivable_pt_sqrt X1);
-        assumption ||
-          unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
-            comp, id, fct_cte, pow_fct in |- *
-    |  |- (derivable_pt Rabs ?X1) =>
-      apply (Rderivable_pt_abs X1);
-        assumption ||
-          unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
-            comp, id, fct_cte, pow_fct in |- *
-        (* regles de differentiabilite *)
-        (* PLUS *)
-    |  |- (derivable_pt (?X1 + ?X2) ?X3) =>
-      apply (derivable_pt_plus X1 X2 X3); is_diff_pt
-       (* MOINS *)
-    |  |- (derivable_pt (?X1 - ?X2) ?X3) =>
-      apply (derivable_pt_minus X1 X2 X3); is_diff_pt
-       (* OPPOSE *)
-    |  |- (derivable_pt (- ?X1) ?X2) =>
-      apply (derivable_pt_opp X1 X2);
-        is_diff_pt
-       (* MULTIPLICATION PAR UN SCALAIRE *)
-    |  |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) =>
-      apply (derivable_pt_scal X2 X1 X3); is_diff_pt
-       (* MULTIPLICATION *)
-    |  |- (derivable_pt (?X1 * ?X2) ?X3) =>
-      apply (derivable_pt_mult X1 X2 X3); is_diff_pt
-       (* DIVISION *)
-    |  |- (derivable_pt (?X1 / ?X2) ?X3) =>
-      apply (derivable_pt_div X1 X2 X3);
-        [ is_diff_pt
-          | is_diff_pt
-          | try
-            assumption ||
-              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-                comp, pow_fct, id, fct_cte in |- * ]
-    |  |- (derivable_pt (/ ?X1) ?X2) =>
-
-       (* INVERSION *)
-      apply (derivable_pt_inv X1 X2);
-        [ assumption ||
-          unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-            comp, pow_fct, id, fct_cte in |- *
-          | is_diff_pt ]
-    |  |- (derivable_pt (comp ?X1 ?X2) ?X3) =>
-
-       (* COMPOSITION *)
-      apply (derivable_pt_comp X2 X1 X3); is_diff_pt
-    | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) =>
-      assumption
-    | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) =>
-      cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ]
-    |  |- (True -> derivable_pt _ _) =>
-      intro HypTruE; clear HypTruE; is_diff_pt
-    | _ =>
-      try
-        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
-          fct_cte, comp, pow_fct in |- *
-  end.
-
-(**********)
-Ltac is_diff_glob :=
-  match goal with
-    |  |- (derivable Rsqr) =>
-  (* fonctions de base *)
-      apply derivable_Rsqr
-    |  |- (derivable id) => apply derivable_id
-    |  |- (derivable (fct_cte _)) => apply derivable_const
-    |  |- (derivable sin) => apply derivable_sin
-    |  |- (derivable cos) => apply derivable_cos
-    |  |- (derivable cosh) => apply derivable_cosh
-    |  |- (derivable sinh) => apply derivable_sinh
-    |  |- (derivable exp) => apply derivable_exp
-    |  |- (derivable (pow_fct _)) =>
-      unfold pow_fct in |- *;
-        apply derivable_pow
-        (* regles de differentiabilite *)
-        (* PLUS *)
-    |  |- (derivable (?X1 + ?X2)) =>
-      apply (derivable_plus X1 X2); is_diff_glob
-       (* MOINS *)
-    |  |- (derivable (?X1 - ?X2)) =>
-      apply (derivable_minus X1 X2); is_diff_glob
-       (* OPPOSE *)
-    |  |- (derivable (- ?X1)) =>
-      apply (derivable_opp X1);
-        is_diff_glob
-       (* MULTIPLICATION PAR UN SCALAIRE *)
-    |  |- (derivable (mult_real_fct ?X1 ?X2)) =>
-      apply (derivable_scal X2 X1); is_diff_glob
-       (* MULTIPLICATION *)
-    |  |- (derivable (?X1 * ?X2)) =>
-      apply (derivable_mult X1 X2); is_diff_glob
-       (* DIVISION *)
-    |  |- (derivable (?X1 / ?X2)) =>
-      apply (derivable_div X1 X2);
-        [ is_diff_glob
-          | is_diff_glob
-          | try
-            assumption ||
-              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-                id, fct_cte, comp, pow_fct in |- * ]
-    |  |- (derivable (/ ?X1)) =>
-
-       (* INVERSION *)
-      apply (derivable_inv X1);
-        [ try
-          assumption ||
-            unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-              id, fct_cte, comp, pow_fct in |- *
-          | is_diff_glob ]
-    |  |- (derivable (comp sqrt _)) =>
-
-       (* COMPOSITION *)
-      unfold derivable in |- *; intro; try is_diff_pt
-    |  |- (derivable (comp Rabs _)) =>
-      unfold derivable in |- *; intro; try is_diff_pt
-    |  |- (derivable (comp ?X1 ?X2)) =>
-      apply (derivable_comp X2 X1); is_diff_glob
-    | _:(derivable ?X1) |- (derivable ?X1) => assumption
-    |  |- (True -> derivable _) =>
-      intro HypTruE; clear HypTruE; is_diff_glob
-    | _ =>
-      try
-        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
-          fct_cte, comp, pow_fct in |- *
-  end.
-
-(**********)
-Ltac is_cont_pt :=
-  match goal with
-    |  |- (continuity_pt Rsqr _) =>
-
-       (* fonctions de base *)
-      apply derivable_continuous_pt; apply derivable_pt_Rsqr
-    |  |- (continuity_pt id ?X1) =>
-      apply derivable_continuous_pt; apply (derivable_pt_id X1)
-    |  |- (continuity_pt (fct_cte _) _) =>
-      apply derivable_continuous_pt; apply derivable_pt_const
-    |  |- (continuity_pt sin _) =>
-      apply derivable_continuous_pt; apply derivable_pt_sin
-    |  |- (continuity_pt cos _) =>
-      apply derivable_continuous_pt; apply derivable_pt_cos
-    |  |- (continuity_pt sinh _) =>
-      apply derivable_continuous_pt; apply derivable_pt_sinh
-    |  |- (continuity_pt cosh _) =>
-      apply derivable_continuous_pt; apply derivable_pt_cosh
-    |  |- (continuity_pt exp _) =>
-      apply derivable_continuous_pt; apply derivable_pt_exp
-    |  |- (continuity_pt (pow_fct _) _) =>
-      unfold pow_fct in |- *; apply derivable_continuous_pt;
-        apply derivable_pt_pow
-    |  |- (continuity_pt sqrt ?X1) =>
-      apply continuity_pt_sqrt;
-        assumption ||
-          unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
-            comp, id, fct_cte, pow_fct in |- *
-    |  |- (continuity_pt Rabs ?X1) =>
-      apply (Rcontinuity_abs X1)
-       (* regles de differentiabilite *)
-       (* PLUS *)
-    |  |- (continuity_pt (?X1 + ?X2) ?X3) =>
-      apply (continuity_pt_plus X1 X2 X3); is_cont_pt
-       (* MOINS *)
-    |  |- (continuity_pt (?X1 - ?X2) ?X3) =>
-      apply (continuity_pt_minus X1 X2 X3); is_cont_pt
-       (* OPPOSE *)
-    |  |- (continuity_pt (- ?X1) ?X2) =>
-      apply (continuity_pt_opp X1 X2);
-        is_cont_pt
-       (* MULTIPLICATION PAR UN SCALAIRE *)
-    |  |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) =>
-      apply (continuity_pt_scal X2 X1 X3); is_cont_pt
-       (* MULTIPLICATION *)
-    |  |- (continuity_pt (?X1 * ?X2) ?X3) =>
-      apply (continuity_pt_mult X1 X2 X3); is_cont_pt
-       (* DIVISION *)
-    |  |- (continuity_pt (?X1 / ?X2) ?X3) =>
-      apply (continuity_pt_div X1 X2 X3);
-        [ is_cont_pt
-          | is_cont_pt
-          | try
-            assumption ||
-              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-                comp, id, fct_cte, pow_fct in |- * ]
-    |  |- (continuity_pt (/ ?X1) ?X2) =>
-
-       (* INVERSION *)
-      apply (continuity_pt_inv X1 X2);
-        [ is_cont_pt
-          | assumption ||
-            unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-              comp, id, fct_cte, pow_fct in |- * ]
-    |  |- (continuity_pt (comp ?X1 ?X2) ?X3) =>
-
-       (* COMPOSITION *)
-      apply (continuity_pt_comp X2 X1 X3); is_cont_pt
-    | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
-      assumption
-    | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) =>
-      cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ]
-    | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
-      apply derivable_continuous_pt; assumption
-    | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) =>
-      cut (continuity X1);
-        [ intro HypDDPT; apply HypDDPT
-          | apply derivable_continuous; assumption ]
-    |  |- (True -> continuity_pt _ _) =>
-      intro HypTruE; clear HypTruE; is_cont_pt
-    | _ =>
-      try
-        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
-          fct_cte, comp, pow_fct in |- *
-  end.
-
-(**********)
-Ltac is_cont_glob :=
-  match goal with
-    |  |- (continuity Rsqr) =>
-
-       (* fonctions de base *)
-      apply derivable_continuous; apply derivable_Rsqr
-    |  |- (continuity id) => apply derivable_continuous; apply derivable_id
-    |  |- (continuity (fct_cte _)) =>
-      apply derivable_continuous; apply derivable_const
-    |  |- (continuity sin) => apply derivable_continuous; apply derivable_sin
-    |  |- (continuity cos) => apply derivable_continuous; apply derivable_cos
-    |  |- (continuity exp) => apply derivable_continuous; apply derivable_exp
-    |  |- (continuity (pow_fct _)) =>
-      unfold pow_fct in |- *; apply derivable_continuous; apply derivable_pow
-    |  |- (continuity sinh) =>
-      apply derivable_continuous; apply derivable_sinh
-    |  |- (continuity cosh) =>
-      apply derivable_continuous; apply derivable_cosh
-    |  |- (continuity Rabs) =>
-      apply Rcontinuity_abs
-       (* regles de continuite *)
-       (* PLUS *)
-    |  |- (continuity (?X1 + ?X2)) =>
-      apply (continuity_plus X1 X2);
-        try is_cont_glob || assumption
-            (* MOINS *)
-    |  |- (continuity (?X1 - ?X2)) =>
-      apply (continuity_minus X1 X2);
-        try is_cont_glob || assumption
-            (* OPPOSE *)
-    |  |- (continuity (- ?X1)) =>
-      apply (continuity_opp X1); try is_cont_glob || assumption
-                                      (* INVERSE *)
-    |  |- (continuity (/ ?X1)) =>
-      apply (continuity_inv X1);
-        try is_cont_glob || assumption
-            (* MULTIPLICATION PAR UN SCALAIRE *)
-    |  |- (continuity (mult_real_fct ?X1 ?X2)) =>
-      apply (continuity_scal X2 X1);
-        try is_cont_glob || assumption
-            (* MULTIPLICATION *)
-    |  |- (continuity (?X1 * ?X2)) =>
-      apply (continuity_mult X1 X2);
-        try is_cont_glob || assumption
-            (* DIVISION *)
-    |  |- (continuity (?X1 / ?X2)) =>
-      apply (continuity_div X1 X2);
-        [ try is_cont_glob || assumption
-          | try is_cont_glob || assumption
-          | try
-            assumption ||
-              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-                id, fct_cte, pow_fct in |- * ]
-    |  |- (continuity (comp sqrt _)) =>
-
-       (* COMPOSITION *)
-      unfold continuity_pt in |- *; intro; try is_cont_pt
-    |  |- (continuity (comp ?X1 ?X2)) =>
-      apply (continuity_comp X2 X1); try is_cont_glob || assumption
-    | _:(continuity ?X1) |- (continuity ?X1) => assumption
-    |  |- (True -> continuity _) =>
-      intro HypTruE; clear HypTruE; is_cont_glob
-    | _:(derivable ?X1) |- (continuity ?X1) =>
-      apply derivable_continuous; assumption
-    | _ =>
-      try
-        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
-          fct_cte, comp, pow_fct in |- *
-  end.
-
-(**********)
-Ltac rew_term trm :=
-  match constr:trm with
-    | (?X1 + ?X2) =>
-      let p1 := rew_term X1 with p2 := rew_term X2 in
-        match constr:p1 with
-          | (fct_cte ?X3) =>
-            match constr:p2 with
-              | (fct_cte ?X4) => constr:(fct_cte (X3 + X4))
-              | _ => constr:(p1 + p2)%F
-            end
-          | _ => constr:(p1 + p2)%F
-        end
-    | (?X1 - ?X2) =>
-      let p1 := rew_term X1 with p2 := rew_term X2 in
-        match constr:p1 with
-          | (fct_cte ?X3) =>
-            match constr:p2 with
-              | (fct_cte ?X4) => constr:(fct_cte (X3 - X4))
-              | _ => constr:(p1 - p2)%F
-            end
-          | _ => constr:(p1 - p2)%F
-        end
-    | (?X1 / ?X2) =>
-      let p1 := rew_term X1 with p2 := rew_term X2 in
-        match constr:p1 with
-          | (fct_cte ?X3) =>
-            match constr:p2 with
-              | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
-              | _ => constr:(p1 / p2)%F
-            end
-          | _ =>
-            match constr:p2 with
-              | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
-              | _ => constr:(p1 / p2)%F
-            end
-        end
-    | (?X1 * / ?X2) =>
-      let p1 := rew_term X1 with p2 := rew_term X2 in
-        match constr:p1 with
-          | (fct_cte ?X3) =>
-            match constr:p2 with
-              | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
-              | _ => constr:(p1 / p2)%F
-            end
-          | _ =>
-            match constr:p2 with
-              | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
-              | _ => constr:(p1 / p2)%F
-            end
-        end
-    | (?X1 * ?X2) =>
-      let p1 := rew_term X1 with p2 := rew_term X2 in
-        match constr:p1 with
-          | (fct_cte ?X3) =>
-            match constr:p2 with
-              | (fct_cte ?X4) => constr:(fct_cte (X3 * X4))
-              | _ => constr:(p1 * p2)%F
-            end
-          | _ => constr:(p1 * p2)%F
-        end
-    | (- ?X1) =>
-      let p := rew_term X1 in
-        match constr:p with
-          | (fct_cte ?X2) => constr:(fct_cte (- X2))
-          | _ => constr:(- p)%F
-        end
-    | (/ ?X1) =>
-      let p := rew_term X1 in
-        match constr:p with
-          | (fct_cte ?X2) => constr:(fct_cte (/ X2))
-          | _ => constr:(/ p)%F
-        end
-    | (?X1 AppVar) => constr:X1
-    | (?X1 ?X2) =>
-      let p := rew_term X2 in
-        match constr:p with
-          | (fct_cte ?X3) => constr:(fct_cte (X1 X3))
-          | _ => constr:(comp X1 p)
-        end
-    | AppVar => constr:id
-    | (AppVar ^ ?X1) => constr:(pow_fct X1)
-    | (?X1 ^ ?X2) =>
-      let p := rew_term X1 in
-        match constr:p with
-          | (fct_cte ?X3) => constr:(fct_cte (pow_fct X2 X3))
-          | _ => constr:(comp (pow_fct X2) p)
-        end
-    | ?X1 => constr:(fct_cte X1)
-  end.
-
-(**********)
-Ltac deriv_proof trm pt :=
-  match constr:trm with
-    | (?X1 + ?X2)%F =>
-      let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
-        constr:(derivable_pt_plus X1 X2 pt p1 p2)
-    | (?X1 - ?X2)%F =>
-      let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
-        constr:(derivable_pt_minus X1 X2 pt p1 p2)
-    | (?X1 * ?X2)%F =>
-      let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
-        constr:(derivable_pt_mult X1 X2 pt p1 p2)
-    | (?X1 / ?X2)%F =>
-      match goal with
-        | id:(?X2 pt <> 0) |- _ =>
-          let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
-            constr:(derivable_pt_div X1 X2 pt p1 p2 id)
-        | _ => constr:False
-      end
-    | (/ ?X1)%F =>
-      match goal with
-        | id:(?X1 pt <> 0) |- _ =>
-          let p1 := deriv_proof X1 pt in
-            constr:(derivable_pt_inv X1 pt p1 id)
-        | _ => constr:False
-      end
-    | (comp ?X1 ?X2) =>
-      let pt_f1 := eval cbv beta in (X2 pt) in
-        let p1 := deriv_proof X1 pt_f1 with p2 := deriv_proof X2 pt in
-          constr:(derivable_pt_comp X2 X1 pt p2 p1)
-    | (- ?X1)%F =>
-      let p1 := deriv_proof X1 pt in
-        constr:(derivable_pt_opp X1 pt p1)
-    | sin => constr:(derivable_pt_sin pt)
-    | cos => constr:(derivable_pt_cos pt)
-    | sinh => constr:(derivable_pt_sinh pt)
-    | cosh => constr:(derivable_pt_cosh pt)
-    | exp => constr:(derivable_pt_exp pt)
-    | id => constr:(derivable_pt_id pt)
-    | Rsqr => constr:(derivable_pt_Rsqr pt)
-    | sqrt =>
-      match goal with
-        | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id)
-        | _ => constr:False
-      end
-    | (fct_cte ?X1) => constr:(derivable_pt_const X1 pt)
-    | ?X1 =>
-      let aux := constr:X1 in
-        match goal with
-          | id:(derivable_pt aux pt) |- _ => constr:id
-          | id:(derivable aux) |- _ => constr:(id pt)
-          | _ => constr:False
-        end
-  end.
-
-(**********)
-Ltac simplify_derive trm pt :=
-  match constr:trm with
-    | (?X1 + ?X2)%F =>
-      try rewrite derive_pt_plus; simplify_derive X1 pt;
-        simplify_derive X2 pt
-    | (?X1 - ?X2)%F =>
-      try rewrite derive_pt_minus; simplify_derive X1 pt;
-        simplify_derive X2 pt
-    | (?X1 * ?X2)%F =>
-      try rewrite derive_pt_mult; simplify_derive X1 pt;
-        simplify_derive X2 pt
-    | (?X1 / ?X2)%F =>
-      try rewrite derive_pt_div; simplify_derive X1 pt; simplify_derive X2 pt
-    | (comp ?X1 ?X2) =>
-      let pt_f1 := eval cbv beta in (X2 pt) in
-        (try rewrite derive_pt_comp; simplify_derive X1 pt_f1;
-          simplify_derive X2 pt)
-    | (- ?X1)%F => try rewrite derive_pt_opp; simplify_derive X1 pt
-    | (/ ?X1)%F =>
-      try rewrite derive_pt_inv; simplify_derive X1 pt
-    | (fct_cte ?X1) => try rewrite derive_pt_const
-    | id => try rewrite derive_pt_id
-    | sin => try rewrite derive_pt_sin
-    | cos => try rewrite derive_pt_cos
-    | sinh => try rewrite derive_pt_sinh
-    | cosh => try rewrite derive_pt_cosh
-    | exp => try rewrite derive_pt_exp
-    | Rsqr => try rewrite derive_pt_Rsqr
-    | sqrt => try rewrite derive_pt_sqrt
-    | ?X1 =>
-      let aux := constr:X1 in
-        match goal with
-          | id:(derive_pt aux pt ?X2 = _),H:(derivable aux) |- _ =>
-            try replace (derive_pt aux pt (H pt)) with (derive_pt aux pt X2);
-              [ rewrite id | apply pr_nu ]
-          | id:(derive_pt aux pt ?X2 = _),H:(derivable_pt aux pt) |- _ =>
-            try replace (derive_pt aux pt H) with (derive_pt aux pt X2);
-              [ rewrite id | apply pr_nu ]
-          | _ => idtac
-        end
-    | _ => idtac
-  end.
-
-(**********)
-Ltac reg :=
-  match goal with
-    |  |- (derivable_pt ?X1 ?X2) =>
-      let trm := eval cbv beta in (X1 AppVar) in
-        let aux := rew_term trm in
-          (intro_hyp_pt aux X2;
-            try (change (derivable_pt aux X2) in |- *; is_diff_pt) || is_diff_pt)
-    |  |- (derivable ?X1) =>
-      let trm := eval cbv beta in (X1 AppVar) in
-        let aux := rew_term trm in
-          (intro_hyp_glob aux;
-            try (change (derivable aux) in |- *; is_diff_glob) || is_diff_glob)
-    |  |- (continuity ?X1) =>
-      let trm := eval cbv beta in (X1 AppVar) in
-        let aux := rew_term trm in
-          (intro_hyp_glob aux;
-            try (change (continuity aux) in |- *; is_cont_glob) || is_cont_glob)
-    |  |- (continuity_pt ?X1 ?X2) =>
-      let trm := eval cbv beta in (X1 AppVar) in
-        let aux := rew_term trm in
-          (intro_hyp_pt aux X2;
-            try (change (continuity_pt aux X2) in |- *; is_cont_pt) || is_cont_pt)
-    |  |- (derive_pt ?X1 ?X2 ?X3 = ?X4) =>
-      let trm := eval cbv beta in (X1 AppVar) in
-      let aux := rew_term trm in
-      intro_hyp_pt aux X2;
-      (let aux2 := deriv_proof aux X2 in
-       try
-         (replace (derive_pt X1 X2 X3) with (derive_pt aux X2 aux2);
-           [ simplify_derive aux X2;
-             try unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte,
-                        inv_fct, opp_fct in |- *; ring || ring_simplify
-           | try apply pr_nu ]) || is_diff_pt)
-  end.
+Require Export Ranalysis_reg.
\ No newline at end of file
diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v
index 673dc3c1..2f54ee94 100644
--- a/theories/Reals/Ranalysis1.v
+++ b/theories/Reals/Ranalysis1.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis1.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Export Rlimit.
 Require Export Rderiv.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 Implicit Type f : R -> R.
 
 (****************************************************)
@@ -30,22 +28,22 @@ Definition inv_fct f (x:R) : R := / f x.
 
 Delimit Scope Rfun_scope with F.
 
-Arguments Scope plus_fct [Rfun_scope Rfun_scope R_scope].
-Arguments Scope mult_fct [Rfun_scope Rfun_scope R_scope].
-Arguments Scope minus_fct [Rfun_scope Rfun_scope R_scope].
-Arguments Scope div_fct [Rfun_scope Rfun_scope R_scope].
-Arguments Scope inv_fct [Rfun_scope R_scope].
-Arguments Scope opp_fct [Rfun_scope R_scope].
-Arguments Scope mult_real_fct [R_scope Rfun_scope R_scope].
-Arguments Scope div_real_fct [R_scope Rfun_scope R_scope].
-Arguments Scope comp [Rfun_scope Rfun_scope R_scope].
+Arguments plus_fct (f1 f2)%F x%R.
+Arguments mult_fct (f1 f2)%F x%R.
+Arguments minus_fct (f1 f2)%F x%R.
+Arguments div_fct (f1 f2)%F x%R.
+Arguments inv_fct f%F x%R.
+Arguments opp_fct f%F x%R.
+Arguments mult_real_fct a%R f%F x%R.
+Arguments div_real_fct a%R f%F x%R.
+Arguments comp (f1 f2)%F x%R.
 
 Infix "+" := plus_fct : Rfun_scope.
 Notation "- x" := (opp_fct x) : Rfun_scope.
 Infix "*" := mult_fct : Rfun_scope.
 Infix "-" := minus_fct : Rfun_scope.
 Infix "/" := div_fct : Rfun_scope.
-Notation Local "f1 'o' f2" := (comp f1 f2)
+Local Notation "f1 'o' f2" := (comp f1 f2)
   (at level 20, right associativity) : Rfun_scope.
 Notation "/ x" := (inv_fct x) : Rfun_scope.
 
@@ -76,22 +74,22 @@ Definition constant_D_eq f (D:R -> Prop) (c:R) : Prop :=
 Definition continuity_pt f (x0:R) : Prop := continue_in f no_cond x0.
 Definition continuity f : Prop := forall x:R, continuity_pt f x.
 
-Arguments Scope continuity_pt [Rfun_scope R_scope].
-Arguments Scope continuity [Rfun_scope].
+Arguments continuity_pt f%F x0%R.
+Arguments continuity f%F.
 
 (**********)
 Lemma continuity_pt_plus :
   forall f1 f2 (x0:R),
     continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 + f2) x0.
 Proof.
-  unfold continuity_pt, plus_fct in |- *; unfold continue_in in |- *; intros;
+  unfold continuity_pt, plus_fct; unfold continue_in; intros;
     apply limit_plus; assumption.
 Qed.
 
 Lemma continuity_pt_opp :
   forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0.
 Proof.
-  unfold continuity_pt, opp_fct in |- *; unfold continue_in in |- *; intros;
+  unfold continuity_pt, opp_fct; unfold continue_in; intros;
     apply limit_Ropp; assumption.
 Qed.
 
@@ -99,7 +97,7 @@ Lemma continuity_pt_minus :
   forall f1 f2 (x0:R),
     continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 - f2) x0.
 Proof.
-  unfold continuity_pt, minus_fct in |- *; unfold continue_in in |- *; intros;
+  unfold continuity_pt, minus_fct; unfold continue_in; intros;
     apply limit_minus; assumption.
 Qed.
 
@@ -107,17 +105,17 @@ Lemma continuity_pt_mult :
   forall f1 f2 (x0:R),
     continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 * f2) x0.
 Proof.
-  unfold continuity_pt, mult_fct in |- *; unfold continue_in in |- *; intros;
+  unfold continuity_pt, mult_fct; unfold continue_in; intros;
     apply limit_mul; assumption.
 Qed.
 
 Lemma continuity_pt_const : forall f (x0:R), constant f -> continuity_pt f x0.
 Proof.
-  unfold constant, continuity_pt in |- *; unfold continue_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
+  unfold constant, continuity_pt; unfold continue_in;
+    unfold limit1_in; unfold limit_in;
       intros; exists 1; split;
         [ apply Rlt_0_1
-          | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *;
+          | intros; generalize (H x x0); intro; rewrite H2; simpl;
             rewrite R_dist_eq; assumption ].
 Qed.
 
@@ -125,9 +123,9 @@ Lemma continuity_pt_scal :
   forall f (a x0:R),
     continuity_pt f x0 -> continuity_pt (mult_real_fct a f) x0.
 Proof.
-  unfold continuity_pt, mult_real_fct in |- *; unfold continue_in in |- *;
+  unfold continuity_pt, mult_real_fct; unfold continue_in;
     intros; apply (limit_mul (fun x:R => a) f (D_x no_cond x0) a (f x0) x0).
-  unfold limit1_in in |- *; unfold limit_in in |- *; intros; exists 1; split.
+  unfold limit1_in; unfold limit_in; intros; exists 1; split.
   apply Rlt_0_1.
   intros; rewrite R_dist_eq; assumption.
   assumption.
@@ -138,9 +136,9 @@ Lemma continuity_pt_inv :
 Proof.
   intros.
   replace (/ f)%F with (fun x:R => / f x).
-  unfold continuity_pt in |- *; unfold continue_in in |- *; intros;
+  unfold continuity_pt; unfold continue_in; intros;
     apply limit_inv; assumption.
-  unfold inv_fct in |- *; reflexivity.
+  unfold inv_fct; reflexivity.
 Qed.
 
 Lemma div_eq_inv : forall f1 f2, (f1 / f2)%F = (f1 * / f2)%F.
@@ -161,8 +159,8 @@ Lemma continuity_pt_comp :
   forall f1 f2 (x:R),
     continuity_pt f1 x -> continuity_pt f2 (f1 x) -> continuity_pt (f2 o f1) x.
 Proof.
-  unfold continuity_pt in |- *; unfold continue_in in |- *; intros;
-    unfold comp in |- *.
+  unfold continuity_pt; unfold continue_in; intros;
+    unfold comp.
   cut
     (limit1_in (fun x0:R => f2 (f1 x0))
       (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) (
@@ -172,23 +170,23 @@ Proof.
   eapply limit_comp.
   apply H.
   apply H0.
-  unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
-    simpl in |- *; unfold R_dist in |- *; intros.
+  unfold limit1_in; unfold limit_in; unfold dist;
+    simpl; unfold R_dist; intros.
   assert (H3 := H1 eps H2).
   elim H3; intros.
   exists x0.
   split.
   elim H4; intros; assumption.
   intros; case (Req_dec (f1 x) (f1 x1)); intro.
-  rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  rewrite H6; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     assumption.
   elim H4; intros; apply H8.
   split.
-  unfold Dgf, D_x, no_cond in |- *.
+  unfold Dgf, D_x, no_cond.
   split.
   split.
   trivial.
-  elim H5; unfold D_x, no_cond in |- *; intros.
+  elim H5; unfold D_x, no_cond; intros.
   elim H9; intros; assumption.
   split.
   trivial.
@@ -200,44 +198,44 @@ Qed.
 Lemma continuity_plus :
   forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2).
 Proof.
-  unfold continuity in |- *; intros;
+  unfold continuity; intros;
     apply (continuity_pt_plus f1 f2 x (H x) (H0 x)).
 Qed.
 
 Lemma continuity_opp : forall f, continuity f -> continuity (- f).
 Proof.
-  unfold continuity in |- *; intros; apply (continuity_pt_opp f x (H x)).
+  unfold continuity; intros; apply (continuity_pt_opp f x (H x)).
 Qed.
 
 Lemma continuity_minus :
   forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2).
 Proof.
-  unfold continuity in |- *; intros;
+  unfold continuity; intros;
     apply (continuity_pt_minus f1 f2 x (H x) (H0 x)).
 Qed.
 
 Lemma continuity_mult :
   forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 * f2).
 Proof.
-  unfold continuity in |- *; intros;
+  unfold continuity; intros;
     apply (continuity_pt_mult f1 f2 x (H x) (H0 x)).
 Qed.
 
 Lemma continuity_const : forall f, constant f -> continuity f.
 Proof.
-  unfold continuity in |- *; intros; apply (continuity_pt_const f x H).
+  unfold continuity; intros; apply (continuity_pt_const f x H).
 Qed.
 
 Lemma continuity_scal :
   forall f (a:R), continuity f -> continuity (mult_real_fct a f).
 Proof.
-  unfold continuity in |- *; intros; apply (continuity_pt_scal f a x (H x)).
+  unfold continuity; intros; apply (continuity_pt_scal f a x (H x)).
 Qed.
 
 Lemma continuity_inv :
   forall f, continuity f -> (forall x:R, f x <> 0) -> continuity (/ f).
 Proof.
-  unfold continuity in |- *; intros; apply (continuity_pt_inv f x (H x) (H0 x)).
+  unfold continuity; intros; apply (continuity_pt_inv f x (H x) (H0 x)).
 Qed.
 
 Lemma continuity_div :
@@ -245,14 +243,14 @@ Lemma continuity_div :
     continuity f1 ->
     continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2).
 Proof.
-  unfold continuity in |- *; intros;
+  unfold continuity; intros;
     apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)).
 Qed.
 
 Lemma continuity_comp :
   forall f1 f2, continuity f1 -> continuity f2 -> continuity (f2 o f1).
 Proof.
-  unfold continuity in |- *; intros.
+  unfold continuity; intros.
   apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))).
 Qed.
 
@@ -276,12 +274,12 @@ Definition derivable f := forall x:R, derivable_pt f x.
 Definition derive_pt f (x:R) (pr:derivable_pt f x) := proj1_sig pr.
 Definition derive f (pr:derivable f) (x:R) := derive_pt f x (pr x).
 
-Arguments Scope derivable_pt_lim [Rfun_scope R_scope].
-Arguments Scope derivable_pt_abs [Rfun_scope R_scope R_scope].
-Arguments Scope derivable_pt [Rfun_scope R_scope].
-Arguments Scope derivable [Rfun_scope].
-Arguments Scope derive_pt [Rfun_scope R_scope _].
-Arguments Scope derive [Rfun_scope _].
+Arguments derivable_pt_lim f%F x%R l.
+Arguments derivable_pt_abs f%F (x l)%R.
+Arguments derivable_pt f%F x%R.
+Arguments derivable f%F.
+Arguments derive_pt f%F x%R pr.
+Arguments derive f%F pr x.
 
 Definition antiderivative f (g:R -> R) (a b:R) : Prop :=
   (forall x:R,
@@ -309,23 +307,23 @@ Proof.
     apply
       (single_limit (fun h:R => (f (x + h) - f x) / h) (
         fun h:R => h <> 0) l1 l2 0); try assumption.
-  unfold adhDa in |- *; intros; exists (alp / 2).
+  unfold adhDa; intros; exists (alp / 2).
   split.
-  unfold Rdiv in |- *; apply prod_neq_R0.
-  red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
+  unfold Rdiv; apply prod_neq_R0.
+  red; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
   apply Rinv_neq_0_compat; discrR.
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
-    rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite Rabs_mult.
+  unfold R_dist; unfold Rminus; rewrite Ropp_0;
+    rewrite Rplus_0_r; unfold Rdiv; rewrite Rabs_mult.
   replace (Rabs (/ 2)) with (/ 2).
   replace (Rabs alp) with alp.
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
   rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
     [ idtac | discrR ]; rewrite Rmult_1_r; rewrite double;
-      pattern alp at 1 in |- *; replace alp with (alp + 0);
+      pattern alp at 1; replace alp with (alp + 0);
         [ idtac | ring ]; apply Rplus_lt_compat_l; assumption.
-  symmetry  in |- *; apply Rabs_right; left; assumption.
-  symmetry  in |- *; apply Rabs_right; left; change (0 < / 2) in |- *;
+  symmetry ; apply Rabs_right; left; assumption.
+  symmetry ; apply Rabs_right; left; change (0 < / 2);
     apply Rinv_0_lt_compat; prove_sup0.
 Qed.
 
@@ -334,14 +332,14 @@ Lemma uniqueness_step2 :
     derivable_pt_lim f x l ->
     limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0.
 Proof.
-  unfold derivable_pt_lim in |- *; intros; unfold limit1_in in |- *;
-    unfold limit_in in |- *; intros.
+  unfold derivable_pt_lim; intros; unfold limit1_in;
+    unfold limit_in; intros.
   assert (H1 := H eps H0).
   elim H1; intros.
   exists (pos x0).
   split.
   apply (cond_pos x0).
-  simpl in |- *; unfold R_dist in |- *; intros.
+  simpl; unfold R_dist; intros.
   elim H3; intros.
   apply H2;
     [ assumption
@@ -354,15 +352,15 @@ Lemma uniqueness_step3 :
     limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 ->
     derivable_pt_lim f x l.
 Proof.
-  unfold limit1_in, derivable_pt_lim in |- *; unfold limit_in in |- *;
-    unfold dist in |- *; simpl in |- *; intros.
+  unfold limit1_in, derivable_pt_lim; unfold limit_in;
+    unfold dist; simpl; intros.
   elim (H eps H0).
   intros; elim H1; intros.
   exists (mkposreal x0 H2).
-  simpl in |- *; intros; unfold R_dist in H3; apply (H3 h).
+  simpl; intros; unfold R_dist in H3; apply (H3 h).
   split;
     [ assumption
-      | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assumption ].
+      | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; assumption ].
 Qed.
 
 Lemma uniqueness_limite :
@@ -385,8 +383,8 @@ Proof.
     assumption.
   intro; assert (H1 := proj2_sig pr); unfold derivable_pt_abs in H1.
   assert (H2 := uniqueness_limite _ _ _ _ H H1).
-  unfold derive_pt in |- *; unfold derivable_pt_abs in |- *.
-  symmetry  in |- *; assumption.
+  unfold derive_pt; unfold derivable_pt_abs.
+  symmetry ; assumption.
 Qed.
 
 (**********)
@@ -416,25 +414,25 @@ Lemma derive_pt_D_in :
     D_in f df no_cond x <-> derive_pt f x pr = df x.
 Proof.
   intros; split.
-  unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
-    simpl in |- *; unfold R_dist in |- *; intros.
+  unfold D_in; unfold limit1_in; unfold limit_in;
+    simpl; unfold R_dist; intros.
   apply derive_pt_eq_0.
-  unfold derivable_pt_lim in |- *.
+  unfold derivable_pt_lim.
   intros; elim (H eps H0); intros alpha H1; elim H1; intros;
     exists (mkposreal alpha H2); intros; generalize (H3 (x + h));
       intro; cut (x + h - x = h);
         [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha);
           [ intro; generalize (H6 H8); rewrite H7; intro; assumption
             | split;
-              [ unfold D_x in |- *; split;
-                [ unfold no_cond in |- *; trivial
+              [ unfold D_x; split;
+                [ unfold no_cond; trivial
                   | apply Rminus_not_eq_right; rewrite H7; assumption ]
                 | rewrite H7; assumption ] ]
           | ring ].
   intro.
   assert (H0 := derive_pt_eq_1 f x (df x) pr H).
-  unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
-    unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+  unfold D_in; unfold limit1_in; unfold limit_in;
+    unfold dist; simpl; unfold R_dist;
       intros.
   elim (H0 eps H1); intros alpha H2; exists (pos alpha); split.
   apply (cond_pos alpha).
@@ -450,24 +448,24 @@ Lemma derivable_pt_lim_D_in :
     D_in f df no_cond x <-> derivable_pt_lim f x (df x).
 Proof.
   intros; split.
-  unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
-    simpl in |- *; unfold R_dist in |- *; intros.
-  unfold derivable_pt_lim in |- *.
+  unfold D_in; unfold limit1_in; unfold limit_in;
+    simpl; unfold R_dist; intros.
+  unfold derivable_pt_lim.
   intros; elim (H eps H0); intros alpha H1; elim H1; intros;
     exists (mkposreal alpha H2); intros; generalize (H3 (x + h));
       intro; cut (x + h - x = h);
         [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha);
           [ intro; generalize (H6 H8); rewrite H7; intro; assumption
             | split;
-              [ unfold D_x in |- *; split;
-                [ unfold no_cond in |- *; trivial
+              [ unfold D_x; split;
+                [ unfold no_cond; trivial
                   | apply Rminus_not_eq_right; rewrite H7; assumption ]
                 | rewrite H7; assumption ] ]
           | ring ].
   intro.
   unfold derivable_pt_lim in H.
-  unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
-    unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+  unfold D_in; unfold limit1_in; unfold limit_in;
+    unfold dist; simpl; unfold R_dist;
       intros.
   elim (H eps H0); intros alpha H2; exists (pos alpha); split.
   apply (cond_pos alpha).
@@ -488,7 +486,7 @@ Lemma derivable_derive :
   forall f (x:R) (pr:derivable_pt f x),  exists l : R, derive_pt f x pr = l.
 Proof.
   intros; exists (proj1_sig pr).
-  unfold derive_pt in |- *; reflexivity.
+  unfold derive_pt; reflexivity.
 Qed.
 
 Theorem derivable_continuous_pt :
@@ -503,14 +501,14 @@ Proof.
   generalize (derive_pt_D_in f (fct_cte l) x); intro.
   elim (H2 X); intros.
   generalize (H4 H1); intro.
-  unfold continuity_pt in |- *.
+  unfold continuity_pt.
   apply (cont_deriv f (fct_cte l) no_cond x H5).
-  unfold fct_cte in |- *; reflexivity.
+  unfold fct_cte; reflexivity.
 Qed.
 
 Theorem derivable_continuous : forall f, derivable f -> continuity f.
 Proof.
-  unfold derivable, continuity in |- *; intros f X x.
+  unfold derivable, continuity; intros f X x.
   apply (derivable_continuous_pt f x (X x)).
 Qed.
 
@@ -526,7 +524,7 @@ Lemma derivable_pt_lim_plus :
   apply uniqueness_step3.
   assert (H1 := uniqueness_step2 _ _ _ H).
   assert (H2 := uniqueness_step2 _ _ _ H0).
-  unfold plus_fct in |- *.
+  unfold plus_fct.
   cut
     (forall h:R,
       (f1 (x + h) + f2 (x + h) - (f1 x + f2 x)) / h =
@@ -535,15 +533,15 @@ Lemma derivable_pt_lim_plus :
   generalize
     (limit_plus (fun h':R => (f1 (x + h') - f1 x) / h')
       (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2).
-  unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
-    simpl in |- *; unfold R_dist in |- *; intros.
+  unfold limit1_in; unfold limit_in; unfold dist;
+    simpl; unfold R_dist; intros.
   elim (H4 eps H5); intros.
   exists x0.
   elim H6; intros.
   split.
   assumption.
   intros; rewrite H3; apply H8; assumption.
-  intro; unfold Rdiv in |- *; ring.
+  intro; unfold Rdiv; ring.
 Qed.
 
 Lemma derivable_pt_lim_opp :
@@ -552,20 +550,20 @@ Proof.
   intros.
   apply uniqueness_step3.
   assert (H1 := uniqueness_step2 _ _ _ H).
-  unfold opp_fct in |- *.
+  unfold opp_fct.
   cut (forall h:R, (- f (x + h) - - f x) / h = - ((f (x + h) - f x) / h)).
   intro.
   generalize
     (limit_Ropp (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 H1).
-  unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
-    simpl in |- *; unfold R_dist in |- *; intros.
+  unfold limit1_in; unfold limit_in; unfold dist;
+    simpl; unfold R_dist; intros.
   elim (H2 eps H3); intros.
   exists x0.
   elim H4; intros.
   split.
   assumption.
   intros; rewrite H0; apply H6; assumption.
-  intro; unfold Rdiv in |- *; ring.
+  intro; unfold Rdiv; ring.
 Qed.
 
 Lemma derivable_pt_lim_minus :
@@ -577,7 +575,7 @@ Proof.
   apply uniqueness_step3.
   assert (H1 := uniqueness_step2 _ _ _ H).
   assert (H2 := uniqueness_step2 _ _ _ H0).
-  unfold minus_fct in |- *.
+  unfold minus_fct.
   cut
     (forall h:R,
       (f1 (x + h) - f1 x) / h - (f2 (x + h) - f2 x) / h =
@@ -586,15 +584,15 @@ Proof.
   generalize
     (limit_minus (fun h':R => (f1 (x + h') - f1 x) / h')
       (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2).
-  unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
-    simpl in |- *; unfold R_dist in |- *; intros.
+  unfold limit1_in; unfold limit_in; unfold dist;
+    simpl; unfold R_dist; intros.
   elim (H4 eps H5); intros.
   exists x0.
   elim H6; intros.
   split.
   assumption.
   intros; rewrite <- H3; apply H8; assumption.
-  intro; unfold Rdiv in |- *; ring.
+  intro; unfold Rdiv; ring.
 Qed.
 
 Lemma derivable_pt_lim_mult :
@@ -617,15 +615,15 @@ Proof.
   elim H1; intros.
   clear H1 H3.
   apply H2.
-  unfold mult_fct in |- *.
+  unfold mult_fct.
   apply (Dmult no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption.
 Qed.
 
 Lemma derivable_pt_lim_const : forall a x:R, derivable_pt_lim (fct_cte a) x 0.
 Proof.
-  intros; unfold fct_cte, derivable_pt_lim in |- *.
-  intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus in |- *;
-    rewrite Rplus_opp_r; unfold Rdiv in |- *; rewrite Rmult_0_l;
+  intros; unfold fct_cte, derivable_pt_lim.
+  intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus;
+    rewrite Rplus_opp_r; unfold Rdiv; rewrite Rmult_0_l;
       rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
 Qed.
 
@@ -638,34 +636,34 @@ Proof.
   replace (mult_real_fct a f) with (fct_cte a * f)%F.
   replace (a * l) with (0 * f x + a * l); [ idtac | ring ].
   apply (derivable_pt_lim_mult (fct_cte a) f x 0 l); assumption.
-  unfold mult_real_fct, mult_fct, fct_cte in |- *; reflexivity.
+  unfold mult_real_fct, mult_fct, fct_cte; reflexivity.
 Qed.
 
 Lemma derivable_pt_lim_id : forall x:R, derivable_pt_lim id x 1.
 Proof.
-  intro; unfold derivable_pt_lim in |- *.
+  intro; unfold derivable_pt_lim.
   intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2;
-    unfold id in |- *; replace ((x + h - x) / h - 1) with 0.
+    unfold id; replace ((x + h - x) / h - 1) with 0.
   rewrite Rabs_R0; apply Rle_lt_trans with (Rabs h).
   apply Rabs_pos.
   assumption.
-  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite (Rplus_comm x);
+  unfold Rminus; rewrite Rplus_assoc; rewrite (Rplus_comm x);
     rewrite Rplus_assoc.
-  rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv in |- *;
+  rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv;
     rewrite <- Rinv_r_sym.
-  symmetry  in |- *; apply Rplus_opp_r.
+  symmetry ; apply Rplus_opp_r.
   assumption.
 Qed.
 
 Lemma derivable_pt_lim_Rsqr : forall x:R, derivable_pt_lim Rsqr x (2 * x).
 Proof.
-  intro; unfold derivable_pt_lim in |- *.
-  unfold Rsqr in |- *; intros eps Heps; exists (mkposreal eps Heps);
+  intro; unfold derivable_pt_lim.
+  unfold Rsqr; intros eps Heps; exists (mkposreal eps Heps);
     intros h H1 H2; replace (((x + h) * (x + h) - x * x) / h - 2 * x) with h.
   assumption.
   replace ((x + h) * (x + h) - x * x) with (2 * x * h + h * h);
   [ idtac | ring ].
-  unfold Rdiv in |- *; rewrite Rmult_plus_distr_r.
+  unfold Rdiv; rewrite Rmult_plus_distr_r.
   repeat rewrite Rmult_assoc.
   repeat rewrite <- Rinv_r_sym; [ idtac | assumption ].
   ring.
@@ -686,7 +684,7 @@ Proof.
   assert (H1 := derivable_pt_lim_D_in (f2 o f1)%F (fun y:R => l2 * l1) x).
   elim H1; intros.
   clear H1 H3; apply H2.
-  unfold comp in |- *;
+  unfold comp;
     cut
       (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1)
         (Dgf no_cond no_cond f1) x ->
@@ -695,14 +693,14 @@ Proof.
   rewrite Rmult_comm;
     apply (Dcomp no_cond no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x);
       assumption.
-  unfold Dgf, D_in, no_cond in |- *; unfold limit1_in in |- *;
-    unfold limit_in in |- *; unfold dist in |- *; simpl in |- *;
-      unfold R_dist in |- *; intros.
+  unfold Dgf, D_in, no_cond; unfold limit1_in;
+    unfold limit_in; unfold dist; simpl;
+      unfold R_dist; intros.
   elim (H1 eps H3); intros.
   exists x0; intros; split.
   elim H5; intros; assumption.
   intros; elim H5; intros; apply H9; split.
-  unfold D_x in |- *; split.
+  unfold D_x; split.
   split; trivial.
   elim H6; intros; unfold D_x in H10; elim H10; intros; assumption.
   elim H6; intros; assumption.
@@ -712,7 +710,7 @@ Lemma derivable_pt_plus :
   forall f1 f2 (x:R),
     derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 + f2) x.
 Proof.
-  unfold derivable_pt in |- *; intros f1 f2 x X X0.
+  unfold derivable_pt; intros f1 f2 x X X0.
   elim X; intros.
   elim X0; intros.
   exists (x0 + x1).
@@ -722,7 +720,7 @@ Qed.
 Lemma derivable_pt_opp :
   forall f (x:R), derivable_pt f x -> derivable_pt (- f) x.
 Proof.
-  unfold derivable_pt in |- *; intros f x X.
+  unfold derivable_pt; intros f x X.
   elim X; intros.
   exists (- x0).
   apply derivable_pt_lim_opp; assumption.
@@ -732,7 +730,7 @@ Lemma derivable_pt_minus :
   forall f1 f2 (x:R),
     derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 - f2) x.
 Proof.
-  unfold derivable_pt in |- *; intros f1 f2 x X X0.
+  unfold derivable_pt; intros f1 f2 x X X0.
   elim X; intros.
   elim X0; intros.
   exists (x0 - x1).
@@ -743,7 +741,7 @@ Lemma derivable_pt_mult :
   forall f1 f2 (x:R),
     derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 * f2) x.
 Proof.
-  unfold derivable_pt in |- *; intros f1 f2 x X X0.
+  unfold derivable_pt; intros f1 f2 x X X0.
   elim X; intros.
   elim X0; intros.
   exists (x0 * f2 x + f1 x * x1).
@@ -752,7 +750,7 @@ Qed.
 
 Lemma derivable_pt_const : forall a x:R, derivable_pt (fct_cte a) x.
 Proof.
-  intros; unfold derivable_pt in |- *.
+  intros; unfold derivable_pt.
   exists 0.
   apply derivable_pt_lim_const.
 Qed.
@@ -760,7 +758,7 @@ Qed.
 Lemma derivable_pt_scal :
   forall f (a x:R), derivable_pt f x -> derivable_pt (mult_real_fct a f) x.
 Proof.
-  unfold derivable_pt in |- *; intros f1 a x X.
+  unfold derivable_pt; intros f1 a x X.
   elim X; intros.
   exists (a * x0).
   apply derivable_pt_lim_scal; assumption.
@@ -768,14 +766,14 @@ Qed.
 
 Lemma derivable_pt_id : forall x:R, derivable_pt id x.
 Proof.
-  unfold derivable_pt in |- *; intro.
+  unfold derivable_pt; intro.
   exists 1.
   apply derivable_pt_lim_id.
 Qed.
 
 Lemma derivable_pt_Rsqr : forall x:R, derivable_pt Rsqr x.
 Proof.
-  unfold derivable_pt in |- *; intro; exists (2 * x).
+  unfold derivable_pt; intro; exists (2 * x).
   apply derivable_pt_lim_Rsqr.
 Qed.
 
@@ -783,7 +781,7 @@ Lemma derivable_pt_comp :
   forall f1 f2 (x:R),
     derivable_pt f1 x -> derivable_pt f2 (f1 x) -> derivable_pt (f2 o f1) x.
 Proof.
-  unfold derivable_pt in |- *; intros f1 f2 x X X0.
+  unfold derivable_pt; intros f1 f2 x X X0.
   elim X; intros.
   elim X0; intros.
   exists (x1 * x0).
@@ -793,57 +791,57 @@ Qed.
 Lemma derivable_plus :
   forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2).
 Proof.
-  unfold derivable in |- *; intros f1 f2 X X0 x.
+  unfold derivable; intros f1 f2 X X0 x.
   apply (derivable_pt_plus _ _ x (X _) (X0 _)).
 Qed.
 
 Lemma derivable_opp : forall f, derivable f -> derivable (- f).
 Proof.
-  unfold derivable in |- *; intros f X x.
+  unfold derivable; intros f X x.
   apply (derivable_pt_opp _ x (X _)).
 Qed.
 
 Lemma derivable_minus :
   forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2).
 Proof.
-  unfold derivable in |- *; intros f1 f2 X X0 x.
+  unfold derivable; intros f1 f2 X X0 x.
   apply (derivable_pt_minus _ _ x (X _) (X0 _)).
 Qed.
 
 Lemma derivable_mult :
   forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 * f2).
 Proof.
-  unfold derivable in |- *; intros f1 f2 X X0 x.
+  unfold derivable; intros f1 f2 X X0 x.
   apply (derivable_pt_mult _ _ x (X _) (X0 _)).
 Qed.
 
 Lemma derivable_const : forall a:R, derivable (fct_cte a).
 Proof.
-  unfold derivable in |- *; intros.
+  unfold derivable; intros.
   apply derivable_pt_const.
 Qed.
 
 Lemma derivable_scal :
   forall f (a:R), derivable f -> derivable (mult_real_fct a f).
 Proof.
-  unfold derivable in |- *; intros f a X x.
+  unfold derivable; intros f a X x.
   apply (derivable_pt_scal _ a x (X _)).
 Qed.
 
 Lemma derivable_id : derivable id.
 Proof.
-  unfold derivable in |- *; intro; apply derivable_pt_id.
+  unfold derivable; intro; apply derivable_pt_id.
 Qed.
 
 Lemma derivable_Rsqr : derivable Rsqr.
 Proof.
-  unfold derivable in |- *; intro; apply derivable_pt_Rsqr.
+  unfold derivable; intro; apply derivable_pt_Rsqr.
 Qed.
 
 Lemma derivable_comp :
   forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1).
 Proof.
-  unfold derivable in |- *; intros f1 f2 X X0 x.
+  unfold derivable; intros f1 f2 X X0 x.
   apply (derivable_pt_comp _ _ x (X _) (X0 _)).
 Qed.
 
@@ -998,13 +996,13 @@ Proof.
   elim (lt_irrefl _ H).
   cut (n = 0%nat \/ (0 < n)%nat).
   intro; elim H0; intro.
-  rewrite H1; simpl in |- *.
+  rewrite H1; simpl.
   replace (fun y:R => y * 1) with (id * fct_cte 1)%F.
   replace (1 * 1) with (1 * fct_cte 1 x + id x * 0).
   apply derivable_pt_lim_mult.
   apply derivable_pt_lim_id.
   apply derivable_pt_lim_const.
-  unfold fct_cte, id in |- *; ring.
+  unfold fct_cte, id; ring.
   reflexivity.
   replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n).
   replace (pred (S n)) with n; [ idtac | reflexivity ].
@@ -1013,13 +1011,13 @@ Proof.
   replace (INR (S n) * x ^ n) with (1 * f x + id x * (INR n * x ^ pred n)).
   apply derivable_pt_lim_mult.
   apply derivable_pt_lim_id.
-  unfold f in |- *; apply Hrecn; assumption.
-  unfold f in |- *.
-  pattern n at 1 5 in |- *; replace n with (S (pred n)).
-  unfold id in |- *; rewrite S_INR; simpl in |- *.
+  unfold f; apply Hrecn; assumption.
+  unfold f.
+  pattern n at 1 5; replace n with (S (pred n)).
+  unfold id; rewrite S_INR; simpl.
   ring.
-  symmetry  in |- *; apply S_pred with 0%nat; assumption.
-  unfold mult_fct, id in |- *; reflexivity.
+  symmetry ; apply S_pred with 0%nat; assumption.
+  unfold mult_fct, id; reflexivity.
   reflexivity.
   inversion H.
   left; reflexivity.
@@ -1035,7 +1033,7 @@ Lemma derivable_pt_lim_pow :
 Proof.
   intros.
   induction  n as [| n Hrecn].
-  simpl in |- *.
+  simpl.
   rewrite Rmult_0_l.
   replace (fun _:R => 1) with (fct_cte 1);
   [ apply derivable_pt_lim_const | reflexivity ].
@@ -1046,14 +1044,14 @@ Qed.
 Lemma derivable_pt_pow :
   forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x.
 Proof.
-  intros; unfold derivable_pt in |- *.
+  intros; unfold derivable_pt.
   exists (INR n * x ^ pred n).
   apply derivable_pt_lim_pow.
 Qed.
 
 Lemma derivable_pow : forall n:nat, derivable (fun y:R => y ^ n).
 Proof.
-  intro; unfold derivable in |- *; intro; apply derivable_pt_pow.
+  intro; unfold derivable; intro; apply derivable_pt_pow.
 Qed.
 
 Lemma derive_pt_pow :
@@ -1075,7 +1073,7 @@ Proof.
   elim pr2; intros.
   unfold derivable_pt_abs in p.
   unfold derivable_pt_abs in p0.
-  simpl in |- *.
+  simpl.
   apply (uniqueness_limite f x x0 x1 p p0).
 Qed.
 
@@ -1096,7 +1094,7 @@ Proof.
   assert (H5 := derive_pt_eq_1 f c l pr H4).
   cut (0 < l / 2);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
   elim (H5 (l / 2) H6); intros delta H7.
   cut (0 < (b - c) / 2).
@@ -1121,7 +1119,7 @@ Proof.
       (Rabs
         ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
           Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2).
-  unfold Rabs in |- *;
+  unfold Rabs;
     case
     (Rcase_abs
       ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
@@ -1159,7 +1157,7 @@ Proof.
               (Rlt_le_trans 0
                 ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
                   Rmin (delta / 2) ((b + - c) / 2)) 0 H22 H16)).
-  pattern l at 2 in |- *; rewrite double_var.
+  pattern l at 2; rewrite double_var.
   ring.
   ring.
   intro.
@@ -1185,7 +1183,7 @@ Proof.
         l +
         -
         ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) /
-          Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat;
+          Rmin (delta / 2) ((b + - c) / 2))); apply Rplus_lt_le_0_compat;
       [ assumption
         | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ].
   unfold Rminus; ring.
@@ -1197,13 +1195,13 @@ Proof.
     ((f c - f (c + Rmin (delta / 2) ((b - c) / 2))) /
       Rmin (delta / 2) ((b - c) / 2))).
   rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge;
-    unfold Rdiv in |- *; apply Rmult_le_pos;
+    unfold Rdiv; apply Rmult_le_pos;
       [ generalize
         (Rplus_le_compat_r (- f (c + Rmin (delta * / 2) ((b - c) * / 2)))
           (f (c + Rmin (delta * / 2) ((b - c) * / 2))) (
             f c) H15); rewrite Rplus_opp_r; intro; assumption
         | left; apply Rinv_0_lt_compat; assumption ].
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   rewrite <- Ropp_mult_distr_l_reverse.
   repeat rewrite <- (Rmult_comm (/ Rmin (delta * / 2) ((b - c) * / 2))).
   apply Rmult_eq_reg_l with (Rmin (delta * / 2) ((b - c) * / 2)).
@@ -1211,9 +1209,9 @@ Proof.
   rewrite <- Rinv_r_sym.
   repeat rewrite Rmult_1_l.
   ring.
-  red in |- *; intro.
+  red; intro.
   unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12).
-  red in |- *; intro.
+  red; intro.
   unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12).
   assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)).
   assert
@@ -1227,7 +1225,7 @@ Proof.
   replace (2 * b) with (b + b).
   apply Rplus_lt_compat_r; assumption.
   ring.
-  unfold Rdiv in |- *; rewrite Rmult_plus_distr_l.
+  unfold Rdiv; rewrite Rmult_plus_distr_l.
   repeat rewrite (Rmult_comm 2).
   rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r.
@@ -1235,51 +1233,51 @@ Proof.
   discrR.
   apply Rlt_trans with c.
   assumption.
-  pattern c at 1 in |- *; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l;
+  pattern c at 1; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l;
     assumption.
   cut (0 < delta / 2).
   intro;
     apply
       (Rmin_stable_in_posreal (mkposreal (delta / 2) H12)
         (mkposreal ((b - c) / 2) H8)).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
-  unfold Rabs in |- *; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))).
+  unfold Rabs; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))).
   intro.
   cut (0 < delta / 2).
   intro.
   generalize
     (Rmin_stable_in_posreal (mkposreal (delta / 2) H10)
-      (mkposreal ((b - c) / 2) H8)); simpl in |- *; intro;
+      (mkposreal ((b - c) / 2) H8)); simpl; intro;
     elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 r)).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
   intro; apply Rle_lt_trans with (delta / 2).
   apply Rmin_l.
-  unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+  unfold Rdiv; apply Rmult_lt_reg_l with 2.
   prove_sup0.
   rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l.
   replace (2 * delta) with (delta + delta).
-  pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta);
+  pattern delta at 2; rewrite <- (Rplus_0_r delta);
     apply Rplus_lt_compat_l.
   rewrite Rplus_0_r; apply (cond_pos delta).
-  symmetry  in |- *; apply double.
+  symmetry ; apply double.
   discrR.
   cut (0 < delta / 2).
   intro;
     generalize
       (Rmin_stable_in_posreal (mkposreal (delta / 2) H9)
-        (mkposreal ((b - c) / 2) H8)); simpl in |- *;
-      intro; red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        (mkposreal ((b - c) / 2) H8)); simpl;
+      intro; red; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   generalize (Rplus_lt_compat_r (- c) c b H0); rewrite Rplus_opp_r; intro;
     assumption.
   apply Rinv_0_lt_compat; prove_sup0.
   elim H2; intro.
-  symmetry  in |- *; assumption.
+  symmetry ; assumption.
   generalize (derivable_derive f c pr); intro; elim H4; intros l H5.
   rewrite H5 in H3; generalize (derive_pt_eq_1 f c l pr H5); intro;
     cut (0 < - (l / 2)).
@@ -1309,7 +1307,7 @@ Proof.
         ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
           Rmax (- (delta / 2)) ((a + - c) / 2) + - l) <
         - (l / 2)).
-  unfold Rabs in |- *;
+  unfold Rabs;
     case
     (Rcase_abs
       ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
@@ -1341,12 +1339,12 @@ Proof.
                 Rmax (- (delta / 2)) ((a - c) / 2)) 0 H17 H23)).
   rewrite <- (Ropp_involutive (l / 2)); rewrite <- Ropp_0;
     apply Ropp_lt_gt_contravar; assumption.
-  pattern l at 3 in |- *; rewrite double_var.
+  pattern l at 3; rewrite double_var.
   ring.
   assumption.
   apply Rplus_le_lt_0_compat; assumption.
   rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
-  unfold Rdiv in |- *;
+  unfold Rdiv;
     replace
     ((f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) *
       / Rmax (- (delta * / 2)) ((a - c) * / 2)) with
@@ -1363,7 +1361,7 @@ Proof.
   ring.
   left; apply Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar;
     assumption.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   rewrite <- Ropp_inv_permute.
   rewrite Rmult_opp_opp.
   reflexivity.
@@ -1382,7 +1380,7 @@ Proof.
   apply Rplus_lt_compat_l; assumption.
   field; discrR.
   assumption.
-  unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))).
+  unfold Rabs; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))).
   intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro;
     generalize
       (Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2))
@@ -1392,10 +1390,10 @@ Proof.
   assumption.
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
-  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+  unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
     rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l; rewrite double.
-  pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta);
+  pattern delta at 2; rewrite <- (Rplus_0_r delta);
     apply Rplus_lt_compat_l; rewrite Rplus_0_r; apply (cond_pos delta).
   discrR.
   cut (- (delta / 2) < 0).
@@ -1403,7 +1401,7 @@ Proof.
   intros;
     generalize
       (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13)
-        (mknegreal ((a - c) / 2) H12)); simpl in |- *;
+        (mknegreal ((a - c) / 2) H12)); simpl;
       intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r);
         intro;
           elim
@@ -1412,41 +1410,41 @@ Proof.
   rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2));
     apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2).
   assumption.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   rewrite <- Ropp_mult_distr_l_reverse.
   rewrite (Ropp_minus_distr a c).
   reflexivity.
-  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *;
+  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv;
     apply Rmult_lt_0_compat;
       [ apply (cond_pos delta)
         | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
-  red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
+  red; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
   cut ((a - c) / 2 < 0).
   intro; cut (- (delta / 2) < 0).
   intro;
     apply
       (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H11)
         (mknegreal ((a - c) / 2) H10)).
-  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *;
+  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv;
     apply Rmult_lt_0_compat;
       [ apply (cond_pos delta)
         | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
   rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2));
     apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2).
   assumption.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   rewrite <- Ropp_mult_distr_l_reverse.
   rewrite (Ropp_minus_distr a c).
   reflexivity.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ generalize (Rplus_lt_compat_r (- a) a c H); rewrite Rplus_opp_r; intro;
       assumption
       | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
   replace (- (l / 2)) with (- l / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
   assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ].
-  unfold Rdiv in |- *; apply Ropp_mult_distr_l_reverse.
+  unfold Rdiv; apply Ropp_mult_distr_l_reverse.
 Qed.
 
 Theorem deriv_minimum :
@@ -1462,7 +1460,7 @@ Proof.
   cut (forall x:R, a < x -> x < b -> (- f)%F x <= (- f)%F c).
   intro.
   apply (deriv_maximum (- f)%F a b c (derivable_pt_opp _ _ pr) H H0 H2).
-  intros; unfold opp_fct in |- *; apply Ropp_ge_le_contravar; apply Rle_ge.
+  intros; unfold opp_fct; apply Ropp_ge_le_contravar; apply Rle_ge.
   apply (H1 x H2 H3).
 Qed.
 
@@ -1495,7 +1493,7 @@ Proof.
   intro; decompose [and] H7; intros; generalize (H6 (delta / 2) H8 H11);
     cut (0 <= (f (x + delta / 2) - f x) / (delta / 2)).
   intro; cut (0 <= (f (x + delta / 2) - f x) / (delta / 2) - l).
-  intro; unfold Rabs in |- *;
+  intro; unfold Rabs;
     case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
   intro;
     elim
@@ -1504,7 +1502,7 @@ Proof.
   intros;
     generalize
       (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l)
-        (- (l / 2)) H13); unfold Rminus in |- *;
+        (- (l / 2)) H13); unfold Rminus;
       replace (- (l / 2) + l) with (l / 2).
   rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; intro;
     generalize
@@ -1514,50 +1512,50 @@ Proof.
   rewrite <- Ropp_0 in H5;
     generalize (Ropp_lt_gt_contravar (-0) (- (l / 2)) H5);
       repeat rewrite Ropp_involutive; intro; assumption.
-  pattern l at 3 in |- *; rewrite double_var.
+  pattern l at 3; rewrite double_var.
   ring.
-  unfold Rminus in |- *; apply Rplus_le_le_0_compat.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Rminus; apply Rplus_le_le_0_compat.
+  unfold Rdiv; apply Rmult_le_pos.
   cut (x <= x + delta * / 2).
   intro; generalize (H x (x + delta * / 2) H12); intro;
     generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H13);
       rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
-  pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+  pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
     left; assumption.
   left; apply Rinv_0_lt_compat; assumption.
   left; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Rdiv; apply Rmult_le_pos.
   cut (x <= x + delta * / 2).
   intro; generalize (H x (x + delta * / 2) H9); intro;
     generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12);
       rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
-  pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+  pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
     left; assumption.
   left; apply Rinv_0_lt_compat; assumption.
   split.
-  unfold Rdiv in |- *; apply prod_neq_R0.
-  generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H7;
+  unfold Rdiv; apply prod_neq_R0.
+  generalize (cond_pos delta); intro; red; intro H9; rewrite H9 in H7;
     elim (Rlt_irrefl 0 H7).
   apply Rinv_neq_0_compat; discrR.
   split.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
   replace (Rabs (delta / 2)) with (delta / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+  unfold Rdiv; apply Rmult_lt_reg_l with 2.
   prove_sup0.
   rewrite (Rmult_comm 2).
   rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
   rewrite Rmult_1_r.
   rewrite double.
-  pattern (pos delta) at 1 in |- *; rewrite <- Rplus_0_r.
+  pattern (pos delta) at 1; rewrite <- Rplus_0_r.
   apply Rplus_lt_compat_l; apply (cond_pos delta).
-  symmetry  in |- *; apply Rabs_right.
-  left; change (0 < delta / 2) in |- *; unfold Rdiv in |- *;
+  symmetry ; apply Rabs_right.
+  left; change (0 < delta / 2); unfold Rdiv;
     apply Rmult_lt_0_compat;
       [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
-  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse;
+  unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse;
     apply Rmult_lt_0_compat.
   apply Rplus_lt_reg_r with l.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption.
   apply Rinv_0_lt_compat; prove_sup0.
 Qed.
diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v
index fcff9a01..3c15a305 100644
--- a/theories/Reals/Ranalysis2.v
+++ b/theories/Reals/Ranalysis2.v
@@ -1,17 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis2.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Ranalysis1.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (**********)
 Lemma formule :
@@ -26,7 +24,7 @@ Lemma formule :
     f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2) +
     l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x).
 Proof.
-  intros; unfold Rdiv, Rminus, Rsqr in |- *.
+  intros; unfold Rdiv, Rminus, Rsqr.
   repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
     repeat rewrite Rinv_mult_distr; try assumption.
   replace (l1 * f2 x * (/ f2 x * / f2 x)) with (l1 * / f2 x * (f2 x * / f2 x));
@@ -83,10 +81,10 @@ Proof.
   rewrite Rabs_Rinv; [ left; exact H7 | assumption ].
   apply Rlt_le_trans with (2 / Rabs (f2 x) * Rabs (eps * f2 x / 8)).
   apply Rmult_lt_compat_l.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ].
   exact H8.
-  right; unfold Rdiv in |- *.
+  right; unfold Rdiv.
   repeat rewrite Rabs_mult.
   rewrite Rabs_Rinv; discrR.
   replace (Rabs 8) with 8.
@@ -98,8 +96,8 @@ Proof.
   replace (Rabs eps) with eps.
   repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
   ring.
-  symmetry  in |- *; apply Rabs_right; left; assumption.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup.
+  symmetry ; apply Rabs_right; left; assumption.
+  symmetry ; apply Rabs_right; left; prove_sup.
 Qed.
 
 Lemma maj_term2 :
@@ -131,11 +129,11 @@ Proof.
     (Rabs (2 * (l1 / (f2 x * f2 x))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))).
   apply Rmult_lt_compat_r.
   apply Rabs_pos_lt.
-  unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
+  unfold Rdiv; unfold Rsqr; repeat apply prod_neq_R0;
     try assumption || discrR.
-  red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
+  red; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
   apply Rinv_neq_0_compat; apply prod_neq_R0; try assumption || discrR.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   repeat rewrite Rinv_mult_distr; try assumption.
   repeat rewrite Rabs_mult.
   replace (Rabs 2) with 2.
@@ -149,9 +147,9 @@ Proof.
   repeat rewrite Rabs_Rinv; try assumption.
   rewrite <- (Rmult_comm 2).
   unfold Rdiv in H8; exact H8.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
+  symmetry ; apply Rabs_right; left; prove_sup0.
   right.
-  unfold Rsqr, Rdiv in |- *.
+  unfold Rsqr, Rdiv.
   do 1 rewrite Rinv_mult_distr; try assumption || discrR.
   do 1 rewrite Rinv_mult_distr; try assumption || discrR.
   repeat rewrite Rabs_mult.
@@ -168,9 +166,9 @@ Proof.
     (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ].
   repeat rewrite <- Rinv_r_sym; try (apply Rabs_no_R0; assumption) || discrR.
   ring.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup.
-  symmetry  in |- *; apply Rabs_right; left; assumption.
+  symmetry ; apply Rabs_right; left; prove_sup0.
+  symmetry ; apply Rabs_right; left; prove_sup.
+  symmetry ; apply Rabs_right; left; assumption.
 Qed.
 
 Lemma maj_term3 :
@@ -206,11 +204,11 @@ Proof.
     (Rabs (2 * (f1 x / (f2 x * f2 x))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))).
   apply Rmult_lt_compat_r.
   apply Rabs_pos_lt.
-  unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
+  unfold Rdiv; unfold Rsqr; repeat apply prod_neq_R0;
     try assumption.
-  red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
+  red; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
   apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   repeat rewrite Rinv_mult_distr; try assumption.
   repeat rewrite Rabs_mult.
   replace (Rabs 2) with 2.
@@ -224,9 +222,9 @@ Proof.
   repeat rewrite Rabs_Rinv; assumption || idtac.
   rewrite <- (Rmult_comm 2).
   unfold Rdiv in H9; exact H9.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
+  symmetry ; apply Rabs_right; left; prove_sup0.
   right.
-  unfold Rsqr, Rdiv in |- *.
+  unfold Rsqr, Rdiv.
   rewrite Rinv_mult_distr; try assumption || discrR.
   rewrite Rinv_mult_distr; try assumption || discrR.
   repeat rewrite Rabs_mult.
@@ -243,9 +241,9 @@ Proof.
     (Rabs (f1 x) * / Rabs (f1 x)) * (2 * / 2)); [ idtac | ring ].
   repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
   ring.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup.
-  symmetry  in |- *; apply Rabs_right; left; assumption.
+  symmetry ; apply Rabs_right; left; prove_sup0.
+  symmetry ; apply Rabs_right; left; prove_sup.
+  symmetry ; apply Rabs_right; left; assumption.
 Qed.
 
 Lemma maj_term4 :
@@ -283,17 +281,17 @@ Proof.
       Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
   apply Rmult_lt_compat_r.
   apply Rabs_pos_lt.
-  unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
+  unfold Rdiv; unfold Rsqr; repeat apply prod_neq_R0;
     assumption || idtac.
-  red in |- *; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H).
+  red; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H).
   apply Rinv_neq_0_compat; apply prod_neq_R0.
   apply prod_neq_R0.
   discrR.
   assumption.
   assumption.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   repeat rewrite Rinv_mult_distr;
-    try assumption || (unfold Rsqr in |- *; apply prod_neq_R0; assumption).
+    try assumption || (unfold Rsqr; apply prod_neq_R0; assumption).
   repeat rewrite Rabs_mult.
   replace (Rabs 2) with 2.
   replace
@@ -307,13 +305,13 @@ Proof.
   repeat apply Rmult_lt_compat_l.
   apply Rabs_pos_lt; assumption.
   apply Rabs_pos_lt; assumption.
-  apply Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr in |- *;
+  apply Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr;
     apply prod_neq_R0; assumption.
   repeat rewrite Rabs_Rinv; [ idtac | assumption | assumption ].
   rewrite <- (Rmult_comm 2).
   unfold Rdiv in H10; exact H10.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-  right; unfold Rsqr, Rdiv in |- *.
+  symmetry ; apply Rabs_right; left; prove_sup0.
+  right; unfold Rsqr, Rdiv.
   rewrite Rinv_mult_distr; try assumption || discrR.
   rewrite Rinv_mult_distr; try assumption || discrR.
   rewrite Rinv_mult_distr; try assumption || discrR.
@@ -335,9 +333,9 @@ Proof.
     (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ].
   repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
   ring.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-  symmetry  in |- *; apply Rabs_right; left; prove_sup.
-  symmetry  in |- *; apply Rabs_right; left; assumption.
+  symmetry ; apply Rabs_right; left; prove_sup0.
+  symmetry ; apply Rabs_right; left; prove_sup.
+  symmetry ; apply Rabs_right; left; assumption.
   apply prod_neq_R0; assumption || discrR.
   apply prod_neq_R0; assumption.
 Qed.
@@ -345,11 +343,11 @@ Qed.
 Lemma D_x_no_cond : forall x a:R, a <> 0 -> D_x no_cond x (x + a).
 Proof.
   intros.
-  unfold D_x, no_cond in |- *.
+  unfold D_x, no_cond.
   split.
   trivial.
   apply Rminus_not_eq.
-  unfold Rminus in |- *.
+  unfold Rminus.
   rewrite Ropp_plus_distr.
   rewrite <- Rplus_assoc.
   rewrite Rplus_opp_r.
@@ -396,7 +394,7 @@ Qed.
 Lemma quadruple_var : forall x:R, x = x / 4 + x / 4 + x / 4 + x / 4.
 Proof.
   intro; rewrite <- quadruple.
-  unfold Rdiv in |- *; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR.
+  unfold Rdiv; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR.
   reflexivity.
 Qed.
 
@@ -415,10 +413,10 @@ Proof.
   cut
     (dist R_met (x0 + h) x0 < x ->
       dist R_met (f (x0 + h)) (f x0) < Rabs (f x0 / 2)).
-  unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+  unfold dist; simpl; unfold R_dist;
     replace (x0 + h - x0) with h.
   intros; assert (H7 := H6 H4).
-  red in |- *; intro.
+  red; intro.
   rewrite H8 in H7; unfold Rminus in H7; rewrite Rplus_0_l in H7;
     rewrite Rabs_Ropp in H7; unfold Rdiv in H7; rewrite Rabs_mult in H7;
       pattern (Rabs (f x0)) at 1 in H7; rewrite <- Rmult_1_r in H7.
@@ -431,10 +429,10 @@ Proof.
     rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12;
       [ idtac | discrR ].
   cut (IZR 1 < IZR 2).
-  unfold IZR in |- *; unfold INR, nat_of_P in |- *; simpl in |- *; intro;
+  unfold IZR; unfold INR, Pos.to_nat; simpl; intro;
     elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)).
   apply IZR_lt; omega.
-  unfold Rabs in |- *; case (Rcase_abs (/ 2)); intro.
+  unfold Rabs; case (Rcase_abs (/ 2)); intro.
   assert (Hyp : 0 < 2).
   prove_sup0.
   assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp r); rewrite Rmult_0_r in H11;
@@ -444,18 +442,18 @@ Proof.
   apply (Rabs_pos_lt _ H0).
   ring.
   assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro.
-  intro; rewrite <- H7; unfold dist, R_met in |- *; unfold R_dist in |- *;
-    unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  intro; rewrite <- H7; unfold dist, R_met; unfold R_dist;
+    unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
       apply Rabs_pos_lt.
-  unfold Rdiv in |- *; apply prod_neq_R0;
+  unfold Rdiv; apply prod_neq_R0;
     [ assumption | apply Rinv_neq_0_compat; discrR ].
   intro; apply H5.
   split.
-  unfold D_x, no_cond in |- *.
+  unfold D_x, no_cond.
   split; trivial || assumption.
   assumption.
-  change (0 < Rabs (f x0 / 2)) in |- *.
-  apply Rabs_pos_lt; unfold Rdiv in |- *; apply prod_neq_R0.
+  change (0 < Rabs (f x0 / 2)).
+  apply Rabs_pos_lt; unfold Rdiv; apply prod_neq_R0.
   assumption.
   apply Rinv_neq_0_compat; discrR.
 Qed.
diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v
index c7d95660..5eaf5a57 100644
--- a/theories/Reals/Ranalysis3.v
+++ b/theories/Reals/Ranalysis3.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis3.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Ranalysis1.
 Require Import Ranalysis2.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (** Division *)
 Theorem derivable_pt_lim_div :
@@ -24,17 +22,17 @@ Theorem derivable_pt_lim_div :
 Proof.
   intros f1 f2 x l1 l2 H H0 H1.
   cut (derivable_pt f2 x);
-    [ intro X | unfold derivable_pt in |- *; exists l2; exact H0 ].
+    [ intro X | unfold derivable_pt; exists l2; exact H0 ].
   assert (H2 := continuous_neq_0 _ _ (derivable_continuous_pt _ _ X) H1).
   elim H2; clear H2; intros eps_f2 H2.
-  unfold div_fct in |- *.
+  unfold div_fct.
   assert (H3 := derivable_continuous_pt _ _ X).
   unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3;
     unfold limit_in in H3; unfold dist in H3.
   simpl in H3; unfold R_dist in H3.
   elim (H3 (Rabs (f2 x) / 2));
     [ idtac
-      | unfold Rdiv in |- *; change (0 < Rabs (f2 x) * / 2) in |- *;
+      | unfold Rdiv; change (0 < Rabs (f2 x) * / 2);
         apply Rmult_lt_0_compat;
           [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
   clear H3; intros alp_f2 H3.
@@ -48,12 +46,12 @@ Proof.
     (forall a:R,
       Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)).
   intro Maj.
-  unfold derivable_pt_lim in |- *; intros.
+  unfold derivable_pt_lim; intros.
   elim (H (Rabs (eps * f2 x / 8)));
     [ idtac
-      | unfold Rdiv in |- *; change (0 < Rabs (eps * f2 x * / 8)) in |- *;
+      | unfold Rdiv; change (0 < Rabs (eps * f2 x * / 8));
         apply Rabs_pos_lt; repeat apply prod_neq_R0;
-          [ red in |- *; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6)
+          [ red; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6)
             | assumption
             | apply Rinv_neq_0_compat; discrR ] ].
   intros alp_f1d H7.
@@ -70,7 +68,7 @@ Proof.
           | elim H3; intros; assumption
           | apply (cond_pos alp_f1d) ] ].
   exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10).
-  simpl in |- *; intros.
+  simpl; intros.
   assert (H13 := Rlt_le_trans _ _ _ H12 (Rmin_r _ _)).
   assert (H14 := Rlt_le_trans _ _ _ H12 (Rmin_l _ _)).
   assert (H15 := Rlt_le_trans _ _ _ H13 (Rmin_r _ _)).
@@ -82,7 +80,7 @@ Proof.
       Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
       Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
       Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-  unfold Rminus in |- *.
+  unfold Rminus.
   rewrite <-
     (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
     .
@@ -100,15 +98,15 @@ Proof.
   intros.
   apply Rlt_4; assumption.
   rewrite H8.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
   rewrite Rabs_R0; rewrite Rmult_0_l.
   apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
   rewrite H8.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
   rewrite Rabs_R0; rewrite Rmult_0_l.
   apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
   rewrite H9.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
   rewrite Rabs_R0; rewrite Rmult_0_l.
   apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
   rewrite <- Rabs_mult.
@@ -116,7 +114,7 @@ Proof.
     try assumption || apply H2.
   apply H14.
   apply Rmin_2; assumption.
-  right; symmetry  in |- *; apply quadruple_var.
+  right; symmetry ; apply quadruple_var.
 (***********************************)
 (*           Second case           *)
 (*           (f1 x)=0  l1<>0       *)
@@ -139,7 +137,7 @@ Proof.
   cut (0 < Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)).
   intro.
   exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12).
-  simpl in |- *.
+  simpl.
   intros.
   assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)).
   assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)).
@@ -154,7 +152,7 @@ Proof.
       Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
       Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
       Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-  unfold Rminus in |- *.
+  unfold Rminus.
   rewrite <-
     (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
     .
@@ -172,11 +170,11 @@ Proof.
   intros.
   apply Rlt_4; assumption.
   rewrite H8.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
   rewrite Rabs_R0; rewrite Rmult_0_l.
   apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
   rewrite H8.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
   rewrite Rabs_R0; rewrite Rmult_0_l.
   apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
   rewrite <- Rabs_mult.
@@ -187,7 +185,7 @@ Proof.
   apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
   apply H2; assumption.
   apply Rmin_2; assumption.
-  right; symmetry  in |- *; apply quadruple_var.
+  right; symmetry ; apply quadruple_var.
   apply H2; assumption.
   repeat apply Rmin_pos.
   apply (cond_pos eps_f2).
@@ -198,21 +196,21 @@ Proof.
   elim H10; intros.
   case (Req_dec a 0); intro.
   rewrite H14; rewrite Rplus_0_r.
-  unfold Rminus in |- *; rewrite Rplus_opp_r.
+  unfold Rminus; rewrite Rplus_opp_r.
   rewrite Rabs_R0.
   apply Rabs_pos_lt.
-  unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc.
+  unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc.
   repeat apply prod_neq_R0; try assumption.
-  red in |- *; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6).
+  red; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6).
   apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption.
   apply H13.
   split.
   apply D_x_no_cond; assumption.
   replace (x + a - x) with a; [ assumption | ring ].
-  change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *.
-  apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc;
+  change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))).
+  apply Rabs_pos_lt; unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc;
     repeat apply prod_neq_R0.
-  red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
+  red; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
   assumption.
   assumption.
   apply Rinv_neq_0_compat; repeat apply prod_neq_R0;
@@ -225,17 +223,17 @@ Proof.
   case (Req_dec l2 0); intro.
   elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
     [ idtac
-      | apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc;
+      | apply Rabs_pos_lt; unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc;
         repeat apply prod_neq_R0;
           [ assumption
             | assumption
-            | red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6)
+            | red; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6)
             | apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption ] ].
   intros alp_f2d H12.
   cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)).
   intro.
   exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11).
-  simpl in |- *.
+  simpl.
   intros.
   assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)).
   assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)).
@@ -250,7 +248,7 @@ Proof.
       Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
       Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
       Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-  unfold Rminus in |- *.
+  unfold Rminus.
   rewrite <-
     (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
     .
@@ -268,7 +266,7 @@ Proof.
   intros.
   apply Rlt_4; assumption.
   rewrite H10.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
   rewrite Rabs_R0; rewrite Rmult_0_l.
   apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
   rewrite <- Rabs_mult.
@@ -276,14 +274,14 @@ Proof.
   apply H2; assumption.
   apply Rmin_2; assumption.
   rewrite H9.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
   rewrite Rabs_R0; rewrite Rmult_0_l.
   apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
   rewrite <- Rabs_mult.
   apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac.
   apply H2; assumption.
   apply Rmin_2; assumption.
-  right; symmetry  in |- *; apply quadruple_var.
+  right; symmetry ; apply quadruple_var.
   apply H2; assumption.
   repeat apply Rmin_pos.
   apply (cond_pos eps_f2).
@@ -296,7 +294,7 @@ Proof.
 (***********************************)
   elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
     [ idtac
-      | apply Rabs_pos_lt; unfold Rsqr, Rdiv in |- *;
+      | apply Rabs_pos_lt; unfold Rsqr, Rdiv;
         repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0;
           try assumption || discrR ].
   intros alp_f2d H11.
@@ -315,7 +313,7 @@ Proof.
   exists
     (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c)))
       H14).
-  simpl in |- *; intros.
+  simpl; intros.
   assert (H17 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)).
   assert (H18 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)).
   assert (H19 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)).
@@ -337,7 +335,7 @@ Proof.
       Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
       Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
       Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-  unfold Rminus in |- *.
+  unfold Rminus.
   rewrite <-
     (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
     .
@@ -363,24 +361,24 @@ Proof.
   apply H2; assumption.
   apply Rmin_2; assumption.
   rewrite H9.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
   rewrite Rabs_R0; rewrite Rmult_0_l.
   apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
   rewrite <- Rabs_mult.
   apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
   apply H2; assumption.
   apply Rmin_2; assumption.
-  right; symmetry  in |- *; apply quadruple_var.
+  right; symmetry ; apply quadruple_var.
   apply H2; assumption.
   intros.
   case (Req_dec a 0); intro.
   rewrite H17; rewrite Rplus_0_r.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0.
   apply Rabs_pos_lt.
-  unfold Rdiv, Rsqr in |- *.
+  unfold Rdiv, Rsqr.
   repeat rewrite Rinv_mult_distr; try assumption.
   repeat apply prod_neq_R0; try assumption.
-  red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6).
+  red; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6).
   apply Rinv_neq_0_compat; discrR.
   apply Rinv_neq_0_compat; discrR.
   apply Rinv_neq_0_compat; discrR.
@@ -403,19 +401,19 @@ Proof.
   apply (cond_pos alp_f1d).
   apply (cond_pos alp_f2d).
   elim H13; intros; assumption.
-  change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *.
+  change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
   apply Rabs_pos_lt.
-  unfold Rsqr, Rdiv in |- *.
+  unfold Rsqr, Rdiv.
   repeat rewrite Rinv_mult_distr; try assumption || discrR.
   repeat apply prod_neq_R0; try assumption.
-  red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6).
+  red; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6).
   apply Rinv_neq_0_compat; discrR.
   apply Rinv_neq_0_compat; discrR.
   apply Rinv_neq_0_compat; discrR.
   apply Rinv_neq_0_compat; assumption.
   apply Rinv_neq_0_compat; assumption.
   apply prod_neq_R0; [ discrR | assumption ].
-  red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
+  red; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
   apply Rinv_neq_0_compat; discrR.
   apply Rinv_neq_0_compat; discrR.
   apply Rinv_neq_0_compat; discrR.
@@ -442,7 +440,7 @@ Proof.
   exists
     (mkposreal
       (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13).
-  simpl in |- *.
+  simpl.
   intros.
   cut
     (forall a:R,
@@ -464,7 +462,7 @@ Proof.
       Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
       Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
       Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-  unfold Rminus in |- *.
+  unfold Rminus.
   rewrite <-
     (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
     .
@@ -482,7 +480,7 @@ Proof.
   intros.
   apply Rlt_4; assumption.
   rewrite H10.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
   rewrite Rabs_R0; rewrite Rmult_0_l.
   apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
   rewrite <- Rabs_mult.
@@ -497,20 +495,20 @@ Proof.
   apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
   apply H2; assumption.
   apply Rmin_2; assumption.
-  right; symmetry  in |- *; apply quadruple_var.
+  right; symmetry ; apply quadruple_var.
   apply H2; assumption.
   intros.
   case (Req_dec a 0); intro.
-  rewrite H17; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
+  rewrite H17; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r;
     rewrite Rabs_R0.
   apply Rabs_pos_lt.
-  unfold Rdiv in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
-  unfold Rsqr in |- *.
+  unfold Rdiv; rewrite Rinv_mult_distr; try discrR || assumption.
+  unfold Rsqr.
   repeat apply prod_neq_R0;
     assumption ||
       (apply Rinv_neq_0_compat; assumption) ||
         (apply Rinv_neq_0_compat; discrR) ||
-          (red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)).
+          (red; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)).
   elim H11; intros.
   apply H19.
   split.
@@ -523,20 +521,20 @@ Proof.
   apply (cond_pos alp_f2d).
   elim H11; intros; assumption.
   apply Rabs_pos_lt.
-  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr; try discrR || assumption.
   repeat apply prod_neq_R0;
     assumption ||
       (apply Rinv_neq_0_compat; assumption) ||
         (apply Rinv_neq_0_compat; discrR) ||
-          (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
-  change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *.
+          (red; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
+  change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))).
   apply Rabs_pos_lt.
-  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr; try discrR || assumption.
   repeat apply prod_neq_R0;
     assumption ||
       (apply Rinv_neq_0_compat; assumption) ||
         (apply Rinv_neq_0_compat; discrR) ||
-          (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
+          (red; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
 (***********************************)
 (*       Sixth case                *)
 (*    (f1 x)<>0  l1<>0  l2<>0      *)
@@ -564,7 +562,7 @@ Proof.
     (mkposreal
       (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d))
         (Rmin alp_f2c alp_f2t2)) H15).
-  simpl in |- *.
+  simpl.
   intros.
   assert (H18 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)).
   assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)).
@@ -593,7 +591,7 @@ Proof.
       Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
       Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
       Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-  unfold Rminus in |- *.
+  unfold Rminus.
   rewrite <-
     (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
     .
@@ -626,18 +624,18 @@ Proof.
   apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
   apply H2; assumption.
   apply Rmin_2; assumption.
-  right; symmetry  in |- *; apply quadruple_var.
+  right; symmetry ; apply quadruple_var.
   apply H2; assumption.
   intros.
   case (Req_dec a 0); intro.
-  rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
+  rewrite H18; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r;
     rewrite Rabs_R0; apply Rabs_pos_lt.
-  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr.
   repeat apply prod_neq_R0;
     assumption ||
       (apply Rinv_neq_0_compat; assumption) ||
         (apply Rinv_neq_0_compat; discrR) ||
-          (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
+          (red; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
   apply prod_neq_R0; [ discrR | assumption ].
   apply prod_neq_R0; [ discrR | assumption ].
   assumption.
@@ -648,20 +646,20 @@ Proof.
   replace (x + a - x) with a; [ assumption | ring ].
   intros.
   case (Req_dec a 0); intro.
-  rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
+  rewrite H18; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r;
     rewrite Rabs_R0; apply Rabs_pos_lt.
-  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr.
   repeat apply prod_neq_R0;
     assumption ||
       (apply Rinv_neq_0_compat; assumption) ||
         (apply Rinv_neq_0_compat; discrR) ||
-          (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
+          (red; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
   discrR.
   assumption.
   elim H14; intros.
   apply H20.
   split.
-  unfold D_x, no_cond in |- *; split.
+  unfold D_x, no_cond; split.
   trivial.
   apply Rminus_not_eq_right.
   replace (x + a - x) with a; [ assumption | ring ].
@@ -673,34 +671,34 @@ Proof.
   apply (cond_pos alp_f2d).
   elim H13; intros; assumption.
   elim H14; intros; assumption.
-  change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *; apply Rabs_pos_lt.
-  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+  change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))); apply Rabs_pos_lt.
+  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr; try discrR || assumption.
   repeat apply prod_neq_R0;
     assumption ||
       (apply Rinv_neq_0_compat; assumption) ||
         (apply Rinv_neq_0_compat; discrR) ||
-          (red in |- *; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)).
-  change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *;
+          (red; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)).
+  change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)));
     apply Rabs_pos_lt.
-  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr.
   repeat apply prod_neq_R0;
     assumption ||
       (apply Rinv_neq_0_compat; assumption) ||
         (apply Rinv_neq_0_compat; discrR) ||
-          (red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)).
+          (red; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)).
   apply prod_neq_R0; [ discrR | assumption ].
   apply prod_neq_R0; [ discrR | assumption ].
   assumption.
   apply Rabs_pos_lt.
-  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr;
+  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr;
     [ idtac | discrR | assumption ].
   repeat apply prod_neq_R0;
     assumption ||
       (apply Rinv_neq_0_compat; assumption) ||
         (apply Rinv_neq_0_compat; discrR) ||
-          (red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)).
+          (red; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)).
   intros.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   apply Rmult_lt_reg_l with (Rabs (f2 (x + a))).
   apply Rabs_pos_lt; apply H2.
   apply Rlt_le_trans with (Rmin eps_f2 alp_f2).
@@ -741,13 +739,13 @@ Proof.
   unfold Rminus in H7; assumption.
   intros.
   case (Req_dec x x0); intro.
-  rewrite <- H5; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
-    unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  rewrite <- H5; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    unfold Rdiv; apply Rmult_lt_0_compat;
       [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   elim H3; intros.
   apply H7.
   split.
-  unfold D_x, no_cond in |- *; split.
+  unfold D_x, no_cond; split.
   trivial.
   assumption.
   assumption.
@@ -758,7 +756,7 @@ Lemma derivable_pt_div :
     derivable_pt f1 x ->
     derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x.
 Proof.
-  unfold derivable_pt in |- *.
+  unfold derivable_pt.
   intros f1 f2 x X X0 H.
   elim X; intros.
   elim X0; intros.
@@ -771,7 +769,7 @@ Lemma derivable_div :
     derivable f1 ->
     derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2).
 Proof.
-  unfold derivable in |- *; intros f1 f2 X X0 H x.
+  unfold derivable; intros f1 f2 X X0 H x.
   apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)).
 Qed.
 
diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v
index a7c5a387..00c07592 100644
--- a/theories/Reals/Ranalysis4.v
+++ b/theories/Reals/Ranalysis4.v
@@ -1,21 +1,19 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis4.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
-Require Import Rtrigo.
+Require Import Rtrigo1.
 Require Import Ranalysis1.
 Require Import Ranalysis3.
 Require Import Exp_prop.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (**********)
 Lemma derivable_pt_inv :
@@ -28,12 +26,12 @@ Proof.
   apply derivable_pt_const.
   assumption.
   assumption.
-  unfold div_fct, inv_fct, fct_cte in |- *; intro X0; elim X0; intros;
-    unfold derivable_pt in |- *; exists x0;
-      unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *;
+  unfold div_fct, inv_fct, fct_cte; intro X0; elim X0; intros;
+    unfold derivable_pt; exists x0;
+      unfold derivable_pt_abs; unfold derivable_pt_lim;
         unfold derivable_pt_abs in p; unfold derivable_pt_lim in p;
           intros; elim (p eps H0); intros; exists x1; intros;
-            unfold Rdiv in H1; unfold Rdiv in |- *; rewrite <- (Rmult_1_l (/ f x));
+            unfold Rdiv in H1; unfold Rdiv; rewrite <- (Rmult_1_l (/ f x));
               rewrite <- (Rmult_1_l (/ f (x + h))).
   apply H1; assumption.
 Qed.
@@ -43,10 +41,10 @@ Lemma pr_nu_var :
   forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
     f = g -> derive_pt f x pr1 = derive_pt g x pr2.
 Proof.
-  unfold derivable_pt, derive_pt in |- *; intros.
+  unfold derivable_pt, derive_pt; intros.
   elim pr1; intros.
   elim pr2; intros.
-  simpl in |- *.
+  simpl.
   rewrite H in p.
   apply uniqueness_limite with g x; assumption.
 Qed.
@@ -56,17 +54,17 @@ Lemma pr_nu_var2 :
   forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
     (forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2.
 Proof.
-  unfold derivable_pt, derive_pt in |- *; intros.
+  unfold derivable_pt, derive_pt; intros.
   elim pr1; intros.
   elim pr2; intros.
-  simpl in |- *.
+  simpl.
   assert (H0 := uniqueness_step2 _ _ _ p).
   assert (H1 := uniqueness_step2 _ _ _ p0).
   cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0).
   intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2).
   assumption.
-  unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
-    simpl in |- *; unfold R_dist in |- *; unfold limit1_in in H1;
+  unfold limit1_in; unfold limit_in; unfold dist;
+    simpl; unfold R_dist; unfold limit1_in in H1;
       unfold limit_in in H1; unfold dist in H1; simpl in H1;
         unfold R_dist in H1.
   intros; elim (H1 eps H2); intros.
@@ -82,7 +80,7 @@ Lemma derivable_inv :
   forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f).
 Proof.
   intros f H X.
-  unfold derivable in |- *; intro x.
+  unfold derivable; intro x.
   apply derivable_pt_inv.
   apply (H x).
   apply (X x).
@@ -97,25 +95,25 @@ Proof.
     replace (derive_pt (/ f) x (derivable_pt_inv f x na pr)) with
     (derive_pt (fct_cte 1 / f) x
       (derivable_pt_div (fct_cte 1) f x (derivable_pt_const 1 x) pr na)).
-  rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte in |- *;
-    rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus in |- *;
+  rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte;
+    rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus;
       rewrite Rplus_0_l; reflexivity.
   apply pr_nu_var2.
-  intro; unfold div_fct, fct_cte, inv_fct in |- *.
-  unfold Rdiv in |- *; ring.
+  intro; unfold div_fct, fct_cte, inv_fct.
+  unfold Rdiv; ring.
 Qed.
 
 (** Rabsolu *)
 Lemma Rabs_derive_1 : forall x:R, 0 < x -> derivable_pt_lim Rabs x 1.
 Proof.
   intros.
-  unfold derivable_pt_lim in |- *; intros.
+  unfold derivable_pt_lim; intros.
   exists (mkposreal x H); intros.
   rewrite (Rabs_right x).
   rewrite (Rabs_right (x + h)).
   rewrite Rplus_comm.
-  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r.
-  rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym.
+  unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r.
+  rewrite Rplus_0_r; unfold Rdiv; rewrite <- Rinv_r_sym.
   rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0.
   apply H1.
   apply Rle_ge.
@@ -133,16 +131,16 @@ Qed.
 Lemma Rabs_derive_2 : forall x:R, x < 0 -> derivable_pt_lim Rabs x (-1).
 Proof.
   intros.
-  unfold derivable_pt_lim in |- *; intros.
+  unfold derivable_pt_lim; intros.
   cut (0 < - x).
   intro; exists (mkposreal (- x) H1); intros.
   rewrite (Rabs_left x).
   rewrite (Rabs_left (x + h)).
   rewrite Rplus_comm.
   rewrite Ropp_plus_distr.
-  unfold Rminus in |- *; rewrite Ropp_involutive; rewrite Rplus_assoc;
+  unfold Rminus; rewrite Ropp_involutive; rewrite Rplus_assoc;
     rewrite Rplus_opp_l.
-  rewrite Rplus_0_r; unfold Rdiv in |- *.
+  rewrite Rplus_0_r; unfold Rdiv.
   rewrite Ropp_mult_distr_l_reverse.
   rewrite <- Rinv_r_sym.
   rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0.
@@ -165,24 +163,24 @@ Proof.
   intros.
   case (total_order_T x 0); intro.
   elim s; intro.
-  unfold derivable_pt in |- *; exists (-1).
+  unfold derivable_pt; exists (-1).
   apply (Rabs_derive_2 x a).
   elim H; exact b.
-  unfold derivable_pt in |- *; exists 1.
+  unfold derivable_pt; exists 1.
   apply (Rabs_derive_1 x r).
 Qed.
 
 (** Rabsolu is continuous for all x *)
 Lemma Rcontinuity_abs : continuity Rabs.
 Proof.
-  unfold continuity in |- *; intro.
+  unfold continuity; intro.
   case (Req_dec x 0); intro.
-  unfold continuity_pt in |- *; unfold continue_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
-      simpl in |- *; unfold R_dist in |- *; intros; exists eps;
+  unfold continuity_pt; unfold continue_in;
+    unfold limit1_in; unfold limit_in;
+      simpl; unfold R_dist; intros; exists eps;
         split.
   apply H0.
-  intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0;
+  intros; rewrite H; rewrite Rabs_R0; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1;
       intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3;
         rewrite Rplus_0_r in H3; apply H3.
@@ -194,11 +192,11 @@ Lemma continuity_finite_sum :
   forall (An:nat -> R) (N:nat),
     continuity (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N).
 Proof.
-  intros; unfold continuity in |- *; intro.
+  intros; unfold continuity; intro.
   induction  N as [| N HrecN].
-  simpl in |- *.
+  simpl.
   apply continuity_pt_const.
-  unfold constant in |- *; intros; reflexivity.
+  unfold constant; intros; reflexivity.
   replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with
   ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) +
     (fun y:R => (An (S N) * y ^ S N)%R))%F.
@@ -224,7 +222,7 @@ Proof.
   cut (N = 0%nat \/ (0 < N)%nat).
   intro; elim H0; intro.
   rewrite H1.
-  simpl in |- *.
+  simpl.
   replace (fun y:R => An 0%nat * 1 + An 1%nat * (y * 1)) with
   (fct_cte (An 0%nat * 1) + mult_real_fct (An 1%nat) (id * fct_cte 1))%F.
   replace (1 * An 1%nat * 1) with (0 + An 1%nat * (1 * fct_cte 1 x + id x * 0)).
@@ -234,7 +232,7 @@ Proof.
   apply derivable_pt_lim_mult.
   apply derivable_pt_lim_id.
   apply derivable_pt_lim_const.
-  unfold fct_cte, id in |- *; ring.
+  unfold fct_cte, id; ring.
   reflexivity.
   replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with
   ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) +
@@ -250,7 +248,7 @@ Proof.
   (mult_real_fct (An (S N)) (fun y:R => y ^ S N)).
   apply derivable_pt_lim_scal.
   replace (pred (S N)) with N; [ idtac | reflexivity ].
-  pattern N at 3 in |- *; replace N with (pred (S N)).
+  pattern N at 3; replace N with (pred (S N)).
   apply derivable_pt_lim_pow.
   reflexivity.
   reflexivity.
@@ -261,10 +259,10 @@ Proof.
   rewrite <- H2.
   replace (pred (S N)) with N; [ idtac | reflexivity ].
   ring.
-  simpl in |- *.
+  simpl.
   apply S_pred with 0%nat; assumption.
-  unfold plus_fct in |- *.
-  simpl in |- *; reflexivity.
+  unfold plus_fct.
+  simpl; reflexivity.
   inversion H.
   left; reflexivity.
   right; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
@@ -280,7 +278,7 @@ Lemma derivable_pt_lim_finite_sum :
 Proof.
   intros.
   induction  N as [| N HrecN].
-  simpl in |- *.
+  simpl.
   rewrite Rmult_1_r.
   replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat));
   [ apply derivable_pt_lim_const | reflexivity ].
@@ -292,7 +290,7 @@ Lemma derivable_pt_finite_sum :
     derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x.
 Proof.
   intros.
-  unfold derivable_pt in |- *.
+  unfold derivable_pt.
   assert (H := derivable_pt_lim_finite_sum An x N).
   induction  N as [| N HrecN].
   exists 0; apply H.
@@ -305,14 +303,14 @@ Lemma derivable_finite_sum :
   forall (An:nat -> R) (N:nat),
     derivable (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N).
 Proof.
-  intros; unfold derivable in |- *; intro; apply derivable_pt_finite_sum.
+  intros; unfold derivable; intro; apply derivable_pt_finite_sum.
 Qed.
 
 (** Regularity of hyperbolic functions *)
 Lemma derivable_pt_lim_cosh : forall x:R, derivable_pt_lim cosh x (sinh x).
 Proof.
   intro.
-  unfold cosh, sinh in |- *; unfold Rdiv in |- *.
+  unfold cosh, sinh; unfold Rdiv.
   replace (fun x0:R => (exp x0 + exp (- x0)) * / 2) with
   ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ].
   replace ((exp x - exp (- x)) * / 2) with
@@ -326,13 +324,13 @@ Proof.
   apply derivable_pt_lim_id.
   apply derivable_pt_lim_exp.
   apply derivable_pt_lim_const.
-  unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring.
+  unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte; ring.
 Qed.
 
 Lemma derivable_pt_lim_sinh : forall x:R, derivable_pt_lim sinh x (cosh x).
 Proof.
   intro.
-  unfold cosh, sinh in |- *; unfold Rdiv in |- *.
+  unfold cosh, sinh; unfold Rdiv.
   replace (fun x0:R => (exp x0 - exp (- x0)) * / 2) with
   ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ].
   replace ((exp x + exp (- x)) * / 2) with
@@ -346,13 +344,13 @@ Proof.
   apply derivable_pt_lim_id.
   apply derivable_pt_lim_exp.
   apply derivable_pt_lim_const.
-  unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring.
+  unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte; ring.
 Qed.
 
 Lemma derivable_pt_exp : forall x:R, derivable_pt exp x.
 Proof.
   intro.
-  unfold derivable_pt in |- *.
+  unfold derivable_pt.
   exists (exp x).
   apply derivable_pt_lim_exp.
 Qed.
@@ -360,7 +358,7 @@ Qed.
 Lemma derivable_pt_cosh : forall x:R, derivable_pt cosh x.
 Proof.
   intro.
-  unfold derivable_pt in |- *.
+  unfold derivable_pt.
   exists (sinh x).
   apply derivable_pt_lim_cosh.
 Qed.
@@ -368,24 +366,24 @@ Qed.
 Lemma derivable_pt_sinh : forall x:R, derivable_pt sinh x.
 Proof.
   intro.
-  unfold derivable_pt in |- *.
+  unfold derivable_pt.
   exists (cosh x).
   apply derivable_pt_lim_sinh.
 Qed.
 
 Lemma derivable_exp : derivable exp.
 Proof.
-  unfold derivable in |- *; apply derivable_pt_exp.
+  unfold derivable; apply derivable_pt_exp.
 Qed.
 
 Lemma derivable_cosh : derivable cosh.
 Proof.
-  unfold derivable in |- *; apply derivable_pt_cosh.
+  unfold derivable; apply derivable_pt_cosh.
 Qed.
 
 Lemma derivable_sinh : derivable sinh.
 Proof.
-  unfold derivable in |- *; apply derivable_pt_sinh.
+  unfold derivable; apply derivable_pt_sinh.
 Qed.
 
 Lemma derive_pt_exp :
diff --git a/theories/Reals/Ranalysis5.v b/theories/Reals/Ranalysis5.v
new file mode 100644
index 00000000..c8a2e1a8
--- /dev/null
+++ b/theories/Reals/Ranalysis5.v
@@ -0,0 +1,1348 @@
+Require Import Rbase.
+Require Import Ranalysis_reg.
+Require Import Rfunctions.
+Require Import Rseries.
+Require Import Fourier.
+Require Import RiemannInt.
+Require Import SeqProp.
+Require Import Max.
+Local Open Scope R_scope.
+
+(** * Preliminaries lemmas *)
+
+Lemma f_incr_implies_g_incr_interv : forall f g:R->R, forall lb ub,
+       lb < ub ->
+       (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) ->
+       (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) ->
+       (forall x , f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
+       (forall x y, f lb <= x -> x < y -> y <= f ub -> g x < g y).
+Proof.
+intros f g lb ub lb_lt_ub f_incr f_eq_g g_ok x y lb_le_x x_lt_y y_le_ub.
+ assert (x_encad : f lb <= x <= f ub).
+  split ; [assumption | apply Rle_trans with (r2:=y) ; [apply Rlt_le|] ; assumption].
+ assert (y_encad : f lb <= y <= f ub).
+  split ; [apply Rle_trans with (r2:=x) ; [|apply Rlt_le] ; assumption | assumption].
+  assert (Temp1 : lb <= lb) by intuition ; assert (Temp2 : ub <= ub) by intuition.
+ assert (gx_encad := g_ok _ (proj1 x_encad) (proj2 x_encad)).
+ assert (gy_encad := g_ok _ (proj1 y_encad) (proj2 y_encad)).
+ clear Temp1 Temp2.
+ case (Rlt_dec (g x) (g y)).
+  intuition.
+  intros Hfalse.
+   assert (Temp := Rnot_lt_le _ _ Hfalse).
+   assert (Hcontradiction : y <= x).
+   replace y with (id y) by intuition ; replace x with (id x) by intuition ;
+   rewrite <- f_eq_g. rewrite <- f_eq_g.
+   assert (f_incr2 : forall x y, lb <= x -> x <= y -> y < ub -> f x <= f y).
+    intros m n lb_le_m m_le_n n_lt_ub.
+    case (m_le_n).
+     intros ; apply Rlt_le ; apply f_incr ; [| | apply Rlt_le] ; assumption.
+     intros Hyp ; rewrite Hyp ; apply Req_le ; reflexivity.
+   apply f_incr2.
+   intuition. intuition.
+   Focus 3. intuition.
+   Focus 2. intuition.
+   Focus 2. intuition. Focus 2. intuition.
+   assert (Temp2 : g x <> ub).
+   intro Hf.
+    assert (Htemp : (comp f g) x = f ub).
+     unfold comp ; rewrite Hf ; reflexivity.
+     rewrite f_eq_g in Htemp ; unfold id in Htemp.
+    assert (Htemp2 : x < f ub).
+     apply Rlt_le_trans with (r2:=y) ; intuition.
+    clear -Htemp Htemp2. fourier.
+    intuition. intuition.
+   clear -Temp2 gx_encad.
+   case (proj2 gx_encad).
+    intuition.
+    intro Hfalse ; apply False_ind ; apply Temp2 ; assumption.
+   apply False_ind. clear - Hcontradiction x_lt_y. fourier.
+Qed.
+
+Lemma derivable_pt_id_interv : forall (lb ub x:R),
+       lb <= x <= ub ->
+       derivable_pt id x.
+Proof.
+intros.
+ reg.
+Qed.
+
+Lemma pr_nu_var2_interv : forall (f g : R -> R) (lb ub x : R) (pr1 : derivable_pt f x)
+       (pr2 : derivable_pt g x),
+       lb < ub ->
+       lb < x < ub ->
+       (forall h : R, lb < h < ub -> f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2.
+Proof.
+intros f g lb ub x Prf Prg lb_lt_ub x_encad local_eq.
+assert (forall x l, lb < x < ub -> (derivable_pt_abs f x l <-> derivable_pt_abs g x l)).
+ intros a l a_encad.
+ unfold derivable_pt_abs, derivable_pt_lim.
+ split.
+ intros Hyp eps eps_pos.
+ elim (Hyp eps eps_pos) ; intros delta Hyp2.
+ assert (Pos_cond : Rmin delta (Rmin (ub - a) (a - lb)) > 0).
+  clear-a lb ub a_encad delta.
+  apply Rmin_pos ; [exact (delta.(cond_pos)) | apply Rmin_pos ] ; apply Rlt_Rminus ; intuition.
+ exists (mkposreal (Rmin delta (Rmin (ub - a) (a - lb))) Pos_cond).
+ intros h h_neq h_encad.
+ replace (g (a + h) - g a) with (f (a + h) - f a).
+ apply Hyp2 ; intuition.
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))).
+ assumption. apply Rmin_l.
+ assert (local_eq2 : forall h : R, lb < h < ub -> - f h = - g h).
+  intros ; apply Ropp_eq_compat ; intuition.
+ rewrite local_eq ; unfold Rminus. rewrite local_eq2. reflexivity.
+ assumption.
+ assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y).
+  intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n).
+   apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs.
+   apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption.
+ split.
+ assert (Sublemma : forall x y z, -z < y - x -> x < y + z).
+  intros ; fourier.
+ apply Sublemma.
+ apply Sublemma2. rewrite Rabs_Ropp.
+ apply Rlt_le_trans with (r2:=a-lb) ; [| apply RRle_abs] ;
+ apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ;
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption.
+ apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ;
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption.
+ assert (Sublemma : forall x y z, y < z - x -> x + y < z).
+  intros ; fourier.
+ apply Sublemma.
+ apply Sublemma2.
+ apply Rlt_le_trans with (r2:=ub-a) ; [| apply RRle_abs] ;
+ apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ;
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption.
+ apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ;
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption.
+ intros Hyp eps eps_pos.
+ elim (Hyp eps eps_pos) ; intros delta Hyp2.
+ assert (Pos_cond : Rmin delta (Rmin (ub - a) (a - lb)) > 0).
+  clear-a lb ub a_encad delta.
+  apply Rmin_pos ; [exact (delta.(cond_pos)) | apply Rmin_pos ] ; apply Rlt_Rminus ; intuition.
+ exists (mkposreal (Rmin delta (Rmin (ub - a) (a - lb))) Pos_cond).
+ intros h h_neq h_encad.
+ replace (f (a + h) - f a) with (g (a + h) - g a).
+ apply Hyp2 ; intuition.
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))).
+ assumption. apply Rmin_l.
+ assert (local_eq2 : forall h : R, lb < h < ub -> - f h = - g h).
+  intros ; apply Ropp_eq_compat ; intuition.
+ rewrite local_eq ; unfold Rminus. rewrite local_eq2. reflexivity.
+ assumption.
+ assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y).
+  intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n).
+   apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs.
+   apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption.
+ split.
+ assert (Sublemma : forall x y z, -z < y - x -> x < y + z).
+  intros ; fourier.
+ apply Sublemma.
+ apply Sublemma2. rewrite Rabs_Ropp.
+ apply Rlt_le_trans with (r2:=a-lb) ; [| apply RRle_abs] ;
+ apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ;
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption.
+ apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ;
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption.
+ assert (Sublemma : forall x y z, y < z - x -> x + y < z).
+  intros ; fourier.
+ apply Sublemma.
+ apply Sublemma2.
+ apply Rlt_le_trans with (r2:=ub-a) ; [| apply RRle_abs] ;
+ apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ;
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption.
+ apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ;
+ apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption.
+ unfold derivable_pt in Prf.
+  unfold derivable_pt in Prg.
+  elim Prf; intros.
+  elim Prg; intros.
+  assert (Temp := p); rewrite H in Temp.
+  unfold derivable_pt_abs in p.
+  unfold derivable_pt_abs in p0.
+  simpl in |- *.
+  apply (uniqueness_limite g x x0 x1 Temp p0).
+  assumption.
+Qed.
+
+
+(* begin hide *)
+Lemma leftinv_is_rightinv : forall (f g:R->R),
+       (forall x y, x < y -> f x < f y) ->
+       (forall x, (comp f g) x = id x) ->
+       (forall x, (comp g f) x = id x).
+Proof.
+intros f g f_incr Hyp x.
+ assert (forall x, f (g (f x)) = f x).
+  intros ; apply Hyp.
+ assert(f_inj : forall x y, f x = f y -> x = y).
+  intros a b fa_eq_fb.
+  case(total_order_T a b).
+  intro s ; case s ; clear s.
+  intro Hf.
+  assert (Hfalse := f_incr a b Hf).
+  apply False_ind. apply (Rlt_not_eq (f a) (f b)) ; assumption.
+  intuition.
+  intro Hf. assert (Hfalse := f_incr b a Hf).
+  apply False_ind. apply (Rlt_not_eq (f b) (f a)) ; [|symmetry] ; assumption.
+ apply f_inj. unfold comp.
+ unfold comp in Hyp.
+ rewrite Hyp.
+ unfold id.
+ reflexivity.
+Qed.
+(* end hide *)
+
+Lemma leftinv_is_rightinv_interv : forall (f g:R->R) (lb ub:R),
+       (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) ->
+       (forall y, f lb <= y -> y <= f ub -> (comp f g) y = id y) ->
+       (forall x, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
+       forall x,
+       lb <= x <= ub ->
+       (comp g f) x = id x.
+Proof.
+intros f g lb ub f_incr_interv Hyp g_wf x x_encad.
+ assert(f_inj : forall x y, lb <= x <= ub -> lb <= y <= ub -> f x = f y -> x = y).
+  intros a b a_encad b_encad fa_eq_fb.
+  case(total_order_T a b).
+  intro s ; case s ; clear s.
+  intro Hf.
+  assert (Hfalse := f_incr_interv a b (proj1 a_encad) Hf (proj2 b_encad)).
+  apply False_ind. apply (Rlt_not_eq (f a) (f b)) ; assumption.
+  intuition.
+  intro Hf. assert (Hfalse := f_incr_interv b a (proj1 b_encad) Hf (proj2 a_encad)).
+  apply False_ind. apply (Rlt_not_eq (f b) (f a)) ; [|symmetry] ; assumption.
+ assert (f_incr_interv2 : forall x y, lb <= x -> x <= y -> y <= ub -> f x <= f y).
+  intros m n cond1 cond2 cond3.
+   case cond2.
+   intro cond. apply Rlt_le ; apply f_incr_interv ; assumption.
+   intro cond ; right ; rewrite cond ; reflexivity.
+ assert (Hyp2:forall x, lb <= x <= ub -> f (g (f x)) = f x).
+  intros ; apply Hyp.  apply f_incr_interv2 ; intuition. 
+ apply f_incr_interv2 ; intuition.
+ unfold comp ; unfold comp in Hyp.
+ apply f_inj.
+ apply g_wf ; apply f_incr_interv2 ; intuition.
+ unfold id ; assumption.
+ apply Hyp2 ; unfold id ; assumption.
+Qed.
+
+
+(** Intermediate Value Theorem on an Interval (Proof mainly taken from Reals.Rsqrt_def) and its corollary *)
+
+Lemma IVT_interv_prelim0 : forall (x y:R) (P:R->bool) (N:nat),
+       x < y ->
+       x <= Dichotomy_ub x y P N <= y /\ x <= Dichotomy_lb x y P N <= y.
+Proof.
+assert (Sublemma : forall x y lb ub, lb <= x <= ub /\ lb <= y <= ub -> lb <= (x+y) / 2 <= ub).
+ intros x y lb ub Hyp.
+  split.
+  replace lb with ((lb + lb) * /2) by field.
+  unfold Rdiv ; apply Rmult_le_compat_r ; intuition.
+  replace ub with ((ub + ub) * /2) by field.
+  unfold Rdiv ; apply Rmult_le_compat_r ; intuition.
+intros x y P N x_lt_y.
+induction N.
+ simpl ; intuition.
+ simpl.
+ case (P ((Dichotomy_lb x y P N + Dichotomy_ub x y P N) / 2)).
+ split. apply Sublemma ; intuition.
+ intuition.
+ split. intuition.
+ apply Sublemma ; intuition.
+Qed.
+
+Lemma IVT_interv_prelim1 : forall (x y x0:R) (D : R -> bool),
+       x < y ->
+       Un_cv (dicho_up x y D) x0 ->
+       x <= x0 <= y.
+Proof.
+intros x y x0 D x_lt_y bnd.
+ assert (Main : forall n, x <= dicho_up x y D n <= y).
+  intro n. unfold dicho_up.
+  apply (proj1 (IVT_interv_prelim0 x y D n x_lt_y)).
+ split.
+  apply Rle_cv_lim with (Vn:=dicho_up x y D) (Un:=fun n => x).
+  intro n ; exact (proj1 (Main n)).
+  unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold R_dist ; replace (x -x) with 0 by field ; rewrite Rabs_R0 ; assumption.
+  assumption.
+  apply Rle_cv_lim with (Un:=dicho_up x y D) (Vn:=fun n => y).
+  intro n ; exact (proj2 (Main n)).
+  assumption.
+  unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold R_dist ; replace (y -y) with 0 by field ; rewrite Rabs_R0 ; assumption.
+Qed.
+
+Lemma IVT_interv : forall (f : R -> R) (x y : R),
+       (forall a, x <= a <= y -> continuity_pt f a) ->
+       x < y ->
+       f x < 0 ->
+       0 < f y ->
+       {z : R | x <= z <= y /\ f z = 0}.
+Proof.
+intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*)
+  cut (x <= y).
+  intro.
+  generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). 
+  generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). 
+  intros X X0.
+  elim X; intros.
+  elim X0; intros.
+  assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p).
+  rewrite H4 in p0.
+  exists x0.
+  split.
+  split.
+  apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0).
+  simpl in |- *.
+  right; reflexivity.
+  apply growing_ineq.
+  apply dicho_lb_growing; assumption.
+  assumption.
+  apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0).
+  apply decreasing_ineq.
+  apply dicho_up_decreasing; assumption.
+  assumption.
+  right; reflexivity.
+  2: left; assumption.
+  set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n).
+  set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n).
+  cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0).
+  cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0).
+  intros.
+  cut (forall n:nat, f (Vn n) <= 0).
+  cut (forall n:nat, 0 <= f (Wn n)).
+  intros.
+  assert (H9 := H6 H8).
+  assert (H10 := H5 H7).
+  apply Rle_antisym; assumption.
+  intro.
+  unfold Wn in |- *.
+  cut (forall z:R, cond_positivity z = true <-> 0 <= z).
+  intro.
+  assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n).
+  elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros.
+  apply H9.
+  apply H8.
+  elim (H7 (f y)); intros.
+  apply H12.
+  left; assumption.
+  intro.
+  unfold cond_positivity in |- *.
+  case (Rle_dec 0 z); intro.
+  split.
+  intro; assumption.
+  intro; reflexivity.
+  split.
+  intro feqt;discriminate feqt.
+  intro.
+  elim n0; assumption.
+  unfold Vn in |- *.
+  cut (forall z:R, cond_positivity z = false <-> z < 0).
+  intros.
+  assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n).
+  left.
+  elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros.
+  apply H9.
+  apply H8.
+  elim (H7 (f x)); intros.
+  apply H12.
+  assumption.
+  intro.
+  unfold cond_positivity in |- *.
+  case (Rle_dec 0 z); intro.
+  split.
+  intro feqt; discriminate feqt.
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)).
+  split.
+  intro; auto with real.
+  intro; reflexivity.
+  cut (Un_cv Wn x0).
+  intros.
+  assert (Temp : x <= x0 <= y).
+   apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption.
+  assert (H7 := continuity_seq f Wn x0 (H x0 Temp) H5).
+  case (total_order_T 0 (f x0)); intro.
+  elim s; intro.
+  left; assumption.
+  rewrite <- b; right; reflexivity.
+  unfold Un_cv in H7; unfold R_dist in H7.
+  cut (0 < - f x0).
+  intro.
+  elim (H7 (- f x0) H8); intros.
+  cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
+  assert (H11 := H9 x2 H10).
+  rewrite Rabs_right in H11.
+  pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11.
+  unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11.
+  assert (H12 := Rplus_lt_reg_r _ _ _ H11).
+  assert (H13 := H6 x2).
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)).
+  apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat.
+  apply H6.
+  exact H8.
+  apply Ropp_0_gt_lt_contravar; assumption.
+  unfold Wn in |- *; assumption.
+  cut (Un_cv Vn x0).
+  intros.
+  assert (Temp : x <= x0 <= y).
+   apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption.
+  assert (H7 := continuity_seq f Vn x0 (H x0 Temp) H5).
+  case (total_order_T 0 (f x0)); intro.
+  elim s; intro.
+  unfold Un_cv in H7; unfold R_dist in H7.
+  elim (H7 (f x0) a); intros.
+  cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
+  assert (H10 := H8 x2 H9).
+  rewrite Rabs_left in H10.
+  pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10.
+  rewrite Ropp_minus_distr' in H10.
+  unfold Rminus in H10.
+  assert (H11 := Rplus_lt_reg_r _ _ _ H10).
+  assert (H12 := H6 x2).
+  cut (0 < f (Vn x2)).
+  intro.
+  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)).
+  rewrite <- (Ropp_involutive (f (Vn x2))).
+  apply Ropp_0_gt_lt_contravar; assumption.
+  apply Rplus_lt_reg_r with (f x0 - f (Vn x2)).
+  rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0;
+    [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ].
+  assumption.
+  apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6.
+  right; rewrite <- b; reflexivity.
+  left; assumption.
+  unfold Vn in |- *; assumption.
+Qed.
+
+(* begin hide *)
+Ltac case_le H :=
+   let t := type of H in 
+   let h' := fresh in 
+      match t with ?x <= ?y => case (total_order_T x y);
+         [intros h'; case h'; clear h' | 
+          intros h'; clear -H h'; elimtype False; fourier ] end.
+(* end hide *)
+
+
+Lemma f_interv_is_interv : forall (f:R->R) (lb ub y:R),
+       lb < ub ->
+       f lb <= y <= f ub ->
+       (forall x, lb <=  x <= ub -> continuity_pt f x) ->
+       {x | lb <= x <= ub /\ f x = y}.
+Proof.
+intros f lb ub y lb_lt_ub y_encad f_cont_interv.
+ case y_encad ; intro y_encad1.
+   case_le y_encad1 ; intros y_encad2 y_encad3 ; case_le y_encad3.
+    intro y_encad4.
+     clear y_encad y_encad1 y_encad3.
+     assert (Cont : forall a : R, lb <= a <= ub -> continuity_pt (fun x => f x - y) a).
+      intros a a_encad. unfold continuity_pt, continue_in, limit1_in, limit_in ; simpl ; unfold R_dist.
+      intros eps eps_pos. elim (f_cont_interv a a_encad eps eps_pos).
+      intros alpha alpha_pos. destruct alpha_pos as (alpha_pos,Temp).
+      exists alpha. split.
+      assumption. intros x  x_cond.
+      replace (f x - y - (f a - y)) with (f x - f a) by field.
+      exact (Temp x x_cond).
+     assert (H1 : (fun x : R => f x - y) lb < 0).
+       apply Rlt_minus. assumption.
+      assert (H2 : 0 < (fun x : R => f x - y) ub).
+       apply Rgt_minus ; assumption.
+     destruct (IVT_interv (fun x => f x - y) lb ub Cont lb_lt_ub H1 H2) as (x,Hx).
+     exists x.
+     destruct Hx as (Hyp,Result).
+     intuition.
+     intro H ; exists ub ; intuition.
+     intro H ; exists lb ; intuition.
+     intro H ; exists ub ; intuition.
+Qed.
+
+(** ** The derivative of a reciprocal function       *)
+
+
+(** * Continuity of the reciprocal function *)
+
+Lemma continuity_pt_recip_prelim : forall (f g:R->R) (lb ub : R) (Pr1:lb < ub),
+       (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) ->
+       (forall x, lb <= x <= ub -> (comp g f) x = id x) ->
+       (forall a, lb <= a <= ub -> continuity_pt f a) ->
+       forall b,
+       f lb < b < f ub ->
+       continuity_pt g b.
+Proof.
+assert (Sublemma : forall x y z, Rmax x y < z <-> x < z /\ y < z).
+ intros x y z. split.
+  unfold Rmax. case (Rle_dec x y) ; intros Hyp Hyp2.
+  split. apply Rle_lt_trans with (r2:=y) ; assumption. assumption.
+  split. assumption. apply Rlt_trans with (r2:=x).
+  assert (Temp : forall x y, ~ x <= y -> x > y).
+   intros m n Hypmn. intuition.
+  apply Temp ; clear Temp ; assumption.
+  assumption.
+  intros Hyp.
+  unfold Rmax. case (Rle_dec x y).
+  intro ; exact (proj2 Hyp).
+  intro ; exact (proj1 Hyp).
+assert (Sublemma2 : forall x y z, Rmin x y > z <-> x > z /\ y > z).
+ intros x y z. split.
+  unfold Rmin. case (Rle_dec x y) ; intros Hyp Hyp2.
+  split. assumption.
+  apply Rlt_le_trans with (r2:=x) ; intuition.
+  split.
+  apply Rlt_trans with (r2:=y). intuition.
+  assert (Temp : forall x y, ~ x <= y -> x > y).
+   intros m n Hypmn. intuition.
+  apply Temp ; clear Temp ; assumption.
+  assumption.
+  intros Hyp.
+  unfold Rmin. case (Rle_dec x y).
+  intro ; exact (proj1 Hyp).
+  intro ; exact (proj2 Hyp).
+assert (Sublemma3 : forall x y, x <= y /\ x <> y -> x < y).
+ intros m n Hyp. unfold Rle in Hyp.
+  destruct Hyp as (Hyp1,Hyp2).
+  case Hyp1.
+  intuition.
+  intro Hfalse ; apply False_ind ; apply Hyp2 ; exact Hfalse.
+intros f g lb ub lb_lt_ub f_incr_interv f_eq_g f_cont_interv b b_encad.
+ assert (f_incr_interv2 : forall x y, lb <= x -> x <= y -> y <= ub -> f x <= f y).
+  intros m n cond1 cond2 cond3.
+   case cond2.
+   intro cond. apply Rlt_le ; apply f_incr_interv ; assumption.
+   intro cond ; right ; rewrite cond ; reflexivity.
+ unfold continuity_pt, continue_in, limit1_in, limit_in ; intros eps eps_pos.
+ unfold dist ; simpl ; unfold R_dist.
+ assert (b_encad_e : f lb <= b <= f ub) by intuition.
+ elim (f_interv_is_interv f lb ub b lb_lt_ub b_encad_e f_cont_interv) ; intros x Temp.
+ destruct Temp as (x_encad,f_x_b).
+ assert (lb_lt_x : lb < x).
+ assert (Temp : x <> lb).
+  intro Hfalse.
+  assert (Temp' : b = f lb).
+   rewrite <- f_x_b ; rewrite Hfalse ; reflexivity.
+  assert (Temp'' : b <> f lb).
+   apply Rgt_not_eq ; exact (proj1 b_encad).
+  apply Temp'' ; exact Temp'.
+ apply Sublemma3.
+ split. exact (proj1 x_encad).
+ assert (Temp2 : forall x y:R, x <> y <-> y <> x).
+  intros m n. split ; intuition.
+ rewrite Temp2 ; assumption.
+ assert (x_lt_ub : x < ub).
+ assert (Temp : x <> ub).
+  intro Hfalse.
+  assert (Temp' : b = f ub).
+   rewrite <- f_x_b ; rewrite Hfalse ; reflexivity.
+  assert (Temp'' : b <> f ub).
+   apply Rlt_not_eq ; exact (proj2 b_encad).
+  apply Temp'' ; exact Temp'.
+ apply Sublemma3.
+ split ; [exact (proj2 x_encad) | assumption].
+ pose (x1 := Rmax (x - eps) lb).
+ pose (x2 := Rmin (x + eps) ub).
+ assert (Hx1 : x1 = Rmax (x - eps) lb) by intuition.
+ assert (Hx2 : x2 = Rmin (x + eps) ub) by intuition.
+ assert (x1_encad : lb <= x1 <= ub).
+  split. apply RmaxLess2.
+  apply Rlt_le. rewrite Hx1. rewrite Sublemma.
+  split. apply Rlt_trans with (r2:=x) ; fourier.
+  assumption.
+ assert (x2_encad : lb <= x2 <= ub).
+  split. apply Rlt_le ; rewrite Hx2 ; apply Rgt_lt ; rewrite Sublemma2.
+  split. apply Rgt_trans with (r2:=x) ; fourier.
+  assumption.
+  apply Rmin_r.
+ assert (x_lt_x2 : x < x2).
+  rewrite Hx2.
+  apply Rgt_lt. rewrite Sublemma2.
+  split ; fourier.
+ assert (x1_lt_x : x1 < x).
+  rewrite Hx1.
+  rewrite Sublemma.
+  split ; fourier.
+ exists (Rmin (f x - f x1) (f x2 - f x)).
+ split. apply Rmin_pos ; apply Rgt_minus. apply f_incr_interv ; [apply RmaxLess2 | | ] ; fourier.
+ apply f_incr_interv ; intuition.
+ intros y Temp.
+ destruct Temp as (_,y_cond).
+  rewrite <- f_x_b in y_cond.
+  assert (Temp : forall x y d1 d2, d1 > 0 -> d2 > 0 -> Rabs (y - x) < Rmin d1 d2 -> x - d1 <= y <= x + d2).
+   intros.
+    split. assert (H10 : forall x y z, x - y <= z -> x - z <= y). intuition. fourier.
+    apply H10. apply Rle_trans with (r2:=Rabs (y0 - x0)).
+    replace (Rabs (y0 - x0)) with (Rabs (x0 - y0)). apply RRle_abs.
+    rewrite <- Rabs_Ropp. unfold Rminus ; rewrite Ropp_plus_distr. rewrite Ropp_involutive.
+    intuition.
+    apply Rle_trans with (r2:= Rmin d1 d2). apply Rlt_le ; assumption.
+    apply Rmin_l.
+    assert (H10 : forall x y z, x - y <= z -> x <= y + z). intuition. fourier.
+    apply H10. apply Rle_trans with (r2:=Rabs (y0 - x0)). apply RRle_abs.
+    apply Rle_trans with (r2:= Rmin d1 d2). apply Rlt_le ; assumption.
+    apply Rmin_r.
+  assert (Temp' := Temp (f x) y (f x - f x1) (f x2 - f x)).
+  replace (f x - (f x - f x1)) with (f x1) in Temp' by field.
+  replace (f x + (f x2 - f x)) with (f x2) in Temp' by field.
+  assert (T : f x - f x1 > 0).
+   apply Rgt_minus. apply f_incr_interv ; intuition.
+  assert (T' : f x2 - f x > 0).
+   apply Rgt_minus. apply f_incr_interv ; intuition.
+  assert (Main := Temp' T T' y_cond).
+  clear Temp Temp' T T'.
+  assert (x1_lt_x2 : x1 < x2).
+   apply Rlt_trans with (r2:=x) ; assumption.
+   assert (f_cont_myinterv : forall a : R, x1 <= a <= x2 -> continuity_pt f a).
+    intros ; apply f_cont_interv ; split. 
+    apply Rle_trans with (r2 := x1) ; intuition.
+    apply Rle_trans with (r2 := x2) ; intuition.
+   elim (f_interv_is_interv f x1 x2 y x1_lt_x2 Main f_cont_myinterv) ; intros x' Temp.
+   destruct Temp as (x'_encad,f_x'_y).
+   rewrite <- f_x_b ; rewrite <- f_x'_y.
+   unfold comp in f_eq_g. rewrite f_eq_g. rewrite f_eq_g.
+   unfold id.
+   assert (x'_encad2 : x - eps <= x' <= x + eps).
+    split.
+    apply Rle_trans with (r2:=x1) ; [ apply RmaxLess1|] ; intuition.
+    apply Rle_trans with (r2:=x2) ; [ | apply Rmin_l] ; intuition.
+    assert (x1_lt_x' : x1 < x').
+     apply Sublemma3.
+     assert (x1_neq_x' : x1 <> x').
+      intro Hfalse. rewrite Hfalse, f_x'_y in y_cond.
+      assert (Hf : Rabs (y - f x) < f x - y).
+       apply Rlt_le_trans with (r2:=Rmin (f x - y) (f x2 - f x)). fourier.
+       apply Rmin_l.
+      assert(Hfin : f x - y < f x - y).
+       apply Rle_lt_trans with (r2:=Rabs (y - f x)).
+       replace (Rabs (y - f x)) with (Rabs (f x - y)). apply RRle_abs.
+       rewrite <- Rabs_Ropp. replace (- (f x - y)) with (y - f x) by field ; reflexivity. fourier.
+      apply (Rlt_irrefl (f x - y)) ; assumption.
+      split ; intuition.
+     assert (x'_lb : x - eps < x').
+      apply Sublemma3.
+      split. intuition. apply Rlt_not_eq.
+      apply Rle_lt_trans with (r2:=x1) ; [ apply RmaxLess1|] ; intuition.
+     assert (x'_lt_x2 : x' < x2).
+     apply Sublemma3.
+     assert (x1_neq_x' : x' <> x2).
+      intro Hfalse. rewrite <- Hfalse, f_x'_y in y_cond.
+      assert (Hf : Rabs (y - f x) < y - f x).
+       apply Rlt_le_trans with (r2:=Rmin (f x - f x1) (y - f x)). fourier.
+       apply Rmin_r.
+      assert(Hfin : y - f x < y - f x).
+       apply Rle_lt_trans with (r2:=Rabs (y - f x)). apply RRle_abs. fourier.
+      apply (Rlt_irrefl (y - f x)) ; assumption.
+      split ; intuition.
+     assert (x'_ub : x' < x + eps).
+      apply Sublemma3.
+      split. intuition. apply Rlt_not_eq.
+      apply Rlt_le_trans with (r2:=x2) ; [ |rewrite Hx2 ; apply Rmin_l] ; intuition.
+    apply Rabs_def1 ; fourier.
+    assumption.
+    split. apply Rle_trans with (r2:=x1) ; intuition.
+    apply Rle_trans with (r2:=x2) ; intuition.
+Qed.
+
+Lemma continuity_pt_recip_interv : forall (f g:R->R) (lb ub : R) (Pr1:lb < ub),
+       (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) ->
+       (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) ->
+       (forall x, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
+       (forall a, lb <= a <= ub -> continuity_pt f a) ->
+       forall b,
+       f lb < b < f ub ->
+       continuity_pt g b.
+Proof.
+intros f g lb ub lb_lt_ub f_incr_interv f_eq_g g_wf.
+assert (g_eq_f_prelim := leftinv_is_rightinv_interv f g lb ub f_incr_interv f_eq_g).
+assert (g_eq_f : forall x, lb <= x <= ub -> (comp g f) x = id x).
+intro x ; apply g_eq_f_prelim ; assumption.
+apply (continuity_pt_recip_prelim f g lb ub lb_lt_ub f_incr_interv g_eq_f).
+Qed.
+
+(** *   Derivability of the reciprocal function        *)
+
+Lemma derivable_pt_lim_recip_interv : forall (f g:R->R) (lb ub x:R)
+       (Prf:forall a : R, g lb <= a <= g ub -> derivable_pt f a) (Prg : continuity_pt g x),
+       lb < ub ->
+       lb < x < ub ->
+       forall (Prg_incr:g lb <= g x <= g ub),
+       (forall x, lb <= x <= ub -> (comp f g) x = id x) ->
+       derive_pt f (g x) (Prf (g x) Prg_incr) <> 0 ->
+       derivable_pt_lim g x (1 / derive_pt f (g x) (Prf (g x) Prg_incr)).
+Proof.
+intros f g lb ub x Prf g_cont_pur lb_lt_ub x_encad Prg_incr f_eq_g df_neq.
+ assert (x_encad2 : lb <= x <= ub).
+  split ; apply Rlt_le ; intuition.
+ elim (Prf (g x)); simpl; intros l Hl.
+ unfold derivable_pt_lim.
+ intros eps eps_pos.
+  pose (y := g x).
+   assert (Hlinv := limit_inv).
+    assert (Hf_deriv : forall eps:R,
+    0 < eps ->
+    exists delta : posreal,
+    (forall h:R,
+    h <> 0 -> Rabs h < delta -> Rabs ((f (g x + h) - f (g x)) / h - l) < eps)).
+     intros eps0 eps0_pos.
+      red in Hl ; red in Hl. elim (Hl eps0 eps0_pos).
+      intros deltatemp Htemp.
+       exists deltatemp ; exact Htemp.
+    elim (Hf_deriv eps eps_pos).
+    intros deltatemp Htemp.
+     red in Hlinv ; red in Hlinv ; simpl dist in Hlinv ; unfold R_dist in Hlinv.
+     assert (Hlinv' := Hlinv (fun h => (f (y+h) - f y)/h) (fun h => h <>0) l 0).
+     unfold limit1_in, limit_in, dist in Hlinv' ; simpl in Hlinv'. unfold R_dist in Hlinv'.
+     assert (Premisse : (forall eps : R,
+     eps > 0 ->
+     exists alp : R,
+     alp > 0 /\
+     (forall x : R,
+     (fun h => h <>0) x /\ Rabs (x - 0) < alp ->
+     Rabs ((f (y + x) - f y) / x - l) < eps))).
+      intros eps0 eps0_pos.
+       elim (Hf_deriv eps0 eps0_pos).
+       intros deltatemp' Htemp'.
+        exists deltatemp'.
+        split.
+         exact deltatemp'.(cond_pos).
+         intros htemp cond.
+          apply (Htemp' htemp).
+          exact (proj1 cond).
+         replace (htemp) with (htemp - 0).
+         exact (proj2 cond).
+         intuition.
+     assert (Premisse2 : l <> 0).
+      intro l_null.
+       rewrite l_null in Hl.
+       apply df_neq.
+       rewrite derive_pt_eq.
+       exact Hl.                
+     elim (Hlinv' Premisse Premisse2 eps eps_pos).
+     intros alpha cond.
+      assert (alpha_pos := proj1 cond) ; assert (inv_cont := proj2 cond) ; clear cond.
+      unfold derivable, derivable_pt, derivable_pt_abs, derivable_pt_lim in Prf.
+      elim (Hl eps eps_pos).
+      intros delta f_deriv.
+       assert (g_cont := g_cont_pur).
+       unfold continuity_pt, continue_in, limit1_in, limit_in in g_cont.
+       pose (mydelta := Rmin delta alpha).
+       assert (mydelta_pos : mydelta > 0).
+        unfold mydelta, Rmin.
+        case (Rle_dec delta alpha).
+        intro ; exact (delta.(cond_pos)).
+        intro ; exact alpha_pos.
+       elim (g_cont mydelta mydelta_pos).
+       intros delta' new_g_cont.
+        assert(delta'_pos := proj1 (new_g_cont)).
+        clear g_cont ; assert (g_cont := proj2 (new_g_cont)) ; clear new_g_cont.
+        pose (mydelta'' := Rmin delta' (Rmin (x - lb) (ub - x))).
+        assert(mydelta''_pos : mydelta'' > 0).
+         unfold mydelta''.
+         apply Rmin_pos ; [intuition | apply Rmin_pos] ; apply Rgt_minus ; intuition.
+        pose (delta'' := mkposreal mydelta'' mydelta''_pos: posreal).
+        exists delta''.
+        intros h h_neq h_le_delta'.
+  assert (lb <= x +h <= ub).
+ assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y).
+  intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n).
+   apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs.
+   apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption.
+ assert (lb <= x + h <= ub).
+ split.
+ assert (Sublemma : forall x y z, -z <= y - x -> x <= y + z).
+  intros ; fourier.
+ apply Sublemma.
+ apply Rlt_le ; apply Sublemma2. rewrite Rabs_Ropp.
+ apply Rlt_le_trans with (r2:=x-lb) ; [| apply RRle_abs] ;
+ apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_l] ;
+ apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))).
+ apply Rlt_le_trans with (r2:=delta''). assumption. intuition. apply Rmin_r.
+ apply Rgt_minus. intuition.
+ assert (Sublemma : forall x y z, y <= z - x -> x + y <= z).
+  intros ; fourier.
+ apply Sublemma.
+ apply Rlt_le ; apply Sublemma2.
+ apply Rlt_le_trans with (r2:=ub-x) ; [| apply RRle_abs] ;
+ apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_r] ;
+ apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))) ; [| apply Rmin_r] ; assumption.
+ apply Rlt_le_trans with (r2:=delta''). assumption.
+  apply Rle_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))). intuition.
+  apply Rle_trans with (r2:=Rmin (x - lb) (ub - x)). apply Rmin_r. apply Rmin_r.
+         replace ((g (x + h) - g x) / h) with (1/ (h / (g (x + h) - g x))).
+         assert (Hrewr : h = (comp f g ) (x+h) - (comp f g) x).
+          rewrite f_eq_g. rewrite f_eq_g ; unfold id. rewrite Rplus_comm ;
+          unfold Rminus ; rewrite Rplus_assoc ; rewrite Rplus_opp_r. intuition. intuition.    
+ assumption.
+         split ; [|intuition].
+         assert (Sublemma : forall x y z, - z <= y - x -> x <= y + z).
+          intros ; fourier.
+         apply Sublemma ; apply Rlt_le ; apply Sublemma2. rewrite Rabs_Ropp.
+ apply Rlt_le_trans with (r2:=x-lb) ; [| apply RRle_abs] ;
+ apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_l] ;
+ apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))) ; [| apply Rmin_r] ; assumption.
+ apply Rgt_minus. intuition.
+ field.
+ split. assumption.
+ intro Hfalse. assert (Hf : g (x+h) = g x) by intuition.
+ assert ((comp f g) (x+h) = (comp f g) x).
+  unfold comp ; rewrite Hf ; intuition.
+ assert (Main : x+h = x).
+ replace (x +h) with (id (x+h)) by intuition.
+ assert (Temp : x = id x) by intuition ; rewrite Temp at 2 ; clear Temp.
+ rewrite <- f_eq_g. rewrite <- f_eq_g. assumption.
+ intuition. assumption.
+ assert (h = 0).
+ apply Rplus_0_r_uniq with (r:=x) ; assumption.
+ apply h_neq ; assumption.
+         replace ((g (x + h) - g x) / h) with (1/ (h / (g (x + h) - g x))).
+         assert (Hrewr : h = (comp f g ) (x+h) - (comp f g) x).
+          rewrite f_eq_g. rewrite f_eq_g. unfold id ; rewrite Rplus_comm ;
+          unfold Rminus ; rewrite Rplus_assoc ; rewrite Rplus_opp_r ; intuition.
+          assumption. assumption.
+         rewrite Hrewr at 1. 
+         unfold comp.
+         replace (g(x+h)) with (g x + (g (x+h) - g(x))) by field.
+         pose (h':=g (x+h) - g x).
+         replace (g (x+h) - g x) with h' by intuition.
+         replace (g x + h' - g x) with h' by field.
+         assert (h'_neq : h' <> 0).
+          unfold h'.
+          intro Hfalse.
+          unfold Rminus in Hfalse ; apply Rminus_diag_uniq in Hfalse.
+          assert (Hfalse' : (comp f g) (x+h) = (comp f g) x).
+           intros ; unfold comp ; rewrite Hfalse ; trivial.
+          rewrite f_eq_g in Hfalse' ; rewrite f_eq_g in Hfalse'.
+          unfold id in Hfalse'.
+          apply Rplus_0_r_uniq in Hfalse'.
+          apply h_neq ; exact Hfalse'. assumption. assumption. assumption.
+         unfold Rdiv at 1 3; rewrite Rmult_1_l ; rewrite Rmult_1_l.
+         apply inv_cont.
+         split.
+          exact h'_neq.
+          rewrite Rminus_0_r. 
+          unfold continuity_pt, continue_in, limit1_in, limit_in in g_cont_pur.
+          elim (g_cont_pur mydelta mydelta_pos).
+          intros delta3 cond3.
+          unfold dist in cond3 ; simpl in cond3 ; unfold R_dist in cond3.
+          unfold h'.
+          assert (mydelta_le_alpha : mydelta <= alpha).
+           unfold mydelta, Rmin ; case (Rle_dec delta alpha).
+           trivial.
+           intro ; intuition.
+          apply Rlt_le_trans with (r2:=mydelta).
+          unfold dist in g_cont ; simpl in g_cont ; unfold R_dist in g_cont ; apply g_cont.
+          split.
+           unfold D_x ; simpl.
+           split.
+            unfold no_cond ; trivial.
+            intro Hfalse ; apply h_neq.
+             apply (Rplus_0_r_uniq x).
+             symmetry ; assumption.
+            replace (x + h - x) with h by field. 
+            apply Rlt_le_trans with (r2:=delta'').
+            assumption ; unfold delta''. intuition.
+            apply Rle_trans with (r2:=mydelta''). apply Req_le. unfold delta''. intuition.
+            apply Rmin_l. assumption.
+            field ; split.
+             assumption.
+             intro Hfalse ; apply h_neq.
+             apply (Rplus_0_r_uniq x).
+             assert (Hfin : (comp f g) (x+h) = (comp f g) x).
+              apply Rminus_diag_uniq in Hfalse.
+              unfold comp.
+              rewrite Hfalse ; reflexivity.
+              rewrite f_eq_g in Hfin. rewrite f_eq_g in Hfin. unfold id in Hfin. exact Hfin.
+              assumption. assumption.
+Qed.
+
+Lemma derivable_pt_recip_interv_prelim0 : forall (f g : R -> R) (lb ub x : R)
+       (Prf : forall a : R, g lb <= a <= g ub -> derivable_pt f a),
+       continuity_pt g x ->
+       lb < ub ->
+       lb < x < ub ->
+       forall Prg_incr : g lb <= g x <= g ub,
+       (forall x0 : R, lb <= x0 <= ub -> comp f g x0 = id x0) ->
+       derive_pt f (g x) (Prf (g x) Prg_incr) <> 0 ->
+       derivable_pt g x.
+Proof.
+intros f g lb ub x Prf g_cont_pt lb_lt_ub x_encad Prg_incr f_eq_g Df_neq.
+unfold derivable_pt, derivable_pt_abs.
+exists (1 / derive_pt f (g x) (Prf (g x) Prg_incr)).
+apply derivable_pt_lim_recip_interv ; assumption.
+Qed.
+
+Lemma derivable_pt_recip_interv_prelim1 :forall (f g:R->R) (lb ub x : R),
+         lb < ub ->
+         f lb < x < f ub ->
+         (forall x : R, f lb <= x -> x <= f ub -> comp f g x = id x) ->
+         (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
+         (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) ->
+         (forall a : R, lb <= a <= ub -> derivable_pt f a) ->
+         derivable_pt f (g x).
+Proof.
+intros f g lb ub x lb_lt_ub x_encad f_eq_g g_ok f_incr f_derivable.
+ apply f_derivable.
+ assert (Left_inv := leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_ok).
+ replace lb with ((comp g f) lb).
+ replace ub with ((comp g f) ub).
+ unfold comp.
+ assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_ok).
+ split ; apply Rlt_le ; apply Temp ; intuition.
+ apply Left_inv ; intuition.
+ apply Left_inv ; intuition.
+Qed.
+
+Lemma derivable_pt_recip_interv : forall (f g:R->R) (lb ub x : R)
+         (lb_lt_ub:lb < ub) (x_encad:f lb < x < f ub)
+         (f_eq_g:forall x : R, f lb <= x -> x <= f ub -> comp f g x = id x)
+         (g_wf:forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub)
+         (f_incr:forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y)
+         (f_derivable:forall a : R, lb <= a <= ub -> derivable_pt f a),
+         derive_pt f (g x)
+              (derivable_pt_recip_interv_prelim1 f g lb ub x lb_lt_ub
+              x_encad f_eq_g g_wf f_incr f_derivable)
+         <> 0 ->
+         derivable_pt g x.
+Proof.
+intros f g lb ub x lb_lt_ub x_encad f_eq_g g_wf f_incr f_derivable Df_neq.
+ assert(g_incr : g (f lb) < g x < g (f ub)).
+  assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_wf).
+  split ; apply Temp ; intuition.
+  exact (proj1 x_encad). apply Rlt_le ; exact (proj2 x_encad).
+  apply Rlt_le ; exact (proj1 x_encad). exact (proj2 x_encad).
+ assert(g_incr2 :  g (f lb) <= g x <= g (f ub)).
+  split ; apply Rlt_le ; intuition.
+ assert (g_eq_f :=  leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_wf).
+ unfold comp, id in g_eq_f.
+ assert (f_derivable2 : forall a : R, g (f lb) <= a <= g (f ub) -> derivable_pt f a).
+  intros a a_encad ; apply f_derivable.
+   rewrite g_eq_f in a_encad ; rewrite g_eq_f in a_encad ; intuition.
+ apply derivable_pt_recip_interv_prelim0 with (f:=f) (lb:=f lb) (ub:=f ub)
+     (Prf:=f_derivable2) (Prg_incr:=g_incr2).
+ apply continuity_pt_recip_interv with (f:=f) (lb:=lb) (ub:=ub) ; intuition.
+ apply derivable_continuous_pt ; apply f_derivable ; intuition.
+ exact (proj1 x_encad). exact (proj2 x_encad).  apply f_incr ; intuition.
+ assumption.
+ intros x0 x0_encad ; apply f_eq_g ; intuition.
+ rewrite pr_nu_var2_interv with (g:=f) (lb:=lb) (ub:=ub) (pr2:=derivable_pt_recip_interv_prelim1 f g lb ub x lb_lt_ub x_encad
+      f_eq_g g_wf f_incr f_derivable) ; [| |rewrite g_eq_f in g_incr ; rewrite g_eq_f in g_incr| ] ; intuition.
+Qed.
+
+(****************************************************)
+(** *   Value of the derivative of the reciprocal function        *)
+(****************************************************)
+
+Lemma derive_pt_recip_interv_prelim0 : forall (f g:R->R) (lb ub x:R)
+       (Prf:derivable_pt f (g x)) (Prg:derivable_pt g x),
+       lb < ub ->
+       lb < x < ub ->
+       (forall x, lb < x < ub -> (comp f g) x = id x) ->
+       derive_pt f (g x) Prf <> 0 ->
+       derive_pt g x Prg = 1 / (derive_pt f (g x) Prf).
+Proof.
+intros f g lb ub x Prf Prg lb_lt_ub x_encad local_recip Df_neq.
+ replace (derive_pt g x Prg) with
+  ((derive_pt g x Prg) * (derive_pt f (g x) Prf) * / (derive_pt f (g x) Prf)).
+ unfold Rdiv.
+ rewrite (Rmult_comm _ (/ derive_pt f (g x) Prf)).
+ rewrite (Rmult_comm _ (/ derive_pt f (g x) Prf)). 
+ apply Rmult_eq_compat_l. 
+ rewrite Rmult_comm.
+ rewrite <- derive_pt_comp.
+ assert (x_encad2 : lb <= x <= ub) by intuition.
+ rewrite pr_nu_var2_interv with (g:=id) (pr2:= derivable_pt_id_interv lb ub x x_encad2) (lb:=lb) (ub:=ub) ; [reg| | |] ; assumption.
+ rewrite Rmult_assoc, Rinv_r.
+ intuition.
+ assumption.
+Qed.
+
+Lemma derive_pt_recip_interv_prelim1_0 : forall (f g:R->R) (lb ub x:R), 
+       lb < ub ->
+       f lb < x < f ub ->
+       (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) ->
+       (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
+       (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) ->
+       lb < g x < ub.
+Proof.
+intros f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g.
+ assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_wf).
+ assert (Left_inv := leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_wf).
+ unfold comp, id in Left_inv.
+ split ; [rewrite <- Left_inv with (x:=lb) | rewrite <- Left_inv ].
+ apply Temp ; intuition.
+ intuition.
+ apply Temp ; intuition.
+ intuition.
+Qed.
+
+Lemma derive_pt_recip_interv_prelim1_1 : forall (f g:R->R) (lb ub x:R), 
+       lb < ub ->
+       f lb < x < f ub ->
+       (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) ->
+       (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
+       (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) ->
+       lb <= g x <= ub.
+Proof.
+intros f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g.
+ assert (Temp := derive_pt_recip_interv_prelim1_0 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g).
+ split ; apply Rlt_le ; intuition.
+Qed.
+
+Lemma derive_pt_recip_interv : forall (f g:R->R) (lb ub x:R)
+       (lb_lt_ub:lb < ub) (x_encad:f lb < x < f ub)
+       (f_incr:forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y)
+       (g_wf:forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub)
+       (Prf:forall a : R, lb <= a <= ub -> derivable_pt f a)
+       (f_eq_g:forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x)
+       (Df_neq:derive_pt f (g x) (derivable_pt_recip_interv_prelim1 f g lb ub x
+                 lb_lt_ub x_encad f_eq_g g_wf f_incr Prf) <> 0),
+       derive_pt g x (derivable_pt_recip_interv f g lb ub x lb_lt_ub x_encad f_eq_g
+                 g_wf f_incr Prf Df_neq)
+       =
+       1 / (derive_pt f (g x) (Prf (g x) (derive_pt_recip_interv_prelim1_1 f g lb ub x
+       lb_lt_ub x_encad f_incr g_wf f_eq_g))).
+Proof.
+intros.
+ assert(g_incr := (derive_pt_recip_interv_prelim1_1 f g lb ub x lb_lt_ub
+        x_encad f_incr g_wf f_eq_g)).
+ apply derive_pt_recip_interv_prelim0 with (lb:=f lb) (ub:=f ub) ;
+ [intuition |assumption | intuition |].
+ intro Hfalse ; apply Df_neq.  rewrite pr_nu_var2_interv with (g:=f) (lb:=lb) (ub:=ub)
+        (pr2:= (Prf (g x) (derive_pt_recip_interv_prelim1_1 f g lb ub x lb_lt_ub x_encad
+                 f_incr g_wf f_eq_g))) ;
+ [intuition | intuition | | intuition].
+ exact (derive_pt_recip_interv_prelim1_0 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g).
+Qed.
+  
+(****************************************************)
+(** * Existence of the derivative of a function which is the limit of a sequence of functions *)
+(****************************************************)
+
+(* begin hide *)
+Lemma ub_lt_2_pos : forall x ub lb, lb < x -> x < ub -> 0 < (ub-lb)/2.
+Proof.
+intros x ub lb lb_lt_x x_lt_ub.
+ assert (T : 0 < ub - lb).
+  fourier.
+ unfold Rdiv ; apply Rlt_mult_inv_pos ; intuition.
+Qed.
+
+Definition mkposreal_lb_ub (x lb ub:R) (lb_lt_x:lb<x) (x_lt_ub:x<ub) : posreal.
+ apply (mkposreal ((ub-lb)/2) (ub_lt_2_pos x ub lb lb_lt_x x_lt_ub)).
+Defined.
+(* end hide *)
+
+Definition boule_of_interval x y (h : x < y) :
+  {c :R & {r : posreal | c - r = x /\ c + r = y}}.
+exists ((x + y)/2).
+assert (radius : 0 < (y - x)/2).
+ unfold Rdiv; apply Rmult_lt_0_compat; fourier.
+ exists (mkposreal _ radius).
+ simpl; split; unfold Rdiv; field.
+Qed.
+
+Definition boule_in_interval x y z (h : x < z < y) :
+  {c : R & {r | Boule c r z /\  x < c - r /\ c + r < y}}.
+Proof.
+assert (cmp : x * /2 + z * /2 < z * /2 + y * /2).
+destruct h as [h1 h2]; fourier.
+destruct (boule_of_interval _ _ cmp) as [c [r [P1 P2]]].
+exists c, r; split.
+ destruct h; unfold Boule; simpl; apply Rabs_def1; fourier.
+destruct h; split; fourier.
+Qed.
+
+Lemma Ball_in_inter : forall c1 c2 r1 r2 x,
+  Boule c1 r1 x -> Boule c2 r2 x ->
+  {r3 : posreal | forall y, Boule x r3 y -> Boule c1 r1 y /\ Boule c2 r2 y}.
+intros c1 c2 [r1 r1p] [r2 r2p] x; unfold Boule; simpl; intros in1 in2.
+assert (Rmax (c1 - r1)(c2 - r2) < x).
+ apply Rmax_lub_lt;[revert in1 | revert in2]; intros h;
+  apply Rabs_def2 in h; destruct h; fourier.
+assert (x < Rmin (c1 + r1) (c2 + r2)).
+ apply Rmin_glb_lt;[revert in1 | revert in2]; intros h;
+  apply Rabs_def2 in h; destruct h; fourier.
+assert (t: 0 < Rmin (x - Rmax (c1 - r1) (c2 - r2)) 
+              (Rmin (c1 + r1) (c2 + r2) - x)).
+ apply Rmin_glb_lt; fourier.
+exists (mkposreal _ t).
+apply Rabs_def2 in in1; destruct in1.
+apply Rabs_def2 in in2; destruct in2.
+assert (c1 - r1 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_l.
+assert (c2 - r2 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_r.
+assert (Rmin (c1 + r1) (c2 + r2) <= c1 + r1) by apply Rmin_l.
+assert (Rmin (c1 + r1) (c2 + r2) <= c2 + r2) by apply Rmin_r.
+assert (Rmin (x - Rmax (c1 - r1) (c2 - r2)) 
+         (Rmin (c1 + r1) (c2 + r2) - x) <= x - Rmax (c1 - r1) (c2 - r2))
+ by apply Rmin_l.
+assert (Rmin (x - Rmax (c1 - r1) (c2 - r2)) 
+         (Rmin (c1 + r1) (c2 + r2) - x) <= Rmin (c1 + r1) (c2 + r2) - x)
+ by apply Rmin_r.
+simpl.
+intros y h; apply Rabs_def2 in h; destruct h;split; apply Rabs_def1; fourier.
+Qed.
+
+Lemma Boule_center : forall x r, Boule x r x.
+Proof.
+intros x [r rpos]; unfold Boule, Rminus; simpl; rewrite Rplus_opp_r.
+rewrite Rabs_pos_eq;[assumption | apply Rle_refl].
+Qed.
+
+Lemma derivable_pt_lim_CVU : forall (fn fn':nat -> R -> R) (f g:R->R)
+      (x:R) c r, Boule c r x ->
+      (forall y n, Boule c r y -> derivable_pt_lim (fn n) y (fn' n y)) ->
+      (forall y, Boule c r y -> Un_cv (fun n => fn n y) (f y)) ->
+      (CVU fn' g c r) ->
+      (forall y, Boule c r y -> continuity_pt g y) ->
+      derivable_pt_lim f x (g x).
+Proof.
+intros fn fn' f g x c' r xinb Dfn_eq_fn' fn_CV_f fn'_CVU_g g_cont eps eps_pos.
+assert (eps_8_pos : 0 < eps / 8) by fourier.
+elim (g_cont x xinb _ eps_8_pos) ; clear g_cont ;
+intros delta1 (delta1_pos, g_cont).
+destruct (Ball_in_inter _ _ _ _ _ xinb
+   (Boule_center x (mkposreal _ delta1_pos)))
+   as [delta Pdelta].
+exists delta; intros h hpos hinbdelta.
+assert (eps'_pos : 0 < (Rabs h) * eps / 4).
+ unfold Rdiv ; rewrite Rmult_assoc ; apply Rmult_lt_0_compat.
+ apply Rabs_pos_lt ; assumption.
+fourier.
+destruct (fn_CV_f x xinb ((Rabs h) * eps / 4) eps'_pos) as [N2 fnx_CV_fx].
+assert (xhinbxdelta : Boule x delta (x + h)).
+ clear -hinbdelta; apply Rabs_def2 in hinbdelta; unfold Boule; simpl.
+ destruct hinbdelta; apply Rabs_def1; fourier.
+assert (t : Boule c' r (x + h)).
+ apply Pdelta in xhinbxdelta; tauto.
+destruct (fn_CV_f (x+h) t ((Rabs h) * eps / 4) eps'_pos) as [N1 fnxh_CV_fxh].
+clear fn_CV_f t.
+destruct (fn'_CVU_g (eps/8) eps_8_pos) as [N3 fn'c_CVU_gc].
+pose (N := ((N1 + N2) + N3)%nat).
+assert (Main : Rabs ((f (x+h) - fn N (x+h)) - (f x - fn N x) + (fn N (x+h) - fn N x - h * (g x))) < (Rabs h)*eps).
+ apply Rle_lt_trans with (Rabs (f (x + h) - fn N (x + h) - (f x - fn N x)) +  Rabs ((fn N (x + h) - fn N x - h * g x))).
+  solve[apply Rabs_triang].
+ apply Rle_lt_trans with (Rabs (f (x + h) - fn N (x + h)) + Rabs (- (f x - fn N x)) + Rabs (fn N (x + h) - fn N x - h * g x)).
+  solve[apply Rplus_le_compat_r ; apply Rabs_triang].
+ rewrite Rabs_Ropp.
+ case (Rlt_le_dec h 0) ; intro sgn_h.
+  assert (pr1 : forall c : R, x + h < c < x -> derivable_pt (fn N) c).
+   intros c c_encad ; unfold derivable_pt.
+   exists (fn' N c) ; apply Dfn_eq_fn'.
+   assert (t : Boule x delta c).
+    apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta; destruct c_encad.
+    apply Rabs_def2 in xinb; apply Rabs_def1; fourier.
+   apply Pdelta in t; tauto.
+  assert (pr2 : forall c : R, x + h < c < x -> derivable_pt id c).
+   solve[intros; apply derivable_id].
+  assert (xh_x : x+h < x) by fourier.
+  assert (pr3 : forall c : R, x + h <= c <= x -> continuity_pt (fn N) c).
+   intros c c_encad ; apply derivable_continuous_pt.
+   exists (fn' N c) ; apply Dfn_eq_fn' ; intuition.
+   assert (t : Boule x delta c).
+    apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
+    apply Rabs_def2 in xinb; apply Rabs_def1; fourier.
+   apply Pdelta in t; tauto.
+  assert (pr4 : forall c : R, x + h <= c <= x -> continuity_pt id c).
+   solve[intros; apply derivable_continuous ; apply derivable_id].
+  destruct (MVT (fn N) id (x+h) x pr1 pr2 xh_x pr3 pr4) as [c [P Hc]].
+  assert (Hc' : h * derive_pt (fn N) c (pr1 c P) = (fn N (x+h) - fn N x)).
+   apply Rmult_eq_reg_l with (-1).
+    replace (-1 * (h * derive_pt (fn N) c (pr1 c P))) with (-h * derive_pt (fn N) c (pr1 c P)) by field.
+    replace (-1 * (fn N (x + h) - fn N x)) with (- (fn N (x + h) - fn N x)) by field.
+    replace (-h) with (id x - id (x + h)) by (unfold id; field).
+    rewrite <- Rmult_1_r ; replace 1 with (derive_pt id c (pr2 c P)) by reg.
+    replace (- (fn N (x + h) - fn N x)) with (fn N x - fn N (x + h)) by field.
+    assumption.
+   solve[apply Rlt_not_eq ; intuition].
+  rewrite <- Hc'; clear Hc Hc'.
+  replace (derive_pt (fn N) c (pr1 c P)) with (fn' N c).
+  replace (h * fn' N c - h * g x) with (h * (fn' N c - g x)) by field.
+   rewrite Rabs_mult.
+   apply Rlt_trans with (Rabs h * eps / 4 + Rabs (f x - fn N x) + Rabs h * Rabs (fn' N c - g x)).
+    apply Rplus_lt_compat_r ; apply Rplus_lt_compat_r ; unfold R_dist in fnxh_CV_fxh ;
+ rewrite Rabs_minus_sym ; apply fnxh_CV_fxh.
+   unfold N; omega.
+   apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g x)).
+    apply Rplus_lt_compat_r ; apply Rplus_lt_compat_l.
+    unfold R_dist in fnx_CV_fx ; rewrite Rabs_minus_sym ; apply fnx_CV_fx.
+    unfold N ; omega.
+   replace (fn' N c - g x)  with ((fn' N c - g c) +  (g c - g x)) by field.
+   apply Rle_lt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 +
+          Rabs h * Rabs (fn' N c - g c) + Rabs h * Rabs (g c - g x)).
+    rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ;
+    apply Rplus_le_compat_l ; apply Rplus_le_compat_l ;
+    rewrite <- Rmult_plus_distr_l ; apply Rmult_le_compat_l. 
+     solve[apply Rabs_pos].
+    solve[apply Rabs_triang].
+   apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 +
+          Rabs h * (eps / 8) + Rabs h * Rabs (g c - g x)).
+    apply Rplus_lt_compat_r; apply Rplus_lt_compat_l; apply Rmult_lt_compat_l.
+     apply Rabs_pos_lt ; assumption.
+    rewrite Rabs_minus_sym ; apply fn'c_CVU_gc.
+     unfold N ; omega.
+    assert (t : Boule x delta c).
+     destruct P.
+     apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
+     apply Rabs_def2 in xinb; apply Rabs_def1; fourier.
+    apply Pdelta in t; tauto.
+   apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) +
+         Rabs h * (eps / 8)).
+    rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ;
+    apply Rplus_lt_compat_l ; apply Rplus_lt_compat_l ; rewrite <- Rmult_plus_distr_l ;
+    rewrite <- Rmult_plus_distr_l ; apply Rmult_lt_compat_l.
+     apply Rabs_pos_lt ; assumption.
+     apply Rplus_lt_compat_l ; simpl in g_cont ; apply g_cont ; split ; [unfold D_x ; split |].
+      solve[unfold no_cond ; intuition].
+     apply Rgt_not_eq ; exact (proj2 P).
+    apply Rlt_trans with (Rabs h).
+     apply Rabs_def1. 
+      apply Rlt_trans with 0.
+       destruct P; fourier.
+      apply Rabs_pos_lt ; assumption.
+     rewrite <- Rabs_Ropp, Rabs_pos_eq, Ropp_involutive;[ | fourier]. 
+     destruct P; fourier.
+    clear -Pdelta xhinbxdelta.
+    apply Pdelta in xhinbxdelta; destruct xhinbxdelta as [_ P'].
+    apply Rabs_def2 in P'; simpl in P'; destruct P';
+    apply Rabs_def1; fourier.
+   rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite <- Rmult_plus_distr_l.
+   replace (Rabs h * eps / 4 + (Rabs h * eps / 4 + Rabs h * (eps / 8 + eps / 8))) with
+      (Rabs h * (eps / 4 + eps / 4 + eps / 8 + eps / 8)) by field.
+   apply Rmult_lt_compat_l. 
+    apply Rabs_pos_lt ; assumption.
+   fourier.
+  assert (H := pr1 c P) ; elim H ; clear H ; intros l Hl.
+  assert (Temp : l = fn' N c).
+   assert (bc'rc : Boule c' r c).
+    assert (t : Boule x delta c).
+     clear - xhinbxdelta P.
+     destruct P; apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
+     apply Rabs_def1; fourier.
+    apply Pdelta in t; tauto.
+   assert (Hl' := Dfn_eq_fn' c N bc'rc).
+   unfold derivable_pt_abs in Hl; clear -Hl Hl'.
+   apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption.
+  rewrite <- Temp.
+  assert (Hl' : derivable_pt (fn N) c).
+  exists l ; apply Hl.
+  rewrite pr_nu_var with (g:= fn N) (pr2:=Hl').
+   elim Hl' ; clear Hl' ; intros l' Hl'.
+   assert (Main : l = l').
+    apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption.
+   rewrite Main ; reflexivity.
+  reflexivity.
+ assert (h_pos : h > 0).
+  case sgn_h ; intro Hyp.
+  assumption.
+  apply False_ind ; apply hpos ; symmetry ; assumption.
+ clear sgn_h.
+ assert (pr1 : forall c : R, x < c < x + h -> derivable_pt (fn N) c).
+  intros c c_encad ; unfold derivable_pt.
+  exists (fn' N c) ; apply Dfn_eq_fn'.
+  assert (t : Boule x delta c).
+   apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta; destruct c_encad.
+   apply Rabs_def2 in xinb; apply Rabs_def1; fourier.
+  apply Pdelta in t; tauto.
+  assert (pr2 : forall c : R, x < c < x + h -> derivable_pt id c).
+   solve[intros; apply derivable_id].
+  assert (xh_x : x < x + h) by fourier.
+  assert (pr3 : forall c : R, x <= c <= x + h -> continuity_pt (fn N) c).
+   intros c c_encad ; apply derivable_continuous_pt.
+   exists (fn' N c) ; apply Dfn_eq_fn' ; intuition.
+   assert (t : Boule x delta c).
+    apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
+    apply Rabs_def2 in xinb; apply Rabs_def1; fourier.
+   apply Pdelta in t; tauto.
+  assert (pr4 : forall c : R, x <= c <= x + h -> continuity_pt id c).
+   solve[intros; apply derivable_continuous ; apply derivable_id].
+  destruct (MVT (fn N) id x (x+h) pr1 pr2 xh_x pr3 pr4) as [c [P Hc]].
+  assert (Hc' : h * derive_pt (fn N) c (pr1 c P) = fn N (x+h) - fn N x).
+    pattern h at 1; replace h with (id (x + h) - id x) by (unfold id; field).
+    rewrite <- Rmult_1_r ; replace 1 with (derive_pt id c (pr2 c P)) by reg.
+    assumption.
+  rewrite <- Hc'; clear Hc Hc'.
+  replace (derive_pt (fn N) c (pr1 c P)) with (fn' N c).
+  replace (h * fn' N c - h * g x) with (h * (fn' N c - g x)) by field.
+   rewrite Rabs_mult.
+   apply Rlt_trans with (Rabs h * eps / 4 + Rabs (f x - fn N x) + Rabs h * Rabs (fn' N c - g x)).
+    apply Rplus_lt_compat_r ; apply Rplus_lt_compat_r ; unfold R_dist in fnxh_CV_fxh ;
+ rewrite Rabs_minus_sym ; apply fnxh_CV_fxh.
+   unfold N; omega.
+   apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g x)).
+    apply Rplus_lt_compat_r ; apply Rplus_lt_compat_l.
+    unfold R_dist in fnx_CV_fx ; rewrite Rabs_minus_sym ; apply fnx_CV_fx.
+    unfold N ; omega.
+   replace (fn' N c - g x)  with ((fn' N c - g c) +  (g c - g x)) by field.
+   apply Rle_lt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 +
+          Rabs h * Rabs (fn' N c - g c) + Rabs h * Rabs (g c - g x)).
+    rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ;
+    apply Rplus_le_compat_l ; apply Rplus_le_compat_l ;
+    rewrite <- Rmult_plus_distr_l ; apply Rmult_le_compat_l. 
+     solve[apply Rabs_pos].
+    solve[apply Rabs_triang].
+   apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 +
+          Rabs h * (eps / 8) + Rabs h * Rabs (g c - g x)).
+    apply Rplus_lt_compat_r; apply Rplus_lt_compat_l; apply Rmult_lt_compat_l.
+     apply Rabs_pos_lt ; assumption.
+    rewrite Rabs_minus_sym ; apply fn'c_CVU_gc.
+     unfold N ; omega.
+    assert (t : Boule x delta c).
+     destruct P.
+    apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
+    apply Rabs_def2 in xinb; apply Rabs_def1; fourier.
+   apply Pdelta in t; tauto.
+  apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) +
+         Rabs h * (eps / 8)).
+   rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ;
+    apply Rplus_lt_compat_l ; apply Rplus_lt_compat_l ; rewrite <- Rmult_plus_distr_l ;
+   rewrite <- Rmult_plus_distr_l ; apply Rmult_lt_compat_l.
+    apply Rabs_pos_lt ; assumption.
+   apply Rplus_lt_compat_l ; simpl in g_cont ; apply g_cont ; split ; [unfold D_x ; split |].
+     solve[unfold no_cond ; intuition].
+    apply Rlt_not_eq ; exact (proj1 P).
+   apply Rlt_trans with (Rabs h).
+    apply Rabs_def1.
+     destruct P; rewrite Rabs_pos_eq;fourier.
+    apply Rle_lt_trans with 0.
+     assert (t := Rabs_pos h); clear -t; fourier.
+    clear -P; destruct P; fourier.
+   clear -Pdelta xhinbxdelta.
+   apply Pdelta in xhinbxdelta; destruct xhinbxdelta as [_ P'].
+   apply Rabs_def2 in P'; simpl in P'; destruct P';
+    apply Rabs_def1; fourier.
+  rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite <- Rmult_plus_distr_l.
+  replace (Rabs h * eps / 4 + (Rabs h * eps / 4 + Rabs h * (eps / 8 + eps / 8))) with
+      (Rabs h * (eps / 4 + eps / 4 + eps / 8 + eps / 8)) by field.
+  apply Rmult_lt_compat_l. 
+   apply Rabs_pos_lt ; assumption.
+  fourier.
+ assert (H := pr1 c P) ; elim H ; clear H ; intros l Hl.
+ assert (Temp : l = fn' N c).
+  assert (bc'rc : Boule c' r c).
+   assert (t : Boule x delta c).
+    clear - xhinbxdelta P.
+    destruct P; apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
+    apply Rabs_def1; fourier.
+   apply Pdelta in t; tauto.
+  assert (Hl' := Dfn_eq_fn' c N bc'rc).
+  unfold derivable_pt_abs in Hl; clear -Hl Hl'.
+  apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption.
+ rewrite <- Temp.
+ assert (Hl' : derivable_pt (fn N) c).
+ exists l ; apply Hl.
+ rewrite pr_nu_var with (g:= fn N) (pr2:=Hl').
+  elim Hl' ; clear Hl' ; intros l' Hl'.
+  assert (Main : l = l').
+   apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption.
+  rewrite Main ; reflexivity.
+ reflexivity.
+ replace ((f (x + h) - f x) / h - g x) with ((/h) * ((f (x + h) - f x) - h * g x)). 
+ rewrite Rabs_mult ; rewrite Rabs_Rinv.
+ replace eps with (/ Rabs h * (Rabs h * eps)).
+ apply Rmult_lt_compat_l.
+ apply Rinv_0_lt_compat ; apply Rabs_pos_lt ; assumption.
+ replace (f (x + h) - f x - h * g x) with (f (x + h) - fn N (x + h) - (f x - fn N x) +
+          (fn N (x + h) - fn N x - h * g x)) by field.
+ assumption.
+ field ; apply Rgt_not_eq ; apply Rabs_pos_lt ; assumption.
+ assumption.
+ field. assumption.
+Qed.
\ No newline at end of file
diff --git a/theories/Reals/Ranalysis_reg.v b/theories/Reals/Ranalysis_reg.v
new file mode 100644
index 00000000..a4b18288
--- /dev/null
+++ b/theories/Reals/Ranalysis_reg.v
@@ -0,0 +1,800 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import Rtrigo1.
+Require Import SeqSeries.
+Require Export Ranalysis1.
+Require Export Ranalysis2.
+Require Export Ranalysis3.
+Require Export Rtopology.
+Require Export MVT.
+Require Export PSeries_reg.
+Require Export Exp_prop.
+Require Export Rtrigo_reg.
+Require Export Rsqrt_def.
+Require Export R_sqrt.
+Require Export Rtrigo_calc.
+Require Export Rgeom.
+Require Export RList.
+Require Export Sqrt_reg.
+Require Export Ranalysis4.
+Require Export Rpower.
+Local Open Scope R_scope.
+
+Axiom AppVar : R.
+
+(**********)
+Ltac intro_hyp_glob trm :=
+  match constr:trm with
+    | (?X1 + ?X2)%F =>
+      match goal with
+        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+        | _ => idtac
+      end
+    | (?X1 - ?X2)%F =>
+      match goal with
+        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+        | _ => idtac
+      end
+    | (?X1 * ?X2)%F =>
+      match goal with
+        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+        | _ => idtac
+      end
+    | (?X1 / ?X2)%F =>
+      let aux := constr:X2 in
+        match goal with
+          | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
+            intro_hyp_glob X1; intro_hyp_glob X2
+          | _:(forall x0:R, aux x0 <> 0) |- (continuity _) =>
+            intro_hyp_glob X1; intro_hyp_glob X2
+          |  |- (derivable _) =>
+            cut (forall x0:R, aux x0 <> 0);
+              [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
+          |  |- (continuity _) =>
+            cut (forall x0:R, aux x0 <> 0);
+              [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
+          | _ => idtac
+        end
+    | (comp ?X1 ?X2) =>
+      match goal with
+        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+        | _ => idtac
+      end
+    | (- ?X1)%F =>
+      match goal with
+        |  |- (derivable _) => intro_hyp_glob X1
+        |  |- (continuity _) => intro_hyp_glob X1
+        | _ => idtac
+      end
+    | (/ ?X1)%F =>
+      let aux := constr:X1 in
+        match goal with
+          | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
+            intro_hyp_glob X1
+          | _:(forall x0:R, aux x0 <> 0) |- (continuity _) =>
+            intro_hyp_glob X1
+          |  |- (derivable _) =>
+            cut (forall x0:R, aux x0 <> 0);
+              [ intro; intro_hyp_glob X1 | try assumption ]
+          |  |- (continuity _) =>
+            cut (forall x0:R, aux x0 <> 0);
+              [ intro; intro_hyp_glob X1 | try assumption ]
+          | _ => idtac
+        end
+    | cos => idtac
+    | sin => idtac
+    | cosh => idtac
+    | sinh => idtac
+    | exp => idtac
+    | Rsqr => idtac
+    | sqrt => idtac
+    | id => idtac
+    | (fct_cte _) => idtac
+    | (pow_fct _) => idtac
+    | Rabs => idtac
+    | ?X1 =>
+      let p := constr:X1 in
+        match goal with
+          | _:(derivable p) |- _ => idtac
+          |  |- (derivable p) => idtac
+          |  |- (derivable _) =>
+            cut (True -> derivable p);
+              [ intro HYPPD; cut (derivable p);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          | _:(continuity p) |- _ => idtac
+          |  |- (continuity p) => idtac
+          |  |- (continuity _) =>
+            cut (True -> continuity p);
+              [ intro HYPPD; cut (continuity p);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          | _ => idtac
+        end
+  end.
+
+(**********)
+Ltac intro_hyp_pt trm pt :=
+  match constr:trm with
+    | (?X1 + ?X2)%F =>
+      match goal with
+        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (derive_pt _ _ _ = _) =>
+          intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        | _ => idtac
+      end
+    | (?X1 - ?X2)%F =>
+      match goal with
+        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (derive_pt _ _ _ = _) =>
+          intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        | _ => idtac
+      end
+    | (?X1 * ?X2)%F =>
+      match goal with
+        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (derive_pt _ _ _ = _) =>
+          intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        | _ => idtac
+      end
+    | (?X1 / ?X2)%F =>
+      let aux := constr:X2 in
+        match goal with
+          | _:(aux pt <> 0) |- (derivable_pt _ _) =>
+            intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | _:(aux pt <> 0) |- (continuity_pt _ _) =>
+            intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
+            intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          |  |- (derivable_pt _ _) =>
+            cut (aux pt <> 0);
+              [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
+          |  |- (continuity_pt _ _) =>
+            cut (aux pt <> 0);
+              [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
+          |  |- (derive_pt _ _ _ = _) =>
+            cut (aux pt <> 0);
+              [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
+          | _ => idtac
+        end
+    | (comp ?X1 ?X2) =>
+      match goal with
+        |  |- (derivable_pt _ _) =>
+          let pt_f1 := eval cbv beta in (X2 pt) in
+            (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
+        |  |- (continuity_pt _ _) =>
+          let pt_f1 := eval cbv beta in (X2 pt) in
+            (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
+        |  |- (derive_pt _ _ _ = _) =>
+          let pt_f1 := eval cbv beta in (X2 pt) in
+            (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
+        | _ => idtac
+      end
+    | (- ?X1)%F =>
+      match goal with
+        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt
+        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt
+        |  |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt
+        | _ => idtac
+      end
+    | (/ ?X1)%F =>
+      let aux := constr:X1 in
+        match goal with
+          | _:(aux pt <> 0) |- (derivable_pt _ _) =>
+            intro_hyp_pt X1 pt
+          | _:(aux pt <> 0) |- (continuity_pt _ _) =>
+            intro_hyp_pt X1 pt
+          | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
+            intro_hyp_pt X1 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt
+          |  |- (derivable_pt _ _) =>
+            cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
+          |  |- (continuity_pt _ _) =>
+            cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
+          |  |- (derive_pt _ _ _ = _) =>
+            cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
+          | _ => idtac
+        end
+    | cos => idtac
+    | sin => idtac
+    | cosh => idtac
+    | sinh => idtac
+    | exp => idtac
+    | Rsqr => idtac
+    | id => idtac
+    | (fct_cte _) => idtac
+    | (pow_fct _) => idtac
+    | sqrt =>
+      match goal with
+        |  |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ]
+        |  |- (continuity_pt _ _) =>
+          cut (0 <= pt); [ intro | try assumption ]
+        |  |- (derive_pt _ _ _ = _) =>
+          cut (0 < pt); [ intro | try assumption ]
+        | _ => idtac
+      end
+    | Rabs =>
+      match goal with
+        |  |- (derivable_pt _ _) =>
+          cut (pt <> 0); [ intro | try assumption ]
+        | _ => idtac
+      end
+    | ?X1 =>
+      let p := constr:X1 in
+        match goal with
+          | _:(derivable_pt p pt) |- _ => idtac
+          |  |- (derivable_pt p pt) => idtac
+          |  |- (derivable_pt _ _) =>
+            cut (True -> derivable_pt p pt);
+              [ intro HYPPD; cut (derivable_pt p pt);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          | _:(continuity_pt p pt) |- _ => idtac
+          |  |- (continuity_pt p pt) => idtac
+          |  |- (continuity_pt _ _) =>
+            cut (True -> continuity_pt p pt);
+              [ intro HYPPD; cut (continuity_pt p pt);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          |  |- (derive_pt _ _ _ = _) =>
+            cut (True -> derivable_pt p pt);
+              [ intro HYPPD; cut (derivable_pt p pt);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          | _ => idtac
+        end
+  end.
+
+(**********)
+Ltac is_diff_pt :=
+  match goal with
+    |  |- (derivable_pt Rsqr _) =>
+
+  (* fonctions de base *)
+      apply derivable_pt_Rsqr
+    |  |- (derivable_pt id ?X1) => apply (derivable_pt_id X1)
+    |  |- (derivable_pt (fct_cte _) _) => apply derivable_pt_const
+    |  |- (derivable_pt sin _) => apply derivable_pt_sin
+    |  |- (derivable_pt cos _) => apply derivable_pt_cos
+    |  |- (derivable_pt sinh _) => apply derivable_pt_sinh
+    |  |- (derivable_pt cosh _) => apply derivable_pt_cosh
+    |  |- (derivable_pt exp _) => apply derivable_pt_exp
+    |  |- (derivable_pt (pow_fct _) _) =>
+      unfold pow_fct in |- *; apply derivable_pt_pow
+    |  |- (derivable_pt sqrt ?X1) =>
+      apply (derivable_pt_sqrt X1);
+        assumption ||
+          unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
+            comp, id, fct_cte, pow_fct in |- *
+    |  |- (derivable_pt Rabs ?X1) =>
+      apply (Rderivable_pt_abs X1);
+        assumption ||
+          unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
+            comp, id, fct_cte, pow_fct in |- *
+        (* regles de differentiabilite *)
+        (* PLUS *)
+    |  |- (derivable_pt (?X1 + ?X2) ?X3) =>
+      apply (derivable_pt_plus X1 X2 X3); is_diff_pt
+       (* MOINS *)
+    |  |- (derivable_pt (?X1 - ?X2) ?X3) =>
+      apply (derivable_pt_minus X1 X2 X3); is_diff_pt
+       (* OPPOSE *)
+    |  |- (derivable_pt (- ?X1) ?X2) =>
+      apply (derivable_pt_opp X1 X2);
+        is_diff_pt
+       (* MULTIPLICATION PAR UN SCALAIRE *)
+    |  |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) =>
+      apply (derivable_pt_scal X2 X1 X3); is_diff_pt
+       (* MULTIPLICATION *)
+    |  |- (derivable_pt (?X1 * ?X2) ?X3) =>
+      apply (derivable_pt_mult X1 X2 X3); is_diff_pt
+       (* DIVISION *)
+    |  |- (derivable_pt (?X1 / ?X2) ?X3) =>
+      apply (derivable_pt_div X1 X2 X3);
+        [ is_diff_pt
+          | is_diff_pt
+          | try
+            assumption ||
+              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+                comp, pow_fct, id, fct_cte in |- * ]
+    |  |- (derivable_pt (/ ?X1) ?X2) =>
+
+       (* INVERSION *)
+      apply (derivable_pt_inv X1 X2);
+        [ assumption ||
+          unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+            comp, pow_fct, id, fct_cte in |- *
+          | is_diff_pt ]
+    |  |- (derivable_pt (comp ?X1 ?X2) ?X3) =>
+
+       (* COMPOSITION *)
+      apply (derivable_pt_comp X2 X1 X3); is_diff_pt
+    | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) =>
+      assumption
+    | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) =>
+      cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ]
+    |  |- (True -> derivable_pt _ _) =>
+      intro HypTruE; clear HypTruE; is_diff_pt
+    | _ =>
+      try
+        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+          fct_cte, comp, pow_fct in |- *
+  end.
+
+(**********)
+Ltac is_diff_glob :=
+  match goal with
+    |  |- (derivable Rsqr) =>
+  (* fonctions de base *)
+      apply derivable_Rsqr
+    |  |- (derivable id) => apply derivable_id
+    |  |- (derivable (fct_cte _)) => apply derivable_const
+    |  |- (derivable sin) => apply derivable_sin
+    |  |- (derivable cos) => apply derivable_cos
+    |  |- (derivable cosh) => apply derivable_cosh
+    |  |- (derivable sinh) => apply derivable_sinh
+    |  |- (derivable exp) => apply derivable_exp
+    |  |- (derivable (pow_fct _)) =>
+      unfold pow_fct in |- *;
+        apply derivable_pow
+        (* regles de differentiabilite *)
+        (* PLUS *)
+    |  |- (derivable (?X1 + ?X2)) =>
+      apply (derivable_plus X1 X2); is_diff_glob
+       (* MOINS *)
+    |  |- (derivable (?X1 - ?X2)) =>
+      apply (derivable_minus X1 X2); is_diff_glob
+       (* OPPOSE *)
+    |  |- (derivable (- ?X1)) =>
+      apply (derivable_opp X1);
+        is_diff_glob
+       (* MULTIPLICATION PAR UN SCALAIRE *)
+    |  |- (derivable (mult_real_fct ?X1 ?X2)) =>
+      apply (derivable_scal X2 X1); is_diff_glob
+       (* MULTIPLICATION *)
+    |  |- (derivable (?X1 * ?X2)) =>
+      apply (derivable_mult X1 X2); is_diff_glob
+       (* DIVISION *)
+    |  |- (derivable (?X1 / ?X2)) =>
+      apply (derivable_div X1 X2);
+        [ is_diff_glob
+          | is_diff_glob
+          | try
+            assumption ||
+              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+                id, fct_cte, comp, pow_fct in |- * ]
+    |  |- (derivable (/ ?X1)) =>
+
+       (* INVERSION *)
+      apply (derivable_inv X1);
+        [ try
+          assumption ||
+            unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+              id, fct_cte, comp, pow_fct in |- *
+          | is_diff_glob ]
+    |  |- (derivable (comp sqrt _)) =>
+
+       (* COMPOSITION *)
+      unfold derivable in |- *; intro; try is_diff_pt
+    |  |- (derivable (comp Rabs _)) =>
+      unfold derivable in |- *; intro; try is_diff_pt
+    |  |- (derivable (comp ?X1 ?X2)) =>
+      apply (derivable_comp X2 X1); is_diff_glob
+    | _:(derivable ?X1) |- (derivable ?X1) => assumption
+    |  |- (True -> derivable _) =>
+      intro HypTruE; clear HypTruE; is_diff_glob
+    | _ =>
+      try
+        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+          fct_cte, comp, pow_fct in |- *
+  end.
+
+(**********)
+Ltac is_cont_pt :=
+  match goal with
+    |  |- (continuity_pt Rsqr _) =>
+
+       (* fonctions de base *)
+      apply derivable_continuous_pt; apply derivable_pt_Rsqr
+    |  |- (continuity_pt id ?X1) =>
+      apply derivable_continuous_pt; apply (derivable_pt_id X1)
+    |  |- (continuity_pt (fct_cte _) _) =>
+      apply derivable_continuous_pt; apply derivable_pt_const
+    |  |- (continuity_pt sin _) =>
+      apply derivable_continuous_pt; apply derivable_pt_sin
+    |  |- (continuity_pt cos _) =>
+      apply derivable_continuous_pt; apply derivable_pt_cos
+    |  |- (continuity_pt sinh _) =>
+      apply derivable_continuous_pt; apply derivable_pt_sinh
+    |  |- (continuity_pt cosh _) =>
+      apply derivable_continuous_pt; apply derivable_pt_cosh
+    |  |- (continuity_pt exp _) =>
+      apply derivable_continuous_pt; apply derivable_pt_exp
+    |  |- (continuity_pt (pow_fct _) _) =>
+      unfold pow_fct in |- *; apply derivable_continuous_pt;
+        apply derivable_pt_pow
+    |  |- (continuity_pt sqrt ?X1) =>
+      apply continuity_pt_sqrt;
+        assumption ||
+          unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
+            comp, id, fct_cte, pow_fct in |- *
+    |  |- (continuity_pt Rabs ?X1) =>
+      apply (Rcontinuity_abs X1)
+       (* regles de differentiabilite *)
+       (* PLUS *)
+    |  |- (continuity_pt (?X1 + ?X2) ?X3) =>
+      apply (continuity_pt_plus X1 X2 X3); is_cont_pt
+       (* MOINS *)
+    |  |- (continuity_pt (?X1 - ?X2) ?X3) =>
+      apply (continuity_pt_minus X1 X2 X3); is_cont_pt
+       (* OPPOSE *)
+    |  |- (continuity_pt (- ?X1) ?X2) =>
+      apply (continuity_pt_opp X1 X2);
+        is_cont_pt
+       (* MULTIPLICATION PAR UN SCALAIRE *)
+    |  |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) =>
+      apply (continuity_pt_scal X2 X1 X3); is_cont_pt
+       (* MULTIPLICATION *)
+    |  |- (continuity_pt (?X1 * ?X2) ?X3) =>
+      apply (continuity_pt_mult X1 X2 X3); is_cont_pt
+       (* DIVISION *)
+    |  |- (continuity_pt (?X1 / ?X2) ?X3) =>
+      apply (continuity_pt_div X1 X2 X3);
+        [ is_cont_pt
+          | is_cont_pt
+          | try
+            assumption ||
+              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+                comp, id, fct_cte, pow_fct in |- * ]
+    |  |- (continuity_pt (/ ?X1) ?X2) =>
+
+       (* INVERSION *)
+      apply (continuity_pt_inv X1 X2);
+        [ is_cont_pt
+          | assumption ||
+            unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+              comp, id, fct_cte, pow_fct in |- * ]
+    |  |- (continuity_pt (comp ?X1 ?X2) ?X3) =>
+
+       (* COMPOSITION *)
+      apply (continuity_pt_comp X2 X1 X3); is_cont_pt
+    | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
+      assumption
+    | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) =>
+      cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ]
+    | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
+      apply derivable_continuous_pt; assumption
+    | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) =>
+      cut (continuity X1);
+        [ intro HypDDPT; apply HypDDPT
+          | apply derivable_continuous; assumption ]
+    |  |- (True -> continuity_pt _ _) =>
+      intro HypTruE; clear HypTruE; is_cont_pt
+    | _ =>
+      try
+        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+          fct_cte, comp, pow_fct in |- *
+  end.
+
+(**********)
+Ltac is_cont_glob :=
+  match goal with
+    |  |- (continuity Rsqr) =>
+
+       (* fonctions de base *)
+      apply derivable_continuous; apply derivable_Rsqr
+    |  |- (continuity id) => apply derivable_continuous; apply derivable_id
+    |  |- (continuity (fct_cte _)) =>
+      apply derivable_continuous; apply derivable_const
+    |  |- (continuity sin) => apply derivable_continuous; apply derivable_sin
+    |  |- (continuity cos) => apply derivable_continuous; apply derivable_cos
+    |  |- (continuity exp) => apply derivable_continuous; apply derivable_exp
+    |  |- (continuity (pow_fct _)) =>
+      unfold pow_fct in |- *; apply derivable_continuous; apply derivable_pow
+    |  |- (continuity sinh) =>
+      apply derivable_continuous; apply derivable_sinh
+    |  |- (continuity cosh) =>
+      apply derivable_continuous; apply derivable_cosh
+    |  |- (continuity Rabs) =>
+      apply Rcontinuity_abs
+       (* regles de continuite *)
+       (* PLUS *)
+    |  |- (continuity (?X1 + ?X2)) =>
+      apply (continuity_plus X1 X2);
+        try is_cont_glob || assumption
+            (* MOINS *)
+    |  |- (continuity (?X1 - ?X2)) =>
+      apply (continuity_minus X1 X2);
+        try is_cont_glob || assumption
+            (* OPPOSE *)
+    |  |- (continuity (- ?X1)) =>
+      apply (continuity_opp X1); try is_cont_glob || assumption
+                                      (* INVERSE *)
+    |  |- (continuity (/ ?X1)) =>
+      apply (continuity_inv X1);
+        try is_cont_glob || assumption
+            (* MULTIPLICATION PAR UN SCALAIRE *)
+    |  |- (continuity (mult_real_fct ?X1 ?X2)) =>
+      apply (continuity_scal X2 X1);
+        try is_cont_glob || assumption
+            (* MULTIPLICATION *)
+    |  |- (continuity (?X1 * ?X2)) =>
+      apply (continuity_mult X1 X2);
+        try is_cont_glob || assumption
+            (* DIVISION *)
+    |  |- (continuity (?X1 / ?X2)) =>
+      apply (continuity_div X1 X2);
+        [ try is_cont_glob || assumption
+          | try is_cont_glob || assumption
+          | try
+            assumption ||
+              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+                id, fct_cte, pow_fct in |- * ]
+    |  |- (continuity (comp sqrt _)) =>
+
+       (* COMPOSITION *)
+      unfold continuity_pt in |- *; intro; try is_cont_pt
+    |  |- (continuity (comp ?X1 ?X2)) =>
+      apply (continuity_comp X2 X1); try is_cont_glob || assumption
+    | _:(continuity ?X1) |- (continuity ?X1) => assumption
+    |  |- (True -> continuity _) =>
+      intro HypTruE; clear HypTruE; is_cont_glob
+    | _:(derivable ?X1) |- (continuity ?X1) =>
+      apply derivable_continuous; assumption
+    | _ =>
+      try
+        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+          fct_cte, comp, pow_fct in |- *
+  end.
+
+(**********)
+Ltac rew_term trm :=
+  match constr:trm with
+    | (?X1 + ?X2) =>
+      let p1 := rew_term X1 with p2 := rew_term X2 in
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 + X4))
+              | _ => constr:(p1 + p2)%F
+            end
+          | _ => constr:(p1 + p2)%F
+        end
+    | (?X1 - ?X2) =>
+      let p1 := rew_term X1 with p2 := rew_term X2 in
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 - X4))
+              | _ => constr:(p1 - p2)%F
+            end
+          | _ => constr:(p1 - p2)%F
+        end
+    | (?X1 / ?X2) =>
+      let p1 := rew_term X1 with p2 := rew_term X2 in
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
+              | _ => constr:(p1 / p2)%F
+            end
+          | _ =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
+              | _ => constr:(p1 / p2)%F
+            end
+        end
+    | (?X1 * / ?X2) =>
+      let p1 := rew_term X1 with p2 := rew_term X2 in
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
+              | _ => constr:(p1 / p2)%F
+            end
+          | _ =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
+              | _ => constr:(p1 / p2)%F
+            end
+        end
+    | (?X1 * ?X2) =>
+      let p1 := rew_term X1 with p2 := rew_term X2 in
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 * X4))
+              | _ => constr:(p1 * p2)%F
+            end
+          | _ => constr:(p1 * p2)%F
+        end
+    | (- ?X1) =>
+      let p := rew_term X1 in
+        match constr:p with
+          | (fct_cte ?X2) => constr:(fct_cte (- X2))
+          | _ => constr:(- p)%F
+        end
+    | (/ ?X1) =>
+      let p := rew_term X1 in
+        match constr:p with
+          | (fct_cte ?X2) => constr:(fct_cte (/ X2))
+          | _ => constr:(/ p)%F
+        end
+    | (?X1 AppVar) => constr:X1
+    | (?X1 ?X2) =>
+      let p := rew_term X2 in
+        match constr:p with
+          | (fct_cte ?X3) => constr:(fct_cte (X1 X3))
+          | _ => constr:(comp X1 p)
+        end
+    | AppVar => constr:id
+    | (AppVar ^ ?X1) => constr:(pow_fct X1)
+    | (?X1 ^ ?X2) =>
+      let p := rew_term X1 in
+        match constr:p with
+          | (fct_cte ?X3) => constr:(fct_cte (pow_fct X2 X3))
+          | _ => constr:(comp (pow_fct X2) p)
+        end
+    | ?X1 => constr:(fct_cte X1)
+  end.
+
+(**********)
+Ltac deriv_proof trm pt :=
+  match constr:trm with
+    | (?X1 + ?X2)%F =>
+      let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
+        constr:(derivable_pt_plus X1 X2 pt p1 p2)
+    | (?X1 - ?X2)%F =>
+      let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
+        constr:(derivable_pt_minus X1 X2 pt p1 p2)
+    | (?X1 * ?X2)%F =>
+      let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
+        constr:(derivable_pt_mult X1 X2 pt p1 p2)
+    | (?X1 / ?X2)%F =>
+      match goal with
+        | id:(?X2 pt <> 0) |- _ =>
+          let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
+            constr:(derivable_pt_div X1 X2 pt p1 p2 id)
+        | _ => constr:False
+      end
+    | (/ ?X1)%F =>
+      match goal with
+        | id:(?X1 pt <> 0) |- _ =>
+          let p1 := deriv_proof X1 pt in
+            constr:(derivable_pt_inv X1 pt p1 id)
+        | _ => constr:False
+      end
+    | (comp ?X1 ?X2) =>
+      let pt_f1 := eval cbv beta in (X2 pt) in
+        let p1 := deriv_proof X1 pt_f1 with p2 := deriv_proof X2 pt in
+          constr:(derivable_pt_comp X2 X1 pt p2 p1)
+    | (- ?X1)%F =>
+      let p1 := deriv_proof X1 pt in
+        constr:(derivable_pt_opp X1 pt p1)
+    | sin => constr:(derivable_pt_sin pt)
+    | cos => constr:(derivable_pt_cos pt)
+    | sinh => constr:(derivable_pt_sinh pt)
+    | cosh => constr:(derivable_pt_cosh pt)
+    | exp => constr:(derivable_pt_exp pt)
+    | id => constr:(derivable_pt_id pt)
+    | Rsqr => constr:(derivable_pt_Rsqr pt)
+    | sqrt =>
+      match goal with
+        | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id)
+        | _ => constr:False
+      end
+    | (fct_cte ?X1) => constr:(derivable_pt_const X1 pt)
+    | ?X1 =>
+      let aux := constr:X1 in
+        match goal with
+          | id:(derivable_pt aux pt) |- _ => constr:id
+          | id:(derivable aux) |- _ => constr:(id pt)
+          | _ => constr:False
+        end
+  end.
+
+(**********)
+Ltac simplify_derive trm pt :=
+  match constr:trm with
+    | (?X1 + ?X2)%F =>
+      try rewrite derive_pt_plus; simplify_derive X1 pt;
+        simplify_derive X2 pt
+    | (?X1 - ?X2)%F =>
+      try rewrite derive_pt_minus; simplify_derive X1 pt;
+        simplify_derive X2 pt
+    | (?X1 * ?X2)%F =>
+      try rewrite derive_pt_mult; simplify_derive X1 pt;
+        simplify_derive X2 pt
+    | (?X1 / ?X2)%F =>
+      try rewrite derive_pt_div; simplify_derive X1 pt; simplify_derive X2 pt
+    | (comp ?X1 ?X2) =>
+      let pt_f1 := eval cbv beta in (X2 pt) in
+        (try rewrite derive_pt_comp; simplify_derive X1 pt_f1;
+          simplify_derive X2 pt)
+    | (- ?X1)%F => try rewrite derive_pt_opp; simplify_derive X1 pt
+    | (/ ?X1)%F =>
+      try rewrite derive_pt_inv; simplify_derive X1 pt
+    | (fct_cte ?X1) => try rewrite derive_pt_const
+    | id => try rewrite derive_pt_id
+    | sin => try rewrite derive_pt_sin
+    | cos => try rewrite derive_pt_cos
+    | sinh => try rewrite derive_pt_sinh
+    | cosh => try rewrite derive_pt_cosh
+    | exp => try rewrite derive_pt_exp
+    | Rsqr => try rewrite derive_pt_Rsqr
+    | sqrt => try rewrite derive_pt_sqrt
+    | ?X1 =>
+      let aux := constr:X1 in
+        match goal with
+          | id:(derive_pt aux pt ?X2 = _),H:(derivable aux) |- _ =>
+            try replace (derive_pt aux pt (H pt)) with (derive_pt aux pt X2);
+              [ rewrite id | apply pr_nu ]
+          | id:(derive_pt aux pt ?X2 = _),H:(derivable_pt aux pt) |- _ =>
+            try replace (derive_pt aux pt H) with (derive_pt aux pt X2);
+              [ rewrite id | apply pr_nu ]
+          | _ => idtac
+        end
+    | _ => idtac
+  end.
+
+(**********)
+Ltac reg :=
+  match goal with
+    |  |- (derivable_pt ?X1 ?X2) =>
+      let trm := eval cbv beta in (X1 AppVar) in
+        let aux := rew_term trm in
+          (intro_hyp_pt aux X2;
+            try (change (derivable_pt aux X2) in |- *; is_diff_pt) || is_diff_pt)
+    |  |- (derivable ?X1) =>
+      let trm := eval cbv beta in (X1 AppVar) in
+        let aux := rew_term trm in
+          (intro_hyp_glob aux;
+            try (change (derivable aux) in |- *; is_diff_glob) || is_diff_glob)
+    |  |- (continuity ?X1) =>
+      let trm := eval cbv beta in (X1 AppVar) in
+        let aux := rew_term trm in
+          (intro_hyp_glob aux;
+            try (change (continuity aux) in |- *; is_cont_glob) || is_cont_glob)
+    |  |- (continuity_pt ?X1 ?X2) =>
+      let trm := eval cbv beta in (X1 AppVar) in
+        let aux := rew_term trm in
+          (intro_hyp_pt aux X2;
+            try (change (continuity_pt aux X2) in |- *; is_cont_pt) || is_cont_pt)
+    |  |- (derive_pt ?X1 ?X2 ?X3 = ?X4) =>
+      let trm := eval cbv beta in (X1 AppVar) in
+      let aux := rew_term trm in
+      intro_hyp_pt aux X2;
+      (let aux2 := deriv_proof aux X2 in
+       try
+         (replace (derive_pt X1 X2 X3) with (derive_pt aux X2 aux2);
+           [ simplify_derive aux X2;
+             try unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte,
+                        inv_fct, opp_fct in |- *; ring || ring_simplify
+           | try apply pr_nu ]) || is_diff_pt)
+  end.
diff --git a/theories/Reals/Ratan.v b/theories/Reals/Ratan.v
new file mode 100644
index 00000000..1a0ea969
--- /dev/null
+++ b/theories/Reals/Ratan.v
@@ -0,0 +1,1602 @@
+Require Import Fourier.
+Require Import Rbase.
+Require Import PSeries_reg.
+Require Import Rtrigo1.
+Require Import Ranalysis_reg.
+Require Import Rfunctions.
+Require Import AltSeries.
+Require Import Rseries.
+Require Import SeqProp.
+Require Import Ranalysis5.
+Require Import SeqSeries.
+Require Import PartSum.
+
+Local Open Scope R_scope.
+
+(** Tools *)
+
+Lemma Ropp_div : forall x y, -x/y = -(x/y).
+Proof.
+intros x y; unfold Rdiv; rewrite <-Ropp_mult_distr_l_reverse; reflexivity.
+Qed.
+
+Definition pos_half_prf : 0 < /2.
+Proof. fourier. Qed.
+
+Definition pos_half := mkposreal (/2) pos_half_prf.
+
+Lemma Boule_half_to_interval :
+  forall x , Boule (/2) pos_half x -> 0 <= x <= 1.
+Proof.
+unfold Boule, pos_half; simpl.
+intros x b; apply Rabs_def2 in b; destruct b; split; fourier.
+Qed.
+
+Lemma Boule_lt : forall c r x, Boule c r x -> Rabs x < Rabs c + r.
+Proof.
+unfold Boule; intros c r x h.
+apply Rabs_def2 in h; destruct h; apply Rabs_def1;
+ (destruct (Rle_lt_dec 0 c);[rewrite Rabs_pos_eq; fourier | 
+    rewrite <- Rabs_Ropp, Rabs_pos_eq; fourier]).
+Qed.
+
+(* The following lemma does not belong here. *)
+Lemma Un_cv_ext :
+  forall un vn, (forall n, un n = vn n) ->
+  forall l, Un_cv un l -> Un_cv vn l.
+Proof.
+intros un vn quv l P eps ep; destruct (P eps ep) as [N Pn]; exists N.
+intro n; rewrite <- quv; apply Pn.
+Qed.
+
+(* The following two lemmas are general purposes about alternated series.
+  They do not belong here. *)
+Lemma Alt_first_term_bound :forall f l N n,
+   Un_decreasing f -> Un_cv f 0 ->
+   Un_cv (sum_f_R0 (tg_alt f)) l ->
+   (N <= n)%nat ->
+   R_dist (sum_f_R0 (tg_alt f) n) l <= f N.
+Proof.
+intros f l.
+assert (WLOG :
+   forall n P, (forall k, (0 < k)%nat -> P k) ->
+         ((forall k, (0 < k)%nat -> P k) -> P 0%nat) -> P n).
+clear.
+intros [ | n] P Hs Ho;[solve[apply Ho, Hs] | apply Hs; auto with arith].
+intros N; pattern N; apply WLOG; clear N.
+intros [ | N] Npos n decr to0 cv nN.
+  clear -Npos; elimtype False; omega.
+ assert (decr' : Un_decreasing (fun i => f (S N + i)%nat)).
+  intros k; replace (S N+S k)%nat with (S (S N+k)) by ring.
+  apply (decr (S N + k)%nat).
+ assert (to' : Un_cv (fun i => f (S N + i)%nat) 0).
+  intros eps ep; destruct (to0 eps ep) as [M PM].
+  exists M; intros k kM; apply PM; omega.
+ assert (cv' : Un_cv
+         (sum_f_R0 (tg_alt (fun i => ((-1) ^ S N * f(S N + i)%nat))))
+             (l - sum_f_R0 (tg_alt f) N)).
+  intros eps ep; destruct (cv eps ep) as [M PM]; exists M.
+  intros n' nM. 
+  match goal with |- ?C => set (U := C) end.
+  assert (nM' : (n' + S N >= M)%nat) by omega.
+   generalize (PM _ nM'); unfold R_dist.
+  rewrite (tech2 (tg_alt f) N (n' + S N)).
+  assert (t : forall a b c, (a + b) - c = b - (c - a)) by (intros; ring).
+  rewrite t; clear t; unfold U, R_dist; clear U.
+  replace (n' + S N - S N)%nat with n' by omega.
+  rewrite <- (sum_eq (tg_alt (fun i => (-1) ^ S N * f(S N + i)%nat))).
+   tauto.
+   intros i _; unfold tg_alt.
+   rewrite <- Rmult_assoc, <- pow_add, !(plus_comm i); reflexivity.
+  omega.
+  assert (cv'' : Un_cv (sum_f_R0 (tg_alt (fun i => f (S N + i)%nat)))
+                   ((-1) ^ S N * (l - sum_f_R0 (tg_alt f) N))).
+  apply (Un_cv_ext (fun n => (-1) ^ S N * 
+            sum_f_R0 (tg_alt (fun i : nat => (-1) ^ S N * f (S N + i)%nat)) n)).
+   intros n0; rewrite scal_sum; apply sum_eq; intros i _.
+   unfold tg_alt; ring_simplify; replace (((-1) ^ S N) ^ 2) with 1.
+    ring.
+   rewrite <- pow_mult, mult_comm, pow_mult; replace ((-1) ^2) with 1 by ring.
+   rewrite pow1; reflexivity.
+  apply CV_mult.
+   solve[intros eps ep; exists 0%nat; intros; rewrite R_dist_eq; auto].
+  assumption.
+ destruct (even_odd_cor N) as [p [Neven | Nodd]].
+  rewrite Neven; destruct (alternated_series_ineq _ _ p decr to0 cv) as [B C].
+  case (even_odd_cor n) as [p' [neven | nodd]].
+   rewrite neven.
+   destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E].
+   unfold R_dist; rewrite Rabs_pos_eq;[ | fourier].
+   assert (dist : (p <= p')%nat) by omega.
+   assert (t := decreasing_prop _ _ _ (CV_ALT_step1 f decr) dist).
+   apply Rle_trans with (sum_f_R0 (tg_alt f) (2 * p) - l).
+    unfold Rminus; apply Rplus_le_compat_r; exact t.
+   match goal with _ : ?a <= l, _ : l <= ?b |- _ => 
+    replace (f (S (2 * p))) with (b - a) by
+     (rewrite tech5; unfold tg_alt; rewrite pow_1_odd; ring); fourier
+   end.
+  rewrite nodd; destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E].
+   unfold R_dist; rewrite <- Rabs_Ropp, Rabs_pos_eq, Ropp_minus_distr;
+     [ | fourier].
+   assert (dist : (p <= p')%nat) by omega.
+   apply Rle_trans with (l - sum_f_R0 (tg_alt f) (S (2 * p))).
+    unfold Rminus; apply Rplus_le_compat_l, Ropp_le_contravar.
+    solve[apply Rge_le, (growing_prop _ _ _ (CV_ALT_step0 f decr) dist)].
+   unfold Rminus; rewrite tech5, Ropp_plus_distr, <- Rplus_assoc.
+   unfold tg_alt at 2; rewrite pow_1_odd, Ropp_mult_distr_l_reverse; fourier.
+ rewrite Nodd; destruct (alternated_series_ineq _ _ p decr to0 cv) as [B _].
+ destruct (alternated_series_ineq _ _ (S p) decr to0 cv) as [_ C].
+ assert (keep : (2 * S p = S (S ( 2 * p)))%nat) by ring.
+ case (even_odd_cor n) as [p' [neven | nodd]].
+   rewrite neven;
+   destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E].
+   unfold R_dist; rewrite Rabs_pos_eq;[ | fourier].
+   assert (dist : (S p < S p')%nat) by omega.
+   apply Rle_trans with (sum_f_R0 (tg_alt f) (2 * S p) - l).
+   unfold Rminus; apply Rplus_le_compat_r,
+     (decreasing_prop _ _ _ (CV_ALT_step1 f decr)).
+   omega.
+  rewrite keep, tech5; unfold tg_alt at 2; rewrite <- keep, pow_1_even.
+  fourier.
+ rewrite nodd; destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E].
+ unfold R_dist; rewrite <- Rabs_Ropp, Rabs_pos_eq;[ | fourier].
+ rewrite Ropp_minus_distr.
+ apply Rle_trans with (l - sum_f_R0 (tg_alt f) (S (2 * p))).
+  unfold Rminus; apply Rplus_le_compat_l, Ropp_le_contravar, Rge_le,
+   (growing_prop _ _ _ (CV_ALT_step0 f decr)); omega.
+ generalize C; rewrite keep, tech5; unfold tg_alt.
+ rewrite <- keep, pow_1_even.
+ assert (t : forall a b c, a <= b + 1 * c -> a - b <= c) by (intros; fourier).
+ solve[apply t].
+clear WLOG; intros Hyp [ | n] decr to0 cv _.
+ generalize (alternated_series_ineq f l 0 decr to0 cv).
+ unfold R_dist, tg_alt; simpl; rewrite !Rmult_1_l, !Rmult_1_r.
+ assert (f 1%nat <= f 0%nat) by apply decr.
+ rewrite Ropp_mult_distr_l_reverse.
+ intros [A B]; rewrite Rabs_pos_eq; fourier.
+apply Rle_trans with (f 1%nat).
+ apply (Hyp 1%nat (le_n 1) (S n) decr to0 cv).
+ omega.
+solve[apply decr].
+Qed.
+
+Lemma Alt_CVU : forall (f : nat -> R -> R) g h c r,
+   (forall x, Boule c r x ->Un_decreasing (fun n => f n x)) -> 
+   (forall x, Boule c r x -> Un_cv (fun n => f n x) 0) ->
+   (forall x, Boule c r x -> 
+       Un_cv (sum_f_R0 (tg_alt  (fun i => f i x))) (g x)) ->
+   (forall x n, Boule c r x -> f n x <= h n) ->
+   (Un_cv h 0) ->
+   CVU (fun N x => sum_f_R0 (tg_alt (fun i => f i x)) N) g c r.
+Proof.
+intros f g h c r decr to0 to_g bound bound0 eps ep.  
+assert (ep' : 0 <eps/2) by fourier.
+destruct (bound0 _ ep) as [N Pn]; exists N.
+intros n y nN dy.
+rewrite <- Rabs_Ropp, Ropp_minus_distr; apply Rle_lt_trans with (f n y).
+ solve[apply (Alt_first_term_bound (fun i => f i y) (g y) n n); auto].
+apply Rle_lt_trans with (h n).
+ apply bound; assumption.
+clear - nN Pn.
+generalize (Pn _ nN); unfold R_dist; rewrite Rminus_0_r; intros t.
+apply Rabs_def2 in t; tauto.
+Qed.
+
+(* The following lemmas are general purpose lemmas about squares. 
+  They do not belong here *)
+
+Lemma pow2_ge_0 : forall x, 0 <= x ^ 2.
+Proof.
+intros x; destruct (Rle_lt_dec 0 x).
+ replace (x ^ 2) with (x * x) by field.
+ apply Rmult_le_pos; assumption.
+ replace (x ^ 2) with ((-x) * (-x)) by field.
+apply Rmult_le_pos; fourier.
+Qed.
+
+Lemma pow2_abs : forall x,  Rabs x ^ 2 = x ^ 2.
+Proof.
+intros x; destruct (Rle_lt_dec 0 x).
+ rewrite Rabs_pos_eq;[field | assumption].
+rewrite <- Rabs_Ropp, Rabs_pos_eq;[field | fourier].
+Qed.
+
+(** * Properties of tangent *)
+
+Lemma derivable_pt_tan : forall x, -PI/2 < x < PI/2 -> derivable_pt tan x.
+Proof.
+intros x xint.
+ unfold derivable_pt, tan. 
+ apply derivable_pt_div ; [reg | reg | ].
+ apply Rgt_not_eq.
+ unfold Rgt ; apply cos_gt_0;
+  [unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse; fold (-PI/2) |];tauto.
+Qed.
+
+Lemma derive_pt_tan : forall (x:R),
+ forall (Pr1: -PI/2 < x < PI/2),
+ derive_pt tan x (derivable_pt_tan x Pr1) = 1 + (tan x)^2.
+Proof.
+intros x pr.
+assert (cos x <> 0).
+ apply Rgt_not_eq, cos_gt_0; rewrite <- ?Ropp_div; tauto.
+unfold tan; reg; unfold pow, Rsqr; field; assumption.
+Qed.
+
+(** Proof that tangent is a bijection *)
+(* to be removed? *)
+
+Lemma derive_increasing_interv :
+  forall (a b:R) (f:R -> R),
+    a < b ->
+    forall (pr:forall x, a < x < b -> derivable_pt f x),
+    (forall t:R, forall (t_encad : a < t < b), 0 < derive_pt f t (pr t t_encad)) ->
+    forall x y:R, a < x < b -> a < y < b -> x < y -> f x < f y.
+Proof.
+intros a b f a_lt_b pr Df_gt_0 x y x_encad y_encad x_lt_y.
+ assert (derivable_id_interv : forall c : R, x < c < y -> derivable_pt id c).
+  intros ; apply derivable_pt_id.
+ assert (derivable_f_interv :  forall c : R, x < c < y -> derivable_pt f c).
+  intros c c_encad. apply pr. split.
+  apply Rlt_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 c_encad)].
+  apply Rlt_trans with (r2:=y) ; [exact (proj2 c_encad) | exact (proj2 y_encad)].
+ assert (f_cont_interv : forall c : R, x <= c <= y -> continuity_pt f c).
+  intros c c_encad; apply derivable_continuous_pt ; apply pr. split.
+  apply Rlt_le_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 c_encad)].
+  apply Rle_lt_trans with (r2:=y) ; [ exact (proj2 c_encad) | exact (proj2 y_encad)].
+ assert (id_cont_interv : forall c : R, x <= c <= y -> continuity_pt id c).
+  intros ; apply derivable_continuous_pt ; apply derivable_pt_id. 
+ elim (MVT f id x y derivable_f_interv derivable_id_interv x_lt_y f_cont_interv id_cont_interv).
+  intros c Temp ; elim Temp ; clear Temp ; intros Pr eq.
+   replace (id y - id x) with (y - x) in eq by intuition.
+   replace (derive_pt id c (derivable_id_interv c Pr)) with 1 in eq.
+   assert (Hyp : f y - f x > 0).
+    rewrite Rmult_1_r in eq. rewrite <- eq.
+    apply Rmult_gt_0_compat.
+    apply Rgt_minus ; assumption.
+    assert (c_encad2 : a <= c < b).
+     split.
+     apply Rlt_le ; apply Rlt_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 Pr)].
+     apply Rle_lt_trans with (r2:=y) ; [apply Rlt_le ; exact (proj2 Pr) | exact (proj2 y_encad)].
+     assert (c_encad : a < c < b).
+      split.
+      apply Rlt_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 Pr)].
+      apply Rle_lt_trans with (r2:=y) ; [apply Rlt_le ; exact (proj2 Pr) | exact (proj2 y_encad)].
+     assert (Temp := Df_gt_0 c c_encad).
+     assert (Temp2 := pr_nu f c (derivable_f_interv c Pr) (pr c c_encad)).
+     rewrite Temp2 ; apply Temp.
+   apply Rminus_gt ; exact Hyp.
+   symmetry ; rewrite derive_pt_eq ; apply derivable_pt_lim_id.
+Qed.
+
+(* begin hide *)
+Lemma plus_Rsqr_gt_0 : forall x, 1 + x ^ 2 > 0.
+Proof.
+intro m. replace 0 with (0+0) by intuition.
+ apply Rplus_gt_ge_compat. intuition.
+ elim (total_order_T m 0) ; intro s'. case s'.
+ intros m_cond. replace 0 with (0*0) by intuition.
+  replace (m ^ 2) with ((-m)^2).
+  apply Rle_ge ; apply Rmult_le_compat ; intuition ; apply Rlt_le ; rewrite Rmult_1_r ; intuition.
+  field.
+  intro H' ; rewrite H' ; right ; field.
+   left. intuition.
+Qed.
+(* end hide *)
+
+(* The following lemmas about PI should probably be in Rtrigo. *)
+
+Lemma PI2_lower_bound :
+  forall x, 0 < x < 2 -> 0 < cos x  -> x < PI/2.
+Proof.
+intros x [xp xlt2] cx.
+destruct (Rtotal_order x (PI/2)) as [xltpi2 | [xeqpi2 | xgtpi2]].
+  assumption.
+ now case (Rgt_not_eq _ _ cx); rewrite xeqpi2, cos_PI2.
+destruct (MVT_cor1 cos (PI/2) x derivable_cos xgtpi2) as
+   [c [Pc [cint1 cint2]]].
+revert Pc; rewrite cos_PI2, Rminus_0_r. 
+rewrite <- (pr_nu cos c (derivable_pt_cos c)), derive_pt_cos.
+assert (0 < c < 2) by (split; assert (t := PI2_RGT_0); fourier).
+assert (0 < sin c) by now apply sin_pos_tech.
+intros Pc.
+case (Rlt_not_le _ _ cx).
+rewrite <- (Rplus_0_l (cos x)), Pc, Ropp_mult_distr_l_reverse.
+apply Rle_minus, Rmult_le_pos;[apply Rlt_le; assumption | fourier ].
+Qed.
+
+Lemma PI2_3_2 : 3/2 < PI/2.
+Proof.
+apply PI2_lower_bound;[split; fourier | ].
+destruct (pre_cos_bound (3/2) 1) as [t _]; [fourier | fourier | ].
+apply Rlt_le_trans with (2 := t); clear t.
+unfold cos_approx; simpl; unfold cos_term.
+simpl mult; replace ((-1)^ 0) with 1 by ring; replace ((-1)^2) with 1 by ring;
+ replace ((-1)^4) with 1 by ring; replace ((-1)^1) with (-1) by ring;
+ replace ((-1)^3) with (-1) by ring; replace 3 with (IZR 3) by (simpl; ring);
+ replace 2 with (IZR 2) by (simpl; ring); simpl Z.of_nat;
+ rewrite !INR_IZR_INZ, Ropp_mult_distr_l_reverse, Rmult_1_l.
+match goal with |- _ < ?a =>
+replace a with ((- IZR 3 ^ 6 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 2)) *
+    IZR (Z.of_nat (fact 4)) +
+    IZR 3 ^ 4 * IZR 2 ^ 2 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 2)) *
+    IZR (Z.of_nat (fact 6)) -
+    IZR 3 ^ 2 * IZR 2 ^ 4 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 4)) *
+    IZR (Z.of_nat (fact 6)) +
+    IZR 2 ^ 6 * IZR (Z.of_nat (fact 2)) * IZR (Z.of_nat (fact 4)) *
+    IZR (Z.of_nat (fact 6))) /
+   (IZR 2 ^ 6 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 2)) *
+    IZR (Z.of_nat (fact 4)) * IZR (Z.of_nat (fact 6))));[ | field;
+    repeat apply conj;((rewrite <- INR_IZR_INZ; apply INR_fact_neq_0) ||
+         (apply Rgt_not_eq; apply (IZR_lt 0); reflexivity)) ]
+end.
+rewrite !fact_simpl, !Nat2Z.inj_mul; simpl Z.of_nat.
+unfold Rdiv; apply Rmult_lt_0_compat.
+unfold Rminus; rewrite !pow_IZR, <- !opp_IZR, <- !mult_IZR, <- !opp_IZR, 
+  <- !plus_IZR; apply (IZR_lt 0); reflexivity.
+apply Rinv_0_lt_compat; rewrite !pow_IZR, <- !mult_IZR; apply (IZR_lt 0).
+reflexivity.
+Qed.
+
+Lemma PI2_1 : 1 < PI/2.
+Proof. assert (t := PI2_3_2); fourier. Qed.
+
+Lemma tan_increasing :
+  forall x y:R,
+    -PI/2 < x ->
+    x < y -> 
+    y < PI/2 -> tan x < tan y.
+Proof.
+intros x y Z_le_x x_lt_y y_le_1.
+ assert (x_encad : -PI/2 < x < PI/2).
+  split ; [assumption | apply Rlt_trans with (r2:=y) ; assumption].
+ assert (y_encad : -PI/2 < y < PI/2).
+  split ; [apply Rlt_trans with (r2:=x) ; intuition | intuition ].
+ assert (local_derivable_pt_tan : forall x : R, -PI/2 < x < PI/2 ->
+          derivable_pt tan x).
+  intros ; apply derivable_pt_tan ; intuition.
+ apply derive_increasing_interv with (a:=-PI/2) (b:=PI/2) (pr:=local_derivable_pt_tan) ; intuition.
+ fourier.
+ assert (Temp := pr_nu tan t (derivable_pt_tan t t_encad) (local_derivable_pt_tan t t_encad)) ;
+ rewrite <- Temp ; clear Temp.
+ assert (Temp := derive_pt_tan t t_encad) ; rewrite Temp ; clear Temp.
+ apply plus_Rsqr_gt_0.
+Qed.
+
+Lemma tan_is_inj : forall x y, -PI/2 < x < PI/2 -> -PI/2 < y < PI/2 ->
+   tan x = tan y -> x = y.
+Proof.
+  intros a b a_encad b_encad fa_eq_fb.
+  case(total_order_T a b).
+  intro s ; case s ; clear s.
+  intro Hf.
+  assert (Hfalse := tan_increasing a b (proj1 a_encad) Hf (proj2 b_encad)).
+  case (Rlt_not_eq (tan a) (tan b)) ; assumption.
+  intuition.
+  intro Hf. assert (Hfalse := tan_increasing b a (proj1 b_encad) Hf (proj2 a_encad)).
+  case (Rlt_not_eq (tan b) (tan a)) ; [|symmetry] ; assumption.
+Qed.
+
+Lemma exists_atan_in_frame :
+ forall lb ub y, lb < ub -> -PI/2 < lb -> ub < PI/2 ->
+ tan lb < y < tan ub -> {x | lb < x < ub /\ tan x = y}.
+Proof.
+intros lb ub y lb_lt_ub lb_cond ub_cond y_encad.
+ case y_encad ; intros y_encad1 y_encad2.
+     assert (f_cont : forall a : R, lb <= a <= ub -> continuity_pt tan a).
+      intros a a_encad. apply derivable_continuous_pt ; apply derivable_pt_tan.
+      split. apply Rlt_le_trans with (r2:=lb) ; intuition.
+      apply Rle_lt_trans with (r2:=ub) ; intuition.
+     assert (Cont : forall a : R, lb <= a <= ub -> continuity_pt (fun x => tan x - y) a).
+      intros a a_encad. unfold continuity_pt, continue_in, limit1_in, limit_in ; simpl ; unfold R_dist.
+      intros eps eps_pos. elim (f_cont a a_encad eps eps_pos).
+      intros alpha alpha_pos. destruct alpha_pos as (alpha_pos,Temp).
+      exists alpha. split.
+      assumption. intros x  x_cond.
+      replace (tan x - y - (tan a - y)) with (tan x - tan a) by field.
+      exact (Temp x x_cond).
+     assert (H1 : (fun x : R => tan x - y) lb < 0).
+       apply Rlt_minus. assumption.
+      assert (H2 : 0 < (fun x : R => tan x - y) ub).
+       apply Rgt_minus. assumption.
+     destruct (IVT_interv (fun x => tan x - y) lb ub Cont lb_lt_ub H1 H2) as (x,Hx).
+     exists x.
+     destruct Hx as (Hyp,Result).
+     intuition.
+     assert (Temp2 : x <> lb).
+      intro Hfalse. rewrite Hfalse in Result.
+      assert (Temp2 : y <> tan lb).
+       apply Rgt_not_eq ; assumption.
+      clear - Temp2 Result. apply Temp2.
+      intuition.
+     clear -Temp2 H3.
+      case H3 ; intuition. apply False_ind ; apply Temp2 ; symmetry ; assumption.
+      assert (Temp : x <> ub).
+      intro Hfalse. rewrite Hfalse in Result.
+      assert (Temp2 : y <> tan ub).
+       apply Rlt_not_eq ; assumption.
+      clear - Temp2 Result. apply Temp2.
+      intuition.
+      case H4 ; intuition.
+Qed.
+
+(** * Definition of arctangent as the reciprocal function of tangent and proof of this status *)
+Lemma tan_1_gt_1 : tan 1 > 1.
+Proof.
+assert (0 < cos 1) by (apply cos_gt_0; assert (t:=PI2_1); fourier).
+assert (t1 : cos 1 <= 1 - 1/2 + 1/24).
+ destruct (pre_cos_bound 1 0) as [_ t]; try fourier; revert t.
+ unfold cos_approx, cos_term; simpl; intros t; apply Rle_trans with (1:=t).
+ clear t; apply Req_le; field.
+assert (t2 : 1 - 1/6 <= sin 1).
+ destruct (pre_sin_bound 1 0) as [t _]; try fourier; revert t.
+ unfold sin_approx, sin_term; simpl; intros t; apply Rle_trans with (2:=t).
+ clear t; apply Req_le; field.
+pattern 1 at 2; replace 1 with
+  (cos 1 / cos 1) by (field; apply Rgt_not_eq; fourier).
+apply Rlt_gt; apply (Rmult_lt_compat_r (/ cos 1) (cos 1) (sin 1)).
+ apply Rinv_0_lt_compat; assumption.
+apply Rle_lt_trans with (1 := t1); apply Rlt_le_trans with (2 := t2).
+fourier.
+Qed.
+
+Definition frame_tan y : {x | 0 < x < PI/2 /\ Rabs y < tan x}.
+destruct (total_order_T (Rabs y) 1).
+ assert (yle1 : Rabs y <= 1) by (destruct s; fourier).
+ clear s; exists 1; split;[split; [exact Rlt_0_1 | exact PI2_1] | ].
+ apply Rle_lt_trans with (1 := yle1); exact tan_1_gt_1.
+assert (0 < / (Rabs y + 1)).
+ apply Rinv_0_lt_compat; fourier.
+set (u := /2 * / (Rabs y + 1)).
+assert (0 < u).
+ apply Rmult_lt_0_compat; [fourier | assumption].
+assert (vlt1 : / (Rabs y + 1) < 1).
+ apply Rmult_lt_reg_r with (Rabs y + 1).
+  assert (t := Rabs_pos y); fourier.
+ rewrite Rinv_l; [rewrite Rmult_1_l | apply Rgt_not_eq]; fourier.
+assert (vlt2 : u < 1).
+ apply Rlt_trans with (/ (Rabs y + 1)).
+  rewrite double_var.
+  assert (t : forall x, 0 < x -> x < x + x) by (clear; intros; fourier).
+  unfold u; rewrite Rmult_comm; apply t.
+  unfold Rdiv; rewrite Rmult_comm; assumption.
+ assumption.
+assert(int : 0 < PI / 2 - u < PI / 2).
+ split.
+  assert (t := PI2_1); apply Rlt_Rminus, Rlt_trans with (2 := t); assumption.
+ assert (dumb : forall x y, 0 < y -> x - y < x) by (clear; intros; fourier).
+ apply dumb; clear dumb; assumption.
+exists (PI/2 - u).
+assert (tmp : forall x y, 0 < x -> y < 1 -> x * y < x).
+ clear; intros x y x0 y1; pattern x at 2; rewrite <- (Rmult_1_r x).
+ apply Rmult_lt_compat_l; assumption.
+assert (0 < sin u).
+ apply sin_gt_0;[ assumption | ].
+ assert (t := PI2_Rlt_PI); assert (t' := PI2_1).
+ apply Rlt_trans with (2 := Rlt_trans _ _ _ t' t); assumption.
+split.
+ assumption.
+ apply Rlt_trans with (/2 * / cos(PI / 2 - u)).
+ rewrite cos_shift.
+ assert (sin u < u).
+  assert (t1 : 0 <= u) by (apply Rlt_le; assumption).
+  assert (t2 : u <= 4) by
+   (apply Rle_trans with 1;[apply Rlt_le | fourier]; assumption).
+  destruct (pre_sin_bound u 0 t1 t2) as [_ t].
+  apply Rle_lt_trans with (1 := t); clear t1 t2 t.
+  unfold sin_approx; simpl; unfold sin_term; simpl ((-1) ^ 0);
+  replace ((-1) ^ 2) with 1 by ring; simpl ((-1) ^ 1);
+  rewrite !Rmult_1_r, !Rmult_1_l; simpl plus; simpl (INR (fact 1)).
+  rewrite <- (fun x => tech_pow_Rmult x 0), <- (fun x => tech_pow_Rmult x 2),
+    <- (fun x => tech_pow_Rmult x 4).
+  rewrite (Rmult_comm (-1)); simpl ((/(Rabs y + 1)) ^ 0).
+  unfold Rdiv; rewrite Rinv_1, !Rmult_assoc, <- !Rmult_plus_distr_l.
+  apply tmp;[assumption | ].
+  rewrite Rplus_assoc, Rmult_1_l; pattern 1 at 3; rewrite <- Rplus_0_r.
+  apply Rplus_lt_compat_l.
+  rewrite <- Rmult_assoc.
+  match goal with |- (?a * (-1)) + _ < 0 =>
+   rewrite <- (Rplus_opp_l a), Ropp_mult_distr_r_reverse, Rmult_1_r
+  end.
+  apply Rplus_lt_compat_l.
+  assert (0 < u ^ 2) by (apply pow_lt; assumption).
+  replace (u ^ 4) with (u ^ 2 * u ^ 2) by ring.
+ rewrite Rmult_assoc; apply Rmult_lt_compat_l; auto.
+  apply Rlt_trans with (u ^ 2 * /INR (fact 3)).
+   apply Rmult_lt_compat_l; auto.
+   apply Rinv_lt_contravar.
+    solve[apply Rmult_lt_0_compat; apply INR_fact_lt_0].
+   rewrite !INR_IZR_INZ; apply IZR_lt; reflexivity.
+  rewrite Rmult_comm; apply tmp.
+   solve[apply Rinv_0_lt_compat, INR_fact_lt_0].
+  apply Rlt_trans with (2 := vlt2).
+  simpl; unfold u; apply tmp; auto; rewrite Rmult_1_r; assumption.
+ apply Rlt_trans with (Rabs y + 1);[fourier | ]. 
+ pattern (Rabs y + 1) at 1; rewrite <- (Rinv_involutive (Rabs y + 1));
+  [ | apply Rgt_not_eq; fourier].
+ rewrite <- Rinv_mult_distr.
+   apply Rinv_lt_contravar.
+    apply Rmult_lt_0_compat.
+     apply Rmult_lt_0_compat;[fourier | assumption].
+    assumption.
+   replace (/(Rabs y + 1)) with (2 * u).
+    fourier.
+   unfold u; field; apply Rgt_not_eq; clear -r; fourier.
+  solve[discrR].
+ apply Rgt_not_eq; assumption.
+unfold tan.
+set (u' := PI / 2); unfold Rdiv; apply Rmult_lt_compat_r; unfold u'.
+ apply Rinv_0_lt_compat. 
+ rewrite cos_shift; assumption.
+assert (vlt3 : u < /4).
+ replace (/4) with (/2 * /2) by field.
+ unfold u; apply Rmult_lt_compat_l;[fourier | ].
+ apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat; fourier.
+ fourier.
+assert (1 < PI / 2 - u) by (assert (t := PI2_3_2); fourier).
+apply Rlt_trans with (sin 1).
+ assert (t' : 1 <= 4) by fourier.
+ destruct (pre_sin_bound 1 0 (Rlt_le _ _ Rlt_0_1) t') as [t _].
+ apply Rlt_le_trans with (2 := t); clear t.
+ simpl plus; replace (sin_approx 1 1) with (5/6);[fourier | ].
+ unfold sin_approx, sin_term; simpl; field.
+apply sin_increasing_1.
+    assert (t := PI2_1); fourier.
+   apply Rlt_le, PI2_1.
+  assert (t := PI2_1); fourier.
+ fourier.
+assumption.
+Qed.
+
+Lemma ub_opp : forall x, x < PI/2 -> -PI/2 < -x.
+Proof.
+intros x h; rewrite Ropp_div; apply Ropp_lt_contravar; assumption.
+Qed.
+
+Lemma pos_opp_lt : forall x, 0 < x -> -x < x.
+Proof. intros; fourier. Qed.
+
+Lemma tech_opp_tan : forall x y, -tan x < y -> tan (-x) < y.
+intros; rewrite tan_neg; assumption.
+Qed.
+
+Definition pre_atan (y : R) : {x : R | -PI/2 < x < PI/2 /\ tan x = y}.
+destruct (frame_tan y) as [ub [[ub0 ubpi2] Ptan_ub]].
+set (pr := (conj (tech_opp_tan _ _ (proj2 (Rabs_def2 _ _ Ptan_ub)))
+     (proj1 (Rabs_def2 _ _ Ptan_ub)))).
+destruct (exists_atan_in_frame (-ub) ub y (pos_opp_lt _ ub0) (ub_opp _ ubpi2)
+             ubpi2 pr) as [v [[vl vu] vq]].
+exists v; clear pr.
+split;[rewrite Ropp_div; split; fourier | assumption].
+Qed.
+
+Definition atan x := let (v, _) := pre_atan x in v.
+
+Lemma atan_bound : forall x, -PI/2 < atan x < PI/2.
+Proof.
+intros x; unfold atan; destruct (pre_atan x) as [v [int _]]; exact int.
+Qed.
+
+Lemma atan_right_inv : forall x, tan (atan x) = x.
+Proof.
+intros x; unfold atan; destruct (pre_atan x) as [v [_ q]]; exact q.
+Qed.
+
+Lemma atan_opp : forall x, atan (- x) = - atan x.
+Proof.
+intros x; generalize (atan_bound (-x)); rewrite Ropp_div;intros [a b].
+generalize (atan_bound x); rewrite Ropp_div; intros [c d].
+apply tan_is_inj; try rewrite Ropp_div; try split; try fourier.
+rewrite tan_neg, !atan_right_inv; reflexivity.
+Qed.
+
+Lemma derivable_pt_atan : forall x, derivable_pt atan x.
+Proof.
+intros x.
+destruct (frame_tan x) as [ub [[ub0 ubpi] P]].
+assert (lb_lt_ub : -ub < ub) by apply pos_opp_lt, ub0.
+assert (xint : tan(-ub) < x < tan ub).
+ assert (xint' : x < tan ub /\ -(tan ub) < x) by apply Rabs_def2, P.
+  rewrite tan_neg; tauto.
+assert (inv_p : forall x, tan(-ub) <= x -> x <= tan ub -> 
+                     comp tan atan x = id x).
+ intros; apply atan_right_inv.
+assert (int_tan : forall y, tan (- ub) <= y -> y <= tan ub ->
+                       -ub <= atan y <= ub).
+ clear -ub0 ubpi; intros y lo up; split.
+  destruct (Rle_lt_dec (-ub) (atan y)) as [h | abs]; auto.
+  assert (y < tan (-ub)).
+   rewrite <- (atan_right_inv y); apply tan_increasing.
+     destruct (atan_bound y); assumption.
+    assumption.
+   fourier.
+  fourier.
+ destruct (Rle_lt_dec (atan y) ub) as [h | abs]; auto.
+  assert (tan ub < y).
+   rewrite <- (atan_right_inv y); apply tan_increasing.
+    rewrite Ropp_div; fourier.
+   assumption.
+  destruct (atan_bound y); assumption.
+ fourier.
+assert (incr : forall x y, -ub <= x -> x < y -> y <= ub -> tan x < tan y).
+ intros y z l yz u; apply tan_increasing.
+   rewrite Ropp_div; fourier.
+  assumption.
+ fourier.
+assert (der : forall a, -ub <= a <= ub -> derivable_pt tan a).
+ intros a [la ua]; apply derivable_pt_tan.
+ rewrite Ropp_div; split; fourier.
+assert (df_neq : derive_pt tan (atan x)
+     (derivable_pt_recip_interv_prelim1 tan atan 
+        (- ub) ub x lb_lt_ub xint inv_p int_tan incr der) <> 0).
+ rewrite <- (pr_nu tan (atan x)
+              (derivable_pt_tan (atan x) (atan_bound x))).
+ rewrite derive_pt_tan.
+ solve[apply Rgt_not_eq, plus_Rsqr_gt_0].
+apply (derivable_pt_recip_interv tan atan (-ub) ub x
+      lb_lt_ub xint inv_p int_tan incr der).
+exact df_neq.
+Qed.
+
+Lemma atan_increasing : forall x y, x < y -> atan x < atan y.
+intros x y d.
+assert (t1 := atan_bound x).
+assert (t2 := atan_bound y).
+destruct (Rlt_le_dec (atan x) (atan y)) as [lt | bad].
+ assumption.
+apply Rlt_not_le in d.
+case d.
+rewrite <- (atan_right_inv y), <- (atan_right_inv x).
+destruct bad as [ylt | yx].
+ apply Rlt_le, tan_increasing; try tauto.
+solve[rewrite yx; apply Rle_refl].
+Qed.
+
+Lemma atan_0 : atan 0 = 0.
+apply tan_is_inj; try (apply atan_bound).
+ assert (t := PI_RGT_0); rewrite Ropp_div; split; fourier.
+rewrite atan_right_inv, tan_0.
+reflexivity.
+Qed.
+
+Lemma atan_1 : atan 1 = PI/4.
+assert (ut := PI_RGT_0).
+assert (-PI/2 < PI/4 < PI/2) by (rewrite Ropp_div; split; fourier).
+assert (t := atan_bound 1).
+apply tan_is_inj; auto.
+rewrite tan_PI4, atan_right_inv; reflexivity.
+Qed.
+
+(** atan's derivative value is the function 1 / (1+x²) *)
+
+Lemma derive_pt_atan : forall x,
+      derive_pt atan x (derivable_pt_atan x) =
+         1 / (1 + x²).
+Proof.
+intros x.
+destruct (frame_tan x) as [ub [[ub0 ubpi] Pub]].
+assert (lb_lt_ub : -ub < ub) by apply pos_opp_lt, ub0.
+assert (xint : tan(-ub) < x < tan ub).
+ assert (xint' : x < tan ub /\ -(tan ub) < x) by apply Rabs_def2, Pub.
+  rewrite tan_neg; tauto.
+assert (inv_p : forall x, tan(-ub) <= x -> x <= tan ub -> 
+                     comp tan atan x = id x).
+ intros; apply atan_right_inv.
+assert (int_tan : forall y, tan (- ub) <= y -> y <= tan ub ->
+                       -ub <= atan y <= ub).
+ clear -ub0 ubpi; intros y lo up; split.
+  destruct (Rle_lt_dec (-ub) (atan y)) as [h | abs]; auto.
+  assert (y < tan (-ub)).
+   rewrite <- (atan_right_inv y); apply tan_increasing.
+     destruct (atan_bound y); assumption.
+    assumption.
+   fourier.
+  fourier.
+ destruct (Rle_lt_dec (atan y) ub) as [h | abs]; auto.
+  assert (tan ub < y).
+   rewrite <- (atan_right_inv y); apply tan_increasing.
+    rewrite Ropp_div; fourier.
+   assumption.
+  destruct (atan_bound y); assumption.
+ fourier.
+assert (incr : forall x y, -ub <= x -> x < y -> y <= ub -> tan x < tan y).
+ intros y z l yz u; apply tan_increasing.
+   rewrite Ropp_div; fourier.
+  assumption.
+ fourier.
+assert (der : forall a, -ub <= a <= ub -> derivable_pt tan a).
+ intros a [la ua]; apply derivable_pt_tan.
+ rewrite Ropp_div; split; fourier.
+assert (df_neq : derive_pt tan (atan x)
+     (derivable_pt_recip_interv_prelim1 tan atan 
+        (- ub) ub x lb_lt_ub xint inv_p int_tan incr der) <> 0).
+ rewrite <- (pr_nu tan (atan x)
+              (derivable_pt_tan (atan x) (atan_bound x))).
+ rewrite derive_pt_tan.
+ solve[apply Rgt_not_eq, plus_Rsqr_gt_0].
+assert (t := derive_pt_recip_interv tan atan (-ub) ub x lb_lt_ub
+        xint incr int_tan der inv_p df_neq).
+rewrite <- (pr_nu atan x (derivable_pt_recip_interv tan atan (- ub) ub
+      x lb_lt_ub xint inv_p int_tan incr der df_neq)).
+rewrite t.
+assert (t' := atan_bound x).
+rewrite <- (pr_nu tan (atan x) (derivable_pt_tan _ t')). 
+rewrite derive_pt_tan, atan_right_inv.
+replace (Rsqr x) with (x ^ 2) by (unfold Rsqr; ring).
+reflexivity.
+Qed.
+
+(** * Definition of the arctangent function as the sum of the arctan power series *)
+(* Proof taken from Guillaume Melquiond's interval package for Coq *)
+
+Definition Ratan_seq x :=  fun n => (x ^ (2 * n + 1) / INR (2 * n + 1))%R.
+
+Lemma Ratan_seq_decreasing : forall x, (0 <= x <= 1)%R -> Un_decreasing (Ratan_seq x).
+Proof.
+intros x Hx n.
+ unfold Ratan_seq, Rdiv.
+ apply Rmult_le_compat. apply pow_le.
+ exact (proj1 Hx).
+ apply Rlt_le.
+ apply Rinv_0_lt_compat.
+ apply lt_INR_0.
+ omega.
+ destruct (proj1 Hx) as [Hx1|Hx1].
+ destruct (proj2 Hx) as [Hx2|Hx2].
+ (* . 0 < x < 1 *)
+ rewrite <- (Rinv_involutive x).
+ assert (/ x <> 0)%R by auto with real.
+ repeat rewrite <- Rinv_pow with (1 := H).
+ apply Rlt_le.
+ apply Rinv_lt_contravar.
+ apply Rmult_lt_0_compat ; apply pow_lt ; auto with real.
+ apply Rlt_pow.
+ rewrite <- Rinv_1.
+ apply Rinv_lt_contravar.
+ rewrite Rmult_1_r.
+ exact Hx1.
+ exact Hx2.
+ omega.
+ apply Rgt_not_eq.
+ exact Hx1.
+ (* . x = 1 *)
+ rewrite Hx2.
+ do 2 rewrite pow1.
+ apply Rle_refl.
+ (* . x = 0 *)
+ rewrite <- Hx1.
+ do 2 (rewrite pow_i ; [ idtac | omega ]).
+ apply Rle_refl.
+ apply Rlt_le.
+ apply Rinv_lt_contravar.
+ apply Rmult_lt_0_compat ; apply lt_INR_0 ; omega.
+ apply lt_INR.
+ omega.
+Qed.
+
+Lemma Ratan_seq_converging : forall x, (0 <= x <= 1)%R -> Un_cv (Ratan_seq x) 0.
+Proof.
+intros x Hx eps Heps.
+ destruct (archimed (/ eps)) as (HN,_).
+ assert (0 < up (/ eps))%Z.
+  apply lt_IZR.
+  apply Rlt_trans with (2 := HN).
+  apply Rinv_0_lt_compat.
+  exact Heps.
+ case_eq (up (/ eps)) ;
+  intros ; rewrite H0 in H ; try discriminate H.
+   rewrite H0 in HN.
+   simpl in HN.
+   pose (N := Pos.to_nat p).
+   fold N in HN.
+   clear H H0.
+   exists N.
+  intros n Hn.
+   unfold R_dist.
+   rewrite Rminus_0_r.
+   unfold Ratan_seq.
+   rewrite Rabs_right.
+   apply Rle_lt_trans with (1 ^ (2 * n + 1) / INR (2 * n + 1))%R.
+   unfold Rdiv.
+   apply Rmult_le_compat_r.
+   apply Rlt_le.
+   apply Rinv_0_lt_compat.
+   apply lt_INR_0.
+   omega.
+   apply pow_incr.
+   exact Hx.
+   rewrite pow1.
+   apply Rle_lt_trans with (/ INR (2 * N + 1))%R.
+   unfold Rdiv.
+   rewrite Rmult_1_l.
+   apply Rle_Rinv.
+   apply lt_INR_0.
+   omega.
+   replace 0 with (INR 0) by intuition.
+   apply lt_INR.
+   omega.
+   intuition.
+   rewrite <- (Rinv_involutive eps).
+   apply Rinv_lt_contravar.
+   apply Rmult_lt_0_compat.
+   auto with real.
+   apply lt_INR_0.
+   omega.
+   apply Rlt_trans with (INR N).
+   destruct (archimed (/ eps)) as (H,_).
+   assert (0 < up (/ eps))%Z.
+   apply lt_IZR.
+   apply Rlt_trans with (2 := H).
+   apply Rinv_0_lt_compat.
+   exact Heps.
+   exact HN.
+   apply lt_INR.
+   omega.
+   apply Rgt_not_eq.
+   exact Heps.
+   apply Rle_ge.
+   unfold Rdiv.
+   apply Rmult_le_pos.
+   apply pow_le.
+   exact (proj1 Hx).
+   apply Rlt_le.
+   apply Rinv_0_lt_compat.
+   apply lt_INR_0.
+   omega.
+Qed.
+
+Definition ps_atan_exists_01 (x : R) (Hx:0 <= x <= 1) :
+   {l : R | Un_cv (fun N : nat => sum_f_R0 (tg_alt (Ratan_seq x)) N) l}.
+exact (alternated_series (Ratan_seq x)
+  (Ratan_seq_decreasing _ Hx) (Ratan_seq_converging _ Hx)).
+Defined.
+
+Lemma Ratan_seq_opp : forall x n, Ratan_seq (-x) n = -Ratan_seq x n.
+Proof.
+intros x n; unfold Ratan_seq.
+rewrite !pow_add, !pow_mult, !pow_1.
+unfold Rdiv; replace ((-x) ^ 2) with (x ^ 2) by ring; ring.
+Qed.
+
+Lemma sum_Ratan_seq_opp : 
+  forall x n, sum_f_R0 (tg_alt (Ratan_seq (- x))) n =
+     - sum_f_R0 (tg_alt (Ratan_seq x)) n.
+Proof.
+intros x n; replace (-sum_f_R0 (tg_alt (Ratan_seq x)) n) with 
+  (-1 * sum_f_R0 (tg_alt (Ratan_seq x)) n) by ring.
+rewrite scal_sum; apply sum_eq; intros i _; unfold tg_alt.
+rewrite Ratan_seq_opp; ring.
+Qed.
+
+Definition ps_atan_exists_1 (x : R) (Hx : -1 <= x <= 1) :
+   {l : R | Un_cv (fun N : nat => sum_f_R0 (tg_alt (Ratan_seq x)) N) l}.
+destruct (Rle_lt_dec 0 x).
+ assert (pr : 0 <= x <= 1) by tauto.
+ exact (ps_atan_exists_01 x pr).
+assert (pr : 0 <= -x <= 1) by (destruct Hx; split; fourier).
+destruct (ps_atan_exists_01 _ pr) as [v Pv].
+exists (-v).
+ apply (Un_cv_ext (fun n => (- 1) * sum_f_R0 (tg_alt (Ratan_seq (- x))) n)).
+ intros n; rewrite sum_Ratan_seq_opp; ring.
+replace (-v) with (-1 * v) by ring.
+apply CV_mult;[ | assumption].
+solve[intros; exists 0%nat; intros; rewrite R_dist_eq; auto].
+Qed.
+
+Definition in_int (x : R) : {-1 <= x <= 1}+{~ -1 <= x <= 1}.
+destruct (Rle_lt_dec x 1).
+ destruct (Rle_lt_dec (-1) x).
+  left;split; auto.
+ right;intros [a1 a2]; fourier.
+right;intros [a1 a2]; fourier.
+Qed.
+
+Definition ps_atan (x : R) : R :=
+ match in_int x with
+   left h => let (v, _) := ps_atan_exists_1 x h in v
+ | right h => atan x
+ end.
+
+(** * Proof of the equivalence of the two definitions between -1 and 1 *)
+
+Lemma ps_atan0_0 : ps_atan 0 = 0.
+Proof.
+unfold ps_atan.
+ destruct (in_int 0) as [h1 | h2].
+ destruct (ps_atan_exists_1 0 h1) as [v P].
+ apply (UL_sequence _ _ _ P).
+  apply (Un_cv_ext (fun n => 0)).
+  symmetry;apply sum_eq_R0.
+  intros i _; unfold tg_alt, Ratan_seq; rewrite plus_comm; simpl.
+  unfold Rdiv; rewrite !Rmult_0_l, Rmult_0_r; reflexivity.
+ intros eps ep; exists 0%nat; intros n _; unfold R_dist.
+ rewrite Rminus_0_r, Rabs_pos_eq; auto with real.
+case h2; split; fourier.
+Qed.
+
+Lemma ps_atan_exists_1_opp :
+  forall x h h', proj1_sig (ps_atan_exists_1 (-x) h) = 
+     -(proj1_sig (ps_atan_exists_1 x h')).
+Proof.
+intros x h h'; destruct (ps_atan_exists_1 (-x) h) as [v Pv].
+destruct (ps_atan_exists_1 x h') as [u Pu]; simpl.
+assert (Pu' : Un_cv (fun N => (-1) * sum_f_R0 (tg_alt (Ratan_seq x)) N) (-1 * u)).
+ apply CV_mult;[ | assumption].
+ intros eps ep; exists 0%nat; intros; rewrite R_dist_eq; assumption.  
+assert (Pv' : Un_cv
+           (fun N : nat => -1 * sum_f_R0 (tg_alt (Ratan_seq x)) N) v).
+ apply Un_cv_ext with (2 := Pv); intros n; rewrite sum_Ratan_seq_opp; ring.
+replace (-u) with (-1 * u) by ring.
+apply UL_sequence with (1:=Pv') (2:= Pu').
+Qed.
+
+Lemma ps_atan_opp : forall x, ps_atan (-x) = -ps_atan x.
+Proof.
+intros x; unfold ps_atan.
+destruct (in_int (- x)) as [inside | outside].
+ destruct (in_int x) as [ins' | outs'].
+ generalize (ps_atan_exists_1_opp x inside ins').
+  intros h; exact h.
+ destruct inside; case outs'; split; fourier.   
+destruct (in_int x) as [ins' | outs'].
+ destruct outside; case ins'; split; fourier.   
+apply atan_opp.
+Qed.
+
+(** atan = ps_atan *)
+
+Lemma ps_atanSeq_continuity_pt_1 : forall (N:nat) (x:R),
+      0 <= x ->
+      x <= 1 ->
+      continuity_pt (fun x => sum_f_R0 (tg_alt (Ratan_seq x)) N) x.
+Proof.
+assert (Sublemma : forall (x:R) (N:nat), sum_f_R0 (tg_alt (Ratan_seq x)) N = x * (comp (fun x => sum_f_R0 (fun n => (fun i : nat => (-1) ^ i / INR (2 * i + 1)) n * x ^ n) N) (fun x => x ^ 2) x)).
+ intros x N.
+  induction N.
+   unfold tg_alt, Ratan_seq, comp ; simpl ; field.
+   simpl sum_f_R0 at 1.
+   rewrite IHN.
+   replace (comp (fun x => sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x ^ n) (S N)) (fun x => x ^ 2))
+     with (comp (fun x => sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x ^ n) N + (-1) ^ (S N) / INR (2 * (S N) + 1) * x ^ (S N)) (fun x => x ^ 2)).
+   unfold comp.
+   rewrite Rmult_plus_distr_l.
+   apply Rplus_eq_compat_l.
+   unfold tg_alt, Ratan_seq.
+   rewrite <- Rmult_assoc.
+   case (Req_dec x 0) ; intro Hyp.
+   rewrite Hyp ; rewrite pow_i. rewrite Rmult_0_l ; rewrite Rmult_0_l.
+   unfold Rdiv ; rewrite Rmult_0_l ; rewrite Rmult_0_r ; reflexivity.
+   intuition.
+   replace (x * ((-1) ^ S N / INR (2 * S N + 1)) * (x ^ 2) ^ S N) with (x ^ (2 * S N + 1) * ((-1) ^ S N / INR (2 * S N + 1))).
+   rewrite Rmult_comm ; unfold Rdiv at 1.
+   rewrite Rmult_assoc ; apply Rmult_eq_compat_l.
+   field. apply Rgt_not_eq ; intuition.
+   rewrite Rmult_assoc.
+   replace (x * ((-1) ^ S N / INR (2 * S N + 1) * (x ^ 2) ^ S N)) with (((-1) ^ S N / INR (2 * S N + 1) * (x ^ 2) ^ S N) * x).
+   rewrite Rmult_assoc.
+   replace ((x ^ 2) ^ S N * x) with (x ^ (2 * S N + 1)).
+   rewrite Rmult_comm at 1 ; reflexivity.
+   rewrite <- pow_mult.
+   assert (Temp : forall x n, x ^ n * x = x ^ (n+1)).
+    intros a n ; induction n. rewrite pow_O. simpl ; intuition.
+    simpl ; rewrite Rmult_assoc ; rewrite IHn ; intuition.
+   rewrite Temp ; reflexivity.
+   rewrite Rmult_comm ; reflexivity.
+   intuition.
+intros N x x_lb x_ub.
+ intros eps eps_pos.
+ assert (continuity_id : continuity id).
+ apply derivable_continuous ; exact derivable_id.
+assert (Temp := continuity_mult id (comp
+        (fun x1 : R =>
+         sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x1 ^ n) N)
+        (fun x1 : R => x1 ^ 2))
+           continuity_id).
+assert (Temp2 : continuity
+    (comp
+       (fun x1 : R =>
+        sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x1 ^ n) N)
+       (fun x1 : R => x1 ^ 2))).
+ apply continuity_comp.
+ reg.
+ apply continuity_finite_sum.
+ elim (Temp Temp2 x eps eps_pos) ; clear Temp Temp2 ; intros alpha T ; destruct T as (alpha_pos, T).
+ exists alpha ; split.
+ intuition.
+intros x0 x0_cond.
+ rewrite Sublemma ; rewrite Sublemma.
+apply T.
+intuition.
+Qed.
+
+(** Definition of ps_atan's derivative *)
+
+Definition Datan_seq := fun (x:R) (n:nat) => x ^ (2*n).
+
+Lemma pow_lt_1_compat : forall x n, 0 <= x < 1 -> (0 < n)%nat ->
+   0 <= x ^ n < 1.
+Proof.
+intros x n hx; induction 1; simpl.
+ rewrite Rmult_1_r; tauto.
+split.
+ apply Rmult_le_pos; tauto.
+rewrite <- (Rmult_1_r 1); apply Rmult_le_0_lt_compat; intuition.
+Qed.
+
+Lemma Datan_seq_Rabs : forall x n, Datan_seq (Rabs x) n = Datan_seq x n.
+Proof.
+intros x n; unfold Datan_seq; rewrite !pow_mult, pow2_abs; reflexivity.
+Qed.
+
+Lemma Datan_seq_pos : forall x n, 0 < x -> 0 < Datan_seq x n.
+Proof.
+intros x n x_lb ; unfold Datan_seq ; induction n.
+ simpl ; intuition.
+ replace (x ^ (2 * S n)) with ((x ^ 2) * (x ^ (2 * n))).
+ apply Rmult_gt_0_compat.
+ replace (x^2) with (x*x) by field ; apply Rmult_gt_0_compat ; assumption.
+ assumption.
+ replace (2 * S n)%nat with (S (S (2 * n))) by intuition.
+ simpl ; field.
+Qed.
+
+Lemma Datan_sum_eq :forall x n,
+  sum_f_R0 (tg_alt (Datan_seq x)) n = (1 - (- x ^ 2) ^ S n)/(1 + x ^ 2).
+Proof.
+intros x n.
+assert (dif : - x ^ 2 <> 1).
+apply Rlt_not_eq; apply Rle_lt_trans with 0;[ | apply Rlt_0_1].
+assert (t := pow2_ge_0 x); fourier.
+replace (1 + x ^ 2) with (1 - - (x ^ 2)) by ring; rewrite <- (tech3 _ n dif).
+apply sum_eq; unfold tg_alt, Datan_seq; intros i _.
+rewrite pow_mult, <- Rpow_mult_distr, Ropp_mult_distr_l_reverse, Rmult_1_l.
+reflexivity.
+Qed.
+
+Lemma Datan_seq_increasing : forall x y n, (n > 0)%nat -> 0 <= x < y -> Datan_seq x n < Datan_seq y n.
+Proof.
+intros x y n n_lb x_encad ; assert (x_pos : x >= 0) by intuition.
+ assert (y_pos : y > 0). apply Rle_lt_trans with (r2:=x) ; intuition.
+ induction n.
+ apply False_ind ; intuition.
+ clear -x_encad x_pos y_pos ; induction n ; unfold Datan_seq.
+ case x_pos ; clear x_pos ; intro x_pos.
+ simpl ; apply Rmult_gt_0_lt_compat ; intuition. fourier.
+ rewrite x_pos ; rewrite pow_i. replace (y ^ (2*1)) with (y*y).
+ apply Rmult_gt_0_compat ; assumption.
+ simpl ; field.
+ intuition.
+ assert (Hrew : forall a, a^(2 * S (S n)) = (a ^ 2) * (a ^ (2 * S n))).
+  clear ; intro a ; replace (2 * S (S n))%nat with (S (S (2 * S n)))%nat by intuition.
+  simpl ; field.
+ case x_pos ; clear x_pos ; intro x_pos.
+ rewrite Hrew ; rewrite Hrew.
+ apply Rmult_gt_0_lt_compat ; intuition.
+ apply Rmult_gt_0_lt_compat ; intuition ; fourier.
+ rewrite x_pos.
+ rewrite pow_i ; intuition.
+Qed.
+
+Lemma Datan_seq_decreasing : forall x,  -1 < x -> x < 1 -> Un_decreasing (Datan_seq x).
+Proof.
+intros x x_lb x_ub n.
+unfold Datan_seq.
+replace (2 * S n)%nat with (2 + 2 * n)%nat by ring.
+rewrite <- (Rmult_1_l (x ^ (2 * n))).
+rewrite pow_add.
+apply Rmult_le_compat_r.
+rewrite pow_mult; apply pow_le, pow2_ge_0.
+apply Rlt_le; rewrite <- pow2_abs.
+assert (intabs : 0 <= Rabs x < 1).
+ split;[apply Rabs_pos | apply Rabs_def1]; tauto.
+apply (pow_lt_1_compat (Rabs x) 2) in intabs.
+ tauto.
+omega.
+Qed.
+
+Lemma Datan_seq_CV_0 : forall x, -1 < x -> x < 1 -> Un_cv (Datan_seq x) 0.
+Proof.
+intros x x_lb x_ub eps eps_pos.
+assert (x_ub2 : Rabs (x^2) < 1).
+ rewrite Rabs_pos_eq;[ | apply pow2_ge_0].
+ rewrite <- pow2_abs.
+ assert (H: 0 <= Rabs x < 1)
+   by (split;[apply Rabs_pos | apply Rabs_def1; auto]).
+ apply (pow_lt_1_compat _ 2) in H;[tauto | omega].
+elim (pow_lt_1_zero (x^2) x_ub2 eps eps_pos) ; intros N HN ; exists N ; intros n Hn.
+unfold R_dist, Datan_seq.
+replace (x ^ (2 * n) - 0) with ((x ^ 2) ^ n). apply HN ; assumption.
+rewrite pow_mult ; field.
+Qed.
+
+Lemma Datan_lim : forall x, -1 < x -> x < 1 ->
+    Un_cv (fun N : nat => sum_f_R0 (tg_alt (Datan_seq x)) N) (/ (1 + x ^ 2)).
+Proof.
+intros x x_lb x_ub eps eps_pos.
+assert (Tool0 : 0 <= x ^ 2) by apply pow2_ge_0.
+assert (Tool1 : 0 < (1 + x ^ 2)).
+ solve[apply Rplus_lt_le_0_compat ; intuition].
+assert (Tool2 : / (1 + x ^ 2) > 0).
+ apply Rinv_0_lt_compat ; tauto.
+assert (x_ub2' : 0<= Rabs (x^2) < 1).
+ rewrite Rabs_pos_eq, <- pow2_abs;[ | apply pow2_ge_0].
+ apply pow_lt_1_compat;[split;[apply Rabs_pos | ] | omega].
+ apply Rabs_def1; assumption.
+assert (x_ub2 : Rabs (x^2) < 1) by tauto.
+assert (eps'_pos : ((1+x^2)*eps) > 0).
+  apply Rmult_gt_0_compat ; assumption.
+elim (pow_lt_1_zero _ x_ub2 _ eps'_pos) ; intros N HN ; exists N.
+intros n Hn.
+assert (H1 : - x^2 <> 1).
+ apply Rlt_not_eq; apply Rle_lt_trans with (2 := Rlt_0_1).
+assert (t := pow2_ge_0 x); fourier.
+rewrite Datan_sum_eq. 
+unfold R_dist.
+assert (tool : forall a b, a / b - /b = (-1 + a) /b).
+ intros a b; rewrite <- (Rmult_1_l (/b)); unfold Rdiv, Rminus.
+ rewrite <- Ropp_mult_distr_l_reverse, Rmult_plus_distr_r, Rplus_comm.
+ reflexivity.
+set (u := 1 + x ^ 2); rewrite tool; unfold Rminus; rewrite <- Rplus_assoc.
+unfold Rdiv, u.
+rewrite Rplus_opp_l, Rplus_0_l, Ropp_mult_distr_l_reverse, Rabs_Ropp.
+rewrite Rabs_mult; clear tool u.
+assert (tool : forall k, Rabs ((-x ^ 2) ^ k) = Rabs ((x ^ 2) ^ k)).
+ clear -Tool0; induction k;[simpl; rewrite Rabs_R1;tauto | ].
+ rewrite <- !(tech_pow_Rmult _ k), !Rabs_mult, Rabs_Ropp, IHk, Rabs_pos_eq.
+  reflexivity.
+ exact Tool0.
+rewrite tool, (Rabs_pos_eq (/ _)); clear tool;[ | apply Rlt_le; assumption].
+assert (tool : forall a b c, 0 < b -> a < b * c -> a * / b < c).
+ intros a b c bp h; replace c with (b * c * /b).
+  apply Rmult_lt_compat_r.  
+   apply Rinv_0_lt_compat; assumption.
+  assumption.
+ field; apply Rgt_not_eq; exact bp.
+apply tool;[exact Tool1 | ].
+apply HN; omega.
+Qed.
+
+Lemma Datan_CVU_prelim : forall c (r : posreal), Rabs c + r < 1 ->
+ CVU (fun N x => sum_f_R0 (tg_alt (Datan_seq x)) N)
+     (fun y : R => / (1 + y ^ 2)) c r.
+Proof.
+intros c r ub_ub eps eps_pos.
+apply (Alt_CVU (fun x n => Datan_seq n x) 
+         (fun x => /(1 + x ^ 2))
+         (Datan_seq (Rabs c + r)) c r).
+     intros x inb; apply Datan_seq_decreasing;
+      try (apply Boule_lt in inb; apply Rabs_def2 in inb;
+         destruct inb; fourier).
+    intros x inb; apply Datan_seq_CV_0;
+      try (apply Boule_lt in inb; apply Rabs_def2 in inb;
+         destruct inb; fourier).
+   intros x inb; apply (Datan_lim x);
+      try (apply Boule_lt in inb; apply Rabs_def2 in inb;
+         destruct inb; fourier).
+  intros x [ | n] inb.
+   solve[unfold Datan_seq; apply Rle_refl].
+  rewrite <- (Datan_seq_Rabs x); apply Rlt_le, Datan_seq_increasing.
+   omega.
+  apply Boule_lt in inb; intuition.
+  solve[apply Rabs_pos].
+ apply Datan_seq_CV_0.
+  apply Rlt_trans with 0;[fourier | ].
+  apply Rplus_le_lt_0_compat.
+   solve[apply Rabs_pos].
+  destruct r; assumption.
+ assumption.
+assumption.
+Qed.
+
+Lemma Datan_is_datan : forall (N:nat) (x:R),
+      -1 <= x ->
+      x < 1 ->
+derivable_pt_lim (fun x => sum_f_R0 (tg_alt (Ratan_seq x)) N) x (sum_f_R0 (tg_alt (Datan_seq x)) N).
+Proof.
+assert (Tool : forall N, (-1) ^ (S (2 * N))  = - 1).
+ intro n ; induction n.
+  simpl ; field.
+  replace ((-1) ^ S (2 * S n)) with ((-1) ^ 2 * (-1) ^ S (2*n)).
+  rewrite IHn ; field.
+  rewrite <- pow_add.
+  replace (2 + S (2 * n))%nat with (S (2 * S n))%nat.
+  reflexivity.
+  intuition.
+intros N x x_lb x_ub.
+ induction N.
+  unfold Datan_seq, Ratan_seq, tg_alt ; simpl.
+  intros eps eps_pos.
+   elim (derivable_pt_lim_id x eps eps_pos) ; intros delta Hdelta ; exists delta.
+   intros h hneq h_b.
+    replace (1 * ((x + h) * 1 / 1) - 1 * (x * 1 / 1)) with (id (x + h) - id x). 
+    rewrite Rmult_1_r.
+    apply Hdelta ; assumption.
+    unfold id ; field ; assumption.
+  intros eps eps_pos.
+  assert (eps_3_pos : (eps/3) > 0) by fourier.
+  elim (IHN (eps/3) eps_3_pos) ; intros delta1 Hdelta1.
+  assert (Main : derivable_pt_lim (fun x : R =>tg_alt (Ratan_seq x) (S N)) x ((tg_alt (Datan_seq x)) (S N))).
+   clear -Tool ; intros eps' eps'_pos.
+   elim (derivable_pt_lim_pow x (2 * (S N) + 1) eps' eps'_pos) ; intros delta Hdelta ; exists delta.
+   intros h h_neq h_b ; unfold tg_alt, Ratan_seq, Datan_seq.
+   replace (((-1) ^ S N * ((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1)) -
+    (-1) ^ S N * (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h -
+    (-1) ^ S N * x ^ (2 * S N)) 
+    with (((-1)^(S N)) * ((((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1)) -
+    (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h - x ^ (2 * S N))).
+   rewrite Rabs_mult ; rewrite pow_1_abs ; rewrite Rmult_1_l.
+   replace (((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1) -
+    x ^ (2 * S N + 1) / INR (2 * S N + 1)) / h - x ^ (2 * S N))
+    with ((/INR (2* S N + 1)) * (((x + h) ^ (2 * S N + 1) - x ^ (2 * S N + 1)) / h -
+    INR (2 * S N + 1) * x ^ pred (2 * S N + 1))).
+   rewrite Rabs_mult.
+   case (Req_dec (((x + h) ^ (2 * S N + 1) - x ^ (2 * S N + 1)) / h -
+     INR (2 * S N + 1) * x ^ pred (2 * S N + 1)) 0) ; intro Heq.
+   rewrite Heq ; rewrite Rabs_R0 ; rewrite Rmult_0_r ; assumption.
+   apply Rlt_trans with (r2:=Rabs
+           (((x + h) ^ (2 * S N + 1) - x ^ (2 * S N + 1)) / h -
+            INR (2 * S N + 1) * x ^ pred (2 * S N + 1))).
+   rewrite <- Rmult_1_l ; apply Rmult_lt_compat_r.
+   apply Rabs_pos_lt ; assumption.
+   rewrite Rabs_right.
+   replace 1 with (/1) by field.
+   apply Rinv_1_lt_contravar ; intuition.
+   apply Rgt_ge ; replace (INR (2 * S N + 1)) with (INR (2*S N) + 1) ;
+   [apply RiemannInt.RinvN_pos | ].
+   replace (2 * S N + 1)%nat with (S (2 * S N))%nat by intuition ;
+   rewrite S_INR ; reflexivity.
+   apply Hdelta ; assumption.
+   rewrite Rmult_minus_distr_l.
+   replace (/ INR (2 * S N + 1) * (INR (2 * S N + 1) * x ^ pred (2 * S N + 1))) with (x ^ (2 * S N)).
+   unfold Rminus ; rewrite Rplus_comm.
+   replace (((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1) +
+      - (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h + - x ^ (2 * S N))
+      with (- x ^ (2 * S N) + (((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1) +
+      - (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h)) by intuition.
+   apply Rplus_eq_compat_l. field.
+   split ; [apply Rgt_not_eq|] ; intuition.
+   clear ; replace (pred (2 * S N + 1)) with (2 * S N)%nat by intuition.
+   field ; apply Rgt_not_eq ; intuition.
+   field ; split ; [apply Rgt_not_eq |] ; intuition.
+   elim (Main (eps/3) eps_3_pos) ; intros delta2 Hdelta2.
+   destruct delta1 as (delta1, delta1_pos) ; destruct delta2 as (delta2, delta2_pos).
+   pose (mydelta := Rmin delta1 delta2).
+   assert (mydelta_pos : mydelta > 0).
+    unfold mydelta ; rewrite Rmin_Rgt ; split ; assumption.
+   pose (delta := mkposreal mydelta mydelta_pos) ; exists delta ; intros h h_neq h_b.
+   clear Main IHN.
+   unfold Rminus at 1.
+   apply Rle_lt_trans with (r2:=eps/3 + eps / 3).
+   assert (Temp : (sum_f_R0 (tg_alt (Ratan_seq (x + h))) (S N) -
+    sum_f_R0 (tg_alt (Ratan_seq x)) (S N)) / h +
+    - sum_f_R0 (tg_alt (Datan_seq x)) (S N) = ((sum_f_R0 (tg_alt (Ratan_seq (x + h))) N -
+              sum_f_R0 (tg_alt (Ratan_seq x)) N) / h) + (-
+             sum_f_R0 (tg_alt (Datan_seq x)) N) + ((tg_alt (Ratan_seq (x + h)) (S N) - tg_alt (Ratan_seq x) (S N)) /
+             h - tg_alt (Datan_seq x) (S N))).
+    simpl ; field ; intuition.
+   apply Rle_trans with (r2:= Rabs ((sum_f_R0 (tg_alt (Ratan_seq (x + h))) N -
+        sum_f_R0 (tg_alt (Ratan_seq x)) N) / h +
+       - sum_f_R0 (tg_alt (Datan_seq x)) N) +
+       Rabs ((tg_alt (Ratan_seq (x + h)) (S N) - tg_alt (Ratan_seq x) (S N)) / h -
+        tg_alt (Datan_seq x) (S N))).
+   rewrite Temp ; clear Temp ; apply Rabs_triang.
+   apply Rplus_le_compat ; apply Rlt_le ; [apply Hdelta1 | apply Hdelta2] ;
+   intuition ; apply Rlt_le_trans with (r2:=delta) ; intuition unfold delta, mydelta.
+   apply Rmin_l.
+   apply Rmin_r.
+   fourier.
+Qed.
+
+Lemma Ratan_CVU' :
+  CVU (fun N x => sum_f_R0 (tg_alt (Ratan_seq x)) N)
+                     ps_atan (/2) (mkposreal (/2) pos_half_prf).
+Proof.
+apply (Alt_CVU (fun i r => Ratan_seq r i) ps_atan PI_tg (/2) pos_half);
+  lazy beta.
+    now intros; apply Ratan_seq_decreasing, Boule_half_to_interval.
+   now intros; apply Ratan_seq_converging, Boule_half_to_interval.
+  intros x b; apply Boule_half_to_interval in b.
+  unfold ps_atan; destruct (in_int x) as [inside | outside];
+   [ | destruct b; case outside; split; fourier].
+  destruct (ps_atan_exists_1 x inside) as [v Pv].
+  apply Un_cv_ext with (2 := Pv);[reflexivity].
+ intros x n b; apply Boule_half_to_interval in b.
+ rewrite <- (Rmult_1_l (PI_tg n)); unfold Ratan_seq, PI_tg. 
+ apply Rmult_le_compat_r.
+  apply Rlt_le, Rinv_0_lt_compat, (lt_INR 0); omega.
+ rewrite <- (pow1 (2 * n + 1)); apply pow_incr; assumption.
+exact PI_tg_cv.
+Qed.
+
+Lemma Ratan_CVU :
+  CVU (fun N x => sum_f_R0 (tg_alt (Ratan_seq x)) N)
+                     ps_atan 0  (mkposreal 1 Rlt_0_1).
+Proof.
+intros eps ep; destruct (Ratan_CVU' eps ep) as [N Pn].
+exists N; intros n x nN b_y.
+case (Rtotal_order 0 x) as [xgt0 | [x0 | x0]].
+  assert (Boule (/2) {| pos := / 2; cond_pos := pos_half_prf|} x).
+   revert b_y; unfold Boule; simpl; intros b_y; apply Rabs_def2 in b_y.
+   destruct b_y; unfold Boule; simpl; apply Rabs_def1; fourier.
+  apply Pn; assumption.
+ rewrite <- x0, ps_atan0_0.
+ rewrite <- (sum_eq (fun _ => 0)), sum_cte, Rmult_0_l, Rminus_0_r, Rabs_pos_eq.
+   assumption.
+  apply Rle_refl.
+ intros i _; unfold tg_alt, Ratan_seq, Rdiv; rewrite plus_comm; simpl.
+ solve[rewrite !Rmult_0_l, Rmult_0_r; auto].
+replace (ps_atan x - sum_f_R0 (tg_alt (Ratan_seq x)) n) with
+  (-(ps_atan (-x) - sum_f_R0 (tg_alt (Ratan_seq (-x))) n)).
+ rewrite Rabs_Ropp.
+ assert (Boule (/2) {| pos := / 2; cond_pos := pos_half_prf|} (-x)).
+  revert b_y; unfold Boule; simpl; intros b_y; apply Rabs_def2 in b_y.
+  destruct b_y; unfold Boule; simpl; apply Rabs_def1; fourier.
+ apply Pn; assumption.
+unfold Rminus; rewrite ps_atan_opp, Ropp_plus_distr, sum_Ratan_seq_opp.
+rewrite !Ropp_involutive; reflexivity.
+Qed.
+
+Lemma Alt_PI_tg : forall n, PI_tg n = Ratan_seq 1 n.
+Proof.
+intros n; unfold PI_tg, Ratan_seq, Rdiv; rewrite pow1, Rmult_1_l.
+reflexivity.
+Qed.
+
+Lemma Ratan_is_ps_atan : forall eps, eps > 0 ->
+       exists N, forall n, (n >= N)%nat -> forall x, -1 < x -> x < 1 ->
+       Rabs (sum_f_R0 (tg_alt (Ratan_seq x)) n - ps_atan x) < eps.
+Proof.
+intros eps ep.
+destruct (Ratan_CVU _ ep) as [N1 PN1].
+exists N1; intros n nN x xm1 x1; rewrite <- Rabs_Ropp, Ropp_minus_distr.
+apply PN1; [assumption | ].
+unfold Boule; simpl; rewrite Rminus_0_r; apply Rabs_def1; assumption.
+Qed.
+
+Lemma Datan_continuity : continuity (fun x => /(1+x ^ 2)).
+Proof.
+apply continuity_inv.
+apply continuity_plus.
+apply continuity_const ; unfold constant ; intuition.
+apply derivable_continuous ; apply derivable_pow.
+intro x ; apply Rgt_not_eq ; apply Rge_gt_trans with (1+0) ; [|fourier] ;
+ apply Rplus_ge_compat_l.
+ replace (x^2) with (x²).
+ apply Rle_ge ; apply Rle_0_sqr.
+ unfold Rsqr ; field.
+Qed.
+
+Lemma derivable_pt_lim_ps_atan : forall x, -1 < x < 1 ->
+  derivable_pt_lim ps_atan x ((fun y => /(1 + y ^ 2)) x).
+Proof.
+intros x x_encad.
+destruct (boule_in_interval (-1) 1 x x_encad) as [c [r [Pcr1 [P1 P2]]]].
+change (/ (1 + x ^ 2)) with ((fun u => /(1 + u ^ 2)) x).
+assert (t := derivable_pt_lim_CVU).
+apply derivable_pt_lim_CVU with 
+          (fn := (fun N x => sum_f_R0 (tg_alt (Ratan_seq x)) N))
+          (fn' := (fun N x => sum_f_R0 (tg_alt (Datan_seq x)) N))
+          (c := c) (r := r).
+    assumption.
+   intros y N inb; apply Rabs_def2 in inb; destruct inb.
+   apply Datan_is_datan.
+    fourier.
+   fourier.
+  intros y inb; apply Rabs_def2 in inb; destruct inb.
+  assert (y_gt_0 : -1 < y) by fourier.
+  assert (y_lt_1 : y < 1) by fourier.
+  intros eps eps_pos ; elim (Ratan_is_ps_atan eps eps_pos).
+  intros N HN ; exists N; intros n n_lb ; apply HN ; tauto.
+ apply Datan_CVU_prelim.
+ replace ((c - r + (c + r)) / 2) with c by field.
+ unfold mkposreal_lb_ub; simpl.
+ replace ((c + r - (c - r)) / 2) with (r :R) by field.
+ assert (Rabs c < 1 - r).
+  unfold Boule in Pcr1; destruct r; simpl in *; apply Rabs_def1;
+  apply Rabs_def2 in Pcr1; destruct Pcr1; fourier.
+ fourier.
+intros; apply Datan_continuity.
+Qed.
+
+Lemma derivable_pt_ps_atan :
+   forall x, -1 < x < 1 -> derivable_pt ps_atan x.
+Proof.
+intros x x_encad.
+exists (/(1+x^2)) ; apply derivable_pt_lim_ps_atan; assumption.
+Qed.
+
+Lemma ps_atan_continuity_pt_1 : forall eps : R,
+       eps > 0 ->
+       exists alp : R,
+       alp > 0 /\
+       (forall x, x < 1 -> 0 < x -> R_dist x 1 < alp ->
+       dist R_met (ps_atan x) (Alt_PI/4) < eps).
+Proof.
+intros eps eps_pos.
+assert (eps_3_pos : eps / 3 > 0) by fourier.
+elim (Ratan_is_ps_atan (eps / 3) eps_3_pos) ; intros N1 HN1.
+unfold Alt_PI.
+destruct exist_PI as [v Pv]; replace ((4 * v)/4) with v by field.
+assert (Pv' : Un_cv (sum_f_R0 (tg_alt (Ratan_seq 1))) v).
+ apply Un_cv_ext with (2:= Pv).
+ intros; apply sum_eq; intros; unfold tg_alt; rewrite Alt_PI_tg; tauto.
+destruct (Pv' (eps / 3) eps_3_pos) as [N2 HN2].
+set (N := (N1 + N2)%nat).
+assert (O_lb : 0 <= 1) by intuition ; assert (O_ub : 1 <= 1) by intuition ;
+ elim (ps_atanSeq_continuity_pt_1 N 1 O_lb O_ub (eps / 3) eps_3_pos) ; intros alpha Halpha ;
+ clear -HN1 HN2 Halpha eps_3_pos; destruct Halpha as (alpha_pos, Halpha).
+exists alpha ; split;[assumption | ].
+intros x x_ub x_lb x_bounds.
+simpl ; unfold R_dist.
+replace (ps_atan x - v) with ((ps_atan x - sum_f_R0 (tg_alt (Ratan_seq x)) N)
+     + (sum_f_R0 (tg_alt (Ratan_seq x)) N - sum_f_R0 (tg_alt (Ratan_seq 1)) N)
+     + (sum_f_R0 (tg_alt (Ratan_seq 1)) N - v)).
+apply Rle_lt_trans with (r2:=Rabs (ps_atan x - sum_f_R0 (tg_alt (Ratan_seq x)) N) +
+      Rabs ((sum_f_R0 (tg_alt (Ratan_seq x)) N - sum_f_R0 (tg_alt (Ratan_seq 1)) N) +
+   (sum_f_R0 (tg_alt (Ratan_seq 1)) N - v))).
+rewrite Rplus_assoc ; apply Rabs_triang.
+   replace eps with (2 / 3 * eps + eps / 3).
+   rewrite Rplus_comm.
+   apply Rplus_lt_compat.
+   apply Rle_lt_trans with (r2 := Rabs (sum_f_R0 (tg_alt (Ratan_seq x)) N - sum_f_R0 (tg_alt (Ratan_seq 1)) N) +
+      Rabs (sum_f_R0 (tg_alt (Ratan_seq 1)) N - v)).
+   apply Rabs_triang.
+   apply Rlt_le_trans with (r2:= eps / 3 + eps / 3).
+   apply Rplus_lt_compat.
+   simpl in Halpha ; unfold R_dist in Halpha.
+   apply Halpha ; split.
+   unfold D_x, no_cond ; split ; [ | apply Rgt_not_eq ] ; intuition.
+   intuition.
+   apply HN2; unfold N; omega.
+   fourier.
+  rewrite <- Rabs_Ropp, Ropp_minus_distr; apply HN1.
+     unfold N; omega.  
+    fourier.
+  assumption.
+ field.
+ring.
+Qed.
+
+Lemma Datan_eq_DatanSeq_interv : forall x, -1 < x < 1 ->
+ forall (Pratan:derivable_pt ps_atan x) (Prmymeta:derivable_pt atan x),
+      derive_pt ps_atan x Pratan = derive_pt atan x Prmymeta.
+Proof.
+assert (freq : 0 < tan 1) by apply (Rlt_trans _ _ _ Rlt_0_1 tan_1_gt_1).
+intros x x_encad Pratan Prmymeta.
+ rewrite pr_nu_var2_interv with (g:=ps_atan) (lb:=-1) (ub:=tan 1)
+   (pr2 := derivable_pt_ps_atan x x_encad).
+ rewrite pr_nu_var2_interv with (f:=atan) (g:=atan) (lb:=-1) (ub:= 1) (pr2:=derivable_pt_atan x).
+ assert (Temp := derivable_pt_lim_ps_atan x x_encad).
+ assert (Hrew1 : derive_pt ps_atan x (derivable_pt_ps_atan x x_encad) = (/(1+x^2))).
+  apply derive_pt_eq_0 ; assumption.
+  rewrite derive_pt_atan.
+  rewrite Hrew1.
+  replace (Rsqr x) with (x ^ 2) by (unfold Rsqr; ring).
+  unfold Rdiv; rewrite Rmult_1_l; reflexivity.
+     fourier.
+    assumption.
+   intros; reflexivity.
+  fourier.
+ assert (t := tan_1_gt_1); split;destruct x_encad; fourier.
+intros; reflexivity.
+Qed.
+
+Lemma atan_eq_ps_atan :
+ forall x, 0 < x < 1 -> atan x = ps_atan x.
+Proof.
+intros x x_encad.
+assert (pr1 : forall c : R, 0 < c < x -> derivable_pt (atan - ps_atan) c).
+ intros c c_encad.
+ apply derivable_pt_minus.
+  exact (derivable_pt_atan c).
+ apply derivable_pt_ps_atan.
+  destruct x_encad; destruct c_encad; split; fourier.
+assert (pr2 : forall c : R, 0 < c < x -> derivable_pt id c).
+ intros ; apply derivable_pt_id; fourier.
+assert (delta_cont : forall c : R, 0 <= c <= x -> continuity_pt (atan - ps_atan) c).
+ intros c [[c_encad1 | c_encad1 ] [c_encad2 | c_encad2]];
+        apply continuity_pt_minus.
+        apply derivable_continuous_pt ; apply derivable_pt_atan. 
+       apply derivable_continuous_pt ; apply derivable_pt_ps_atan.
+       split; destruct x_encad; fourier.
+      apply derivable_continuous_pt, derivable_pt_atan.
+     apply derivable_continuous_pt, derivable_pt_ps_atan.
+     subst c; destruct x_encad; split; fourier.
+    apply derivable_continuous_pt, derivable_pt_atan.
+   apply derivable_continuous_pt, derivable_pt_ps_atan.
+   subst c; split; fourier.
+  apply derivable_continuous_pt, derivable_pt_atan.
+ apply derivable_continuous_pt, derivable_pt_ps_atan.
+ subst c; destruct x_encad; split; fourier.
+assert (id_cont : forall c : R, 0 <= c <= x -> continuity_pt id c).
+    intros ; apply derivable_continuous ; apply derivable_id.
+assert (x_lb : 0 < x) by (destruct x_encad; fourier).
+elim (MVT (atan - ps_atan)%F id 0 x pr1 pr2 x_lb delta_cont id_cont) ; intros d Temp ; elim Temp ; intros d_encad Main.
+clear - Main x_encad.
+assert (Temp : forall (pr: derivable_pt (atan - ps_atan) d), derive_pt (atan - ps_atan) d pr = 0).
+ intro pr.
+ assert (d_encad3 : -1 < d < 1).
+  destruct d_encad; destruct x_encad; split; fourier.
+ pose (pr3 := derivable_pt_minus atan ps_atan d (derivable_pt_atan d) (derivable_pt_ps_atan d d_encad3)).
+ rewrite <- pr_nu_var2_interv with (f:=(atan - ps_atan)%F) (g:=(atan - ps_atan)%F) (lb:=0) (ub:=x) (pr1:=pr3) (pr2:=pr).
+    unfold pr3. rewrite derive_pt_minus.
+    rewrite Datan_eq_DatanSeq_interv with (Prmymeta := derivable_pt_atan d).
+     intuition.
+    assumption. 
+   destruct d_encad; fourier.
+  assumption.
+ reflexivity.
+assert (iatan0 : atan 0 = 0).
+ apply tan_is_inj.
+   apply atan_bound.
+  rewrite Ropp_div; assert (t := PI2_RGT_0); split; fourier.
+ rewrite tan_0, atan_right_inv; reflexivity.
+generalize Main; rewrite Temp, Rmult_0_r.
+replace ((atan - ps_atan)%F x) with (atan x - ps_atan x) by intuition.
+replace ((atan - ps_atan)%F 0) with (atan 0 - ps_atan 0) by intuition.
+rewrite iatan0, ps_atan0_0, !Rminus_0_r.
+replace (derive_pt id d (pr2 d d_encad)) with 1. 
+ rewrite Rmult_1_r.
+ solve[intros M; apply Rminus_diag_uniq; auto].
+rewrite pr_nu_var with (g:=id) (pr2:=derivable_pt_id d).
+ symmetry ; apply derive_pt_id.
+tauto.
+Qed.
+
+
+Theorem Alt_PI_eq : Alt_PI = PI.
+apply Rmult_eq_reg_r with (/4); fold (Alt_PI/4); fold (PI/4);
+  [ | apply Rgt_not_eq; fourier].
+assert (0 < PI/6) by (apply PI6_RGT_0).
+assert (t1:= PI2_1).
+assert (t2 := PI_4).
+assert (m := Alt_PI_RGT_0).
+assert (-PI/2 < 1 < PI/2) by (rewrite Ropp_div; split; fourier).
+apply cond_eq; intros eps ep.
+change (R_dist (Alt_PI/4) (PI/4) < eps).
+assert (ca : continuity_pt atan 1).
+  apply derivable_continuous_pt, derivable_pt_atan.
+assert (Xe : exists eps', exists eps'',
+  eps' + eps'' <= eps /\ 0 < eps' /\ 0 < eps'').
+ exists (eps/2); exists (eps/2); repeat apply conj; fourier.
+destruct Xe as [eps' [eps'' [eps_ineq [ep' ep'']]]].
+destruct (ps_atan_continuity_pt_1 _ ep') as [alpha [a0 Palpha]].
+destruct (ca _ ep'') as [beta [b0 Pbeta]].
+assert (Xa : exists a, 0 < a < 1 /\ R_dist a 1 < alpha /\
+                R_dist a 1 < beta).
+ exists (Rmax (/2) (Rmax (1 - alpha /2) (1 - beta /2))).
+ assert (/2 <= Rmax (/2) (Rmax (1 - alpha /2) (1 - beta /2))) by apply Rmax_l.
+ assert (Rmax (1 - alpha /2) (1 - beta /2) <=
+         Rmax (/2) (Rmax (1 - alpha /2) (1 - beta /2))) by apply Rmax_r.
+ assert ((1 - alpha /2) <= Rmax (1 - alpha /2) (1 - beta /2)) by apply Rmax_l.
+ assert ((1 - beta /2) <= Rmax (1 - alpha /2) (1 - beta /2)) by apply Rmax_r.
+ assert (Rmax (1 - alpha /2) (1 - beta /2) < 1)
+   by (apply Rmax_lub_lt; fourier).
+ split;[split;[ | apply Rmax_lub_lt]; fourier | ].
+ assert (0 <= 1 - Rmax (/ 2) (Rmax (1 - alpha / 2) (1 - beta / 2))).
+  assert (Rmax (/2) (Rmax (1 - alpha / 2) 
+            (1 - beta /2)) <= 1) by (apply Rmax_lub; fourier).
+  fourier.
+ split; unfold R_dist; rewrite <-Rabs_Ropp, Ropp_minus_distr,
+   Rabs_pos_eq;fourier.
+destruct Xa as [a [[Pa0 Pa1] [P1 P2]]].
+apply Rle_lt_trans with (1 := R_dist_tri _ _ (ps_atan a)).
+apply Rlt_le_trans with (2 := eps_ineq).
+apply Rplus_lt_compat.
+rewrite R_dist_sym; apply Palpha; assumption.
+rewrite <- atan_eq_ps_atan.
+ rewrite <- atan_1; apply (Pbeta a); auto.
+ split; [ | exact P2].
+split;[exact I | apply Rgt_not_eq; assumption].
+split; assumption.
+Qed.
+
+Lemma PI_ineq :
+  forall N : nat,
+    sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <=
+    sum_f_R0 (tg_alt PI_tg) (2 * N).
+Proof.
+intros; rewrite <- Alt_PI_eq; apply Alt_PI_ineq.
+Qed.
+
diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v
index b6286c0d..200019a8 100644
--- a/theories/Reals/Raxioms.v
+++ b/theories/Reals/Raxioms.v
@@ -1,20 +1,18 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Raxioms.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (*********************************************************)
 (**    Axiomatisation of the classical reals             *)
 (*********************************************************)
 
 Require Export ZArith_base.
 Require Export Rdefinitions.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (*********************************************************)
 (** *            Field axioms                            *)
@@ -107,13 +105,13 @@ Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real.
 (**********************************************************)
 
 (**********)
-Boxed Fixpoint INR (n:nat) : R :=
+Fixpoint INR (n:nat) : R :=
   match n with
   | O => 0
   | S O => 1
   | S n => INR n + 1
   end.
-Arguments Scope INR [nat_scope].
+Arguments INR n%nat.
 
 
 (**********************************************************)
@@ -124,10 +122,10 @@ Arguments Scope INR [nat_scope].
 Definition IZR (z:Z) : R :=
   match z with
   | Z0 => 0
-  | Zpos n => INR (nat_of_P n)
-  | Zneg n => - INR (nat_of_P n)
+  | Zpos n => INR (Pos.to_nat n)
+  | Zneg n => - INR (Pos.to_nat n)
   end.
-Arguments Scope IZR [Z_scope].
+Arguments IZR z%Z.
 
 (**********************************************************)
 (** *    [R] Archimedean                                  *)
diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v
index 23aae957..29715ed9 100644
--- a/theories/Reals/Rbase.v
+++ b/theories/Reals/Rbase.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rbase.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Rdefinitions.
 Require Export Raxioms.
 Require Export RIneq.
diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v
index 15b04807..560f389b 100644
--- a/theories/Reals/Rbasic_fun.v
+++ b/theories/Reals/Rbasic_fun.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rbasic_fun.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (*********************************************************)
 (**          Complements for the real numbers            *)
 (*                                                       *)
@@ -47,10 +45,10 @@ Qed.
 (*********)
 Lemma Rmin_Rgt_l : forall r1 r2 r, Rmin r1 r2 > r -> r1 > r /\ r2 > r.
 Proof.
-  intros r1 r2 r; unfold Rmin in |- *; case (Rle_dec r1 r2); intros.
+  intros r1 r2 r; unfold Rmin; case (Rle_dec r1 r2); intros.
   split.
   assumption.
-  unfold Rgt in |- *; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0).
+  unfold Rgt; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0).
   split.
   generalize (Rnot_le_lt r1 r2 n); intro; exact (Rgt_trans r1 r2 r H0 H).
   assumption.
@@ -59,7 +57,7 @@ Qed.
 (*********)
 Lemma Rmin_Rgt_r : forall r1 r2 r, r1 > r /\ r2 > r -> Rmin r1 r2 > r.
 Proof.
-  intros; unfold Rmin in |- *; case (Rle_dec r1 r2); elim H; clear H; intros;
+  intros; unfold Rmin; case (Rle_dec r1 r2); elim H; clear H; intros;
     assumption.
 Qed.
 
@@ -74,14 +72,14 @@ Qed.
 (*********)
 Lemma Rmin_l : forall x y:R, Rmin x y <= x.
 Proof.
-  intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1;
+  intros; unfold Rmin; case (Rle_dec x y); intro H1;
     [ right; reflexivity | auto with real ].
 Qed.
 
 (*********)
 Lemma Rmin_r : forall x y:R, Rmin x y <= y.
 Proof.
-  intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1;
+  intros; unfold Rmin; case (Rle_dec x y); intro H1;
     [ assumption | auto with real ].
 Qed.
 
@@ -125,20 +123,20 @@ Qed.
 (*********)
 Lemma Rmin_pos : forall x y:R, 0 < x -> 0 < y -> 0 < Rmin x y.
 Proof.
-  intros; unfold Rmin in |- *.
+  intros; unfold Rmin.
   case (Rle_dec x y); intro; assumption.
 Qed.
 
 (*********)
 Lemma Rmin_glb : forall x y z:R, z <= x -> z <= y -> z <= Rmin x y.
 Proof.
-  intros; unfold Rmin in |- *; case (Rle_dec x y); intro; assumption.
+  intros; unfold Rmin; case (Rle_dec x y); intro; assumption.
 Qed.
 
 (*********)
 Lemma Rmin_glb_lt : forall x y z:R, z < x -> z < y -> z < Rmin x y.
 Proof.
-  intros; unfold Rmin in |- *; case (Rle_dec x y); intro; assumption.
+  intros; unfold Rmin; case (Rle_dec x y); intro; assumption.
 Qed.
 
 (*******************************)
@@ -169,8 +167,8 @@ Qed.
 Lemma Rmax_Rle : forall r1 r2 r, r <= Rmax r1 r2 <-> r <= r1 \/ r <= r2.
 Proof.
   intros; split.
-  unfold Rmax in |- *; case (Rle_dec r1 r2); intros; auto.
-  intro; unfold Rmax in |- *; case (Rle_dec r1 r2); elim H; clear H; intros;
+  unfold Rmax; case (Rle_dec r1 r2); intros; auto.
+  intro; unfold Rmax; case (Rle_dec r1 r2); elim H; clear H; intros;
     auto.
   apply (Rle_trans r r1 r2); auto.
   generalize (Rnot_le_lt r1 r2 n); clear n; intro; unfold Rgt in H0;
@@ -179,7 +177,7 @@ Qed.
 
 Lemma Rmax_comm : forall x y:R, Rmax x y = Rmax y x.
 Proof.
-  intros p q; unfold Rmax in |- *; case (Rle_dec p q); case (Rle_dec q p); auto;
+  intros p q; unfold Rmax; case (Rle_dec p q); case (Rle_dec q p); auto;
     intros H1 H2; apply Rle_antisym; auto with real.
 Qed.
 
@@ -190,14 +188,14 @@ Notation RmaxSym := Rmax_comm (only parsing).
 (*********)
 Lemma Rmax_l : forall x y:R, x <= Rmax x y.
 Proof.
-  intros; unfold Rmax in |- *; case (Rle_dec x y); intro H1;
+  intros; unfold Rmax; case (Rle_dec x y); intro H1;
     [ assumption | auto with real ].
 Qed.
 
 (*********)
 Lemma Rmax_r : forall x y:R, y <= Rmax x y.
 Proof.
-  intros; unfold Rmax in |- *; case (Rle_dec x y); intro H1;
+  intros; unfold Rmax; case (Rle_dec x y); intro H1;
     [ right; reflexivity | auto with real ].
 Qed.
 
@@ -234,7 +232,7 @@ Qed.
 Lemma RmaxRmult :
   forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q.
 Proof.
-  intros p q r H; unfold Rmax in |- *.
+  intros p q r H; unfold Rmax.
   case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto.
   case H; intros E1.
   case H1; auto with real.
@@ -248,7 +246,7 @@ Qed.
 (*********)
 Lemma Rmax_stable_in_negreal : forall x y:negreal, Rmax x y < 0.
 Proof.
-  intros; unfold Rmax in |- *; case (Rle_dec x y); intro;
+  intros; unfold Rmax; case (Rle_dec x y); intro;
     [ apply (cond_neg y) | apply (cond_neg x) ].
 Qed.
 
@@ -267,7 +265,7 @@ Qed.
 (*********)
 Lemma Rmax_neg : forall x y:R, x < 0 -> y < 0 -> Rmax x y < 0.
 Proof.
-  intros; unfold Rmax in |- *.
+  intros; unfold Rmax.
   case (Rle_dec x y); intro; assumption.
 Qed.
 
@@ -280,7 +278,7 @@ Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}.
 Proof.
   intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X.
   right; apply (Rle_ge 0 r a).
-  left; fold (0 > r) in |- *; apply (Rnot_le_lt 0 r b).
+  left; fold (0 > r); apply (Rnot_le_lt 0 r b).
 Qed.
 
 (*********)
@@ -293,27 +291,27 @@ Definition Rabs r : R :=
 (*********)
 Lemma Rabs_R0 : Rabs 0 = 0.
 Proof.
-  unfold Rabs in |- *; case (Rcase_abs 0); auto; intro.
+  unfold Rabs; case (Rcase_abs 0); auto; intro.
   generalize (Rlt_irrefl 0); intro; exfalso; auto.
 Qed.
 
 Lemma Rabs_R1 : Rabs 1 = 1.
 Proof.
-unfold Rabs in |- *; case (Rcase_abs 1); auto with real.
+unfold Rabs; case (Rcase_abs 1); auto with real.
 intros H; absurd (1 < 0); auto with real.
 Qed.
 
 (*********)
 Lemma Rabs_no_R0 : forall r, r <> 0 -> Rabs r <> 0.
 Proof.
-  intros; unfold Rabs in |- *; case (Rcase_abs r); intro; auto.
+  intros; unfold Rabs; case (Rcase_abs r); intro; auto.
   apply Ropp_neq_0_compat; auto.
 Qed.
 
 (*********)
 Lemma Rabs_left : forall r, r < 0 -> Rabs r = - r.
 Proof.
-  intros; unfold Rabs in |- *; case (Rcase_abs r); trivial; intro;
+  intros; unfold Rabs; case (Rcase_abs r); trivial; intro;
     absurd (r >= 0).
   exact (Rlt_not_ge r 0 H).
   assumption.
@@ -322,7 +320,7 @@ Qed.
 (*********)
 Lemma Rabs_right : forall r, r >= 0 -> Rabs r = r.
 Proof.
-  intros; unfold Rabs in |- *; case (Rcase_abs r); intro.
+  intros; unfold Rabs; case (Rcase_abs r); intro.
   absurd (r >= 0).
   exact (Rlt_not_ge r 0 r0).
   assumption.
@@ -333,21 +331,21 @@ Lemma Rabs_left1 : forall a:R, a <= 0 -> Rabs a = - a.
 Proof.
   intros a H; case H; intros H1.
   apply Rabs_left; auto.
-  rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real.
+  rewrite H1; simpl; rewrite Rabs_right; auto with real.
 Qed.
 
 (*********)
 Lemma Rabs_pos : forall x:R, 0 <= Rabs x.
 Proof.
-  intros; unfold Rabs in |- *; case (Rcase_abs x); intro.
+  intros; unfold Rabs; case (Rcase_abs x); intro.
   generalize (Ropp_lt_gt_contravar x 0 r); intro; unfold Rgt in H;
-    rewrite Ropp_0 in H; unfold Rle in |- *; left; assumption.
+    rewrite Ropp_0 in H; unfold Rle; left; assumption.
   apply Rge_le; assumption.
 Qed.
 
 Lemma Rle_abs : forall x:R, x <= Rabs x.
 Proof.
-  intro; unfold Rabs in |- *; case (Rcase_abs x); intros; fourier.
+  intro; unfold Rabs; case (Rcase_abs x); intros; fourier.
 Qed.
 
 Definition RRle_abs := Rle_abs.
@@ -355,7 +353,7 @@ Definition RRle_abs := Rle_abs.
 (*********)
 Lemma Rabs_pos_eq : forall x:R, 0 <= x -> Rabs x = x.
 Proof.
-  intros; unfold Rabs in |- *; case (Rcase_abs x); intro;
+  intros; unfold Rabs; case (Rcase_abs x); intro;
     [ generalize (Rgt_not_le 0 x r); intro; exfalso; auto | trivial ].
 Qed.
 
@@ -370,7 +368,7 @@ Lemma Rabs_pos_lt : forall x:R, x <> 0 -> 0 < Rabs x.
 Proof.
   intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro;
     auto.
-  exfalso; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *;
+  exfalso; clear H0; elim H; clear H; generalize H1; unfold Rabs;
     case (Rcase_abs x); intros; auto.
   clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0);
     rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x);
@@ -380,7 +378,7 @@ Qed.
 (*********)
 Lemma Rabs_minus_sym : forall x y:R, Rabs (x - y) = Rabs (y - x).
 Proof.
-  intros; unfold Rabs in |- *; case (Rcase_abs (x - y));
+  intros; unfold Rabs; case (Rcase_abs (x - y));
     case (Rcase_abs (y - x)); intros.
   generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros;
     generalize (Rlt_asym x y H); intro; exfalso;
@@ -399,7 +397,7 @@ Qed.
 (*********)
 Lemma Rabs_mult : forall x y:R, Rabs (x * y) = Rabs x * Rabs y.
 Proof.
-  intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x);
+  intros; unfold Rabs; case (Rcase_abs (x * y)); case (Rcase_abs x);
     case (Rcase_abs y); intros; auto.
   generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro;
     rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1);
@@ -450,7 +448,7 @@ Qed.
 (*********)
 Lemma Rabs_Rinv : forall r, r <> 0 -> Rabs (/ r) = / Rabs r.
 Proof.
-  intro; unfold Rabs in |- *; case (Rcase_abs r); case (Rcase_abs (/ r)); auto;
+  intro; unfold Rabs; case (Rcase_abs r); case (Rcase_abs (/ r)); auto;
     intros.
   apply Ropp_inv_permute; auto.
   generalize (Rinv_lt_0_compat r r1); intro; unfold Rge in r0; elim r0; intros.
@@ -472,7 +470,7 @@ Proof.
   cut (Rabs (-1) = 1).
   intros; rewrite H0.
   ring.
-  unfold Rabs in |- *; case (Rcase_abs (-1)).
+  unfold Rabs; case (Rcase_abs (-1)).
   intro; ring.
   intro H0; generalize (Rge_le (-1) 0 H0); intros.
   generalize (Ropp_le_ge_contravar 0 (-1) H1).
@@ -485,13 +483,13 @@ Qed.
 (*********)
 Lemma Rabs_triang : forall a b:R, Rabs (a + b) <= Rabs a + Rabs b.
 Proof.
-  intros a b; unfold Rabs in |- *; case (Rcase_abs (a + b)); case (Rcase_abs a);
+  intros a b; unfold Rabs; case (Rcase_abs (a + b)); case (Rcase_abs a);
     case (Rcase_abs b); intros.
   apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b);
     reflexivity.
 (**)
   rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b);
-    unfold Rle in |- *; unfold Rge in r; elim r; intro.
+    unfold Rle; unfold Rge in r; elim r; intro.
   left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro;
     elim (Rplus_ne (- b)); intros v w; rewrite v in H0;
       clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H).
@@ -499,7 +497,7 @@ Proof.
 (**)
   rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b));
     rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a);
-      unfold Rle in |- *; unfold Rge in r0; elim r0; intro.
+      unfold Rle; unfold Rge in r0; elim r0; intro.
   left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro;
     elim (Rplus_ne (- a)); intros v w; rewrite v in H0;
       clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H).
@@ -523,27 +521,27 @@ Proof.
 (**)
   rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b);
     apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a));
-      unfold Rminus in |- *; rewrite (Ropp_involutive a);
+      unfold Rminus; rewrite (Ropp_involutive a);
         generalize (Rplus_lt_compat_l a a 0 r0); clear r r1;
           intro; elim (Rplus_ne a); intros v w; rewrite v in H;
             clear v w; generalize (Rlt_trans (a + a) a 0 H r0);
               intro; apply (Rlt_le (a + a) 0 H0).
 (**)
   apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b));
-    unfold Rminus in |- *; rewrite (Ropp_involutive b);
+    unfold Rminus; rewrite (Ropp_involutive b);
       generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1;
         intro; elim (Rplus_ne b); intros v w; rewrite v in H;
           clear v w; generalize (Rlt_trans (b + b) b 0 H r);
             intro; apply (Rlt_le (b + b) 0 H0).
 (**)
-  unfold Rle in |- *; right; reflexivity.
+  unfold Rle; right; reflexivity.
 Qed.
 
 (*********)
 Lemma Rabs_triang_inv : forall a b:R, Rabs a - Rabs b <= Rabs (a - b).
 Proof.
   intros; apply (Rplus_le_reg_l (Rabs b) (Rabs a - Rabs b) (Rabs (a - b)));
-    unfold Rminus in |- *; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b));
+    unfold Rminus; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b));
       rewrite (Rplus_comm (Rabs b) (Rabs a));
         rewrite (Rplus_assoc (Rabs a) (Rabs b) (- Rabs b));
           rewrite (Rplus_opp_r (Rabs b)); rewrite (proj1 (Rplus_ne (Rabs a)));
@@ -563,7 +561,7 @@ Proof.
   rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b));
     do 2 rewrite Ropp_minus_distr.
   apply H; left; assumption.
-  rewrite Heq; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  rewrite Heq; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     apply Rabs_pos.
   apply H; left; assumption.
   intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b).
@@ -578,8 +576,8 @@ Qed.
 (*********)
 Lemma Rabs_def1 : forall x a:R, x < a -> - a < x -> Rabs x < a.
 Proof.
-  unfold Rabs in |- *; intros; case (Rcase_abs x); intro.
-  generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt in |- *;
+  unfold Rabs; intros; case (Rcase_abs x); intro.
+  generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt;
     rewrite Ropp_involutive; intro; assumption.
   assumption.
 Qed.
@@ -587,15 +585,15 @@ Qed.
 (*********)
 Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x.
 Proof.
-  unfold Rabs in |- *; intro x; case (Rcase_abs x); intros.
-  generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro;
+  unfold Rabs; intro x; case (Rcase_abs x); intros.
+  generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt; intro;
     generalize (Rlt_trans 0 (- x) a H0 H); intro; split.
   apply (Rlt_trans x 0 a r H1).
   generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x);
-    unfold Rgt in |- *; trivial.
+    unfold Rgt; trivial.
   fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro;
-    generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a) in |- *;
-      generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *;
+    generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a);
+      generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt;
         intro; split; assumption.
 Qed.
 
@@ -625,16 +623,16 @@ Proof.
   apply RmaxLess1; auto.
 Qed.
 
-Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Zabs z).
+Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Z.abs z).
 Proof.
-  intros z; case z; simpl in |- *; auto with real.
+  intros z; case z; simpl; auto with real.
   apply Rabs_right; auto with real.
   intros p0; apply Rabs_right; auto with real zarith.
   intros p0; rewrite Rabs_Ropp.
   apply Rabs_right; auto with real zarith.
 Qed.
 
-Lemma abs_IZR : forall z, IZR (Zabs z) = Rabs (IZR z).
+Lemma abs_IZR : forall z, IZR (Z.abs z) = Rabs (IZR z).
 Proof.
   intros.
   now rewrite Rabs_Zabs.
diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v
index f6d40631..8e0e0692 100644
--- a/theories/Reals/Rcomplete.v
+++ b/theories/Reals/Rcomplete.v
@@ -1,19 +1,17 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rcomplete.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rseries.
 Require Import SeqProp.
 Require Import Max.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (****************************************************)
 (*              R is complete :                     *)
@@ -39,7 +37,7 @@ Proof.
   intros.
   exists x.
   rewrite <- H2 in p0.
-  unfold Un_cv in |- *.
+  unfold Un_cv.
   intros.
   unfold Un_cv in p; unfold Un_cv in p0.
   cut (0 < eps / 3).
@@ -48,7 +46,7 @@ Proof.
   elim (p0 (eps / 3) H4); intros.
   exists (max x1 x2).
   intros.
-  unfold R_dist in |- *.
+  unfold R_dist.
   apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)).
   replace (Un n - x) with (Un n - Vn n + (Vn n - x));
   [ apply Rabs_triang | ring ].
@@ -56,14 +54,14 @@ Proof.
   do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))).
   apply Rplus_le_compat_l.
   repeat rewrite Rabs_right.
-  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- Vn n));
+  unfold Rminus; do 2 rewrite <- (Rplus_comm (- Vn n));
     apply Rplus_le_compat_l.
   assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
   fold Vn Wn in H8.
   elim (H8 n); intros.
   assumption.
   apply Rle_ge.
-  unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n).
+  unfold Rminus; apply Rplus_le_reg_l with (Vn n).
   rewrite Rplus_0_r.
   replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ].
   assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
@@ -71,7 +69,7 @@ Proof.
   elim (H8 n); intros.
   apply Rle_trans with (Un n); assumption.
   apply Rle_ge.
-  unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n).
+  unfold Rminus; apply Rplus_le_reg_l with (Vn n).
   rewrite Rplus_0_r.
   replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ].
   assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
@@ -87,26 +85,26 @@ Proof.
   repeat apply Rplus_lt_compat.
   unfold R_dist in H5.
   apply H5.
-  unfold ge in |- *; apply le_trans with (max x1 x2).
+  unfold ge; apply le_trans with (max x1 x2).
   apply le_max_l.
   assumption.
   rewrite <- Rabs_Ropp.
   replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ].
   unfold R_dist in H6.
   apply H6.
-  unfold ge in |- *; apply le_trans with (max x1 x2).
+  unfold ge; apply le_trans with (max x1 x2).
   apply le_max_r.
   assumption.
   unfold R_dist in H6.
   apply H6.
-  unfold ge in |- *; apply le_trans with (max x1 x2).
+  unfold ge; apply le_trans with (max x1 x2).
   apply le_max_r.
   assumption.
   right.
-  pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)).
+  pattern eps at 4; replace eps with (3 * (eps / 3)).
   ring.
-  unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR.
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   apply cond_eq.
   intros.
@@ -132,10 +130,10 @@ Proof.
   repeat apply Rplus_lt_compat.
   rewrite <- Rabs_Ropp.
   replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ].
-  unfold ge, N in |- *.
+  unfold ge, N.
   apply le_trans with (max N1 N2); apply le_max_l.
-  unfold Wn, Vn in |- *.
-  unfold sequence_majorant, sequence_minorant in |- *.
+  unfold Wn, Vn.
+  unfold sequence_majorant, sequence_minorant.
   assert
     (H7 :=
       approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))).
@@ -171,13 +169,13 @@ Proof.
   [ repeat apply Rplus_lt_compat | ring ].
   assumption.
   apply H6.
-  unfold ge in |- *.
+  unfold ge.
   apply le_trans with N.
-  unfold N in |- *; apply le_max_r.
+  unfold N; apply le_max_r.
   apply le_plus_l.
-  unfold ge in |- *.
+  unfold ge.
   apply le_trans with N.
-  unfold N in |- *; apply le_max_r.
+  unfold N; apply le_max_r.
   apply le_plus_l.
   rewrite <- Rabs_Ropp.
   replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat);
@@ -185,14 +183,14 @@ Proof.
   reflexivity.
   reflexivity.
   apply H5.
-  unfold ge in |- *; apply le_trans with (max N1 N2).
+  unfold ge; apply le_trans with (max N1 N2).
   apply le_max_r.
-  unfold N in |- *; apply le_max_l.
-  pattern eps at 4 in |- *; replace eps with (5 * (eps / 5)).
+  unfold N; apply le_max_l.
+  pattern eps at 4; replace eps with (5 * (eps / 5)).
   ring.
-  unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+  unfold Rdiv; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
   discrR.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   assumption.
   apply Rinv_0_lt_compat.
   prove_sup0; try apply lt_O_Sn.
diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v
index d06e2d1b..f7d03ed8 100644
--- a/theories/Reals/Rdefinitions.v
+++ b/theories/Reals/Rdefinitions.v
@@ -1,12 +1,10 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Rdefinitions.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 
 (*********************************************************)
 (**          Definitions for the axiomatization          *)
@@ -23,7 +21,7 @@ Delimit Scope R_scope with R.
 (* Automatically open scope R_scope for arguments of type R *)
 Bind Scope R_scope with R.
 
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Parameter R0 : R.
 Parameter R1 : R.
diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v
index 701914ac..e714f5f8 100644
--- a/theories/Reals/Rderiv.v
+++ b/theories/Reals/Rderiv.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rderiv.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (*********************************************************)
 (**     Definition of the derivative,continuity          *)
 (*                                                       *)
@@ -17,10 +15,8 @@ Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rlimit.
 Require Import Fourier.
-Require Import Classical_Prop.
-Require Import Classical_Pred_Type.
 Require Import Omega.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (*********)
 Definition D_x (D:R -> Prop) (y x:R) : Prop := D x /\ y <> x.
@@ -38,18 +34,18 @@ Lemma cont_deriv :
   forall (f d:R -> R) (D:R -> Prop) (x0:R),
     D_in f d D x0 -> continue_in f D x0.
 Proof.
-  unfold continue_in in |- *; unfold D_in in |- *; unfold limit1_in in |- *;
-    unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *;
+  unfold continue_in; unfold D_in; unfold limit1_in;
+    unfold limit_in; unfold Rdiv; simpl;
       intros; elim (H eps H0); clear H; intros; elim H;
         clear H; intros; elim (Req_dec (d x0) 0); intro.
   split with (Rmin 1 x); split.
   elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)).
   intros; elim H3; clear H3; intros;
     generalize (let (H1, H2) := Rmin_Rgt 1 x (R_dist x1 x0) in H1);
-      unfold Rgt in |- *; intro; elim (H5 H4); clear H5;
+      unfold Rgt; intro; elim (H5 H4); clear H5;
         intros; generalize (H1 x1 (conj H3 H6)); clear H1;
           intro; unfold D_x in H3; elim H3; intros.
-  rewrite H2 in H1; unfold R_dist in |- *; unfold R_dist in H1;
+  rewrite H2 in H1; unfold R_dist; unfold R_dist in H1;
     cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)).
   intro; unfold R_dist in H5;
     generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) 1 H0 H5);
@@ -72,7 +68,7 @@ Proof.
   intros; elim (Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) 0);
     intros a b; apply (b (conj H4 H3)).
   apply Rmult_gt_0_compat; auto.
-  unfold Rgt in |- *; apply Rinv_0_lt_compat; apply Rabs_pos_lt;
+  unfold Rgt; apply Rinv_0_lt_compat; apply Rabs_pos_lt;
     apply Rmult_integral_contrapositive; split.
   discrR.
   assumption.
@@ -84,17 +80,17 @@ Proof.
     generalize
       (let (H1, H2) :=
         Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (R_dist x1 x0) in
-        H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5;
+        H1); unfold Rgt; intro; elim (H5 H4); clear H5;
       intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (R_dist x1 x0) in H1);
-        unfold Rgt in |- *; intro; elim (H7 H5); clear H7;
+        unfold Rgt; intro; elim (H7 H5); clear H7;
           intros; clear H4 H5; generalize (H1 x1 (conj H3 H8));
             clear H1; intro; unfold D_x in H3; elim H3; intros;
-              generalize (sym_not_eq H5); clear H5; intro H5;
+              generalize (not_eq_sym H5); clear H5; intro H5;
                 generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1;
-                  pattern (d x0) at 1 in |- *;
+                  pattern (d x0) at 1;
                     rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2);
-                      rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist in |- *;
-                        unfold Rminus at 1 in |- *; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0)));
+                      rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist;
+                        unfold Rminus at 1; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0)));
                           rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0));
                             rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0)));
                               rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0)));
@@ -117,7 +113,7 @@ Proof.
                                                   ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0));
                                                     intro; rewrite (Rmult_comm (x1 - x0) (- d x0));
                                                       rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0));
-                                                        fold (f x1 - f x0 - d x0 * (x1 - x0)) in |- *;
+                                                        fold (f x1 - f x0 - d x0 * (x1 - x0));
                                                           rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1;
                                                             intro;
                                                               generalize
@@ -127,7 +123,7 @@ Proof.
                                                                   generalize
                                                                     (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0)))
                                                                       (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) (
-                                                                        Rabs (x1 - x0) * eps) H1); unfold Rminus at 2 in |- *;
+                                                                        Rabs (x1 - x0) * eps) H1); unfold Rminus at 2;
                                                                     rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0))));
                                                                       rewrite <-
                                                                         (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0)))
@@ -166,27 +162,26 @@ Proof.
       (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2)
         (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro;
       rewrite eps2 in H10; assumption.
-  unfold Rabs in |- *; case (Rcase_abs 2); auto.
+  unfold Rabs; case (Rcase_abs 2); auto.
   intro; cut (0 < 2).
-  intro; generalize (Rlt_asym 0 2 H7); intro; exfalso; auto.
+  intro ; elim (Rlt_asym 0 2 H7 r).
   fourier.
   apply Rabs_no_R0.
   discrR.
 Qed.
 
-
 (*********)
 Lemma Dconst :
   forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0.
 Proof.
-  unfold D_in in |- *; intros; unfold limit1_in in |- *;
-    unfold limit_in in |- *; unfold Rdiv in |- *; intros;
-      simpl in |- *; split with eps; split; auto.
-  intros; rewrite (Rminus_diag_eq y y (refl_equal y)); rewrite Rmult_0_l;
-    unfold R_dist in |- *; rewrite (Rminus_diag_eq 0 0 (refl_equal 0));
-      unfold Rabs in |- *; case (Rcase_abs 0); intro.
+  unfold D_in; intros; unfold limit1_in;
+    unfold limit_in; unfold Rdiv; intros;
+      simpl; split with eps; split; auto.
+  intros; rewrite (Rminus_diag_eq y y (eq_refl y)); rewrite Rmult_0_l;
+    unfold R_dist; rewrite (Rminus_diag_eq 0 0 (eq_refl 0));
+      unfold Rabs; case (Rcase_abs 0); intro.
   absurd (0 < 0); auto.
-  red in |- *; intro; apply (Rlt_irrefl 0 H1).
+  red; intro; apply (Rlt_irrefl 0 H1).
   unfold Rgt in H0; assumption.
 Qed.
 
@@ -194,15 +189,15 @@ Qed.
 Lemma Dx :
   forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0.
 Proof.
-  unfold D_in in |- *; unfold Rdiv in |- *; intros; unfold limit1_in in |- *;
-    unfold limit_in in |- *; intros; simpl in |- *; split with eps;
+  unfold D_in; unfold Rdiv; intros; unfold limit1_in;
+    unfold limit_in; intros; simpl; split with eps;
       split; auto.
   intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros;
-    rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3)));
-      unfold R_dist in |- *; rewrite (Rminus_diag_eq 1 1 (refl_equal 1));
-        unfold Rabs in |- *; case (Rcase_abs 0); intro.
+    rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (not_eq_sym H3)));
+      unfold R_dist; rewrite (Rminus_diag_eq 1 1 (eq_refl 1));
+        unfold Rabs; case (Rcase_abs 0); intro.
   absurd (0 < 0); auto.
-  red in |- *; intro; apply (Rlt_irrefl 0 r).
+  red; intro; apply (Rlt_irrefl 0 r).
   unfold Rgt in H; assumption.
 Qed.
 
@@ -213,12 +208,12 @@ Lemma Dadd :
     D_in g dg D x0 ->
     D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0.
 Proof.
-  unfold D_in in |- *; intros;
+  unfold D_in; intros;
     generalize
       (limit_plus (fun x:R => (f x - f x0) * / (x - x0))
         (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) (
-          df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in in |- *;
-      unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0);
+          df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in;
+      unfold limit_in; simpl; intros; elim (H eps H0);
         clear H; intros; elim H; clear H; intros; split with x;
           split; auto; intros; generalize (H1 x1 H2); clear H1;
             intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
@@ -238,8 +233,8 @@ Lemma Dmult :
     D_in g dg D x0 ->
     D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0.
 Proof.
-  intros; unfold D_in in |- *; generalize H H0; intros; unfold D_in in H, H0;
-    generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *;
+  intros; unfold D_in; generalize H H0; intros; unfold D_in in H, H0;
+    generalize (cont_deriv f df D x0 H1); unfold continue_in;
       intro;
         generalize
           (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) (
@@ -255,8 +250,8 @@ Proof.
             (fun x:R => (g x - g x0) * / (x - x0) * f x) (
               D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4);
           clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H;
-            simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *;
-              simpl in |- *; intros; elim (H eps H0); clear H; intros;
+            simpl in H; unfold limit1_in; unfold limit_in;
+              simpl; intros; elim (H eps H0); clear H; intros;
                 elim H; clear H; intros; split with x; split; auto;
                   intros; generalize (H1 x1 H2); clear H1; intro;
                     rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
@@ -273,9 +268,9 @@ Proof.
                                     ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0).
   intro; rewrite H3 in H1; assumption.
   ring.
-  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+  unfold limit1_in; unfold limit_in; simpl; intros;
     split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0));
-      intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H;
+      intros a b; rewrite (b (eq_refl (g x0))); unfold Rgt in H;
         assumption.
 Qed.
 
@@ -286,7 +281,7 @@ Lemma Dmult_const :
 Proof.
   intros;
     generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H);
-      unfold D_in in |- *; intros; rewrite (Rmult_0_l (f x0)) in H0;
+      unfold D_in; intros; rewrite (Rmult_0_l (f x0)) in H0;
         rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0;
           assumption.
 Qed.
@@ -296,10 +291,10 @@ Lemma Dopp :
   forall (D:R -> Prop) (f df:R -> R) (x0:R),
     D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0.
 Proof.
-  intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
+  intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in;
+    unfold limit1_in; unfold limit_in;
       intros; generalize (H0 eps H1); clear H0; intro; elim H0;
-        clear H0; intros; elim H0; clear H0; simpl in |- *;
+        clear H0; intros; elim H0; clear H0; simpl;
           intros; split with x; split; auto.
   intros; generalize (H2 x1 H3); clear H2; intro;
     rewrite Ropp_mult_distr_l_reverse in H2;
@@ -318,7 +313,7 @@ Lemma Dminus :
     D_in g dg D x0 ->
     D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0.
 Proof.
-  unfold Rminus in |- *; intros; generalize (Dopp D g dg x0 H0); intro;
+  unfold Rminus; intros; generalize (Dopp D g dg x0 H0); intro;
     apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0);
       assumption.
 Qed.
@@ -329,14 +324,14 @@ Lemma Dx_pow_n :
     D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0.
 Proof.
   simple induction n; intros.
-  simpl in |- *; rewrite Rmult_0_l; apply Dconst.
+  simpl; rewrite Rmult_0_l; apply Dconst.
   intros; cut (n0 = (S n0 - 1)%nat);
-    [ intro a; rewrite <- a; clear a | simpl in |- *; apply minus_n_O ].
+    [ intro a; rewrite <- a; clear a | simpl; apply minus_n_O ].
   generalize
     (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) (
       fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) (
-        H D x0)); unfold D_in in |- *; unfold limit1_in in |- *;
-    unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1);
+        H D x0)); unfold D_in; unfold limit1_in;
+    unfold limit_in; simpl; intros; elim (H0 eps H1);
       clear H0; intros; elim H0; clear H0; intros; split with x;
         split; auto.
   intros; generalize (H2 x1 H3); clear H2 H3; intro;
@@ -344,9 +339,8 @@ Proof.
       rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2;
         rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2;
           rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2;
-            rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (classic (n0 = 0%nat));
-              intro cond.
-  rewrite cond in H2; rewrite cond; simpl in H2; simpl in |- *;
+            rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (Peano_dec.eq_nat_dec n0 0) ; intros cond.
+  rewrite cond in H2; rewrite cond; simpl in H2; simpl;
     cut (1 + x0 * 1 * 0 = 1 * 1);
       [ intro A; rewrite A in H2; assumption | ring ].
   cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | omega ];
@@ -361,8 +355,8 @@ Lemma Dcomp :
     D_in g dg Dg (f x0) ->
     D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0.
 Proof.
-  intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in in |- *;
-    unfold Rdiv in |- *; intros;
+  intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in;
+    unfold Rdiv; intros;
       generalize
         (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) (
           D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0);
@@ -382,8 +376,8 @@ Proof.
       (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) (
         fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1
       (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0));
-      intro; unfold limit1_in in |- *; unfold limit_in in |- *;
-        simpl in |- *; unfold limit1_in in H5, H7; unfold limit_in in H5, H7;
+      intro; unfold limit1_in; unfold limit_in;
+        simpl; unfold limit1_in in H5, H7; unfold limit_in in H5, H7;
           simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8);
             clear H5 H7; intros; elim H5; elim H7; clear H5 H7;
               intros; split with (Rmin x x1); split.
@@ -391,13 +385,13 @@ Proof.
   intros; elim H11; clear H11; intros; elim (Rmin_Rgt x x1 (R_dist x2 x0));
     intros a b; clear b; unfold Rgt in a; elim (a H12);
       clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10;
-        clear H12; elim (classic (f x2 = f x0)); intro.
+        clear H12; elim (Req_dec (f x2) (f x0)); intro.
   elim H11; clear H11; intros; elim H11; clear H11; intros;
     generalize (H10 x2 (conj (conj H11 H14) H5)); intro;
       rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16;
         rewrite (Rmult_0_l (/ (x2 - x0))) in H16;
           rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12;
-            rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (refl_equal (g (f x0))));
+            rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (eq_refl (g (f x0))));
               rewrite (Rmult_0_l (/ (x2 - x0))); assumption.
   clear H10 H5; elim H11; clear H11; intros; elim H5; clear H5; intros;
     cut
@@ -411,8 +405,8 @@ Proof.
               in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15;
                 rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15;
                   rewrite (Rmult_comm (df x0) (dg (f x0))); assumption.
-  clear H5 H3 H4 H2; unfold limit1_in in |- *; unfold limit_in in |- *;
-    simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1;
+  clear H5 H3 H4 H2; unfold limit1_in; unfold limit_in;
+    simpl; unfold limit1_in in H1; unfold limit_in in H1;
       simpl in H1; intros; elim (H1 eps H2); clear H1; intros;
         elim H1; clear H1; intros; split with x; split; auto;
           intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4;
@@ -431,8 +425,8 @@ Proof.
     generalize
       (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr (
         fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0)));
-      intro; unfold D_in in |- *; unfold limit1_in in |- *;
-        unfold limit_in in |- *; simpl in |- *; intros; unfold D_in in H0;
+      intro; unfold D_in; unfold limit1_in;
+        unfold limit_in; simpl; intros; unfold D_in in H0;
           unfold limit1_in in H0; unfold limit_in in H0; simpl in H0;
             elim (H0 eps H1); clear H0; intros; elim H0; clear H0;
               intros; split with x; split; intros; auto.
diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v
index 9929733f..03bf534d 100644
--- a/theories/Reals/Reals.v
+++ b/theories/Reals/Reals.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Reals.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** The library REALS is divided in 6 parts :
    - Rbase: basic lemmas on R
             equalities and inequalities
@@ -29,4 +27,4 @@ Require Export Rfunctions.
 Require Export SeqSeries.
 Require Export Rtrigo.
 Require Export Ranalysis.
-Require Export Integration.
\ No newline at end of file
+Require Export Integration.
diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v
index a91cf8ae..4724d0e5 100644
--- a/theories/Reals/Rfunctions.v
+++ b/theories/Reals/Rfunctions.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rfunctions.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (*i Some properties about pow and sum have been made with John Harrison i*)
 (*i Some Lemmas (about pow and powerRZ) have been done by Laurent Thery i*)
 
@@ -27,8 +25,8 @@ Require Export SplitRmult.
 Require Export ArithProp.
 Require Import Omega.
 Require Import Zpower.
-Open Local Scope nat_scope.
-Open Local Scope R_scope.
+Local Open Scope nat_scope.
+Local Open Scope R_scope.
 
 (*******************************)
 (** * Lemmas about factorial   *)
@@ -36,7 +34,7 @@ Open Local Scope R_scope.
 (*********)
 Lemma INR_fact_neq_0 : forall n:nat, INR (fact n) <> 0.
 Proof.
-  intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n));
+  intro; red; intro; apply (not_O_INR (fact n) (fact_neq_0 n));
     assumption.
 Qed.
 
@@ -51,7 +49,7 @@ Lemma simpl_fact :
   forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n).
 Proof.
   intro; rewrite (Rinv_involutive (INR (fact n)) (INR_fact_neq_0 n));
-    unfold fact at 1 in |- *; cbv beta iota in |- *; fold fact in |- *;
+    unfold fact at 1; cbv beta iota; fold fact;
       rewrite (mult_INR (S n) (fact n));
         rewrite (Rinv_mult_distr (INR (S n)) (INR (fact n))).
   rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n)));
@@ -75,20 +73,29 @@ Qed.
 
 Lemma pow_1 : forall x:R, x ^ 1 = x.
 Proof.
-  simpl in |- *; auto with real.
+  simpl; auto with real.
 Qed.
 
 Lemma pow_add : forall (x:R) (n m:nat), x ^ (n + m) = x ^ n * x ^ m.
 Proof.
-  intros x n; elim n; simpl in |- *; auto with real.
+  intros x n; elim n; simpl; auto with real.
   intros n0 H' m; rewrite H'; auto with real.
 Qed.
 
+Lemma Rpow_mult_distr : forall (x y:R) (n:nat), (x * y) ^ n = x^n * y^n.
+Proof.
+intros x y n ; induction n.
+ field.
+ simpl.
+ repeat (rewrite Rmult_assoc) ; apply Rmult_eq_compat_l.
+ rewrite IHn ; field.
+Qed.
+
 Lemma pow_nonzero : forall (x:R) (n:nat), x <> 0 -> x ^ n <> 0.
 Proof.
-  intro; simple induction n; simpl in |- *.
-  intro; red in |- *; intro; apply R1_neq_R0; assumption.
-  intros; red in |- *; intro; elim (Rmult_integral x (x ^ n0) H1).
+  intro; simple induction n; simpl.
+  intro; red; intro; apply R1_neq_R0; assumption.
+  intros; red; intro; elim (Rmult_integral x (x ^ n0) H1).
   intro; auto.
   apply H; assumption.
 Qed.
@@ -98,24 +105,24 @@ Hint Resolve pow_O pow_1 pow_add pow_nonzero: real.
 Lemma pow_RN_plus :
   forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m.
 Proof.
-  intros x n; elim n; simpl in |- *; auto with real.
+  intros x n; elim n; simpl; auto with real.
   intros n0 H' m H'0.
   rewrite Rmult_assoc; rewrite <- H'; auto.
 Qed.
 
 Lemma pow_lt : forall (x:R) (n:nat), 0 < x -> 0 < x ^ n.
 Proof.
-  intros x n; elim n; simpl in |- *; auto with real.
+  intros x n; elim n; simpl; auto with real.
   intros n0 H' H'0; replace 0 with (x * 0); auto with real.
 Qed.
 Hint Resolve pow_lt: real.
 
 Lemma Rlt_pow_R1 : forall (x:R) (n:nat), 1 < x -> (0 < n)%nat -> 1 < x ^ n.
 Proof.
-  intros x n; elim n; simpl in |- *; auto with real.
+  intros x n; elim n; simpl; auto with real.
   intros H' H'0; exfalso; omega.
   intros n0; case n0.
-  simpl in |- *; rewrite Rmult_1_r; auto.
+  simpl; rewrite Rmult_1_r; auto.
   intros n1 H' H'0 H'1.
   replace 1 with (1 * 1); auto with real.
   apply Rlt_trans with (r2 := x * 1); auto with real.
@@ -129,7 +136,7 @@ Lemma Rlt_pow : forall (x:R) (n m:nat), 1 < x -> (n < m)%nat -> x ^ n < x ^ m.
 Proof.
   intros x n m H' H'0; replace m with (m - n + n)%nat.
   rewrite pow_add.
-  pattern (x ^ n) at 1 in |- *; replace (x ^ n) with (1 * x ^ n);
+  pattern (x ^ n) at 1; replace (x ^ n) with (1 * x ^ n);
     auto with real.
   apply Rminus_lt.
   repeat rewrite (fun y:R => Rmult_comm y (x ^ n));
@@ -149,14 +156,14 @@ Hint Resolve Rlt_pow: real.
 (*********)
 Lemma tech_pow_Rmult : forall (x:R) (n:nat), x * x ^ n = x ^ S n.
 Proof.
-  simple induction n; simpl in |- *; trivial.
+  simple induction n; simpl; trivial.
 Qed.
 
 (*********)
 Lemma tech_pow_Rplus :
   forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a.
 Proof.
-  intros; pattern (x ^ a) at 1 in |- *;
+  intros; pattern (x ^ a) at 1;
     rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1);
       rewrite (Rmult_comm (INR n) (x ^ a));
         rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n));
@@ -167,29 +174,29 @@ Qed.
 Lemma poly : forall (n:nat) (x:R), 0 < x -> 1 + INR n * x <= (1 + x) ^ n.
 Proof.
   intros; elim n.
-  simpl in |- *; cut (1 + 0 * x = 1).
-  intro; rewrite H0; unfold Rle in |- *; right; reflexivity.
+  simpl; cut (1 + 0 * x = 1).
+  intro; rewrite H0; unfold Rle; right; reflexivity.
   ring.
-  intros; unfold pow in |- *; fold pow in |- *;
+  intros; unfold pow; fold pow;
     apply
       (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x))
         ((1 + x) * (1 + x) ^ n0)).
   cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)).
-  intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1 in |- *;
+  intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1;
     rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1);
       apply Rplus_le_compat_l; elim n0; intros.
-  simpl in |- *; rewrite Rmult_0_l; unfold Rle in |- *; right; auto.
-  unfold Rle in |- *; left; generalize Rmult_gt_0_compat; unfold Rgt in |- *;
-    intro; fold (Rsqr x) in |- *;
+  simpl; rewrite Rmult_0_l; unfold Rle; right; auto.
+  unfold Rle; left; generalize Rmult_gt_0_compat; unfold Rgt;
+    intro; fold (Rsqr x);
       apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (lt_O_Sn n1)));
         fold (x > 0) in H;
           apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))).
   rewrite (S_INR n0); ring.
   unfold Rle in H0; elim H0; intro.
-  unfold Rle in |- *; left; apply Rmult_lt_compat_l.
+  unfold Rle; left; apply Rmult_lt_compat_l.
   rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)).
   assumption.
-  rewrite H1; unfold Rle in |- *; right; trivial.
+  rewrite H1; unfold Rle; right; trivial.
 Qed.
 
 Lemma Power_monotonic :
@@ -197,12 +204,12 @@ Lemma Power_monotonic :
     Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n).
 Proof.
   intros x m n H; induction  n as [| n Hrecn]; intros; inversion H0.
-  unfold Rle in |- *; right; reflexivity.
-  unfold Rle in |- *; right; reflexivity.
+  unfold Rle; right; reflexivity.
+  unfold Rle; right; reflexivity.
   apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))).
   apply Hrecn; assumption.
-  simpl in |- *; rewrite Rabs_mult.
-  pattern (Rabs (x ^ n)) at 1 in |- *.
+  simpl; rewrite Rabs_mult.
+  pattern (Rabs (x ^ n)) at 1.
   rewrite <- Rmult_1_r.
   rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))).
   apply Rmult_le_compat_l.
@@ -213,9 +220,9 @@ Qed.
 
 Lemma RPow_abs : forall (x:R) (n:nat), Rabs x ^ n = Rabs (x ^ n).
 Proof.
-  intro; simple induction n; simpl in |- *.
-  apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1.
-  intros; rewrite H; apply sym_eq; apply Rabs_mult.
+  intro; simple induction n; simpl.
+  symmetry; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1.
+  intros; rewrite H; symmetry; apply Rabs_mult.
 Qed.
 
 
@@ -233,16 +240,16 @@ Proof.
   rewrite <- RPow_abs; cut (Rabs x = 1 + (Rabs x - 1)).
   intro; rewrite H3;
     apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b).
-  apply Rle_ge; apply poly; fold (Rabs x - 1 > 0) in |- *; apply Rgt_minus;
+  apply Rle_ge; apply poly; fold (Rabs x - 1 > 0); apply Rgt_minus;
     assumption.
   apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b).
   apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1)));
-    pattern (INR x0 * (Rabs x - 1)) at 1 in |- *;
+    pattern (INR x0 * (Rabs x - 1)) at 1;
       rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1);
         apply Rplus_lt_compat_l; apply Rlt_0_1.
   cut (b = b * / (Rabs x - 1) * (Rabs x - 1)).
   intros; rewrite H4; apply Rmult_ge_compat_r.
-  apply Rge_minus; unfold Rge in |- *; left; assumption.
+  apply Rge_minus; unfold Rge; left; assumption.
   assumption.
   rewrite Rmult_assoc; rewrite Rinv_l.
   ring.
@@ -254,26 +261,26 @@ Proof.
     apply
       (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
   rewrite INR_IZR_INZ; apply IZR_ge; omega.
-  unfold Rge in |- *; left; assumption.
+  unfold Rge; left; assumption.
   exists 0%nat;
     apply
       (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
-  rewrite INR_IZR_INZ; apply IZR_ge; simpl in |- *; omega.
-  unfold Rge in |- *; left; assumption.
+  rewrite INR_IZR_INZ; apply IZR_ge; simpl; omega.
+  unfold Rge; left; assumption.
   omega.
 Qed.
 
 Lemma pow_ne_zero : forall n:nat, n <> 0%nat -> 0 ^ n = 0.
 Proof.
   simple induction n.
-  simpl in |- *; auto.
+  simpl; auto.
   intros; elim H; reflexivity.
-  intros; simpl in |- *; apply Rmult_0_l.
+  intros; simpl; apply Rmult_0_l.
 Qed.
 
 Lemma Rinv_pow : forall (x:R) (n:nat), x <> 0 -> / x ^ n = (/ x) ^ n.
 Proof.
-  intros; elim n; simpl in |- *.
+  intros; elim n; simpl.
   apply Rinv_1.
   intro m; intro; rewrite Rinv_mult_distr.
   rewrite H0; reflexivity; assumption.
@@ -307,7 +314,7 @@ Proof.
   rewrite <- Rabs_Rinv.
   rewrite Rinv_pow.
   apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))).
-  pattern (/ y) at 1 in |- *.
+  pattern (/ y) at 1.
   rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1).
   apply Rplus_lt_compat_l.
   apply Rlt_0_1.
@@ -321,17 +328,17 @@ Proof.
   apply pow_nonzero.
   assumption.
   apply Rlt_dichotomy_converse.
-  right; unfold Rgt in |- *; assumption.
+  right; unfold Rgt; assumption.
   rewrite <- (Rinv_involutive 1).
   rewrite Rabs_Rinv.
-  unfold Rgt in |- *; apply Rinv_lt_contravar.
+  unfold Rgt; apply Rinv_lt_contravar.
   apply Rmult_lt_0_compat.
   apply Rabs_pos_lt.
   assumption.
   rewrite Rinv_1; apply Rlt_0_1.
   rewrite Rinv_1; assumption.
   assumption.
-  red in |- *; intro; apply R1_neq_R0; assumption.
+  red; intro; apply R1_neq_R0; assumption.
 Qed.
 
 Lemma pow_R1 : forall (r:R) (n:nat), r ^ n = 1 -> Rabs r = 1 \/ n = 0%nat.
@@ -345,7 +352,7 @@ Proof.
   cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
   absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto.
   replace (Rabs (/ r) ^ S n0) with 1.
-  simpl in |- *; apply Rlt_irrefl; auto.
+  simpl; apply Rlt_irrefl; auto.
   rewrite Rabs_Rinv; auto.
   rewrite <- Rinv_pow; auto.
   rewrite RPow_abs; auto.
@@ -356,16 +363,16 @@ Proof.
   case (Rabs_pos r); auto.
   intros H'3; case Eq2; auto.
   rewrite Rmult_1_r; rewrite Rinv_r; auto with real.
-  red in |- *; intro; absurd (r ^ S n0 = 1); auto.
-  simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
+  red; intro; absurd (r ^ S n0 = 1); auto.
+  simpl; rewrite H; rewrite Rmult_0_l; auto with real.
   generalize H'; case n; auto.
   intros n0 H'0.
   cut (r <> 0); [ intros Eq1 | auto with real ].
   cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
   absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith.
-  repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real.
-  red in |- *; intro; absurd (r ^ S n0 = 1); auto.
-  simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
+  repeat rewrite RPow_abs; rewrite H'0; simpl; auto with real.
+  red; intro; absurd (r ^ S n0 = 1); auto.
+  simpl; rewrite H; rewrite Rmult_0_l; auto with real.
 Qed.
 
 Lemma pow_Rsqr : forall (x:R) (n:nat), x ^ (2 * n) = Rsqr x ^ n.
@@ -375,15 +382,15 @@ Proof.
   replace (2 * S n)%nat with (S (S (2 * n))).
   replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)).
   rewrite Hrecn; reflexivity.
-  simpl in |- *; ring.
+  simpl; ring.
   ring.
 Qed.
 
 Lemma pow_le : forall (a:R) (n:nat), 0 <= a -> 0 <= a ^ n.
 Proof.
   intros; induction  n as [| n Hrecn].
-  simpl in |- *; left; apply Rlt_0_1.
-  simpl in |- *; apply Rmult_le_pos; assumption.
+  simpl; left; apply Rlt_0_1.
+  simpl; apply Rmult_le_pos; assumption.
 Qed.
 
 (**********)
@@ -392,36 +399,36 @@ Proof.
   intro; induction  n as [| n Hrecn].
   reflexivity.
   replace (2 * S n)%nat with (2 + 2 * n)%nat by ring.
-  rewrite pow_add; rewrite Hrecn; simpl in |- *; ring.
+  rewrite pow_add; rewrite Hrecn; simpl; ring.
 Qed.
 
 (**********)
 Lemma pow_1_odd : forall n:nat, (-1) ^ S (2 * n) = -1.
 Proof.
   intro; replace (S (2 * n)) with (2 * n + 1)%nat by ring.
-  rewrite pow_add; rewrite pow_1_even; simpl in |- *; ring.
+  rewrite pow_add; rewrite pow_1_even; simpl; ring.
 Qed.
 
 (**********)
 Lemma pow_1_abs : forall n:nat, Rabs ((-1) ^ n) = 1.
 Proof.
   intro; induction  n as [| n Hrecn].
-  simpl in |- *; apply Rabs_R1.
+  simpl; apply Rabs_R1.
   replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ].
   rewrite Rabs_mult.
-  rewrite Hrecn; rewrite Rmult_1_l; simpl in |- *; rewrite Rmult_1_r;
+  rewrite Hrecn; rewrite Rmult_1_l; simpl; rewrite Rmult_1_r;
     rewrite Rabs_Ropp; apply Rabs_R1.
 Qed.
 
 Lemma pow_mult : forall (x:R) (n1 n2:nat), x ^ (n1 * n2) = (x ^ n1) ^ n2.
 Proof.
   intros; induction  n2 as [| n2 Hrecn2].
-  simpl in |- *; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ].
+  simpl; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ].
   replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat.
   replace (S n2) with (n2 + 1)%nat by ring.
   do 2 rewrite pow_add.
   rewrite Hrecn2.
-  simpl in |- *.
+  simpl.
   ring.
   ring.
 Qed.
@@ -431,7 +438,7 @@ Proof.
   intros.
   induction  n as [| n Hrecn].
   right; reflexivity.
-  simpl in |- *.
+  simpl.
   elim H; intros.
   apply Rle_trans with (y * x ^ n).
   do 2 rewrite <- (Rmult_comm (x ^ n)).
@@ -448,7 +455,7 @@ Proof.
   intros.
   induction  k as [| k Hreck].
   right; reflexivity.
-  simpl in |- *.
+  simpl.
   apply Rle_trans with (x * 1).
   rewrite Rmult_1_r; assumption.
   apply Rmult_le_compat_l.
@@ -463,33 +470,33 @@ Proof.
   replace n with (n - m + m)%nat.
   rewrite pow_add.
   rewrite Rmult_comm.
-  pattern (x ^ m) at 1 in |- *; rewrite <- Rmult_1_r.
+  pattern (x ^ m) at 1; rewrite <- Rmult_1_r.
   apply Rmult_le_compat_l.
   apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ].
   apply pow_R1_Rle; assumption.
   rewrite plus_comm.
-  symmetry  in |- *; apply le_plus_minus; assumption.
+  symmetry ; apply le_plus_minus; assumption.
 Qed.
 
 Lemma pow1 : forall n:nat, 1 ^ n = 1.
 Proof.
   intro; induction  n as [| n Hrecn].
   reflexivity.
-  simpl in |- *; rewrite Hrecn; rewrite Rmult_1_r; reflexivity.
+  simpl; rewrite Hrecn; rewrite Rmult_1_r; reflexivity.
 Qed.
 
 Lemma pow_Rabs : forall (x:R) (n:nat), x ^ n <= Rabs x ^ n.
 Proof.
   intros; induction  n as [| n Hrecn].
   right; reflexivity.
-  simpl in |- *; case (Rcase_abs x); intro.
+  simpl; case (Rcase_abs x); intro.
   apply Rle_trans with (Rabs (x * x ^ n)).
   apply RRle_abs.
   rewrite Rabs_mult.
   apply Rmult_le_compat_l.
   apply Rabs_pos.
-  right; symmetry  in |- *; apply RPow_abs.
-  pattern (Rabs x) at 1 in |- *; rewrite (Rabs_right x r);
+  right; symmetry ; apply RPow_abs.
+  pattern (Rabs x) at 1; rewrite (Rabs_right x r);
     apply Rmult_le_compat_l.
   apply Rge_le; exact r.
   apply Hrecn.
@@ -502,7 +509,7 @@ Proof.
   apply pow_Rabs.
   induction  n as [| n Hrecn].
   right; reflexivity.
-  simpl in |- *; apply Rle_trans with (x * Rabs y ^ n).
+  simpl; apply Rle_trans with (x * Rabs y ^ n).
   do 2 rewrite <- (Rmult_comm (Rabs y ^ n)).
   apply Rmult_le_compat_l.
   apply pow_le; apply Rabs_pos.
@@ -519,21 +526,21 @@ Qed.
 (*i Due to L.Thery i*)
 
 Ltac case_eq name :=
-  generalize (refl_equal name); pattern name at -1 in |- *; case name.
+  generalize (eq_refl name); pattern name at -1; case name.
 
 Definition powerRZ (x:R) (n:Z) :=
   match n with
     | Z0 => 1
-    | Zpos p => x ^ nat_of_P p
-    | Zneg p => / x ^ nat_of_P p
+    | Zpos p => x ^ Pos.to_nat p
+    | Zneg p => / x ^ Pos.to_nat p
   end.
 
-Infix Local "^Z" := powerRZ (at level 30, right associativity) : R_scope.
+Local Infix "^Z" := powerRZ (at level 30, right associativity) : R_scope.
 
 Lemma Zpower_NR0 :
   forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z.
 Proof.
-  induction n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith.
+  induction n; unfold Zpower_nat; simpl; auto with zarith.
 Qed.
 
 Lemma powerRZ_O : forall x:R, x ^Z 0 = 1.
@@ -541,90 +548,73 @@ Proof.
   reflexivity.
 Qed.
 
-Lemma powerRZ_1 : forall x:R, x ^Z Zsucc 0 = x.
+Lemma powerRZ_1 : forall x:R, x ^Z Z.succ 0 = x.
 Proof.
-  simpl in |- *; auto with real.
+  simpl; auto with real.
 Qed.
 
 Lemma powerRZ_NOR : forall (x:R) (z:Z), x <> 0 -> x ^Z z <> 0.
 Proof.
-  destruct z; simpl in |- *; auto with real.
+  destruct z; simpl; auto with real.
+Qed.
+
+Lemma powerRZ_pos_sub (x:R) (n m:positive) : x <> 0 ->
+   x ^Z (Z.pos_sub n m) = x ^ Pos.to_nat n * / x ^ Pos.to_nat m.
+Proof.
+ intro Hx.
+ rewrite Z.pos_sub_spec.
+ case Pos.compare_spec; intro H; simpl.
+ - subst; auto with real.
+ - rewrite Pos2Nat.inj_sub by trivial.
+   rewrite Pos2Nat.inj_lt in H.
+   rewrite (pow_RN_plus x _ (Pos.to_nat n)) by auto with real.
+   rewrite plus_comm, le_plus_minus_r by auto with real.
+   rewrite Rinv_mult_distr, Rinv_involutive; auto with real.
+ - rewrite Pos2Nat.inj_sub by trivial.
+   rewrite Pos2Nat.inj_lt in H.
+   rewrite (pow_RN_plus x _ (Pos.to_nat m)) by auto with real.
+   rewrite plus_comm, le_plus_minus_r by auto with real.
+   reflexivity.
 Qed.
 
 Lemma powerRZ_add :
   forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m.
 Proof.
-  intro x; destruct n as [| n1| n1]; destruct m as [| m1| m1]; simpl in |- *;
-    auto with real.
-(* POS/POS *)
-  rewrite nat_of_P_plus_morphism; auto with real.
-(* POS/NEG *)
-  case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
-  intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
-  intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
-  rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
-    auto with real.
-  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
-  rewrite Rinv_mult_distr; auto with real.
-  rewrite Rinv_involutive; auto with real.
-  apply lt_le_weak.
-  apply nat_of_P_lt_Lt_compare_morphism; auto.
-  apply ZC2; auto.
-  intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
-  rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
-    auto with real.
-  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
-  apply lt_le_weak.
-  change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
-  apply nat_of_P_gt_Gt_compare_morphism; auto.
-(* NEG/POS *)
-  case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
-  intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
-  intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
-  rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
-    auto with real.
-  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
-  apply lt_le_weak.
-  apply nat_of_P_lt_Lt_compare_morphism; auto.
-  apply ZC2; auto.
-  intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
-  rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
-    auto with real.
-  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
-  rewrite Rinv_mult_distr; auto with real.
-  apply lt_le_weak.
-  change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
-  apply nat_of_P_gt_Gt_compare_morphism; auto.
-(* NEG/NEG *)
-  rewrite nat_of_P_plus_morphism; auto with real.
-  intros H'; rewrite pow_add; auto with real.
-  apply Rinv_mult_distr; auto.
-  apply pow_nonzero; auto.
-  apply pow_nonzero; auto.
+  intros x [|n|n] [|m|m]; simpl; intros; auto with real.
+  - (* + + *)
+    rewrite Pos2Nat.inj_add; auto with real.
+  - (* + - *)
+    now apply powerRZ_pos_sub.
+  - (* - + *)
+    rewrite Rmult_comm. now apply powerRZ_pos_sub.
+  - (* - - *)
+    rewrite Pos2Nat.inj_add; auto with real.
+    rewrite pow_add; auto with real.
+    apply Rinv_mult_distr; apply pow_nonzero; auto.
 Qed.
 Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real.
 
 Lemma Zpower_nat_powerRZ :
-  forall n m:nat, IZR (Zpower_nat (Z_of_nat n) m) = INR n ^Z Z_of_nat m.
+  forall n m:nat, IZR (Zpower_nat (Z.of_nat n) m) = INR n ^Z Z.of_nat m.
 Proof.
-  intros n m; elim m; simpl in |- *; auto with real.
-  intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *.
-  replace (Zpower_nat (Z_of_nat n) (S m1)) with
-  (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z.
+  intros n m; elim m; simpl; auto with real.
+  intros m1 H'; rewrite SuccNat2Pos.id_succ; simpl.
+  replace (Zpower_nat (Z.of_nat n) (S m1)) with
+  (Z.of_nat n * Zpower_nat (Z.of_nat n) m1)%Z.
   rewrite mult_IZR; auto with real.
-  repeat rewrite <- INR_IZR_INZ; simpl in |- *.
-  rewrite H'; simpl in |- *.
-  case m1; simpl in |- *; auto with real.
-  intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto.
-  unfold Zpower_nat in |- *; auto.
+  repeat rewrite <- INR_IZR_INZ; simpl.
+  rewrite H'; simpl.
+  case m1; simpl; auto with real.
+  intros m2; rewrite SuccNat2Pos.id_succ; auto.
+  unfold Zpower_nat; auto.
 Qed.
 
 Lemma Zpower_pos_powerRZ :
-  forall n m, IZR (Zpower_pos n m) = IZR n ^Z Zpos m.
+  forall n m, IZR (Z.pow_pos n m) = IZR n ^Z Zpos m.
 Proof.
   intros.
   rewrite Zpower_pos_nat; simpl.
-  induction (nat_of_P m).
+  induction (Pos.to_nat m).
   easy.
   unfold Zpower_nat; simpl.
   rewrite mult_IZR.
@@ -633,7 +623,7 @@ Qed.
 
 Lemma powerRZ_lt : forall (x:R) (z:Z), 0 < x -> 0 < x ^Z z.
 Proof.
-  intros x z; case z; simpl in |- *; auto with real.
+  intros x z; case z; simpl; auto with real.
 Qed.
 Hint Resolve powerRZ_lt: real.
 
@@ -644,21 +634,21 @@ Qed.
 Hint Resolve powerRZ_le: real.
 
 Lemma Zpower_nat_powerRZ_absolu :
-  forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = IZR n ^Z m.
+  forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Z.abs_nat m)) = IZR n ^Z m.
 Proof.
-  intros n m; case m; simpl in |- *; auto with zarith.
-  intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith.
-  intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith.
+  intros n m; case m; simpl; auto with zarith.
+  intros p H'; elim (Pos.to_nat p); simpl; auto with zarith.
+  intros n0 H'0; rewrite <- H'0; simpl; auto with zarith.
   rewrite <- mult_IZR; auto.
   intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith.
 Qed.
 
 Lemma powerRZ_R1 : forall n:Z, 1 ^Z n = 1.
 Proof.
-  intros n; case n; simpl in |- *; auto.
-  intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H';
+  intros n; case n; simpl; auto.
+  intros p; elim (Pos.to_nat p); simpl; auto; intros n0 H'; rewrite H';
     ring.
-  intros p; elim (nat_of_P p); simpl in |- *.
+  intros p; elim (Pos.to_nat p); simpl.
   exact Rinv_1.
   intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H';
     auto with real.
@@ -676,7 +666,7 @@ Definition decimal_exp (r:R) (z:Z) : R := (r * 10 ^Z z).
 (** * Sum of n first naturals  *)
 (*******************************)
 (*********)
-Boxed Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) : nat :=
+Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) : nat :=
   match n with
     | O => f 0%nat
     | S n' => (sum_nat_f_O f n' + f (S n'))%nat
@@ -710,10 +700,10 @@ Lemma GP_finite :
   forall (x:R) (n:nat),
     sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1.
 Proof.
-  intros; induction  n as [| n Hrecn]; simpl in |- *.
+  intros; induction  n as [| n Hrecn]; simpl.
   ring.
   rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n).
-  intro H; rewrite H; simpl in |- *; ring.
+  intro H; rewrite H; simpl; ring.
   omega.
 Qed.
 
@@ -721,8 +711,8 @@ Lemma sum_f_R0_triangle :
   forall (x:nat -> R) (n:nat),
     Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n.
 Proof.
-  intro; simple induction n; simpl in |- *.
-  unfold Rle in |- *; right; reflexivity.
+  intro; simple induction n; simpl.
+  unfold Rle; right; reflexivity.
   intro m; intro;
     apply
       (Rle_trans (Rabs (sum_f_R0 x m + x (S m)))
@@ -744,16 +734,16 @@ Definition R_dist (x y:R) : R := Rabs (x - y).
 (*********)
 Lemma R_dist_pos : forall x y:R, R_dist x y >= 0.
 Proof.
-  intros; unfold R_dist in |- *; unfold Rabs in |- *; case (Rcase_abs (x - y));
+  intros; unfold R_dist; unfold Rabs; case (Rcase_abs (x - y));
     intro l.
-  unfold Rge in |- *; left; apply (Ropp_gt_lt_0_contravar (x - y) l).
+  unfold Rge; left; apply (Ropp_gt_lt_0_contravar (x - y) l).
   trivial.
 Qed.
 
 (*********)
 Lemma R_dist_sym : forall x y:R, R_dist x y = R_dist y x.
 Proof.
-  unfold R_dist in |- *; intros; split_Rabs; try ring.
+  unfold R_dist; intros; split_Rabs; try ring.
   generalize (Ropp_gt_lt_0_contravar (y - x) r); intro;
     rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0);
       intro; unfold Rgt in H; exfalso; auto.
@@ -765,10 +755,10 @@ Qed.
 (*********)
 Lemma R_dist_refl : forall x y:R, R_dist x y = 0 <-> x = y.
 Proof.
-  unfold R_dist in |- *; intros; split_Rabs; split; intros.
-  rewrite (Ropp_minus_distr x y) in H; apply sym_eq;
+  unfold R_dist; intros; split_Rabs; split; intros.
+  rewrite (Ropp_minus_distr x y) in H; symmetry;
     apply (Rminus_diag_uniq y x H).
-  rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro;
+  rewrite (Ropp_minus_distr x y); generalize (eq_sym H); intro;
     apply (Rminus_diag_eq y x H0).
   apply (Rminus_diag_uniq x y H).
   apply (Rminus_diag_eq x y H).
@@ -776,13 +766,13 @@ Qed.
 
 Lemma R_dist_eq : forall x:R, R_dist x x = 0.
 Proof.
-  unfold R_dist in |- *; intros; split_Rabs; intros; ring.
+  unfold R_dist; intros; split_Rabs; intros; ring.
 Qed.
 
 (***********)
 Lemma R_dist_tri : forall x y z:R, R_dist x y <= R_dist x z + R_dist z y.
 Proof.
-  intros; unfold R_dist in |- *; replace (x - y) with (x - z + (z - y));
+  intros; unfold R_dist; replace (x - y) with (x - z + (z - y));
     [ apply (Rabs_triang (x - z) (z - y)) | ring ].
 Qed.
 
@@ -790,7 +780,7 @@ Qed.
 Lemma R_dist_plus :
   forall a b c d:R, R_dist (a + c) (b + d) <= R_dist a b + R_dist c d.
 Proof.
-  intros; unfold R_dist in |- *;
+  intros; unfold R_dist;
     replace (a + c - (b + d)) with (a - b + (c - d)).
   exact (Rabs_triang (a - b) (c - d)).
   ring.
diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v
index 3ab2bc73..ffa11608 100644
--- a/theories/Reals/Rgeom.v
+++ b/theories/Reals/Rgeom.v
@@ -1,19 +1,17 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rgeom.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
-Require Import Rtrigo.
+Require Import Rtrigo1.
 Require Import R_sqrt.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (** * Distance *)
 
@@ -22,23 +20,23 @@ Definition dist_euc (x0 y0 x1 y1:R) : R :=
 
 Lemma distance_refl : forall x0 y0:R, dist_euc x0 y0 x0 y0 = 0.
 Proof.
-  intros x0 y0; unfold dist_euc in |- *; apply Rsqr_inj;
+  intros x0 y0; unfold dist_euc; apply Rsqr_inj;
     [ apply sqrt_positivity; apply Rplus_le_le_0_compat;
       [ apply Rle_0_sqr | apply Rle_0_sqr ]
       | right; reflexivity
       | rewrite Rsqr_0; rewrite Rsqr_sqrt;
-        [ unfold Rsqr in |- *; ring
+        [ unfold Rsqr; ring
           | apply Rplus_le_le_0_compat; [ apply Rle_0_sqr | apply Rle_0_sqr ] ] ].
 Qed.
 
 Lemma distance_symm :
   forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0.
 Proof.
-  intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj;
+  intros x0 y0 x1 y1; unfold dist_euc; apply Rsqr_inj;
     [ apply sqrt_positivity; apply Rplus_le_le_0_compat
       | apply sqrt_positivity; apply Rplus_le_le_0_compat
       | repeat rewrite Rsqr_sqrt;
-        [ unfold Rsqr in |- *; ring
+        [ unfold Rsqr; ring
           | apply Rplus_le_le_0_compat
           | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr.
 Qed.
@@ -51,8 +49,8 @@ Lemma law_cosines :
           a * c * cos ac = (x0 - x1) * (x2 - x1) + (y0 - y1) * (y2 - y1) ->
           Rsqr b = Rsqr c + Rsqr a - 2 * (a * c * cos ac).
 Proof.
-  unfold dist_euc in |- *; intros; repeat rewrite Rsqr_sqrt;
-    [ rewrite H; unfold Rsqr in |- *; ring
+  unfold dist_euc; intros; repeat rewrite Rsqr_sqrt;
+    [ rewrite H; unfold Rsqr; ring
       | apply Rplus_le_le_0_compat
       | apply Rplus_le_le_0_compat
       | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr.
@@ -62,7 +60,7 @@ Lemma triangle :
   forall x0 y0 x1 y1 x2 y2:R,
     dist_euc x0 y0 x1 y1 <= dist_euc x0 y0 x2 y2 + dist_euc x2 y2 x1 y1.
 Proof.
-  intros; unfold dist_euc in |- *; apply Rsqr_incr_0;
+  intros; unfold dist_euc; apply Rsqr_incr_0;
     [ rewrite Rsqr_plus; repeat rewrite Rsqr_sqrt;
       [ replace (Rsqr (x0 - x1)) with
         (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1));
@@ -114,7 +112,7 @@ Definition yt (y ty:R) : R := y + ty.
 
 Lemma translation_0 : forall x y:R, xt x 0 = x /\ yt y 0 = y.
 Proof.
-  intros x y; split; [ unfold xt in |- * | unfold yt in |- * ]; ring.
+  intros x y; split; [ unfold xt | unfold yt ]; ring.
 Qed.
 
 Lemma isometric_translation :
@@ -122,7 +120,7 @@ Lemma isometric_translation :
     Rsqr (x1 - x2) + Rsqr (y1 - y2) =
     Rsqr (xt x1 tx - xt x2 tx) + Rsqr (yt y1 ty - yt y2 ty).
 Proof.
-  intros; unfold Rsqr, xt, yt in |- *; ring.
+  intros; unfold Rsqr, xt, yt; ring.
 Qed.
 
 (******************************************************************)
@@ -134,13 +132,13 @@ Definition yr (x y theta:R) : R := - x * sin theta + y * cos theta.
 
 Lemma rotation_0 : forall x y:R, xr x y 0 = x /\ yr x y 0 = y.
 Proof.
-  intros x y; unfold xr, yr in |- *; split; rewrite cos_0; rewrite sin_0; ring.
+  intros x y; unfold xr, yr; split; rewrite cos_0; rewrite sin_0; ring.
 Qed.
 
 Lemma rotation_PI2 :
   forall x y:R, xr x y (PI / 2) = y /\ yr x y (PI / 2) = - x.
 Proof.
-  intros x y; unfold xr, yr in |- *; split; rewrite cos_PI2; rewrite sin_PI2;
+  intros x y; unfold xr, yr; split; rewrite cos_PI2; rewrite sin_PI2;
     ring.
 Qed.
 
@@ -150,7 +148,7 @@ Lemma isometric_rotation_0 :
     Rsqr (xr x1 y1 theta - xr x2 y2 theta) +
     Rsqr (yr x1 y1 theta - yr x2 y2 theta).
 Proof.
-  intros; unfold xr, yr in |- *;
+  intros; unfold xr, yr;
     replace
     (x1 * cos theta + y1 * sin theta - (x2 * cos theta + y2 * sin theta)) with
     (cos theta * (x1 - x2) + sin theta * (y1 - y2));
@@ -170,7 +168,7 @@ Lemma isometric_rotation :
     dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta)
     (yr x2 y2 theta).
 Proof.
-  unfold dist_euc in |- *; intros; apply Rsqr_inj;
+  unfold dist_euc; intros; apply Rsqr_inj;
     [ apply sqrt_positivity; apply Rplus_le_le_0_compat
       | apply sqrt_positivity; apply Rplus_le_le_0_compat
       | repeat rewrite Rsqr_sqrt;
diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v
index 598f5f31..0a00ca22 100644
--- a/theories/Reals/RiemannInt.v
+++ b/theories/Reals/RiemannInt.v
@@ -1,23 +1,21 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: RiemannInt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rfunctions.
 Require Import SeqSeries.
-Require Import Ranalysis.
+Require Import Ranalysis_reg.
 Require Import Rbase.
 Require Import RiemannInt_SF.
 Require Import Classical_Prop.
 Require Import Classical_Pred_Type.
 Require Import Max.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Set Implicit Arguments.
 
@@ -53,19 +51,19 @@ Lemma RiemannInt_P1 :
   forall (f:R -> R) (a b:R),
     Riemann_integrable f a b -> Riemann_integrable f b a.
 Proof.
-  unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; intros;
+  unfold Riemann_integrable; intros; elim (X eps); clear X; intros;
     elim p; clear p; intros; exists (mkStepFun (StepFun_P6 (pre x)));
       exists (mkStepFun (StepFun_P6 (pre x0)));
         elim p; clear p; intros; split.
   intros; apply (H t); elim H1; clear H1; intros; split;
     [ apply Rle_trans with (Rmin b a); try assumption; right;
-      unfold Rmin in |- *
+      unfold Rmin
       | apply Rle_trans with (Rmax b a); try assumption; right;
-        unfold Rmax in |- * ];
+        unfold Rmax ];
     (case (Rle_dec a b); case (Rle_dec b a); intros;
       try reflexivity || apply Rle_antisym;
         [ assumption | assumption | auto with real | auto with real ]).
-  generalize H0; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
+  generalize H0; unfold RiemannInt_SF; case (Rle_dec a b);
     case (Rle_dec b a); intros;
       (replace
         (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0))))
@@ -91,11 +89,11 @@ Lemma RiemannInt_P2 :
       Rabs (RiemannInt_SF (wn n)) < un n) ->
     { l:R | Un_cv (fun N:nat => RiemannInt_SF (vn N)) l }.
 Proof.
-  intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit in |- *;
+  intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit;
     intros; assert (H3 : 0 < eps / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-  elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist in |- *;
+  elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist;
     unfold R_dist in H4; elim (H1 n); elim (H1 m); intros;
       replace (RiemannInt_SF (vn n) - RiemannInt_SF (vn m)) with
       (RiemannInt_SF (vn n) + -1 * RiemannInt_SF (vn m));
@@ -107,15 +105,15 @@ Proof.
   apply Rle_lt_trans with
     (RiemannInt_SF (mkStepFun (StepFun_P28 1 (wn n) (wn m)))).
   apply StepFun_P37; try assumption.
-  intros; simpl in |- *;
+  intros; simpl;
     apply Rle_trans with (Rabs (vn n x - f x) + Rabs (f x - vn m x)).
   replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x));
   [ apply Rabs_triang | ring ].
   assert (H12 : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   assert (H13 : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   rewrite <- H12 in H11; pattern b at 2 in H11; rewrite <- H13 in H11;
     rewrite Rmult_1_l; apply Rplus_le_compat.
@@ -158,14 +156,14 @@ Proof.
   intro; elim (H0 n0); intros; split.
   intros; apply (H2 t); elim H4; clear H4; intros; split;
     [ apply Rle_trans with (Rmin b a); try assumption; right;
-      unfold Rmin in |- *
+      unfold Rmin
       | apply Rle_trans with (Rmax b a); try assumption; right;
-        unfold Rmax in |- * ];
+        unfold Rmax ];
     (case (Rle_dec a b); case (Rle_dec b a); intros;
       try reflexivity || apply Rle_antisym;
         [ assumption | assumption | auto with real | auto with real ]).
-  generalize H3; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
-    case (Rle_dec b a); unfold wn' in |- *; intros;
+  generalize H3; unfold RiemannInt_SF; case (Rle_dec a b);
+    case (Rle_dec b a); unfold wn'; intros;
       (replace
         (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0)))))
           (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with
@@ -180,19 +178,19 @@ Proof.
   rewrite Rabs_Ropp in H4; apply H4.
   apply H4.
   assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros;
-    exists (- x); unfold Un_cv in |- *; unfold Un_cv in p;
+    exists (- x); unfold Un_cv; unfold Un_cv in p;
       intros; elim (p _ H4); intros; exists x0; intros;
-        generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *;
+        generalize (H5 _ H6); unfold R_dist, RiemannInt_SF;
           case (Rle_dec b a); case (Rle_dec a b); intros.
   elim n; assumption.
   unfold vn' in H7;
     replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with
     (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0)))))
       (subdivision (mkStepFun (StepFun_P6 (pre (vn n0))))));
-    [ unfold Rminus in |- *; rewrite Ropp_involutive; rewrite <- Rabs_Ropp;
+    [ unfold Rminus; rewrite Ropp_involutive; rewrite <- Rabs_Ropp;
       rewrite Ropp_plus_distr; rewrite Ropp_involutive;
         apply H7
-      | symmetry  in |- *; apply StepFun_P17 with (fe (vn n0)) a b;
+      | symmetry ; apply StepFun_P17 with (fe (vn n0)) a b;
         [ apply StepFun_P1
           | apply StepFun_P2;
             apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0))))) ] ].
@@ -220,9 +218,9 @@ Lemma RiemannInt_P4 :
     Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr1 N)) l ->
     Un_cv (fun N:nat => RiemannInt_SF (phi_sequence vn pr2 N)) l.
 Proof.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros f; intros;
+  unfold Un_cv; unfold R_dist; intros f; intros;
     assert (H3 : 0 < eps / 3).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   elim (H _ H3); clear H; intros N0 H; elim (H0 _ H3); clear H0; intros N1 H0;
     elim (H1 _ H3); clear H1; intros N2 H1; set (N := max (max N0 N1) N2);
@@ -257,7 +255,7 @@ Proof.
   apply StepFun_P34; assumption.
   apply Rle_lt_trans with
     (RiemannInt_SF (mkStepFun (StepFun_P28 1 psi_un psi_vn))).
-  apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l;
+  apply StepFun_P37; try assumption; intros; simpl; rewrite Rmult_1_l;
     apply Rle_trans with
       (Rabs (phi_sequence vn pr2 n x - f x) +
         Rabs (f x - phi_sequence un pr1 n x)).
@@ -265,10 +263,10 @@ Proof.
   (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x));
   [ apply Rabs_triang | ring ].
   assert (H10 : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   assert (H11 : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat.
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8.
@@ -281,20 +279,20 @@ Proof.
   apply RRle_abs.
   assumption.
   replace (pos (un n)) with (Rabs (un n - 0));
-  [ apply H; unfold ge in |- *; apply le_trans with N; try assumption;
-    unfold N in |- *; apply le_trans with (max N0 N1);
+  [ apply H; unfold ge; apply le_trans with N; try assumption;
+    unfold N; apply le_trans with (max N0 N1);
       apply le_max_l
-    | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+    | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
       apply Rle_ge; left; apply (cond_pos (un n)) ].
   apply Rlt_trans with (pos (vn n)).
   elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)).
   apply RRle_abs; assumption.
   assumption.
   replace (pos (vn n)) with (Rabs (vn n - 0));
-  [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption;
-    unfold N in |- *; apply le_trans with (max N0 N1);
+  [ apply H0; unfold ge; apply le_trans with N; try assumption;
+    unfold N; apply le_trans with (max N0 N1);
       [ apply le_max_r | apply le_max_l ]
-    | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+    | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
       apply Rle_ge; left; apply (cond_pos (vn n)) ].
   rewrite StepFun_P39; rewrite Rabs_Ropp;
     apply Rle_lt_trans with
@@ -313,7 +311,7 @@ Proof.
       (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))).
   apply StepFun_P37.
   auto with real.
-  intros; simpl in |- *; rewrite Rmult_1_l;
+  intros; simpl; rewrite Rmult_1_l;
     apply Rle_trans with
       (Rabs (phi_sequence vn pr2 n x - f x) +
         Rabs (f x - phi_sequence un pr1 n x)).
@@ -321,10 +319,10 @@ Proof.
   (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x));
   [ apply Rabs_triang | ring ].
   assert (H10 : Rmin a b = b).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ elim n0; assumption | reflexivity ].
   assert (H11 : Rmax a b = a).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ elim n0; assumption | reflexivity ].
   apply Rplus_le_compat.
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8.
@@ -343,10 +341,10 @@ Proof.
   rewrite <- Rabs_Ropp; apply RRle_abs.
   assumption.
   replace (pos (vn n)) with (Rabs (vn n - 0));
-  [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption;
-    unfold N in |- *; apply le_trans with (max N0 N1);
+  [ apply H0; unfold ge; apply le_trans with N; try assumption;
+    unfold N; apply le_trans with (max N0 N1);
       [ apply le_max_r | apply le_max_l ]
-    | unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    | unfold R_dist; unfold Rminus; rewrite Ropp_0;
       rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge;
         left; apply (cond_pos (vn n)) ].
   apply Rlt_trans with (pos (un n)).
@@ -354,15 +352,15 @@ Proof.
   rewrite <- Rabs_Ropp; apply RRle_abs; assumption.
   assumption.
   replace (pos (un n)) with (Rabs (un n - 0));
-  [ apply H; unfold ge in |- *; apply le_trans with N; try assumption;
-    unfold N in |- *; apply le_trans with (max N0 N1);
+  [ apply H; unfold ge; apply le_trans with N; try assumption;
+    unfold N; apply le_trans with (max N0 N1);
       apply le_max_l
-    | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+    | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
       apply Rle_ge; left; apply (cond_pos (un n)) ].
-  apply H1; unfold ge in |- *; apply le_trans with N; try assumption;
-    unfold N in |- *; apply le_max_r.
+  apply H1; unfold ge; apply le_trans with N; try assumption;
+    unfold N; apply le_max_r.
   apply Rmult_eq_reg_l with 3;
-    [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+    [ unfold Rdiv; rewrite Rmult_plus_distr_l;
       do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
         rewrite <- Rinv_l_sym; [ ring | discrR ]
       | discrR ].
@@ -378,17 +376,17 @@ Definition RinvN (N:nat) : posreal := mkposreal _ (RinvN_pos N).
 
 Lemma RinvN_cv : Un_cv RinvN 0.
 Proof.
-  unfold Un_cv in |- *; intros; assert (H0 := archimed (/ eps)); elim H0;
+  unfold Un_cv; intros; assert (H0 := archimed (/ eps)); elim H0;
     clear H0; intros; assert (H2 : (0 <= up (/ eps))%Z).
   apply le_IZR; left; apply Rlt_trans with (/ eps);
     [ apply Rinv_0_lt_compat; assumption | assumption ].
-  elim (IZN _ H2); intros; exists x; intros; unfold R_dist in |- *;
-    simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+  elim (IZN _ H2); intros; exists x; intros; unfold R_dist;
+    simpl; unfold Rminus; rewrite Ropp_0;
       rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1).
   apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
   rewrite Rabs_right;
     [ idtac
-      | left; change (0 < / (INR n + 1)) in |- *; apply Rinv_0_lt_compat;
+      | left; change (0 < / (INR n + 1)); apply Rinv_0_lt_compat;
         assumption ]; apply Rle_lt_trans with (/ (INR x + 1)).
   apply Rle_Rinv.
   apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
@@ -402,9 +400,9 @@ Proof.
   apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
   apply Rlt_trans with (INR x);
     [ rewrite INR_IZR_INZ; rewrite <- H3; apply H0
-      | pattern (INR x) at 1 in |- *; rewrite <- Rplus_0_r;
+      | pattern (INR x) at 1; rewrite <- Rplus_0_r;
         apply Rplus_lt_compat_l; apply Rlt_0_1 ].
-  red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H6 in H; elim (Rlt_irrefl _ H).
 Qed.
 
 (**********)
@@ -415,7 +413,7 @@ Lemma RiemannInt_P5 :
   forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b),
     RiemannInt pr1 = RiemannInt pr2.
 Proof.
-  intros; unfold RiemannInt in |- *;
+  intros; unfold RiemannInt;
     case (RiemannInt_exists pr1 RinvN RinvN_cv);
     case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
       eapply UL_sequence;
@@ -433,7 +431,7 @@ Lemma maxN :
 Proof.
   intros; set (I := fun n:nat => a + INR n * del < b);
     assert (H0 :  exists n : nat, I n).
-  exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r;
+  exists 0%nat; unfold I; rewrite Rmult_0_l; rewrite Rplus_0_r;
     assumption.
   cut (Nbound I).
   intro; assert (H2 := Nzorn H0 H1); elim H2; intros; exists x; elim p; intros;
@@ -442,27 +440,27 @@ Proof.
   case (total_order_T (a + INR (S x) * del) b); intro.
   elim s; intro.
   assert (H5 := H4 (S x) a0); elim (le_Sn_n _ H5).
-  right; symmetry  in |- *; assumption.
+  right; symmetry ; assumption.
   left; apply r.
   assert (H1 : 0 <= (b - a) / del).
-  unfold Rdiv in |- *; apply Rmult_le_pos;
+  unfold Rdiv; apply Rmult_le_pos;
     [ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H
       | left; apply Rinv_0_lt_compat; apply (cond_pos del) ].
   elim (archimed ((b - a) / del)); intros;
     assert (H4 : (0 <= up ((b - a) / del))%Z).
-  apply le_IZR; simpl in |- *; left; apply Rle_lt_trans with ((b - a) / del);
+  apply le_IZR; simpl; left; apply Rle_lt_trans with ((b - a) / del);
     assumption.
   assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5;
-    unfold Nbound in |- *; exists N; intros; unfold I in H6;
+    unfold Nbound; exists N; intros; unfold I in H6;
       apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2;
         left; apply Rle_lt_trans with ((b - a) / del); try assumption;
           apply Rmult_le_reg_l with (pos del);
             [ apply (cond_pos del)
-              | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ del));
+              | unfold Rdiv; rewrite <- (Rmult_comm (/ del));
                 rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
                   [ rewrite Rmult_1_l; rewrite Rmult_comm; apply Rplus_le_reg_l with a;
                     replace (a + (b - a)) with b; [ left; assumption | ring ]
-                    | assert (H7 := cond_pos del); red in |- *; intro; rewrite H8 in H7;
+                    | assert (H7 := cond_pos del); red; intro; rewrite H8 in H7;
                       elim (Rlt_irrefl _ H7) ] ].
 Qed.
 
@@ -498,15 +496,15 @@ Proof.
             a <= x <= b ->
             a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps));
       assert (H1 : bound E).
-  unfold bound in |- *; exists (b - a); unfold is_upper_bound in |- *; intros;
+  unfold bound; exists (b - a); unfold is_upper_bound; intros;
     unfold E in H1; elim H1; clear H1; intros H1 _; elim H1;
       intros; assumption.
   assert (H2 :  exists x : R, E x).
   assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps);
-    elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *;
+    elim H2; intros; exists (Rmin x (b - a)); unfold E;
       split;
         [ split;
-          [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro;
+          [ unfold Rmin; case (Rle_dec x (b - a)); intro;
             [ apply (cond_pos x) | apply Rlt_Rminus; assumption ]
             | apply Rmin_r ]
           | intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a));
@@ -521,7 +519,7 @@ Proof.
     intros; apply H15; assumption.
   assert (H12 := not_ex_all_not _ (fun y:R => D < y /\ E y) H11);
     assert (H13 : is_upper_bound E D).
-  unfold is_upper_bound in |- *; intros; assert (H14 := H12 x1);
+  unfold is_upper_bound; intros; assert (H14 := H12 x1);
     elim (not_and_or (D < x1) (E x1) H14); intro.
   case (Rle_dec x1 D); intro.
   assumption.
@@ -553,7 +551,7 @@ Proof.
   exists (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y);
     [ elim H0; elim H1; intros; rewrite b0 in H3; rewrite b0 in H5;
       apply Rle_antisym; apply Rle_trans with b; assumption
-      | rewrite H3; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+      | rewrite H3; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
         apply (cond_pos eps) ].
   exists (mkposreal _ Rlt_0_1); intros; elim H0; intros;
     elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)).
@@ -562,14 +560,14 @@ Qed.
 Lemma SubEqui_P1 :
   forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) 0 = a.
 Proof.
-  intros; unfold SubEqui in |- *; case (maxN del h); intros; reflexivity.
+  intros; unfold SubEqui; case (maxN del h); intros; reflexivity.
 Qed.
 
 Lemma SubEqui_P2 :
   forall (a b:R) (del:posreal) (h:a < b),
     pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))) = b.
 Proof.
-  intros; unfold SubEqui in |- *; case (maxN del h); intros; clear a0;
+  intros; unfold SubEqui; case (maxN del h); intros; clear a0;
     cut
       (forall (x:nat) (a:R) (del:posreal),
         pos_Rl (SubEquiN (S x) a b del)
@@ -581,14 +579,14 @@ Proof.
               change
                 (pos_Rl (SubEquiN (S n) (a0 + del0) b del0)
                   (pred (Rlength (SubEquiN (S n) (a0 + del0) b del0))) = b)
-                in |- *; apply H ] ].
+               ; apply H ] ].
 Qed.
 
 Lemma SubEqui_P3 :
   forall (N:nat) (a b:R) (del:posreal), Rlength (SubEquiN N a b del) = S N.
 Proof.
   simple induction N; intros;
-    [ reflexivity | simpl in |- *; rewrite H; reflexivity ].
+    [ reflexivity | simpl; rewrite H; reflexivity ].
 Qed.
 
 Lemma SubEqui_P4 :
@@ -596,36 +594,36 @@ Lemma SubEqui_P4 :
     (i < S N)%nat -> pos_Rl (SubEquiN (S N) a b del) i = a + INR i * del.
 Proof.
   simple induction N;
-    [ intros; inversion H; [ simpl in |- *; ring | elim (le_Sn_O _ H1) ]
+    [ intros; inversion H; [ simpl; ring | elim (le_Sn_O _ H1) ]
       | intros; induction  i as [| i Hreci];
-        [ simpl in |- *; ring
+        [ simpl; ring
           | change
             (pos_Rl (SubEquiN (S n) (a + del) b del) i = a + INR (S i) * del)
-            in |- *; rewrite H; [ rewrite S_INR; ring | apply lt_S_n; apply H0 ] ] ].
+           ; rewrite H; [ rewrite S_INR; ring | apply lt_S_n; apply H0 ] ] ].
 Qed.
 
 Lemma SubEqui_P5 :
   forall (a b:R) (del:posreal) (h:a < b),
     Rlength (SubEqui del h) = S (S (max_N del h)).
 Proof.
-  intros; unfold SubEqui in |- *; apply SubEqui_P3.
+  intros; unfold SubEqui; apply SubEqui_P3.
 Qed.
 
 Lemma SubEqui_P6 :
   forall (a b:R) (del:posreal) (h:a < b) (i:nat),
     (i < S (max_N del h))%nat -> pos_Rl (SubEqui del h) i = a + INR i * del.
 Proof.
-  intros; unfold SubEqui in |- *; apply SubEqui_P4; assumption.
+  intros; unfold SubEqui; apply SubEqui_P4; assumption.
 Qed.
 
 Lemma SubEqui_P7 :
   forall (a b:R) (del:posreal) (h:a < b), ordered_Rlist (SubEqui del h).
 Proof.
-  intros; unfold ordered_Rlist in |- *; intros; rewrite SubEqui_P5 in H;
+  intros; unfold ordered_Rlist; intros; rewrite SubEqui_P5 in H;
     simpl in H; inversion H.
   rewrite (SubEqui_P6 del h (i:=(max_N del h))).
   replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))).
-  rewrite SubEqui_P2; unfold max_N in |- *; case (maxN del h); intros; left;
+  rewrite SubEqui_P2; unfold max_N; case (maxN del h); intros; left;
     elim a0; intros; assumption.
   rewrite SubEqui_P5; reflexivity.
   apply lt_n_Sn.
@@ -633,7 +631,7 @@ Proof.
   3: assumption.
   2: apply le_lt_n_Sm; assumption.
   apply Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r;
-    pattern (INR i * del) at 1 in |- *; rewrite <- Rplus_0_r;
+    pattern (INR i * del) at 1; rewrite <- Rplus_0_r;
       apply Rplus_le_compat_l; rewrite Rmult_1_l; left;
         apply (cond_pos del).
 Qed.
@@ -643,11 +641,11 @@ Lemma SubEqui_P8 :
     (i < Rlength (SubEqui del h))%nat -> a <= pos_Rl (SubEqui del h) i <= b.
 Proof.
   intros; split.
-  pattern a at 1 in |- *; rewrite <- (SubEqui_P1 del h); apply RList_P5.
+  pattern a at 1; rewrite <- (SubEqui_P1 del h); apply RList_P5.
   apply SubEqui_P7.
   elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1;
     exists i; split; [ reflexivity | assumption ].
-  pattern b at 2 in |- *; rewrite <- (SubEqui_P2 del h); apply RList_P7;
+  pattern b at 2; rewrite <- (SubEqui_P2 del h); apply RList_P7;
     [ apply SubEqui_P7
       | elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros;
         apply H1; exists i; split; [ reflexivity | assumption ] ].
@@ -673,42 +671,42 @@ Lemma RiemannInt_P6 :
     a < b ->
     (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b.
 Proof.
-  intros; unfold Riemann_integrable in |- *; intro;
+  intros; unfold Riemann_integrable; intro;
     assert (H1 : 0 < eps / (2 * (b - a))).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos eps)
       | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
         [ prove_sup0 | apply Rlt_Rminus; assumption ] ].
   assert (H2 : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; left; assumption ].
   assert (H3 : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; left; assumption ].
   elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4;
     elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi;
       split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a)))));
         split.
-  2: rewrite StepFun_P18; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  2: rewrite StepFun_P18; unfold Rdiv; rewrite Rinv_mult_distr.
   2: do 2 rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   2: rewrite Rmult_1_r; rewrite Rabs_right.
   2: apply Rmult_lt_reg_l with 2.
   2: prove_sup0.
   2: rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
     rewrite <- Rinv_r_sym.
-  2: rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r;
+  2: rewrite Rmult_1_l; pattern (pos eps) at 1; rewrite <- Rplus_0_r;
     rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps).
   2: discrR.
   2: apply Rle_ge; left; apply Rmult_lt_0_compat.
   2: apply (cond_pos eps).
   2: apply Rinv_0_lt_compat; prove_sup0.
-  2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H;
+  2: apply Rminus_eq_contra; red; intro; clear H6; rewrite H7 in H;
     elim (Rlt_irrefl _ H).
   2: discrR.
-  2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H;
+  2: apply Rminus_eq_contra; red; intro; clear H6; rewrite H7 in H;
     elim (Rlt_irrefl _ H).
-  intros; rewrite H2 in H7; rewrite H3 in H7; simpl in |- *;
-    unfold fct_cte in |- *;
+  intros; rewrite H2 in H7; rewrite H3 in H7; simpl;
+    unfold fct_cte;
       cut
         (forall t:R,
           a <= t <= b ->
@@ -718,14 +716,14 @@ Proof.
             co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i))
             t)).
   intro; elim (H8 _ H7); intro.
-  rewrite H9; rewrite H5; unfold Rminus in |- *; rewrite Rplus_opp_r;
+  rewrite H9; rewrite H5; unfold Rminus; rewrite Rplus_opp_r;
     rewrite Rabs_R0; left; assumption.
   elim H9; clear H9; intros I [H9 H10]; assert (H11 := H6 I H9 t H10);
     rewrite H11; left; apply H4.
   assumption.
   apply SubEqui_P8; apply lt_trans with (pred (Rlength (SubEqui del H))).
   assumption.
-  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H9;
+  apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H12 in H9;
     elim (lt_n_O _ H9).
   unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right.
   rewrite SubEqui_P5 in H9; simpl in H9; inversion H9.
@@ -740,7 +738,7 @@ Proof.
   rewrite H13 in H12; rewrite SubEqui_P2 in H12; apply H12.
   rewrite SubEqui_P6.
   2: apply lt_n_Sn.
-  unfold max_N in |- *; case (maxN del H); intros; elim a0; clear a0;
+  unfold max_N; case (maxN del H); intros; elim a0; clear a0;
     intros _ H13; replace (a + INR x * del + del) with (a + INR (S x) * del);
       [ assumption | rewrite S_INR; ring ].
   apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) I);
@@ -757,10 +755,10 @@ Proof.
   left; assumption.
   right; set (I := fun j:nat => a + INR j * del <= t0);
     assert (H1 :  exists n : nat, I n).
-  exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8;
+  exists 0%nat; unfold I; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8;
     intros; assumption.
   assert (H4 : Nbound I).
-  unfold Nbound in |- *; exists (S (max_N del H)); intros; unfold max_N in |- *;
+  unfold Nbound; exists (S (max_N del H)); intros; unfold max_N;
     case (maxN del H); intros; elim a0; clear a0; intros _ H5;
       apply INR_le; apply Rmult_le_reg_l with (pos del).
   apply (cond_pos del).
@@ -769,7 +767,7 @@ Proof.
       apply Rle_trans with b; try assumption; elim H8; intros;
         assumption.
   elim (Nzorn H1 H4); intros N [H5 H6]; assert (H7 : (N < S (max_N del H))%nat).
-  unfold max_N in |- *; case (maxN del H); intros; apply INR_lt;
+  unfold max_N; case (maxN del H); intros; apply INR_lt;
     apply Rmult_lt_reg_l with (pos del).
   apply (cond_pos del).
   apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del);
@@ -780,8 +778,8 @@ Proof.
   assumption.
   elim H0; assumption.
   exists N; split.
-  rewrite SubEqui_P5; simpl in |- *; assumption.
-  unfold co_interval in |- *; split.
+  rewrite SubEqui_P5; simpl; assumption.
+  unfold co_interval; split.
   rewrite SubEqui_P6.
   apply H5.
   assumption.
@@ -801,13 +799,13 @@ Qed.
 
 Lemma RiemannInt_P7 : forall (f:R -> R) (a:R), Riemann_integrable f a a.
 Proof.
-  unfold Riemann_integrable in |- *; intro f; intros;
+  unfold Riemann_integrable; intro f; intros;
     split with (mkStepFun (StepFun_P4 a a (f a)));
       split with (mkStepFun (StepFun_P4 a a 0)); split.
-  intros; simpl in |- *; unfold fct_cte in |- *; replace t with a.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; right;
+  intros; simpl; unfold fct_cte; replace t with a.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; right;
     reflexivity.
-  generalize H; unfold Rmin, Rmax in |- *; case (Rle_dec a a); intros; elim H0;
+  generalize H; unfold Rmin, Rmax; case (Rle_dec a a); intros; elim H0;
     intros; apply Rle_antisym; assumption.
   rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps).
 Qed.
@@ -828,9 +826,9 @@ Lemma RiemannInt_P8 :
     (pr2:Riemann_integrable f b a), RiemannInt pr1 = - RiemannInt pr2.
 Proof.
   intro f; intros; eapply UL_sequence.
-  unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv);
+  unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv);
     intros; apply u.
-  unfold RiemannInt in |- *; case (RiemannInt_exists pr2 RinvN RinvN_cv);
+  unfold RiemannInt; case (RiemannInt_exists pr2 RinvN RinvN_cv);
     intros;
       cut
         (exists psi1 : nat -> StepFun a b,
@@ -847,9 +845,9 @@ Proof.
           Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\
         Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
   intros; elim H; clear H; intros psi2 H; elim H0; clear H0; intros psi1 H0;
-    assert (H1 := RinvN_cv); unfold Un_cv in |- *; intros;
+    assert (H1 := RinvN_cv); unfold Un_cv; intros;
       assert (H3 : 0 < eps / 3).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   unfold Un_cv in H1; elim (H1 _ H3); clear H1; intros N0 H1;
     unfold R_dist in H1; simpl in H1;
@@ -857,10 +855,10 @@ Proof.
   intros; assert (H5 := H1 _ H4);
     replace (pos (RinvN n)) with (Rabs (/ (INR n + 1) - 0));
     [ assumption
-      | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+      | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
         left; apply (cond_pos (RinvN n)) ].
   clear H1; unfold Un_cv in u; elim (u _ H3); clear u; intros N1 H1;
-    exists (max N0 N1); intros; unfold R_dist in |- *;
+    exists (max N0 N1); intros; unfold R_dist;
       apply Rle_lt_trans with
         (Rabs
           (RiemannInt_SF (phi_sequence RinvN pr1 n) +
@@ -897,7 +895,7 @@ Proof.
       (mkStepFun
         (StepFun_P28 1 (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))).
   apply StepFun_P37; try assumption.
-  intros; simpl in |- *; rewrite Rmult_1_l;
+  intros; simpl; rewrite Rmult_1_l;
     apply Rle_trans with
       (Rabs (phi_sequence RinvN pr1 n x0 - f x0) +
         Rabs (f x0 - phi_sequence RinvN pr2 n x0)).
@@ -905,10 +903,10 @@ Proof.
   (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0));
   [ apply Rabs_triang | ring ].
   assert (H7 : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   assert (H8 : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   apply Rplus_le_compat.
   elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9;
@@ -921,7 +919,7 @@ Proof.
     [ apply RRle_abs
       | apply Rlt_trans with (pos (RinvN n));
         [ assumption
-          | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+          | apply H4; unfold ge; apply le_trans with (max N0 N1);
             [ apply le_max_l | assumption ] ] ].
   elim (H n); intros;
     rewrite <-
@@ -931,7 +929,7 @@ Proof.
           [ rewrite <- Rabs_Ropp; apply RRle_abs
             | apply Rlt_trans with (pos (RinvN n));
               [ assumption
-                | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+                | apply H4; unfold ge; apply le_trans with (max N0 N1);
                   [ apply le_max_l | assumption ] ] ].
   assert (Hyp : b <= a).
   auto with real.
@@ -950,7 +948,7 @@ Proof.
       (mkStepFun
         (StepFun_P28 1 (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))).
   apply StepFun_P37; try assumption.
-  intros; simpl in |- *; rewrite Rmult_1_l;
+  intros; simpl; rewrite Rmult_1_l;
     apply Rle_trans with
       (Rabs (phi_sequence RinvN pr1 n x0 - f x0) +
         Rabs (f x0 - phi_sequence RinvN pr2 n x0)).
@@ -958,10 +956,10 @@ Proof.
   (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0));
   [ apply Rabs_triang | ring ].
   assert (H7 : Rmin a b = b).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ elim n0; assumption | reflexivity ].
   assert (H8 : Rmax a b = a).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ elim n0; assumption | reflexivity ].
   apply Rplus_le_compat.
   elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9;
@@ -978,18 +976,18 @@ Proof.
           [ rewrite <- Rabs_Ropp; apply RRle_abs
             | apply Rlt_trans with (pos (RinvN n));
               [ assumption
-                | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+                | apply H4; unfold ge; apply le_trans with (max N0 N1);
                   [ apply le_max_l | assumption ] ] ].
   elim (H n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
     [ apply RRle_abs
       | apply Rlt_trans with (pos (RinvN n));
         [ assumption
-          | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+          | apply H4; unfold ge; apply le_trans with (max N0 N1);
             [ apply le_max_l | assumption ] ] ].
-  unfold R_dist in H1; apply H1; unfold ge in |- *;
+  unfold R_dist in H1; apply H1; unfold ge;
     apply le_trans with (max N0 N1); [ apply le_max_r | assumption ].
   apply Rmult_eq_reg_l with 3;
-    [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+    [ unfold Rdiv; rewrite Rmult_plus_distr_l;
       do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
         rewrite <- Rinv_l_sym; [ ring | discrR ]
       | discrR ].
@@ -1004,7 +1002,7 @@ Lemma RiemannInt_P9 :
   forall (f:R -> R) (a:R) (pr:Riemann_integrable f a a), RiemannInt pr = 0.
 Proof.
   intros; assert (H := RiemannInt_P8 pr pr); apply Rmult_eq_reg_l with 2;
-    [ rewrite Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2 in |- *;
+    [ rewrite Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2;
       rewrite H; apply Rplus_opp_r
       | discrR ].
 Qed.
@@ -1013,9 +1011,9 @@ Lemma Req_EM_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}.
 Proof.
   intros; elim (total_order_T r1 r2); intros;
     [ elim a; intro;
-      [ right; red in |- *; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0)
+      [ right; red; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0)
         | left; assumption ]
-      | right; red in |- *; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ].
+      | right; red; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ].
 Qed.
 
 (* L1([a,b]) is a vectorial space *)
@@ -1025,16 +1023,16 @@ Lemma RiemannInt_P10 :
     Riemann_integrable g a b ->
     Riemann_integrable (fun x:R => f x + l * g x) a b.
 Proof.
-  unfold Riemann_integrable in |- *; intros f g; intros; case (Req_EM_T l 0);
+  unfold Riemann_integrable; intros f g; intros; case (Req_EM_T l 0);
     intro.
   elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0;
     intros; split; try assumption; rewrite e; intros;
       rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption.
   assert (H : 0 < eps / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
   assert (H0 : 0 < eps / (2 * Rabs l)).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos eps)
       | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
         [ prove_sup0 | apply Rabs_pos_lt; assumption ] ].
@@ -1042,7 +1040,7 @@ Proof.
     split with (mkStepFun (StepFun_P28 l x x0)); elim p0;
       elim p; intros; split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2));
         elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split.
-  intros; simpl in |- *;
+  intros; simpl;
     apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))).
   replace (f t + l * g t - (x t + l * x0 t)) with
   (f t - x t + l * (g t - x0 t)); [ apply Rabs_triang | ring ].
@@ -1062,7 +1060,7 @@ Proof.
     [ rewrite Rmult_1_l;
       replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l));
       [ apply H2
-        | unfold Rdiv in |- *; rewrite Rinv_mult_distr;
+        | unfold Rdiv; rewrite Rinv_mult_distr;
           [ ring | discrR | apply Rabs_no_R0; assumption ] ]
       | apply Rabs_no_R0; assumption ].
 Qed.
@@ -1082,14 +1080,14 @@ Lemma RiemannInt_P11 :
     Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) l ->
     Un_cv (fun N:nat => RiemannInt_SF (phi2 N)) l.
 Proof.
-  unfold Un_cv in |- *; intro f; intros; intros.
+  unfold Un_cv; intro f; intros; intros.
   case (Rle_dec a b); intro Hyp.
   assert (H4 : 0 < eps / 3).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   elim (H _ H4); clear H; intros N0 H.
   elim (H2 _ H4); clear H2; intros N1 H2.
-  set (N := max N0 N1); exists N; intros; unfold R_dist in |- *.
+  set (N := max N0 N1); exists N; intros; unfold R_dist.
   apply Rle_lt_trans with
     (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) +
       Rabs (RiemannInt_SF (phi1 n) - l)).
@@ -1108,24 +1106,24 @@ Proof.
   apply StepFun_P34; assumption.
   apply Rle_lt_trans with
     (RiemannInt_SF (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))).
-  apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l.
+  apply StepFun_P37; try assumption; intros; simpl; rewrite Rmult_1_l.
   apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)).
   replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x));
   [ apply Rabs_triang | ring ].
   rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat.
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7.
   assert (H10 : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   assert (H11 : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
   elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   assert (H11 : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
   rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat.
@@ -1134,9 +1132,9 @@ Proof.
   apply RRle_abs.
   assumption.
   replace (pos (un n)) with (R_dist (un n) 0).
-  apply H; unfold ge in |- *; apply le_trans with N; try assumption.
-  unfold N in |- *; apply le_max_l.
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+  apply H; unfold ge; apply le_trans with N; try assumption.
+  unfold N; apply le_max_l.
+  unfold R_dist; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; apply Rabs_right.
   apply Rle_ge; left; apply (cond_pos (un n)).
   apply Rlt_trans with (pos (un n)).
@@ -1144,24 +1142,24 @@ Proof.
   apply RRle_abs; assumption.
   assumption.
   replace (pos (un n)) with (R_dist (un n) 0).
-  apply H; unfold ge in |- *; apply le_trans with N; try assumption;
-    unfold N in |- *; apply le_max_l.
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+  apply H; unfold ge; apply le_trans with N; try assumption;
+    unfold N; apply le_max_l.
+  unfold R_dist; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge;
       left; apply (cond_pos (un n)).
-  unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N;
-    try assumption; unfold N in |- *; apply le_max_r.
+  unfold R_dist in H2; apply H2; unfold ge; apply le_trans with N;
+    try assumption; unfold N; apply le_max_r.
   apply Rmult_eq_reg_l with 3;
-    [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+    [ unfold Rdiv; rewrite Rmult_plus_distr_l;
       do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
         rewrite <- Rinv_l_sym; [ ring | discrR ]
       | discrR ].
   assert (H4 : 0 < eps / 3).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   elim (H _ H4); clear H; intros N0 H.
   elim (H2 _ H4); clear H2; intros N1 H2.
-  set (N := max N0 N1); exists N; intros; unfold R_dist in |- *.
+  set (N := max N0 N1); exists N; intros; unfold R_dist.
   apply Rle_lt_trans with
     (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) +
       Rabs (RiemannInt_SF (phi1 n) - l)).
@@ -1191,24 +1189,24 @@ Proof.
       (mkStepFun
         (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))).
   apply StepFun_P37; try assumption.
-  intros; simpl in |- *; rewrite Rmult_1_l.
+  intros; simpl; rewrite Rmult_1_l.
   apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)).
   replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x));
   [ apply Rabs_triang | ring ].
   rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat.
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7.
   assert (H10 : Rmin a b = b).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ elim Hyp; assumption | reflexivity ].
   assert (H11 : Rmax a b = a).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ elim Hyp; assumption | reflexivity ].
   rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
   elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = b).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ elim Hyp; assumption | reflexivity ].
   assert (H11 : Rmax a b = a).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ elim Hyp; assumption | reflexivity ].
   rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
   rewrite <-
@@ -1226,9 +1224,9 @@ Proof.
   rewrite <- Rabs_Ropp; apply RRle_abs.
   assumption.
   replace (pos (un n)) with (R_dist (un n) 0).
-  apply H; unfold ge in |- *; apply le_trans with N; try assumption.
-  unfold N in |- *; apply le_max_l.
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+  apply H; unfold ge; apply le_trans with N; try assumption.
+  unfold N; apply le_max_l.
+  unfold R_dist; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; apply Rabs_right.
   apply Rle_ge; left; apply (cond_pos (un n)).
   apply Rlt_trans with (pos (un n)).
@@ -1236,15 +1234,15 @@ Proof.
   rewrite <- Rabs_Ropp; apply RRle_abs; assumption.
   assumption.
   replace (pos (un n)) with (R_dist (un n) 0).
-  apply H; unfold ge in |- *; apply le_trans with N; try assumption;
-    unfold N in |- *; apply le_max_l.
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+  apply H; unfold ge; apply le_trans with N; try assumption;
+    unfold N; apply le_max_l.
+  unfold R_dist; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge;
       left; apply (cond_pos (un n)).
-  unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N;
-    try assumption; unfold N in |- *; apply le_max_r.
+  unfold R_dist in H2; apply H2; unfold ge; apply le_trans with N;
+    try assumption; unfold N; apply le_max_r.
   apply Rmult_eq_reg_l with 3;
-    [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+    [ unfold Rdiv; rewrite Rmult_plus_distr_l;
       do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
         rewrite <- Rinv_l_sym; [ ring | discrR ]
       | discrR ].
@@ -1257,8 +1255,8 @@ Lemma RiemannInt_P12 :
     a <= b -> RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2.
 Proof.
   intro f; intros; case (Req_dec l 0); intro.
-  pattern l at 2 in |- *; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r;
-    unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv);
+  pattern l at 2; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r;
+    unfold RiemannInt; case (RiemannInt_exists pr3 RinvN RinvN_cv);
       case (RiemannInt_exists pr1 RinvN RinvN_cv); intros;
         eapply UL_sequence;
           [ apply u0
@@ -1280,18 +1278,18 @@ Proof.
                             [ apply H2; assumption | rewrite H0; ring ] ]
                     | assumption ] ].
   eapply UL_sequence.
-  unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv);
+  unfold RiemannInt; case (RiemannInt_exists pr3 RinvN RinvN_cv);
     intros; apply u.
-  unfold Un_cv in |- *; intros; unfold RiemannInt in |- *;
+  unfold Un_cv; intros; unfold RiemannInt;
     case (RiemannInt_exists pr1 RinvN RinvN_cv);
-    case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *;
+    case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv;
       intros; assert (H2 : 0 < eps / 5).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv);
     unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4;
       assert (H5 : 0 < eps / (5 * Rabs l)).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption
       | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
         [ prove_sup0 | apply Rabs_pos_lt; assumption ] ].
@@ -1300,17 +1298,17 @@ Proof.
       unfold R_dist in H3, H4, H5, H6; set (N := max (max N0 N1) (max N2 N3)).
   assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5).
   intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0));
-    [ unfold RinvN in |- *; apply H4; assumption
-      | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+    [ unfold RinvN; apply H4; assumption
+      | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
         left; apply (cond_pos (RinvN n)) ].
   clear H4; assert (H4 := H7); clear H7;
     assert (H7 : forall n:nat, (n >= N3)%nat -> RinvN n < eps / (5 * Rabs l)).
   intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0));
-    [ unfold RinvN in |- *; apply H5; assumption
-      | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+    [ unfold RinvN; apply H5; assumption
+      | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
         left; apply (cond_pos (RinvN n)) ].
   clear H5; assert (H5 := H7); clear H7; exists N; intros;
-    unfold R_dist in |- *.
+    unfold R_dist.
   apply Rle_lt_trans with
     (Rabs
       (RiemannInt_SF (phi_sequence RinvN pr3 n) -
@@ -1383,10 +1381,10 @@ Proof.
         (RiemannInt_SF (phi_sequence RinvN pr1 n) +
           l * RiemannInt_SF (phi_sequence RinvN pr2 n)));
       [ idtac | ring ]; do 2 rewrite <- StepFun_P30; assert (H10 : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   assert (H11 : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   rewrite H10 in H7; rewrite H10 in H8; rewrite H10 in H9; rewrite H11 in H7;
     rewrite H11 in H8; rewrite H11 in H9;
@@ -1406,7 +1404,7 @@ Proof.
         (StepFun_P28 1 (psi3 n)
           (mkStepFun (StepFun_P28 (Rabs l) (psi1 n) (psi2 n)))))).
   apply StepFun_P37; try assumption.
-  intros; simpl in |- *; rewrite Rmult_1_l.
+  intros; simpl; rewrite Rmult_1_l.
   apply Rle_trans with
     (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) +
       Rabs
@@ -1446,16 +1444,16 @@ Proof.
   apply Rlt_trans with (pos (RinvN n));
     [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n)));
       [ apply RRle_abs | elim (H9 n); intros; assumption ]
-      | apply H4; unfold ge in |- *; apply le_trans with N;
+      | apply H4; unfold ge; apply le_trans with N;
         [ apply le_trans with (max N0 N1);
-          [ apply le_max_r | unfold N in |- *; apply le_max_l ]
+          [ apply le_max_r | unfold N; apply le_max_l ]
           | assumption ] ].
   apply Rlt_trans with (pos (RinvN n));
     [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
       [ apply RRle_abs | elim (H7 n); intros; assumption ]
-      | apply H4; unfold ge in |- *; apply le_trans with N;
+      | apply H4; unfold ge; apply le_trans with N;
         [ apply le_trans with (max N0 N1);
-          [ apply le_max_r | unfold N in |- *; apply le_max_l ]
+          [ apply le_max_r | unfold N; apply le_max_l ]
           | assumption ] ].
   apply Rmult_lt_reg_l with (/ Rabs l).
   apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
@@ -1464,28 +1462,28 @@ Proof.
   apply Rlt_trans with (pos (RinvN n));
     [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
       [ apply RRle_abs | elim (H8 n); intros; assumption ]
-      | apply H5; unfold ge in |- *; apply le_trans with N;
+      | apply H5; unfold ge; apply le_trans with N;
         [ apply le_trans with (max N2 N3);
-          [ apply le_max_r | unfold N in |- *; apply le_max_r ]
+          [ apply le_max_r | unfold N; apply le_max_r ]
           | assumption ] ].
-  unfold Rdiv in |- *; rewrite Rinv_mult_distr;
+  unfold Rdiv; rewrite Rinv_mult_distr;
     [ ring | discrR | apply Rabs_no_R0; assumption ].
   apply Rabs_no_R0; assumption.
-  apply H3; unfold ge in |- *; apply le_trans with (max N0 N1);
+  apply H3; unfold ge; apply le_trans with (max N0 N1);
     [ apply le_max_l
-      | apply le_trans with N; [ unfold N in |- *; apply le_max_l | assumption ] ].
+      | apply le_trans with N; [ unfold N; apply le_max_l | assumption ] ].
   apply Rmult_lt_reg_l with (/ Rabs l).
   apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
   rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)).
-  apply H6; unfold ge in |- *; apply le_trans with (max N2 N3);
+  apply H6; unfold ge; apply le_trans with (max N2 N3);
     [ apply le_max_l
-      | apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ] ].
-  unfold Rdiv in |- *; rewrite Rinv_mult_distr;
+      | apply le_trans with N; [ unfold N; apply le_max_r | assumption ] ].
+  unfold Rdiv; rewrite Rinv_mult_distr;
     [ ring | discrR | apply Rabs_no_R0; assumption ].
   apply Rabs_no_R0; assumption.
   apply Rmult_eq_reg_l with 5;
-    [ unfold Rdiv in |- *; do 2 rewrite Rmult_plus_distr_l;
+    [ unfold Rdiv; do 2 rewrite Rmult_plus_distr_l;
       do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc;
         rewrite <- Rinv_l_sym; [ ring | discrR ]
       | discrR ].
@@ -1502,11 +1500,11 @@ Proof.
       | assert (H : b <= a);
         [ auto with real
           | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3));
-            [ idtac | symmetry  in |- *; apply RiemannInt_P8 ];
+            [ idtac | symmetry ; apply RiemannInt_P8 ];
             replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2));
-            [ idtac | symmetry  in |- *; apply RiemannInt_P8 ];
+            [ idtac | symmetry ; apply RiemannInt_P8 ];
             replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1));
-            [ idtac | symmetry  in |- *; apply RiemannInt_P8 ];
+            [ idtac | symmetry ; apply RiemannInt_P8 ];
             rewrite
               (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2)
                 (RiemannInt_P1 pr3) H); ring ] ].
@@ -1514,11 +1512,11 @@ Qed.
 
 Lemma RiemannInt_P14 : forall a b c:R, Riemann_integrable (fct_cte c) a b.
 Proof.
-  unfold Riemann_integrable in |- *; intros;
+  unfold Riemann_integrable; intros;
     split with (mkStepFun (StepFun_P4 a b c));
       split with (mkStepFun (StepFun_P4 a b 0)); split;
-        [ intros; simpl in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
-          rewrite Rabs_R0; unfold fct_cte in |- *; right;
+        [ intros; simpl; unfold Rminus; rewrite Rplus_opp_r;
+          rewrite Rabs_R0; unfold fct_cte; right;
             reflexivity
           | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0;
             apply (cond_pos eps) ].
@@ -1528,11 +1526,11 @@ Lemma RiemannInt_P15 :
   forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b),
     RiemannInt pr = c * (b - a).
 Proof.
-  intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr RinvN RinvN_cv);
+  intros; unfold RiemannInt; case (RiemannInt_exists pr RinvN RinvN_cv);
     intros; eapply UL_sequence.
   apply u.
   set (phi1 := fun N:nat => phi_sequence RinvN pr N);
-    change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))) in |- *;
+    change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a)));
       set (f := fct_cte c);
         assert
           (H1 :
@@ -1551,13 +1549,13 @@ Proof.
           try assumption.
   apply RinvN_cv.
   intro; split.
-  intros; unfold f in |- *; simpl in |- *; unfold Rminus in |- *;
-    rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *;
+  intros; unfold f; simpl; unfold Rminus;
+    rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte;
       right; reflexivity.
-  unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0;
+  unfold psi2; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0;
     apply (cond_pos (RinvN n)).
-  unfold Un_cv in |- *; intros; split with 0%nat; intros; unfold R_dist in |- *;
-    unfold phi2 in |- *; rewrite StepFun_P18; unfold Rminus in |- *;
+  unfold Un_cv; intros; split with 0%nat; intros; unfold R_dist;
+    unfold phi2; rewrite StepFun_P18; unfold Rminus;
       rewrite Rplus_opp_r; rewrite Rabs_R0; apply H.
 Qed.
 
@@ -1565,9 +1563,9 @@ Lemma RiemannInt_P16 :
   forall (f:R -> R) (a b:R),
     Riemann_integrable f a b -> Riemann_integrable (fun x:R => Rabs (f x)) a b.
 Proof.
-  unfold Riemann_integrable in |- *; intro f; intros; elim (X eps); clear X;
+  unfold Riemann_integrable; intro f; intros; elim (X eps); clear X;
     intros phi [psi [H H0]]; split with (mkStepFun (StepFun_P32 phi));
-      split with psi; split; try assumption; intros; simpl in |- *;
+      split with psi; split; try assumption; intros; simpl;
         apply Rle_trans with (Rabs (f t - phi t));
           [ apply Rabs_triang_inv2 | apply H; assumption ].
 Qed.
@@ -1581,9 +1579,9 @@ Proof.
   assert (H2 : l2 < l1).
   auto with real.
   clear n; assert (H3 : 0 < (l1 - l2) / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply Rlt_Rminus; assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-  elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist in |- *; intros;
+  elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist; intros;
     set (N := max x x0); cut (Vn N < Un N).
   intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)).
   apply Rlt_trans with ((l1 + l2) / 2).
@@ -1591,9 +1589,9 @@ Proof.
     replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2).
   rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)).
   apply RRle_abs.
-  apply H1; unfold ge in |- *; unfold N in |- *; apply le_max_r.
+  apply H1; unfold ge; unfold N; apply le_max_r.
   apply Rmult_eq_reg_l with 2;
-    [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2);
+    [ unfold Rdiv; do 2 rewrite (Rmult_comm 2);
       rewrite (Rmult_plus_distr_r (- l2) ((l1 + l2) * / 2) 2);
         repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
           [ ring | discrR ]
@@ -1602,9 +1600,9 @@ Proof.
     replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2).
   apply Rle_lt_trans with (Rabs (Un N - l1)).
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
-  apply H0; unfold ge in |- *; unfold N in |- *; apply le_max_l.
+  apply H0; unfold ge; unfold N; apply le_max_l.
   apply Rmult_eq_reg_l with 2;
-    [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2);
+    [ unfold Rdiv; do 2 rewrite (Rmult_comm 2);
       rewrite (Rmult_plus_distr_r l1 (- ((l1 + l2) * / 2)) 2);
         rewrite <- Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
           rewrite <- Rinv_l_sym; [ ring | discrR ]
@@ -1616,7 +1614,7 @@ Lemma RiemannInt_P17 :
     (pr2:Riemann_integrable (fun x:R => Rabs (f x)) a b),
     a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2.
 Proof.
-  intro f; intros; unfold RiemannInt in |- *;
+  intro f; intros; unfold RiemannInt;
     case (RiemannInt_exists pr1 RinvN RinvN_cv);
     case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
       set (phi1 := phi_sequence RinvN pr1) in u0;
@@ -1624,7 +1622,7 @@ Proof.
           apply Rle_cv_lim with
             (fun N:nat => Rabs (RiemannInt_SF (phi1 N)))
             (fun N:nat => RiemannInt_SF (phi2 N)).
-  intro; unfold phi2 in |- *; apply StepFun_P34; assumption.
+  intro; unfold phi2; apply StepFun_P34; assumption.
   apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0);
     try assumption.
   apply Rcontinuity_abs.
@@ -1658,7 +1656,7 @@ Proof.
     apply (proj2_sig (phi_sequence_prop RinvN pr1 n)).
   elim H1; clear H1; intros psi2 H1; split with psi2; intros; elim (H1 n);
     clear H1; intros; split; try assumption.
-  intros; unfold phi2 in |- *; simpl in |- *;
+  intros; unfold phi2; simpl;
     apply Rle_trans with (Rabs (f t - phi1 n t)).
   apply Rabs_triang_inv2.
   apply H1; assumption.
@@ -1673,13 +1671,13 @@ Lemma RiemannInt_P18 :
     a <= b ->
     (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2.
 Proof.
-  intro f; intros; unfold RiemannInt in |- *;
+  intro f; intros; unfold RiemannInt;
     case (RiemannInt_exists pr1 RinvN RinvN_cv);
     case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
       eapply UL_sequence.
   apply u0.
   set (phi1 := fun N:nat => phi_sequence RinvN pr1 N);
-    change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x) in |- *;
+    change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x);
       assert
         (H1 :
           exists psi1 : nat -> StepFun a b,
@@ -1719,45 +1717,45 @@ Proof.
       try assumption.
   apply RinvN_cv.
   intro; elim (H2 n); intros; split; try assumption.
-  intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
+  intros; unfold phi2_m; simpl; unfold phi2_aux;
     case (Req_EM_T t a); case (Req_EM_T t b); intros.
-  rewrite e0; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  rewrite e0; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     apply Rle_trans with (Rabs (g t - phi2 n t)).
   apply Rabs_pos.
-  pattern a at 3 in |- *; rewrite <- e0; apply H3; assumption.
-  rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  pattern a at 3; rewrite <- e0; apply H3; assumption.
+  rewrite e; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     apply Rle_trans with (Rabs (g t - phi2 n t)).
   apply Rabs_pos.
-  pattern a at 3 in |- *; rewrite <- e; apply H3; assumption.
-  rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  pattern a at 3; rewrite <- e; apply H3; assumption.
+  rewrite e; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     apply Rle_trans with (Rabs (g t - phi2 n t)).
   apply Rabs_pos.
-  pattern b at 3 in |- *; rewrite <- e; apply H3; assumption.
+  pattern b at 3; rewrite <- e; apply H3; assumption.
   replace (f t) with (g t).
   apply H3; assumption.
-  symmetry  in |- *; apply H0; elim H5; clear H5; intros.
+  symmetry ; apply H0; elim H5; clear H5; intros.
   assert (H7 : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n2; assumption ].
   assert (H8 : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n2; assumption ].
   rewrite H7 in H5; rewrite H8 in H6; split.
-  elim H5; intro; [ assumption | elim n1; symmetry  in |- *; assumption ].
+  elim H5; intro; [ assumption | elim n1; symmetry ; assumption ].
   elim H6; intro; [ assumption | elim n0; assumption ].
   cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)).
-  intro; unfold Un_cv in |- *; intros; elim (u _ H4); intros; exists x1; intros;
+  intro; unfold Un_cv; intros; elim (u _ H4); intros; exists x1; intros;
     rewrite (H3 n); apply H5; assumption.
   intro; apply Rle_antisym.
   apply StepFun_P37; try assumption.
-  intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
+  intros; unfold phi2_m; simpl; unfold phi2_aux;
     case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
   elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
   elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
   elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5).
   right; reflexivity.
   apply StepFun_P37; try assumption.
-  intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
+  intros; unfold phi2_m; simpl; unfold phi2_aux;
     case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
   elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
   elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
@@ -1766,10 +1764,10 @@ Proof.
   intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2;
     unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2];
       split with l; split with lf; unfold adapted_couple in H2;
-        decompose [and] H2; clear H2; unfold adapted_couple in |- *;
+        decompose [and] H2; clear H2; unfold adapted_couple;
           repeat split; try assumption.
   intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9;
-    unfold constant_D_eq, open_interval in |- *; intros;
+    unfold constant_D_eq, open_interval; intros;
       rewrite <- (H9 x1 H7); assert (H10 : a <= pos_Rl l i).
   replace a with (Rmin a b).
   rewrite <- H5; elim (RList_P6 l); intros; apply H10.
@@ -1777,7 +1775,7 @@ Proof.
   apply le_O_n.
   apply lt_trans with (pred (Rlength l)); [ assumption | apply lt_pred_n_n ].
   apply neq_O_lt; intro; rewrite <- H12 in H6; discriminate.
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   assert (H11 : pos_Rl l (S i) <= b).
   replace b with (Rmax a b).
@@ -1785,9 +1783,9 @@ Proof.
   assumption.
   apply lt_le_S; assumption.
   apply lt_pred_n_n; apply neq_O_lt; intro; rewrite <- H13 in H6; discriminate.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
-  elim H7; clear H7; intros; unfold phi2_aux in |- *; case (Req_EM_T x1 a);
+  elim H7; clear H7; intros; unfold phi2_aux; case (Req_EM_T x1 a);
     case (Req_EM_T x1 b); intros.
   rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
   rewrite e in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)).
@@ -1854,12 +1852,12 @@ Proof.
   intros; replace (primitive h pr a) with 0.
   replace (RiemannInt pr0) with (primitive h pr b).
   ring.
-  unfold primitive in |- *; case (Rle_dec a b); case (Rle_dec b b); intros;
+  unfold primitive; case (Rle_dec a b); case (Rle_dec b b); intros;
     [ apply RiemannInt_P5
       | elim n; right; reflexivity
       | elim n; assumption
       | elim n0; assumption ].
-  symmetry  in |- *; unfold primitive in |- *; case (Rle_dec a a);
+  symmetry ; unfold primitive; case (Rle_dec a a);
     case (Rle_dec a b); intros;
       [ apply RiemannInt_P9
         | elim n; assumption
@@ -1874,9 +1872,9 @@ Lemma RiemannInt_P21 :
     Riemann_integrable f a b ->
     Riemann_integrable f b c -> Riemann_integrable f a c.
 Proof.
-  unfold Riemann_integrable in |- *; intros f a b c Hyp1 Hyp2 X X0 eps.
+  unfold Riemann_integrable; intros f a b c Hyp1 Hyp2 X X0 eps.
   assert (H : 0 < eps / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
   elim (X (mkposreal _ H)); clear X; intros phi1 [psi1 H1];
     elim (X0 (mkposreal _ H)); clear X0; intros phi2 [psi2 H2].
@@ -1906,35 +1904,35 @@ Proof.
   intro; cut (IsStepFun psi3 a b).
   intro; cut (IsStepFun psi3 b c).
   intro; cut (IsStepFun psi3 a c).
-  intro; split with (mkStepFun X); split with (mkStepFun X2); simpl in |- *;
+  intro; split with (mkStepFun X); split with (mkStepFun X2); simpl;
     split.
-  intros; unfold phi3, psi3 in |- *; case (Rle_dec t b); case (Rle_dec a t);
+  intros; unfold phi3, psi3; case (Rle_dec t b); case (Rle_dec a t);
     intros.
   elim H1; intros; apply H3.
   replace (Rmin a b) with a.
   replace (Rmax a b) with b.
   split; assumption.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   elim n; replace a with (Rmin a c).
   elim H0; intros; assumption.
-  unfold Rmin in |- *; case (Rle_dec a c); intro;
+  unfold Rmin; case (Rle_dec a c); intro;
     [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
   elim H2; intros; apply H3.
   replace (Rmax b c) with (Rmax a c).
   elim H0; intros; split; try assumption.
   replace (Rmin b c) with b.
   auto with real.
-  unfold Rmin in |- *; case (Rle_dec b c); intro;
+  unfold Rmin; case (Rle_dec b c); intro;
     [ reflexivity | elim n0; assumption ].
-  unfold Rmax in |- *; case (Rle_dec a c); case (Rle_dec b c); intros;
+  unfold Rmax; case (Rle_dec a c); case (Rle_dec b c); intros;
     try (elim n0; assumption || elim n0; apply Rle_trans with b; assumption).
   reflexivity.
   elim n; replace a with (Rmin a c).
   elim H0; intros; assumption.
-  unfold Rmin in |- *; case (Rle_dec a c); intro;
+  unfold Rmin; case (Rle_dec a c); intro;
     [ reflexivity | elim n1; apply Rle_trans with b; assumption ].
   rewrite <- (StepFun_P43 X0 X1 X2).
   apply Rle_lt_trans with
@@ -1948,14 +1946,14 @@ Proof.
   elim H2; intros; assumption.
   apply Rle_antisym.
   apply StepFun_P37; try assumption.
-  simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+  simpl; intros; unfold psi3; elim H0; clear H0; intros;
     case (Rle_dec a x); case (Rle_dec x b); intros;
       [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
         | right; reflexivity
         | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
         | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
   apply StepFun_P37; try assumption.
-  simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+  simpl; intros; unfold psi3; elim H0; clear H0; intros;
     case (Rle_dec a x); case (Rle_dec x b); intros;
       [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
         | right; reflexivity
@@ -1963,14 +1961,14 @@ Proof.
         | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
   apply Rle_antisym.
   apply StepFun_P37; try assumption.
-  simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+  simpl; intros; unfold psi3; elim H0; clear H0; intros;
     case (Rle_dec a x); case (Rle_dec x b); intros;
       [ right; reflexivity
         | elim n; left; assumption
         | elim n; left; assumption
         | elim n0; left; assumption ].
   apply StepFun_P37; try assumption.
-  simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+  simpl; intros; unfold psi3; elim H0; clear H0; intros;
     case (Rle_dec a x); case (Rle_dec x b); intros;
       [ right; reflexivity
         | elim n; left; assumption
@@ -1980,19 +1978,19 @@ Proof.
   assert (H3 := pre psi2); unfold IsStepFun in H3; unfold is_subdivision in H3;
     elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
       split with lf1; unfold adapted_couple in H3; decompose [and] H3;
-        clear H3; unfold adapted_couple in |- *; repeat split;
+        clear H3; unfold adapted_couple; repeat split;
           try assumption.
-  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval;
     unfold constant_D_eq, open_interval in H9; intros;
-      rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x).
+      rewrite <- (H9 x H7); unfold psi3; assert (H10 : b < x).
   apply Rle_lt_trans with (pos_Rl l1 i).
   replace b with (Rmin b c).
   rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption.
   apply le_O_n.
   apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
-    apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+    apply neq_O_lt; red; intro; rewrite <- H12 in H6;
       discriminate.
-  unfold Rmin in |- *; case (Rle_dec b c); intro;
+  unfold Rmin; case (Rle_dec b c); intro;
     [ reflexivity | elim n; assumption ].
   elim H7; intros; assumption.
   case (Rle_dec a x); case (Rle_dec x b); intros;
@@ -2003,18 +2001,18 @@ Proof.
   assert (H3 := pre psi1); unfold IsStepFun in H3; unfold is_subdivision in H3;
     elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
       split with lf1; unfold adapted_couple in H3; decompose [and] H3;
-        clear H3; unfold adapted_couple in |- *; repeat split;
+        clear H3; unfold adapted_couple; repeat split;
           try assumption.
-  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval;
     unfold constant_D_eq, open_interval in H9; intros;
-      rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b).
+      rewrite <- (H9 x H7); unfold psi3; assert (H10 : x <= b).
   apply Rle_trans with (pos_Rl l1 (S i)).
   elim H7; intros; left; assumption.
   replace b with (Rmax a b).
   rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
-  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+  apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H12 in H6;
     discriminate.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   assert (H11 : a <= x).
   apply Rle_trans with (pos_Rl l1 i).
@@ -2022,9 +2020,9 @@ Proof.
   rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption.
   apply le_O_n.
   apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
-    apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6;
+    apply neq_O_lt; red; intro; rewrite <- H13 in H6;
       discriminate.
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   left; elim H7; intros; assumption.
   case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n;
@@ -2033,18 +2031,18 @@ Proof.
   assert (H3 := pre phi1); unfold IsStepFun in H3; unfold is_subdivision in H3;
     elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
       split with lf1; unfold adapted_couple in H3; decompose [and] H3;
-        clear H3; unfold adapted_couple in |- *; repeat split;
+        clear H3; unfold adapted_couple; repeat split;
           try assumption.
-  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval;
     unfold constant_D_eq, open_interval in H9; intros;
-      rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b).
+      rewrite <- (H9 x H7); unfold psi3; assert (H10 : x <= b).
   apply Rle_trans with (pos_Rl l1 (S i)).
   elim H7; intros; left; assumption.
   replace b with (Rmax a b).
   rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
-  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+  apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H12 in H6;
     discriminate.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   assert (H11 : a <= x).
   apply Rle_trans with (pos_Rl l1 i).
@@ -2052,32 +2050,32 @@ Proof.
   rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption.
   apply le_O_n.
   apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
-    apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6;
+    apply neq_O_lt; red; intro; rewrite <- H13 in H6;
       discriminate.
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   left; elim H7; intros; assumption.
-  unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros;
+  unfold phi3; case (Rle_dec a x); case (Rle_dec x b); intros;
     reflexivity || elim n; assumption.
   assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3;
     elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
       split with lf1; unfold adapted_couple in H3; decompose [and] H3;
-        clear H3; unfold adapted_couple in |- *; repeat split;
+        clear H3; unfold adapted_couple; repeat split;
           try assumption.
-  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval;
     unfold constant_D_eq, open_interval in H9; intros;
-      rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x).
+      rewrite <- (H9 x H7); unfold psi3; assert (H10 : b < x).
   apply Rle_lt_trans with (pos_Rl l1 i).
   replace b with (Rmin b c).
   rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption.
   apply le_O_n.
   apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
-    apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+    apply neq_O_lt; red; intro; rewrite <- H12 in H6;
       discriminate.
-  unfold Rmin in |- *; case (Rle_dec b c); intro;
+  unfold Rmin; case (Rle_dec b c); intro;
     [ reflexivity | elim n; assumption ].
   elim H7; intros; assumption.
-  unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros;
+  unfold phi3; case (Rle_dec a x); case (Rle_dec x b); intros;
     [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10))
       | reflexivity
       | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
@@ -2088,7 +2086,7 @@ Lemma RiemannInt_P22 :
   forall (f:R -> R) (a b c:R),
     Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c.
 Proof.
-  unfold Riemann_integrable in |- *; intros; elim (X eps); clear X;
+  unfold Riemann_integrable; intros; elim (X eps); clear X;
     intros phi [psi H0]; elim H; elim H0; clear H H0;
       intros; assert (H3 : IsStepFun phi a c).
   apply StepFun_P44 with b.
@@ -2099,18 +2097,18 @@ Proof.
   apply (pre psi).
   split; assumption.
   split with (mkStepFun H3); split with (mkStepFun H4); split.
-  simpl in |- *; intros; apply H.
+  simpl; intros; apply H.
   replace (Rmin a b) with (Rmin a c).
   elim H5; intros; split; try assumption.
   apply Rle_trans with (Rmax a c); try assumption.
   replace (Rmax a b) with b.
   replace (Rmax a c) with c.
   assumption.
-  unfold Rmax in |- *; case (Rle_dec a c); intro;
+  unfold Rmax; case (Rle_dec a c); intro;
     [ reflexivity | elim n; assumption ].
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-  unfold Rmin in |- *; case (Rle_dec a c); case (Rle_dec a b); intros;
+  unfold Rmin; case (Rle_dec a c); case (Rle_dec a b); intros;
     [ reflexivity
       | elim n; apply Rle_trans with c; assumption
       | elim n; assumption
@@ -2123,12 +2121,12 @@ Proof.
   replace (RiemannInt_SF (mkStepFun H4)) with
   (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)).
   apply Rle_lt_trans with (RiemannInt_SF psi).
-  unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *;
+  unfold Rminus; pattern (RiemannInt_SF psi) at 2;
     rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0;
       apply Ropp_ge_le_contravar; apply Rle_ge;
         replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))).
   apply StepFun_P37; try assumption.
-  intros; simpl in |- *; unfold fct_cte in |- *;
+  intros; simpl; unfold fct_cte;
     apply Rle_trans with (Rabs (f x - phi x)).
   apply Rabs_pos.
   apply H.
@@ -2137,9 +2135,9 @@ Proof.
   elim H6; intros; split; left.
   apply Rle_lt_trans with c; assumption.
   assumption.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
   rewrite StepFun_P18; ring.
   apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
@@ -2149,16 +2147,16 @@ Proof.
   apply (pre psi).
   replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
   rewrite <- (StepFun_P43 H4 H5 H6); ring.
-  unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+  unfold RiemannInt_SF; case (Rle_dec a b); intro.
   eapply StepFun_P17.
   apply StepFun_P1.
-  simpl in |- *; apply StepFun_P1.
+  simpl; apply StepFun_P1.
   apply Ropp_eq_compat; eapply StepFun_P17.
   apply StepFun_P1.
-  simpl in |- *; apply StepFun_P1.
+  simpl; apply StepFun_P1.
   apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))).
   apply StepFun_P37; try assumption.
-  intros; simpl in |- *; unfold fct_cte in |- *;
+  intros; simpl; unfold fct_cte;
     apply Rle_trans with (Rabs (f x - phi x)).
   apply Rabs_pos.
   apply H.
@@ -2167,9 +2165,9 @@ Proof.
   elim H5; intros; split; left.
   assumption.
   apply Rlt_le_trans with c; assumption.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
   rewrite StepFun_P18; ring.
 Qed.
@@ -2178,7 +2176,7 @@ Lemma RiemannInt_P23 :
   forall (f:R -> R) (a b c:R),
     Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b.
 Proof.
-  unfold Riemann_integrable in |- *; intros; elim (X eps); clear X;
+  unfold Riemann_integrable; intros; elim (X eps); clear X;
     intros phi [psi H0]; elim H; elim H0; clear H H0;
       intros; assert (H3 : IsStepFun phi c b).
   apply StepFun_P45 with a.
@@ -2189,18 +2187,18 @@ Proof.
   apply (pre psi).
   split; assumption.
   split with (mkStepFun H3); split with (mkStepFun H4); split.
-  simpl in |- *; intros; apply H.
+  simpl; intros; apply H.
   replace (Rmax a b) with (Rmax c b).
   elim H5; intros; split; try assumption.
   apply Rle_trans with (Rmin c b); try assumption.
   replace (Rmin a b) with a.
   replace (Rmin c b) with c.
   assumption.
-  unfold Rmin in |- *; case (Rle_dec c b); intro;
+  unfold Rmin; case (Rle_dec c b); intro;
     [ reflexivity | elim n; assumption ].
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-  unfold Rmax in |- *; case (Rle_dec c b); case (Rle_dec a b); intros;
+  unfold Rmax; case (Rle_dec c b); case (Rle_dec a b); intros;
     [ reflexivity
       | elim n; apply Rle_trans with c; assumption
       | elim n; assumption
@@ -2213,12 +2211,12 @@ Proof.
   replace (RiemannInt_SF (mkStepFun H4)) with
   (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)).
   apply Rle_lt_trans with (RiemannInt_SF psi).
-  unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *;
+  unfold Rminus; pattern (RiemannInt_SF psi) at 2;
     rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0;
       apply Ropp_ge_le_contravar; apply Rle_ge;
         replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))).
   apply StepFun_P37; try assumption.
-  intros; simpl in |- *; unfold fct_cte in |- *;
+  intros; simpl; unfold fct_cte;
     apply Rle_trans with (Rabs (f x - phi x)).
   apply Rabs_pos.
   apply H.
@@ -2227,9 +2225,9 @@ Proof.
   elim H6; intros; split; left.
   assumption.
   apply Rlt_le_trans with c; assumption.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
   rewrite StepFun_P18; ring.
   apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
@@ -2239,16 +2237,16 @@ Proof.
   apply (pre psi).
   replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
   rewrite <- (StepFun_P43 H5 H4 H6); ring.
-  unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+  unfold RiemannInt_SF; case (Rle_dec a b); intro.
   eapply StepFun_P17.
   apply StepFun_P1.
-  simpl in |- *; apply StepFun_P1.
+  simpl; apply StepFun_P1.
   apply Ropp_eq_compat; eapply StepFun_P17.
   apply StepFun_P1.
-  simpl in |- *; apply StepFun_P1.
+  simpl; apply StepFun_P1.
   apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))).
   apply StepFun_P37; try assumption.
-  intros; simpl in |- *; unfold fct_cte in |- *;
+  intros; simpl; unfold fct_cte;
     apply Rle_trans with (Rabs (f x - phi x)).
   apply Rabs_pos.
   apply H.
@@ -2257,9 +2255,9 @@ Proof.
   elim H5; intros; split; left.
   apply Rle_lt_trans with c; assumption.
   assumption.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; apply Rle_trans with c; assumption ].
   rewrite StepFun_P18; ring.
 Qed.
@@ -2292,14 +2290,14 @@ Lemma RiemannInt_P25 :
     (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c),
     a <= b -> b <= c -> RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3.
 Proof.
-  intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt in |- *;
+  intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt;
     case (RiemannInt_exists pr1 RinvN RinvN_cv);
     case (RiemannInt_exists pr2 RinvN RinvN_cv);
     case (RiemannInt_exists pr3 RinvN RinvN_cv); intros;
-      symmetry  in |- *; eapply UL_sequence.
+      symmetry ; eapply UL_sequence.
   apply u.
-  unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Un_cv; intros; assert (H0 : 0 < eps / 3).
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   elim (u1 _ H0); clear u1; intros N1 H1; elim (u0 _ H0); clear u0;
     intros N2 H2;
@@ -2311,7 +2309,7 @@ Proof.
               RiemannInt_SF (phi_sequence RinvN pr2 n))) 0).
   intro; elim (H3 _ H0); clear H3; intros N3 H3;
     set (N0 := max (max N1 N2) N3); exists N0; intros;
-      unfold R_dist in |- *;
+      unfold R_dist;
         apply Rle_lt_trans with
           (Rabs
             (RiemannInt_SF (phi_sequence RinvN pr3 n) -
@@ -2332,8 +2330,8 @@ Proof.
   unfold R_dist in H3; cut (n >= N3)%nat.
   intro; assert (H6 := H3 _ H5); unfold Rminus in H6; rewrite Ropp_0 in H6;
     rewrite Rplus_0_r in H6; apply H6.
-  unfold ge in |- *; apply le_trans with N0;
-    [ unfold N0 in |- *; apply le_max_r | assumption ].
+  unfold ge; apply le_trans with N0;
+    [ unfold N0; apply le_max_r | assumption ].
   apply Rle_lt_trans with
     (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1) +
       Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)).
@@ -2345,17 +2343,17 @@ Proof.
   [ apply Rabs_triang | ring ].
   apply Rplus_lt_compat.
   unfold R_dist in H1; apply H1.
-  unfold ge in |- *; apply le_trans with N0;
+  unfold ge; apply le_trans with N0;
     [ apply le_trans with (max N1 N2);
-      [ apply le_max_l | unfold N0 in |- *; apply le_max_l ]
+      [ apply le_max_l | unfold N0; apply le_max_l ]
       | assumption ].
   unfold R_dist in H2; apply H2.
-  unfold ge in |- *; apply le_trans with N0;
+  unfold ge; apply le_trans with N0;
     [ apply le_trans with (max N1 N2);
-      [ apply le_max_r | unfold N0 in |- *; apply le_max_l ]
+      [ apply le_max_r | unfold N0; apply le_max_l ]
       | assumption ].
   apply Rmult_eq_reg_l with 3;
-    [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l;
+    [ unfold Rdiv; repeat rewrite Rmult_plus_distr_l;
       do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
         rewrite <- Rinv_l_sym; [ ring | discrR ]
       | discrR ].
@@ -2392,8 +2390,8 @@ Proof.
     apply (proj2_sig (phi_sequence_prop RinvN pr3 n)).
   elim H1; clear H1; intros psi1 H1; elim H2; clear H2; intros psi2 H2; elim H3;
     clear H3; intros psi3 H3; assert (H := RinvN_cv);
-      unfold Un_cv in |- *; intros; assert (H4 : 0 < eps / 3).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      unfold Un_cv; intros; assert (H4 : 0 < eps / 3).
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   elim (H _ H4); clear H; intros N0 H;
     assert (H5 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3).
@@ -2401,11 +2399,11 @@ Proof.
     replace (pos (RinvN n)) with
     (R_dist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0).
   apply H; assumption.
-  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+  unfold R_dist; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge;
       left; apply (cond_pos (RinvN n)).
   exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3;
-    intros; unfold R_dist in |- *; unfold Rminus in |- *;
+    intros; unfold R_dist; unfold Rminus;
       rewrite Ropp_0; rewrite Rplus_0_r;
         set (phi1 := phi_sequence RinvN pr1 n) in H8 |- *;
           set (phi2 := phi_sequence RinvN pr2 n) in H3 |- *;
@@ -2471,7 +2469,7 @@ Proof.
         (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) +
       RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))).
   apply Rplus_le_compat_l; apply StepFun_P37; try assumption.
-  intros; simpl in |- *; rewrite Rmult_1_l;
+  intros; simpl; rewrite Rmult_1_l;
     apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi2 x)).
   rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr;
     replace (phi3 x + -1 * phi2 x) with (phi3 x - f x + (f x - phi2 x));
@@ -2482,28 +2480,28 @@ Proof.
   replace (Rmin a c) with a.
   apply Rle_trans with b; try assumption.
   left; assumption.
-  unfold Rmin in |- *; case (Rle_dec a c); intro;
+  unfold Rmin; case (Rle_dec a c); intro;
     [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
   replace (Rmax a c) with c.
   left; assumption.
-  unfold Rmax in |- *; case (Rle_dec a c); intro;
+  unfold Rmax; case (Rle_dec a c); intro;
     [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
   apply H3.
   elim H14; intros; split.
   replace (Rmin b c) with b.
   left; assumption.
-  unfold Rmin in |- *; case (Rle_dec b c); intro;
+  unfold Rmin; case (Rle_dec b c); intro;
     [ reflexivity | elim n0; assumption ].
   replace (Rmax b c) with c.
   left; assumption.
-  unfold Rmax in |- *; case (Rle_dec b c); intro;
+  unfold Rmax; case (Rle_dec b c); intro;
     [ reflexivity | elim n0; assumption ].
   do 2
     rewrite <-
       (Rplus_comm
         (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))))
       ; apply Rplus_le_compat_l; apply StepFun_P37; try assumption.
-  intros; simpl in |- *; rewrite Rmult_1_l;
+  intros; simpl; rewrite Rmult_1_l;
     apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi1 x)).
   rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr;
     replace (phi3 x + -1 * phi1 x) with (phi3 x - f x + (f x - phi1 x));
@@ -2513,23 +2511,23 @@ Proof.
   elim H14; intros; split.
   replace (Rmin a c) with a.
   left; assumption.
-  unfold Rmin in |- *; case (Rle_dec a c); intro;
+  unfold Rmin; case (Rle_dec a c); intro;
     [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
   replace (Rmax a c) with c.
   apply Rle_trans with b.
   left; assumption.
   assumption.
-  unfold Rmax in |- *; case (Rle_dec a c); intro;
+  unfold Rmax; case (Rle_dec a c); intro;
     [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
   apply H8.
   elim H14; intros; split.
   replace (Rmin a b) with a.
   left; assumption.
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   replace (Rmax a b) with b.
   left; assumption.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n0; assumption ].
   do 2 rewrite StepFun_P30.
   do 2 rewrite Rmult_1_l;
@@ -2555,7 +2553,7 @@ Proof.
   assumption.
   apply H5; assumption.
   apply Rmult_eq_reg_l with 3;
-    [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l;
+    [ unfold Rdiv; repeat rewrite Rmult_plus_distr_l;
       do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
         rewrite <- Rinv_l_sym; [ ring | discrR ]
       | discrR ].
@@ -2610,13 +2608,13 @@ Lemma RiemannInt_P27 :
 Proof.
   intro f; intros; elim H; clear H; intros; assert (H1 : continuity_pt f x).
   apply C0; split; left; assumption.
-  unfold derivable_pt_lim in |- *; intros; assert (Hyp : 0 < eps / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold derivable_pt_lim; intros; assert (Hyp : 0 < eps / 2).
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-  elim (H1 _ Hyp); unfold dist, D_x, no_cond in |- *; simpl in |- *;
-    unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin (b - x) (x - a)));
+  elim (H1 _ Hyp); unfold dist, D_x, no_cond; simpl;
+    unfold R_dist; intros; set (del := Rmin x0 (Rmin (b - x) (x - a)));
       assert (H4 : 0 < del).
-  unfold del in |- *; unfold Rmin in |- *; case (Rle_dec (b - x) (x - a));
+  unfold del; unfold Rmin; case (Rle_dec (b - x) (x - a));
     intro.
   case (Rle_dec x0 (b - x)); intro;
     [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ].
@@ -2633,22 +2631,22 @@ Proof.
   left; apply Rlt_le_trans with (x + del).
   apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h0);
     [ apply RRle_abs | apply H6 ].
-  unfold del in |- *; apply Rle_trans with (x + Rmin (b - x) (x - a)).
+  unfold del; apply Rle_trans with (x + Rmin (b - x) (x - a)).
   apply Rplus_le_compat_l; apply Rmin_r.
-  pattern b at 2 in |- *; replace b with (x + (b - x));
+  pattern b at 2; replace b with (x + (b - x));
     [ apply Rplus_le_compat_l; apply Rmin_l | ring ].
   apply RiemannInt_P1; apply continuity_implies_RiemannInt; auto with real.
   intros; apply C0; elim H7; intros; split.
   apply Rle_trans with (x + h0).
   left; apply Rle_lt_trans with (x - del).
-  unfold del in |- *; apply Rle_trans with (x - Rmin (b - x) (x - a)).
-  pattern a at 1 in |- *; replace a with (x + (a - x)); [ idtac | ring ].
-  unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
+  unfold del; apply Rle_trans with (x - Rmin (b - x) (x - a)).
+  pattern a at 1; replace a with (x + (a - x)); [ idtac | ring ].
+  unfold Rminus; apply Rplus_le_compat_l; apply Ropp_le_cancel.
   rewrite Ropp_involutive; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
     rewrite (Rplus_comm x); apply Rmin_r.
-  unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
+  unfold Rminus; apply Rplus_le_compat_l; apply Ropp_le_cancel.
   do 2 rewrite Ropp_involutive; apply Rmin_r.
-  unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel.
+  unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_cancel.
   rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0);
     [ rewrite <- Rabs_Ropp; apply RRle_abs | apply H6 ].
   assumption.
@@ -2661,7 +2659,7 @@ Proof.
     with ((RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) / h0).
   replace (RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) with
   (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))).
-  unfold Rdiv in |- *; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro.
+  unfold Rdiv; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro.
   apply Rle_lt_trans with
     (RiemannInt
       (RiemannInt_P16
@@ -2680,8 +2678,8 @@ Proof.
   apply Rabs_pos.
   apply RiemannInt_P19; try assumption.
   intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x).
-  unfold fct_cte in |- *; case (Req_dec x x1); intro.
-  rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
+  unfold fct_cte; case (Req_dec x x1); intro.
+  rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
     assumption.
   elim H3; intros; left; apply H11.
   repeat split.
@@ -2692,16 +2690,16 @@ Proof.
   elim H8; intros; assumption.
   apply Rplus_le_compat_l; apply Rle_trans with del.
   left; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | assumption ].
-  unfold del in |- *; apply Rmin_l.
+  unfold del; apply Rmin_l.
   apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption.
-  unfold fct_cte in |- *; ring.
+  unfold fct_cte; ring.
   rewrite RiemannInt_P15.
   rewrite Rmult_assoc; replace ((x + h0 - x) * Rabs (/ h0)) with 1.
-  rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+  rewrite Rmult_1_r; unfold Rdiv; apply Rmult_lt_reg_l with 2;
     [ prove_sup0
       | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
-          [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+          [ rewrite Rmult_1_l; pattern eps at 1; rewrite <- Rplus_0_r;
             rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   rewrite Rabs_right.
@@ -2711,7 +2709,7 @@ Proof.
   apply Rle_ge; left; apply Rinv_0_lt_compat.
   elim r; intro.
   apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption.
-  elim H5; symmetry  in |- *; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r;
+  elim H5; symmetry ; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r;
     assumption.
   apply Rle_lt_trans with
     (RiemannInt
@@ -2735,7 +2733,7 @@ Proof.
           (RiemannInt_P1
             (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))));
       auto with real.
-  symmetry  in |- *; apply RiemannInt_P8.
+  symmetry ; apply RiemannInt_P8.
   apply Rle_lt_trans with
     (RiemannInt (RiemannInt_P14 (x + h0) x (eps / 2)) * Rabs (/ h0)).
   do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
@@ -2743,8 +2741,8 @@ Proof.
   apply RiemannInt_P19.
   auto with real.
   intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x).
-  unfold fct_cte in |- *; case (Req_dec x x1); intro.
-  rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
+  unfold fct_cte; case (Req_dec x x1); intro.
+  rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
     assumption.
   elim H3; intros; left; apply H11.
   repeat split.
@@ -2754,22 +2752,22 @@ Proof.
     [ idtac | ring ].
   replace (x1 - x0 + - (x1 - x)) with (x - x0); [ idtac | ring ].
   apply Rle_lt_trans with (x + h0).
-  unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
+  unfold Rminus; apply Rplus_le_compat_l; apply Ropp_le_cancel.
   rewrite Ropp_involutive; apply Rle_trans with (Rabs h0).
   rewrite <- Rabs_Ropp; apply RRle_abs.
   apply Rle_trans with del;
-    [ left; assumption | unfold del in |- *; apply Rmin_l ].
+    [ left; assumption | unfold del; apply Rmin_l ].
   elim H8; intros; assumption.
   apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
     replace (x + (x1 - x)) with x1; [ elim H8; intros; assumption | ring ].
-  unfold fct_cte in |- *; ring.
+  unfold fct_cte; ring.
   rewrite RiemannInt_P15.
   rewrite Rmult_assoc; replace ((x - (x + h0)) * Rabs (/ h0)) with 1.
-  rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+  rewrite Rmult_1_r; unfold Rdiv; apply Rmult_lt_reg_l with 2;
     [ prove_sup0
       | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
-          [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+          [ rewrite Rmult_1_l; pattern eps at 1; rewrite <- Rplus_0_r;
             rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   rewrite Rabs_left.
@@ -2786,14 +2784,14 @@ Proof.
       (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))
     .
   ring.
-  unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring.
+  unfold Rdiv, Rminus; rewrite Rmult_plus_distr_r; ring.
   rewrite RiemannInt_P15; apply Rmult_eq_reg_l with h0;
-    [ unfold Rdiv in |- *; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc;
+    [ unfold Rdiv; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc;
       rewrite <- Rinv_l_sym; [ ring | assumption ]
       | assumption ].
   cut (a <= x + h0).
   cut (x + h0 <= b).
-  intros; unfold primitive in |- *.
+  intros; unfold primitive.
   case (Rle_dec a (x + h0)); case (Rle_dec (x + h0) b); case (Rle_dec a x);
   case (Rle_dec x b); intros; try (elim n; assumption || left; assumption).
   rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); ring.
@@ -2803,7 +2801,7 @@ Proof.
   apply RRle_abs.
   apply Rle_trans with del;
     [ left; assumption
-      | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a));
+      | unfold del; apply Rle_trans with (Rmin (b - x) (x - a));
         [ apply Rmin_r | apply Rmin_l ] ].
   apply Ropp_le_cancel; apply Rplus_le_reg_l with x;
     replace (x + - (x + h0)) with (- h0); [ idtac | ring ].
@@ -2811,7 +2809,7 @@ Proof.
     [ rewrite <- Rabs_Ropp; apply RRle_abs
       | apply Rle_trans with del;
         [ left; assumption
-          | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a));
+          | unfold del; apply Rle_trans with (Rmin (b - x) (x - a));
             apply Rmin_r ] ].
 Qed.
 
@@ -2828,14 +2826,14 @@ Proof.
     (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b)));
     rewrite H3.
   assert (H4 : derivable_pt_lim f_b b (f b)).
-  unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0).
+  unfold f_b; pattern (f b) at 2; replace (f b) with (f b + 0).
   change
     (derivable_pt_lim
       ((fct_cte (f b) * (id - fct_cte b))%F +
         fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b (
-          f b + 0)) in |- *.
+          f b + 0)).
   apply derivable_pt_lim_plus.
-  pattern (f b) at 2 in |- *;
+  pattern (f b) at 2;
     replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1).
   apply derivable_pt_lim_mult.
   apply derivable_pt_lim_const.
@@ -2843,26 +2841,26 @@ Proof.
   apply derivable_pt_lim_minus.
   apply derivable_pt_lim_id.
   apply derivable_pt_lim_const.
-  unfold fct_cte in |- *; ring.
+  unfold fct_cte; ring.
   apply derivable_pt_lim_const.
   ring.
-  unfold derivable_pt_lim in |- *; intros; elim (H4 _ H5); intros;
+  unfold derivable_pt_lim; intros; elim (H4 _ H5); intros;
     assert (H7 : continuity_pt f b).
   apply C0; split; [ left; assumption | right; reflexivity ].
   assert (H8 : 0 < eps / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-  elim (H7 _ H8); unfold D_x, no_cond, dist in |- *; simpl in |- *;
-    unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin x1 (b - a)));
+  elim (H7 _ H8); unfold D_x, no_cond, dist; simpl;
+    unfold R_dist; intros; set (del := Rmin x0 (Rmin x1 (b - a)));
       assert (H10 : 0 < del).
-  unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - a)); intros.
+  unfold del; unfold Rmin; case (Rle_dec x1 (b - a)); intros.
   case (Rle_dec x0 x1); intro;
     [ apply (cond_pos x0) | elim H9; intros; assumption ].
   case (Rle_dec x0 (b - a)); intro;
     [ apply (cond_pos x0) | apply Rlt_Rminus; assumption ].
   split with (mkposreal _ H10); intros; case (Rcase_abs h0); intro.
   assert (H14 : b + h0 < b).
-  pattern b at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+  pattern b at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
     assumption.
   assert (H13 : Riemann_integrable f (b + h0) b).
   apply continuity_implies_RiemannInt.
@@ -2876,11 +2874,11 @@ Proof.
   apply Rle_trans with (Rabs h0).
   rewrite <- Rabs_Ropp; apply RRle_abs.
   left; assumption.
-  unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
+  unfold del; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
   replace (primitive h (FTC_P1 h C0) (b + h0) - primitive h (FTC_P1 h C0) b)
     with (- RiemannInt H13).
   replace (f b) with (- RiemannInt (RiemannInt_P14 (b + h0) b (f b)) / h0).
-  rewrite <- Rabs_Ropp; unfold Rminus in |- *; unfold Rdiv in |- *;
+  rewrite <- Rabs_Ropp; unfold Rminus; unfold Rdiv;
     rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr;
       repeat rewrite Ropp_involutive;
         replace
@@ -2889,7 +2887,7 @@ Proof.
         ((RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) / h0).
   replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) with
   (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))).
-  unfold Rdiv in |- *; rewrite Rabs_mult;
+  unfold Rdiv; rewrite Rabs_mult;
     apply Rle_lt_trans with
       (RiemannInt
         (RiemannInt_P16
@@ -2909,8 +2907,8 @@ Proof.
   apply RiemannInt_P19.
   left; assumption.
   intros; replace (f x2 + -1 * fct_cte (f b) x2) with (f x2 - f b).
-  unfold fct_cte in |- *; case (Req_dec b x2); intro.
-  rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  unfold fct_cte; case (Req_dec b x2); intro.
+  rewrite H16; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     left; assumption.
   elim H9; intros; left; apply H18.
   repeat split.
@@ -2921,22 +2919,22 @@ Proof.
   replace (x2 - x1 + x1) with x2; [ idtac | ring ].
   apply Rlt_le_trans with (b + h0).
   2: elim H15; intros; left; assumption.
-  unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel;
+  unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_cancel;
     rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0).
   rewrite <- Rabs_Ropp; apply RRle_abs.
   apply Rlt_le_trans with del;
     [ assumption
-      | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a));
+      | unfold del; apply Rle_trans with (Rmin x1 (b - a));
         [ apply Rmin_r | apply Rmin_l ] ].
   apply Rle_ge; left; apply Rlt_Rminus; elim H15; intros; assumption.
-  unfold fct_cte in |- *; ring.
+  unfold fct_cte; ring.
   rewrite RiemannInt_P15.
   rewrite Rmult_assoc; replace ((b - (b + h0)) * Rabs (/ h0)) with 1.
-  rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+  rewrite Rmult_1_r; unfold Rdiv; apply Rmult_lt_reg_l with 2;
     [ prove_sup0
       | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
-          [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+          [ rewrite Rmult_1_l; pattern eps at 1; rewrite <- Rplus_0_r;
             rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   rewrite Rabs_left.
@@ -2950,16 +2948,16 @@ Proof.
     (RiemannInt_P13 H13 (RiemannInt_P14 (b + h0) b (f b))
       (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))))
     ; ring.
-  unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring.
+  unfold Rdiv, Rminus; rewrite Rmult_plus_distr_r; ring.
   rewrite RiemannInt_P15.
   rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0;
-    [ repeat rewrite (Rmult_comm h0); unfold Rdiv in |- *;
+    [ repeat rewrite (Rmult_comm h0); unfold Rdiv;
       repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
         [ ring | assumption ]
       | assumption ].
   cut (a <= b + h0).
   cut (b + h0 <= b).
-  intros; unfold primitive in |- *; case (Rle_dec a (b + h0));
+  intros; unfold primitive; case (Rle_dec a (b + h0));
     case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b);
     intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
   rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring.
@@ -2972,26 +2970,26 @@ Proof.
   apply Rle_trans with (Rabs h0).
   rewrite <- Rabs_Ropp; apply RRle_abs.
   left; assumption.
-  unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
+  unfold del; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
   cut (primitive h (FTC_P1 h C0) b = f_b b).
   intro; cut (primitive h (FTC_P1 h C0) (b + h0) = f_b (b + h0)).
   intro; rewrite H13; rewrite H14; apply H6.
   assumption.
   apply Rlt_le_trans with del;
-    [ assumption | unfold del in |- *; apply Rmin_l ].
+    [ assumption | unfold del; apply Rmin_l ].
   assert (H14 : b < b + h0).
-  pattern b at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+  pattern b at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
   assert (H14 := Rge_le _ _ r); elim H14; intro.
   assumption.
-  elim H11; symmetry  in |- *; assumption.
-  unfold primitive in |- *; case (Rle_dec a (b + h0));
+  elim H11; symmetry ; assumption.
+  unfold primitive; case (Rle_dec a (b + h0));
     case (Rle_dec (b + h0) b); intros;
       [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14))
-        | unfold f_b in |- *; reflexivity
+        | unfold f_b; reflexivity
         | elim n; left; apply Rlt_trans with b; assumption
         | elim n0; left; apply Rlt_trans with b; assumption ].
-  unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
-    rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive in |- *;
+  unfold f_b; unfold Rminus; rewrite Rplus_opp_r;
+    rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive;
       case (Rle_dec a b); case (Rle_dec b b); intros;
         [ apply RiemannInt_P5
           | elim n; right; reflexivity
@@ -3000,9 +2998,9 @@ Proof.
 (*****)
   set (f_a := fun x:R => f a * (x - a)); rewrite <- H2;
     assert (H3 : derivable_pt_lim f_a a (f a)).
-  unfold f_a in |- *;
+  unfold f_a;
     change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a))
-      in |- *; pattern (f a) at 2 in |- *;
+     ; pattern (f a) at 2;
         replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1).
   apply derivable_pt_lim_mult.
   apply derivable_pt_lim_const.
@@ -3010,18 +3008,18 @@ Proof.
   apply derivable_pt_lim_minus.
   apply derivable_pt_lim_id.
   apply derivable_pt_lim_const.
-  unfold fct_cte in |- *; ring.
-  unfold derivable_pt_lim in |- *; intros; elim (H3 _ H4); intros.
+  unfold fct_cte; ring.
+  unfold derivable_pt_lim; intros; elim (H3 _ H4); intros.
   assert (H6 : continuity_pt f a).
   apply C0; split; [ right; reflexivity | left; assumption ].
   assert (H7 : 0 < eps / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-  elim (H6 _ H7); unfold D_x, no_cond, dist in |- *; simpl in |- *;
-    unfold R_dist in |- *; intros.
+  elim (H6 _ H7); unfold D_x, no_cond, dist; simpl;
+    unfold R_dist; intros.
   set (del := Rmin x0 (Rmin x1 (b - a))).
   assert (H9 : 0 < del).
-  unfold del in |- *; unfold Rmin in |- *.
+  unfold del; unfold Rmin.
   case (Rle_dec x1 (b - a)); intros.
   case (Rle_dec x0 x1); intro.
   apply (cond_pos x0).
@@ -3032,9 +3030,9 @@ Proof.
   split with (mkposreal _ H9).
   intros; case (Rcase_abs h0); intro.
   assert (H12 : a + h0 < a).
-  pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+  pattern a at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
     assumption.
-  unfold primitive in |- *.
+  unfold primitive.
   case (Rle_dec a (a + h0)); case (Rle_dec (a + h0) b); case (Rle_dec a a);
   case (Rle_dec a b); intros;
     try (elim n; left; assumption) || (elim n; right; reflexivity).
@@ -3044,15 +3042,15 @@ Proof.
   replace (f a * (a + h0 - a)) with (f_a (a + h0)).
   apply H5; try assumption.
   apply Rlt_le_trans with del;
-    [ assumption | unfold del in |- *; apply Rmin_l ].
-  unfold f_a in |- *; ring.
-  unfold f_a in |- *; ring.
+    [ assumption | unfold del; apply Rmin_l ].
+  unfold f_a; ring.
+  unfold f_a; ring.
   elim n; left; apply Rlt_trans with a; assumption.
   assert (H12 : a < a + h0).
-  pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+  pattern a at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
   assert (H12 := Rge_le _ _ r); elim H12; intro.
   assumption.
-  elim H10; symmetry  in |- *; assumption.
+  elim H10; symmetry ; assumption.
   assert (H13 : Riemann_integrable f a (a + h0)).
   apply continuity_implies_RiemannInt.
   left; assumption.
@@ -3064,7 +3062,7 @@ Proof.
   apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite Ropp_minus_distr;
     apply Rle_trans with del.
   apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ].
-  unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
+  unfold del; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
   replace (primitive h (FTC_P1 h C0) (a + h0) - primitive h (FTC_P1 h C0) a)
     with (RiemannInt H13).
   replace (f a) with (RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0).
@@ -3073,7 +3071,7 @@ Proof.
     with ((RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) / h0).
   replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) with
   (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))).
-  unfold Rdiv in |- *; rewrite Rabs_mult;
+  unfold Rdiv; rewrite Rabs_mult;
     apply Rle_lt_trans with
       (RiemannInt
         (RiemannInt_P16
@@ -3093,8 +3091,8 @@ Proof.
   apply RiemannInt_P19.
   left; assumption.
   intros; replace (f x2 + -1 * fct_cte (f a) x2) with (f x2 - f a).
-  unfold fct_cte in |- *; case (Req_dec a x2); intro.
-  rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  unfold fct_cte; case (Req_dec a x2); intro.
+  rewrite H15; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     left; assumption.
   elim H8; intros; left; apply H17; repeat split.
   assumption.
@@ -3106,42 +3104,42 @@ Proof.
   apply RRle_abs.
   apply Rlt_le_trans with del;
     [ assumption
-      | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a));
+      | unfold del; apply Rle_trans with (Rmin x1 (b - a));
         [ apply Rmin_r | apply Rmin_l ] ].
   apply Rle_ge; left; apply Rlt_Rminus; elim H14; intros; assumption.
-  unfold fct_cte in |- *; ring.
+  unfold fct_cte; ring.
   rewrite RiemannInt_P15.
   rewrite Rmult_assoc; replace ((a + h0 - a) * Rabs (/ h0)) with 1.
-  rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+  rewrite Rmult_1_r; unfold Rdiv; apply Rmult_lt_reg_l with 2;
     [ prove_sup0
       | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
-          [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+          [ rewrite Rmult_1_l; pattern eps at 1; rewrite <- Rplus_0_r;
             rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   rewrite Rabs_right.
-  rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
+  rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc;
     rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym;
       [ reflexivity | assumption ].
   apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ r);
     elim H14; intro.
   assumption.
-  elim H10; symmetry  in |- *; assumption.
+  elim H10; symmetry ; assumption.
   rewrite
     (RiemannInt_P13 H13 (RiemannInt_P14 a (a + h0) (f a))
       (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))
     ; ring.
-  unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring.
+  unfold Rdiv, Rminus; rewrite Rmult_plus_distr_r; ring.
   rewrite RiemannInt_P15.
-  rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
-    rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv in |- *;
+  rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc;
+    rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv;
       rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ ring | assumption ].
   cut (a <= a + h0).
   cut (a + h0 <= b).
-  intros; unfold primitive in |- *; case (Rle_dec a (a + h0));
+  intros; unfold primitive; case (Rle_dec a (a + h0));
     case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b);
     intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
-  rewrite RiemannInt_P9; unfold Rminus in |- *; rewrite Ropp_0;
+  rewrite RiemannInt_P9; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; apply RiemannInt_P5.
   elim n; assumption.
   elim n; assumption.
@@ -3150,15 +3148,15 @@ Proof.
     [ idtac | ring ].
   rewrite Rplus_comm; apply Rle_trans with del;
     [ apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ]
-      | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ].
+      | unfold del; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ].
 (*****)
   assert (H1 : x = a).
   rewrite <- H0 in H; elim H; intros; apply Rle_antisym; assumption.
   set (f_a := fun x:R => f a * (x - a)).
   assert (H2 : derivable_pt_lim f_a a (f a)).
-  unfold f_a in |- *;
+  unfold f_a;
     change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a))
-      in |- *; pattern (f a) at 2 in |- *;
+     ; pattern (f a) at 2;
         replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1).
   apply derivable_pt_lim_mult.
   apply derivable_pt_lim_const.
@@ -3166,18 +3164,18 @@ Proof.
   apply derivable_pt_lim_minus.
   apply derivable_pt_lim_id.
   apply derivable_pt_lim_const.
-  unfold fct_cte in |- *; ring.
+  unfold fct_cte; ring.
   set
     (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))).
   assert (H3 : derivable_pt_lim f_b b (f b)).
-  unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0).
+  unfold f_b; pattern (f b) at 2; replace (f b) with (f b + 0).
   change
     (derivable_pt_lim
       ((fct_cte (f b) * (id - fct_cte b))%F +
         fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b (
-          f b + 0)) in |- *.
+          f b + 0)).
   apply derivable_pt_lim_plus.
-  pattern (f b) at 2 in |- *;
+  pattern (f b) at 2;
     replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1).
   apply derivable_pt_lim_mult.
   apply derivable_pt_lim_const.
@@ -3185,20 +3183,20 @@ Proof.
   apply derivable_pt_lim_minus.
   apply derivable_pt_lim_id.
   apply derivable_pt_lim_const.
-  unfold fct_cte in |- *; ring.
+  unfold fct_cte; ring.
   apply derivable_pt_lim_const.
   ring.
-  unfold derivable_pt_lim in |- *; intros; elim (H2 _ H4); intros;
+  unfold derivable_pt_lim; intros; elim (H2 _ H4); intros;
     elim (H3 _ H4); intros; set (del := Rmin x0 x1).
   assert (H7 : 0 < del).
-  unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x0 x1); intro.
+  unfold del; unfold Rmin; case (Rle_dec x0 x1); intro.
   apply (cond_pos x0).
   apply (cond_pos x1).
   split with (mkposreal _ H7); intros; case (Rcase_abs h0); intro.
   assert (H10 : a + h0 < a).
-  pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+  pattern a at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
     assumption.
-  rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0));
+  rewrite H1; unfold primitive; case (Rle_dec a (a + h0));
     case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b);
     intros; try (elim n; right; assumption || reflexivity).
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)).
@@ -3207,27 +3205,27 @@ Proof.
   replace (f a * (a + h0 - a)) with (f_a (a + h0)).
   apply H5; try assumption.
   apply Rlt_le_trans with del; try assumption.
-  unfold del in |- *; apply Rmin_l.
-  unfold f_a in |- *; ring.
-  unfold f_a in |- *; ring.
+  unfold del; apply Rmin_l.
+  unfold f_a; ring.
+  unfold f_a; ring.
   elim n; rewrite <- H0; left; assumption.
   assert (H10 : a < a + h0).
-  pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+  pattern a at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
   assert (H10 := Rge_le _ _ r); elim H10; intro.
   assumption.
-  elim H8; symmetry  in |- *; assumption.
-  rewrite H0 in H1; rewrite H1; unfold primitive in |- *;
+  elim H8; symmetry ; assumption.
+  rewrite H0 in H1; rewrite H1; unfold primitive;
     case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b);
     case (Rle_dec a b); case (Rle_dec b b); intros;
       try (elim n; right; assumption || reflexivity).
   rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)).
   repeat rewrite RiemannInt_P9.
   replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b).
-  fold (f_b (b + h0)) in |- *.
+  fold (f_b (b + h0)).
   apply H6; try assumption.
   apply Rlt_le_trans with del; try assumption.
-  unfold del in |- *; apply Rmin_r.
-  unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+  unfold del; apply Rmin_r.
+  unfold f_b; unfold Rminus; rewrite Rplus_opp_r;
     rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5.
   elim n; rewrite <- H0; left; assumption.
   elim n0; rewrite <- H0; left; assumption.
@@ -3238,11 +3236,11 @@ Lemma RiemannInt_P29 :
     (C0:forall x:R, a <= x <= b -> continuity_pt f x),
     antiderivative f (primitive h (FTC_P1 h C0)) a b.
 Proof.
-  intro f; intros; unfold antiderivative in |- *; split; try assumption; intros;
+  intro f; intros; unfold antiderivative; split; try assumption; intros;
     assert (H0 := RiemannInt_P28 h C0 H);
       assert (H1 : derivable_pt (primitive h (FTC_P1 h C0)) x);
-        [ unfold derivable_pt in |- *; split with (f x); apply H0
-          | split with H1; symmetry  in |- *; apply derive_pt_eq_0; apply H0 ].
+        [ unfold derivable_pt; split with (f x); apply H0
+          | split with H1; symmetry ; apply derive_pt_eq_0; apply H0 ].
 Qed.
 
 Lemma RiemannInt_P30 :
@@ -3261,7 +3259,7 @@ Lemma RiemannInt_P31 :
   forall (f:C1_fun) (a b:R),
     a <= b -> antiderivative (derive f (diff0 f)) f a b.
 Proof.
-  intro f; intros; unfold antiderivative in |- *; split; try assumption; intros;
+  intro f; intros; unfold antiderivative; split; try assumption; intros;
     split with (diff0 f x); reflexivity.
 Qed.
 
diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v
index d0d9519c..d523a1f4 100644
--- a/theories/Reals/RiemannInt_SF.v
+++ b/theories/Reals/RiemannInt_SF.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: RiemannInt_SF.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
-Require Import Ranalysis.
+Require Import Ranalysis_reg.
 Require Import Classical_Prop.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Set Implicit Arguments.
 
@@ -23,7 +21,7 @@ Set Implicit Arguments.
 Definition Nbound (I:nat -> Prop) : Prop :=
   exists n : nat, (forall i:nat, I i -> (i <= n)%nat).
 
-Lemma IZN_var : forall z:Z, (0 <= z)%Z -> {n : nat | z = Z_of_nat n}.
+Lemma IZN_var : forall z:Z, (0 <= z)%Z -> {n : nat | z = Z.of_nat n}.
 Proof.
   intros; apply Z_of_nat_complete_inf; assumption.
 Qed.
@@ -35,19 +33,19 @@ Lemma Nzorn :
 Proof.
   intros I H H0; set (E := fun x:R =>  exists i : nat, I i /\ INR i = x);
     assert (H1 : bound E).
-  unfold Nbound in H0; elim H0; intros N H1; unfold bound in |- *;
-    exists (INR N); unfold is_upper_bound in |- *; intros;
+  unfold Nbound in H0; elim H0; intros N H1; unfold bound;
+    exists (INR N); unfold is_upper_bound; intros;
       unfold E in H2; elim H2; intros; elim H3; intros;
         rewrite <- H5; apply le_INR; apply H1; assumption.
   assert (H2 :  exists x : R, E x).
-  elim H; intros; exists (INR x); unfold E in |- *; exists x; split;
+  elim H; intros; exists (INR x); unfold E; exists x; split;
     [ assumption | reflexivity ].
   assert (H3 := completeness E H1 H2); elim H3; intros; unfold is_lub in p;
     elim p; clear p; intros; unfold is_upper_bound in H4, H5;
       assert (H6 : 0 <= x).
   elim H2; intros; unfold E in H6; elim H6; intros; elim H7; intros;
     apply Rle_trans with x0;
-      [ rewrite <- H9; change (INR 0 <= INR x1) in |- *; apply le_INR;
+      [ rewrite <- H9; change (INR 0 <= INR x1); apply le_INR;
         apply le_O_n
         | apply H4; assumption ].
   assert (H7 := archimed x); elim H7; clear H7; intros;
@@ -90,7 +88,7 @@ Proof.
     [ idtac | reflexivity ]; rewrite <- minus_INR.
   replace (x0 - 1)%nat with (pred x0);
   [ reflexivity
-    | case x0; [ reflexivity | intro; simpl in |- *; apply minus_n_O ] ].
+    | case x0; [ reflexivity | intro; simpl; apply minus_n_O ] ].
   induction  x0 as [| x0 Hrecx0];
     [ rewrite p in H7; rewrite <- INR_IZR_INZ in H7; simpl in H7;
       elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7))
@@ -101,10 +99,10 @@ Proof.
       assert (H16 : INR x0 = INR x1 + 1).
   rewrite H15; ring.
   rewrite <- S_INR in H16; assert (H17 := INR_eq _ _ H16); rewrite H17;
-    simpl in |- *; split.
+    simpl; split.
   assumption.
   intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros;
-    rewrite H20; apply H4; unfold E in |- *; exists i;
+    rewrite H20; apply H4; unfold E; exists i;
       split; [ assumption | reflexivity ].
 Qed.
 
@@ -149,7 +147,7 @@ Definition subdivision_val (a b:R) (f:StepFun a b) : Rlist :=
     | existT a b => a
   end.
 
-Boxed Fixpoint Int_SF (l k:Rlist) : R :=
+Fixpoint Int_SF (l k:Rlist) : R :=
   match l with
     | nil => 0
     | cons a l' =>
@@ -175,7 +173,7 @@ Lemma StepFun_P1 :
   forall (a b:R) (f:StepFun a b),
     adapted_couple f a b (subdivision f) (subdivision_val f).
 Proof.
-  intros a b f; unfold subdivision_val in |- *; case (projT2 (pre f)); intros;
+  intros a b f; unfold subdivision_val; case (projT2 (pre f)); intros;
     apply a0.
 Qed.
 
@@ -183,13 +181,13 @@ Lemma StepFun_P2 :
   forall (a b:R) (f:R -> R) (l lf:Rlist),
     adapted_couple f a b l lf -> adapted_couple f b a l lf.
 Proof.
-  unfold adapted_couple in |- *; intros; decompose [and] H; clear H;
+  unfold adapted_couple; intros; decompose [and] H; clear H;
     repeat split; try assumption.
-  rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro;
+  rewrite H2; unfold Rmin; case (Rle_dec a b); intro;
     case (Rle_dec b a); intro; try reflexivity.
   apply Rle_antisym; assumption.
   apply Rle_antisym; auto with real.
-  rewrite H1; unfold Rmax in |- *; case (Rle_dec a b); intro;
+  rewrite H1; unfold Rmax; case (Rle_dec a b); intro;
     case (Rle_dec b a); intro; try reflexivity.
   apply Rle_antisym; assumption.
   apply Rle_antisym; auto with real.
@@ -200,23 +198,23 @@ Lemma StepFun_P3 :
     a <= b ->
     adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil).
 Proof.
-  intros; unfold adapted_couple in |- *; repeat split.
-  unfold ordered_Rlist in |- *; intros; simpl in H0; inversion H0;
-    [ simpl in |- *; assumption | elim (le_Sn_O _ H2) ].
-  simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro;
+  intros; unfold adapted_couple; repeat split.
+  unfold ordered_Rlist; intros; simpl in H0; inversion H0;
+    [ simpl; assumption | elim (le_Sn_O _ H2) ].
+  simpl; unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
-  simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro;
+  simpl; unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
-  unfold constant_D_eq, open_interval in |- *; intros; simpl in H0;
+  unfold constant_D_eq, open_interval; intros; simpl in H0;
     inversion H0; [ reflexivity | elim (le_Sn_O _ H3) ].
 Qed.
 
 Lemma StepFun_P4 : forall a b c:R, IsStepFun (fct_cte c) a b.
 Proof.
-  intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro.
-  apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *;
+  intros; unfold IsStepFun; case (Rle_dec a b); intro.
+  apply existT with (cons a (cons b nil)); unfold is_subdivision;
     apply existT with (cons c nil); apply (StepFun_P3 c r).
-  apply existT with (cons b (cons a nil)); unfold is_subdivision in |- *;
+  apply existT with (cons b (cons a nil)); unfold is_subdivision;
     apply existT with (cons c nil); apply StepFun_P2;
       apply StepFun_P3; auto with real.
 Qed.
@@ -234,7 +232,7 @@ Qed.
 Lemma StepFun_P6 :
   forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a.
 Proof.
-  unfold IsStepFun in |- *; intros; elim X; intros; apply existT with x;
+  unfold IsStepFun; intros; elim X; intros; apply existT with x;
     apply StepFun_P5; assumption.
 Qed.
 
@@ -244,26 +242,26 @@ Lemma StepFun_P7 :
     adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf) ->
     adapted_couple f r2 b (cons r2 l) lf.
 Proof.
-  unfold adapted_couple in |- *; intros; decompose [and] H0; clear H0;
+  unfold adapted_couple; intros; decompose [and] H0; clear H0;
     assert (H5 : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   assert (H7 : r2 <= b).
   rewrite H5 in H2; rewrite <- H2; apply RList_P7;
-    [ assumption | simpl in |- *; right; left; reflexivity ].
+    [ assumption | simpl; right; left; reflexivity ].
   repeat split.
   apply RList_P4 with r1; assumption.
-  rewrite H5 in H2; unfold Rmin in |- *; case (Rle_dec r2 b); intro;
+  rewrite H5 in H2; unfold Rmin; case (Rle_dec r2 b); intro;
     [ reflexivity | elim n; assumption ].
-  unfold Rmax in |- *; case (Rle_dec r2 b); intro;
+  unfold Rmax; case (Rle_dec r2 b); intro;
     [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ].
-  simpl in H4; simpl in |- *; apply INR_eq; apply Rplus_eq_reg_l with 1;
+  simpl in H4; simpl; apply INR_eq; apply Rplus_eq_reg_l with 1;
     do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR;
       rewrite H4; reflexivity.
-  intros; unfold constant_D_eq, open_interval in |- *; intros;
+  intros; unfold constant_D_eq, open_interval; intros;
     unfold constant_D_eq, open_interval in H6;
       assert (H9 : (S i < pred (Rlength (cons r1 (cons r2 l))))%nat).
-  simpl in |- *; simpl in H0; apply lt_n_S; assumption.
+  simpl; simpl in H0; apply lt_n_S; assumption.
   assert (H10 := H6 _ H9); apply H10; assumption.
 Qed.
 
@@ -280,19 +278,19 @@ Proof.
     discriminate.
   intros; induction  lf1 as [| r3 lf1 Hreclf1].
   reflexivity.
-  simpl in |- *; cut (r = r1).
+  simpl; cut (r = r1).
   intro; rewrite H3; rewrite (H0 lf1 r b).
   ring.
   rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ].
   clear H H0 Hreclf1 r0; unfold adapted_couple in H1; decompose [and] H1;
-    intros; simpl in H4; rewrite H4; unfold Rmin in |- *;
+    intros; simpl in H4; rewrite H4; unfold Rmin;
       case (Rle_dec a b); intro; [ assumption | reflexivity ].
   unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym.
-  apply (H3 0%nat); simpl in |- *; apply lt_O_Sn.
+  apply (H3 0%nat); simpl; apply lt_O_Sn.
   simpl in H5; rewrite H2 in H5; rewrite H5; replace (Rmin b b) with (Rmax a b);
     [ rewrite <- H4; apply RList_P7;
-      [ assumption | simpl in |- *; right; left; reflexivity ]
-      | unfold Rmin, Rmax in |- *; case (Rle_dec b b); case (Rle_dec a b); intros;
+      [ assumption | simpl; right; left; reflexivity ]
+      | unfold Rmin, Rmax; case (Rle_dec b b); case (Rle_dec a b); intros;
         try assumption || reflexivity ].
 Qed.
 
@@ -305,10 +303,10 @@ Proof.
       [ simpl in H4; discriminate
         | induction  l as [| r0 l Hrecl0];
           [ simpl in H3; simpl in H2; generalize H3; generalize H2;
-            unfold Rmin, Rmax in |- *; case (Rle_dec a b);
+            unfold Rmin, Rmax; case (Rle_dec a b);
               intros; elim H0; rewrite <- H5; rewrite <- H7;
                 reflexivity
-            | simpl in |- *; do 2 apply le_n_S; apply le_O_n ] ].
+            | simpl; do 2 apply le_n_S; apply le_O_n ] ].
 Qed.
 
 Lemma StepFun_P10 :
@@ -322,12 +320,12 @@ Proof.
   intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4;
     discriminate.
   intros; case (Req_dec a b); intro.
-  exists (cons a nil); exists nil; unfold adapted_couple_opt in |- *;
-    unfold adapted_couple in |- *; unfold ordered_Rlist in |- *;
+  exists (cons a nil); exists nil; unfold adapted_couple_opt;
+    unfold adapted_couple; unfold ordered_Rlist;
       repeat split; try (intros; simpl in H3; elim (lt_n_O _ H3)).
-  simpl in |- *; rewrite <- H2; unfold Rmin in |- *; case (Rle_dec a a); intro;
+  simpl; rewrite <- H2; unfold Rmin; case (Rle_dec a a); intro;
     reflexivity.
-  simpl in |- *; rewrite <- H2; unfold Rmax in |- *; case (Rle_dec a a); intro;
+  simpl; rewrite <- H2; unfold Rmax; case (Rle_dec a a); intro;
     reflexivity.
   elim (RList_P20 _ (StepFun_P9 H1 H2)); intros t1 [t2 [t3 H3]];
     induction  lf as [| r1 lf Hreclf].
@@ -342,32 +340,32 @@ Proof.
   apply H6.
   rewrite <- Hyp_eq; rewrite H3 in H1; unfold adapted_couple in H1;
     decompose [and] H1; clear H1; simpl in H9; rewrite H9;
-      unfold Rmin in |- *; case (Rle_dec a b); intro;
+      unfold Rmin; case (Rle_dec a b); intro;
         [ reflexivity | elim n; assumption ].
   elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro.
   exists (cons a (cons b nil)); exists (cons r1 nil);
-    unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+    unfold adapted_couple_opt; unfold adapted_couple;
       repeat split.
-  unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8;
-    [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
-  simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold ordered_Rlist; intros; simpl in H8; inversion H8;
+    [ simpl; assumption | elim (le_Sn_O _ H10) ].
+  simpl; unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
-  simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro;
+  simpl; unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   intros; simpl in H8; inversion H8.
-  unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *;
+  unfold constant_D_eq, open_interval; intros; simpl;
     simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1;
       decompose [and] H1; apply (H16 0%nat).
-  simpl in |- *; apply lt_O_Sn.
-  unfold open_interval in |- *; simpl in |- *; rewrite H7; simpl in H13;
-    rewrite H13; unfold Rmin in |- *; case (Rle_dec a b);
+  simpl; apply lt_O_Sn.
+  unfold open_interval; simpl; rewrite H7; simpl in H13;
+    rewrite H13; unfold Rmin; case (Rle_dec a b);
       intro; [ assumption | elim n; assumption ].
   elim (le_Sn_O _ H10).
   intros; simpl in H8; elim (lt_n_O _ H8).
   intros; simpl in H8; inversion H8;
-    [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
+    [ simpl; assumption | elim (le_Sn_O _ H10) ].
   assert (Hyp_min : Rmin t2 b = t2).
-  unfold Rmin in |- *; case (Rle_dec t2 b); intro;
+  unfold Rmin; case (Rle_dec t2 b); intro;
     [ reflexivity | elim n; assumption ].
   unfold adapted_couple in H6; elim H6; clear H6; intros;
     elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]];
@@ -379,141 +377,141 @@ Proof.
   exists (cons t1 (cons s2 s3)); exists (cons r1 lf'); rewrite H3 in H1;
     rewrite H9 in H6; unfold adapted_couple in H6, H1;
       decompose [and] H1; decompose [and] H6; clear H1 H6;
-        unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+        unfold adapted_couple_opt; unfold adapted_couple;
           repeat split.
-  unfold ordered_Rlist in |- *; intros; simpl in H1;
+  unfold ordered_Rlist; intros; simpl in H1;
     induction  i as [| i Hreci].
-  simpl in |- *; apply Rle_trans with s1.
+  simpl; apply Rle_trans with s1.
   replace s1 with t2.
   apply (H12 0%nat).
-  simpl in |- *; apply lt_O_Sn.
-  simpl in H19; rewrite H19; symmetry  in |- *; apply Hyp_min.
-  apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
-  change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *;
-    apply (H16 (S i)); simpl in |- *; assumption.
-  simpl in |- *; simpl in H14; rewrite H14; reflexivity.
-  simpl in |- *; simpl in H18; rewrite H18; unfold Rmax in |- *;
+  simpl; apply lt_O_Sn.
+  simpl in H19; rewrite H19; symmetry ; apply Hyp_min.
+  apply (H16 0%nat); simpl; apply lt_O_Sn.
+  change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i));
+    apply (H16 (S i)); simpl; assumption.
+  simpl; simpl in H14; rewrite H14; reflexivity.
+  simpl; simpl in H18; rewrite H18; unfold Rmax;
     case (Rle_dec a b); case (Rle_dec t2 b); intros; reflexivity || elim n;
       assumption.
-  simpl in |- *; simpl in H20; apply H20.
-  intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
+  simpl; simpl in H20; apply H20.
+  intros; simpl in H1; unfold constant_D_eq, open_interval; intros;
     induction  i as [| i Hreci].
-  simpl in |- *; simpl in H6; case (total_order_T x t2); intro.
+  simpl; simpl in H6; case (total_order_T x t2); intro.
   elim s; intro.
   apply (H17 0%nat);
-    [ simpl in |- *; apply lt_O_Sn
-      | unfold open_interval in |- *; simpl in |- *; elim H6; intros; split;
+    [ simpl; apply lt_O_Sn
+      | unfold open_interval; simpl; elim H6; intros; split;
         assumption ].
   rewrite b0; assumption.
   rewrite H10; apply (H22 0%nat);
-    [ simpl in |- *; apply lt_O_Sn
-      | unfold open_interval in |- *; simpl in |- *; replace s1 with t2;
+    [ simpl; apply lt_O_Sn
+      | unfold open_interval; simpl; replace s1 with t2;
         [ elim H6; intros; split; assumption
           | simpl in H19; rewrite H19; rewrite Hyp_min; reflexivity ] ].
-  simpl in |- *; simpl in H6; apply (H22 (S i));
-    [ simpl in |- *; assumption
-      | unfold open_interval in |- *; simpl in |- *; apply H6 ].
+  simpl; simpl in H6; apply (H22 (S i));
+    [ simpl; assumption
+      | unfold open_interval; simpl; apply H6 ].
   intros; simpl in H1; rewrite H10;
     change
       (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/
         f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i)
-      in |- *; rewrite <- H9; elim H8; intros; apply H6;
-        simpl in |- *; apply H1.
+     ; rewrite <- H9; elim H8; intros; apply H6;
+        simpl; apply H1.
   intros; induction  i as [| i Hreci].
-  simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
-  apply (H12 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl; red; intro; elim Hyp_eq; apply Rle_antisym.
+  apply (H12 0%nat); simpl; apply lt_O_Sn.
   rewrite <- Hyp_min; rewrite H6; simpl in H19; rewrite <- H19;
-    apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
-  elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl in |- *;
+    apply (H16 0%nat); simpl; apply lt_O_Sn.
+  elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl;
     simpl in H1; apply H1.
   exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6;
     rewrite H3 in H1; unfold adapted_couple in H1, H6;
       decompose [and] H6; decompose [and] H1; clear H6 H1;
-        unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+        unfold adapted_couple_opt; unfold adapted_couple;
           repeat split.
-  rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1;
+  rewrite H9; unfold ordered_Rlist; intros; simpl in H1;
     induction  i as [| i Hreci].
-  simpl in |- *; replace s1 with t2.
-  apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl; replace s1 with t2.
+  apply (H16 0%nat); simpl; apply lt_O_Sn.
   simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
   change
     (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i))
-    in |- *; apply (H12 i); simpl in |- *; apply lt_S_n;
+   ; apply (H12 i); simpl; apply lt_S_n;
       assumption.
-  simpl in |- *; simpl in H19; apply H19.
-  rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *;
+  simpl; simpl in H19; apply H19.
+  rewrite H9; simpl; simpl in H13; rewrite H13; unfold Rmax;
     case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
       assumption.
-  rewrite H9; simpl in |- *; simpl in H15; rewrite H15; reflexivity.
-  intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
+  rewrite H9; simpl; simpl in H15; rewrite H15; reflexivity.
+  intros; simpl in H1; unfold constant_D_eq, open_interval; intros;
     induction  i as [| i Hreci].
-  simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H22 0%nat).
-  simpl in |- *; apply lt_O_Sn.
-  unfold open_interval in |- *; simpl in |- *.
+  simpl; rewrite H9 in H6; simpl in H6; apply (H22 0%nat).
+  simpl; apply lt_O_Sn.
+  unfold open_interval; simpl.
   replace t2 with s1.
   assumption.
   simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
-  change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H17 i).
-  simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
-  rewrite H9 in H6; unfold open_interval in |- *; apply H6.
+  change (f x = pos_Rl (cons r2 lf') i); clear Hreci; apply (H17 i).
+  simpl; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
+  rewrite H9 in H6; unfold open_interval; apply H6.
   intros; simpl in H1; induction  i as [| i Hreci].
-  simpl in |- *; rewrite H9; right; simpl in |- *; replace s1 with t2.
+  simpl; rewrite H9; right; simpl; replace s1 with t2.
   assumption.
   simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
   elim H8; intros; apply (H6 i).
-  simpl in |- *; apply lt_S_n; apply H1.
+  simpl; apply lt_S_n; apply H1.
   intros; rewrite H9; induction  i as [| i Hreci].
-  simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
-  apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl; red; intro; elim Hyp_eq; apply Rle_antisym.
+  apply (H16 0%nat); simpl; apply lt_O_Sn.
   rewrite <- Hyp_min; rewrite H6; simpl in H14; rewrite <- H14; right;
     reflexivity.
   elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1;
-    simpl in |- *; simpl in H1; apply lt_S_n; apply H1.
+    simpl; simpl in H1; apply lt_S_n; apply H1.
   exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6;
     rewrite H3 in H1; unfold adapted_couple in H1, H6;
       decompose [and] H6; decompose [and] H1; clear H6 H1;
-        unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+        unfold adapted_couple_opt; unfold adapted_couple;
           repeat split.
-  rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1;
+  rewrite H9; unfold ordered_Rlist; intros; simpl in H1;
     induction  i as [| i Hreci].
-  simpl in |- *; replace s1 with t2.
-  apply (H15 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl; replace s1 with t2.
+  apply (H15 0%nat); simpl; apply lt_O_Sn.
   simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity.
   change
     (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i))
-    in |- *; apply (H11 i); simpl in |- *; apply lt_S_n;
+   ; apply (H11 i); simpl; apply lt_S_n;
       assumption.
-  simpl in |- *; simpl in H18; apply H18.
-  rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *;
+  simpl; simpl in H18; apply H18.
+  rewrite H9; simpl; simpl in H12; rewrite H12; unfold Rmax;
     case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
       assumption.
-  rewrite H9; simpl in |- *; simpl in H14; rewrite H14; reflexivity.
-  intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
+  rewrite H9; simpl; simpl in H14; rewrite H14; reflexivity.
+  intros; simpl in H1; unfold constant_D_eq, open_interval; intros;
     induction  i as [| i Hreci].
-  simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H21 0%nat).
-  simpl in |- *; apply lt_O_Sn.
-  unfold open_interval in |- *; simpl in |- *; replace t2 with s1.
+  simpl; rewrite H9 in H6; simpl in H6; apply (H21 0%nat).
+  simpl; apply lt_O_Sn.
+  unfold open_interval; simpl; replace t2 with s1.
   assumption.
   simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity.
-  change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H16 i).
-  simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
-  rewrite H9 in H6; unfold open_interval in |- *; apply H6.
+  change (f x = pos_Rl (cons r2 lf') i); clear Hreci; apply (H16 i).
+  simpl; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
+  rewrite H9 in H6; unfold open_interval; apply H6.
   intros; simpl in H1; induction  i as [| i Hreci].
-  simpl in |- *; left; assumption.
+  simpl; left; assumption.
   elim H8; intros; apply (H6 i).
-  simpl in |- *; apply lt_S_n; apply H1.
+  simpl; apply lt_S_n; apply H1.
   intros; rewrite H9; induction  i as [| i Hreci].
-  simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
-  apply (H15 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl; red; intro; elim Hyp_eq; apply Rle_antisym.
+  apply (H15 0%nat); simpl; apply lt_O_Sn.
   rewrite <- Hyp_min; rewrite H6; simpl in H13; rewrite <- H13; right;
     reflexivity.
   elim H8; intros; rewrite <- H9; apply (H20 i); rewrite H9; rewrite H9 in H1;
-    simpl in |- *; simpl in H1; apply lt_S_n; apply H1.
+    simpl; simpl in H1; apply lt_S_n; apply H1.
   rewrite H3 in H1; clear H4; unfold adapted_couple in H1; decompose [and] H1;
     clear H1; clear H H7 H9; cut (Rmax a b = b);
       [ intro; rewrite H in H5; rewrite <- H5; apply RList_P7;
-        [ assumption | simpl in |- *; right; left; reflexivity ]
-        | unfold Rmax in |- *; case (Rle_dec a b); intro;
+        [ assumption | simpl; right; left; reflexivity ]
+        | unfold Rmax; case (Rle_dec a b); intro;
           [ reflexivity | elim n; assumption ] ].
 Qed.
 
@@ -536,7 +534,7 @@ Proof.
   simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b).
   intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H17 H16)).
   rewrite <- H4; apply RList_P7;
-    [ assumption | simpl in |- *; right; left; reflexivity ].
+    [ assumption | simpl; right; left; reflexivity ].
   clear Hrecs3; induction  lf2 as [| r5 lf2 Hreclf2].
   simpl in H11; discriminate.
   clear Hreclf2; assert (H17 : r3 = r4).
@@ -546,31 +544,31 @@ Proof.
         simpl in H18; rewrite <- (H17 x).
   rewrite <- (H18 x).
   reflexivity.
-  rewrite <- H12; unfold x in |- *; split.
+  rewrite <- H12; unfold x; split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double;
             apply Rplus_lt_compat_l; assumption
             | discrR ] ].
-  unfold x in |- *; split.
+  unfold x; split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   apply Rlt_trans with s2;
     [ apply Rmult_lt_reg_l with 2;
       [ prove_sup0
-        | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+        | unfold Rdiv; rewrite <- (Rmult_comm (/ 2));
           rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
             [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double;
               apply Rplus_lt_compat_l; assumption
@@ -578,8 +576,8 @@ Proof.
       | assumption ].
   assert (H18 : f s2 = r3).
   apply (H8 0%nat);
-    [ simpl in |- *; apply lt_O_Sn
-      | unfold open_interval in |- *; simpl in |- *; split; assumption ].
+    [ simpl; apply lt_O_Sn
+      | unfold open_interval; simpl; split; assumption ].
   assert (H19 : r3 = r5).
   assert (H19 := H7 1%nat); simpl in H19;
     assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20;
@@ -589,18 +587,18 @@ Proof.
       rewrite <- (H22 (lt_O_Sn _) x).
   rewrite <- (H23 (lt_n_S _ _ (lt_O_Sn _)) x).
   reflexivity.
-  unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split.
+  unfold open_interval; simpl; unfold x; split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
-            unfold Rmin in |- *; case (Rle_dec r1 r0); intro;
+            unfold Rmin; case (Rle_dec r1 r0); intro;
               assumption
             | discrR ] ].
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double;
             apply Rlt_le_trans with (r0 + Rmin r1 r0);
@@ -608,20 +606,20 @@ Proof.
                 assumption
                 | apply Rplus_le_compat_l; apply Rmin_r ]
             | discrR ] ].
-  unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split.
+  unfold open_interval; simpl; unfold x; split.
   apply Rlt_trans with s2;
     [ assumption
       | apply Rmult_lt_reg_l with 2;
         [ prove_sup0
-          | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+          | unfold Rdiv; rewrite <- (Rmult_comm (/ 2));
             rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
               [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
-                unfold Rmin in |- *; case (Rle_dec r1 r0);
+                unfold Rmin; case (Rle_dec r1 r0);
                   intro; assumption
                 | discrR ] ] ].
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double;
             apply Rlt_le_trans with (r1 + Rmin r1 r0);
@@ -638,20 +636,20 @@ Proof.
         | elim H24; rewrite <- H17; assumption ].
   elim H2; clear H2; intros; assert (H17 := H16 0%nat); simpl in H17;
     elim (H17 (lt_O_Sn _)); assumption.
-  rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl in |- *; apply lt_O_Sn.
+  rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl; apply lt_O_Sn.
 Qed.
 
 Lemma StepFun_P12 :
   forall (a b:R) (f:R -> R) (l lf:Rlist),
     adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf.
 Proof.
-  unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros;
+  unfold adapted_couple_opt; unfold adapted_couple; intros;
     decompose [and] H; clear H; repeat split; try assumption.
-  rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro;
+  rewrite H0; unfold Rmin; case (Rle_dec a b); intro;
     case (Rle_dec b a); intro; try reflexivity.
   apply Rle_antisym; assumption.
   apply Rle_antisym; auto with real.
-  rewrite H3; unfold Rmax in |- *; case (Rle_dec a b); intro;
+  rewrite H3; unfold Rmax; case (Rle_dec a b); intro;
     case (Rle_dec b a); intro; try reflexivity.
   apply Rle_antisym; assumption.
   apply Rle_antisym; auto with real.
@@ -691,10 +689,10 @@ Proof.
     case (Req_dec a b); intro.
   rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity.
   assert (Hyp_min : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   assert (Hyp_max : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H;
     rewrite H5; induction  lf1 as [| r3 lf1 Hreclf1].
@@ -718,34 +716,34 @@ Proof.
   rewrite <- (H20 (lt_O_Sn _) x).
   reflexivity.
   assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; intro;
-    [ idtac | elim H7; assumption ]; unfold x in |- *;
+    [ idtac | elim H7; assumption ]; unfold x;
       split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H
             | discrR ] ].
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double;
             apply Rplus_lt_compat_l; apply H
             | discrR ] ].
   rewrite <- H6; assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21;
-    intro; [ idtac | elim H7; assumption ]; unfold x in |- *;
+    intro; [ idtac | elim H7; assumption ]; unfold x;
       split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H
             | discrR ] ].
   apply Rlt_le_trans with r1;
     [ apply Rmult_lt_reg_l with 2;
       [ prove_sup0
-        | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+        | unfold Rdiv; rewrite <- (Rmult_comm (/ 2));
           rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
             [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double;
               apply Rplus_lt_compat_l; apply H
@@ -754,64 +752,64 @@ Proof.
   eapply StepFun_P13.
   apply H4.
   apply H2.
-  unfold adapted_couple_opt in |- *; split.
+  unfold adapted_couple_opt; split.
   apply H.
   rewrite H5 in H3; apply H3.
   assert (H8 : r1 <= s2).
   eapply StepFun_P13.
   apply H4.
   apply H2.
-  unfold adapted_couple_opt in |- *; split.
+  unfold adapted_couple_opt; split.
   apply H.
   rewrite H5 in H3; apply H3.
   elim H7; intro.
-  simpl in |- *; elim H8; intro.
+  simpl; elim H8; intro.
   replace (r4 * (s2 - s1)) with (r3 * (r1 - r) + r3 * (s2 - r1));
   [ idtac | rewrite H9; rewrite H6; ring ].
   rewrite Rplus_assoc; apply Rplus_eq_compat_l;
     change
       (Int_SF lf1 (cons r1 r2) = Int_SF (cons r3 lf2) (cons r1 (cons s2 s3)))
-      in |- *; apply H0 with r1 b.
+     ; apply H0 with r1 b.
   unfold adapted_couple in H2; decompose [and] H2; clear H2;
     replace b with (Rmax a b).
   rewrite <- H12; apply RList_P7;
-    [ assumption | simpl in |- *; right; left; reflexivity ].
+    [ assumption | simpl; right; left; reflexivity ].
   eapply StepFun_P7.
   apply H1.
   apply H2.
-  unfold adapted_couple_opt in |- *; split.
+  unfold adapted_couple_opt; split.
   apply StepFun_P7 with a a r3.
   apply H1.
   unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H;
     clear H H2; assert (H20 : r = a).
   simpl in H13; rewrite H13; apply Hyp_min.
-  unfold adapted_couple in |- *; repeat split.
-  unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
-  simpl in |- *; rewrite <- H20; apply (H11 0%nat).
-  simpl in |- *; apply lt_O_Sn.
+  unfold adapted_couple; repeat split.
+  unfold ordered_Rlist; intros; simpl in H; induction  i as [| i Hreci].
+  simpl; rewrite <- H20; apply (H11 0%nat).
+  simpl; apply lt_O_Sn.
   induction  i as [| i Hreci0].
-  simpl in |- *; assumption.
-  change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *;
-    apply (H15 (S i)); simpl in |- *; apply lt_S_n; assumption.
-  simpl in |- *; symmetry  in |- *; apply Hyp_min.
+  simpl; assumption.
+  change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i));
+    apply (H15 (S i)); simpl; apply lt_S_n; assumption.
+  simpl; symmetry ; apply Hyp_min.
   rewrite <- H17; reflexivity.
-  simpl in H19; simpl in |- *; rewrite H19; reflexivity.
-  intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
+  simpl in H19; simpl; rewrite H19; reflexivity.
+  intros; simpl in H; unfold constant_D_eq, open_interval; intros;
     induction  i as [| i Hreci].
-  simpl in |- *; apply (H16 0%nat).
-  simpl in |- *; apply lt_O_Sn.
-  simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *;
-    simpl in |- *; apply H2.
+  simpl; apply (H16 0%nat).
+  simpl; apply lt_O_Sn.
+  simpl in H2; rewrite <- H20 in H2; unfold open_interval;
+    simpl; apply H2.
   clear Hreci; induction  i as [| i Hreci].
-  simpl in |- *; simpl in H2; rewrite H9; apply (H21 0%nat).
-  simpl in |- *; apply lt_O_Sn.
-  unfold open_interval in |- *; simpl in |- *; elim H2; intros; split.
+  simpl; simpl in H2; rewrite H9; apply (H21 0%nat).
+  simpl; apply lt_O_Sn.
+  unfold open_interval; simpl; elim H2; intros; split.
   apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat);
-    simpl in |- *; apply lt_O_Sn.
+    simpl; apply lt_O_Sn.
   assumption.
-  clear Hreci; simpl in |- *; apply (H21 (S i)).
-  simpl in |- *; apply lt_S_n; assumption.
-  unfold open_interval in |- *; apply H2.
+  clear Hreci; simpl; apply (H21 (S i)).
+  simpl; apply lt_S_n; assumption.
+  unfold open_interval; apply H2.
   elim H3; clear H3; intros; split.
   rewrite H9;
     change
@@ -819,64 +817,64 @@ Proof.
         (i < pred (Rlength (cons r4 lf2)))%nat ->
         pos_Rl (cons r4 lf2) i <> pos_Rl (cons r4 lf2) (S i) \/
         f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r4 lf2) i)
-      in |- *; rewrite <- H5; apply H3.
+     ; rewrite <- H5; apply H3.
   rewrite H5 in H11; intros; simpl in H12; induction  i as [| i Hreci].
-  simpl in |- *; red in |- *; intro; rewrite H13 in H10;
+  simpl; red; intro; rewrite H13 in H10;
     elim (Rlt_irrefl _ H10).
-  clear Hreci; apply (H11 (S i)); simpl in |- *; apply H12.
+  clear Hreci; apply (H11 (S i)); simpl; apply H12.
   rewrite H9; rewrite H10; rewrite H6; apply Rplus_eq_compat_l; rewrite <- H10;
     apply H0 with r1 b.
   unfold adapted_couple in H2; decompose [and] H2; clear H2;
     replace b with (Rmax a b).
   rewrite <- H12; apply RList_P7;
-    [ assumption | simpl in |- *; right; left; reflexivity ].
+    [ assumption | simpl; right; left; reflexivity ].
   eapply StepFun_P7.
   apply H1.
   apply H2.
-  unfold adapted_couple_opt in |- *; split.
+  unfold adapted_couple_opt; split.
   apply StepFun_P7 with a a r3.
   apply H1.
   unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H;
     clear H H2; assert (H20 : r = a).
   simpl in H13; rewrite H13; apply Hyp_min.
-  unfold adapted_couple in |- *; repeat split.
-  unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
-  simpl in |- *; rewrite <- H20; apply (H11 0%nat); simpl in |- *;
+  unfold adapted_couple; repeat split.
+  unfold ordered_Rlist; intros; simpl in H; induction  i as [| i Hreci].
+  simpl; rewrite <- H20; apply (H11 0%nat); simpl;
     apply lt_O_Sn.
-  rewrite H10; apply (H15 (S i)); simpl in |- *; assumption.
-  simpl in |- *; symmetry  in |- *; apply Hyp_min.
+  rewrite H10; apply (H15 (S i)); simpl; assumption.
+  simpl; symmetry ; apply Hyp_min.
   rewrite <- H17; rewrite H10; reflexivity.
-  simpl in H19; simpl in |- *; apply H19.
-  intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
+  simpl in H19; simpl; apply H19.
+  intros; simpl in H; unfold constant_D_eq, open_interval; intros;
     induction  i as [| i Hreci].
-  simpl in |- *; apply (H16 0%nat).
-  simpl in |- *; apply lt_O_Sn.
-  simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *;
-    simpl in |- *; apply H2.
-  clear Hreci; simpl in |- *; apply (H21 (S i)).
-  simpl in |- *; assumption.
-  rewrite <- H10; unfold open_interval in |- *; apply H2.
+  simpl; apply (H16 0%nat).
+  simpl; apply lt_O_Sn.
+  simpl in H2; rewrite <- H20 in H2; unfold open_interval;
+    simpl; apply H2.
+  clear Hreci; simpl; apply (H21 (S i)).
+  simpl; assumption.
+  rewrite <- H10; unfold open_interval; apply H2.
   elim H3; clear H3; intros; split.
   rewrite H5 in H3; intros; apply (H3 (S i)).
-  simpl in |- *; replace (Rlength lf2) with (S (pred (Rlength lf2))).
+  simpl; replace (Rlength lf2) with (S (pred (Rlength lf2))).
   apply lt_n_S; apply H12.
-  symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+  symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red;
     intro; rewrite <- H13 in H12; elim (lt_n_O _ H12).
   intros; simpl in H12; rewrite H10; rewrite H5 in H11; apply (H11 (S i));
-    simpl in |- *; apply lt_n_S; apply H12.
-  simpl in |- *; rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    simpl; apply lt_n_S; apply H12.
+  simpl; rewrite H9; unfold Rminus; rewrite Rplus_opp_r;
     rewrite Rmult_0_r; rewrite Rplus_0_l;
       change
         (Int_SF lf1 (cons r1 r2) = Int_SF (cons r4 lf2) (cons s1 (cons s2 s3)))
-        in |- *; eapply H0.
+       ; eapply H0.
   apply H1.
-  2: rewrite H5 in H3; unfold adapted_couple_opt in |- *; split; assumption.
+  2: rewrite H5 in H3; unfold adapted_couple_opt; split; assumption.
   assert (H10 : r = a).
   unfold adapted_couple in H2; decompose [and] H2; clear H2; simpl in H12;
     rewrite H12; apply Hyp_min.
   rewrite <- H9; rewrite H10; apply StepFun_P7 with a r r3;
     [ apply H1
-      | pattern a at 2 in |- *; rewrite <- H10; pattern r at 2 in |- *; rewrite H9;
+      | pattern a at 2; rewrite <- H10; pattern r at 2; rewrite H9;
         apply H2 ].
 Qed.
 
@@ -920,12 +918,12 @@ Qed.
 Lemma StepFun_P18 :
   forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a).
 Proof.
-  intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+  intros; unfold RiemannInt_SF; case (Rle_dec a b); intro.
   replace
   (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c)))
     (subdivision (mkStepFun (StepFun_P4 a b c)))) with
   (Int_SF (cons c nil) (cons a (cons b nil)));
-  [ simpl in |- *; ring
+  [ simpl; ring
     | apply StepFun_P17 with (fct_cte c) a b;
       [ apply StepFun_P3; assumption
         | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ].
@@ -933,7 +931,7 @@ Proof.
   (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c)))
     (subdivision (mkStepFun (StepFun_P4 a b c)))) with
   (Int_SF (cons c nil) (cons b (cons a nil)));
-  [ simpl in |- *; ring
+  [ simpl; ring
     | apply StepFun_P17 with (fct_cte c) a b;
       [ apply StepFun_P2; apply StepFun_P3; auto with real
         | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ].
@@ -945,8 +943,8 @@ Lemma StepFun_P19 :
     Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1.
 Proof.
   intros; induction  l1 as [| r l1 Hrecl1];
-    [ simpl in |- *; ring
-      | induction  l1 as [| r0 l1 Hrecl0]; simpl in |- *;
+    [ simpl; ring
+      | induction  l1 as [| r0 l1 Hrecl0]; simpl;
         [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ].
 Qed.
 
@@ -956,38 +954,38 @@ Lemma StepFun_P20 :
 Proof.
   intros l f H; induction l;
     [ elim (lt_irrefl _ H)
-      | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ].
+      | simpl; rewrite RList_P18; rewrite RList_P14; reflexivity ].
 Qed.
 
 Lemma StepFun_P21 :
   forall (a b:R) (f:R -> R) (l:Rlist),
     is_subdivision f a b l -> adapted_couple f a b l (FF l f).
 Proof.
-  intros; unfold adapted_couple in |- *; unfold is_subdivision in X;
+  intros; unfold adapted_couple; unfold is_subdivision in X;
     unfold adapted_couple in X; elim X; clear X; intros;
       decompose [and] p; clear p; repeat split; try assumption.
   apply StepFun_P20; rewrite H2; apply lt_O_Sn.
   intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5;
-    unfold constant_D_eq, open_interval in |- *; intros;
+    unfold constant_D_eq, open_interval; intros;
       induction  l as [| r l Hrecl].
   discriminate.
-  unfold FF in |- *; rewrite RList_P12.
-  simpl in |- *;
-    change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))) in |- *;
+  unfold FF; rewrite RList_P12.
+  simpl;
+    change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i)));
       rewrite RList_P13; try assumption; rewrite (H5 x0 H6);
         rewrite H5.
   reflexivity.
   split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; elim H6;
             intros; apply Rlt_trans with x0; assumption
             | discrR ] ].
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double;
             rewrite (Rplus_comm (pos_Rl (cons r l) i));
@@ -1003,22 +1001,22 @@ Lemma StepFun_P22 :
     is_subdivision f a b lf ->
     is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg).
 Proof.
-  unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0;
+  unfold is_subdivision; intros a b f g lf lg Hyp X X0; elim X; elim X0;
     clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   assert (Hyp_max : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0;
     decompose [and] p; decompose [and] p0; clear p p0;
       rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0;
-        rewrite Hyp_max in H5; unfold adapted_couple in |- *;
+        rewrite Hyp_max in H5; unfold adapted_couple;
           repeat split.
   apply RList_P2; assumption.
-  rewrite Hyp_min; symmetry  in |- *; apply Rle_antisym.
+  rewrite Hyp_min; symmetry ; apply Rle_antisym.
   induction  lf as [| r lf Hreclf].
-  simpl in |- *; right; symmetry  in |- *; assumption.
+  simpl; right; symmetry ; assumption.
   assert
     (H10 :
       In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)).
@@ -1026,7 +1024,7 @@ Proof.
     (RList_P3 (cons_ORlist (cons r lf) lg)
       (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10;
     apply H10; exists 0%nat; split;
-      [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ].
+      [ reflexivity | rewrite RList_P11; simpl; apply lt_O_Sn ].
   elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0));
     intros H12 _; assert (H13 := H12 H10); elim H13; intro.
   elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0));
@@ -1039,16 +1037,16 @@ Proof.
       clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg);
         intros; apply H17; [ assumption | apply le_O_n | assumption ].
   induction  lf as [| r lf Hreclf].
-  simpl in |- *; right; assumption.
+  simpl; right; assumption.
   assert (H8 : In a (cons_ORlist (cons r lf) lg)).
   elim (RList_P9 (cons r lf) lg a); intros; apply H10; left;
     elim (RList_P3 (cons r lf) a); intros; apply H12;
       exists 0%nat; split;
-        [ symmetry  in |- *; assumption | simpl in |- *; apply lt_O_Sn ].
+        [ symmetry ; assumption | simpl; apply lt_O_Sn ].
   apply RList_P5; [ apply RList_P2; assumption | assumption ].
   rewrite Hyp_max; apply Rle_antisym.
   induction  lf as [| r lf Hreclf].
-  simpl in |- *; right; assumption.
+  simpl; right; assumption.
   assert
     (H8 :
       In
@@ -1061,7 +1059,7 @@ Proof.
         (pred (Rlength (cons_ORlist (cons r lf) lg)))));
     intros _ H10; apply H10;
       exists (pred (Rlength (cons_ORlist (cons r lf) lg)));
-        split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ].
+        split; [ reflexivity | rewrite RList_P11; simpl; apply lt_n_Sn ].
   elim
     (RList_P9 (cons r lf) lg
       (pos_Rl (cons_ORlist (cons r lf) lg)
@@ -1076,8 +1074,8 @@ Proof.
       elim H15; clear H15; intros; rewrite H15; rewrite <- H5;
         elim (RList_P6 (cons r lf)); intros; apply H17;
           [ assumption
-            | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption
-            | simpl in |- *; apply lt_n_Sn ].
+            | simpl; simpl in H14; apply lt_n_Sm_le; assumption
+            | simpl; apply lt_n_Sn ].
   elim
     (RList_P3 lg
       (pos_Rl (cons_ORlist (cons r lf) lg)
@@ -1085,23 +1083,23 @@ Proof.
     intros H13 _; assert (H14 := H13 H12); elim H14; intros;
       elim H15; clear H15; intros.
   rewrite H15; assert (H17 : Rlength lg = S (pred (Rlength lg))).
-  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+  apply S_pred with 0%nat; apply neq_O_lt; red; intro;
     rewrite <- H17 in H16; elim (lt_n_O _ H16).
   rewrite <- H0; elim (RList_P6 lg); intros; apply H18;
     [ assumption
       | rewrite H17 in H16; apply lt_n_Sm_le; assumption
       | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ].
   induction  lf as [| r lf Hreclf].
-  simpl in |- *; right; symmetry  in |- *; assumption.
+  simpl; right; symmetry ; assumption.
   assert (H8 : In b (cons_ORlist (cons r lf) lg)).
   elim (RList_P9 (cons r lf) lg b); intros; apply H10; left;
     elim (RList_P3 (cons r lf) b); intros; apply H12;
       exists (pred (Rlength (cons r lf))); split;
-        [ symmetry  in |- *; assumption | simpl in |- *; apply lt_n_Sn ].
+        [ symmetry ; assumption | simpl; apply lt_n_Sn ].
   apply RList_P7; [ apply RList_P2; assumption | assumption ].
-  apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl in |- *;
+  apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl;
     apply lt_O_Sn.
-  intros; unfold constant_D_eq, open_interval in |- *; intros;
+  intros; unfold constant_D_eq, open_interval; intros;
     cut
       (exists l : R,
         constant_D_eq f
@@ -1111,10 +1109,10 @@ Proof.
     assert
       (Hyp_cons :
         exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)).
-  apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
+  apply RList_P19; red; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
   elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons;
-    unfold FF in |- *; rewrite RList_P12.
-  change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *;
+    unfold FF; rewrite RList_P12.
+  change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i)));
     rewrite <- Hyp_cons; rewrite RList_P13.
   assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro.
   unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10);
@@ -1126,13 +1124,13 @@ Proof.
   split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double;
             rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i));
@@ -1151,7 +1149,7 @@ Proof.
   apply le_O_n.
   apply lt_trans with (pred (Rlength (cons_ORlist lf lg)));
     [ assumption
-      | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro;
+      | apply lt_pred_n_n; apply neq_O_lt; red; intro;
         rewrite <- H13 in H8; elim (lt_n_O _ H8) ].
   assumption.
   assumption.
@@ -1162,7 +1160,7 @@ Proof.
   elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11.
   apply RList_P2; assumption.
   apply lt_n_Sm_le; apply lt_n_S; assumption.
-  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8;
+  apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H13 in H8;
     elim (lt_n_O _ H8).
   rewrite H0; assumption.
   set
@@ -1170,24 +1168,24 @@ Proof.
       fun j:nat =>
         pos_Rl lf j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lf)%nat);
     assert (H12 : Nbound I).
-  unfold Nbound in |- *; exists (Rlength lf); intros; unfold I in H12; elim H12;
+  unfold Nbound; exists (Rlength lf); intros; unfold I in H12; elim H12;
     intros; apply lt_le_weak; assumption.
   assert (H13 :  exists n : nat, I n).
-  exists 0%nat; unfold I in |- *; split.
+  exists 0%nat; unfold I; split.
   apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0).
-  right; symmetry  in |- *.
+  right; symmetry .
   apply RList_P15; try assumption; rewrite H1; assumption.
   elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13.
   apply RList_P2; assumption.
   apply le_O_n.
   apply lt_trans with (pred (Rlength (cons_ORlist lf lg))).
   assumption.
-  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H15 in H8;
+  apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H15 in H8;
     elim (lt_n_O _ H8).
-  apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5;
+  apply neq_O_lt; red; intro; rewrite <- H13 in H5;
     rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11).
   assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14;
-    exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *;
+    exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval;
       intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (Rlength lf))%nat).
   elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros;
     apply lt_S_n; replace (S (pred (Rlength lf))) with (Rlength lf).
@@ -1205,11 +1203,11 @@ Proof.
   elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21.
   apply RList_P2; assumption.
   apply lt_n_Sm_le; apply lt_n_S; assumption.
-  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8;
+  apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H23 in H8;
     elim (lt_n_O _ H8).
   right; apply RList_P16; try assumption; rewrite H0; assumption.
   rewrite <- H20; reflexivity.
-  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+  apply S_pred with 0%nat; apply neq_O_lt; red; intro;
     rewrite <- H19 in H18; elim (lt_n_O _ H18).
   assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18;
     rewrite (H18 x1).
@@ -1221,11 +1219,11 @@ Proof.
   assert (H22 : (S x0 < Rlength lf)%nat).
   replace (Rlength lf) with (S (pred (Rlength lf)));
   [ apply lt_n_S; assumption
-    | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+    | symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red;
       intro; rewrite <- H22 in H21; elim (lt_n_O _ H21) ].
   elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
   assert (H23 : (S x0 <= x0)%nat).
-  apply H20; unfold I in |- *; split; assumption.
+  apply H20; unfold I; split; assumption.
   elim (le_Sn_n _ H23).
   assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lf (S x0)).
   auto with real.
@@ -1255,22 +1253,22 @@ Lemma StepFun_P24 :
     is_subdivision f a b lf ->
     is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg).
 Proof.
-  unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0;
+  unfold is_subdivision; intros a b f g lf lg Hyp X X0; elim X; elim X0;
     clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   assert (Hyp_max : Rmax a b = b).
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0;
     decompose [and] p; decompose [and] p0; clear p p0;
       rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0;
-        rewrite Hyp_max in H5; unfold adapted_couple in |- *;
+        rewrite Hyp_max in H5; unfold adapted_couple;
           repeat split.
   apply RList_P2; assumption.
-  rewrite Hyp_min; symmetry  in |- *; apply Rle_antisym.
+  rewrite Hyp_min; symmetry ; apply Rle_antisym.
   induction  lf as [| r lf Hreclf].
-  simpl in |- *; right; symmetry  in |- *; assumption.
+  simpl; right; symmetry ; assumption.
   assert
     (H10 :
       In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)).
@@ -1278,7 +1276,7 @@ Proof.
     (RList_P3 (cons_ORlist (cons r lf) lg)
       (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10;
     apply H10; exists 0%nat; split;
-      [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ].
+      [ reflexivity | rewrite RList_P11; simpl; apply lt_O_Sn ].
   elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0));
     intros H12 _; assert (H13 := H12 H10); elim H13; intro.
   elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0));
@@ -1291,16 +1289,16 @@ Proof.
       clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg);
         intros; apply H17; [ assumption | apply le_O_n | assumption ].
   induction  lf as [| r lf Hreclf].
-  simpl in |- *; right; assumption.
+  simpl; right; assumption.
   assert (H8 : In a (cons_ORlist (cons r lf) lg)).
   elim (RList_P9 (cons r lf) lg a); intros; apply H10; left;
     elim (RList_P3 (cons r lf) a); intros; apply H12;
       exists 0%nat; split;
-        [ symmetry  in |- *; assumption | simpl in |- *; apply lt_O_Sn ].
+        [ symmetry ; assumption | simpl; apply lt_O_Sn ].
   apply RList_P5; [ apply RList_P2; assumption | assumption ].
   rewrite Hyp_max; apply Rle_antisym.
   induction  lf as [| r lf Hreclf].
-  simpl in |- *; right; assumption.
+  simpl; right; assumption.
   assert
     (H8 :
       In
@@ -1313,7 +1311,7 @@ Proof.
         (pred (Rlength (cons_ORlist (cons r lf) lg)))));
     intros _ H10; apply H10;
       exists (pred (Rlength (cons_ORlist (cons r lf) lg)));
-        split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ].
+        split; [ reflexivity | rewrite RList_P11; simpl; apply lt_n_Sn ].
   elim
     (RList_P9 (cons r lf) lg
       (pos_Rl (cons_ORlist (cons r lf) lg)
@@ -1327,8 +1325,8 @@ Proof.
       elim H15; clear H15; intros; rewrite H15; rewrite <- H5;
         elim (RList_P6 (cons r lf)); intros; apply H17;
           [ assumption
-            | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption
-            | simpl in |- *; apply lt_n_Sn ].
+            | simpl; simpl in H14; apply lt_n_Sm_le; assumption
+            | simpl; apply lt_n_Sn ].
   elim
     (RList_P3 lg
       (pos_Rl (cons_ORlist (cons r lf) lg)
@@ -1336,23 +1334,23 @@ Proof.
     intros H13 _; assert (H14 := H13 H12); elim H14; intros;
       elim H15; clear H15; intros; rewrite H15;
         assert (H17 : Rlength lg = S (pred (Rlength lg))).
-  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+  apply S_pred with 0%nat; apply neq_O_lt; red; intro;
     rewrite <- H17 in H16; elim (lt_n_O _ H16).
   rewrite <- H0; elim (RList_P6 lg); intros; apply H18;
     [ assumption
       | rewrite H17 in H16; apply lt_n_Sm_le; assumption
       | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ].
   induction  lf as [| r lf Hreclf].
-  simpl in |- *; right; symmetry  in |- *; assumption.
+  simpl; right; symmetry ; assumption.
   assert (H8 : In b (cons_ORlist (cons r lf) lg)).
   elim (RList_P9 (cons r lf) lg b); intros; apply H10; left;
     elim (RList_P3 (cons r lf) b); intros; apply H12;
       exists (pred (Rlength (cons r lf))); split;
-        [ symmetry  in |- *; assumption | simpl in |- *; apply lt_n_Sn ].
+        [ symmetry ; assumption | simpl; apply lt_n_Sn ].
   apply RList_P7; [ apply RList_P2; assumption | assumption ].
-  apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl in |- *;
+  apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl;
     apply lt_O_Sn.
-  unfold constant_D_eq, open_interval in |- *; intros;
+  unfold constant_D_eq, open_interval; intros;
     cut
       (exists l : R,
         constant_D_eq g
@@ -1362,10 +1360,10 @@ Proof.
     assert
       (Hyp_cons :
         exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)).
-  apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
+  apply RList_P19; red; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
   elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons;
-    unfold FF in |- *; rewrite RList_P12.
-  change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *;
+    unfold FF; rewrite RList_P12.
+  change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i)));
     rewrite <- Hyp_cons; rewrite RList_P13.
   assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro.
   unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10);
@@ -1377,13 +1375,13 @@ Proof.
   split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double;
             rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i));
@@ -1402,7 +1400,7 @@ Proof.
   apply le_O_n.
   apply lt_trans with (pred (Rlength (cons_ORlist lf lg)));
     [ assumption
-      | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro;
+      | apply lt_pred_n_n; apply neq_O_lt; red; intro;
         rewrite <- H13 in H8; elim (lt_n_O _ H8) ].
   rewrite H1; assumption.
   apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
@@ -1411,7 +1409,7 @@ Proof.
   elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11.
   apply RList_P2; assumption.
   apply lt_n_Sm_le; apply lt_n_S; assumption.
-  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8;
+  apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H13 in H8;
     elim (lt_n_O _ H8).
   rewrite H0; assumption.
   set
@@ -1419,24 +1417,24 @@ Proof.
       fun j:nat =>
         pos_Rl lg j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lg)%nat);
     assert (H12 : Nbound I).
-  unfold Nbound in |- *; exists (Rlength lg); intros; unfold I in H12; elim H12;
+  unfold Nbound; exists (Rlength lg); intros; unfold I in H12; elim H12;
     intros; apply lt_le_weak; assumption.
   assert (H13 :  exists n : nat, I n).
-  exists 0%nat; unfold I in |- *; split.
+  exists 0%nat; unfold I; split.
   apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0).
-  right; symmetry  in |- *; rewrite H1; rewrite <- H6; apply RList_P15;
+  right; symmetry ; rewrite H1; rewrite <- H6; apply RList_P15;
     try assumption; rewrite H1; assumption.
   elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13;
     [ apply RList_P2; assumption
       | apply le_O_n
       | apply lt_trans with (pred (Rlength (cons_ORlist lf lg)));
         [ assumption
-          | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro;
+          | apply lt_pred_n_n; apply neq_O_lt; red; intro;
             rewrite <- H15 in H8; elim (lt_n_O _ H8) ] ].
-  apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0;
+  apply neq_O_lt; red; intro; rewrite <- H13 in H0;
     rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11).
   assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14;
-    exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *;
+    exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval;
       intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (Rlength lg))%nat).
   elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros;
     apply lt_S_n; replace (S (pred (Rlength lg))) with (Rlength lg).
@@ -1454,12 +1452,12 @@ Proof.
   elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21.
   apply RList_P2; assumption.
   apply lt_n_Sm_le; apply lt_n_S; assumption.
-  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8;
+  apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H23 in H8;
     elim (lt_n_O _ H8).
   right; rewrite H0; rewrite <- H5; apply RList_P16; try assumption.
   rewrite H0; assumption.
   rewrite <- H20; reflexivity.
-  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+  apply S_pred with 0%nat; apply neq_O_lt; red; intro;
     rewrite <- H19 in H18; elim (lt_n_O _ H18).
   assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18;
     rewrite (H18 x1).
@@ -1471,11 +1469,11 @@ Proof.
   assert (H22 : (S x0 < Rlength lg)%nat).
   replace (Rlength lg) with (S (pred (Rlength lg))).
   apply lt_n_S; assumption.
-  symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+  symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red;
     intro; rewrite <- H22 in H21; elim (lt_n_O _ H21).
   elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
   assert (H23 : (S x0 <= x0)%nat);
-    [ apply H20; unfold I in |- *; split; assumption | elim (le_Sn_n _ H23) ].
+    [ apply H20; unfold I; split; assumption | elim (le_Sn_n _ H23) ].
   assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lg (S x0)).
   auto with real.
   clear b0; apply RList_P17; try assumption;
@@ -1511,35 +1509,35 @@ Proof.
   intros i H8 x1 H10; unfold open_interval in H10, H9, H4;
     rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10);
       assert (H11 : l1 <> nil).
-  red in |- *; intro H11; rewrite H11 in H8; elim (lt_n_O _ H8).
+  red; intro H11; rewrite H11 in H8; elim (lt_n_O _ H8).
   destruct (RList_P19 _ H11) as (r,(r0,H12));
-    rewrite H12; unfold FF in |- *;
+    rewrite H12; unfold FF;
       change
         (pos_Rl x0 i + l * pos_Rl x i =
           pos_Rl
           (app_Rlist (mid_Rlist (cons r r0) r) (fun x2:R => f x2 + l * g x2))
-          (S i)) in |- *; rewrite RList_P12.
+          (S i)); rewrite RList_P12.
   rewrite RList_P13.
   rewrite <- H12; rewrite (H9 _ H8); try rewrite (H4 _ H8);
     reflexivity ||
       (elim H10; clear H10; intros; split;
         [ apply Rmult_lt_reg_l with 2;
           [ prove_sup0
-            | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+            | unfold Rdiv; rewrite <- (Rmult_comm (/ 2));
               rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
                 [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
                   apply Rlt_trans with x1; assumption
                   | discrR ] ]
           | apply Rmult_lt_reg_l with 2;
             [ prove_sup0
-              | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+              | unfold Rdiv; rewrite <- (Rmult_comm (/ 2));
                 rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
                   [ rewrite Rmult_1_l; rewrite double;
                     rewrite (Rplus_comm (pos_Rl l1 i)); apply Rplus_lt_compat_l;
                       apply Rlt_trans with x1; assumption
                     | discrR ] ] ]).
   rewrite <- H12; assumption.
-  rewrite RList_P14; simpl in |- *; rewrite H12 in H8; simpl in H8;
+  rewrite RList_P14; simpl; rewrite H12 in H8; simpl in H8;
     apply lt_n_S; apply H8.
 Qed.
 
@@ -1558,7 +1556,7 @@ Qed.
 Lemma StepFun_P28 :
   forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b.
 Proof.
-  intros a b l f g; unfold IsStepFun in |- *; assert (H := pre f);
+  intros a b l f g; unfold IsStepFun; assert (H := pre f);
     assert (H0 := pre g); unfold IsStepFun in H, H0; elim H;
       elim H0; intros; apply existT with (cons_ORlist x0 x);
         apply StepFun_P27; assumption.
@@ -1567,7 +1565,7 @@ Qed.
 Lemma StepFun_P29 :
   forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f).
 Proof.
-  intros a b f; unfold is_subdivision in |- *;
+  intros a b f; unfold is_subdivision;
     apply existT with (subdivision_val f); apply StepFun_P1.
 Qed.
 
@@ -1576,7 +1574,7 @@ Lemma StepFun_P30 :
     RiemannInt_SF (mkStepFun (StepFun_P28 l f g)) =
     RiemannInt_SF f + l * RiemannInt_SF g.
 Proof.
-  intros a b l f g; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
+  intros a b l f g; unfold RiemannInt_SF; case (Rle_dec a b);
     (intro;
       replace
       (Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g)))
@@ -1613,10 +1611,10 @@ Lemma StepFun_P31 :
     adapted_couple f a b l lf ->
     adapted_couple (fun x:R => Rabs (f x)) a b l (app_Rlist lf Rabs).
 Proof.
-  unfold adapted_couple in |- *; intros; decompose [and] H; clear H;
+  unfold adapted_couple; intros; decompose [and] H; clear H;
     repeat split; try assumption.
-  symmetry  in |- *; rewrite H3; rewrite RList_P18; reflexivity.
-  intros; unfold constant_D_eq, open_interval in |- *;
+  symmetry ; rewrite H3; rewrite RList_P18; reflexivity.
+  intros; unfold constant_D_eq, open_interval;
     unfold constant_D_eq, open_interval in H5; intros;
       rewrite (H5 _ H _ H4); rewrite RList_P12;
         [ reflexivity | rewrite H3 in H; simpl in H; apply H ].
@@ -1625,8 +1623,8 @@ Qed.
 Lemma StepFun_P32 :
   forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b.
 Proof.
-  intros a b f; unfold IsStepFun in |- *; apply existT with (subdivision f);
-    unfold is_subdivision in |- *;
+  intros a b f; unfold IsStepFun; apply existT with (subdivision f);
+    unfold is_subdivision;
       apply existT with (app_Rlist (subdivision_val f) Rabs);
         apply StepFun_P31; apply StepFun_P1.
 Qed.
@@ -1636,8 +1634,8 @@ Lemma StepFun_P33 :
     ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (app_Rlist l2 Rabs) l1.
 Proof.
   simple induction l2; intros.
-  simpl in |- *; rewrite Rabs_R0; right; reflexivity.
-  simpl in |- *; induction  l1 as [| r1 l1 Hrecl1].
+  simpl; rewrite Rabs_R0; right; reflexivity.
+  simpl; induction  l1 as [| r1 l1 Hrecl1].
   rewrite Rabs_R0; right; reflexivity.
   induction  l1 as [| r2 l1 Hrecl0].
   rewrite Rabs_R0; right; reflexivity.
@@ -1645,7 +1643,7 @@ Proof.
   apply Rabs_triang.
   rewrite Rabs_mult; rewrite (Rabs_right (r2 - r1));
     [ apply Rplus_le_compat_l; apply H; apply RList_P4 with r1; assumption
-      | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *;
+      | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl;
         apply lt_O_Sn ].
 Qed.
 
@@ -1654,7 +1652,7 @@ Lemma StepFun_P34 :
     a <= b ->
     Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)).
 Proof.
-  intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+  intros; unfold RiemannInt_SF; case (Rle_dec a b); intro.
   replace
   (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f)))
     (subdivision (mkStepFun (StepFun_P32 f)))) with
@@ -1678,18 +1676,18 @@ Lemma StepFun_P35 :
 Proof.
   simple induction l; intros.
   right; reflexivity.
-  simpl in |- *; induction  r0 as [| r0 r1 Hrecr0].
+  simpl; induction  r0 as [| r0 r1 Hrecr0].
   right; reflexivity.
-  simpl in |- *; apply Rplus_le_compat.
+  simpl; apply Rplus_le_compat.
   case (Req_dec r r0); intro.
   rewrite H4; right; ring.
   do 2 rewrite <- (Rmult_comm (r0 - r)); apply Rmult_le_compat_l.
-  apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *;
+  apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl;
     apply lt_O_Sn.
   apply H3; split.
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
-  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+  unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
     rewrite <- Rinv_r_sym.
   assert (H5 : r = a).
   apply H1.
@@ -1702,7 +1700,7 @@ Proof.
   discrR.
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
-  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+  unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
     rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l; rewrite double; assert (H5 : r0 <= b).
   replace b with
@@ -1710,9 +1708,9 @@ Proof.
   replace r0 with (pos_Rl (cons r (cons r0 r1)) 1).
   elim (RList_P6 (cons r (cons r0 r1))); intros; apply H5.
   assumption.
-  simpl in |- *; apply le_n_S.
+  simpl; apply le_n_S.
   apply le_O_n.
-  simpl in |- *; apply lt_n_Sn.
+  simpl; apply lt_n_Sn.
   reflexivity.
   apply Rle_lt_trans with (r + b).
   apply Rplus_le_compat_l; assumption.
@@ -1732,7 +1730,7 @@ Proof.
   intros; apply H3; elim H4; intros; split; try assumption.
   apply Rle_lt_trans with r0; try assumption.
   rewrite <- H1.
-  simpl in |- *; apply (H0 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl; apply (H0 0%nat); simpl; apply lt_O_Sn.
 Qed.
 
 Lemma StepFun_P36 :
@@ -1743,16 +1741,16 @@ Lemma StepFun_P36 :
     (forall x:R, a < x < b -> f x <= g x) ->
     RiemannInt_SF f <= RiemannInt_SF g.
 Proof.
-  intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+  intros; unfold RiemannInt_SF; case (Rle_dec a b); intro.
   replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l).
   replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l).
   unfold is_subdivision in X; elim X; clear X; intros;
     unfold adapted_couple in p; decompose [and] p; clear p;
       assert (H5 : Rmin a b = a);
-        [ unfold Rmin in |- *; case (Rle_dec a b); intro;
+        [ unfold Rmin; case (Rle_dec a b); intro;
           [ reflexivity | elim n; assumption ]
           | assert (H7 : Rmax a b = b);
-            [ unfold Rmax in |- *; case (Rle_dec a b); intro;
+            [ unfold Rmax; case (Rle_dec a b); intro;
               [ reflexivity | elim n; assumption ]
               | rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b;
                 assumption ] ].
@@ -1811,27 +1809,27 @@ Proof.
   assert (H7 : r1 <= b).
   rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ].
   assert (H8 : IsStepFun g' a b).
-  unfold IsStepFun in |- *; assert (H8 := pre g); unfold IsStepFun in H8;
+  unfold IsStepFun; assert (H8 := pre g); unfold IsStepFun in H8;
     elim H8; intros lg H9; unfold is_subdivision in H9;
       elim H9; clear H9; intros lg2 H9; split with (cons a lg);
-        unfold is_subdivision in |- *; split with (cons (f a) lg2);
+        unfold is_subdivision; split with (cons (f a) lg2);
           unfold adapted_couple in H9; decompose [and] H9; clear H9;
-            unfold adapted_couple in |- *; repeat split.
-  unfold ordered_Rlist in |- *; intros; simpl in H9;
+            unfold adapted_couple; repeat split.
+  unfold ordered_Rlist; intros; simpl in H9;
     induction  i as [| i Hreci].
-  simpl in |- *; rewrite H12; replace (Rmin r1 b) with r1.
-  simpl in H0; rewrite <- H0; apply (H 0%nat); simpl in |- *; apply lt_O_Sn.
-  unfold Rmin in |- *; case (Rle_dec r1 b); intro;
+  simpl; rewrite H12; replace (Rmin r1 b) with r1.
+  simpl in H0; rewrite <- H0; apply (H 0%nat); simpl; apply lt_O_Sn.
+  unfold Rmin; case (Rle_dec r1 b); intro;
     [ reflexivity | elim n; assumption ].
   apply (H10 i); apply lt_S_n.
   replace (S (pred (Rlength lg))) with (Rlength lg).
   apply H9.
   apply S_pred with 0%nat; apply neq_O_lt; intro; rewrite <- H14 in H9;
     elim (lt_n_O _ H9).
-  simpl in |- *; assert (H14 : a <= b).
+  simpl; assert (H14 : a <= b).
   rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7;
     [ assumption | left; reflexivity ].
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   assert (H14 : a <= b).
   rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7;
@@ -1840,30 +1838,30 @@ Proof.
   rewrite <- H11; induction  lg as [| r0 lg Hreclg].
   simpl in H13; discriminate.
   reflexivity.
-  unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec r1 b); intros;
+  unfold Rmax; case (Rle_dec a b); case (Rle_dec r1 b); intros;
     reflexivity || elim n; assumption.
-  simpl in |- *; rewrite H13; reflexivity.
+  simpl; rewrite H13; reflexivity.
   intros; simpl in H9; induction  i as [| i Hreci].
-  unfold constant_D_eq, open_interval in |- *; simpl in |- *; intros;
+  unfold constant_D_eq, open_interval; simpl; intros;
     assert (H16 : Rmin r1 b = r1).
-  unfold Rmin in |- *; case (Rle_dec r1 b); intro;
+  unfold Rmin; case (Rle_dec r1 b); intro;
     [ reflexivity | elim n; assumption ].
   rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14;
-    unfold g' in |- *; case (Rle_dec r1 x); intro r3.
+    unfold g'; case (Rle_dec r1 x); intro r3.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)).
   reflexivity.
   change
     (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i)))
-      (pos_Rl lg2 i)) in |- *; clear Hreci; assert (H16 := H15 i);
+      (pos_Rl lg2 i)); clear Hreci; assert (H16 := H15 i);
     assert (H17 : (i < pred (Rlength lg))%nat).
   apply lt_S_n.
   replace (S (pred (Rlength lg))) with (Rlength lg).
   assumption.
-  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+  apply S_pred with 0%nat; apply neq_O_lt; red; intro;
     rewrite <- H14 in H9; elim (lt_n_O _ H9).
   assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18;
-    unfold constant_D_eq, open_interval in |- *; intros;
-      assert (H19 := H18 _ H14); rewrite <- H19; unfold g' in |- *;
+    unfold constant_D_eq, open_interval; intros;
+      assert (H19 := H18 _ H14); rewrite <- H19; unfold g';
         case (Rle_dec r1 x); intro.
   reflexivity.
   elim n; replace r1 with (Rmin r1 b).
@@ -1874,17 +1872,17 @@ Proof.
   elim (RList_P3 lg (pos_Rl lg i)); intros; apply H21; exists i; split.
   reflexivity.
   apply lt_trans with (pred (Rlength lg)); try assumption.
-  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H22 in H17;
+  apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H22 in H17;
     elim (lt_n_O _ H17).
-  unfold Rmin in |- *; case (Rle_dec r1 b); intro;
+  unfold Rmin; case (Rle_dec r1 b); intro;
     [ reflexivity | elim n0; assumption ].
   exists (mkStepFun H8); split.
-  simpl in |- *; unfold g' in |- *; case (Rle_dec r1 b); intro.
+  simpl; unfold g'; case (Rle_dec r1 b); intro.
   assumption.
   elim n; assumption.
   intros; simpl in H9; induction  i as [| i Hreci].
-  unfold constant_D_eq, co_interval in |- *; simpl in |- *; intros; simpl in H0;
-    rewrite H0; elim H10; clear H10; intros; unfold g' in |- *;
+  unfold constant_D_eq, co_interval; simpl; intros; simpl in H0;
+    rewrite H0; elim H10; clear H10; intros; unfold g';
       case (Rle_dec r1 x); intro r3.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H11)).
   reflexivity.
@@ -1892,21 +1890,21 @@ Proof.
     change
       (constant_D_eq (mkStepFun H8)
         (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i)))
-        (f (pos_Rl (cons r1 l) i))) in |- *; assert (H10 := H6 i);
+        (f (pos_Rl (cons r1 l) i))); assert (H10 := H6 i);
       assert (H11 : (i < pred (Rlength (cons r1 l)))%nat).
-  simpl in |- *; apply lt_S_n; assumption.
+  simpl; apply lt_S_n; assumption.
   assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12;
-    unfold constant_D_eq, co_interval in |- *; intros;
-      rewrite <- (H12 _ H13); simpl in |- *; unfold g' in |- *;
+    unfold constant_D_eq, co_interval; intros;
+      rewrite <- (H12 _ H13); simpl; unfold g';
         case (Rle_dec r1 x); intro.
   reflexivity.
   elim n; elim H13; clear H13; intros;
     apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption;
-      change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i) in |- *;
+      change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i);
         elim (RList_P6 (cons r1 l)); intros; apply H15;
           [ assumption
             | apply le_O_n
-            | simpl in |- *; apply lt_trans with (Rlength l);
+            | simpl; apply lt_trans with (Rlength l);
               [ apply lt_S_n; assumption | apply lt_n_Sn ] ].
 Qed.
 
@@ -1914,7 +1912,7 @@ Lemma StepFun_P39 :
   forall (a b:R) (f:StepFun a b),
     RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))).
 Proof.
-  intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); case (Rle_dec b a);
+  intros; unfold RiemannInt_SF; case (Rle_dec a b); case (Rle_dec b a);
     intros.
   assert (H : adapted_couple f a b (subdivision f) (subdivision_val f));
     [ apply StepFun_P1
@@ -1927,16 +1925,16 @@ Proof.
           | assert (H1 : a = b);
             [ apply Rle_antisym; assumption
               | rewrite (StepFun_P8 H H1); assert (H2 : b = a);
-                [ symmetry  in |- *; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ].
+                [ symmetry ; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ].
   rewrite Ropp_involutive; eapply StepFun_P17;
     [ apply StepFun_P1
       | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H;
-        elim H; intros; unfold is_subdivision in |- *;
+        elim H; intros; unfold is_subdivision;
           elim p; intros; apply p0 ].
   apply Ropp_eq_compat; eapply StepFun_P17;
     [ apply StepFun_P1
       | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H;
-        elim H; intros; unfold is_subdivision in |- *;
+        elim H; intros; unfold is_subdivision;
           elim p; intros; apply p0 ].
   assert (H : a < b);
     [ auto with real
@@ -1953,34 +1951,34 @@ Lemma StepFun_P40 :
     adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f).
 Proof.
   intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; unfold adapted_couple in H1, H2;
-    unfold adapted_couple in |- *; decompose [and] H1;
+    unfold adapted_couple; decompose [and] H1;
       decompose [and] H2; clear H1 H2; repeat split.
   apply RList_P25; try assumption.
-  rewrite H10; rewrite H4; unfold Rmin, Rmax in |- *; case (Rle_dec a b);
+  rewrite H10; rewrite H4; unfold Rmin, Rmax; case (Rle_dec a b);
     case (Rle_dec b c); intros;
       (right; reflexivity) || (elim n; left; assumption).
   rewrite RList_P22.
-  rewrite H5; unfold Rmin, Rmax in |- *; case (Rle_dec a b); case (Rle_dec a c);
+  rewrite H5; unfold Rmin, Rmax; case (Rle_dec a b); case (Rle_dec a c);
     intros;
       [ reflexivity
         | elim n; apply Rle_trans with b; left; assumption
         | elim n; left; assumption
         | elim n0; left; assumption ].
-  red in |- *; intro; rewrite H1 in H6; discriminate.
+  red; intro; rewrite H1 in H6; discriminate.
   rewrite RList_P24.
-  rewrite H9; unfold Rmin, Rmax in |- *; case (Rle_dec b c); case (Rle_dec a c);
+  rewrite H9; unfold Rmin, Rmax; case (Rle_dec b c); case (Rle_dec a c);
     intros;
       [ reflexivity
         | elim n; apply Rle_trans with b; left; assumption
         | elim n; left; assumption
         | elim n0; left; assumption ].
-  red in |- *; intro; rewrite H1 in H11; discriminate.
+  red; intro; rewrite H1 in H11; discriminate.
   apply StepFun_P20.
-  rewrite RList_P23; apply neq_O_lt; red in |- *; intro.
+  rewrite RList_P23; apply neq_O_lt; red; intro.
   assert (H2 : (Rlength l1 + Rlength l2)%nat = 0%nat).
-  symmetry  in |- *; apply H1.
+  symmetry ; apply H1.
   elim (plus_is_O _ _ H2); intros; rewrite H12 in H6; discriminate.
-  unfold constant_D_eq, open_interval in |- *; intros;
+  unfold constant_D_eq, open_interval; intros;
     elim (le_or_lt (S (S i)) (Rlength l1)); intro.
   assert (H14 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i).
   apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; apply le_S_n;
@@ -1993,28 +1991,28 @@ Proof.
   elim (RList_P20 _ H16); intros r1 [r2 [r3 H17]]; rewrite H17;
     change
       (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i)
-      in |- *; rewrite RList_P12.
+     ; rewrite RList_P12.
   induction  i as [| i Hreci].
-  simpl in |- *; assert (H18 := H8 0%nat);
+  simpl; assert (H18 := H8 0%nat);
     unfold constant_D_eq, open_interval in H18;
       assert (H19 : (0 < pred (Rlength l1))%nat).
-  rewrite H17; simpl in |- *; apply lt_O_Sn.
+  rewrite H17; simpl; apply lt_O_Sn.
   assert (H20 := H18 H19); repeat rewrite H20.
   reflexivity.
   assert (H21 : r1 <= r2).
   rewrite H17 in H3; apply (H3 0%nat).
-  simpl in |- *; apply lt_O_Sn.
+  simpl; apply lt_O_Sn.
   elim H21; intro.
   split.
-  rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2;
+  rewrite H17; simpl; apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
-  rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2;
+  rewrite H17; simpl; apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite (Rplus_comm r1); rewrite double;
             apply Rplus_lt_compat_l; assumption
@@ -2043,13 +2041,13 @@ Proof.
   split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l1 (S i)));
             rewrite double; apply Rplus_lt_compat_l; assumption
@@ -2057,21 +2055,21 @@ Proof.
   elim H2; intros; rewrite H22 in H23;
     elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)).
   assumption.
-  simpl in |- *; rewrite H17 in H1; simpl in H1; apply lt_S_n; assumption.
+  simpl; rewrite H17 in H1; simpl in H1; apply lt_S_n; assumption.
   rewrite RList_P14; rewrite H17 in H1; simpl in H1; apply H1.
   inversion H12.
   assert (H16 : pos_Rl (cons_Rlist l1 l2) (S i) = b).
   rewrite RList_P29.
-  rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin in |- *;
+  rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin;
     case (Rle_dec b c); intro; [ reflexivity | elim n; left; assumption ].
   rewrite H15; apply le_n.
   induction  l1 as [| r l1 Hrecl1].
   simpl in H15; discriminate.
-  clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption.
+  clear Hrecl1; simpl in H1; simpl; apply lt_n_S; assumption.
   assert (H17 : pos_Rl (cons_Rlist l1 l2) i = b).
   rewrite RList_P26.
   replace i with (pred (Rlength l1));
-  [ rewrite H4; unfold Rmax in |- *; case (Rle_dec a b); intro;
+  [ rewrite H4; unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; left; assumption ]
     | rewrite H15; reflexivity ].
   rewrite H15; apply lt_n_Sn.
@@ -2089,22 +2087,22 @@ Proof.
   apply le_S_n; apply le_trans with (S i); [ assumption | apply le_n_Sn ].
   induction  l1 as [| r l1 Hrecl1].
   simpl in H6; discriminate.
-  clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption.
-  symmetry  in |- *; apply minus_Sn_m; apply le_S_n; assumption.
+  clear Hrecl1; simpl in H1; simpl; apply lt_n_S; assumption.
+  symmetry ; apply minus_Sn_m; apply le_S_n; assumption.
   assert (H18 : (2 <= Rlength l1)%nat).
   clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17;
     induction  l1 as [| r l1 Hrecl1].
   discriminate.
   clear Hrecl1; induction  l1 as [| r0 l1 Hrecl1].
   simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b).
-  unfold Rmin, Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmin, Rmax; case (Rle_dec a b); intro;
     [ assumption | elim n; left; assumption ].
   rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0).
-  clear Hrecl1; simpl in |- *; repeat apply le_n_S; apply le_O_n.
+  clear Hrecl1; simpl; repeat apply le_n_S; apply le_O_n.
   elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19;
     change
       (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i)
-      in |- *; rewrite RList_P12.
+     ; rewrite RList_P12.
   induction  i as [| i Hreci].
   assert (H20 := le_S_n _ _ H15); assert (H21 := le_trans _ _ _ H18 H20);
     elim (le_Sn_O _ H21).
@@ -2122,7 +2120,7 @@ Proof.
               assert (H21 : (S i - Rlength l1 < pred (Rlength l2))%nat).
   apply lt_pred; rewrite minus_Sn_m.
   apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus.
-  rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *;
+  rewrite H19 in H1; simpl in H1; rewrite H19; simpl;
     rewrite RList_P23 in H1; apply lt_n_S; assumption.
   apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ].
   apply le_S_n; assumption.
@@ -2134,7 +2132,7 @@ Proof.
   apply H7; apply lt_pred.
   rewrite minus_Sn_m.
   apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus.
-  rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *;
+  rewrite H19 in H1; simpl in H1; rewrite H19; simpl;
     rewrite RList_P23 in H1; apply lt_n_S; assumption.
   apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ].
   apply le_S_n; assumption.
@@ -2142,13 +2140,13 @@ Proof.
   split.
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
             | discrR ] ].
   apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+      | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
         rewrite <- Rinv_r_sym;
           [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l2 (S i - Rlength l1)));
             rewrite double; apply Rplus_lt_compat_l; assumption
@@ -2159,14 +2157,14 @@ Proof.
         rewrite H17 in H26; simpl in H24; rewrite H24 in H25;
           elim (Rlt_irrefl _ (Rlt_trans _ _ _ H25 H26)).
   assert (H23 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S i - Rlength l1)).
-  rewrite H19; simpl in |- *; simpl in H16; apply H16.
+  rewrite H19; simpl; simpl in H16; apply H16.
   assert
     (H24 :
       pos_Rl (cons_Rlist l1 l2) (S (S i)) = pos_Rl l2 (S (S i - Rlength l1))).
-  rewrite H19; simpl in |- *; simpl in H17; apply H17.
+  rewrite H19; simpl; simpl in H17; apply H17.
   rewrite <- H23; rewrite <- H24; assumption.
-  simpl in |- *; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption.
-  rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl in |- *; apply H1.
+  simpl; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption.
+  rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl; apply H1.
 Qed.
 
 Lemma StepFun_P41 :
@@ -2191,11 +2189,11 @@ Lemma StepFun_P42 :
     Int_SF (FF l1 f) l1 + Int_SF (FF l2 f) l2.
 Proof.
   intros l1 l2 f; induction l1 as [| r l1 IHl1]; intros H;
-    [ simpl in |- *; ring
+    [ simpl; ring
       | destruct l1 as [| r0 r1];
-        [ simpl in H; simpl in |- *; destruct l2 as [| r0 r1];
-          [ simpl in |- *; ring | simpl in |- *; simpl in H; rewrite H; ring ]
-          | simpl in |- *; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1;
+        [ simpl in H; simpl; destruct l2 as [| r0 r1];
+          [ simpl; ring | simpl; simpl in H; rewrite H; ring ]
+          | simpl; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1;
             rewrite <- H; reflexivity ] ].
 Qed.
 
@@ -2231,27 +2229,27 @@ Proof.
   (Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)).
   replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
   replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-  symmetry  in |- *; apply StepFun_P42.
+  symmetry ; apply StepFun_P42.
   unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2;
-    clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+    clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin;
       case (Rle_dec a b); case (Rle_dec b c); intros; reflexivity || elim n;
         assumption.
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2;
+    [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2;
       assumption
       | assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+    [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1
       | assumption ].
   eapply StepFun_P17; [ apply (StepFun_P40 H H0 H1 H2) | apply H3 ].
   replace (Int_SF lf2 l2) with 0.
   rewrite Rplus_0_r; eapply StepFun_P17;
     [ apply H1 | rewrite <- H0 in H3; apply H3 ].
-  symmetry  in |- *; eapply StepFun_P8; [ apply H2 | assumption ].
+  symmetry ; eapply StepFun_P8; [ apply H2 | assumption ].
   replace (Int_SF lf1 l1) with 0.
   rewrite Rplus_0_l; eapply StepFun_P17;
     [ apply H2 | rewrite H in H3; apply H3 ].
-  symmetry  in |- *; eapply StepFun_P8; [ apply H1 | assumption ].
+  symmetry ; eapply StepFun_P8; [ apply H1 | assumption ].
   elim n; apply Rle_trans with b; assumption.
   apply Rplus_eq_reg_l with (Int_SF lf2 l2);
     replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with
@@ -2266,24 +2264,24 @@ Proof.
   replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
   apply StepFun_P42.
   unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3;
-    clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin in |- *;
+    clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin;
       case (Rle_dec a c); case (Rle_dec b c); intros;
         [ elim n; assumption
           | reflexivity
           | elim n0; assumption
           | elim n1; assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
+    [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2
       | assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
+    [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3
       | assumption ].
   eapply StepFun_P17;
     [ apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | apply H1 ].
   replace (Int_SF lf3 l3) with 0.
   rewrite Rplus_0_r; eapply StepFun_P17;
     [ apply H1 | apply StepFun_P2; rewrite <- H0 in H2; apply H2 ].
-  symmetry  in |- *; eapply StepFun_P8; [ apply H3 | assumption ].
+  symmetry ; eapply StepFun_P8; [ apply H3 | assumption ].
   replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1).
   ring.
   elim r; intro.
@@ -2291,19 +2289,19 @@ Proof.
   (Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)).
   replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
   replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-  symmetry  in |- *; apply StepFun_P42.
+  symmetry ; apply StepFun_P42.
   unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
-    clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin in |- *;
+    clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin;
       case (Rle_dec a c); case (Rle_dec a b); intros;
         [ elim n; assumption
           | elim n1; assumption
           | reflexivity
           | elim n1; assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+    [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1
       | assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
+    [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3
       | assumption ].
   eapply StepFun_P17.
   assert (H0 : c < a).
@@ -2313,7 +2311,7 @@ Proof.
   replace (Int_SF lf1 l1) with 0.
   rewrite Rplus_0_r; eapply StepFun_P17;
     [ apply H3 | rewrite <- H in H2; apply H2 ].
-  symmetry  in |- *; eapply StepFun_P8; [ apply H1 | assumption ].
+  symmetry ; eapply StepFun_P8; [ apply H1 | assumption ].
   assert (H : b < a).
   auto with real.
   replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1).
@@ -2323,19 +2321,19 @@ Proof.
   (Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)).
   replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
   replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-  symmetry  in |- *; apply StepFun_P42.
+  symmetry ; apply StepFun_P42.
   unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
-    clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+    clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin;
       case (Rle_dec a c); case (Rle_dec a b); intros;
         [ elim n; assumption
           | reflexivity
           | elim n0; assumption
           | elim n1; assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+    [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1
       | assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
+    [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3
       | assumption ].
   eapply StepFun_P17.
   apply (StepFun_P40 H H0 (StepFun_P2 H1) H3).
@@ -2343,7 +2341,7 @@ Proof.
   replace (Int_SF lf3 l3) with 0.
   rewrite Rplus_0_r; eapply StepFun_P17;
     [ apply H1 | rewrite <- H0 in H2; apply StepFun_P2; apply H2 ].
-  symmetry  in |- *; eapply StepFun_P8; [ apply H3 | assumption ].
+  symmetry ; eapply StepFun_P8; [ apply H3 | assumption ].
   assert (H : c < a).
   auto with real.
   replace (Int_SF lf1 l1) with (Int_SF lf2 l2 + Int_SF lf3 l3).
@@ -2353,19 +2351,19 @@ Proof.
   (Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)).
   replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
   replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-  symmetry  in |- *; apply StepFun_P42.
+  symmetry ; apply StepFun_P42.
   unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3;
-    clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+    clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin;
       case (Rle_dec a c); case (Rle_dec b c); intros;
         [ elim n; assumption
           | elim n1; assumption
           | reflexivity
           | elim n1; assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
+    [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2
       | assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
+    [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3
       | assumption ].
   eapply StepFun_P17.
   apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)).
@@ -2373,7 +2371,7 @@ Proof.
   replace (Int_SF lf2 l2) with 0.
   rewrite Rplus_0_l; eapply StepFun_P17;
     [ apply H3 | rewrite H0 in H1; apply H1 ].
-  symmetry  in |- *; eapply StepFun_P8; [ apply H2 | assumption ].
+  symmetry ; eapply StepFun_P8; [ apply H2 | assumption ].
   elim n; apply Rle_trans with a; try assumption.
   auto with real.
   assert (H : c < b).
@@ -2386,56 +2384,56 @@ Proof.
   (Int_SF (FF (cons_Rlist l2 l1) f) (cons_Rlist l2 l1)).
   replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
   replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-  symmetry  in |- *; apply StepFun_P42.
+  symmetry ; apply StepFun_P42.
   unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1;
-    clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+    clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin;
       case (Rle_dec a b); case (Rle_dec b c); intros;
         [ elim n1; assumption
           | elim n1; assumption
           | elim n0; assumption
           | reflexivity ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
+    [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2
       | assumption ].
   eapply StepFun_P17;
-    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+    [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1
       | assumption ].
   eapply StepFun_P17.
   apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)).
   apply StepFun_P2; apply H3.
-  unfold RiemannInt_SF in |- *; case (Rle_dec a c); intro.
+  unfold RiemannInt_SF; case (Rle_dec a c); intro.
   eapply StepFun_P17.
   apply H3.
   change
     (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3))
-      (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1.
+      (subdivision_val (mkStepFun pr3))); apply StepFun_P1.
   apply Ropp_eq_compat; eapply StepFun_P17.
   apply H3.
   change
     (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3))
-      (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1.
-  unfold RiemannInt_SF in |- *; case (Rle_dec b c); intro.
+      (subdivision_val (mkStepFun pr3))); apply StepFun_P1.
+  unfold RiemannInt_SF; case (Rle_dec b c); intro.
   eapply StepFun_P17.
   apply H2.
   change
     (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2))
-      (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1.
+      (subdivision_val (mkStepFun pr2))); apply StepFun_P1.
   apply Ropp_eq_compat; eapply StepFun_P17.
   apply H2.
   change
     (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2))
-      (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1.
-  unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+      (subdivision_val (mkStepFun pr2))); apply StepFun_P1.
+  unfold RiemannInt_SF; case (Rle_dec a b); intro.
   eapply StepFun_P17.
   apply H1.
   change
     (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1))
-      (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1.
+      (subdivision_val (mkStepFun pr1))); apply StepFun_P1.
   apply Ropp_eq_compat; eapply StepFun_P17.
   apply H1.
   change
     (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1))
-      (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1.
+      (subdivision_val (mkStepFun pr1))); apply StepFun_P1.
 Qed.
 
 Lemma StepFun_P44 :
@@ -2451,7 +2449,7 @@ Proof.
           adapted_couple f a b l1 lf1 ->
           a <= c <= b ->
           { l:Rlist & { l0:Rlist & adapted_couple f a c l l0 } }).
-  intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X.
+  intro X; unfold IsStepFun; unfold is_subdivision; eapply X.
   apply H2.
   split; assumption.
   clear f a b c H0 H H1 H2 l1 lf1; simple induction l1.
@@ -2463,11 +2461,11 @@ Proof.
     simpl in H2; assert (H7 : a <= b).
   elim H0; intros; apply Rle_trans with c; assumption.
   replace a with (Rmin a b).
-  pattern b at 2 in |- *; replace b with (Rmax a b).
+  pattern b at 2; replace b with (Rmax a b).
   rewrite <- H2; rewrite H3; reflexivity.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   split with (cons r nil); split with lf1; assert (H2 : c = b).
   rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
@@ -2481,22 +2479,22 @@ Proof.
   split with (cons r (cons c nil)); split with (cons r3 nil);
     unfold adapted_couple in H; decompose [and] H; clear H;
       assert (H6 : r = a).
-  simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intro;
+  simpl in H4; rewrite H4; unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity
       | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
-  elim H0; clear H0; intros; unfold adapted_couple in |- *; repeat split.
-  rewrite H6; unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8;
-    [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
-  simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro;
+  elim H0; clear H0; intros; unfold adapted_couple; repeat split.
+  rewrite H6; unfold ordered_Rlist; intros; simpl in H8; inversion H8;
+    [ simpl; assumption | elim (le_Sn_O _ H10) ].
+  simpl; unfold Rmin; case (Rle_dec a c); intro;
     [ assumption | elim n; assumption ].
-  simpl in |- *; unfold Rmax in |- *; case (Rle_dec a c); intro;
+  simpl; unfold Rmax; case (Rle_dec a c); intro;
     [ reflexivity | elim n; assumption ].
-  unfold constant_D_eq, open_interval in |- *; intros; simpl in H8;
+  unfold constant_D_eq, open_interval; intros; simpl in H8;
     inversion H8.
-  simpl in |- *; assert (H10 := H7 0%nat);
+  simpl; assert (H10 := H7 0%nat);
     assert (H12 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat).
-  simpl in |- *; apply lt_O_Sn.
-  apply (H10 H12); unfold open_interval in |- *; simpl in |- *;
+  simpl; apply lt_O_Sn.
+  apply (H10 H12); unfold open_interval; simpl;
     rewrite H11 in H9; simpl in H9; elim H9; clear H9;
       intros; split; try assumption.
   apply Rlt_le_trans with c; assumption.
@@ -2510,42 +2508,42 @@ Proof.
         assert (H14 : a <= b).
   elim H0; intros; apply Rle_trans with c; assumption.
   assert (H16 : r = a).
-  simpl in H7; rewrite H7; unfold Rmin in |- *; case (Rle_dec a b); intro;
+  simpl in H7; rewrite H7; unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   induction  l1' as [| r4 l1' Hrecl1'].
   simpl in H13; discriminate.
-  clear Hrecl1'; unfold adapted_couple in |- *; repeat split.
-  unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
-  simpl in |- *; replace r4 with r1.
+  clear Hrecl1'; unfold adapted_couple; repeat split.
+  unfold ordered_Rlist; intros; simpl in H; induction  i as [| i Hreci].
+  simpl; replace r4 with r1.
   apply (H5 0%nat).
-  simpl in |- *; apply lt_O_Sn.
-  simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro;
+  simpl; apply lt_O_Sn.
+  simpl in H12; rewrite H12; unfold Rmin; case (Rle_dec r1 c); intro;
     [ reflexivity | elim n; left; assumption ].
-  apply (H9 i); simpl in |- *; apply lt_S_n; assumption.
-  simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro;
+  apply (H9 i); simpl; apply lt_S_n; assumption.
+  simpl; unfold Rmin; case (Rle_dec a c); intro;
     [ assumption | elim n; elim H0; intros; assumption ].
   replace (Rmax a c) with (Rmax r1 c).
   rewrite <- H11; reflexivity.
-  unfold Rmax in |- *; case (Rle_dec r1 c); case (Rle_dec a c); intros;
+  unfold Rmax; case (Rle_dec r1 c); case (Rle_dec a c); intros;
     [ reflexivity
       | elim n; elim H0; intros; assumption
       | elim n; left; assumption
       | elim n0; left; assumption ].
-  simpl in |- *; simpl in H13; rewrite H13; reflexivity.
-  intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
+  simpl; simpl in H13; rewrite H13; reflexivity.
+  intros; simpl in H; unfold constant_D_eq, open_interval; intros;
     induction  i as [| i Hreci].
-  simpl in |- *; assert (H17 := H10 0%nat);
+  simpl; assert (H17 := H10 0%nat);
     assert (H18 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat).
-  simpl in |- *; apply lt_O_Sn.
-  apply (H17 H18); unfold open_interval in |- *; simpl in |- *; simpl in H4;
+  simpl; apply lt_O_Sn.
+  apply (H17 H18); unfold open_interval; simpl; simpl in H4;
     elim H4; clear H4; intros; split; try assumption;
       replace r1 with r4.
   assumption.
-  simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro;
+  simpl in H12; rewrite H12; unfold Rmin; case (Rle_dec r1 c); intro;
     [ reflexivity | elim n; left; assumption ].
-  clear Hreci; simpl in |- *; apply H15.
-  simpl in |- *; apply lt_S_n; assumption.
-  unfold open_interval in |- *; apply H4.
+  clear Hreci; simpl; apply H15.
+  simpl; apply lt_S_n; assumption.
+  unfold open_interval; apply H4.
   split.
   left; assumption.
   elim H0; intros; assumption.
@@ -2567,7 +2565,7 @@ Proof.
           adapted_couple f a b l1 lf1 ->
           a <= c <= b ->
           { l:Rlist & { l0:Rlist & adapted_couple f c b l l0 } }).
-  intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X;
+  intro X; unfold IsStepFun; unfold is_subdivision; eapply X;
     [ apply H2 | split; assumption ].
   clear f a b c H0 H H1 H2 l1 lf1; simple induction l1.
   intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
@@ -2578,11 +2576,11 @@ Proof.
     simpl in H2; assert (H7 : a <= b).
   elim H0; intros; apply Rle_trans with c; assumption.
   replace a with (Rmin a b).
-  pattern b at 2 in |- *; replace b with (Rmax a b).
+  pattern b at 2; replace b with (Rmax a b).
   rewrite <- H2; rewrite H3; reflexivity.
-  unfold Rmax in |- *; case (Rle_dec a b); intro;
+  unfold Rmax; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
-  unfold Rmin in |- *; case (Rle_dec a b); intro;
+  unfold Rmin; case (Rle_dec a b); intro;
     [ reflexivity | elim n; assumption ].
   split with (cons r nil); split with lf1; assert (H2 : c = b).
   rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
@@ -2595,32 +2593,32 @@ Proof.
   elim H1; intro.
   split with (cons c (cons r1 r2)); split with (cons r3 lf1);
     unfold adapted_couple in H; decompose [and] H; clear H;
-      unfold adapted_couple in |- *; repeat split.
-  unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
-  simpl in |- *; assumption.
-  clear Hreci; apply (H2 (S i)); simpl in |- *; assumption.
-  simpl in |- *; unfold Rmin in |- *; case (Rle_dec c b); intro;
+      unfold adapted_couple; repeat split.
+  unfold ordered_Rlist; intros; simpl in H; induction  i as [| i Hreci].
+  simpl; assumption.
+  clear Hreci; apply (H2 (S i)); simpl; assumption.
+  simpl; unfold Rmin; case (Rle_dec c b); intro;
     [ reflexivity | elim n; elim H0; intros; assumption ].
   replace (Rmax c b) with (Rmax a b).
   rewrite <- H3; reflexivity.
-  unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec c b); intros;
+  unfold Rmax; case (Rle_dec a b); case (Rle_dec c b); intros;
     [ reflexivity
       | elim n; elim H0; intros; assumption
       | elim n; elim H0; intros; apply Rle_trans with c; assumption
       | elim n0; elim H0; intros; apply Rle_trans with c; assumption ].
-  simpl in |- *; simpl in H5; apply H5.
+  simpl; simpl in H5; apply H5.
   intros; simpl in H; induction  i as [| i Hreci].
-  unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *;
+  unfold constant_D_eq, open_interval; intros; simpl;
     apply (H7 0%nat).
-  simpl in |- *; apply lt_O_Sn.
-  unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6;
+  simpl; apply lt_O_Sn.
+  unfold open_interval; simpl; simpl in H6; elim H6; clear H6;
     intros; split; try assumption; apply Rle_lt_trans with c;
       try assumption; replace r with a.
   elim H0; intros; assumption.
-  simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intros;
+  simpl in H4; rewrite H4; unfold Rmin; case (Rle_dec a b); intros;
     [ reflexivity
       | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
-  clear Hreci; apply (H7 (S i)); simpl in |- *; assumption.
+  clear Hreci; apply (H7 (S i)); simpl; assumption.
   cut (adapted_couple f r1 b (cons r1 r2) lf1).
   cut (r1 <= c <= b).
   intros; elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with l1';
diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v
index d2d935b7..c5ee828a 100644
--- a/theories/Reals/Rlimit.v
+++ b/theories/Reals/Rlimit.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rlimit.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (*********************************************************)
 (**          Definition of the limit                     *)
 (*                                                       *)
@@ -15,9 +13,8 @@
 
 Require Import Rbase.
 Require Import Rfunctions.
-Require Import Classical_Prop.
 Require Import Fourier.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (*******************************)
 (** *   Calculus               *)
@@ -34,7 +31,7 @@ Proof.
   intro esp.
   assert (H := double_var esp).
   unfold Rdiv in H.
-  symmetry  in |- *; exact H.
+  symmetry ; exact H.
 Qed.
 
 (*********)
@@ -42,9 +39,9 @@ Lemma eps4 : forall eps:R, eps * / (2 + 2) + eps * / (2 + 2) = eps * / 2.
 Proof.
   intro eps.
   replace (2 + 2) with 4.
-  pattern eps at 3 in |- *; rewrite double_var.
+  pattern eps at 3; rewrite double_var.
   rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)).
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   repeat rewrite Rmult_assoc.
   rewrite <- Rinv_mult_distr.
   reflexivity.
@@ -57,7 +54,7 @@ Qed.
 Lemma Rlt_eps2_eps : forall eps:R, eps > 0 -> eps * / 2 < eps.
 Proof.
   intros.
-  pattern eps at 2 in |- *; rewrite <- Rmult_1_r.
+  pattern eps at 2; rewrite <- Rmult_1_r.
   repeat rewrite (Rmult_comm eps).
   apply Rmult_lt_compat_r.
   exact H.
@@ -73,7 +70,7 @@ Lemma Rlt_eps4_eps : forall eps:R, eps > 0 -> eps * / (2 + 2) < eps.
 Proof.
   intros.
   replace (2 + 2) with 4.
-  pattern eps at 2 in |- *; rewrite <- Rmult_1_r.
+  pattern eps at 2; rewrite <- Rmult_1_r.
   repeat rewrite (Rmult_comm eps).
   apply Rmult_lt_compat_r.
   exact H.
@@ -116,10 +113,10 @@ Qed.
 (*********)
 Lemma mul_factor_gt : forall eps l l':R, eps > 0 -> eps * mul_factor l l' > 0.
 Proof.
-  intros; unfold Rgt in |- *; rewrite <- (Rmult_0_r eps);
+  intros; unfold Rgt; rewrite <- (Rmult_0_r eps);
     apply Rmult_lt_compat_l.
   assumption.
-  unfold mul_factor in |- *; apply Rinv_0_lt_compat;
+  unfold mul_factor; apply Rinv_0_lt_compat;
     cut (1 <= 1 + (Rabs l + Rabs l')).
   cut (0 < 1).
   exact (Rlt_le_trans _ _ _).
@@ -199,7 +196,7 @@ Proof.
   case (H0 (dist R_met (f x0) l)); auto.
   intros alpha1 [H2 H3]; apply H3; auto; split; auto.
   case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto.
-  case (dist_refl R_met (f x0) l); intros Hr1 Hr2; apply sym_eq; auto.
+  case (dist_refl R_met (f x0) l); intros Hr1 Hr2; symmetry; auto.
 Qed.
 
 (*********)
@@ -213,7 +210,7 @@ Qed.
 (*********)
 Lemma lim_x : forall (D:R -> Prop) (x0:R), limit1_in (fun x:R => x) D x0 x0.
 Proof.
-  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+  unfold limit1_in; unfold limit_in; simpl; intros;
     split with eps; split; auto; intros; elim H0; intros;
       auto.
 Qed.
@@ -224,9 +221,9 @@ Lemma limit_plus :
     limit1_in f D l x0 ->
     limit1_in g D l' x0 -> limit1_in (fun x:R => f x + g x) D (l + l') x0.
 Proof.
-  intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
+  intros; unfold limit1_in; unfold limit_in; simpl;
     intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1));
-      elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *;
+      elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl;
         clear H H0; intros; elim H; elim H0; clear H H0; intros;
           split with (Rmin x1 x); split.
   exact (Rmin_Rgt_r x1 x 0 (conj H H2)).
@@ -247,12 +244,12 @@ Lemma limit_Ropp :
   forall (f:R -> R) (D:R -> Prop) (l x0:R),
     limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0.
 Proof.
-  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+  unfold limit1_in; unfold limit_in; simpl; intros;
     elim (H eps H0); clear H; intros; elim H; clear H;
       intros; split with x; split; auto; intros; generalize (H1 x1 H2);
-        clear H1; intro; unfold R_dist in |- *; unfold Rminus in |- *;
+        clear H1; intro; unfold R_dist; unfold Rminus;
           rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l);
-            fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *;
+            fold (l - f x1); fold (R_dist l (f x1));
               rewrite R_dist_sym; assumption.
 Qed.
 
@@ -262,7 +259,7 @@ Lemma limit_minus :
     limit1_in f D l x0 ->
     limit1_in g D l' x0 -> limit1_in (fun x:R => f x - g x) D (l - l') x0.
 Proof.
-  intros; unfold Rminus in |- *; generalize (limit_Ropp g D l' x0 H0); intro;
+  intros; unfold Rminus; generalize (limit_Ropp g D l' x0 H0); intro;
     exact (limit_plus f (fun x:R => - g x) D l (- l') x0 H H1).
 Qed.
 
@@ -271,9 +268,9 @@ Lemma limit_free :
   forall (f:R -> R) (D:R -> Prop) (x x0:R),
     limit1_in (fun h:R => f x) D (f x) x0.
 Proof.
-  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+  unfold limit1_in; unfold limit_in; simpl; intros;
     split with eps; split; auto; intros; elim (R_dist_refl (f x) (f x));
-      intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H;
+      intros a b; rewrite (b (eq_refl (f x))); unfold Rgt in H;
         assumption.
 Qed.
 
@@ -283,14 +280,14 @@ Lemma limit_mul :
     limit1_in f D l x0 ->
     limit1_in g D l' x0 -> limit1_in (fun x:R => f x * g x) D (l * l') x0.
 Proof.
-  intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
+  intros; unfold limit1_in; unfold limit_in; simpl;
     intros;
       elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1));
         elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1));
-          clear H H0; simpl in |- *; intros; elim H; elim H0;
+          clear H H0; simpl; intros; elim H; elim H0;
             clear H H0; intros; split with (Rmin x1 x); split.
   exact (Rmin_Rgt_r x1 x 0 (conj H H2)).
-  intros; elim H4; clear H4; intros; unfold R_dist in |- *;
+  intros; elim H4; clear H4; intros; unfold R_dist;
     replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)).
   cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps).
   cut
@@ -312,7 +309,7 @@ Proof.
   apply Rmult_ge_0_gt_0_lt_compat.
   apply Rle_ge.
   exact (Rabs_pos (g x2 - l')).
-  rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt in |- *; apply Rle_lt_0_plus_1;
+  rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt; apply Rle_lt_0_plus_1;
     exact (Rabs_pos l).
   unfold R_dist in H9;
     apply (Rplus_lt_reg_r (- Rabs l) (Rabs (f x2)) (1 + Rabs l)).
@@ -326,13 +323,13 @@ Proof.
   generalize (H3 x2 (conj H4 H6)); trivial.
   apply Rmult_le_compat_l.
   exact (Rabs_pos l').
-  unfold Rle in |- *; left; assumption.
+  unfold Rle; left; assumption.
   rewrite (Rmult_comm (1 + Rabs l) (eps * mul_factor l l'));
     rewrite (Rmult_comm (Rabs l') (eps * mul_factor l l'));
       rewrite <-
         (Rmult_plus_distr_l (eps * mul_factor l l') (1 + Rabs l) (Rabs l'))
         ; rewrite (Rmult_assoc eps (mul_factor l l') (1 + Rabs l + Rabs l'));
-          rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor in |- *;
+          rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor;
             rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l'));
               rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial.
   ring.
@@ -347,10 +344,10 @@ Lemma single_limit :
   forall (f:R -> R) (D:R -> Prop) (l l' x0:R),
     adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'.
 Proof.
-  unfold limit1_in in |- *; unfold limit_in in |- *; intros.
+  unfold limit1_in; unfold limit_in; intros.
   cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps).
-  clear H0 H1; unfold dist in |- *; unfold R_met in |- *; unfold R_dist in |- *;
-    unfold Rabs in |- *; case (Rcase_abs (l - l')); intros.
+  clear H0 H1; unfold dist; unfold R_met; unfold R_dist;
+    unfold Rabs; case (Rcase_abs (l - l')); intros.
   cut (forall eps:R, eps > 0 -> - (l - l') < eps).
   intro; generalize (prop_eps (- (l - l')) H1); intro;
     generalize (Ropp_gt_lt_0_contravar (l - l') r); intro;
@@ -361,10 +358,10 @@ Proof.
     rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
   elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
   apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro;
-    unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3);
+    unfold Rgt; generalize (Rplus_lt_compat_l 1 0 1 H3);
       intro; elim (Rplus_ne 1); intros a b; rewrite a in H4;
         clear a b; apply (Rlt_trans 0 1 2 H3 H4).
-  unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
+  unfold Rgt; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
     rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps);
       auto.
   apply (Rinv_0_lt_compat 2); cut (1 < 2).
@@ -383,10 +380,10 @@ Proof.
     rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
   elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
   apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro;
-    unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3);
+    unfold Rgt; generalize (Rplus_lt_compat_l 1 0 1 H3);
       intro; elim (Rplus_ne 1); intros a b; rewrite a in H4;
         clear a b; apply (Rlt_trans 0 1 2 H3 H4).
-  unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
+  unfold Rgt; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
     rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps);
       auto.
   apply (Rinv_0_lt_compat 2); cut (1 < 2).
@@ -396,7 +393,7 @@ Proof.
 (**)
   intros; unfold adhDa in H; elim (H0 eps H2); intros; elim (H1 eps H2); intros;
     clear H0 H1; elim H3; elim H4; clear H3 H4; intros;
-      simpl in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0);
+      simpl; simpl in H1, H4; generalize (Rmin_Rgt x x1 0);
         intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0)));
           intros; elim H5; intros; clear H5 H H6 H7;
             generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro;
@@ -406,10 +403,10 @@ Proof.
                     intros;
                       generalize
                         (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0);
-                        unfold R_dist in |- *; intros; rewrite (Rabs_minus_sym (f x2) l) in H1;
+                        unfold R_dist; intros; rewrite (Rabs_minus_sym (f x2) l) in H1;
                           rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1);
                             elim (Rmult_ne eps); intros a b; rewrite a; clear a b;
-                              generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *;
+                              generalize (R_dist_tri l l' (f x2)); unfold R_dist;
                                 intros;
                                   apply
                                     (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l'))
@@ -422,7 +419,7 @@ Lemma limit_comp :
     limit1_in f Df l x0 ->
     limit1_in g Dg l' l -> limit1_in (fun x:R => g (f x)) (Dgf Df Dg f) l' x0.
 Proof.
-  unfold limit1_in, limit_in, Dgf in |- *; simpl in |- *.
+  unfold limit1_in, limit_in, Dgf; simpl.
   intros f g Df Dg l l' x0 Hf Hg eps eps_pos.
   elim (Hg eps eps_pos).
   intros alpg lg.
@@ -439,12 +436,12 @@ Lemma limit_inv :
   forall (f:R -> R) (D:R -> Prop) (l x0:R),
     limit1_in f D l x0 -> l <> 0 -> limit1_in (fun x:R => / f x) D (/ l) x0.
 Proof.
-  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
-    unfold R_dist in |- *; intros; elim (H (Rabs l / 2)).
+  unfold limit1_in; unfold limit_in; simpl;
+    unfold R_dist; intros; elim (H (Rabs l / 2)).
   intros delta1 H2; elim (H (eps * (Rsqr l / 2))).
   intros delta2 H3; elim H2; elim H3; intros; exists (Rmin delta1 delta2);
     split.
-  unfold Rmin in |- *; case (Rle_dec delta1 delta2); intro; assumption.
+  unfold Rmin; case (Rle_dec delta1 delta2); intro; assumption.
   intro; generalize (H5 x); clear H5; intro H5; generalize (H7 x); clear H7;
     intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1).
   cut (D x /\ Rabs (x - x0) < delta2).
@@ -458,7 +455,7 @@ Proof.
               (Rplus_lt_compat_l (Rabs (f x) - Rabs l / 2) (Rabs l - Rabs (f x))
                 (Rabs l / 2) H14);
               replace (Rabs (f x) - Rabs l / 2 + (Rabs l - Rabs (f x))) with (Rabs l / 2).
-  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+  unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l;
     rewrite Rplus_0_r; intro; cut (f x <> 0).
   intro; replace (/ f x + - / l) with ((l - f x) * / (l * f x)).
   rewrite Rabs_mult; rewrite Rabs_Rinv.
@@ -470,7 +467,7 @@ Proof.
         (/ Rabs (l * f x)) (2 / Rsqr l) (Rabs_pos (l - f x)) H18 H5 H17);
       replace (eps * (Rsqr l / 2) * (2 / Rsqr l)) with eps.
   intro; assumption.
-  unfold Rdiv in |- *; unfold Rsqr in |- *; rewrite Rinv_mult_distr.
+  unfold Rdiv; unfold Rsqr; rewrite Rinv_mult_distr.
   repeat rewrite Rmult_assoc.
   rewrite (Rmult_comm l).
   repeat rewrite Rmult_assoc.
@@ -490,7 +487,7 @@ Proof.
   left; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply prod_neq_R0;
     assumption.
   rewrite Rmult_comm; rewrite Rabs_mult; rewrite Rinv_mult_distr.
-  rewrite (Rsqr_abs l); unfold Rsqr in |- *; unfold Rdiv in |- *;
+  rewrite (Rsqr_abs l); unfold Rsqr; unfold Rdiv;
     rewrite Rinv_mult_distr.
   repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r.
   apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
@@ -499,7 +496,7 @@ Proof.
   apply Rabs_pos_lt; assumption.
   apply Rabs_pos_lt; assumption.
   apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
-    [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *;
+    [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR;
       intro H18; assumption
       | discriminate ].
   replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2).
@@ -515,7 +512,7 @@ Proof.
   discrR.
   apply Rabs_no_R0.
   assumption.
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   repeat rewrite Rmult_assoc.
   rewrite (Rmult_comm (Rabs (f x))).
   repeat rewrite Rmult_assoc.
@@ -529,7 +526,7 @@ Proof.
   apply Rabs_no_R0; assumption.
   apply prod_neq_R0; assumption.
   rewrite (Rinv_mult_distr _ _ H0 H16).
-  unfold Rminus in |- *; rewrite Rmult_plus_distr_r.
+  unfold Rminus; rewrite Rmult_plus_distr_r.
   rewrite <- Rmult_assoc.
   rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l.
@@ -541,16 +538,16 @@ Proof.
   reflexivity.
   assumption.
   assumption.
-  red in |- *; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15;
+  red; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15;
     cut (0 < Rabs l / 2).
   intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rabs l / 2) 0 H17 H15)).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   apply Rabs_pos_lt; assumption.
   apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
-    [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *;
+    [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR;
       intro; assumption
       | discriminate ].
-  pattern (Rabs l) at 3 in |- *; rewrite double_var.
+  pattern (Rabs l) at 3; rewrite double_var.
   ring.
   split;
     [ assumption
@@ -560,18 +557,18 @@ Proof.
     [ assumption
       | apply Rlt_le_trans with (Rmin delta1 delta2);
         [ assumption | apply Rmin_l ] ].
-  change (0 < eps * (Rsqr l / 2)) in |- *; unfold Rdiv in |- *;
+  change (0 < eps * (Rsqr l / 2)); unfold Rdiv;
     repeat rewrite Rmult_assoc; apply Rmult_lt_0_compat.
   assumption.
   apply Rmult_lt_0_compat. apply Rsqr_pos_lt; assumption.
   apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
-    [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *;
+    [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR;
       intro; assumption
       | discriminate ].
-  change (0 < Rabs l / 2) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  change (0 < Rabs l / 2); unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply Rabs_pos_lt; assumption
       | apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
-        [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *;
+        [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR;
           intro; assumption
           | discriminate ] ].
 Qed.
diff --git a/theories/Reals/Rlogic.v b/theories/Reals/Rlogic.v
index b7ffec2b..0b892a76 100644
--- a/theories/Reals/Rlogic.v
+++ b/theories/Reals/Rlogic.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -41,6 +41,7 @@ Variable P : nat -> Prop.
 Hypothesis HP : forall n, {P n} + {~P n}.
 
 Let ge_fun_sums_ge_lemma : (forall (m n : nat) (f : nat -> R), (lt m n) -> (forall i : nat, 0 <= f i) -> sum_f_R0 f m <= sum_f_R0 f n).
+Proof.
 intros m n f mn fpos.
 replace (sum_f_R0 f m) with (sum_f_R0 f m + 0) by ring.
 rewrite (tech2 f m n mn).
@@ -52,6 +53,7 @@ apply (Rplus_le_compat _ _ _ _ IHn0 (fpos (S (m + S n0)%nat))).
 Qed.
 
 Let ge_fun_sums_ge : (forall (m n : nat) (f : nat -> R), (le m n) -> (forall i : nat, 0 <= f i) -> sum_f_R0 f m <= sum_f_R0 f n).
+Proof.
 intros m n f mn pos.
  elim (le_lt_or_eq _ _ mn).
  intro; apply ge_fun_sums_ge_lemma; assumption.
@@ -61,6 +63,7 @@ Qed.
 Let f:=fun n => (if HP n then (1/2)^n else 0)%R.
 
 Lemma cauchy_crit_geometric_dec_fun : Cauchy_crit_series f.
+Proof.
 intros e He.
 assert (X:(Pser (fun n:nat => 1) (1/2) (/ (1 - (1/2))))%R).
  apply GP_infinite.
@@ -233,10 +236,11 @@ fourier.
 Qed.
 
 Lemma sig_forall_dec :  {n | ~P n}+{forall n, P n}.
+Proof.
 destruct forall_dec.
  right; assumption.
 left.
-apply constructive_indefinite_description_nat; auto.
+apply constructive_indefinite_ground_description_nat; auto.
  clear - HP.
  firstorder.
 apply Classical_Pred_Type.not_all_ex_not.
@@ -255,6 +259,7 @@ principle also derive [up] and its [specification] *)
 
 Theorem not_not_archimedean :
   forall r : R, ~ (forall n : nat, (INR n <= r)%R).
+Proof.
 intros r H.
 set (E := fun r => exists n : nat, r = INR n).
 assert (exists x : R, E x) by
@@ -266,10 +271,10 @@ assert (H2 : ~ is_upper_bound E M').
   intro H5.
   assert (M <= M')%R by (apply H4; exact H5).
   apply (Rlt_not_le M M').
-    unfold M' in |- *.
-    pattern M at 2 in |- *.
+    unfold M'.
+    pattern M at 2.
     rewrite <- Rplus_0_l.
-    pattern (0 + M)%R in |- *.
+    pattern (0 + M)%R.
     rewrite Rplus_comm.
     rewrite <- (Rplus_opp_r 1).
     apply Rplus_lt_compat_l.
@@ -279,7 +284,7 @@ assert (H2 : ~ is_upper_bound E M').
 apply H2.
 intros N (n,H7).
 rewrite H7.
-unfold M' in |- *.
+unfold M'.
 assert (H5 : (INR (S n) <= M)%R) by (apply H3; exists (S n); reflexivity).
 rewrite S_INR in H5.
 assert (H6 : (INR n + 1 + -1 <= M + -1)%R).
diff --git a/theories/Reals/Rminmax.v b/theories/Reals/Rminmax.v
index c9faee0c..da3c6ddd 100644
--- a/theories/Reals/Rminmax.v
+++ b/theories/Reals/Rminmax.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
diff --git a/theories/Reals/Rpow_def.v b/theories/Reals/Rpow_def.v
index 4f7a8d22..cd94169f 100644
--- a/theories/Reals/Rpow_def.v
+++ b/theories/Reals/Rpow_def.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Rpow_def.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Import Rdefinitions.
 
 Fixpoint pow (r:R) (n:nat) : R :=
diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v
index 36db12f9..43f326a0 100644
--- a/theories/Reals/Rpower.v
+++ b/theories/Reals/Rpower.v
@@ -1,12 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rpower.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
 (*i Due to L.Thery i*)
 
 (************************************************************)
@@ -16,25 +15,25 @@
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
-Require Import Rtrigo.
+Require Import Rtrigo1.
 Require Import Ranalysis1.
 Require Import Exp_prop.
 Require Import Rsqrt_def.
 Require Import R_sqrt.
 Require Import MVT.
 Require Import Ranalysis4.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Lemma P_Rmin : forall (P:R -> Prop) (x y:R), P x -> P y -> P (Rmin x y).
 Proof.
-  intros P x y H1 H2; unfold Rmin in |- *; case (Rle_dec x y); intro;
+  intros P x y H1 H2; unfold Rmin; case (Rle_dec x y); intro;
     assumption.
 Qed.
 
 Lemma exp_le_3 : exp 1 <= 3.
 Proof.
   assert (exp_1 : exp 1 <> 0).
-  assert (H0 := exp_pos 1); red in |- *; intro; rewrite H in H0;
+  assert (H0 := exp_pos 1); red; intro; rewrite H in H0;
     elim (Rlt_irrefl _ H0).
   apply Rmult_le_reg_l with (/ exp 1).
   apply Rinv_0_lt_compat; apply exp_pos.
@@ -44,7 +43,7 @@ Proof.
   rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc;
     rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)).
-  unfold exp in |- *; case (exist_exp (-1)); intros; simpl in |- *;
+  unfold exp; case (exist_exp (-1)); intros; simpl;
     unfold exp_in in e;
       assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1).
   cut
@@ -74,7 +73,7 @@ Proof.
   ring.
   discrR.
   apply H.
-  unfold Un_decreasing in |- *; intros;
+  unfold Un_decreasing; intros;
     apply Rmult_le_reg_l with (INR (fact n)).
   apply INR_fact_lt_0.
   apply Rmult_le_reg_l with (INR (fact (S n))).
@@ -85,13 +84,13 @@ Proof.
   rewrite Rmult_1_r; apply le_INR; apply fact_le; apply le_n_Sn.
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
-  assert (H0 := cv_speed_pow_fact 1); unfold Un_cv in |- *; unfold Un_cv in H0;
+  assert (H0 := cv_speed_pow_fact 1); unfold Un_cv; unfold Un_cv in H0;
     intros; elim (H0 _ H1); intros; exists x0; intros;
-      unfold R_dist in H2; unfold R_dist in |- *;
+      unfold R_dist in H2; unfold R_dist;
         replace (/ INR (fact n)) with (1 ^ n / INR (fact n)).
   apply (H2 _ H3).
-  unfold Rdiv in |- *; rewrite pow1; rewrite Rmult_1_l; reflexivity.
-  unfold infinite_sum in e; unfold Un_cv, tg_alt in |- *; intros; elim (e _ H0);
+  unfold Rdiv; rewrite pow1; rewrite Rmult_1_l; reflexivity.
+  unfold infinite_sum in e; unfold Un_cv, tg_alt; intros; elim (e _ H0);
     intros; exists x0; intros;
       replace (sum_f_R0 (fun i:nat => (-1) ^ i * / INR (fact i)) n) with
       (sum_f_R0 (fun i:nat => / INR (fact i) * (-1) ^ i) n).
@@ -122,7 +121,7 @@ Proof.
   intro.
   replace (derive_pt exp x0 (H0 x0)) with (exp x0).
   apply exp_pos.
-  symmetry  in |- *; apply derive_pt_eq_0.
+  symmetry ; apply derive_pt_eq_0.
   apply (derivable_pt_lim_exp x0).
   apply H.
 Qed.
@@ -144,11 +143,11 @@ Proof.
         rewrite Ropp_0; rewrite Rplus_0_r;
           replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0).
   rewrite exp_0; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
-    pattern x at 1 in |- *; rewrite <- Rmult_1_r; rewrite (Rmult_comm (exp x0));
+    pattern x at 1; rewrite <- Rmult_1_r; rewrite (Rmult_comm (exp x0));
       apply Rmult_lt_compat_l.
   apply H.
   rewrite <- exp_0; apply exp_increasing; elim H3; intros; assumption.
-  symmetry  in |- *; apply derive_pt_eq_0; apply derivable_pt_lim_exp.
+  symmetry ; apply derive_pt_eq_0; apply derivable_pt_lim_exp.
 Qed.
 
 Lemma ln_exists1 : forall y:R, 1 <= y -> { z:R | y = exp z }.
@@ -161,18 +160,18 @@ Proof.
   cut (f 0 * f y <= 0); [intro H4|].
   pose proof (IVT_cor f 0 y H2 (Rlt_le _ _ H0) H4) as (t,(_,H7));
     exists t; unfold f in H7; apply Rminus_diag_uniq_sym; exact H7.
-  pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y));
+  pattern 0 at 2; rewrite <- (Rmult_0_r (f y));
     rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l;
       assumption.
-  unfold f in |- *; apply Rplus_le_reg_l with y; left;
+  unfold f; apply Rplus_le_reg_l with y; left;
     apply Rlt_trans with (1 + y).
   rewrite <- (Rplus_comm y); apply Rplus_lt_compat_l; apply Rlt_0_1.
   replace (y + (exp y - y)) with (exp y); [ apply (exp_ineq1 y H0) | ring ].
-  unfold f in |- *; change (continuity (exp - fct_cte y)) in |- *;
+  unfold f; change (continuity (exp - fct_cte y));
     apply continuity_minus;
       [ apply derivable_continuous; apply derivable_exp
         | apply derivable_continuous; apply derivable_const ].
-  unfold f in |- *; rewrite exp_0; apply Rplus_le_reg_l with y;
+  unfold f; rewrite exp_0; apply Rplus_le_reg_l with y;
     rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H | ring ].
 Qed.
 
@@ -186,18 +185,18 @@ Proof.
   apply H.
   rewrite <- Rinv_r_sym.
   rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ n).
-  red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
   destruct (ln_exists1 _ H0) as (x,p); exists (- x);
     apply Rmult_eq_reg_l with (exp x / y).
-  unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  unfold Rdiv; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc;
     rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0;
-      rewrite Rmult_1_r; symmetry  in |- *; apply p.
-  red in |- *; intro H3; rewrite H3 in H; elim (Rlt_irrefl _ H).
-  unfold Rdiv in |- *; apply prod_neq_R0.
-  assert (H3 := exp_pos x); red in |- *; intro H4; rewrite H4 in H3;
+      rewrite Rmult_1_r; symmetry ; apply p.
+  red; intro H3; rewrite H3 in H; elim (Rlt_irrefl _ H).
+  unfold Rdiv; apply prod_neq_R0.
+  assert (H3 := exp_pos x); red; intro H4; rewrite H4 in H3;
     elim (Rlt_irrefl _ H3).
-  apply Rinv_neq_0_compat; red in |- *; intro H3; rewrite H3 in H;
+  apply Rinv_neq_0_compat; red; intro H3; rewrite H3 in H;
     elim (Rlt_irrefl _ H).
 Qed.
 
@@ -214,11 +213,11 @@ Definition ln (x:R) : R :=
 
 Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x.
 Proof.
-  intros; unfold ln in |- *; case (Rlt_dec 0 x); intro.
-  unfold Rln in |- *;
+  intros; unfold ln; case (Rlt_dec 0 x); intro.
+  unfold Rln;
     case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r)));
     intros.
-  simpl in e; symmetry  in |- *; apply e.
+  simpl in e; symmetry ; apply e.
   elim n; apply H.
 Qed.
 
@@ -232,7 +231,7 @@ Qed.
 Theorem exp_Ropp : forall x:R, exp (- x) = / exp x.
 Proof.
   intros x; assert (H : exp x <> 0).
-  assert (H := exp_pos x); red in |- *; intro; rewrite H0 in H;
+  assert (H := exp_pos x); red; intro; rewrite H0 in H;
     elim (Rlt_irrefl _ H).
   apply Rmult_eq_reg_l with (r := exp x).
   rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0.
@@ -307,11 +306,11 @@ Theorem ln_continue :
   forall y:R, 0 < y -> continue_in ln (fun x:R => 0 < x) y.
 Proof.
   intros y H.
-  unfold continue_in, limit1_in, limit_in in |- *; intros eps Heps.
+  unfold continue_in, limit1_in, limit_in; intros eps Heps.
   cut (1 < exp eps); [ intros H1 | idtac ].
   cut (exp (- eps) < 1); [ intros H2 | idtac ].
   exists (Rmin (y * (exp eps - 1)) (y * (1 - exp (- eps)))); split.
-  red in |- *; apply P_Rmin.
+  red; apply P_Rmin.
   apply Rmult_lt_0_compat.
   assumption.
   apply Rplus_lt_reg_r with 1.
@@ -322,7 +321,7 @@ Proof.
   apply Rplus_lt_reg_r with (exp (- eps)).
   rewrite Rplus_0_r; replace (exp (- eps) + (1 - exp (- eps))) with 1;
     [ apply H2 | ring ].
-  unfold dist, R_met, R_dist in |- *; simpl in |- *.
+  unfold dist, R_met, R_dist; simpl.
   intros x [[H3 H4] H5].
   cut (y * (x * / y) = x).
   intro Hxyy.
@@ -352,7 +351,7 @@ Proof.
   rewrite Hxyy; rewrite Rmult_1_r; apply Hxy.
   rewrite Hxy; rewrite Rinv_r.
   rewrite ln_1; rewrite Rabs_R0; apply Heps.
-  red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
   rewrite Rabs_right.
   apply exp_lt_inv.
   rewrite exp_ln.
@@ -367,7 +366,7 @@ Proof.
   left; apply (Rgt_minus _ _ Hxy).
   apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
   rewrite <- ln_1.
-  apply Rgt_ge; red in |- *; apply ln_increasing.
+  apply Rgt_ge; red; apply ln_increasing.
   apply Rlt_0_1.
   apply Rmult_lt_reg_l with (r := y).
   apply H.
@@ -380,7 +379,7 @@ Proof.
   apply Rinv_0_lt_compat; assumption.
   rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
   ring.
-  red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
   apply Rmult_lt_reg_l with (exp eps).
   apply exp_pos.
   rewrite <- exp_plus; rewrite Rmult_1_r; rewrite Rplus_opp_r; rewrite exp_0;
@@ -395,7 +394,7 @@ Qed.
 
 Definition Rpower (x y:R) := exp (y * ln x).
 
-Infix Local "^R" := Rpower (at level 30, right associativity) : R_scope.
+Local Infix "^R" := Rpower (at level 30, right associativity) : R_scope.
 
 (******************************************************************)
 (** *                     Properties of  Rpower                   *)
@@ -413,13 +412,13 @@ Infix Local "^R" := Rpower (at level 30, right associativity) : R_scope.
 
 Theorem Rpower_plus : forall x y z:R, z ^R (x + y) = z ^R x * z ^R y.
 Proof.
-  intros x y z; unfold Rpower in |- *.
+  intros x y z; unfold Rpower.
   rewrite Rmult_plus_distr_r; rewrite exp_plus; auto.
 Qed.
 
 Theorem Rpower_mult : forall x y z:R, (x ^R y) ^R z = x ^R (y * z).
 Proof.
-  intros x y z; unfold Rpower in |- *.
+  intros x y z; unfold Rpower.
   rewrite ln_exp.
   replace (z * (y * ln x)) with (y * z * ln x).
   reflexivity.
@@ -428,22 +427,22 @@ Qed.
 
 Theorem Rpower_O : forall x:R, 0 < x -> x ^R 0 = 1.
 Proof.
-  intros x _; unfold Rpower in |- *.
+  intros x _; unfold Rpower.
   rewrite Rmult_0_l; apply exp_0.
 Qed.
 
 Theorem Rpower_1 : forall x:R, 0 < x -> x ^R 1 = x.
 Proof.
-  intros x H; unfold Rpower in |- *.
+  intros x H; unfold Rpower.
   rewrite Rmult_1_l; apply exp_ln; apply H.
 Qed.
 
 Theorem Rpower_pow : forall (n:nat) (x:R), 0 < x -> x ^R INR n = x ^ n.
 Proof.
-  intros n; elim n; simpl in |- *; auto; fold INR in |- *.
+  intros n; elim n; simpl; auto; fold INR.
   intros x H; apply Rpower_O; auto.
   intros n1; case n1.
-  intros H x H0; simpl in |- *; rewrite Rmult_1_r; apply Rpower_1; auto.
+  intros H x H0; simpl; rewrite Rmult_1_r; apply Rpower_1; auto.
   intros n0 H x H0; rewrite Rpower_plus; rewrite H; try rewrite Rpower_1;
     try apply Rmult_comm || assumption.
 Qed.
@@ -452,7 +451,7 @@ Theorem Rpower_lt :
   forall x y z:R, 1 < x -> 0 <= y -> y < z -> x ^R y < x ^R z.
 Proof.
   intros x y z H H0 H1.
-  unfold Rpower in |- *.
+  unfold Rpower.
   apply exp_increasing.
   apply Rmult_lt_compat_r.
   rewrite <- ln_1; apply ln_increasing.
@@ -465,18 +464,18 @@ Theorem Rpower_sqrt : forall x:R, 0 < x -> x ^R (/ 2) = sqrt x.
 Proof.
   intros x H.
   apply ln_inv.
-  unfold Rpower in |- *; apply exp_pos.
+  unfold Rpower; apply exp_pos.
   apply sqrt_lt_R0; apply H.
   apply Rmult_eq_reg_l with (INR 2).
   apply exp_inv.
-  fold Rpower in |- *.
+  fold Rpower.
   cut ((x ^R (/ INR 2)) ^R INR 2 = sqrt x ^R INR 2).
-  unfold Rpower in |- *; auto.
+  unfold Rpower; auto.
   rewrite Rpower_mult.
   rewrite Rinv_l.
   replace 1 with (INR 1); auto.
-  repeat rewrite Rpower_pow; simpl in |- *.
-  pattern x at 1 in |- *; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)).
+  repeat rewrite Rpower_pow; simpl.
+  pattern x at 1; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)).
   ring.
   apply sqrt_lt_R0; apply H.
   apply H.
@@ -486,7 +485,7 @@ Qed.
 
 Theorem Rpower_Ropp : forall x y:R, x ^R (- y) = / x ^R y.
 Proof.
-  unfold Rpower in |- *.
+  unfold Rpower.
   intros x y; rewrite Ropp_mult_distr_l_reverse.
   apply exp_Ropp.
 Qed.
@@ -506,11 +505,11 @@ Proof.
   rewrite Rinv_r.
   apply exp_lt_inv.
   apply Rle_lt_trans with (1 := exp_le_3).
-  change (3 < 2 ^R 2) in |- *.
+  change (3 < 2 ^R 2).
   repeat rewrite Rpower_plus; repeat rewrite Rpower_1.
   repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
     repeat rewrite Rmult_1_l.
-  pattern 3 at 1 in |- *; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1);
+  pattern 3 at 1; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1);
     [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ].
   prove_sup0.
   discrR.
@@ -524,7 +523,7 @@ Theorem limit1_ext :
   forall (f g:R -> R) (D:R -> Prop) (l x:R),
     (forall x:R, D x -> f x = g x) -> limit1_in f D l x -> limit1_in g D l x.
 Proof.
-  intros f g D l x H; unfold limit1_in, limit_in in |- *.
+  intros f g D l x H; unfold limit1_in, limit_in.
   intros H0 eps H1; case (H0 eps); auto.
   intros x0 [H2 H3]; exists x0; split; auto.
   intros x1 [H4 H5]; rewrite <- H; auto.
@@ -534,7 +533,7 @@ Theorem limit1_imp :
   forall (f:R -> R) (D D1:R -> Prop) (l x:R),
     (forall x:R, D1 x -> D x) -> limit1_in f D l x -> limit1_in f D1 l x.
 Proof.
-  intros f D D1 l x H; unfold limit1_in, limit_in in |- *.
+  intros f D D1 l x H; unfold limit1_in, limit_in.
   intros H0 eps H1; case (H0 eps H1); auto.
   intros alpha [H2 H3]; exists alpha; split; auto.
   intros d [H4 H5]; apply H3; split; auto.
@@ -542,7 +541,7 @@ Qed.
 
 Theorem Rinv_Rdiv : forall x y:R, x <> 0 -> y <> 0 -> / (x / y) = y / x.
 Proof.
-  intros x y H1 H2; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  intros x y H1 H2; unfold Rdiv; rewrite Rinv_mult_distr.
   rewrite Rinv_involutive.
   apply Rmult_comm.
   assumption.
@@ -552,18 +551,18 @@ Qed.
 
 Theorem Dln : forall y:R, 0 < y -> D_in ln Rinv (fun x:R => 0 < x) y.
 Proof.
-  intros y Hy; unfold D_in in |- *.
+  intros y Hy; unfold D_in.
   apply limit1_ext with
     (f := fun x:R => / ((exp (ln x) - exp (ln y)) / (ln x - ln y))).
   intros x [HD1 HD2]; repeat rewrite exp_ln.
-  unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  unfold Rdiv; rewrite Rinv_mult_distr.
   rewrite Rinv_involutive.
   apply Rmult_comm.
   apply Rminus_eq_contra.
-  red in |- *; intros H2; case HD2.
-  symmetry  in |- *; apply (ln_inv _ _ HD1 Hy H2).
-  apply Rminus_eq_contra; apply (sym_not_eq HD2).
-  apply Rinv_neq_0_compat; apply Rminus_eq_contra; red in |- *; intros H2;
+  red; intros H2; case HD2.
+  symmetry ; apply (ln_inv _ _ HD1 Hy H2).
+  apply Rminus_eq_contra; apply (not_eq_sym HD2).
+  apply Rinv_neq_0_compat; apply Rminus_eq_contra; red; intros H2;
     case HD2; apply ln_inv; auto.
   assumption.
   assumption.
@@ -575,62 +574,62 @@ Proof.
   intros x [H1 H2]; split.
   split; auto.
   split; auto.
-  red in |- *; intros H3; case H2; apply ln_inv; auto.
+  red; intros H3; case H2; apply ln_inv; auto.
   apply limit_comp with
     (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln).
   apply ln_continue; auto.
   assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
-      simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H);
+    unfold limit1_in; unfold limit_in;
+      simpl; unfold R_dist; intros; elim (H0 _ H);
         intros; exists (pos x); split.
   apply (cond_pos x).
-  intros; pattern y at 3 in |- *; rewrite <- exp_ln.
-  pattern x0 at 1 in |- *; replace x0 with (ln y + (x0 - ln y));
+  intros; pattern y at 3; rewrite <- exp_ln.
+  pattern x0 at 1; replace x0 with (ln y + (x0 - ln y));
     [ idtac | ring ].
   apply H1.
   elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3;
-    apply Rminus_eq_contra; apply (sym_not_eq (A:=R));
+    apply Rminus_eq_contra; apply (not_eq_sym (A:=R));
       apply H3.
   elim H2; clear H2; intros _ H2; apply H2.
   assumption.
-  red in |- *; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy).
+  red; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy).
 Qed.
 
 Lemma derivable_pt_lim_ln : forall x:R, 0 < x -> derivable_pt_lim ln x (/ x).
 Proof.
   intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0;
     unfold limit_in in H0; simpl in H0; unfold R_dist in H0;
-      unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1);
+      unfold derivable_pt_lim; intros; elim (H0 _ H1);
         intros; elim H2; clear H2; intros; set (alp := Rmin x0 (x / 2));
           assert (H4 : 0 < alp).
-  unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec x0 (x / 2)); intro.
+  unfold alp; unfold Rmin; case (Rle_dec x0 (x / 2)); intro.
   apply H2.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-  exists (mkposreal _ H4); intros; pattern h at 2 in |- *;
+  exists (mkposreal _ H4); intros; pattern h at 2;
     replace h with (x + h - x); [ idtac | ring ].
   apply H3; split.
-  unfold D_x in |- *; split.
+  unfold D_x; split.
   case (Rcase_abs h); intro.
   assert (H7 : Rabs h < x / 2).
   apply Rlt_le_trans with alp.
   apply H6.
-  unfold alp in |- *; apply Rmin_r.
+  unfold alp; apply Rmin_r.
   apply Rlt_trans with (x / 2).
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
   rewrite Rabs_left in H7.
   apply Rplus_lt_reg_r with (- h - x / 2).
   replace (- h - x / 2 + x / 2) with (- h); [ idtac | ring ].
-  pattern x at 2 in |- *; rewrite double_var.
+  pattern x at 2; rewrite double_var.
   replace (- h - x / 2 + (x / 2 + x / 2 + h)) with (x / 2); [ apply H7 | ring ].
   apply r.
   apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply r ].
-  apply (sym_not_eq (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h;
+  apply (not_eq_sym (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h;
     [ apply H5 | ring ].
   replace (x + h - x) with h;
   [ apply Rlt_le_trans with alp;
-    [ apply H6 | unfold alp in |- *; apply Rmin_l ]
+    [ apply H6 | unfold alp; apply Rmin_l ]
     | ring ].
 Qed.
 
@@ -638,7 +637,7 @@ Theorem D_in_imp :
   forall (f g:R -> R) (D D1:R -> Prop) (x:R),
     (forall x:R, D1 x -> D x) -> D_in f g D x -> D_in f g D1 x.
 Proof.
-  intros f g D D1 x H; unfold D_in in |- *.
+  intros f g D D1 x H; unfold D_in.
   intros H0; apply limit1_imp with (D := D_x D x); auto.
   intros x1 [H1 H2]; split; auto.
 Qed.
@@ -647,7 +646,7 @@ Theorem D_in_ext :
   forall (f g h:R -> R) (D:R -> Prop) (x:R),
     f x = g x -> D_in h f D x -> D_in h g D x.
 Proof.
-  intros f g h D x H; unfold D_in in |- *.
+  intros f g h D x H; unfold D_in.
   rewrite H; auto.
 Qed.
 
@@ -662,7 +661,7 @@ Proof.
   intros x H0; repeat split.
   assumption.
   apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))).
-  unfold Rminus in |- *; rewrite Rpower_plus; rewrite Rpower_Ropp;
+  unfold Rminus; rewrite Rpower_plus; rewrite Rpower_Ropp;
     rewrite (Rpower_1 _ H); unfold Rpower; ring.
   apply Dcomp with
     (f := ln)
@@ -675,7 +674,7 @@ Proof.
   intros x H1; repeat split; auto.
   apply
     (Dcomp (fun _:R => True) (fun _:R => True) (fun x => z) exp
-      (fun x:R => z * x) exp); simpl in |- *.
+      (fun x:R => z * x) exp); simpl.
   apply D_in_ext with (f := fun x:R => z * 1).
   apply Rmult_1_r.
   apply (Dmult_const (fun x => True) (fun x => x) (fun x => 1)); apply Dx.
@@ -688,16 +687,16 @@ Theorem derivable_pt_lim_power :
     0 < x -> derivable_pt_lim (fun x => x ^R y) x (y * x ^R (y - 1)).
 Proof.
   intros x y H.
-  unfold Rminus in |- *; rewrite Rpower_plus.
+  unfold Rminus; rewrite Rpower_plus.
   rewrite Rpower_Ropp.
   rewrite Rpower_1; auto.
   rewrite <- Rmult_assoc.
-  unfold Rpower in |- *.
+  unfold Rpower.
   apply derivable_pt_lim_comp with (f1 := ln) (f2 := fun x => exp (y * x)).
   apply derivable_pt_lim_ln; assumption.
   rewrite (Rmult_comm y).
   apply derivable_pt_lim_comp with (f1 := fun x => y * x) (f2 := exp).
-  pattern y at 2 in |- *; replace y with (0 * ln x + y * 1).
+  pattern y at 2; replace y with (0 * ln x + y * 1).
   apply derivable_pt_lim_mult with (f1 := fun x:R => y) (f2 := fun x:R => x).
   apply derivable_pt_lim_const with (a := y).
   apply derivable_pt_lim_id.
diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v
index 947dbb11..88c4de23 100644
--- a/theories/Reals/Rprod.v
+++ b/theories/Reals/Rprod.v
@@ -1,23 +1,21 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rprod.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Compare.
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rseries.
 Require Import PartSum.
 Require Import Binomial.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (** TT Ak; 0<=k<=N *)
-Boxed Fixpoint prod_f_R0 (f:nat -> R) (N:nat) : R :=
+Fixpoint prod_f_R0 (f:nat -> R) (N:nat) : R :=
   match N with
     | O => f O
     | S p => prod_f_R0 f p * f (S p)
@@ -38,7 +36,7 @@ Proof.
   replace (S n - k - 1)%nat with O; [rewrite H1; simpl|omega].
   replace (n+1+0)%nat with (S n); ring.
   replace (S n - k-1)%nat with (S (n - k-1));[idtac|omega].
-  simpl in |- *; replace (k + S (n - k))%nat with (S n).
+  simpl; replace (k + S (n - k))%nat with (S n).
   replace (k + 1 + S (n - k - 1))%nat with (S n).
   rewrite Hrecn; [ ring | assumption ].
   omega.
@@ -51,8 +49,8 @@ Lemma prod_SO_pos :
     (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_R0 An N.
 Proof.
   intros; induction  N as [| N HrecN].
-  simpl in |- *; apply H; trivial.
-  simpl in |- *; apply Rmult_le_pos.
+  simpl; apply H; trivial.
+  simpl; apply Rmult_le_pos.
   apply HrecN; intros; apply H; apply le_trans with N;
     [ assumption | apply le_n_Sn ].
   apply H; apply le_n.
@@ -66,7 +64,7 @@ Lemma prod_SO_Rle :
 Proof.
   intros; induction  N as [| N HrecN].
   elim  H with O; trivial.
-  simpl in |- *; apply Rle_trans with (prod_f_R0 An N * Bn (S N)).
+  simpl; apply Rle_trans with (prod_f_R0 An N * Bn (S N)).
   apply Rmult_le_compat_l.
   apply prod_SO_pos; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros;
     assumption.
@@ -116,7 +114,7 @@ Proof.
      (if eq_nat_dec n 0 then 1 else INR n) = INR n).
   intros n; case (eq_nat_dec n 0); auto with real.
   intros; absurd (0 < n)%nat; omega.
-  intros; unfold Rsqr in |- *; repeat rewrite fact_prodSO.
+  intros; unfold Rsqr; repeat rewrite fact_prodSO.
   cut ((k=N)%nat \/ (k < N)%nat \/ (N < k)%nat).
   intro H2; elim H2; intro H3.
   rewrite H3; replace (2*N-N)%nat with N;[right; ring|omega].
@@ -166,14 +164,14 @@ Qed.
 (**********)
 Lemma INR_fact_lt_0 : forall n:nat, 0 < INR (fact n).
 Proof.
-  intro; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
-    elim (fact_neq_0 n); symmetry  in |- *; assumption.
+  intro; apply lt_INR_0; apply neq_O_lt; red; intro;
+    elim (fact_neq_0 n); symmetry ; assumption.
 Qed.
 
 (** We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *)
 Lemma C_maj : forall N k:nat, (k <= 2 * N)%nat -> C (2 * N) k <= C (2 * N) N.
 Proof.
-  intros; unfold C in |- *; unfold Rdiv in |- *; apply Rmult_le_compat_l.
+  intros; unfold C; unfold Rdiv; apply Rmult_le_compat_l.
   apply pos_INR.
   replace (2 * N - N)%nat with N.
   apply Rmult_le_reg_l with (INR (fact N) * INR (fact N)).
diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v
index db0fddad..3c10725b 100644
--- a/theories/Reals/Rseries.v
+++ b/theories/Reals/Rseries.v
@@ -1,18 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rseries.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
-Require Import Classical.
 Require Import Compare.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Implicit Type r : R.
 
@@ -28,7 +25,7 @@ Section sequence.
   Variable Un : nat -> R.
 
 (*********)
-  Boxed Fixpoint Rmax_N (N:nat) : R :=
+  Fixpoint Rmax_N (N:nat) : R :=
     match N with
       | O => Un 0
       | S n => Rmax (Un (S n)) (Rmax_N n)
@@ -57,20 +54,20 @@ Section sequence.
 (*********)
   Lemma EUn_noempty :  exists r : R, EUn r.
   Proof.
-    unfold EUn in |- *; split with (Un 0); split with 0%nat; trivial.
+    unfold EUn; split with (Un 0); split with 0%nat; trivial.
   Qed.
 
 (*********)
   Lemma Un_in_EUn : forall n:nat, EUn (Un n).
   Proof.
-    intro; unfold EUn in |- *; split with n; trivial.
+    intro; unfold EUn; split with n; trivial.
   Qed.
 
 (*********)
   Lemma Un_bound_imp :
     forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x.
   Proof.
-    intros; unfold is_upper_bound in |- *; intros; unfold EUn in H0; elim H0;
+    intros; unfold is_upper_bound; intros; unfold EUn in H0; elim H0;
       clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1;
         trivial.
   Qed.
@@ -80,7 +77,7 @@ Section sequence.
     forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m.
   Proof.
     double induction n m; intros.
-    unfold Rge in |- *; right; trivial.
+    unfold Rge; right; trivial.
     exfalso; unfold ge in H1; generalize (le_Sn_O n0); intro; auto.
     cut (n0 >= 0)%nat.
     generalize H0; intros; unfold Un_growing in H0;
@@ -92,7 +89,7 @@ Section sequence.
     elim y; clear y; intro y.
     unfold ge in H2; generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2)); intro;
       exfalso; auto.
-    rewrite y; unfold Rge in |- *; right; trivial.
+    rewrite y; unfold Rge; right; trivial.
     unfold ge in H0; generalize (H0 (S n0) H1 (lt_le_S n0 n1 y)); intro;
       unfold Un_growing in H1;
         apply
@@ -100,47 +97,173 @@ Section sequence.
             (Rle_ge (Un n1) (Un (S n1)) (H1 n1)) H3).
   Qed.
 
+(*********)
+  Lemma Un_cv_crit_lub : Un_growing -> forall l, is_lub EUn l -> Un_cv l.
+  Proof.
+    intros Hug l H eps Heps.
+
+    cut (exists N, Un N > l - eps).
+    intros (N, H3).
+    exists N.
+    intros n H4.
+    unfold R_dist.
+    rewrite Rabs_left1, Ropp_minus_distr.
+    apply Rplus_lt_reg_r with (Un n - eps).
+    apply Rlt_le_trans with (Un N).
+    now replace (Un n - eps + (l - Un n)) with (l - eps) by ring.
+    replace (Un n - eps + eps) with (Un n) by ring.
+    apply Rge_le.
+    now apply growing_prop.
+    apply Rle_minus.
+    apply (proj1 H).
+    now exists n.
+
+    assert (Hi2pn: forall n, 0 < (/ 2)^n).
+    clear. intros n.
+    apply pow_lt.
+    apply Rinv_0_lt_compat.
+    now apply (IZR_lt 0 2).
+
+    pose (test := fun n => match Rle_lt_dec (Un n) (l - eps) with left _ => false | right _ => true end).
+    pose (sum := let fix aux n := match n with S n' => aux n' +
+      if test n' then (/ 2)^n else 0 | O => 0 end in aux).
+
+    assert (Hsum': forall m n, sum m <= sum (m + n)%nat <= sum m + (/2)^m - (/2)^(m + n)).
+    clearbody test.
+    clear -Hi2pn.
+    intros m.
+    induction n.
+    rewrite<- plus_n_O.
+    ring_simplify (sum m + (/ 2) ^ m - (/ 2) ^ m).
+    split ; apply Rle_refl.
+    rewrite <- plus_n_Sm.
+    simpl.
+    split.
+    apply Rle_trans with (sum (m + n)%nat + 0).
+    rewrite Rplus_0_r.
+    apply IHn.
+    apply Rplus_le_compat_l.
+    case (test (m + n)%nat).
+    apply Rlt_le.
+    exact (Hi2pn (S (m + n))).
+    apply Rle_refl.
+    apply Rle_trans with (sum (m + n)%nat + / 2 * (/ 2) ^ (m + n)).
+    apply Rplus_le_compat_l.
+    case (test (m + n)%nat).
+    apply Rle_refl.
+    apply Rlt_le.
+    exact (Hi2pn (S (m + n))).
+    apply Rplus_le_reg_r with (-(/ 2 * (/ 2) ^ (m + n))).
+    rewrite Rplus_assoc, Rplus_opp_r, Rplus_0_r.
+    apply Rle_trans with (1 := proj2 IHn).
+    apply Req_le.
+    field.
+
+    assert (Hsum: forall n, 0 <= sum n <= 1 - (/2)^n).
+    intros N.
+    generalize (Hsum' O N).
+    simpl.
+    now rewrite Rplus_0_l.
+
+    destruct (completeness (fun x : R => exists n : nat, x = sum n)) as (m, (Hm1, Hm2)).
+    exists 1.
+    intros x (n, H1).
+    rewrite H1.
+    apply Rle_trans with (1 := proj2 (Hsum n)).
+    apply Rlt_le.
+    apply Rplus_lt_reg_r with ((/2)^n - 1).
+    now ring_simplify.
+    exists 0. now exists O.
+
+    destruct (Rle_or_lt m 0) as [[Hm|Hm]|Hm].
+    elim Rlt_not_le with (1 := Hm).
+    apply Hm1.
+    now exists O.
+
+    assert (Hs0: forall n, sum n = 0).
+    intros n.
+    specialize (Hm1 (sum n) (ex_intro _ _ (eq_refl _))).
+    apply Rle_antisym with (2 := proj1 (Hsum n)).
+    now rewrite <- Hm.
+
+    assert (Hub: forall n, Un n <= l - eps).
+    intros n.
+    generalize (eq_refl (sum (S n))).
+    simpl sum at 1.
+    rewrite 2!Hs0, Rplus_0_l.
+    unfold test.
+    destruct Rle_lt_dec. easy.
+    intros H'.
+    elim Rgt_not_eq with (2 := H').
+    exact (Hi2pn (S n)).
+
+    clear -Heps H Hub.
+    destruct H as (_, H).
+    refine (False_ind _ (Rle_not_lt _ _ (H (l - eps) _) _)).
+    intros x (n, H1).
+    now rewrite H1.
+    apply Rplus_lt_reg_r with (eps - l).
+    now ring_simplify.
+
+    assert (Rabs (/2) < 1).
+    rewrite Rabs_pos_eq.
+    rewrite <- Rinv_1 at 3.
+    apply Rinv_lt_contravar.
+    rewrite Rmult_1_l.
+    now apply (IZR_lt 0 2).
+    now apply (IZR_lt 1 2).
+    apply Rlt_le.
+    apply Rinv_0_lt_compat.
+    now apply (IZR_lt 0 2).
+    destruct (pow_lt_1_zero (/2) H0 m Hm) as [N H4].
+    exists N.
+    apply Rnot_le_lt.
+    intros H5.
+    apply Rlt_not_le with (1 := H4 _ (le_refl _)).
+    rewrite Rabs_pos_eq. 2: now apply Rlt_le.
+    apply Hm2.
+    intros x (n, H6).
+    rewrite H6. clear x H6.
+
+    assert (Hs: sum N = 0).
+    clear H4.
+    induction N.
+    easy.
+    simpl.
+    assert (H6: Un N <= l - eps).
+    apply Rle_trans with (2 := H5).
+    apply Rge_le.
+    apply growing_prop ; try easy.
+    apply le_n_Sn.
+    rewrite (IHN H6), Rplus_0_l.
+    unfold test.
+    destruct Rle_lt_dec.
+    apply eq_refl.
+    now elim Rlt_not_le with (1 := r).
+
+    destruct (le_or_lt N n) as [Hn|Hn].
+    rewrite le_plus_minus with (1 := Hn).
+    apply Rle_trans with (1 := proj2 (Hsum' N (n - N)%nat)).
+    rewrite Hs, Rplus_0_l.
+    set (k := (N + (n - N))%nat).
+    apply Rlt_le.
+    apply Rplus_lt_reg_r with ((/2)^k - (/2)^N).
+    now ring_simplify.
+    apply Rle_trans with (sum N).
+    rewrite le_plus_minus with (1 := Hn).
+    rewrite plus_Snm_nSm.
+    exact (proj1 (Hsum' _ _)).
+    rewrite Hs.
+    now apply Rlt_le.
+  Qed.
 
-(** classical is needed: [not_all_not_ex] *)
 (*********)
   Lemma Un_cv_crit : Un_growing -> bound EUn ->  exists l : R, Un_cv l.
   Proof.
-    unfold Un_growing, Un_cv in |- *; intros;
-      generalize (completeness_weak EUn H0 EUn_noempty);
-        intro; elim H1; clear H1; intros; split with x; intros;
-          unfold is_lub in H1; unfold bound in H0; unfold is_upper_bound in H0, H1;
-            elim H0; clear H0; intros; elim H1; clear H1; intros;
-              generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x);
-                intro.
-    cut (exists N : nat, x - eps < Un N).
-    intro; elim H6; clear H6; intros; split with x1.
-    intros; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps).
-    unfold Rgt in H2;
-      apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H2).
-    fold Un_growing in H; generalize (growing_prop n x1 H H7); intro;
-      generalize
-        (Rlt_le_trans (x - eps) (Un x1) (Un n) H6 (Rge_le (Un n) (Un x1) H8));
-        intro; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9);
-          unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps));
-            rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *;
-              rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2);
-                trivial.
-    cut (~ (forall N:nat, x - eps >= Un N)).
-    intro; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)); red in |- *;
-      intro; red in H6; elim H6; clear H6; intro;
-        apply (Rnot_lt_ge (x - eps) (Un N) (H7 N)).
-    red in |- *; intro; cut (forall N:nat, Un N <= x - eps).
-    intro; generalize (Un_bound_imp (x - eps) H7); intro;
-      unfold is_upper_bound in H8; generalize (H3 (x - eps) H8);
-        intro; generalize (Rle_minus x (x - eps) H9); unfold Rminus in |- *;
-          rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
-            rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2);
-              rewrite Ropp_involutive; intro; unfold Rgt in H2;
-                generalize (Rgt_not_le eps 0 H2); intro; auto.
-    intro; elim (H6 N); intro; unfold Rle in |- *.
-    left; unfold Rgt in H7; assumption.
-    right; auto.
-    apply (H1 (Un n) (Un_in_EUn n)).
+    intros Hug Heub.
+    exists (projT1 (completeness EUn Heub EUn_noempty)).
+    destruct (completeness EUn Heub EUn_noempty) as (l, H).
+    now apply Un_cv_crit_lub.
   Qed.
 
 (*********)
@@ -149,20 +272,20 @@ Section sequence.
   Proof.
     intro; induction  N as [| N HrecN].
     split with (Un 0); intros; rewrite (le_n_O_eq n H);
-      apply (Req_le (Un n) (Un n) (refl_equal (Un n))).
+      apply (Req_le (Un n) (Un n) (eq_refl (Un n))).
     elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros;
       elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1;
         inversion H0.
     rewrite <- H1; rewrite <- H1 in H2;
       apply
-        (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (refl_equal (Un n))))).
+        (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (eq_refl (Un n))))).
     apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))).
   Qed.
 
 (*********)
   Lemma cauchy_bound : Cauchy_crit -> bound EUn.
   Proof.
-    unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *;
+    unfold Cauchy_crit, bound; intros; unfold is_upper_bound;
       unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros;
         generalize (H x); intro; generalize (le_dec x); intro;
           elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1));
@@ -201,12 +324,12 @@ End Isequence.
 Lemma GP_infinite :
   forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)).
 Proof.
-  intros; unfold Pser in |- *; unfold infinite_sum in |- *; intros;
+  intros; unfold Pser; unfold infinite_sum; intros;
     elim (Req_dec x 0).
   intros; exists 0%nat; intros; rewrite H1; rewrite Rminus_0_r; rewrite Rinv_1;
     cut (sum_f_R0 (fun n0:nat => 1 * 0 ^ n0) n = 1).
   intros; rewrite H3; rewrite R_dist_eq; auto.
-  elim n; simpl in |- *.
+  elim n; simpl.
   ring.
   intros; rewrite H3; ring.
   intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))).
@@ -221,11 +344,11 @@ Proof.
   apply Rabs_pos_lt.
   apply Rminus_eq_contra.
   apply Rlt_dichotomy_converse.
-  right; unfold Rgt in |- *.
+  right; unfold Rgt.
   apply (Rle_lt_trans x (Rabs x) 1).
   apply RRle_abs.
   assumption.
-  unfold R_dist in |- *; rewrite <- Rabs_mult.
+  unfold R_dist; rewrite <- Rabs_mult.
   rewrite Rmult_minus_distr_l.
   cut
     ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n =
@@ -236,7 +359,7 @@ Proof.
   cut (- (x ^ (n + 1) - 1) - 1 = - x ^ (n + 1)).
   intro; rewrite H7.
   rewrite Rabs_Ropp; cut ((n + 1)%nat = S n); auto.
-  intro H8; rewrite H8; simpl in |- *; rewrite Rabs_mult;
+  intro H8; rewrite H8; simpl; rewrite Rabs_mult;
     apply
       (Rlt_le_trans (Rabs x * Rabs (x ^ n))
         (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) (
@@ -250,7 +373,7 @@ Proof.
       Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))).
   clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r.
   rewrite Rabs_R1; cut (1 * (eps * Rabs (1 - x)) = Rabs (1 - x) * eps).
-  intros; rewrite H9; unfold Rle in |- *; right; reflexivity.
+  intros; rewrite H9; unfold Rle; right; reflexivity.
   ring.
   assumption.
   ring.
@@ -258,12 +381,12 @@ Proof.
   ring.
   apply Rminus_eq_contra.
   apply Rlt_dichotomy_converse.
-  right; unfold Rgt in |- *.
+  right; unfold Rgt.
   apply (Rle_lt_trans x (Rabs x) 1).
   apply RRle_abs.
   assumption.
   ring; ring.
-  elim n; simpl in |- *.
+  elim n; simpl.
   ring.
   intros; rewrite H5.
   ring.
@@ -273,7 +396,7 @@ Proof.
   apply Rabs_pos_lt.
   apply Rminus_eq_contra.
   apply Rlt_dichotomy_converse.
-  right; unfold Rgt in |- *.
+  right; unfold Rgt.
   apply (Rle_lt_trans x (Rabs x) 1).
   apply RRle_abs.
   assumption.
diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v
index fad19ed2..76b44d96 100644
--- a/theories/Reals/Rsigma.v
+++ b/theories/Reals/Rsigma.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rsigma.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rseries.
 Require Import PartSum.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Set Implicit Arguments.
 
@@ -30,8 +28,8 @@ Section Sigma.
   Proof.
     intros; induction  k as [| k Hreck].
     cut (low = 0%nat).
-    intro; rewrite H1; unfold sigma in |- *; rewrite <- minus_n_n;
-      rewrite <- minus_n_O; simpl in |- *; replace (high - 1)%nat with (pred high).
+    intro; rewrite H1; unfold sigma; rewrite <- minus_n_n;
+      rewrite <- minus_n_O; simpl; replace (high - 1)%nat with (pred high).
     apply (decomp_sum (fun k:nat => f k)).
     assumption.
     apply pred_of_minus.
@@ -44,8 +42,8 @@ Section Sigma.
     apply Hreck.
     assumption.
     apply lt_trans with (S k); [ apply lt_n_Sn | assumption ].
-    unfold sigma in |- *; replace (high - S (S k))%nat with (pred (high - S k)).
-    pattern (S k) at 3 in |- *; replace (S k) with (S k + 0)%nat;
+    unfold sigma; replace (high - S (S k))%nat with (pred (high - S k)).
+    pattern (S k) at 3; replace (S k) with (S k + 0)%nat;
       [ idtac | ring ].
     replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with
     (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))).
@@ -57,12 +55,12 @@ Section Sigma.
     replace (high - S (S k))%nat with (high - S k - 1)%nat.
     apply pred_of_minus.
     omega.
-    unfold sigma in |- *; replace (S k - low)%nat with (S (k - low)).
-    pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat.
-    symmetry  in |- *; apply (tech5 (fun i:nat => f (low + i))).
+    unfold sigma; replace (S k - low)%nat with (S (k - low)).
+    pattern (S k) at 1; replace (S k) with (low + S (k - low))%nat.
+    symmetry ; apply (tech5 (fun i:nat => f (low + i))).
     omega.
     omega.
-    rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *;
+    rewrite <- H2; unfold sigma; rewrite <- minus_n_n; simpl;
       replace (high - S low)%nat with (pred (high - low)).
     replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with
     (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))).
@@ -81,7 +79,7 @@ Section Sigma.
       (low <= k)%nat ->
       (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high.
   Proof.
-    intros low high k H1 H2; symmetry  in |- *; rewrite (sigma_split H1 H2); ring.
+    intros low high k H1 H2; symmetry ; rewrite (sigma_split H1 H2); ring.
   Qed.
 
   Theorem sigma_diff_neg :
@@ -102,8 +100,8 @@ Section Sigma.
     apply sigma_split.
     apply le_n.
     assumption.
-    unfold sigma in |- *; rewrite <- minus_n_n.
-    simpl in |- *.
+    unfold sigma; rewrite <- minus_n_n.
+    simpl.
     replace (low + 0)%nat with low; [ reflexivity | ring ].
   Qed.
 
@@ -115,20 +113,20 @@ Section Sigma.
       generalize (lt_le_weak low high H1); intro H3;
         replace (f high) with (sigma high high).
     rewrite Rplus_comm; cut (high = S (pred high)).
-    intro; pattern high at 3 in |- *; rewrite H.
+    intro; pattern high at 3; rewrite H.
     apply sigma_split.
     apply le_S_n; rewrite <- H; apply lt_le_S; assumption.
     apply lt_pred_n_n; apply le_lt_trans with low; [ apply le_O_n | assumption ].
     apply S_pred with 0%nat; apply le_lt_trans with low;
       [ apply le_O_n | assumption ].
-    unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *;
+    unfold sigma; rewrite <- minus_n_n; simpl;
       replace (high + 0)%nat with high; [ reflexivity | ring ].
   Qed.
 
   Theorem sigma_eq_arg : forall low:nat, sigma low low = f low.
   Proof.
-    intro; unfold sigma in |- *; rewrite <- minus_n_n.
-    simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ].
+    intro; unfold sigma; rewrite <- minus_n_n.
+    simpl; replace (low + 0)%nat with low; [ reflexivity | ring ].
   Qed.
 
 End Sigma.
diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v
index f2095982..a6e48f83 100644
--- a/theories/Reals/Rsqrt_def.v
+++ b/theories/Reals/Rsqrt_def.v
@@ -1,21 +1,19 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rsqrt_def.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Sumbool.
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
 Require Import Ranalysis1.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
-Boxed Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R :=
+Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R :=
   match N with
     | O => x
     | S n =>
@@ -43,20 +41,20 @@ Lemma dicho_comp :
 Proof.
   intros.
   induction  n as [| n Hrecn].
-  simpl in |- *; assumption.
-  simpl in |- *.
+  simpl; assumption.
+  simpl.
   case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  unfold Rdiv; apply Rmult_le_reg_l with 2.
   prove_sup0.
-  pattern 2 at 1 in |- *; rewrite Rmult_comm.
+  pattern 2 at 1; rewrite Rmult_comm.
   rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
   rewrite Rmult_1_r.
   rewrite double.
   apply Rplus_le_compat_l.
   assumption.
-  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  unfold Rdiv; apply Rmult_le_reg_l with 2.
   prove_sup0.
-  pattern 2 at 3 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_comm.
   rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
   rewrite Rmult_1_r.
   rewrite double.
@@ -69,14 +67,14 @@ Lemma dicho_lb_growing :
   forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P).
 Proof.
   intros.
-  unfold Un_growing in |- *.
+  unfold Un_growing.
   intro.
-  simpl in |- *.
+  simpl.
   case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
   right; reflexivity.
-  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  unfold Rdiv; apply Rmult_le_reg_l with 2.
   prove_sup0.
-  pattern 2 at 1 in |- *; rewrite Rmult_comm.
+  pattern 2 at 1; rewrite Rmult_comm.
   rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
   rewrite Rmult_1_r.
   rewrite double.
@@ -89,13 +87,13 @@ Lemma dicho_up_decreasing :
   forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P).
 Proof.
   intros.
-  unfold Un_decreasing in |- *.
+  unfold Un_decreasing.
   intro.
-  simpl in |- *.
+  simpl.
   case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  unfold Rdiv; apply Rmult_le_reg_l with 2.
   prove_sup0.
-  pattern 2 at 3 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_comm.
   rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
   rewrite Rmult_1_r.
   rewrite double.
@@ -114,17 +112,17 @@ Lemma dicho_lb_maj_y :
 Proof.
   intros.
   induction  n as [| n Hrecn].
-  simpl in |- *; assumption.
-  simpl in |- *.
+  simpl; assumption.
+  simpl.
   case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
   assumption.
-  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  unfold Rdiv; apply Rmult_le_reg_l with 2.
   prove_sup0.
-  pattern 2 at 3 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_comm.
   rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ].
   rewrite double; apply Rplus_le_compat.
   assumption.
-  pattern y at 2 in |- *; replace y with (Dichotomy_ub x y P 0);
+  pattern y at 2; replace y with (Dichotomy_ub x y P 0);
     [ idtac | reflexivity ].
   apply decreasing_prop.
   assert (H0 := dicho_up_decreasing x y P H).
@@ -138,10 +136,10 @@ Proof.
   intros.
   cut (forall n:nat, dicho_lb x y P n <= y).
   intro.
-  unfold has_ub in |- *.
-  unfold bound in |- *.
+  unfold has_ub.
+  unfold bound.
   exists y.
-  unfold is_upper_bound in |- *.
+  unfold is_upper_bound.
   intros.
   elim H1; intros.
   rewrite H2; apply H0.
@@ -153,15 +151,15 @@ Lemma dicho_up_min_x :
 Proof.
   intros.
   induction  n as [| n Hrecn].
-  simpl in |- *; assumption.
-  simpl in |- *.
+  simpl; assumption.
+  simpl.
   case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  unfold Rdiv; apply Rmult_le_reg_l with 2.
   prove_sup0.
-  pattern 2 at 1 in |- *; rewrite Rmult_comm.
+  pattern 2 at 1; rewrite Rmult_comm.
   rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ].
   rewrite double; apply Rplus_le_compat.
-  pattern x at 1 in |- *; replace x with (Dichotomy_lb x y P 0);
+  pattern x at 1; replace x with (Dichotomy_lb x y P 0);
     [ idtac | reflexivity ].
   apply tech9.
   assert (H0 := dicho_lb_growing x y P H).
@@ -177,14 +175,14 @@ Proof.
   intros.
   cut (forall n:nat, x <= dicho_up x y P n).
   intro.
-  unfold has_lb in |- *.
-  unfold bound in |- *.
+  unfold has_lb.
+  unfold bound.
   exists (- x).
-  unfold is_upper_bound in |- *.
+  unfold is_upper_bound.
   intros.
   elim H1; intros.
   rewrite H2.
-  unfold opp_seq in |- *.
+  unfold opp_seq.
   apply Ropp_le_contravar.
   apply H0.
   apply dicho_up_min_x; assumption.
@@ -216,35 +214,35 @@ Lemma dicho_lb_dicho_up :
 Proof.
   intros.
   induction  n as [| n Hrecn].
-  simpl in |- *.
-  unfold Rdiv in |- *; rewrite Rinv_1; ring.
-  simpl in |- *.
+  simpl.
+  unfold Rdiv; rewrite Rinv_1; ring.
+  simpl.
   case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-  unfold Rdiv in |- *.
+  unfold Rdiv.
   replace
   ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) * / 2 - Dichotomy_lb x y P n)
     with ((dicho_up x y P n - dicho_lb x y P n) / 2).
-  unfold Rdiv in |- *; rewrite Hrecn.
-  unfold Rdiv in |- *.
+  unfold Rdiv; rewrite Hrecn.
+  unfold Rdiv.
   rewrite Rinv_mult_distr.
   ring.
   discrR.
   apply pow_nonzero; discrR.
-  pattern (Dichotomy_lb x y P n) at 2 in |- *;
+  pattern (Dichotomy_lb x y P n) at 2;
     rewrite (double_var (Dichotomy_lb x y P n));
-      unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring.
+      unfold dicho_up, dicho_lb, Rminus, Rdiv; ring.
   replace
   (Dichotomy_ub x y P n - (Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)
     with ((dicho_up x y P n - dicho_lb x y P n) / 2).
-  unfold Rdiv in |- *; rewrite Hrecn.
-  unfold Rdiv in |- *.
+  unfold Rdiv; rewrite Hrecn.
+  unfold Rdiv.
   rewrite Rinv_mult_distr.
   ring.
   discrR.
   apply pow_nonzero; discrR.
-  pattern (Dichotomy_ub x y P n) at 1 in |- *;
+  pattern (Dichotomy_ub x y P n) at 1;
     rewrite (double_var (Dichotomy_ub x y P n));
-      unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring.
+      unfold dicho_up, dicho_lb, Rminus, Rdiv; ring.
 Qed.
 
 Definition pow_2_n (n:nat) := 2 ^ n.
@@ -252,23 +250,23 @@ Definition pow_2_n (n:nat) := 2 ^ n.
 Lemma pow_2_n_neq_R0 : forall n:nat, pow_2_n n <> 0.
 Proof.
   intro.
-  unfold pow_2_n in |- *.
+  unfold pow_2_n.
   apply pow_nonzero.
   discrR.
 Qed.
 
 Lemma pow_2_n_growing : Un_growing pow_2_n.
 Proof.
-  unfold Un_growing in |- *.
+  unfold Un_growing.
   intro.
   replace (S n) with (n + 1)%nat;
-  [ unfold pow_2_n in |- *; rewrite pow_add | ring ].
-  pattern (2 ^ n) at 1 in |- *; rewrite <- Rmult_1_r.
+  [ unfold pow_2_n; rewrite pow_add | ring ].
+  pattern (2 ^ n) at 1; rewrite <- Rmult_1_r.
   apply Rmult_le_compat_l.
   left; apply pow_lt; prove_sup0.
-  simpl in |- *.
+  simpl.
   rewrite Rmult_1_r.
-  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+  pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
     apply Rlt_0_1.
 Qed.
 
@@ -276,7 +274,7 @@ Lemma pow_2_n_infty : cv_infty pow_2_n.
 Proof.
   cut (forall N:nat, INR N <= 2 ^ N).
   intros.
-  unfold cv_infty in |- *.
+  unfold cv_infty.
   intro.
   case (total_order_T 0 M); intro.
   elim s; intro.
@@ -289,41 +287,41 @@ Proof.
   apply Rlt_le_trans with (INR N0).
   rewrite INR_IZR_INZ.
   rewrite <- H1.
-  unfold N in |- *.
+  unfold N.
   assert (H3 := archimed M).
   elim H3; intros; assumption.
   apply Rle_trans with (pow_2_n N0).
-  unfold pow_2_n in |- *; apply H.
+  unfold pow_2_n; apply H.
   apply Rge_le.
   apply growing_prop.
   apply pow_2_n_growing.
   assumption.
   apply le_IZR.
-  unfold N in |- *.
-  simpl in |- *.
+  unfold N.
+  simpl.
   assert (H0 := archimed M); elim H0; intros.
   left; apply Rlt_trans with M; assumption.
   exists 0%nat; intros.
   rewrite <- b.
-  unfold pow_2_n in |- *; apply pow_lt; prove_sup0.
+  unfold pow_2_n; apply pow_lt; prove_sup0.
   exists 0%nat; intros.
   apply Rlt_trans with 0.
   assumption.
-  unfold pow_2_n in |- *; apply pow_lt; prove_sup0.
+  unfold pow_2_n; apply pow_lt; prove_sup0.
   simple induction N.
-  simpl in |- *.
+  simpl.
   left; apply Rlt_0_1.
   intros.
-  pattern (S n) at 2 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  pattern (S n) at 2; replace (S n) with (n + 1)%nat; [ idtac | ring ].
   rewrite S_INR; rewrite pow_add.
-  simpl in |- *.
+  simpl.
   rewrite Rmult_1_r.
   apply Rle_trans with (2 ^ n).
   rewrite <- (Rplus_comm 1).
   rewrite <- (Rmult_1_r (INR n)).
   apply (poly n 1).
   apply Rlt_0_1.
-  pattern (2 ^ n) at 1 in |- *; rewrite <- Rplus_0_r.
+  pattern (2 ^ n) at 1; rewrite <- Rplus_0_r.
   rewrite <- (Rmult_comm 2).
   rewrite double.
   apply Rplus_le_compat_l.
@@ -340,8 +338,8 @@ Proof.
   cut (Un_cv (fun i:nat => dicho_lb x y P i - dicho_up x y P i) 0).
   intro.
   assert (H4 := UL_sequence _ _ _ H2 H3).
-  symmetry  in |- *; apply Rminus_diag_uniq_sym; assumption.
-  unfold Un_cv in |- *; unfold R_dist in |- *.
+  symmetry ; apply Rminus_diag_uniq_sym; assumption.
+  unfold Un_cv; unfold R_dist.
   intros.
   assert (H4 := cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty).
   case (total_order_T x y); intro.
@@ -358,7 +356,7 @@ Proof.
   rewrite <- Rabs_Ropp.
   rewrite Ropp_minus_distr'.
   rewrite dicho_lb_dicho_up.
-  unfold Rdiv in |- *; rewrite Rabs_mult.
+  unfold Rdiv; rewrite Rabs_mult.
   rewrite (Rabs_right (y - x)).
   apply Rmult_lt_reg_l with (/ (y - x)).
   apply Rinv_0_lt_compat; assumption.
@@ -368,12 +366,12 @@ Proof.
   [ unfold pow_2_n, Rdiv in H6; rewrite <- (Rmult_comm eps); apply H6;
     assumption
     | ring ].
-  red in |- *; intro; rewrite H8 in Hyp; elim (Rlt_irrefl _ Hyp).
+  red; intro; rewrite H8 in Hyp; elim (Rlt_irrefl _ Hyp).
   apply Rle_ge.
   apply Rplus_le_reg_l with x; rewrite Rplus_0_r.
   replace (x + (y - x)) with y; [ assumption | ring ].
   assumption.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; assumption ].
   apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
   replace (x + (y - x)) with y; [ assumption | ring ].
@@ -384,7 +382,7 @@ Proof.
   rewrite Ropp_minus_distr'.
   rewrite dicho_lb_dicho_up.
   rewrite b.
-  unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; rewrite Rmult_0_l;
+  unfold Rminus, Rdiv; rewrite Rplus_opp_r; rewrite Rmult_0_l;
     rewrite Rabs_R0; assumption.
   assumption.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
@@ -401,26 +399,26 @@ Lemma continuity_seq :
   forall (f:R -> R) (Un:nat -> R) (l:R),
     continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l).
 Proof.
-  unfold continuity_pt, Un_cv in |- *; unfold continue_in in |- *.
-  unfold limit1_in in |- *.
-  unfold limit_in in |- *.
-  unfold dist in |- *.
-  simpl in |- *.
-  unfold R_dist in |- *.
+  unfold continuity_pt, Un_cv; unfold continue_in.
+  unfold limit1_in.
+  unfold limit_in.
+  unfold dist.
+  simpl.
+  unfold R_dist.
   intros.
   elim (H eps H1); intros alp H2.
   elim H2; intros.
   elim (H0 alp H3); intros N H5.
   exists N; intros.
   case (Req_dec (Un n) l); intro.
-  rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  rewrite H7; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     assumption.
   apply H4.
   split.
-  unfold D_x, no_cond in |- *.
+  unfold D_x, no_cond.
   split.
   trivial.
-  apply (sym_not_eq (A:=R)); assumption.
+  apply (not_eq_sym (A:=R)); assumption.
   apply H5; assumption.
 Qed.
 
@@ -430,9 +428,9 @@ Lemma dicho_lb_car :
 Proof.
   intros.
   induction  n as [| n Hrecn].
-  simpl in |- *.
+  simpl.
   assumption.
-  simpl in |- *.
+  simpl.
   assert
     (X :=
       sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))).
@@ -449,9 +447,9 @@ Lemma dicho_up_car :
 Proof.
   intros.
   induction  n as [| n Hrecn].
-  simpl in |- *.
+  simpl.
   assumption.
-  simpl in |- *.
+  simpl.
   assert
     (X :=
       sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))).
@@ -482,7 +480,7 @@ Proof.
   split.
   split.
   apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0).
-  simpl in |- *.
+  simpl.
   right; reflexivity.
   apply growing_ineq.
   apply dicho_lb_growing; assumption.
@@ -505,7 +503,7 @@ Proof.
   assert (H10 := H5 H7).
   apply Rle_antisym; assumption.
   intro.
-  unfold Wn in |- *.
+  unfold Wn.
   cut (forall z:R, cond_positivity z = true <-> 0 <= z).
   intro.
   assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n).
@@ -516,7 +514,7 @@ Proof.
   apply H12.
   left; assumption.
   intro.
-  unfold cond_positivity in |- *.
+  unfold cond_positivity.
   case (Rle_dec 0 z); intro.
   split.
   intro; assumption.
@@ -525,7 +523,7 @@ Proof.
   intro feqt;discriminate feqt.
   intro.
   elim n0; assumption.
-  unfold Vn in |- *.
+  unfold Vn.
   cut (forall z:R, cond_positivity z = false <-> z < 0).
   intros.
   assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n).
@@ -537,7 +535,7 @@ Proof.
   apply H12.
   assumption.
   intro.
-  unfold cond_positivity in |- *.
+  unfold cond_positivity.
   case (Rle_dec 0 z); intro.
   split.
   intro feqt; discriminate feqt.
@@ -556,7 +554,7 @@ Proof.
   cut (0 < - f x0).
   intro.
   elim (H7 (- f x0) H8); intros.
-  cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
+  cut (x2 >= x2)%nat; [ intro | unfold ge; apply le_n ].
   assert (H11 := H9 x2 H10).
   rewrite Rabs_right in H11.
   pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11.
@@ -564,11 +562,11 @@ Proof.
   assert (H12 := Rplus_lt_reg_r _ _ _ H11).
   assert (H13 := H6 x2).
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)).
-  apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat.
+  apply Rle_ge; left; unfold Rminus; apply Rplus_le_lt_0_compat.
   apply H6.
   exact H8.
   apply Ropp_0_gt_lt_contravar; assumption.
-  unfold Wn in |- *; assumption.
+  unfold Wn; assumption.
   cut (Un_cv Vn x0).
   intros.
   assert (H7 := continuity_seq f Vn x0 (H x0) H5).
@@ -576,7 +574,7 @@ Proof.
   elim s; intro.
   unfold Un_cv in H7; unfold R_dist in H7.
   elim (H7 (f x0) a); intros.
-  cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
+  cut (x2 >= x2)%nat; [ intro | unfold ge; apply le_n ].
   assert (H10 := H8 x2 H9).
   rewrite Rabs_left in H10.
   pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10.
@@ -591,12 +589,12 @@ Proof.
   apply Ropp_0_gt_lt_contravar; assumption.
   apply Rplus_lt_reg_r with (f x0 - f (Vn x2)).
   rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0;
-    [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ].
+    [ unfold Rminus; apply Rplus_lt_le_0_compat | ring ].
   assumption.
   apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6.
   right; rewrite <- b; reflexivity.
   left; assumption.
-  unfold Vn in |- *; assumption.
+  unfold Vn; assumption.
 Qed.
 
 Lemma IVT_cor :
@@ -615,11 +613,11 @@ Proof.
   exists y.
   split.
   split; [ assumption | right; reflexivity ].
-  symmetry  in |- *; exact b.
+  symmetry ; exact b.
   exists x.
   split.
   split; [ right; reflexivity | assumption ].
-  symmetry  in |- *; exact b.
+  symmetry ; exact b.
   elim s; intro.
   cut (x < y).
   intro.
@@ -635,8 +633,8 @@ Proof.
   unfold opp_fct in H7.
   rewrite <- (Ropp_involutive (f x0)).
   apply Ropp_eq_0_compat; assumption.
-  unfold opp_fct in |- *; apply Ropp_0_gt_lt_contravar; assumption.
-  unfold opp_fct in |- *.
+  unfold opp_fct; apply Ropp_0_gt_lt_contravar; assumption.
+  unfold opp_fct.
   apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r;
     assumption.
   inversion H0.
@@ -646,7 +644,7 @@ Proof.
   exists x.
   split.
   split; [ right; reflexivity | assumption ].
-  symmetry  in |- *; assumption.
+  symmetry ; assumption.
   case (total_order_T 0 (f y)); intro.
   elim s; intro.
   cut (x < y).
@@ -659,7 +657,7 @@ Proof.
   exists y.
   split.
   split; [ assumption | right; reflexivity ].
-  symmetry  in |- *; assumption.
+  symmetry ; assumption.
   cut (0 < f x * f y).
   intro.
   elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)).
@@ -692,18 +690,18 @@ Proof.
   elim H5; intros; assumption.
   unfold f in H6.
   apply Rminus_diag_uniq_sym; exact H6.
-  rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f 1)).
+  rewrite Rmult_comm; pattern 0 at 2; rewrite <- (Rmult_0_r (f 1)).
   apply Rmult_le_compat_l; assumption.
-  unfold f in |- *.
+  unfold f.
   rewrite Rsqr_1.
   apply Rplus_le_reg_l with y.
-  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus;
     rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
       left; assumption.
   exists 1.
   split.
   left; apply Rlt_0_1.
-  rewrite b; symmetry  in |- *; apply Rsqr_1.
+  rewrite b; symmetry ; apply Rsqr_1.
   cut (0 <= f y).
   intro.
   cut (f 0 * f y <= 0).
@@ -716,14 +714,14 @@ Proof.
   elim H5; intros; assumption.
   unfold f in H6.
   apply Rminus_diag_uniq_sym; exact H6.
-  rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)).
+  rewrite Rmult_comm; pattern 0 at 2; rewrite <- (Rmult_0_r (f y)).
   apply Rmult_le_compat_l; assumption.
-  unfold f in |- *.
+  unfold f.
   apply Rplus_le_reg_l with y.
-  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus;
     rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
-  pattern y at 1 in |- *; rewrite <- Rmult_1_r.
-  unfold Rsqr in |- *; apply Rmult_le_compat_l.
+  pattern y at 1; rewrite <- Rmult_1_r.
+  unfold Rsqr; apply Rmult_le_compat_l.
   assumption.
   left; exact r.
   replace f with (Rsqr - fct_cte y)%F.
@@ -731,8 +729,8 @@ Proof.
   apply derivable_continuous; apply derivable_Rsqr.
   apply derivable_continuous; apply derivable_const.
   reflexivity.
-  unfold f in |- *; rewrite Rsqr_0.
-  unfold Rminus in |- *; rewrite Rplus_0_l.
+  unfold f; rewrite Rsqr_0.
+  unfold Rminus; rewrite Rplus_0_l.
   apply Rge_le.
   apply Ropp_0_le_ge_contravar; assumption.
 Qed.
@@ -751,7 +749,7 @@ Proof.
   intros.
   elim p; intros.
   rewrite H in H0; assumption.
-  unfold Rsqrt in |- *.
+  unfold Rsqrt.
   case (Rsqrt_exists x (cond_nonneg x)).
   intros.
   elim p; elim a; intros.
@@ -772,7 +770,7 @@ Proof.
   rewrite <- H.
   elim p; intros.
   rewrite H1; reflexivity.
-  unfold Rsqrt in |- *.
+  unfold Rsqrt.
   case (Rsqrt_exists x (cond_nonneg x)).
   intros.
   elim p; elim a; intros.
diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v
index 8e9b2bb3..51d0b99e 100644
--- a/theories/Reals/Rtopology.v
+++ b/theories/Reals/Rtopology.v
@@ -1,20 +1,18 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtopology.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Ranalysis1.
 Require Import RList.
 Require Import Classical_Prop.
 Require Import Classical_Pred_Type.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (** * General definitions and propositions *)
 
@@ -32,16 +30,16 @@ Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x.
 
 Lemma interior_P1 : forall D:R -> Prop, included (interior D) D.
 Proof.
-  intros; unfold included in |- *; unfold interior in |- *; intros;
+  intros; unfold included; unfold interior; intros;
     unfold neighbourhood in H; elim H; intros; unfold included in H0;
-      apply H0; unfold disc in |- *; unfold Rminus in |- *;
+      apply H0; unfold disc; unfold Rminus;
         rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0).
 Qed.
 
 Lemma interior_P2 : forall D:R -> Prop, open_set D -> included D (interior D).
 Proof.
-  intros; unfold open_set in H; unfold included in |- *; intros;
-    assert (H1 := H _ H0); unfold interior in |- *; apply H1.
+  intros; unfold open_set in H; unfold included; intros;
+    assert (H1 := H _ H0); unfold interior; apply H1.
 Qed.
 
 Definition point_adherent (D:R -> Prop) (x:R) : Prop :=
@@ -51,11 +49,11 @@ Definition adherence (D:R -> Prop) (x:R) : Prop := point_adherent D x.
 
 Lemma adherence_P1 : forall D:R -> Prop, included D (adherence D).
 Proof.
-  intro; unfold included in |- *; intros; unfold adherence in |- *;
-    unfold point_adherent in |- *; intros; exists x;
-      unfold intersection_domain in |- *; split.
+  intro; unfold included; intros; unfold adherence;
+    unfold point_adherent; intros; exists x;
+      unfold intersection_domain; split.
   unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1;
-    unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    unfold disc; unfold Rminus; rewrite Rplus_opp_r;
       rewrite Rabs_R0; apply (cond_pos x0).
   apply H.
 Qed.
@@ -64,29 +62,29 @@ Lemma included_trans :
   forall D1 D2 D3:R -> Prop,
     included D1 D2 -> included D2 D3 -> included D1 D3.
 Proof.
-  unfold included in |- *; intros; apply H0; apply H; apply H1.
+  unfold included; intros; apply H0; apply H; apply H1.
 Qed.
 
 Lemma interior_P3 : forall D:R -> Prop, open_set (interior D).
 Proof.
-  intro; unfold open_set, interior in |- *; unfold neighbourhood in |- *;
+  intro; unfold open_set, interior; unfold neighbourhood;
     intros; elim H; intros.
-  exists x0; unfold included in |- *; intros.
+  exists x0; unfold included; intros.
   set (del := x0 - Rabs (x - x1)).
   cut (0 < del).
   intro; exists (mkposreal del H2); intros.
   cut (included (disc x1 (mkposreal del H2)) (disc x x0)).
   intro; assert (H5 := included_trans _ _ _ H4 H0).
   apply H5; apply H3.
-  unfold included in |- *; unfold disc in |- *; intros.
+  unfold included; unfold disc; intros.
   apply Rle_lt_trans with (Rabs (x3 - x1) + Rabs (x1 - x)).
   replace (x3 - x) with (x3 - x1 + (x1 - x)); [ apply Rabs_triang | ring ].
   replace (pos x0) with (del + Rabs (x1 - x)).
   do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l;
     apply H4.
-  unfold del in |- *; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr;
+  unfold del; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr;
     ring.
-  unfold del in |- *; apply Rplus_lt_reg_r with (Rabs (x - x1));
+  unfold del; apply Rplus_lt_reg_r with (Rabs (x - x1));
     rewrite Rplus_0_r;
       replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
       [ idtac | ring ].
@@ -97,7 +95,7 @@ Lemma complementary_P1 :
   forall D:R -> Prop,
     ~ (exists y : R, intersection_domain D (complementary D) y).
 Proof.
-  intro; red in |- *; intro; elim H; intros;
+  intro; red; intro; elim H; intros;
     unfold intersection_domain, complementary in H0; elim H0;
       intros; elim H2; assumption.
 Qed.
@@ -105,8 +103,8 @@ Qed.
 Lemma adherence_P2 :
   forall D:R -> Prop, closed_set D -> included (adherence D) D.
 Proof.
-  unfold closed_set in |- *; unfold open_set, complementary in |- *; intros;
-    unfold included, adherence in |- *; intros; assert (H1 := classic (D x));
+  unfold closed_set; unfold open_set, complementary; intros;
+    unfold included, adherence; intros; assert (H1 := classic (D x));
       elim H1; intro.
   assumption.
   assert (H3 := H _ H2); assert (H4 := H0 _ H3); elim H4; intros;
@@ -116,8 +114,8 @@ Qed.
 
 Lemma adherence_P3 : forall D:R -> Prop, closed_set (adherence D).
 Proof.
-  intro; unfold closed_set, adherence in |- *;
-    unfold open_set, complementary, point_adherent in |- *;
+  intro; unfold closed_set, adherence;
+    unfold open_set, complementary, point_adherent;
       intros;
         set
           (P :=
@@ -125,21 +123,21 @@ Proof.
               neighbourhood V x ->  exists y : R, intersection_domain V D y);
           assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1;
             unfold P in H1; assert (H2 := imply_to_and _ _ H1);
-              unfold neighbourhood in |- *; elim H2; intros; unfold neighbourhood in H3;
-                elim H3; intros; exists x0; unfold included in |- *;
-                  intros; red in |- *; intro.
+              unfold neighbourhood; elim H2; intros; unfold neighbourhood in H3;
+                elim H3; intros; exists x0; unfold included;
+                  intros; red; intro.
   assert (H8 := H7 V0);
     cut (exists delta : posreal, (forall x:R, disc x1 delta x -> V0 x)).
   intro; assert (H10 := H8 H9); elim H4; assumption.
   cut (0 < x0 - Rabs (x - x1)).
   intro; set (del := mkposreal _ H9); exists del; intros;
-    unfold included in H5; apply H5; unfold disc in |- *;
+    unfold included in H5; apply H5; unfold disc;
       apply Rle_lt_trans with (Rabs (x2 - x1) + Rabs (x1 - x)).
   replace (x2 - x) with (x2 - x1 + (x1 - x)); [ apply Rabs_triang | ring ].
   replace (pos x0) with (del + Rabs (x1 - x)).
   do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l;
     apply H10.
-  unfold del in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x1));
+  unfold del; simpl; rewrite <- (Rabs_Ropp (x - x1));
     rewrite Ropp_minus_distr; ring.
   apply Rplus_lt_reg_r with (Rabs (x - x1)); rewrite Rplus_0_r;
     replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
@@ -154,10 +152,10 @@ Infix "=_D" := eq_Dom (at level 70, no associativity).
 Lemma open_set_P1 : forall D:R -> Prop, open_set D <-> D =_D interior D.
 Proof.
   intro; split.
-  intro; unfold eq_Dom in |- *; split.
+  intro; unfold eq_Dom; split.
   apply interior_P2; assumption.
   apply interior_P1.
-  intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set in |- *;
+  intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set;
     intros; unfold included, interior in H; unfold included in H0;
       apply (H _ H1).
 Qed.
@@ -165,20 +163,20 @@ Qed.
 Lemma closed_set_P1 : forall D:R -> Prop, closed_set D <-> D =_D adherence D.
 Proof.
   intro; split.
-  intro; unfold eq_Dom in |- *; split.
+  intro; unfold eq_Dom; split.
   apply adherence_P1.
   apply adherence_P2; assumption.
-  unfold eq_Dom in |- *; unfold included in |- *; intros;
+  unfold eq_Dom; unfold included; intros;
     assert (H0 := adherence_P3 D); unfold closed_set in H0;
-      unfold closed_set in |- *; unfold open_set in |- *;
+      unfold closed_set; unfold open_set;
         unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x).
-  unfold complementary in |- *; unfold complementary in H1; red in |- *; intro;
+  unfold complementary; unfold complementary in H1; red; intro;
     elim H; clear H; intros _ H; elim H1; apply (H _ H2).
-  assert (H3 := H0 _ H2); unfold neighbourhood in |- *;
+  assert (H3 := H0 _ H2); unfold neighbourhood;
     unfold neighbourhood in H3; elim H3; intros; exists x0;
-      unfold included in |- *; unfold included in H4; intros;
+      unfold included; unfold included in H4; intros;
         assert (H6 := H4 _ H5); unfold complementary in H6;
-          unfold complementary in |- *; red in |- *; intro;
+          unfold complementary; red; intro;
             elim H; clear H; intros H _; elim H6; apply (H _ H7).
 Qed.
 
@@ -186,8 +184,8 @@ Lemma neighbourhood_P1 :
   forall (D1 D2:R -> Prop) (x:R),
     included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x.
 Proof.
-  unfold included, neighbourhood in |- *; intros; elim H0; intros; exists x0;
-    intros; unfold included in |- *; unfold included in H1;
+  unfold included, neighbourhood; intros; elim H0; intros; exists x0;
+    intros; unfold included; unfold included in H1;
       intros; apply (H _ (H1 _ H2)).
 Qed.
 
@@ -195,12 +193,12 @@ Lemma open_set_P2 :
   forall D1 D2:R -> Prop,
     open_set D1 -> open_set D2 -> open_set (union_domain D1 D2).
 Proof.
-  unfold open_set in |- *; intros; unfold union_domain in H1; elim H1; intro.
+  unfold open_set; intros; unfold union_domain in H1; elim H1; intro.
   apply neighbourhood_P1 with D1.
-  unfold included, union_domain in |- *; tauto.
+  unfold included, union_domain; tauto.
   apply H; assumption.
   apply neighbourhood_P1 with D2.
-  unfold included, union_domain in |- *; tauto.
+  unfold included, union_domain; tauto.
   apply H0; assumption.
 Qed.
 
@@ -208,53 +206,53 @@ Lemma open_set_P3 :
   forall D1 D2:R -> Prop,
     open_set D1 -> open_set D2 -> open_set (intersection_domain D1 D2).
 Proof.
-  unfold open_set in |- *; intros; unfold intersection_domain in H1; elim H1;
+  unfold open_set; intros; unfold intersection_domain in H1; elim H1;
     intros.
   assert (H4 := H _ H2); assert (H5 := H0 _ H3);
-    unfold intersection_domain in |- *; unfold neighbourhood in H4, H5;
+    unfold intersection_domain; unfold neighbourhood in H4, H5;
       elim H4; clear H; intros del1 H; elim H5; clear H0;
         intros del2 H0; cut (0 < Rmin del1 del2).
   intro; set (del := mkposreal _ H6).
-  exists del; unfold included in |- *; intros; unfold included in H, H0;
+  exists del; unfold included; intros; unfold included in H, H0;
     unfold disc in H, H0, H7.
   split.
   apply H; apply Rlt_le_trans with (pos del).
   apply H7.
-  unfold del in |- *; simpl in |- *; apply Rmin_l.
+  unfold del; simpl; apply Rmin_l.
   apply H0; apply Rlt_le_trans with (pos del).
   apply H7.
-  unfold del in |- *; simpl in |- *; apply Rmin_r.
-  unfold Rmin in |- *; case (Rle_dec del1 del2); intro.
+  unfold del; simpl; apply Rmin_r.
+  unfold Rmin; case (Rle_dec del1 del2); intro.
   apply (cond_pos del1).
   apply (cond_pos del2).
 Qed.
 
 Lemma open_set_P4 : open_set (fun x:R => False).
 Proof.
-  unfold open_set in |- *; intros; elim H.
+  unfold open_set; intros; elim H.
 Qed.
 
 Lemma open_set_P5 : open_set (fun x:R => True).
 Proof.
-  unfold open_set in |- *; intros; unfold neighbourhood in |- *.
-  exists (mkposreal 1 Rlt_0_1); unfold included in |- *; intros; trivial.
+  unfold open_set; intros; unfold neighbourhood.
+  exists (mkposreal 1 Rlt_0_1); unfold included; intros; trivial.
 Qed.
 
 Lemma disc_P1 : forall (x:R) (del:posreal), open_set (disc x del).
 Proof.
   intros; assert (H := open_set_P1 (disc x del)).
   elim H; intros; apply H1.
-  unfold eq_Dom in |- *; split.
-  unfold included, interior, disc in |- *; intros;
+  unfold eq_Dom; split.
+  unfold included, interior, disc; intros;
     cut (0 < del - Rabs (x - x0)).
   intro; set (del2 := mkposreal _ H3).
-  exists del2; unfold included in |- *; intros.
+  exists del2; unfold included; intros.
   apply Rle_lt_trans with (Rabs (x1 - x0) + Rabs (x0 - x)).
   replace (x1 - x) with (x1 - x0 + (x0 - x)); [ apply Rabs_triang | ring ].
   replace (pos del) with (del2 + Rabs (x0 - x)).
   do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l.
   apply H4.
-  unfold del2 in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x0));
+  unfold del2; simpl; rewrite <- (Rabs_Ropp (x - x0));
     rewrite Ropp_minus_distr; ring.
   apply Rplus_lt_reg_r with (Rabs (x - x0)); rewrite Rplus_0_r;
     replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del);
@@ -280,19 +278,19 @@ Proof.
   elim H3; intros.
   exists (disc x (mkposreal del2 H4)).
   intros; unfold included in H1; split.
-  unfold neighbourhood, disc in |- *.
+  unfold neighbourhood, disc.
   exists (mkposreal del2 H4).
-  unfold included in |- *; intros; assumption.
-  intros; apply H1; unfold disc in |- *; case (Req_dec y x); intro.
-  rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  unfold included; intros; assumption.
+  intros; apply H1; unfold disc; case (Req_dec y x); intro.
+  rewrite H7; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     apply (cond_pos del1).
   apply H5; split.
-  unfold D_x, no_cond in |- *; split.
+  unfold D_x, no_cond; split.
   trivial.
-  apply (sym_not_eq (A:=R)); apply H7.
+  apply (not_eq_sym (A:=R)); apply H7.
   unfold disc in H6; apply H6.
-  intros; unfold continuity_pt in |- *; unfold continue_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
+  intros; unfold continuity_pt; unfold continue_in;
+    unfold limit1_in; unfold limit_in;
       intros.
   assert (H1 := H (disc (f x) (mkposreal eps H0))).
   cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)).
@@ -301,10 +299,10 @@ Proof.
     intros del1 H7.
   exists (pos del1); split.
   apply (cond_pos del1).
-  intros; elim H8; intros; simpl in H10; unfold R_dist in H10; simpl in |- *;
-    unfold R_dist in |- *; apply (H6 _ (H7 _ H10)).
-  unfold neighbourhood, disc in |- *; exists (mkposreal eps H0);
-    unfold included in |- *; intros; assumption.
+  intros; elim H8; intros; simpl in H10; unfold R_dist in H10; simpl;
+    unfold R_dist; apply (H6 _ (H7 _ H10)).
+  unfold neighbourhood, disc; exists (mkposreal eps H0);
+    unfold included; intros; assumption.
 Qed.
 
 Definition image_rec (f:R -> R) (D:R -> Prop) (x:R) : Prop := D (f x).
@@ -314,13 +312,13 @@ Lemma continuity_P2 :
   forall (f:R -> R) (D:R -> Prop),
     continuity f -> open_set D -> open_set (image_rec f D).
 Proof.
-  intros; unfold open_set in H0; unfold open_set in |- *; intros;
+  intros; unfold open_set in H0; unfold open_set; intros;
     assert (H2 := continuity_P1 f x); elim H2; intros H3 _;
-      assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *;
+      assert (H4 := H3 (H x)); unfold neighbourhood, image_rec;
         unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1));
           elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7;
             elim H7; intros del H9; exists del; unfold included in H9;
-              unfold included in |- *; intros; apply (H8 _ (H9 _ H10)).
+              unfold included; intros; apply (H8 _ (H9 _ H10)).
 Qed.
 
 (**********)
@@ -331,9 +329,9 @@ Lemma continuity_P3 :
 Proof.
   intros; split.
   intros; apply continuity_P2; assumption.
-  intros; unfold continuity in |- *; unfold continuity_pt in |- *;
-    unfold continue_in in |- *; unfold limit1_in in |- *;
-      unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+  intros; unfold continuity; unfold continuity_pt;
+    unfold continue_in; unfold limit1_in;
+      unfold limit_in; simpl; unfold R_dist;
         intros; cut (open_set (disc (f x) (mkposreal _ H0))).
   intro; assert (H2 := H _ H1).
   unfold open_set, image_rec in H2; cut (disc (f x) (mkposreal _ H0) (f x)).
@@ -342,7 +340,7 @@ Proof.
   exists (pos del); split.
   apply (cond_pos del).
   intros; unfold included in H5; apply H5; elim H6; intros; apply H8.
-  unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+  unfold disc; unfold Rminus; rewrite Rplus_opp_r;
     rewrite Rabs_R0; apply H0.
   apply disc_P1.
 Qed.
@@ -360,23 +358,23 @@ Proof.
   cut (0 < D / 2).
   intro; exists (disc x (mkposreal _ H)).
   exists (disc y (mkposreal _ H)); split.
-  unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *;
+  unfold neighbourhood; exists (mkposreal _ H); unfold included;
     tauto.
   split.
-  unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *;
+  unfold neighbourhood; exists (mkposreal _ H); unfold included;
     tauto.
-  red in |- *; intro; elim H0; intros; unfold intersection_domain in H1;
+  red; intro; elim H0; intros; unfold intersection_domain in H1;
     elim H1; intros.
   cut (D < D).
   intro; elim (Rlt_irrefl _ H4).
-  change (Rabs (x - y) < D) in |- *;
+  change (Rabs (x - y) < D);
     apply Rle_lt_trans with (Rabs (x - x0) + Rabs (x0 - y)).
   replace (x - y) with (x - x0 + (x0 - y)); [ apply Rabs_triang | ring ].
   rewrite (double_var D); apply Rplus_lt_compat.
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2.
   apply H3.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-  unfold D in |- *; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep).
+  unfold Rdiv; apply Rmult_lt_0_compat.
+  unfold D; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep).
   apply Rinv_0_lt_compat; prove_sup0.
 Qed.
 
@@ -406,7 +404,7 @@ Lemma restriction_family :
     (exists y : R, (fun z1 z2:R => f z1 z2 /\ D z1) x y) ->
     intersection_domain (ind f) D x.
 Proof.
-  intros; elim H; intros; unfold intersection_domain in |- *; elim H0; intros;
+  intros; elim H; intros; unfold intersection_domain; elim H0; intros;
     split.
   apply (cond_fam f0); exists x0; assumption.
   assumption.
@@ -426,19 +424,19 @@ Lemma family_P1 :
   forall (f:family) (D:R -> Prop),
     family_open_set f -> family_open_set (subfamily f D).
 Proof.
-  unfold family_open_set in |- *; intros; unfold subfamily in |- *;
-    simpl in |- *; assert (H0 := classic (D x)).
+  unfold family_open_set; intros; unfold subfamily;
+    simpl; assert (H0 := classic (D x)).
   elim H0; intro.
   cut (open_set (f0 x) -> open_set (fun y:R => f0 x y /\ D x)).
   intro; apply H2; apply H.
-  unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3;
+  unfold open_set; unfold neighbourhood; intros; elim H3;
     intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1;
-      unfold included in |- *; intros; split.
+      unfold included; intros; split.
   apply (H7 _ H8).
   assumption.
   cut (open_set (fun y:R => False) -> open_set (fun y:R => f0 x y /\ D x)).
   intro; apply H2; apply open_set_P4.
-  unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3;
+  unfold open_set; unfold neighbourhood; intros; elim H3;
     intros; elim H1; assumption.
 Qed.
 
@@ -448,7 +446,7 @@ Definition bounded (D:R -> Prop) : Prop :=
 Lemma open_set_P6 :
   forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2.
 Proof.
-  unfold open_set in |- *; unfold neighbourhood in |- *; intros.
+  unfold open_set; unfold neighbourhood; intros.
   unfold eq_Dom in H0; elim H0; intros.
   assert (H4 := H _ (H3 _ H1)).
   elim H4; intros.
@@ -467,7 +465,7 @@ Proof.
   intro; assert (H3 := H1 H2); elim H3; intros D' H4;
     unfold covering_finite in H4; elim H4; intros; unfold family_finite in H6;
       unfold domain_finite in H6; elim H6; intros l H7;
-        unfold bounded in |- *; set (r := MaxRlist l).
+        unfold bounded; set (r := MaxRlist l).
   exists (- r); exists r; intros.
   unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros;
     unfold subfamily in H10; simpl in H10; elim H10; intros;
@@ -486,25 +484,25 @@ Proof.
   left; apply H11.
   assumption.
   apply (MaxRlist_P1 l x0 H16).
-  unfold intersection_domain, D in |- *; tauto.
-  unfold covering_open_set in |- *; split.
-  unfold covering in |- *; intros; simpl in |- *; exists (Rabs x + 1);
-    unfold g in |- *; pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r;
+  unfold intersection_domain, D; tauto.
+  unfold covering_open_set; split.
+  unfold covering; intros; simpl; exists (Rabs x + 1);
+    unfold g; pattern (Rabs x) at 1; rewrite <- Rplus_0_r;
       apply Rplus_lt_compat_l; apply Rlt_0_1.
-  unfold family_open_set in |- *; intro; case (Rtotal_order 0 x); intro.
+  unfold family_open_set; intro; case (Rtotal_order 0 x); intro.
   apply open_set_P6 with (disc 0 (mkposreal _ H2)).
   apply disc_P1.
-  unfold eq_Dom in |- *; unfold f0 in |- *; simpl in |- *;
-    unfold g, disc in |- *; split.
-  unfold included in |- *; intros; unfold Rminus in H3; rewrite Ropp_0 in H3;
+  unfold eq_Dom; unfold f0; simpl;
+    unfold g, disc; split.
+  unfold included; intros; unfold Rminus in H3; rewrite Ropp_0 in H3;
     rewrite Rplus_0_r in H3; apply H3.
-  unfold included in |- *; intros; unfold Rminus in |- *; rewrite Ropp_0;
+  unfold included; intros; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; apply H3.
   apply open_set_P6 with (fun x:R => False).
   apply open_set_P4.
-  unfold eq_Dom in |- *; split.
-  unfold included in |- *; intros; elim H3.
-  unfold included, f0 in |- *; simpl in |- *; unfold g in |- *; intros; elim H2;
+  unfold eq_Dom; split.
+  unfold included; intros; elim H3.
+  unfold included, f0; simpl; unfold g; intros; elim H2;
     intro;
       [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0);
         elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3))
@@ -517,10 +515,10 @@ Lemma compact_P2 : forall X:R -> Prop, compact X -> closed_set X.
 Proof.
   intros; assert (H0 := closed_set_P1 X); elim H0; clear H0; intros _ H0;
     apply H0; clear H0.
-  unfold eq_Dom in |- *; split.
+  unfold eq_Dom; split.
   apply adherence_P1.
-  unfold included in |- *; unfold adherence in |- *;
-    unfold point_adherent in |- *; intros; unfold compact in H;
+  unfold included; unfold adherence;
+    unfold point_adherent; intros; unfold compact in H;
       assert (H1 := classic (X x)); elim H1; clear H1; intro.
   assumption.
   cut (forall y:R, X y -> 0 < Rabs (y - x) / 2).
@@ -550,44 +548,44 @@ Proof.
   replace (y0 - x) with (y0 - y + (y - x)); [ apply Rabs_triang | ring ].
   rewrite (double_var (Rabs (y0 - x))); apply Rplus_lt_compat; assumption.
   apply (MinRlist_P1 (AbsList l x) (Rabs (y0 - x) / 2)); apply AbsList_P1;
-    elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain in |- *;
+    elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain;
       split; assumption.
   assert (H11 := disc_P1 x (mkposreal alp H9)); unfold open_set in H11;
     apply H11.
-  unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+  unfold disc; unfold Rminus; rewrite Rplus_opp_r;
     rewrite Rabs_R0; apply H9.
-  unfold alp in |- *; apply MinRlist_P2; intros;
+  unfold alp; apply MinRlist_P2; intros;
     assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10;
       intros z H10; elim H10; clear H10; intros; rewrite H11;
         apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10);
           unfold intersection_domain, D in H13; elim H13; clear H13;
             intros; assumption.
-  unfold covering_open_set in |- *; split.
-  unfold covering in |- *; intros; exists x0; simpl in |- *; unfold g in |- *;
+  unfold covering_open_set; split.
+  unfold covering; intros; exists x0; simpl; unfold g;
     split.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     unfold Rminus in H2; apply (H2 _ H5).
   apply H5.
-  unfold family_open_set in |- *; intro; simpl in |- *; unfold g in |- *;
+  unfold family_open_set; intro; simpl; unfold g;
     elim (classic (D x0)); intro.
   apply open_set_P6 with (disc x0 (mkposreal _ (H2 _ H5))).
   apply disc_P1.
-  unfold eq_Dom in |- *; split.
-  unfold included, disc in |- *; simpl in |- *; intros; split.
+  unfold eq_Dom; split.
+  unfold included, disc; simpl; intros; split.
   rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6.
   apply H5.
-  unfold included, disc in |- *; simpl in |- *; intros; elim H6; intros;
+  unfold included, disc; simpl; intros; elim H6; intros;
     rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr;
       apply H7.
   apply open_set_P6 with (fun z:R => False).
   apply open_set_P4.
-  unfold eq_Dom in |- *; split.
-  unfold included in |- *; intros; elim H6.
-  unfold included in |- *; intros; elim H6; intros; elim H5; assumption.
+  unfold eq_Dom; split.
+  unfold included; intros; elim H6.
+  unfold included; intros; elim H6; intros; elim H5; assumption.
   intros; elim H3; intros; unfold g in H4; elim H4; clear H4; intros _ H4;
     apply H4.
-  intros; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-  apply Rabs_pos_lt; apply Rminus_eq_contra; red in |- *; intro;
+  intros; unfold Rdiv; apply Rmult_lt_0_compat.
+  apply Rabs_pos_lt; apply Rminus_eq_contra; red; intro;
     rewrite H3 in H2; elim H1; apply H2.
   apply Rinv_0_lt_compat; prove_sup0.
 Qed.
@@ -595,29 +593,29 @@ Qed.
 (**********)
 Lemma compact_EMP : compact (fun _:R => False).
 Proof.
-  unfold compact in |- *; intros; exists (fun x:R => False);
-    unfold covering_finite in |- *; split.
-  unfold covering in |- *; intros; elim H0.
-  unfold family_finite in |- *; unfold domain_finite in |- *; exists nil; intro.
+  unfold compact; intros; exists (fun x:R => False);
+    unfold covering_finite; split.
+  unfold covering; intros; elim H0.
+  unfold family_finite; unfold domain_finite; exists nil; intro.
   split.
-  simpl in |- *; unfold intersection_domain in |- *; intros; elim H0.
+  simpl; unfold intersection_domain; intros; elim H0.
   elim H0; clear H0; intros _ H0; elim H0.
-  simpl in |- *; intro; elim H0.
+  simpl; intro; elim H0.
 Qed.
 
 Lemma compact_eqDom :
   forall X1 X2:R -> Prop, compact X1 -> X1 =_D X2 -> compact X2.
 Proof.
-  unfold compact in |- *; intros; unfold eq_Dom in H0; elim H0; clear H0;
-    unfold included in |- *; intros; assert (H3 : covering_open_set X1 f0).
-  unfold covering_open_set in |- *; unfold covering_open_set in H1; elim H1;
+  unfold compact; intros; unfold eq_Dom in H0; elim H0; clear H0;
+    unfold included; intros; assert (H3 : covering_open_set X1 f0).
+  unfold covering_open_set; unfold covering_open_set in H1; elim H1;
     clear H1; intros; split.
-  unfold covering in H1; unfold covering in |- *; intros;
+  unfold covering in H1; unfold covering; intros;
     apply (H1 _ (H0 _ H4)).
   apply H3.
-  elim (H _ H3); intros D H4; exists D; unfold covering_finite in |- *;
+  elim (H _ H3); intros D H4; exists D; unfold covering_finite;
     unfold covering_finite in H4; elim H4; intros; split.
-  unfold covering in H5; unfold covering in |- *; intros;
+  unfold covering in H5; unfold covering; intros;
     apply (H5 _ (H2 _ H7)).
   apply H6.
 Qed.
@@ -626,7 +624,7 @@ Qed.
 Lemma compact_P3 : forall a b:R, compact (fun c:R => a <= c <= b).
 Proof.
   intros; case (Rle_dec a b); intro.
-  unfold compact in |- *; intros;
+  unfold compact; intros;
     set
       (A :=
         fun x:R =>
@@ -649,92 +647,92 @@ Proof.
   rewrite H11 in H10; rewrite H11 in H8; unfold A in H9; elim H9; clear H9;
     intros; elim H12; clear H12; intros Dx H12;
       set (Db := fun x:R => Dx x \/ x = y0); exists Db;
-        unfold covering_finite in |- *; split.
-  unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12;
+        unfold covering_finite; split.
+  unfold covering; unfold covering_finite in H12; elim H12; clear H12;
     intros; unfold covering in H12; case (Rle_dec x0 x);
       intro.
   cut (a <= x0 <= x).
   intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
-    simpl in H16; simpl in |- *; unfold Db in |- *; elim H16;
+    simpl in H16; simpl; unfold Db; elim H16;
       clear H16; intros; split; [ apply H16 | left; apply H17 ].
   split.
   elim H14; intros; assumption.
   assumption.
-  exists y0; simpl in |- *; split.
-  apply H8; unfold disc in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
+  exists y0; simpl; split.
+  apply H8; unfold disc; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
     rewrite Rabs_right.
   apply Rlt_trans with (b - x).
-  unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
+  unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
     auto with real.
   elim H10; intros H15 _; apply Rplus_lt_reg_r with (x - eps);
     replace (x - eps + (b - x)) with (b - eps);
     [ replace (x - eps + eps) with x; [ apply H15 | ring ] | ring ].
   apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15.
-  unfold Db in |- *; right; reflexivity.
-  unfold family_finite in |- *; unfold domain_finite in |- *;
+  unfold Db; right; reflexivity.
+  unfold family_finite; unfold domain_finite;
     unfold covering_finite in H12; elim H12; clear H12;
       intros; unfold family_finite in H13; unfold domain_finite in H13;
         elim H13; clear H13; intros l H13; exists (cons y0 l);
           intro; split.
   intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
     clear H13; intros; case (Req_dec x0 y0); intro.
-  simpl in |- *; left; apply H16.
-  simpl in |- *; right; apply H13.
-  simpl in |- *; unfold intersection_domain in |- *; unfold Db in H14;
+  simpl; left; apply H16.
+  simpl; right; apply H13.
+  simpl; unfold intersection_domain; unfold Db in H14;
     decompose [and or] H14.
   split; assumption.
   elim H16; assumption.
-  intro; simpl in H14; elim H14; intro; simpl in |- *;
-    unfold intersection_domain in |- *.
+  intro; simpl in H14; elim H14; intro; simpl;
+    unfold intersection_domain.
   split.
   apply (cond_fam f0); rewrite H15; exists m; apply H6.
-  unfold Db in |- *; right; assumption.
-  simpl in |- *; unfold intersection_domain in |- *; elim (H13 x0).
+  unfold Db; right; assumption.
+  simpl; unfold intersection_domain; elim (H13 x0).
   intros _ H16; assert (H17 := H16 H15); simpl in H17;
     unfold intersection_domain in H17; split.
   elim H17; intros; assumption.
-  unfold Db in |- *; left; elim H17; intros; assumption.
+  unfold Db; left; elim H17; intros; assumption.
   set (m' := Rmin (m + eps / 2) b); cut (A m').
   intro; elim H3; intros; unfold is_upper_bound in H13;
     assert (H15 := H13 m' H12); cut (m < m').
   intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H15 H16)).
-  unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro.
-  pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
-    unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold m'; unfold Rmin; case (Rle_dec (m + eps / 2) b); intro.
+  pattern m at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    unfold Rdiv; apply Rmult_lt_0_compat;
       [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
   elim H4; intros.
   elim H17; intro.
   assumption.
   elim H11; assumption.
-  unfold A in |- *; split.
+  unfold A; split.
   split.
   apply Rle_trans with m.
   elim H4; intros; assumption.
-  unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro.
-  pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
-    unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold m'; unfold Rmin; case (Rle_dec (m + eps / 2) b); intro.
+  pattern m at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+    unfold Rdiv; apply Rmult_lt_0_compat;
       [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
   elim H4; intros.
   elim H13; intro.
   assumption.
   elim H11; assumption.
-  unfold m' in |- *; apply Rmin_r.
+  unfold m'; apply Rmin_r.
   unfold A in H9; elim H9; clear H9; intros; elim H12; clear H12; intros Dx H12;
     set (Db := fun x:R => Dx x \/ x = y0); exists Db;
-      unfold covering_finite in |- *; split.
-  unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12;
+      unfold covering_finite; split.
+  unfold covering; unfold covering_finite in H12; elim H12; clear H12;
     intros; unfold covering in H12; case (Rle_dec x0 x);
       intro.
   cut (a <= x0 <= x).
   intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
-    simpl in H16; simpl in |- *; unfold Db in |- *.
+    simpl in H16; simpl; unfold Db.
   elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ].
   elim H14; intros; split; assumption.
-  exists y0; simpl in |- *; split.
-  apply H8; unfold disc in |- *; unfold Rabs in |- *; case (Rcase_abs (x0 - m));
+  exists y0; simpl; split.
+  apply H8; unfold disc; unfold Rabs; case (Rcase_abs (x0 - m));
     intro.
   rewrite Ropp_minus_distr; apply Rlt_trans with (m - x).
-  unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
+  unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
     auto with real.
   apply Rplus_lt_reg_r with (x - eps);
     replace (x - eps + (m - x)) with (m - eps).
@@ -743,56 +741,56 @@ Proof.
   ring.
   ring.
   apply Rle_lt_trans with (m' - m).
-  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- m));
+  unfold Rminus; do 2 rewrite <- (Rplus_comm (- m));
     apply Rplus_le_compat_l; elim H14; intros; assumption.
   apply Rplus_lt_reg_r with m; replace (m + (m' - m)) with m'.
   apply Rle_lt_trans with (m + eps / 2).
-  unfold m' in |- *; apply Rmin_l.
+  unfold m'; apply Rmin_l.
   apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2.
   prove_sup0.
-  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+  unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
     rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r;
+  rewrite Rmult_1_l; pattern (pos eps) at 1; rewrite <- Rplus_0_r;
     rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps).
   discrR.
   ring.
-  unfold Db in |- *; right; reflexivity.
-  unfold family_finite in |- *; unfold domain_finite in |- *;
+  unfold Db; right; reflexivity.
+  unfold family_finite; unfold domain_finite;
     unfold covering_finite in H12; elim H12; clear H12;
       intros; unfold family_finite in H13; unfold domain_finite in H13;
         elim H13; clear H13; intros l H13; exists (cons y0 l);
           intro; split.
   intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
     clear H13; intros; case (Req_dec x0 y0); intro.
-  simpl in |- *; left; apply H16.
-  simpl in |- *; right; apply H13; simpl in |- *;
-    unfold intersection_domain in |- *; unfold Db in H14;
+  simpl; left; apply H16.
+  simpl; right; apply H13; simpl;
+    unfold intersection_domain; unfold Db in H14;
       decompose [and or] H14.
   split; assumption.
   elim H16; assumption.
-  intro; simpl in H14; elim H14; intro; simpl in |- *;
-    unfold intersection_domain in |- *.
+  intro; simpl in H14; elim H14; intro; simpl;
+    unfold intersection_domain.
   split.
   apply (cond_fam f0); rewrite H15; exists m; apply H6.
-  unfold Db in |- *; right; assumption.
+  unfold Db; right; assumption.
   elim (H13 x0); intros _ H16.
   assert (H17 := H16 H15).
   simpl in H17.
   unfold intersection_domain in H17.
   split.
   elim H17; intros; assumption.
-  unfold Db in |- *; left; elim H17; intros; assumption.
+  unfold Db; left; elim H17; intros; assumption.
   elim (classic (exists x : R, A x /\ m - eps < x <= m)); intro.
   assumption.
   elim H3; intros; cut (is_upper_bound A (m - eps)).
   intro; assert (H13 := H11 _ H12); cut (m - eps < m).
   intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)).
-  pattern m at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *;
+  pattern m at 2; rewrite <- Rplus_0_r; unfold Rminus;
     apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive;
       rewrite Ropp_0; apply (cond_pos eps).
   set (P := fun n:R => A n /\ m - eps < n <= m);
     assert (H12 := not_ex_all_not _ P H9); unfold P in H12;
-      unfold is_upper_bound in |- *; intros;
+      unfold is_upper_bound; intros;
         assert (H14 := not_and_or _ _ (H12 x)); elim H14;
           intro.
   elim H15; apply H13.
@@ -805,44 +803,44 @@ Proof.
   unfold is_upper_bound in H3.
   split.
   apply (H3 _ H0).
-  apply (H4 b); unfold is_upper_bound in |- *; intros; unfold A in H5; elim H5;
+  apply (H4 b); unfold is_upper_bound; intros; unfold A in H5; elim H5;
     clear H5; intros H5 _; elim H5; clear H5; intros _ H5;
       apply H5.
   exists a; apply H0.
-  unfold bound in |- *; exists b; unfold is_upper_bound in |- *; intros;
+  unfold bound; exists b; unfold is_upper_bound; intros;
     unfold A in H1; elim H1; clear H1; intros H1 _; elim H1;
       clear H1; intros _ H1; apply H1.
-  unfold A in |- *; split.
+  unfold A; split.
   split; [ right; reflexivity | apply r ].
   unfold covering_open_set in H; elim H; clear H; intros; unfold covering in H;
     cut (a <= a <= b).
   intro; elim (H _ H1); intros y0 H2; set (D' := fun x:R => x = y0); exists D';
-    unfold covering_finite in |- *; split.
-  unfold covering in |- *; simpl in |- *; intros; cut (x = a).
+    unfold covering_finite; split.
+  unfold covering; simpl; intros; cut (x = a).
   intro; exists y0; split.
   rewrite H4; apply H2.
-  unfold D' in |- *; reflexivity.
+  unfold D'; reflexivity.
   elim H3; intros; apply Rle_antisym; assumption.
-  unfold family_finite in |- *; unfold domain_finite in |- *;
+  unfold family_finite; unfold domain_finite;
     exists (cons y0 nil); intro; split.
-  simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; clear H3;
+  simpl; unfold intersection_domain; intro; elim H3; clear H3;
     intros; unfold D' in H4; left; apply H4.
-  simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; intro.
+  simpl; unfold intersection_domain; intro; elim H3; intro.
   split; [ rewrite H4; apply (cond_fam f0); exists a; apply H2 | apply H4 ].
   elim H4.
   split; [ right; reflexivity | apply r ].
   apply compact_eqDom with (fun c:R => False).
   apply compact_EMP.
-  unfold eq_Dom in |- *; split.
-  unfold included in |- *; intros; elim H.
-  unfold included in |- *; intros; elim H; clear H; intros;
+  unfold eq_Dom; split.
+  unfold included; intros; elim H.
+  unfold included; intros; elim H; clear H; intros;
     assert (H1 := Rle_trans _ _ _ H H0); elim n; apply H1.
 Qed.
 
 Lemma compact_P4 :
   forall X F:R -> Prop, compact X -> closed_set F -> included F X -> compact F.
 Proof.
-  unfold compact in |- *; intros; elim (classic (exists z : R, F z));
+  unfold compact; intros; elim (classic (exists z : R, F z));
     intro Hyp_F_NE.
   set (D := ind f0); set (g := f f0); unfold closed_set in H0.
   set (g' := fun x y:R => f0 x y \/ complementary F y /\ D x).
@@ -850,61 +848,61 @@ Proof.
   cut (forall x:R, (exists y : R, g' x y) -> D' x).
   intro; set (f' := mkfamily D' g' H3); cut (covering_open_set X f').
   intro; elim (H _ H4); intros DX H5; exists DX.
-  unfold covering_finite in |- *; unfold covering_finite in H5; elim H5;
+  unfold covering_finite; unfold covering_finite in H5; elim H5;
     clear H5; intros.
   split.
-  unfold covering in |- *; unfold covering in H5; intros.
-  elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl in |- *;
+  unfold covering; unfold covering in H5; intros.
+  elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl;
     elim H8; clear H8; intros.
   split.
   unfold g' in H8; elim H8; intro.
   apply H10.
   elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7.
   apply H9.
-  unfold family_finite in |- *; unfold domain_finite in |- *;
+  unfold family_finite; unfold domain_finite;
     unfold family_finite in H6; unfold domain_finite in H6;
       elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x);
         elim H7; clear H7; intros.
   split.
-  intro; apply H7; simpl in |- *; unfold intersection_domain in |- *;
-    simpl in H9; unfold intersection_domain in H9; unfold D' in |- *;
+  intro; apply H7; simpl; unfold intersection_domain;
+    simpl in H9; unfold intersection_domain in H9; unfold D';
       apply H9.
   intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10;
-    simpl in |- *; unfold intersection_domain in |- *;
+    simpl; unfold intersection_domain;
       unfold D' in H10; apply H10.
-  unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2;
+  unfold covering_open_set; unfold covering_open_set in H2; elim H2;
     clear H2; intros.
   split.
-  unfold covering in |- *; unfold covering in H2; intros.
+  unfold covering; unfold covering in H2; intros.
   elim (classic (F x)); intro.
-  elim (H2 _ H6); intros y0 H7; exists y0; simpl in |- *; unfold g' in |- *;
+  elim (H2 _ H6); intros y0 H7; exists y0; simpl; unfold g';
     left; assumption.
   cut (exists z : R, D z).
-  intro; elim H7; clear H7; intros x0 H7; exists x0; simpl in |- *;
-    unfold g' in |- *; right.
+  intro; elim H7; clear H7; intros x0 H7; exists x0; simpl;
+    unfold g'; right.
   split.
-  unfold complementary in |- *; apply H6.
+  unfold complementary; apply H6.
   apply H7.
   elim Hyp_F_NE; intros z0 H7.
   assert (H8 := H2 _ H7).
   elim H8; clear H8; intros t H8; exists t; apply (cond_fam f0); exists z0;
     apply H8.
-  unfold family_open_set in |- *; intro; simpl in |- *; unfold g' in |- *;
+  unfold family_open_set; intro; simpl; unfold g';
     elim (classic (D x)); intro.
   apply open_set_P6 with (union_domain (f0 x) (complementary F)).
   apply open_set_P2.
   unfold family_open_set in H4; apply H4.
   apply H0.
-  unfold eq_Dom in |- *; split.
-  unfold included, union_domain, complementary in |- *; intros.
+  unfold eq_Dom; split.
+  unfold included, union_domain, complementary; intros.
   elim H6; intro; [ left; apply H7 | right; split; assumption ].
-  unfold included, union_domain, complementary in |- *; intros.
+  unfold included, union_domain, complementary; intros.
   elim H6; intro; [ left; apply H7 | right; elim H7; intros; apply H8 ].
   apply open_set_P6 with (f0 x).
   unfold family_open_set in H4; apply H4.
-  unfold eq_Dom in |- *; split.
-  unfold included, complementary in |- *; intros; left; apply H6.
-  unfold included, complementary in |- *; intros.
+  unfold eq_Dom; split.
+  unfold included, complementary; intros; left; apply H6.
+  unfold included, complementary; intros.
   elim H6; intro.
   apply H7.
   elim H7; intros _ H8; elim H5; apply H8.
@@ -916,9 +914,9 @@ Proof.
   intro; apply (H3 f0 H2).
   apply compact_eqDom with (fun _:R => False).
   apply compact_EMP.
-  unfold eq_Dom in |- *; split.
-  unfold included in |- *; intros; elim H3.
-  assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included in |- *; intros;
+  unfold eq_Dom; split.
+  unfold included; intros; elim H3.
+  assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included; intros;
     elim (H3 x); apply H4.
 Qed.
 
@@ -949,7 +947,7 @@ Lemma continuity_compact :
   forall (f:R -> R) (X:R -> Prop),
     (forall x:R, continuity_pt f x) -> compact X -> compact (image_dir f X).
 Proof.
-  unfold compact in |- *; intros; unfold covering_open_set in H1.
+  unfold compact; intros; unfold covering_open_set in H1.
   elim H1; clear H1; intros.
   set (D := ind f1).
   set (g := fun x y:R => image_rec f0 (f1 x) y).
@@ -958,24 +956,24 @@ Proof.
   cut (covering_open_set X f').
   intro; elim (H0 f' H4); intros D' H5; exists D'.
   unfold covering_finite in H5; elim H5; clear H5; intros;
-    unfold covering_finite in |- *; split.
-  unfold covering, image_dir in |- *; simpl in |- *; unfold covering in H5;
+    unfold covering_finite; split.
+  unfold covering, image_dir; simpl; unfold covering in H5;
     intros; elim H7; intros y H8; elim H8; intros; assert (H11 := H5 _ H10);
       simpl in H11; elim H11; intros z H12; exists z; unfold g in H12;
         unfold image_rec in H12; rewrite H9; apply H12.
   unfold family_finite in H6; unfold domain_finite in H6;
-    unfold family_finite in |- *; unfold domain_finite in |- *;
+    unfold family_finite; unfold domain_finite;
       elim H6; intros l H7; exists l; intro; elim (H7 x);
         intros; split; intro.
-  apply H8; simpl in H10; simpl in |- *; apply H10.
+  apply H8; simpl in H10; simpl; apply H10.
   apply (H9 H10).
-  unfold covering_open_set in |- *; split.
-  unfold covering in |- *; intros; simpl in |- *; unfold covering in H1;
-    unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *;
+  unfold covering_open_set; split.
+  unfold covering; intros; simpl; unfold covering in H1;
+    unfold image_dir in H1; unfold g; unfold image_rec;
       apply H1.
   exists x; split; [ reflexivity | apply H4 ].
-  unfold family_open_set in |- *; unfold family_open_set in H2; intro;
-    simpl in |- *; unfold g in |- *;
+  unfold family_open_set; unfold family_open_set in H2; intro;
+    simpl; unfold g;
       cut ((fun y:R => image_rec f0 (f1 x) y) = image_rec f0 (f1 x)).
   intro; rewrite H4.
   apply (continuity_P2 f0 (f1 x) H (H2 x)).
@@ -1012,16 +1010,16 @@ Proof.
   assert (H2 : 0 < b - a).
   apply Rlt_Rminus; assumption.
   exists h; split.
-  unfold continuity in |- *; intro; case (Rtotal_order x a); intro.
-  unfold continuity_pt in |- *; unfold continue_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
-      simpl in |- *; unfold R_dist in |- *; intros; exists (a - x);
+  unfold continuity; intro; case (Rtotal_order x a); intro.
+  unfold continuity_pt; unfold continue_in;
+    unfold limit1_in; unfold limit_in;
+      simpl; unfold R_dist; intros; exists (a - x);
         split.
-  change (0 < a - x) in |- *; apply Rlt_Rminus; assumption.
-  intros; elim H5; clear H5; intros _ H5; unfold h in |- *.
+  change (0 < a - x); apply Rlt_Rminus; assumption.
+  intros; elim H5; clear H5; intros _ H5; unfold h.
   case (Rle_dec x a); intro.
   case (Rle_dec x0 a); intro.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
   elim n; left; apply Rplus_lt_reg_r with (- x);
     do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)).
   apply RRle_abs.
@@ -1032,23 +1030,23 @@ Proof.
   split; [ right; reflexivity | left; assumption ].
   assert (H6 := H0 _ H5); unfold continuity_pt in H6; unfold continue_in in H6;
     unfold limit1_in in H6; unfold limit_in in H6; simpl in H6;
-      unfold R_dist in H6; unfold continuity_pt in |- *;
-        unfold continue_in in |- *; unfold limit1_in in |- *;
-          unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+      unfold R_dist in H6; unfold continuity_pt;
+        unfold continue_in; unfold limit1_in;
+          unfold limit_in; simpl; unfold R_dist;
             intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a));
               split.
-  unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro.
+  unfold Rmin; case (Rle_dec x0 (b - a)); intro.
   elim H8; intros; assumption.
-  change (0 < b - a) in |- *; apply Rlt_Rminus; assumption.
+  change (0 < b - a); apply Rlt_Rminus; assumption.
   intros; elim H9; clear H9; intros _ H9; cut (x1 < b).
-  intro; unfold h in |- *; case (Rle_dec x a); intro.
+  intro; unfold h; case (Rle_dec x a); intro.
   case (Rle_dec x1 a); intro.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
   case (Rle_dec x1 b); intro.
   elim H8; intros; apply H12; split.
-  unfold D_x, no_cond in |- *; split.
+  unfold D_x, no_cond; split.
   trivial.
-  red in |- *; intro; elim n; right; symmetry  in |- *; assumption.
+  red; intro; elim n; right; symmetry ; assumption.
   apply Rlt_le_trans with (Rmin x0 (b - a)).
   rewrite H4 in H9; apply H9.
   apply Rmin_l.
@@ -1065,9 +1063,9 @@ Proof.
   split; left; assumption.
   assert (H7 := H0 _ H6); unfold continuity_pt in H7; unfold continue_in in H7;
     unfold limit1_in in H7; unfold limit_in in H7; simpl in H7;
-      unfold R_dist in H7; unfold continuity_pt in |- *;
-        unfold continue_in in |- *; unfold limit1_in in |- *;
-          unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+      unfold R_dist in H7; unfold continuity_pt;
+        unfold continue_in; unfold limit1_in;
+          unfold limit_in; simpl; unfold R_dist;
             intros; elim (H7 _ H8); intros; elim H9; clear H9;
               intros.
   assert (H11 : 0 < x - a).
@@ -1075,7 +1073,7 @@ Proof.
   assert (H12 : 0 < b - x).
   apply Rlt_Rminus; assumption.
   exists (Rmin x0 (Rmin (x - a) (b - x))); split.
-  unfold Rmin in |- *; case (Rle_dec (x - a) (b - x)); intro.
+  unfold Rmin; case (Rle_dec (x - a) (b - x)); intro.
   case (Rle_dec x0 (x - a)); intro.
   assumption.
   assumption.
@@ -1083,7 +1081,7 @@ Proof.
   assumption.
   assumption.
   intros; elim H13; clear H13; intros; cut (a < x1 < b).
-  intro; elim H15; clear H15; intros; unfold h in |- *; case (Rle_dec x a);
+  intro; elim H15; clear H15; intros; unfold h; case (Rle_dec x a);
     intro.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
   case (Rle_dec x b); intro.
@@ -1117,16 +1115,16 @@ Proof.
   split; [ left; assumption | right; reflexivity ].
   assert (H8 := H0 _ H7); unfold continuity_pt in H8; unfold continue_in in H8;
     unfold limit1_in in H8; unfold limit_in in H8; simpl in H8;
-      unfold R_dist in H8; unfold continuity_pt in |- *;
-        unfold continue_in in |- *; unfold limit1_in in |- *;
-          unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+      unfold R_dist in H8; unfold continuity_pt;
+        unfold continue_in; unfold limit1_in;
+          unfold limit_in; simpl; unfold R_dist;
             intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a));
               split.
-  unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro.
+  unfold Rmin; case (Rle_dec x0 (b - a)); intro.
   elim H10; intros; assumption.
-  change (0 < b - a) in |- *; apply Rlt_Rminus; assumption.
+  change (0 < b - a); apply Rlt_Rminus; assumption.
   intros; elim H11; clear H11; intros _ H11; cut (a < x1).
-  intro; unfold h in |- *; case (Rle_dec x a); intro.
+  intro; unfold h; case (Rle_dec x a); intro.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
   case (Rle_dec x1 a); intro.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H12)).
@@ -1134,15 +1132,15 @@ Proof.
   case (Rle_dec x1 b); intro.
   rewrite H6; elim H10; intros; elim r0; intro.
   apply H14; split.
-  unfold D_x, no_cond in |- *; split.
+  unfold D_x, no_cond; split.
   trivial.
-  red in |- *; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15).
+  red; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15).
   rewrite H6 in H11; apply Rlt_le_trans with (Rmin x0 (b - a)).
   apply H11.
   apply Rmin_l.
-  rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  rewrite H15; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     assumption.
-  rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  rewrite H6; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     assumption.
   elim n1; right; assumption.
   rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_r with b;
@@ -1151,18 +1149,18 @@ Proof.
   apply Rlt_le_trans with (Rmin x0 (b - a)).
   assumption.
   apply Rmin_r.
-  unfold continuity_pt in |- *; unfold continue_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
-      simpl in |- *; unfold R_dist in |- *; intros; exists (x - b);
+  unfold continuity_pt; unfold continue_in;
+    unfold limit1_in; unfold limit_in;
+      simpl; unfold R_dist; intros; exists (x - b);
         split.
-  change (0 < x - b) in |- *; apply Rlt_Rminus; assumption.
+  change (0 < x - b); apply Rlt_Rminus; assumption.
   intros; elim H8; clear H8; intros.
   assert (H10 : b < x0).
   apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x;
     apply Rle_lt_trans with (Rabs (x0 - x)).
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
   assumption.
-  unfold h in |- *; case (Rle_dec x a); intro.
+  unfold h; case (Rle_dec x a); intro.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
   case (Rle_dec x b); intro.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H6)).
@@ -1170,8 +1168,8 @@ Proof.
   elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 r))).
   case (Rle_dec x0 b); intro.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)).
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
-  intros; elim H3; intros; unfold h in |- *; case (Rle_dec c a); intro.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  intros; elim H3; intros; unfold h; case (Rle_dec c a); intro.
   elim r; intro.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)).
   rewrite H6; reflexivity.
@@ -1212,7 +1210,7 @@ Proof.
   intros; rewrite <- (Heq c H10); rewrite <- (Heq Mxx H9); intros;
     rewrite <- H8; unfold is_lub in H7; elim H7; clear H7;
       intros H7 _; unfold is_upper_bound in H7; apply H7;
-        unfold image_dir in |- *; exists c; split; [ reflexivity | apply H10 ].
+        unfold image_dir; exists c; split; [ reflexivity | apply H10 ].
   apply H9.
   elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro.
   assumption.
@@ -1227,13 +1225,13 @@ Proof.
       cut (is_upper_bound (image_dir g (fun c:R => a <= c <= b)) (M - eps)).
   intro; assert (H12 := H10 _ H11); cut (M - eps < M).
   intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H12 H13)).
-  pattern M at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *;
+  pattern M at 2; rewrite <- Rplus_0_r; unfold Rminus;
     apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0;
       rewrite Ropp_involutive; apply (cond_pos eps).
-  unfold is_upper_bound, image_dir in |- *; intros; cut (x <= M).
+  unfold is_upper_bound, image_dir; intros; cut (x <= M).
   intro; case (Rle_dec x (M - eps)); intro.
   apply r.
-  elim (H9 x); unfold intersection_domain, disc, image_dir in |- *; split.
+  elim (H9 x); unfold intersection_domain, disc, image_dir; split.
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right.
   apply Rplus_lt_reg_r with (x - eps);
     replace (x - eps + (M - x)) with (M - eps).
@@ -1251,8 +1249,8 @@ Proof.
         ~ intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y)).
   intro; elim H9; intros V H10; elim H10; clear H10; intros.
   unfold neighbourhood in H10; elim H10; intros del H12; exists del; intros;
-    red in |- *; intro; elim (H11 y).
-  unfold intersection_domain in |- *; unfold intersection_domain in H13;
+    red; intro; elim (H11 y).
+  unfold intersection_domain; unfold intersection_domain in H13;
     elim H13; clear H13; intros; split.
   apply (H12 _ H13).
   apply H14.
@@ -1270,18 +1268,18 @@ Proof.
   split.
   apply H12.
   apply (not_ex_all_not _ _ H13).
-  red in |- *; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M).
+  red; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M).
   intro; elim (closed_set_P1 (image_dir g (fun c:R => a <= c <= b)));
     intros H11 _; assert (H12 := H11 H3).
   elim H8.
   unfold eq_Dom in H12; elim H12; clear H12; intros.
   apply (H13 _ H10).
   apply H9.
-  exists (g a); unfold image_dir in |- *; exists a; split.
+  exists (g a); unfold image_dir; exists a; split.
   reflexivity.
   split; [ right; reflexivity | apply H ].
-  unfold bound in |- *; unfold bounded in H4; elim H4; clear H4; intros m H4;
-    elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound in |- *;
+  unfold bound; unfold bounded in H4; elim H4; clear H4; intros m H4;
+    elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound;
       intros; elim (H4 _ H5); intros _ H6; apply H6.
   apply prolongement_C0; assumption.
 Qed.
@@ -1329,8 +1327,8 @@ Proof.
   intros; elim H; intros; unfold f in H0; unfold adherence in H0;
     unfold point_adherent in H0;
       assert (H1 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0).
-  unfold neighbourhood, disc in |- *; exists (mkposreal _ Rlt_0_1);
-    unfold included in |- *; trivial.
+  unfold neighbourhood, disc; exists (mkposreal _ Rlt_0_1);
+    unfold included; trivial.
   elim (H0 _ H1); intros; unfold intersection_domain in H2; elim H2; intros;
     elim H4; intros; apply H6.
 Qed.
@@ -1347,17 +1345,17 @@ Lemma ValAdh_un_prop :
   forall (un:nat -> R) (x:R), ValAdh un x <-> ValAdh_un un x.
 Proof.
   intros; split; intro.
-  unfold ValAdh in H; unfold ValAdh_un in |- *;
-    unfold intersection_family in |- *; simpl in |- *;
-      intros; elim H0; intros N H1; unfold adherence in |- *;
-        unfold point_adherent in |- *; intros; elim (H V N H2);
-          intros; exists (un x0); unfold intersection_domain in |- *;
+  unfold ValAdh in H; unfold ValAdh_un;
+    unfold intersection_family; simpl;
+      intros; elim H0; intros N H1; unfold adherence;
+        unfold point_adherent; intros; elim (H V N H2);
+          intros; exists (un x0); unfold intersection_domain;
             elim H3; clear H3; intros; split.
   assumption.
   split.
   exists x0; split; [ reflexivity | rewrite H1; apply (le_INR _ _ H3) ].
   exists N; assumption.
-  unfold ValAdh in |- *; intros; unfold ValAdh_un in H;
+  unfold ValAdh; intros; unfold ValAdh_un in H;
     unfold intersection_family in H; simpl in H;
       assert
         (H1 :
@@ -1378,8 +1376,8 @@ Qed.
 Lemma adherence_P4 :
   forall F G:R -> Prop, included F G -> included (adherence F) (adherence G).
 Proof.
-  unfold adherence, included in |- *; unfold point_adherent in |- *; intros;
-    elim (H0 _ H1); unfold intersection_domain in |- *;
+  unfold adherence, included; unfold point_adherent; intros;
+    elim (H0 _ H1); unfold intersection_domain;
       intros; elim H2; clear H2; intros; exists x0; split;
         [ assumption | apply (H _ H3) ].
 Qed.
@@ -1412,36 +1410,36 @@ Proof.
   intros; elim H2; intros; unfold f' in H3; elim H3; intros; assumption.
   set (f0 := mkfamily D' f' H2).
   unfold compact in H; assert (H3 : covering_open_set X f0).
-  unfold covering_open_set in |- *; split.
-  unfold covering in |- *; intros; unfold intersection_vide_in in H1;
+  unfold covering_open_set; split.
+  unfold covering; intros; unfold intersection_vide_in in H1;
     elim (H1 x); intros; unfold intersection_family in H5;
       assert
         (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x);
         assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6);
           elim H7; intros; exists x0; elim (imply_to_and _ _ H8);
-            intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *;
+            intros; unfold f0; simpl; unfold f';
               split; [ apply H10 | apply H9 ].
-  unfold family_open_set in |- *; intro; elim (classic (D' x)); intro.
+  unfold family_open_set; intro; elim (classic (D' x)); intro.
   apply open_set_P6 with (complementary (g x)).
   unfold family_closed_set in H0; unfold closed_set in H0; apply H0.
-  unfold f0 in |- *; simpl in |- *; unfold f' in |- *; unfold eq_Dom in |- *;
+  unfold f0; simpl; unfold f'; unfold eq_Dom;
     split.
-  unfold included in |- *; intros; split; [ apply H4 | apply H3 ].
-  unfold included in |- *; intros; elim H4; intros; assumption.
+  unfold included; intros; split; [ apply H4 | apply H3 ].
+  unfold included; intros; elim H4; intros; assumption.
   apply open_set_P6 with (fun _:R => False).
   apply open_set_P4.
-  unfold eq_Dom in |- *; unfold included in |- *; split; intros;
+  unfold eq_Dom; unfold included; split; intros;
     [ elim H4
       | simpl in H4; unfold f' in H4; elim H4; intros; elim H3; assumption ].
   elim (H _ H3); intros SF H4; exists SF;
-    unfold intersection_vide_finite_in in |- *; split.
-  unfold intersection_vide_in in |- *; simpl in |- *; intros; split.
-  intros; unfold included in |- *; intros; unfold intersection_vide_in in H1;
+    unfold intersection_vide_finite_in; split.
+  unfold intersection_vide_in; simpl; intros; split.
+  intros; unfold included; intros; unfold intersection_vide_in in H1;
     elim (H1 x); intros; elim H6; intros; apply H7.
   unfold intersection_domain in H5; elim H5; intros; assumption.
   assumption.
   elim (classic (exists y : R, intersection_domain (ind g) SF y)); intro Hyp'.
-  red in |- *; intro; elim H5; intros; unfold intersection_family in H6;
+  red; intro; elim H5; intros; unfold intersection_family in H6;
     simpl in H6.
   cut (X x0).
   intro; unfold covering_finite in H4; elim H4; clear H4; intros H4 _;
@@ -1464,16 +1462,16 @@ Proof.
     cut (exists z : R, X z).
   intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5);
     intros; simpl in H6; elim Hyp'; exists x1; elim H6;
-      intros; unfold intersection_domain in |- *; split.
+      intros; unfold intersection_domain; split.
   apply (cond_fam f0); exists x0; apply H7.
   apply H8.
   apply Hyp.
   unfold covering_finite in H4; elim H4; clear H4; intros;
     unfold family_finite in H5; unfold domain_finite in H5;
-      unfold family_finite in |- *; unfold domain_finite in |- *;
+      unfold family_finite; unfold domain_finite;
         elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x);
           intros; split; intro;
-            [ apply H6; simpl in |- *; simpl in H8; apply H8 | apply (H7 H8) ].
+            [ apply H6; simpl; simpl in H8; apply H8 | apply (H7 H8) ].
 Qed.
 
 Theorem Bolzano_Weierstrass :
@@ -1494,8 +1492,8 @@ Proof.
   intros; elim H2; intros; unfold g in H3; unfold adherence in H3;
     unfold point_adherent in H3.
   assert (H4 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0).
-  unfold neighbourhood in |- *; exists (mkposreal _ Rlt_0_1);
-    unfold included in |- *; trivial.
+  unfold neighbourhood; exists (mkposreal _ Rlt_0_1);
+    unfold included; trivial.
   elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5;
     assumption.
   set (f0 := mkfamily D g H2).
@@ -1511,19 +1509,19 @@ Proof.
         unfold domain_finite in H9; elim H9; clear H9; intros l H9;
           set (r := MaxRlist l); cut (D r).
   intro; unfold D in H11; elim H11; intros; exists (un x);
-    unfold intersection_family in |- *; simpl in |- *;
-      unfold intersection_domain in |- *; intros; split.
-  unfold g in |- *; apply adherence_P1; split.
+    unfold intersection_family; simpl;
+      unfold intersection_domain; intros; split.
+  unfold g; apply adherence_P1; split.
   exists x; split;
     [ reflexivity
-      | rewrite <- H12; unfold r in |- *; apply MaxRlist_P1; elim (H9 y); intros;
-        apply H14; simpl in |- *; apply H13 ].
+      | rewrite <- H12; unfold r; apply MaxRlist_P1; elim (H9 y); intros;
+        apply H14; simpl; apply H13 ].
   elim H13; intros; assumption.
   elim H13; intros; assumption.
   elim (H9 r); intros.
   simpl in H12; unfold intersection_domain in H12; cut (In r l).
   intro; elim (H12 H13); intros; assumption.
-  unfold r in |- *; apply MaxRlist_P2;
+  unfold r; apply MaxRlist_P2;
     cut (exists z : R, intersection_domain (ind f0) SF z).
   intro; elim H13; intros; elim (H9 x); intros; simpl in H15;
     assert (H17 := H15 H14); exists x; apply H17.
@@ -1543,16 +1541,16 @@ Proof.
                 not_all_ex_not _ (fun y:R => intersection_domain D SF y -> g y x /\ SF y)
                 H18); elim H19; intros; assert (H21 := imply_to_and _ _ H20);
               elim (H17 x0); elim H21; intros; assumption.
-  unfold intersection_vide_in in |- *; intros; split.
-  intro; simpl in H6; unfold f0 in |- *; simpl in |- *; unfold g in |- *;
+  unfold intersection_vide_in; intros; split.
+  intro; simpl in H6; unfold f0; simpl; unfold g;
     apply included_trans with (adherence X).
   apply adherence_P4.
-  unfold included in |- *; intros; elim H7; intros; elim H8; intros; elim H10;
+  unfold included; intros; elim H7; intros; elim H8; intros; elim H10;
     intros; rewrite H11; apply H0.
   apply adherence_P2; apply compact_P2; assumption.
   apply H4.
-  unfold family_closed_set in |- *; unfold f0 in |- *; simpl in |- *;
-    unfold g in |- *; intro; apply adherence_P3.
+  unfold family_closed_set; unfold f0; simpl;
+    unfold g; intro; apply adherence_P3.
 Qed.
 
 (********************************************************)
@@ -1568,7 +1566,7 @@ Definition uniform_continuity (f:R -> R) (X:R -> Prop) : Prop :=
 Lemma is_lub_u :
   forall (E:R -> Prop) (x y:R), is_lub E x -> is_lub E y -> x = y.
 Proof.
-  unfold is_lub in |- *; intros; elim H; elim H0; intros; apply Rle_antisym;
+  unfold is_lub; intros; elim H; elim H0; intros; apply Rle_antisym;
     [ apply (H4 _ H1) | apply (H2 _ H3) ].
 Qed.
 
@@ -1583,7 +1581,7 @@ Proof.
   right; elim H1; intros; elim H2; intros; exists x; exists x0; intros.
   split;
     [ assumption
-      | split; [ assumption | apply (sym_not_eq (A:=R)); assumption ] ].
+      | split; [ assumption | apply (not_eq_sym (A:=R)); assumption ] ].
   left; exists x; split.
   assumption.
   intros; case (Req_dec x0 x); intro.
@@ -1599,14 +1597,14 @@ Theorem Heine :
 Proof.
   intros f0 X H0 H; elim (domain_P1 X); intro Hyp.
 (* X is empty *)
-  unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1);
+  unfold uniform_continuity; intros; exists (mkposreal _ Rlt_0_1);
     intros; elim Hyp; exists x; assumption.
   elim Hyp; clear Hyp; intro Hyp.
 (* X has only one element *)
-  unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1);
+  unfold uniform_continuity; intros; exists (mkposreal _ Rlt_0_1);
     intros; elim Hyp; clear Hyp; intros; elim H4; clear H4;
       intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2);
-        rewrite H6; rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r;
+        rewrite H6; rewrite H7; unfold Rminus; rewrite Rplus_opp_r;
           rewrite Rabs_R0; apply (cond_pos eps).
 (* X has at least two distinct elements *)
   assert
@@ -1626,9 +1624,9 @@ Proof.
   elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) r)).
   elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc;
     intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp;
-      unfold uniform_continuity in |- *; intro;
+      unfold uniform_continuity; intro;
         assert (H1 : forall t:posreal, 0 < t / 2).
-  intro; unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  intro; unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ].
   set
     (g :=
@@ -1646,8 +1644,8 @@ Proof.
     apply H3.
   set (f' := mkfamily X g H2); unfold compact in H0;
     assert (H3 : covering_open_set X f').
-  unfold covering_open_set in |- *; split.
-  unfold covering in |- *; intros; exists x; simpl in |- *; unfold g in |- *;
+  unfold covering_open_set; split.
+  unfold covering; intros; exists x; simpl; unfold g;
     split.
   assumption.
   assert (H4 := H _ H3); unfold continuity_pt in H4; unfold continue_in in H4;
@@ -1660,22 +1658,22 @@ Proof.
                 0 < zeta <= M - m /\
                 (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2));
             assert (H6 : bound E).
-  unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *;
-    unfold E in |- *; intros; elim H6; clear H6; intros H6 _;
+  unfold bound; exists (M - m); unfold is_upper_bound;
+    unfold E; intros; elim H6; clear H6; intros H6 _;
       elim H6; clear H6; intros _ H6; apply H6.
   assert (H7 :  exists x : R, E x).
-  elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros;
+  elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E; intros;
     split.
   split.
-  unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro.
+  unfold Rmin; case (Rle_dec x0 (M - m)); intro.
   apply H5.
   apply Rlt_Rminus; apply Hyp.
   apply Rmin_r.
   intros; case (Req_dec x z); intro.
-  rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     apply (H1 eps).
   apply H7; split.
-  unfold D_x, no_cond in |- *; split; [ trivial | assumption ].
+  unfold D_x, no_cond; split; [ trivial | assumption ].
   apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ].
   assert (H8 := completeness _ H6 H7); elim H8; clear H8; intros;
     cut (0 < x1 <= M - m).
@@ -1692,15 +1690,15 @@ Proof.
     unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))).
   intro; assert (H16 := H14 _ H15);
     elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)).
-  unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H13;
+  unfold is_upper_bound; intros; unfold is_upper_bound in H13;
     assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x)));
       intro.
   assumption.
   elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ].
   split.
   apply p.
-  unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
-    rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *;
+  unfold disc; unfold Rminus; rewrite Rplus_opp_r;
+    rewrite Rabs_R0; simpl; unfold Rdiv;
       apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ].
   elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _;
     unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12;
@@ -1708,13 +1706,13 @@ Proof.
   apply Rlt_le_trans with x2; [ assumption | apply (H11 _ H8) ].
   apply H12; intros; unfold E in H13; elim H13; intros; elim H14; intros;
     assumption.
-  unfold family_open_set in |- *; intro; simpl in |- *; elim (classic (X x));
+  unfold family_open_set; intro; simpl; elim (classic (X x));
     intro.
-  unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4;
+  unfold g; unfold open_set; intros; elim H4; clear H4;
     intros _ H4; elim H4; clear H4; intros; elim H4; clear H4;
-      intros; unfold neighbourhood in |- *; case (Req_dec x x0);
+      intros; unfold neighbourhood; case (Req_dec x x0);
         intro.
-  exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros;
+  exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included; intros;
     split.
   assumption.
   exists x1; split.
@@ -1723,24 +1721,24 @@ Proof.
   elim H5; intros; apply H8.
   apply H7.
   set (d := x1 / 2 - Rabs (x0 - x)); assert (H7 : 0 < d).
-  unfold d in |- *; apply Rlt_Rminus; elim H5; clear H5; intros;
+  unfold d; apply Rlt_Rminus; elim H5; clear H5; intros;
     unfold disc in H7; apply H7.
-  exists (mkposreal _ H7); unfold included in |- *; intros; split.
+  exists (mkposreal _ H7); unfold included; intros; split.
   assumption.
   exists x1; split.
   apply H4.
   elim H5; intros; split.
   assumption.
-  unfold disc in H8; simpl in H8; unfold disc in |- *; simpl in |- *;
+  unfold disc in H8; simpl in H8; unfold disc; simpl;
     unfold disc in H10; simpl in H10;
       apply Rle_lt_trans with (Rabs (x2 - x0) + Rabs (x0 - x)).
   replace (x2 - x) with (x2 - x0 + (x0 - x)); [ apply Rabs_triang | ring ].
-  replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d in |- *; ring ].
+  replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d; ring ].
   do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l;
     apply H8.
   apply open_set_P6 with (fun _:R => False).
   apply open_set_P4.
-  unfold eq_Dom in |- *; unfold included in |- *; intros; split.
+  unfold eq_Dom; unfold included; intros; split.
   intros; elim H4.
   intros; unfold g in H4; elim H4; clear H4; intros H4 _; elim H3; apply H4.
   elim (H0 _ H3); intros DF H4; unfold covering_finite in H4; elim H4; clear H4;
@@ -1778,10 +1776,10 @@ Proof.
       apply Rlt_trans with (pos_Rl l' i / 2).
   apply H21.
   elim H13; clear H13; intros; assumption.
-  unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+  unfold Rdiv; apply Rmult_lt_reg_l with 2.
   prove_sup0.
   rewrite Rmult_comm; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1 in |- *; rewrite <- Rplus_0_r;
+  rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1; rewrite <- Rplus_0_r;
     rewrite double; apply Rplus_lt_compat_l; apply H19.
   discrR.
   assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20;
@@ -1793,15 +1791,15 @@ Proof.
   rewrite (double_var (pos_Rl l' i)); apply Rplus_lt_compat.
   apply Rlt_le_trans with (D / 2).
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H12.
-  unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2));
+  unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ 2));
     apply Rmult_le_compat_l.
   left; apply Rinv_0_lt_compat; prove_sup0.
-  unfold D in |- *; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i));
+  unfold D; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i));
     intros; apply H26; exists i; split;
       [ rewrite <- H7; assumption | reflexivity ].
   assumption.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ unfold D in |- *; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros;
+  unfold Rdiv; apply Rmult_lt_0_compat;
+    [ unfold D; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros;
       elim (H10 H9); intros; elim H12; intros; rewrite H14;
         rewrite <- H7 in H13; elim (H8 x H13); intros;
           apply H15
@@ -1813,25 +1811,25 @@ Proof.
           0 < zeta <= M - m /\
           (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2));
       assert (H11 : bound E).
-  unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *;
-    unfold E in |- *; intros; elim H11; clear H11; intros H11 _;
+  unfold bound; exists (M - m); unfold is_upper_bound;
+    unfold E; intros; elim H11; clear H11; intros H11 _;
       elim H11; clear H11; intros _ H11; apply H11.
   assert (H12 :  exists x : R, E x).
   assert (H13 := H _ H9); unfold continuity_pt in H13;
     unfold continue_in in H13; unfold limit1_in in H13;
       unfold limit_in in H13; simpl in H13; unfold R_dist in H13;
         elim (H13 _ (H1 eps)); intros; elim H12; clear H12;
-          intros; exists (Rmin x0 (M - m)); unfold E in |- *;
+          intros; exists (Rmin x0 (M - m)); unfold E;
             intros; split.
   split;
-    [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro;
+    [ unfold Rmin; case (Rle_dec x0 (M - m)); intro;
       [ apply H12 | apply Rlt_Rminus; apply Hyp ]
       | apply Rmin_r ].
   intros; case (Req_dec x z); intro.
-  rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+  rewrite H16; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
     apply (H1 eps).
   apply H14; split;
-    [ unfold D_x, no_cond in |- *; split; [ trivial | assumption ]
+    [ unfold D_x, no_cond; split; [ trivial | assumption ]
       | apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ].
   assert (H13 := completeness _ H11 H12); elim H13; clear H13; intros;
     cut (0 < x0 <= M - m).
@@ -1849,14 +1847,14 @@ Proof.
     unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))).
   intro; assert (H21 := H19 _ H20);
     elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)).
-  unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H18;
+  unfold is_upper_bound; intros; unfold is_upper_bound in H18;
     assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x)));
       intro.
   assumption.
   elim (H17 x1); split.
   split; [ auto with real | assumption ].
   assumption.
-  unfold included, g in |- *; intros; elim H15; intros; elim H17; intros;
+  unfold included, g; intros; elim H15; intros; elim H17; intros;
     decompose [and] H18; cut (x0 = x2).
   intro; rewrite H20; apply H22.
   unfold E in p; eapply is_lub_u.
diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v
index 3499ea24..32c4d7d3 100644
--- a/theories/Reals/Rtrigo.v
+++ b/theories/Reals/Rtrigo.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtrigo.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
@@ -19,1785 +17,10 @@ Require Export Cos_plus.
 Require Import ZArith_base.
 Require Import Zcomplements.
 Require Import Classical_Prop.
-Local Open Scope nat_scope.
-Local Open Scope R_scope.
-
-(** sin_PI2 is the only remaining axiom **)
-Axiom sin_PI2 : sin (PI / 2) = 1.
-
-(**********)
-Lemma PI_neq0 : PI <> 0.
-Proof.
-  red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0;
-    elim (Rlt_irrefl _ H0).
-Qed.
-
-(**********)
-Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y.
-Proof.
-  intros; unfold Rminus in |- *; rewrite cos_plus.
-  rewrite <- cos_sym; rewrite sin_antisym; ring.
-Qed.
-
-(**********)
-Lemma sin2_cos2 : forall x:R, Rsqr (sin x) + Rsqr (cos x) = 1.
-Proof.
-  intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x);
-    unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0.
-Qed.
-
-Lemma cos2 : forall x:R, Rsqr (cos x) = 1 - Rsqr (sin x).
-Proof.
-  intro x; generalize (sin2_cos2 x); intro H1; rewrite <- H1;
-    unfold Rminus in |- *; rewrite <- (Rplus_comm (Rsqr (cos x)));
-      rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry  in |- *;
-        apply Rplus_0_r.
-Qed.
-
-(**********)
-Lemma cos_PI2 : cos (PI / 2) = 0.
-Proof.
-  apply Rsqr_eq_0; rewrite cos2; rewrite sin_PI2; rewrite Rsqr_1;
-    unfold Rminus in |- *; apply Rplus_opp_r.
-Qed.
-
-(**********)
-Lemma cos_PI : cos PI = -1.
-Proof.
-  replace PI with (PI / 2 + PI / 2).
-  rewrite cos_plus.
-  rewrite sin_PI2; rewrite cos_PI2.
-  ring.
-  symmetry  in |- *; apply double_var.
-Qed.
-
-Lemma sin_PI : sin PI = 0.
-Proof.
-  assert (H := sin2_cos2 PI).
-  rewrite cos_PI in H.
-  rewrite <- Rsqr_neg in H.
-  rewrite Rsqr_1 in H.
-  cut (Rsqr (sin PI) = 0).
-  intro; apply (Rsqr_eq_0 _ H0).
-  apply Rplus_eq_reg_l with 1.
-  rewrite Rplus_0_r; rewrite Rplus_comm; exact H.
-Qed.
-
-(**********)
-Lemma neg_cos : forall x:R, cos (x + PI) = - cos x.
-Proof.
-  intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring.
-Qed.
-
-(**********)
-Lemma sin_cos : forall x:R, sin x = - cos (PI / 2 + x).
-Proof.
-  intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
-Qed.
-
-(**********)
-Lemma sin_plus : forall x y:R, sin (x + y) = sin x * cos y + cos x * sin y.
-Proof.
-  intros.
-  rewrite (sin_cos (x + y)).
-  replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ].
-  rewrite (sin_cos (PI / 2 + x)).
-  replace (PI / 2 + (PI / 2 + x)) with (x + PI).
-  rewrite neg_cos.
-  replace (cos (PI / 2 + x)) with (- sin x).
-  ring.
-  rewrite sin_cos; rewrite Ropp_involutive; reflexivity.
-  pattern PI at 1 in |- *; rewrite (double_var PI); ring.
-Qed.
-
-Lemma sin_minus : forall x y:R, sin (x - y) = sin x * cos y - cos x * sin y.
-Proof.
-  intros; unfold Rminus in |- *; rewrite sin_plus.
-  rewrite <- cos_sym; rewrite sin_antisym; ring.
-Qed.
-
-(**********)
-Definition tan (x:R) : R := sin x / cos x.
-
-Lemma tan_plus :
-  forall x y:R,
-    cos x <> 0 ->
-    cos y <> 0 ->
-    cos (x + y) <> 0 ->
-    1 - tan x * tan y <> 0 ->
-    tan (x + y) = (tan x + tan y) / (1 - tan x * tan y).
-Proof.
-  intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus;
-    unfold Rdiv in |- *;
-      replace (cos x * cos y - sin x * sin y) with
-      (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))).
-  rewrite Rinv_mult_distr.
-  repeat rewrite <- Rmult_assoc;
-    replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with
-    (sin x * / cos x + sin y * / cos y).
-  reflexivity.
-  rewrite Rmult_plus_distr_r; rewrite Rinv_mult_distr.
-  repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x));
-    repeat rewrite <- Rmult_assoc.
-  repeat rewrite Rinv_r_simpl_m; [ reflexivity | assumption | assumption ].
-  assumption.
-  assumption.
-  apply prod_neq_R0; assumption.
-  assumption.
-  unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
-    apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc;
-      rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y));
-        rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc;
-          rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_l; rewrite (Rmult_comm (sin x));
-    rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc;
-      apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y));
-        rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-  apply Rmult_1_r.
-  assumption.
-  assumption.
-Qed.
-
-(*******************************************************)
-(** * Some properties of cos, sin and tan              *)
-(*******************************************************)
-
-Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x).
-Proof.
-  intro x; generalize (cos2 x); intro H1; rewrite H1.
-  unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
-    rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry  in |- *;
-      apply Ropp_involutive.
-Qed.
-
-Lemma sin_2a : forall x:R, sin (2 * x) = 2 * sin x * cos x.
-Proof.
-  intro x; rewrite double; rewrite sin_plus.
-  rewrite <- (Rmult_comm (sin x)); symmetry  in |- *; rewrite Rmult_assoc;
-    apply double.
-Qed.
-
-Lemma cos_2a : forall x:R, cos (2 * x) = cos x * cos x - sin x * sin x.
-Proof.
-  intro x; rewrite double; apply cos_plus.
-Qed.
-
-Lemma cos_2a_cos : forall x:R, cos (2 * x) = 2 * cos x * cos x - 1.
-Proof.
-  intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc;
-    rewrite cos_plus; generalize (sin2_cos2 x); rewrite double;
-      intro H1; rewrite <- H1; ring_Rsqr.
-Qed.
-
-Lemma cos_2a_sin : forall x:R, cos (2 * x) = 1 - 2 * sin x * sin x.
-Proof.
-  intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite double.
-  generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus;
-    ring_Rsqr.
-Qed.
-
-Lemma tan_2a :
-  forall x:R,
-    cos x <> 0 ->
-    cos (2 * x) <> 0 ->
-    1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x).
-Proof.
-  repeat rewrite double; intros; repeat rewrite double; rewrite double in H0;
-    apply tan_plus; assumption.
-Qed.
-
-Lemma sin_neg : forall x:R, sin (- x) = - sin x.
-Proof.
-  apply sin_antisym.
-Qed.
-
-Lemma cos_neg : forall x:R, cos (- x) = cos x.
-Proof.
-  intro; symmetry  in |- *; apply cos_sym.
-Qed.
-
-Lemma tan_0 : tan 0 = 0.
-Proof.
-  unfold tan in |- *; rewrite sin_0; rewrite cos_0.
-  unfold Rdiv in |- *; apply Rmult_0_l.
-Qed.
-
-Lemma tan_neg : forall x:R, tan (- x) = - tan x.
-Proof.
-  intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg;
-    unfold Rdiv in |- *.
-  apply Ropp_mult_distr_l_reverse.
-Qed.
-
-Lemma tan_minus :
-  forall x y:R,
-    cos x <> 0 ->
-    cos y <> 0 ->
-    cos (x - y) <> 0 ->
-    1 + tan x * tan y <> 0 ->
-    tan (x - y) = (tan x - tan y) / (1 + tan x * tan y).
-Proof.
-  intros; unfold Rminus in |- *; rewrite tan_plus.
-  rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
-    rewrite Rmult_opp_opp; reflexivity.
-  assumption.
-  rewrite cos_neg; assumption.
-  assumption.
-  rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
-    rewrite Rmult_opp_opp; assumption.
-Qed.
-
-Lemma cos_3PI2 : cos (3 * (PI / 2)) = 0.
-Proof.
-  replace (3 * (PI / 2)) with (PI + PI / 2).
-  rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring.
-  pattern PI at 1 in |- *; rewrite (double_var PI).
-  ring.
-Qed.
-
-Lemma sin_2PI : sin (2 * PI) = 0.
-Proof.
-  rewrite sin_2a; rewrite sin_PI; ring.
-Qed.
-
-Lemma cos_2PI : cos (2 * PI) = 1.
-Proof.
-  rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring.
-Qed.
-
-Lemma neg_sin : forall x:R, sin (x + PI) = - sin x.
-Proof.
-  intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring.
-Qed.
-
-Lemma sin_PI_x : forall x:R, sin (PI - x) = sin x.
-Proof.
-  intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l;
-    unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse;
-      rewrite Ropp_involutive; apply Rmult_1_l.
-Qed.
-
-Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x.
-Proof.
-  intros x k; induction  k as [| k Hreck].
-  simpl in |- *;  ring_simplify (x + 2 * 0 * PI).
-  trivial.
-
-  replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI).
-  rewrite sin_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *.
-  ring_simplify; trivial.
-  rewrite S_INR in |- *;  ring.
-Qed.
-
-Lemma cos_period : forall (x:R) (k:nat), cos (x + 2 * INR k * PI) = cos x.
-Proof.
-  intros x k; induction  k as [| k Hreck].
-  simpl in |- *;  ring_simplify (x + 2 * 0 * PI).
-  trivial.
-
-  replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI).
-  rewrite cos_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *.
-  ring_simplify; trivial.
-  rewrite S_INR in |- *;  ring.
-Qed.
-
-Lemma sin_shift : forall x:R, sin (PI / 2 - x) = cos x.
-Proof.
-  intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
-Qed.
-
-Lemma cos_shift : forall x:R, cos (PI / 2 - x) = sin x.
-Proof.
-  intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
-Qed.
-
-Lemma cos_sin : forall x:R, cos x = sin (PI / 2 + x).
-Proof.
-  intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
-Qed.
-
-Lemma PI2_RGT_0 : 0 < PI / 2.
-Proof.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ].
-Qed.
-
-Lemma SIN_bound : forall x:R, -1 <= sin x <= 1.
-Proof.
-  intro; case (Rle_dec (-1) (sin x)); intro.
-  case (Rle_dec (sin x) 1); intro.
-  split; assumption.
-  cut (1 < sin x).
-  intro;
-    generalize
-      (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1)
-        (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H)));
-      rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0;
-        generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
-          repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l;
-            rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
-              generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
-                repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x));
-                  intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
-  auto with real.
-  cut (sin x < -1).
-  intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H);
-    rewrite Ropp_involutive; clear H; intro;
-      generalize
-        (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1)
-          (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H)));
-        rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0;
-          rewrite sin2 in H0; unfold Rminus in H0;
-            generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
-              repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l;
-                rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
-                  generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
-                    repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x));
-                      intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
-  auto with real.
-Qed.
-
-Lemma COS_bound : forall x:R, -1 <= cos x <= 1.
-Proof.
-  intro; rewrite <- sin_shift; apply SIN_bound.
-Qed.
-
-Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0).
-Proof.
-  intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro;
-    rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2;
-      rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro;
-        rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3).
-Qed.
-
-Lemma cos_sin_0_var : forall x:R, cos x <> 0 \/ sin x <> 0.
-Proof.
-  intro; apply not_and_or; apply cos_sin_0.
-Qed.
-
-(*****************************************************************)
-(** * Using series definitions of cos and sin                    *)
-(*****************************************************************)
-
-Definition sin_lb (a:R) : R := sin_approx a 3.
-Definition sin_ub (a:R) : R := sin_approx a 4.
-Definition cos_lb (a:R) : R := cos_approx a 3.
-Definition cos_ub (a:R) : R := cos_approx a 4.
-
-Lemma sin_lb_gt_0 : forall a:R, 0 < a -> a <= PI / 2 -> 0 < sin_lb a.
-Proof.
-  intros.
-  unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *.
-  set (Un := fun i:nat => a ^ (2 * i + 1) / INR (fact (2 * i + 1))).
-  replace
-  (sum_f_R0
-    (fun i:nat => (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1)))) 3)
-    with (sum_f_R0 (fun i:nat => (-1) ^ i * Un i) 3);
-      [ idtac | apply sum_eq; intros; unfold Un in |- *; reflexivity ].
-  cut (forall n:nat, Un (S n) < Un n).
-  intro; simpl in |- *.
-  repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r;
-    replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ];
-    replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ];
-    replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat);
-    [ idtac | ring ];
-    replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with
-    (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ].
-  apply Rplus_lt_0_compat.
-  unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat);
-    rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat));
-      rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
-        apply H1.
-  unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat);
-    rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat));
-      rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
-        apply H1.
-  intro; unfold Un in |- *.
-  cut ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat).
-  intro; rewrite H1.
-  rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
-    apply Rmult_lt_compat_l.
-  apply pow_lt; assumption.
-  rewrite <- H1; apply Rmult_lt_reg_l with (INR (fact (2 * n + 1))).
-  apply lt_INR_0; apply neq_O_lt.
-  assert (H2 := fact_neq_0 (2 * n + 1)).
-  red in |- *; intro; elim H2; symmetry  in |- *; assumption.
-  rewrite <- Rinv_r_sym.
-  apply Rmult_lt_reg_l with (INR (fact (2 * S n + 1))).
-  apply lt_INR_0; apply neq_O_lt.
-  assert (H2 := fact_neq_0 (2 * S n + 1)).
-  red in |- *; intro; elim H2; symmetry  in |- *; assumption.
-  rewrite (Rmult_comm (INR (fact (2 * S n + 1)))); repeat rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym.
-  do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4).
-  apply Rmult_le_compat_l.
-  replace 0 with (INR 0); [ idtac | reflexivity ]; apply le_INR; apply le_O_n.
-  simpl in |- *; rewrite Rmult_1_r; replace 4 with (Rsqr 2);
-    [ idtac | ring_Rsqr ]; replace (a * a) with (Rsqr a);
-    [ idtac | reflexivity ]; apply Rsqr_incr_1.
-  apply Rle_trans with (PI / 2);
-    [ assumption
-      | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2;
-        [ prove_sup0
-          | rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m;
-            [ replace 4 with 4; [ apply PI_4 | ring ] | discrR ] ] ].
-  left; assumption.
-  left; prove_sup0.
-  rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))).
-  do 2 rewrite fact_simpl; do 2 rewrite mult_INR.
-  repeat rewrite <- Rmult_assoc.
-  rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))).
-  rewrite Rmult_assoc.
-  apply Rmult_lt_compat_l.
-  apply lt_INR_0; apply neq_O_lt.
-  assert (H2 := fact_neq_0 (2 * n + 1)).
-  red in |- *; intro; elim H2; symmetry  in |- *; assumption.
-  do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; set (x := INR n);
-    unfold INR in |- *.
-  replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6);
-  [ idtac | ring ].
-  apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l;
-    replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2);
-    [ idtac | ring ].
-  apply Rplus_le_lt_0_compat.
-  cut (0 <= x).
-  intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos;
-    assumption || left; prove_sup.
-  unfold x in |- *; replace 0 with (INR 0);
-    [ apply le_INR; apply le_O_n | reflexivity ].
-  prove_sup0.
-  ring.
-  apply INR_fact_neq_0.
-  apply INR_fact_neq_0.
-  ring.
-Qed.
-
-Lemma SIN : forall a:R, 0 <= a -> a <= PI -> sin_lb a <= sin a <= sin_ub a.
-  intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0).
-Qed.
-
-Lemma COS :
-  forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a.
-  intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0).
-Qed.
-
-(**********)
-Lemma _PI2_RLT_0 : - (PI / 2) < 0.
-Proof.
-  rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0.
-Qed.
-
-Lemma PI4_RLT_PI2 : PI / 4 < PI / 2.
-Proof.
-  unfold Rdiv in |- *; apply Rmult_lt_compat_l.
-  apply PI_RGT_0.
-  apply Rinv_lt_contravar.
-  apply Rmult_lt_0_compat; prove_sup0.
-  pattern 2 at 1 in |- *; rewrite <- Rplus_0_r.
-  replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ].
-Qed.
-
-Lemma PI2_Rlt_PI : PI / 2 < PI.
-Proof.
-  unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r.
-  apply Rmult_lt_compat_l.
-  apply PI_RGT_0.
-  pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar.
-  rewrite Rmult_1_l; prove_sup0.
-  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
-    apply Rlt_0_1.
-Qed.
-
-(***************************************************)
-(** * Increasing and decreasing of [cos] and [sin] *)
-(***************************************************)
-Theorem sin_gt_0 : forall x:R, 0 < x -> x < PI -> 0 < sin x.
-Proof.
-  intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _;
-    case (Rtotal_order x (PI / 2)); intro H2.
-  apply Rlt_le_trans with (sin_lb x).
-  apply sin_lb_gt_0; [ assumption | left; assumption ].
-  assumption.
-  elim H2; intro H3.
-  rewrite H3; rewrite sin_PI2; apply Rlt_0_1.
-  rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3);
-    intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4).
-  replace (PI + - x) with (PI - x).
-  replace (PI + - (PI / 2)) with (PI / 2).
-  intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6;
-    change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6).
-  rewrite Rplus_opp_r.
-  replace (PI + - x) with (PI - x).
-  intro H7;
-    elim
-      (SIN (PI - x) (Rlt_le 0 (PI - x) H7)
-        (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI)));
-      intros H8 _;
-        generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5));
-          intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8).
-  reflexivity.
-  pattern PI at 2 in |- *; rewrite double_var; ring.
-  reflexivity.
-Qed.
-
-Theorem cos_gt_0 : forall x:R, - (PI / 2) < x -> x < PI / 2 -> 0 < cos x.
-Proof.
-  intros; rewrite cos_sin;
-    generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H).
-  rewrite Rplus_opp_r; intro H1;
-    generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0);
-      rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2).
-Qed.
-
-Lemma sin_ge_0 : forall x:R, 0 <= x -> x <= PI -> 0 <= sin x.
-Proof.
-  intros x H1 H2; elim H1; intro H3;
-    [ elim H2; intro H4;
-      [ left; apply (sin_gt_0 x H3 H4)
-        | rewrite H4; right; symmetry  in |- *; apply sin_PI ]
-      | rewrite <- H3; right; symmetry  in |- *; apply sin_0 ].
-Qed.
-
-Lemma cos_ge_0 : forall x:R, - (PI / 2) <= x -> x <= PI / 2 -> 0 <= cos x.
-Proof.
-  intros x H1 H2; elim H1; intro H3;
-    [ elim H2; intro H4;
-      [ left; apply (cos_gt_0 x H3 H4)
-        | rewrite H4; right; symmetry  in |- *; apply cos_PI2 ]
-      | rewrite <- H3; rewrite cos_neg; right; symmetry  in |- *; apply cos_PI2 ].
-Qed.
-
-Lemma sin_le_0 : forall x:R, PI <= x -> x <= 2 * PI -> sin x <= 0.
-Proof.
-  intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
-    rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar;
-      rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI);
-        [ rewrite (sin_period (x - PI) 1); apply sin_ge_0;
-          [ replace (x - PI) with (x + - PI);
-            [ rewrite Rplus_comm; replace 0 with (- PI + PI);
-              [ apply Rplus_le_compat_l; assumption | ring ]
-              | ring ]
-            | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
-              [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
-                [ apply Rplus_le_compat_l; assumption | ring ]
-                | ring ] ]
-          | unfold INR in |- *; ring ].
-Qed.
-
-Lemma cos_le_0 : forall x:R, PI / 2 <= x -> x <= 3 * (PI / 2) -> cos x <= 0.
-Proof.
-  intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
-    rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar;
-      rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI).
-  rewrite cos_period; apply cos_ge_0.
-  replace (- (PI / 2)) with (- PI + PI / 2).
-  unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l;
-    assumption.
-  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
-    ring.
-  unfold Rminus in |- *; rewrite Rplus_comm;
-    replace (PI / 2) with (- PI + 3 * (PI / 2)).
-  apply Rplus_le_compat_l; assumption.
-  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
-    ring.
-  unfold INR in |- *; ring.
-Qed.
-
-Lemma sin_lt_0 : forall x:R, PI < x -> x < 2 * PI -> sin x < 0.
-Proof.
-  intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x));
-    apply Ropp_lt_gt_contravar; rewrite <- neg_sin;
-      replace (x + PI) with (x - PI + 2 * INR 1 * PI);
-      [ rewrite (sin_period (x - PI) 1); apply sin_gt_0;
-        [ replace (x - PI) with (x + - PI);
-          [ rewrite Rplus_comm; replace 0 with (- PI + PI);
-            [ apply Rplus_lt_compat_l; assumption | ring ]
-            | ring ]
-          | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
-            [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
-              [ apply Rplus_lt_compat_l; assumption | ring ]
-              | ring ] ]
-        | unfold INR in |- *; ring ].
-Qed.
-
-Lemma sin_lt_0_var : forall x:R, - PI < x -> x < 0 -> sin x < 0.
-Proof.
-  intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H);
-    replace (2 * PI + - PI) with PI;
-    [ intro H1; rewrite Rplus_comm in H1;
-      generalize (Rplus_lt_compat_l (2 * PI) x 0 H0);
-        intro H2; rewrite (Rplus_comm (2 * PI)) in H2;
-          rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2;
-            rewrite <- (sin_period x 1); unfold INR in |- *;
-              replace (2 * 1 * PI) with (2 * PI);
-              [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ]
-      | ring ].
-Qed.
-
-Lemma cos_lt_0 : forall x:R, PI / 2 < x -> x < 3 * (PI / 2) -> cos x < 0.
-Proof.
-  intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x));
-    apply Ropp_lt_gt_contravar; rewrite <- neg_cos;
-      replace (x + PI) with (x - PI + 2 * INR 1 * PI).
-  rewrite cos_period; apply cos_gt_0.
-  replace (- (PI / 2)) with (- PI + PI / 2).
-  unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l;
-    assumption.
-  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
-    ring.
-  unfold Rminus in |- *; rewrite Rplus_comm;
-    replace (PI / 2) with (- PI + 3 * (PI / 2)).
-  apply Rplus_lt_compat_l; assumption.
-  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
-    ring.
-  unfold INR in |- *; ring.
-Qed.
-
-Lemma tan_gt_0 : forall x:R, 0 < x -> x < PI / 2 -> 0 < tan x.
-Proof.
-  intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0;
-    generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros;
-      generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5;
-        generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI);
-          intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-  apply sin_gt_0; assumption.
-  apply Rinv_0_lt_compat; apply cos_gt_0; assumption.
-Qed.
-
-Lemma tan_lt_0 : forall x:R, - (PI / 2) < x -> x < 0 -> tan x < 0.
-Proof.
-  intros x H1 H2; unfold tan in |- *;
-    generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0));
-      intro H3; rewrite <- Ropp_0;
-        replace (sin x / cos x) with (- (- sin x / cos x)).
-  rewrite <- sin_neg; apply Ropp_gt_lt_contravar;
-    change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *;
-      apply Rmult_lt_0_compat.
-  apply sin_gt_0.
-  rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption.
-  apply Rlt_trans with (PI / 2).
-  rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption.
-  apply PI2_Rlt_PI.
-  apply Rinv_0_lt_compat; assumption.
-  unfold Rdiv in |- *; ring.
-Qed.
-
-Lemma cos_ge_0_3PI2 :
-  forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x.
-Proof.
-  intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1);
-    unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x).
-  generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1;
-    generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1;
-      intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1).
-  rewrite Rplus_opp_r.
-  intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3;
-    generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3;
-      intro H3;
-        generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3).
-  replace (2 * PI + - (3 * (PI / 2))) with (PI / 2).
-  intro H4;
-    apply
-      (cos_ge_0 (2 * PI - x)
-        (Rlt_le (- (PI / 2)) (2 * PI - x)
-          (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4).
-  rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring.
-  ring.
-Qed.
-
-Lemma form1 :
-  forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2).
-Proof.
-  intros p q; pattern p at 1 in |- *;
-    replace p with ((p - q) / 2 + (p + q) / 2).
-  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
-  rewrite cos_plus; rewrite cos_minus; ring.
-  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-Qed.
-
-Lemma form2 :
-  forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2).
-Proof.
-  intros p q; pattern p at 1 in |- *;
-    replace p with ((p - q) / 2 + (p + q) / 2).
-  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
-  rewrite cos_plus; rewrite cos_minus; ring.
-  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-Qed.
-
-Lemma form3 :
-  forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2).
-Proof.
-  intros p q; pattern p at 1 in |- *;
-    replace p with ((p - q) / 2 + (p + q) / 2).
-  pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
-  rewrite sin_plus; rewrite sin_minus; ring.
-  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-Qed.
-
-Lemma form4 :
-  forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2).
-Proof.
-  intros p q; pattern p at 1 in |- *;
-    replace p with ((p - q) / 2 + (p + q) / 2).
-  pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
-  rewrite sin_plus; rewrite sin_minus; ring.
-  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-
-Qed.
-
-Lemma sin_increasing_0 :
-  forall x y:R,
-    - (PI / 2) <= x ->
-    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y.
-Proof.
-  intros; cut (sin ((x - y) / 2) < 0).
-  intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5.
-  assert (Hyp : 0 < 2).
-  prove_sup0.
-  generalize (Rmult_lt_compat_l 2 ((x - y) / 2) 0 Hyp H5).
-  unfold Rdiv in |- *.
-  rewrite <- Rmult_assoc.
-  rewrite Rinv_r_simpl_m.
-  rewrite Rmult_0_r.
-  clear H5; intro H5; apply Rminus_lt; assumption.
-  discrR.
-  elim H5; intro H6.
-  rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4).
-  change (0 < (x - y) / 2) in H6;
-    generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1).
-  rewrite Ropp_involutive.
-  intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7;
-    generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7).
-  rewrite <- double_var.
-  intro H8.
-  assert (Hyp : 0 < 2).
-  prove_sup0.
-  generalize
-    (Rmult_le_compat_l (/ 2) (x - y) PI
-      (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8).
-  repeat rewrite (Rmult_comm (/ 2)).
-  intro H9;
-    generalize
-      (sin_gt_0 ((x - y) / 2) H6
-        (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI));
-      intro H10;
-        elim
-          (Rlt_irrefl (sin ((x - y) / 2))
-            (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)).
-  generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3;
-    rewrite form4 in H3;
-      generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2).
-  rewrite <- double_var.
-  assert (Hyp : 0 < 2).
-  prove_sup0.
-  intro H4;
-    generalize
-      (Rmult_le_compat_l (/ 2) (x + y) PI
-        (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4).
-  repeat rewrite (Rmult_comm (/ 2)).
-  clear H4; intro H4;
-    generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1);
-      replace (- (PI / 2) + - (PI / 2)) with (- PI).
-  intro H5;
-    generalize
-      (Rmult_le_compat_l (/ 2) (- PI) (x + y)
-        (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5).
-  replace (/ 2 * (x + y)) with ((x + y) / 2).
-  replace (/ 2 * - PI) with (- (PI / 2)).
-  clear H5; intro H5; elim H4; intro H40.
-  elim H5; intro H50.
-  generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6;
-    generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6).
-  rewrite Rmult_0_r.
-  clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7.
-  assumption.
-  generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7;
-    generalize
-      (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2))
-        (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8;
-      generalize
-        (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3);
-        intro H9; elim (Rlt_irrefl 0 H9).
-  rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3;
-    rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3;
-      elim (Rlt_irrefl 0 H3).
-  unfold Rdiv in H3.
-  rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50;
-    rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3;
-      elim (Rlt_irrefl 0 H3).
-  unfold Rdiv in |- *.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  apply Rmult_comm.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  pattern PI at 1 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  reflexivity.
-Qed.
-
-Lemma sin_increasing_1 :
-  forall x y:R,
-    - (PI / 2) <= x ->
-    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y.
-Proof.
-  intros; generalize (Rplus_lt_compat_l x x y H3); intro H4;
-    generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H);
-      replace (- (PI / 2) + - (PI / 2)) with (- PI).
-  assert (Hyp : 0 < 2).
-  prove_sup0.
-  intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6;
-    generalize
-      (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6);
-      replace (/ 2 * - PI) with (- (PI / 2)).
-  replace (/ 2 * (x + y)) with ((x + y) / 2).
-  clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5;
-    rewrite Rplus_comm in H5;
-      generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2).
-  rewrite <- double_var.
-  intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7;
-    generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7);
-      replace (/ 2 * PI) with (PI / 2).
-  replace (/ 2 * (x + y)) with ((x + y) / 2).
-  clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1);
-    rewrite Ropp_involutive; clear H1; intro H1;
-      generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1;
-        generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2;
-          intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2);
-            clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3);
-              replace (- y + x) with (x - y).
-  rewrite Rplus_opp_l.
-  intro H6;
-    generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6);
-      rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2).
-  clear H6; intro H6;
-    generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2);
-      replace (- (PI / 2) + - (PI / 2)) with (- PI).
-  replace (x + - y) with (x - y).
-  intro H7;
-    generalize
-      (Rmult_le_compat_l (/ 2) (- PI) (x - y)
-        (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7);
-      replace (/ 2 * - PI) with (- (PI / 2)).
-  replace (/ 2 * (x - y)) with ((x - y) / 2).
-  clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4;
-    generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8;
-      generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8);
-        clear H8; intro H8; cut (- PI < - (PI / 2)).
-  intro H9;
-    generalize
-      (sin_lt_0_var ((x - y) / 2)
-        (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6);
-      intro H10;
-        generalize
-          (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 (
-            2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11;
-          rewrite Rmult_comm; assumption.
-  apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm.
-  reflexivity.
-  pattern PI at 1 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  reflexivity.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rminus in |- *; apply Rplus_comm.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rdiv in |- *; apply Rmult_comm.
-  unfold Rdiv in |- *.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  apply Rmult_comm.
-  pattern PI at 1 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  reflexivity.
-Qed.
-
-Lemma sin_decreasing_0 :
-  forall x y:R,
-    x <= 3 * (PI / 2) ->
-    PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x.
-Proof.
-  intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3;
-    generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3);
-      repeat rewrite <- sin_neg;
-        generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
-          generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
-            generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
-              generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
-                replace (- PI + x) with (x - PI).
-  replace (- PI + PI / 2) with (- (PI / 2)).
-  replace (- PI + y) with (y - PI).
-  replace (- PI + 3 * (PI / 2)) with (PI / 2).
-  replace (- (PI - x)) with (x - PI).
-  replace (- (PI - y)) with (y - PI).
-  intros; change (sin (y - PI) < sin (x - PI)) in H8;
-    apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm;
-      replace (y + - PI) with (y - PI).
-  rewrite Rplus_comm; replace (x + - PI) with (x - PI).
-  apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8).
-  reflexivity.
-  reflexivity.
-  unfold Rminus in |- *; rewrite Ropp_plus_distr.
-  rewrite Ropp_involutive.
-  apply Rplus_comm.
-  unfold Rminus in |- *; rewrite Ropp_plus_distr.
-  rewrite Ropp_involutive.
-  apply Rplus_comm.
-  pattern PI at 2 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  ring.
-  unfold Rminus in |- *; apply Rplus_comm.
-  pattern PI at 2 in |- *; rewrite double_var.
-  rewrite Ropp_plus_distr.
-  ring.
-  unfold Rminus in |- *; apply Rplus_comm.
-Qed.
-
-Lemma sin_decreasing_1 :
-  forall x y:R,
-    x <= 3 * (PI / 2) ->
-    PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x.
-Proof.
-  intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y);
-    generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
-      generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
-        generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
-          generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
-            generalize (Rplus_lt_compat_l (- PI) x y H3);
-              replace (- PI + PI / 2) with (- (PI / 2)).
-  replace (- PI + y) with (y - PI).
-  replace (- PI + 3 * (PI / 2)) with (PI / 2).
-  replace (- PI + x) with (x - PI).
-  intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg;
-    replace (- (PI - x)) with (x - PI).
-  replace (- (PI - y)) with (y - PI).
-  apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4).
-  unfold Rminus in |- *; rewrite Ropp_plus_distr.
-  rewrite Ropp_involutive.
-  apply Rplus_comm.
-  unfold Rminus in |- *; rewrite Ropp_plus_distr.
-  rewrite Ropp_involutive.
-  apply Rplus_comm.
-  unfold Rminus in |- *; apply Rplus_comm.
-  pattern PI at 2 in |- *; rewrite double_var; ring.
-  unfold Rminus in |- *; apply Rplus_comm.
-  pattern PI at 2 in |- *; rewrite double_var; ring.
-Qed.
-
-Lemma cos_increasing_0 :
-  forall x y:R,
-    PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y.
-Proof.
-  intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y);
-    rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
-      unfold INR in |- *;
-        replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
-  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
-  repeat rewrite cos_shift; intro H5;
-    generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
-      generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
-        generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
-          generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4).
-  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
-  replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
-  clear H1 H2 H3 H4; intros H1 H2 H3 H4;
-    apply Rplus_lt_reg_r with (-3 * (PI / 2));
-      replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
-  apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5).
-  unfold Rminus in |- *.
-  rewrite Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  unfold Rminus in |- *.
-  rewrite Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  pattern PI at 3 in |- *; rewrite double_var.
-  ring.
-  rewrite double; pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  unfold Rminus in |- *.
-  rewrite Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  unfold Rminus in |- *.
-  rewrite Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  rewrite Rmult_1_r.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  rewrite Rmult_1_r.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-Qed.
-
-Lemma cos_increasing_1 :
-  forall x y:R,
-    PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y.
-Proof.
-  intros x y H1 H2 H3 H4 H5;
-    generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
-      generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
-        generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
-          generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4);
-            generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5);
-              rewrite <- (cos_neg x); rewrite <- (cos_neg y);
-                rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
-                  unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
-  replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
-  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
-  clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5;
-    replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
-  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
-  repeat rewrite cos_shift;
-    apply
-      (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1).
-  rewrite Rmult_1_r.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  rewrite Rmult_1_r.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-  ring.
-  pattern PI at 3 in |- *; rewrite double_var; ring.
-  unfold Rminus in |- *.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-  unfold Rminus in |- *.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  apply Rplus_comm.
-Qed.
-
-Lemma cos_decreasing_0 :
-  forall x y:R,
-    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x.
-Proof.
-  intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3);
-    repeat rewrite <- neg_cos; intro H4;
-      change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4;
-        rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H);
-          generalize (Rplus_le_compat_l PI x PI H0);
-            generalize (Rplus_le_compat_l PI 0 y H1);
-              generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
-  rewrite <- double.
-  clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI;
-    apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4).
-Qed.
-
-Lemma cos_decreasing_1 :
-  forall x y:R,
-    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x.
-Proof.
-  intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos;
-    rewrite (Rplus_comm x); rewrite (Rplus_comm y);
-      generalize (Rplus_le_compat_l PI 0 x H);
-        generalize (Rplus_le_compat_l PI x PI H0);
-          generalize (Rplus_le_compat_l PI 0 y H1);
-            generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
-  rewrite <- double.
-  generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros;
-    apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H).
-Qed.
-
-Lemma tan_diff :
-  forall x y:R,
-    cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y).
-Proof.
-  intros; unfold tan in |- *; rewrite sin_minus.
-  unfold Rdiv in |- *.
-  unfold Rminus in |- *.
-  rewrite Rmult_plus_distr_r.
-  rewrite Rinv_mult_distr.
-  repeat rewrite (Rmult_comm (sin x)).
-  repeat rewrite Rmult_assoc.
-  rewrite (Rmult_comm (cos y)).
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  rewrite (Rmult_comm (sin x)).
-  apply Rplus_eq_compat_l.
-  rewrite <- Ropp_mult_distr_l_reverse.
-  rewrite <- Ropp_mult_distr_r_reverse.
-  rewrite (Rmult_comm (/ cos x)).
-  repeat rewrite Rmult_assoc.
-  rewrite (Rmult_comm (cos x)).
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_r.
-  reflexivity.
-  assumption.
-  assumption.
-  assumption.
-  assumption.
-Qed.
-
-Lemma tan_increasing_0 :
-  forall x y:R,
-    - (PI / 4) <= x ->
-    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y.
-Proof.
-  intros; generalize PI4_RLT_PI2; intro H4;
-    generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4);
-      intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
-        generalize
-          (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
-            (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
-          generalize
-            (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
-              (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
-            generalize
-              (sym_not_eq
-                (Rlt_not_eq 0 (cos x)
-                  (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
-                    (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4))));
-              intro H6;
-                generalize
-                  (sym_not_eq
-                    (Rlt_not_eq 0 (cos y)
-                      (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
-                        (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4))));
-                  intro H7; generalize (tan_diff x y H6 H7); intro H8;
-                    generalize (Rlt_minus (tan x) (tan y) H3); clear H3;
-                      intro H3; rewrite H8 in H3; cut (sin (x - y) < 0).
-  intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1);
-    rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10);
-      clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
-        intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11);
-          clear H11; intro H11;
-            generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
-              generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10);
-                replace (x + - y) with (x - y).
-  replace (PI / 4 + PI / 4) with (PI / 2).
-  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
-  intros; case (Rtotal_order 0 (x - y)); intro H14.
-  generalize
-    (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI));
-    intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)).
-  elim H14; intro H15.
-  rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9).
-  apply Rminus_lt; assumption.
-  pattern PI at 1 in |- *; rewrite double_var.
-  unfold Rdiv in |- *.
-  rewrite Rmult_plus_distr_r.
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_mult_distr.
-  rewrite Ropp_plus_distr.
-  replace 4 with 4.
-  reflexivity.
-  ring.
-  discrR.
-  discrR.
-  pattern PI at 1 in |- *; rewrite double_var.
-  unfold Rdiv in |- *.
-  rewrite Rmult_plus_distr_r.
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_mult_distr.
-  replace 4 with 4.
-  reflexivity.
-  ring.
-  discrR.
-  discrR.
-  reflexivity.
-  case (Rcase_abs (sin (x - y))); intro H9.
-  assumption.
-  generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9;
-    generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
-      generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
-        generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
-          replace (/ cos x * / cos y) with (/ (cos x * cos y)).
-  intro H12;
-    generalize
-      (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9
-        (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13;
-      elim
-        (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)).
-  rewrite Rinv_mult_distr.
-  reflexivity.
-  assumption.
-  assumption.
-Qed.
-
-Lemma tan_increasing_1 :
-  forall x y:R,
-    - (PI / 4) <= x ->
-    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y.
-Proof.
-  intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4;
-    generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4);
-      intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
-        generalize
-          (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
-            (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
-          generalize
-            (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
-              (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
-            generalize
-              (sym_not_eq
-                (Rlt_not_eq 0 (cos x)
-                  (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
-                    (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4))));
-              intro H6;
-                generalize
-                  (sym_not_eq
-                    (Rlt_not_eq 0 (cos y)
-                      (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
-                        (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4))));
-                  intro H7; rewrite (tan_diff x y H6 H7);
-                    generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
-                      generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
-                        generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
-                          replace (/ cos x * / cos y) with (/ (cos x * cos y)).
-  clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
-    intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11);
-      clear H11; intro H11;
-        generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
-          replace (x + - y) with (x - y).
-  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
-  clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3;
-    clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI;
-      intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1);
-        clear H1; intro H1;
-          generalize
-            (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3);
-            intro H2;
-              generalize
-                (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8);
-                rewrite Rmult_0_r; intro H4; assumption.
-  pattern PI at 1 in |- *; rewrite double_var.
-  unfold Rdiv in |- *.
-  rewrite Rmult_plus_distr_r.
-  repeat rewrite Rmult_assoc.
-  rewrite <- Rinv_mult_distr.
-  replace 4 with 4.
-  rewrite Ropp_plus_distr.
-  reflexivity.
-  ring.
-  discrR.
-  discrR.
-  reflexivity.
-  apply Rinv_mult_distr; assumption.
-Qed.
-
-Lemma sin_incr_0 :
-  forall x y:R,
-    - (PI / 2) <= x ->
-    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y.
-Proof.
-  intros; case (Rtotal_order (sin x) (sin y)); intro H4;
-    [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order x y); intro H6;
-          [ left; assumption
-            | elim H6; intro H7;
-              [ right; assumption
-                | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8;
-                  rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ]
-          | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
-Qed.
-
-Lemma sin_incr_1 :
-  forall x y:R,
-    - (PI / 2) <= x ->
-    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y.
-Proof.
-  intros; case (Rtotal_order x y); intro H4;
-    [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order (sin x) (sin y)); intro H6;
-          [ left; assumption
-            | elim H6; intro H7;
-              [ right; assumption
-                | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8;
-                  rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
-          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
-Qed.
-
-Lemma sin_decr_0 :
-  forall x y:R,
-    x <= 3 * (PI / 2) ->
-    PI / 2 <= x ->
-    y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x.
-Proof.
-  intros; case (Rtotal_order (sin x) (sin y)); intro H4;
-    [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order x y); intro H6;
-          [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8;
-            rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8)
-            | elim H6; intro H7;
-              [ right; symmetry  in |- *; assumption | left; assumption ] ]
-          | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
-Qed.
-
-Lemma sin_decr_1 :
-  forall x y:R,
-    x <= 3 * (PI / 2) ->
-    PI / 2 <= x ->
-    y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x.
-Proof.
-  intros; case (Rtotal_order x y); intro H4;
-    [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order (sin x) (sin y)); intro H6;
-          [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8;
-            rewrite H5 in H8; elim (Rlt_irrefl y H8)
-            | elim H6; intro H7;
-              [ right; symmetry  in |- *; assumption | left; assumption ] ]
-          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
-Qed.
-
-Lemma cos_incr_0 :
-  forall x y:R,
-    PI <= x ->
-    x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y.
-Proof.
-  intros; case (Rtotal_order (cos x) (cos y)); intro H4;
-    [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order x y); intro H6;
-          [ left; assumption
-            | elim H6; intro H7;
-              [ right; assumption
-                | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8;
-                  rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ]
-          | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
-Qed.
-
-Lemma cos_incr_1 :
-  forall x y:R,
-    PI <= x ->
-    x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y.
-Proof.
-  intros; case (Rtotal_order x y); intro H4;
-    [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order (cos x) (cos y)); intro H6;
-          [ left; assumption
-            | elim H6; intro H7;
-              [ right; assumption
-                | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8;
-                  rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
-          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
-Qed.
-
-Lemma cos_decr_0 :
-  forall x y:R,
-    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x.
-Proof.
-  intros; case (Rtotal_order (cos x) (cos y)); intro H4;
-    [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order x y); intro H6;
-          [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8;
-            rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8)
-            | elim H6; intro H7;
-              [ right; symmetry  in |- *; assumption | left; assumption ] ]
-          | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
-Qed.
-
-Lemma cos_decr_1 :
-  forall x y:R,
-    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x.
-Proof.
-  intros; case (Rtotal_order x y); intro H4;
-    [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order (cos x) (cos y)); intro H6;
-          [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8;
-            rewrite H5 in H8; elim (Rlt_irrefl y H8)
-            | elim H6; intro H7;
-              [ right; symmetry  in |- *; assumption | left; assumption ] ]
-          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
-Qed.
-
-Lemma tan_incr_0 :
-  forall x y:R,
-    - (PI / 4) <= x ->
-    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y.
-Proof.
-  intros; case (Rtotal_order (tan x) (tan y)); intro H4;
-    [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order x y); intro H6;
-          [ left; assumption
-            | elim H6; intro H7;
-              [ right; assumption
-                | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8;
-                  rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ]
-          | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ].
-Qed.
-
-Lemma tan_incr_1 :
-  forall x y:R,
-    - (PI / 4) <= x ->
-    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y.
-Proof.
-  intros; case (Rtotal_order x y); intro H4;
-    [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4)
-      | elim H4; intro H5;
-        [ case (Rtotal_order (tan x) (tan y)); intro H6;
-          [ left; assumption
-            | elim H6; intro H7;
-              [ right; assumption
-                | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8;
-                  rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
-          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
-Qed.
-
-(**********)
-Lemma sin_eq_0_1 : forall x:R, (exists k : Z, x = IZR k * PI) -> sin x = 0.
-Proof.
-  intros.
-  elim H; intros.
-  apply (Zcase_sign x0).
-  intro.
-  rewrite H1 in H0.
-  simpl in H0.
-  rewrite H0; rewrite Rmult_0_l; apply sin_0.
-  intro.
-  cut (0 <= x0)%Z.
-  intro.
-  elim (IZN x0 H2); intros.
-  rewrite H3 in H0.
-  rewrite <- INR_IZR_INZ in H0.
-  rewrite H0.
-  elim (even_odd_cor x1); intros.
-  elim H4; intro.
-  rewrite H5.
-  rewrite mult_INR.
-  simpl in |- *.
-  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
-  rewrite sin_period.
-  apply sin_0.
-  rewrite H5.
-  rewrite S_INR; rewrite mult_INR.
-  simpl in |- *.
-  rewrite Rmult_plus_distr_r.
-  rewrite Rmult_1_l; rewrite sin_plus.
-  rewrite sin_PI.
-  rewrite Rmult_0_r.
-  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
-  rewrite sin_period.
-  rewrite sin_0; ring.
-  apply le_IZR.
-  left; apply IZR_lt.
-  assert (H2 := Zorder.Zgt_iff_lt).
-  elim (H2 x0 0%Z); intros.
-  apply H3; assumption.
-  intro.
-  rewrite H0.
-  replace (sin (IZR x0 * PI)) with (- sin (- IZR x0 * PI)).
-  cut (0 <= - x0)%Z.
-  intro.
-  rewrite <- Ropp_Ropp_IZR.
-  elim (IZN (- x0) H2); intros.
-  rewrite H3.
-  rewrite <- INR_IZR_INZ.
-  elim (even_odd_cor x1); intros.
-  elim H4; intro.
-  rewrite H5.
-  rewrite mult_INR.
-  simpl in |- *.
-  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
-  rewrite sin_period.
-  rewrite sin_0; ring.
-  rewrite H5.
-  rewrite S_INR; rewrite mult_INR.
-  simpl in |- *.
-  rewrite Rmult_plus_distr_r.
-  rewrite Rmult_1_l; rewrite sin_plus.
-  rewrite sin_PI.
-  rewrite Rmult_0_r.
-  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
-  rewrite sin_period.
-  rewrite sin_0; ring.
-  apply le_IZR.
-  apply Rplus_le_reg_l with (IZR x0).
-  rewrite Rplus_0_r.
-  rewrite Ropp_Ropp_IZR.
-  rewrite Rplus_opp_r.
-  left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ].
-  assumption.
-  rewrite <- sin_neg.
-  rewrite Ropp_mult_distr_l_reverse.
-  rewrite Ropp_involutive.
-  reflexivity.
-Qed.
-
-Lemma sin_eq_0_0 : forall x:R, sin x = 0 ->  exists k : Z, x = IZR k * PI.
-Proof.
-  intros.
-  assert (H0 := euclidian_division x PI PI_neq0).
-  elim H0; intros q H1.
-  elim H1; intros r H2.
-  exists q.
-  cut (r = 0).
-  intro.
-  elim H2; intros H4 _; rewrite H4; rewrite H3.
-  apply Rplus_0_r.
-  elim H2; intros.
-  rewrite H3 in H.
-  rewrite sin_plus in H.
-  cut (sin (IZR q * PI) = 0).
-  intro.
-  rewrite H5 in H.
-  rewrite Rmult_0_l in H.
-  rewrite Rplus_0_l in H.
-  assert (H6 := Rmult_integral _ _ H).
-  elim H6; intro.
-  assert (H8 := sin2_cos2 (IZR q * PI)).
-  rewrite H5 in H8; rewrite H7 in H8.
-  rewrite Rsqr_0 in H8.
-  rewrite Rplus_0_r in H8.
-  elim R1_neq_R0; symmetry  in |- *; assumption.
-  cut (r = 0 \/ 0 < r < PI).
-  intro; elim H8; intro.
-  assumption.
-  elim H9; intros.
-  assert (H12 := sin_gt_0 _ H10 H11).
-  rewrite H7 in H12; elim (Rlt_irrefl _ H12).
-  rewrite Rabs_right in H4.
-  elim H4; intros.
-  case (Rtotal_order 0 r); intro.
-  right; split; assumption.
-  elim H10; intro.
-  left; symmetry  in |- *; assumption.
-  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 H11)).
-  apply Rle_ge.
-  left; apply PI_RGT_0.
-  apply sin_eq_0_1.
-  exists q; reflexivity.
-Qed.
-
-Lemma cos_eq_0_0 :
-  forall x:R, cos x = 0 ->  exists k : Z, x = IZR k * PI + PI / 2.
-Proof.
-  intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H);
-    intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z;
-      rewrite <- Z_R_minus; simpl.
-unfold INR in H3. field_simplify [(sym_eq H3)]. field.
-(**
-  ring_simplify.
- (* rewrite (Rmult_comm PI);*) (* old ring compat *)
-        rewrite <- H3; simpl;
-          field;repeat split; discrR.
-*)
-Qed.
-
-Lemma cos_eq_0_1 :
-  forall x:R, (exists k : Z, x = IZR k * PI + PI / 2) -> cos x = 0.
-Proof.
-  intros x H1; rewrite cos_sin; elim H1; intros x0 H2; rewrite H2;
-    replace (PI / 2 + (IZR x0 * PI + PI / 2)) with (IZR x0 * PI + PI).
-  rewrite neg_sin; rewrite <- Ropp_0.
-  apply Ropp_eq_compat; apply sin_eq_0_1; exists x0; reflexivity.
-  pattern PI at 2 in |- *; rewrite (double_var PI); ring.
-Qed.
-
-Lemma sin_eq_O_2PI_0 :
-  forall x:R,
-    0 <= x -> x <= 2 * PI -> sin x = 0 -> x = 0 \/ x = PI \/ x = 2 * PI.
-Proof.
-  intros; generalize (sin_eq_0_0 x H1); intro.
-  elim H2; intros k0 H3.
-  case (Rtotal_order PI x); intro.
-  rewrite H3 in H4; rewrite H3 in H0.
-  right; right.
-  generalize
-    (Rmult_lt_compat_r (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) H4);
-    rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_r; intro;
-    generalize
-      (Rmult_le_compat_r (/ PI) (IZR k0 * PI) (2 * PI)
-        (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H0);
-      repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
-  repeat rewrite Rmult_1_r; intro;
-    generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5);
-      rewrite <- plus_IZR.
-  replace (IZR (-2) + 1) with (-1).
-  intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) 2 H6);
-    rewrite <- plus_IZR.
-  replace (IZR (-2) + 2) with 0.
-  intro; cut (-1 < IZR (-2 + k0) < 1).
-  intro; generalize (one_IZR_lt1 (-2 + k0) H9); intro.
-  cut (k0 = 2%Z).
-  intro; rewrite H11 in H3; rewrite H3; simpl in |- *.
-  reflexivity.
-  rewrite <- (Zplus_opp_l 2) in H10; generalize (Zplus_reg_l (-2) k0 2 H10);
-    intro; assumption.
-  split.
-  assumption.
-  apply Rle_lt_trans with 0.
-  assumption.
-  apply Rlt_0_1.
-  simpl in |- *; ring.
-  simpl in |- *; ring.
-  apply PI_neq0.
-  apply PI_neq0.
-  elim H4; intro.
-  right; left.
-  symmetry  in |- *; assumption.
-  left.
-  rewrite H3 in H5; rewrite H3 in H;
-    generalize
-      (Rmult_lt_compat_r (/ PI) (IZR k0 * PI) PI (Rinv_0_lt_compat PI PI_RGT_0)
-        H5); rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_r; intro;
-    generalize
-      (Rmult_le_compat_r (/ PI) 0 (IZR k0 * PI)
-        (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H);
-      repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_r; rewrite Rmult_0_l; intro.
-  cut (-1 < IZR k0 < 1).
-  intro; generalize (one_IZR_lt1 k0 H8); intro; rewrite H9 in H3; rewrite H3;
-    simpl in |- *; apply Rmult_0_l.
-  split.
-  apply Rlt_le_trans with 0.
-  rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; apply Rlt_0_1.
-  assumption.
-  assumption.
-  apply PI_neq0.
-  apply PI_neq0.
-Qed.
-
-Lemma sin_eq_O_2PI_1 :
-  forall x:R,
-    0 <= x -> x <= 2 * PI -> x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0.
-Proof.
-  intros x H1 H2 H3; elim H3; intro H4;
-    [ rewrite H4; rewrite sin_0; reflexivity
-      | elim H4; intro H5;
-        [ rewrite H5; rewrite sin_PI; reflexivity
-          | rewrite H5; rewrite sin_2PI; reflexivity ] ].
-Qed.
-
-Lemma cos_eq_0_2PI_0 :
-  forall x:R,
-    0 <= x -> x <= 2 * PI -> cos x = 0 -> x = PI / 2 \/ x = 3 * (PI / 2).
-Proof.
-  intros; case (Rtotal_order x (3 * (PI / 2))); intro.
-  rewrite cos_sin in H1.
-  cut (0 <= PI / 2 + x).
-  cut (PI / 2 + x <= 2 * PI).
-  intros; generalize (sin_eq_O_2PI_0 (PI / 2 + x) H4 H3 H1); intros.
-  decompose [or] H5.
-  generalize (Rplus_le_compat_l (PI / 2) 0 x H); rewrite Rplus_0_r; rewrite H6;
-    intro.
-  elim (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 H7)).
-  left.
-  generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) PI H7).
-  replace (- (PI / 2) + (PI / 2 + x)) with x.
-  replace (- (PI / 2) + PI) with (PI / 2).
-  intro; assumption.
-  pattern PI at 3 in |- *; rewrite (double_var PI); ring.
-  ring.
-  right.
-  generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) (2 * PI) H7).
-  replace (- (PI / 2) + (PI / 2 + x)) with x.
-  replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)).
-  intro; assumption.
-  rewrite double; pattern PI at 3 4 in |- *; rewrite (double_var PI); ring.
-  ring.
-  left; replace (2 * PI) with (PI / 2 + 3 * (PI / 2)).
-  apply Rplus_lt_compat_l; assumption.
-  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite (double_var PI); ring.
-  apply Rplus_le_le_0_compat.
-  left; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-  apply PI_RGT_0.
-  apply Rinv_0_lt_compat; prove_sup0.
-  assumption.
-  elim H2; intro.
-  right; assumption.
-  generalize (cos_eq_0_0 x H1); intro; elim H4; intros k0 H5.
-  rewrite H5 in H3; rewrite H5 in H0;
-    generalize
-      (Rplus_lt_compat_l (- (PI / 2)) (3 * (PI / 2)) (IZR k0 * PI + PI / 2) H3);
-      generalize
-        (Rplus_le_compat_l (- (PI / 2)) (IZR k0 * PI + PI / 2) (2 * PI) H0).
-  replace (- (PI / 2) + 3 * (PI / 2)) with PI.
-  replace (- (PI / 2) + (IZR k0 * PI + PI / 2)) with (IZR k0 * PI).
-  replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)).
-  intros;
-    generalize
-      (Rmult_lt_compat_l (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0)
-        H7);
-      generalize
-        (Rmult_le_compat_l (/ PI) (IZR k0 * PI) (3 * (PI / 2))
-          (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H6).
-  replace (/ PI * (IZR k0 * PI)) with (IZR k0).
-  replace (/ PI * (3 * (PI / 2))) with (3 * / 2).
-  rewrite <- Rinv_l_sym.
-  intros; generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H9);
-    rewrite <- plus_IZR.
-  replace (IZR (-2) + 1) with (-1).
-  intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) (3 * / 2) H8);
-    rewrite <- plus_IZR.
-  replace (IZR (-2) + 2) with 0.
-  intro; cut (-1 < IZR (-2 + k0) < 1).
-  intro; generalize (one_IZR_lt1 (-2 + k0) H12); intro.
-  cut (k0 = 2%Z).
-  intro; rewrite H14 in H8.
-  assert (Hyp : 0 < 2).
-  prove_sup0.
-  generalize (Rmult_le_compat_l 2 (IZR 2) (3 * / 2) (Rlt_le 0 2 Hyp) H8);
-    simpl in |- *.
-  replace 4 with 4.
-  replace (2 * (3 * / 2)) with 3.
-  intro; cut (3 < 4).
-  intro; elim (Rlt_irrefl 3 (Rlt_le_trans 3 4 3 H16 H15)).
-  generalize (Rplus_lt_compat_l 3 0 1 Rlt_0_1); rewrite Rplus_0_r.
-  replace (3 + 1) with 4.
-  intro; assumption.
-  ring.
-  symmetry  in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
-  discrR.
-  ring.
-  rewrite <- (Zplus_opp_l 2) in H13; generalize (Zplus_reg_l (-2) k0 2 H13);
-    intro; assumption.
-  split.
-  assumption.
-  apply Rle_lt_trans with (IZR (-2) + 3 * / 2).
-  assumption.
-  simpl in |- *; replace (-2 + 3 * / 2) with (- (1 * / 2)).
-  apply Rlt_trans with 0.
-  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar.
-  apply Rmult_lt_0_compat;
-    [ apply Rlt_0_1 | apply Rinv_0_lt_compat; prove_sup0 ].
-  apply Rlt_0_1.
-  rewrite Rmult_1_l; apply Rmult_eq_reg_l with 2.
-  rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_r_sym.
-  rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m.
-  ring.
-  discrR.
-  discrR.
-  discrR.
-  simpl in |- *; ring.
-  simpl in |- *; ring.
-  apply PI_neq0.
-  unfold Rdiv in |- *; pattern 3 at 1 in |- *; rewrite (Rmult_comm 3);
-    repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_l; apply Rmult_comm.
-  apply PI_neq0.
-  symmetry  in |- *; rewrite (Rmult_comm (/ PI)); rewrite Rmult_assoc;
-    rewrite <- Rinv_r_sym.
-  apply Rmult_1_r.
-  apply PI_neq0.
-  rewrite double; pattern PI at 3 4 in |- *; rewrite double_var; ring.
-  ring.
-  pattern PI at 1 in |- *; rewrite double_var; ring.
-Qed.
-
-Lemma cos_eq_0_2PI_1 :
-  forall x:R,
-    0 <= x -> x <= 2 * PI -> x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0.
-Proof.
-  intros x H1 H2 H3; elim H3; intro H4;
-    [ rewrite H4; rewrite cos_PI2; reflexivity
-      | rewrite H4; rewrite cos_3PI2; reflexivity ].
-Qed.
+Require Import Fourier.
+Require Import Ranalysis1.
+Require Import Rsqrt_def. 
+Require Import PSeries_reg.
+Require Export Rtrigo1.
+Require Export Ratan.
+Require Export Machin.
\ No newline at end of file
diff --git a/theories/Reals/Rtrigo1.v b/theories/Reals/Rtrigo1.v
new file mode 100644
index 00000000..6174ef32
--- /dev/null
+++ b/theories/Reals/Rtrigo1.v
@@ -0,0 +1,1933 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Rbase.
+Require Import Rfunctions.
+Require Import SeqSeries.
+Require Export Rtrigo_fun.
+Require Export Rtrigo_def.
+Require Export Rtrigo_alt.
+Require Export Cos_rel.
+Require Export Cos_plus.
+Require Import ZArith_base.
+Require Import Zcomplements.
+Require Import Classical_Prop.
+Require Import Fourier.
+Require Import Ranalysis1.
+Require Import Rsqrt_def. 
+Require Import PSeries_reg.
+
+Local Open Scope nat_scope.
+Local Open Scope R_scope.
+
+Lemma CVN_R_cos :
+  forall fn:nat -> R -> R,
+    fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) ->
+    CVN_R fn.
+Proof.
+  unfold CVN_R in |- *; intros.
+  cut ((r:R) <> 0).
+  intro hyp_r; unfold CVN_r in |- *.
+  exists (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)).
+  cut
+    { l:R |
+        Un_cv
+        (fun n:nat =>
+          sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k)))
+          n) l }.
+  intro X; elim X; intros.
+  exists x.
+  split.
+  apply p.
+  intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult.
+  rewrite pow_1_abs; rewrite Rmult_1_l.
+  cut (0 < / INR (fact (2 * n))).
+  intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))).
+  apply Rmult_le_compat_l.
+  left; apply H1.
+  rewrite <- RPow_abs; apply pow_maj_Rabs.
+  rewrite Rabs_Rabsolu.
+  unfold Boule in H0; rewrite Rminus_0_r in H0.
+  left; apply H0.
+  apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Alembert_C2.
+  intro; apply Rabs_no_R0.
+  apply prod_neq_R0.
+  apply Rinv_neq_0_compat.
+  apply INR_fact_neq_0.
+  apply pow_nonzero; assumption.
+  assert (H0 := Alembert_cos).
+  unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros.
+  cut (0 < eps / Rsqr r).
+  intro; elim (H0 _ H2); intros N0 H3.
+  exists N0; intros.
+  unfold R_dist in |- *; assert (H5 := H3 _ H4).
+  unfold R_dist in H5;
+    replace
+    (Rabs
+      (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) /
+        Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with
+    (Rsqr r *
+      Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))).
+  apply Rmult_lt_reg_l with (/ Rsqr r).
+  apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+  pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)).
+  rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r;
+    rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5.
+  unfold Rsqr in |- *; apply prod_neq_R0; assumption.
+  rewrite Rabs_Rinv.
+  rewrite Rabs_right.
+  reflexivity.
+  apply Rle_ge; apply Rle_0_sqr.
+  unfold Rsqr in |- *; apply prod_neq_R0; assumption.
+  rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult;
+    rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l;
+      repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+  rewrite Rabs_Rinv.
+  rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l;
+    rewrite <- Rabs_Rinv.
+  rewrite Rinv_involutive.
+  rewrite Rinv_mult_distr.
+  rewrite Rabs_Rinv.
+  rewrite Rinv_involutive.
+  rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult;
+    rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+  rewrite Rabs_Rinv.
+  do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right.
+  replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r).
+  repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  unfold Rsqr in |- *; ring.
+  apply pow_nonzero; assumption.
+  replace (2 * S n)%nat with (S (S (2 * n))).
+  simpl in |- *; ring.
+  ring.
+  apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+  apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+  apply Rabs_no_R0; apply pow_nonzero; assumption.
+  apply Rabs_no_R0; apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  apply Rabs_no_R0; apply pow_nonzero; assumption.
+  apply INR_fact_neq_0.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  apply prod_neq_R0.
+  apply pow_nonzero; discrR.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply H1.
+  apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+  assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0;
+    elim (Rlt_irrefl _ H0).
+Qed.
+
+(**********)
+Lemma continuity_cos : continuity cos.
+Proof.
+  set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)).
+  cut (CVN_R fn).
+  intro; cut (forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }).
+  intro cv; cut (forall n:nat, continuity (fn n)).
+  intro; cut (forall x:R, cos x = SFL fn cv x).
+  intro; cut (continuity (SFL fn cv) -> continuity cos).
+  intro; apply H1.
+  apply SFL_continuity; assumption.
+  unfold continuity in |- *; unfold continuity_pt in |- *;
+    unfold continue_in in |- *; unfold limit1_in in |- *;
+      unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
+        intros.
+  elim (H1 x _ H2); intros.
+  exists x0; intros.
+  elim H3; intros.
+  split.
+  apply H4.
+  intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6.
+  intro; unfold cos, SFL in |- *.
+  case (cv x); case (exist_cos (Rsqr x)); intros.
+  symmetry  in |- *; eapply UL_sequence.
+  apply u.
+  unfold cos_in in c; unfold infinite_sum in c; unfold Un_cv in |- *; intros.
+  elim (c _ H0); intros N0 H1.
+  exists N0; intros.
+  unfold R_dist in H1; unfold R_dist, SP in |- *.
+  replace (sum_f_R0 (fun k:nat => fn k x) n) with
+  (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n).
+  apply H1; assumption.
+  apply sum_eq; intros.
+  unfold cos_n, fn in |- *; apply Rmult_eq_compat_l.
+  unfold Rsqr in |- *; rewrite pow_sqr; reflexivity.
+  intro; unfold fn in |- *;
+    replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with
+    (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F;
+    [ idtac | reflexivity ].
+  apply continuity_mult.
+  apply derivable_continuous; apply derivable_const.
+  apply derivable_continuous; apply (derivable_pow (2 * n)).
+  apply CVN_R_CVS; apply X.
+  apply CVN_R_cos; unfold fn in |- *; reflexivity.
+Qed.
+
+Lemma sin_gt_cos_7_8 : sin (7 / 8) > cos (7 / 8).
+Proof. 
+assert (lo1 : 0 <= 7/8) by fourier.
+assert (up1 : 7/8 <= 4) by fourier.
+assert (lo : -2 <= 7/8) by fourier.
+assert (up : 7/8 <= 2) by fourier.
+destruct (pre_sin_bound _ 0 lo1 up1) as [lower _ ].
+destruct (pre_cos_bound _ 0 lo up) as [_ upper].
+apply Rle_lt_trans with (1 := upper).
+apply Rlt_le_trans with (2 := lower).
+unfold cos_approx, sin_approx.
+simpl sum_f_R0; replace 7 with (IZR 7) by (simpl; field).
+replace 8 with (IZR 8) by (simpl; field).
+unfold cos_term, sin_term; simpl fact; rewrite !INR_IZR_INZ.
+simpl plus; simpl mult.
+field_simplify;
+  try (repeat apply conj; apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity).
+unfold Rminus; rewrite !pow_IZR, <- !mult_IZR, <- !opp_IZR, <- ?plus_IZR.
+match goal with 
+  |- IZR ?a / ?b < ?c / ?d =>
+  apply Rmult_lt_reg_r with d;[apply (IZR_lt 0); reflexivity |
+    unfold Rdiv at 2; rewrite Rmult_assoc, Rinv_l, Rmult_1_r, Rmult_comm;
+     [ |apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity ]];
+  apply Rmult_lt_reg_r with b;[apply (IZR_lt 0); reflexivity | ]
+end.
+unfold Rdiv; rewrite !Rmult_assoc, Rinv_l, Rmult_1_r;
+ [ | apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity].
+repeat (rewrite <- !plus_IZR || rewrite <- !mult_IZR).
+apply IZR_lt; reflexivity.
+Qed.
+
+Definition PI_2_aux : {z | 7/8 <= z <= 7/4 /\ -cos z = 0}.
+assert (cc : continuity (fun r =>- cos r)).
+ apply continuity_opp, continuity_cos.
+assert (cvp : 0 < cos (7/8)).
+ assert (int78 : -2 <= 7/8 <= 2) by (split; fourier).
+ destruct int78 as [lower upper].
+ case (pre_cos_bound _ 0 lower upper).
+ unfold cos_approx; simpl sum_f_R0; unfold cos_term.
+ intros cl _; apply Rlt_le_trans with (2 := cl); simpl.
+ fourier.
+assert (cun : cos (7/4) < 0).
+ replace (7/4) with (7/8 + 7/8) by field.
+ rewrite cos_plus.
+ apply Rlt_minus; apply Rsqr_incrst_1.
+   exact sin_gt_cos_7_8.
+  apply Rlt_le; assumption.
+ apply Rlt_le; apply Rlt_trans with (1 := cvp); exact sin_gt_cos_7_8.
+apply IVT; auto; fourier.
+Qed.
+
+Definition PI2 := proj1_sig PI_2_aux.
+
+Definition PI := 2 * PI2.
+
+Lemma cos_pi2 : cos PI2 = 0.
+unfold PI2; case PI_2_aux; simpl.
+intros x [_ q]; rewrite <- (Ropp_involutive (cos x)), q; apply Ropp_0.
+Qed.
+
+Lemma pi2_int : 7/8 <= PI2 <= 7/4.
+unfold PI2; case PI_2_aux; simpl; tauto.
+Qed.
+
+(**********)
+Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y.
+Proof.
+  intros; unfold Rminus in |- *; rewrite cos_plus.
+  rewrite <- cos_sym; rewrite sin_antisym; ring.
+Qed.
+
+(**********)
+Lemma sin2_cos2 : forall x:R, Rsqr (sin x) + Rsqr (cos x) = 1.
+Proof.
+  intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x);
+    unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0.
+Qed.
+
+Lemma cos2 : forall x:R, Rsqr (cos x) = 1 - Rsqr (sin x).
+Proof.
+  intros x; rewrite <- (sin2_cos2 x); ring.
+Qed.
+
+Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x).
+Proof.
+  intro x; generalize (cos2 x); intro H1; rewrite H1.
+  unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
+    rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry  in |- *;
+      apply Ropp_involutive.
+Qed.
+
+(**********)
+Lemma cos_PI2 : cos (PI / 2) = 0.
+Proof.
+ unfold PI; generalize cos_pi2; replace ((2 * PI2)/2) with PI2 by field; tauto.
+Qed.
+
+Lemma sin_pos_tech : forall x, 0 < x < 2 -> 0 < sin x. 
+intros x [int1 int2].
+assert (lo : 0 <= x) by (apply Rlt_le; assumption).
+assert (up : x <= 4) by (apply Rlt_le, Rlt_trans with (1:=int2); fourier).
+destruct (pre_sin_bound _ 0 lo up) as [t _]; clear lo up.
+apply Rlt_le_trans with (2:= t); clear t.
+unfold sin_approx; simpl sum_f_R0; unfold sin_term; simpl.
+match goal with |- _ < ?a =>
+  replace a with (x * (1 - x^2/6)) by (simpl; field)
+end.
+assert (t' : x ^ 2 <= 4).
+ replace 4 with (2 ^ 2) by field.
+ apply (pow_incr x 2); split; apply Rlt_le; assumption.
+apply Rmult_lt_0_compat;[assumption | fourier ].
+Qed.
+
+Lemma sin_PI2 : sin (PI / 2) = 1.
+replace (PI / 2) with PI2 by (unfold PI; field).
+assert (int' : 0 < PI2 < 2).
+ destruct pi2_int; split; fourier.
+assert (lo2 := sin_pos_tech PI2 int').
+assert (t2 : Rabs (sin PI2) = 1).
+ rewrite <- Rabs_R1; apply Rsqr_eq_abs_0.
+ rewrite Rsqr_1, sin2, cos_pi2, Rsqr_0, Rminus_0_r; reflexivity.
+revert t2; rewrite Rabs_pos_eq;[| apply Rlt_le]; tauto.
+Qed.
+
+Lemma PI_RGT_0 : PI > 0.
+Proof. unfold PI; destruct pi2_int; fourier. Qed.
+
+Lemma PI_4 : PI <= 4.
+Proof. unfold PI; destruct pi2_int; fourier. Qed.
+
+(**********)
+Lemma PI_neq0 : PI <> 0.
+Proof.
+  red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0;
+    elim (Rlt_irrefl _ H0).
+Qed.
+
+
+(**********)
+Lemma cos_PI : cos PI = -1.
+Proof.
+  replace PI with (PI / 2 + PI / 2).
+  rewrite cos_plus.
+  rewrite sin_PI2; rewrite cos_PI2.
+  ring.
+  symmetry  in |- *; apply double_var.
+Qed.
+
+Lemma sin_PI : sin PI = 0.
+Proof.
+  assert (H := sin2_cos2 PI).
+  rewrite cos_PI in H.
+  rewrite <- Rsqr_neg in H.
+  rewrite Rsqr_1 in H.
+  cut (Rsqr (sin PI) = 0).
+  intro; apply (Rsqr_eq_0 _ H0).
+  apply Rplus_eq_reg_l with 1.
+  rewrite Rplus_0_r; rewrite Rplus_comm; exact H.
+Qed.
+
+Lemma sin_bound : forall (a : R) (n : nat), 0 <= a -> a <= PI ->
+       sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)).
+Proof.
+intros a n a0 api; apply pre_sin_bound.
+ assumption.
+apply Rle_trans with (1:= api) (2 := PI_4).
+Qed.
+
+Lemma cos_bound : forall (a : R) (n : nat), - PI / 2 <= a -> a <= PI / 2 ->
+       cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)).
+Proof.
+intros a n lower upper; apply pre_cos_bound.
+ apply Rle_trans with (2 := lower).
+ apply Rmult_le_reg_r with 2; [fourier |].
+ replace ((-PI/2) * 2) with (-PI) by field.
+ assert (t := PI_4); fourier.
+apply Rle_trans with (1 := upper).
+apply Rmult_le_reg_r with 2; [fourier | ].
+replace ((PI/2) * 2) with PI by field.
+generalize PI_4; intros; fourier.
+Qed.
+(**********)
+Lemma neg_cos : forall x:R, cos (x + PI) = - cos x.
+Proof.
+  intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring.
+Qed.
+
+(**********)
+Lemma sin_cos : forall x:R, sin x = - cos (PI / 2 + x).
+Proof.
+  intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
+Qed.
+
+(**********)
+Lemma sin_plus : forall x y:R, sin (x + y) = sin x * cos y + cos x * sin y.
+Proof.
+  intros.
+  rewrite (sin_cos (x + y)).
+  replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ].
+  rewrite (sin_cos (PI / 2 + x)).
+  replace (PI / 2 + (PI / 2 + x)) with (x + PI).
+  rewrite neg_cos.
+  replace (cos (PI / 2 + x)) with (- sin x).
+  ring.
+  rewrite sin_cos; rewrite Ropp_involutive; reflexivity.
+  pattern PI at 1 in |- *; rewrite (double_var PI); ring.
+Qed.
+
+Lemma sin_minus : forall x y:R, sin (x - y) = sin x * cos y - cos x * sin y.
+Proof.
+  intros; unfold Rminus in |- *; rewrite sin_plus.
+  rewrite <- cos_sym; rewrite sin_antisym; ring.
+Qed.
+
+(**********)
+Definition tan (x:R) : R := sin x / cos x.
+
+Lemma tan_plus :
+  forall x y:R,
+    cos x <> 0 ->
+    cos y <> 0 ->
+    cos (x + y) <> 0 ->
+    1 - tan x * tan y <> 0 ->
+    tan (x + y) = (tan x + tan y) / (1 - tan x * tan y).
+Proof.
+  intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus;
+    unfold Rdiv in |- *;
+      replace (cos x * cos y - sin x * sin y) with
+      (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))).
+  rewrite Rinv_mult_distr.
+  repeat rewrite <- Rmult_assoc;
+    replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with
+    (sin x * / cos x + sin y * / cos y).
+  reflexivity.
+  rewrite Rmult_plus_distr_r; rewrite Rinv_mult_distr.
+  repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x));
+    repeat rewrite <- Rmult_assoc.
+  repeat rewrite Rinv_r_simpl_m; [ reflexivity | assumption | assumption ].
+  assumption.
+  assumption.
+  apply prod_neq_R0; assumption.
+  assumption.
+  unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
+    apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc;
+      rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y));
+        rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc;
+          rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; rewrite (Rmult_comm (sin x));
+    rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc;
+      apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y));
+        rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+  apply Rmult_1_r.
+  assumption.
+  assumption.
+Qed.
+
+(*******************************************************)
+(** * Some properties of cos, sin and tan              *)
+(*******************************************************)
+
+Lemma sin_2a : forall x:R, sin (2 * x) = 2 * sin x * cos x.
+Proof.
+  intro x; rewrite double; rewrite sin_plus.
+  rewrite <- (Rmult_comm (sin x)); symmetry  in |- *; rewrite Rmult_assoc;
+    apply double.
+Qed.
+
+Lemma cos_2a : forall x:R, cos (2 * x) = cos x * cos x - sin x * sin x.
+Proof.
+  intro x; rewrite double; apply cos_plus.
+Qed.
+
+Lemma cos_2a_cos : forall x:R, cos (2 * x) = 2 * cos x * cos x - 1.
+Proof.
+  intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc;
+    rewrite cos_plus; generalize (sin2_cos2 x); rewrite double;
+      intro H1; rewrite <- H1; ring_Rsqr.
+Qed.
+
+Lemma cos_2a_sin : forall x:R, cos (2 * x) = 1 - 2 * sin x * sin x.
+Proof.
+  intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite double.
+  generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus;
+    ring_Rsqr.
+Qed.
+
+Lemma tan_2a :
+  forall x:R,
+    cos x <> 0 ->
+    cos (2 * x) <> 0 ->
+    1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x).
+Proof.
+  repeat rewrite double; intros; repeat rewrite double; rewrite double in H0;
+    apply tan_plus; assumption.
+Qed.
+
+Lemma sin_neg : forall x:R, sin (- x) = - sin x.
+Proof.
+  apply sin_antisym.
+Qed.
+
+Lemma cos_neg : forall x:R, cos (- x) = cos x.
+Proof.
+  intro; symmetry  in |- *; apply cos_sym.
+Qed.
+
+Lemma tan_0 : tan 0 = 0.
+Proof.
+  unfold tan in |- *; rewrite sin_0; rewrite cos_0.
+  unfold Rdiv in |- *; apply Rmult_0_l.
+Qed.
+
+Lemma tan_neg : forall x:R, tan (- x) = - tan x.
+Proof.
+  intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg;
+    unfold Rdiv in |- *.
+  apply Ropp_mult_distr_l_reverse.
+Qed.
+
+Lemma tan_minus :
+  forall x y:R,
+    cos x <> 0 ->
+    cos y <> 0 ->
+    cos (x - y) <> 0 ->
+    1 + tan x * tan y <> 0 ->
+    tan (x - y) = (tan x - tan y) / (1 + tan x * tan y).
+Proof.
+  intros; unfold Rminus in |- *; rewrite tan_plus.
+  rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
+    rewrite Rmult_opp_opp; reflexivity.
+  assumption.
+  rewrite cos_neg; assumption.
+  assumption.
+  rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
+    rewrite Rmult_opp_opp; assumption.
+Qed.
+
+Lemma cos_3PI2 : cos (3 * (PI / 2)) = 0.
+Proof.
+  replace (3 * (PI / 2)) with (PI + PI / 2).
+  rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring.
+  pattern PI at 1 in |- *; rewrite (double_var PI).
+  ring.
+Qed.
+
+Lemma sin_2PI : sin (2 * PI) = 0.
+Proof.
+  rewrite sin_2a; rewrite sin_PI; ring.
+Qed.
+
+Lemma cos_2PI : cos (2 * PI) = 1.
+Proof.
+  rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring.
+Qed.
+
+Lemma neg_sin : forall x:R, sin (x + PI) = - sin x.
+Proof.
+  intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring.
+Qed.
+
+Lemma sin_PI_x : forall x:R, sin (PI - x) = sin x.
+Proof.
+  intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l;
+    unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse;
+      rewrite Ropp_involutive; apply Rmult_1_l.
+Qed.
+
+Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x.
+Proof.
+  intros x k; induction  k as [| k Hreck].
+  simpl in |- *;  ring_simplify (x + 2 * 0 * PI).
+  trivial.
+
+  replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI).
+  rewrite sin_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *.
+  ring_simplify; trivial.
+  rewrite S_INR in |- *;  ring.
+Qed.
+
+Lemma cos_period : forall (x:R) (k:nat), cos (x + 2 * INR k * PI) = cos x.
+Proof.
+  intros x k; induction  k as [| k Hreck].
+  simpl in |- *;  ring_simplify (x + 2 * 0 * PI).
+  trivial.
+
+  replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI).
+  rewrite cos_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *.
+  ring_simplify; trivial.
+  rewrite S_INR in |- *;  ring.
+Qed.
+
+Lemma sin_shift : forall x:R, sin (PI / 2 - x) = cos x.
+Proof.
+  intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
+Qed.
+
+Lemma cos_shift : forall x:R, cos (PI / 2 - x) = sin x.
+Proof.
+  intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
+Qed.
+
+Lemma cos_sin : forall x:R, cos x = sin (PI / 2 + x).
+Proof.
+  intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
+Qed.
+
+Lemma PI2_RGT_0 : 0 < PI / 2.
+Proof.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ].
+Qed.
+
+Lemma SIN_bound : forall x:R, -1 <= sin x <= 1.
+Proof.
+  intro; case (Rle_dec (-1) (sin x)); intro.
+  case (Rle_dec (sin x) 1); intro.
+  split; assumption.
+  cut (1 < sin x).
+  intro;
+    generalize
+      (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1)
+        (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H)));
+      rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0;
+        generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
+          repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l;
+            rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
+              generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
+                repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x));
+                  intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
+  auto with real.
+  cut (sin x < -1).
+  intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H);
+    rewrite Ropp_involutive; clear H; intro;
+      generalize
+        (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1)
+          (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H)));
+        rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0;
+          rewrite sin2 in H0; unfold Rminus in H0;
+            generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
+              repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l;
+                rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
+                  generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
+                    repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x));
+                      intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
+  auto with real.
+Qed.
+
+Lemma COS_bound : forall x:R, -1 <= cos x <= 1.
+Proof.
+  intro; rewrite <- sin_shift; apply SIN_bound.
+Qed.
+
+Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0).
+Proof.
+  intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro;
+    rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2;
+      rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro;
+        rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3).
+Qed.
+
+Lemma cos_sin_0_var : forall x:R, cos x <> 0 \/ sin x <> 0.
+Proof.
+  intros x.
+  destruct (Req_dec (cos x) 0). 2: now left.
+  right. intros H'.
+  apply (cos_sin_0 x).
+  now split.
+Qed.
+
+(*****************************************************************)
+(** * Using series definitions of cos and sin                    *)
+(*****************************************************************)
+
+Definition sin_lb (a:R) : R := sin_approx a 3.
+Definition sin_ub (a:R) : R := sin_approx a 4.
+Definition cos_lb (a:R) : R := cos_approx a 3.
+Definition cos_ub (a:R) : R := cos_approx a 4.
+
+Lemma sin_lb_gt_0 : forall a:R, 0 < a -> a <= PI / 2 -> 0 < sin_lb a.
+Proof.
+  intros.
+  unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *.
+  set (Un := fun i:nat => a ^ (2 * i + 1) / INR (fact (2 * i + 1))).
+  replace
+  (sum_f_R0
+    (fun i:nat => (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1)))) 3)
+    with (sum_f_R0 (fun i:nat => (-1) ^ i * Un i) 3);
+      [ idtac | apply sum_eq; intros; unfold Un in |- *; reflexivity ].
+  cut (forall n:nat, Un (S n) < Un n).
+  intro; simpl in |- *.
+  repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r;
+    replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ];
+    replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ];
+    replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat);
+    [ idtac | ring ];
+    replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with
+    (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ].
+  apply Rplus_lt_0_compat.
+  unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat);
+    rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat));
+      rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
+        apply H1.
+  unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat);
+    rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat));
+      rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
+        apply H1.
+  intro; unfold Un in |- *.
+  cut ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat).
+  intro; rewrite H1.
+  rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
+    apply Rmult_lt_compat_l.
+  apply pow_lt; assumption.
+  rewrite <- H1; apply Rmult_lt_reg_l with (INR (fact (2 * n + 1))).
+  apply lt_INR_0; apply neq_O_lt.
+  assert (H2 := fact_neq_0 (2 * n + 1)).
+  red in |- *; intro; elim H2; symmetry  in |- *; assumption.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_lt_reg_l with (INR (fact (2 * S n + 1))).
+  apply lt_INR_0; apply neq_O_lt.
+  assert (H2 := fact_neq_0 (2 * S n + 1)).
+  red in |- *; intro; elim H2; symmetry  in |- *; assumption.
+  rewrite (Rmult_comm (INR (fact (2 * S n + 1)))); repeat rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4).
+  apply Rmult_le_compat_l.
+  replace 0 with (INR 0); [ idtac | reflexivity ]; apply le_INR; apply le_O_n.
+  simpl in |- *; rewrite Rmult_1_r; replace 4 with (Rsqr 2);
+    [ idtac | ring_Rsqr ]; replace (a * a) with (Rsqr a);
+    [ idtac | reflexivity ]; apply Rsqr_incr_1.
+  apply Rle_trans with (PI / 2);
+    [ assumption
+      | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2;
+        [ prove_sup0
+          | rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m;
+            [ replace 4 with 4; [ apply PI_4 | ring ] | discrR ] ] ].
+  left; assumption.
+  left; prove_sup0.
+  rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))).
+  do 2 rewrite fact_simpl; do 2 rewrite mult_INR.
+  repeat rewrite <- Rmult_assoc.
+  rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))).
+  rewrite Rmult_assoc.
+  apply Rmult_lt_compat_l.
+  apply lt_INR_0; apply neq_O_lt.
+  assert (H2 := fact_neq_0 (2 * n + 1)).
+  red in |- *; intro; elim H2; symmetry  in |- *; assumption.
+  do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; set (x := INR n);
+    unfold INR in |- *.
+  replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6);
+  [ idtac | ring ].
+  apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l;
+    replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2);
+    [ idtac | ring ].
+  apply Rplus_le_lt_0_compat.
+  cut (0 <= x).
+  intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos;
+    assumption || left; prove_sup.
+  unfold x in |- *; replace 0 with (INR 0);
+    [ apply le_INR; apply le_O_n | reflexivity ].
+  prove_sup0.
+  ring.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  ring.
+Qed.
+
+Lemma SIN : forall a:R, 0 <= a -> a <= PI -> sin_lb a <= sin a <= sin_ub a.
+  intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0).
+Qed.
+
+Lemma COS :
+  forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a.
+  intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0).
+Qed.
+
+(**********)
+Lemma _PI2_RLT_0 : - (PI / 2) < 0.
+Proof.
+  rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0.
+Qed.
+
+Lemma PI4_RLT_PI2 : PI / 4 < PI / 2.
+Proof.
+  unfold Rdiv in |- *; apply Rmult_lt_compat_l.
+  apply PI_RGT_0.
+  apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat; prove_sup0.
+  pattern 2 at 1 in |- *; rewrite <- Rplus_0_r.
+  replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ].
+Qed.
+
+Lemma PI2_Rlt_PI : PI / 2 < PI.
+Proof.
+  unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r.
+  apply Rmult_lt_compat_l.
+  apply PI_RGT_0.
+  pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar.
+  rewrite Rmult_1_l; prove_sup0.
+  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    apply Rlt_0_1.
+Qed.
+
+(***************************************************)
+(** * Increasing and decreasing of [cos] and [sin] *)
+(***************************************************)
+Theorem sin_gt_0 : forall x:R, 0 < x -> x < PI -> 0 < sin x.
+Proof.
+  intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _;
+    case (Rtotal_order x (PI / 2)); intro H2.
+  apply Rlt_le_trans with (sin_lb x).
+  apply sin_lb_gt_0; [ assumption | left; assumption ].
+  assumption.
+  elim H2; intro H3.
+  rewrite H3; rewrite sin_PI2; apply Rlt_0_1.
+  rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3);
+    intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4).
+  replace (PI + - x) with (PI - x).
+  replace (PI + - (PI / 2)) with (PI / 2).
+  intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6;
+    change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6).
+  rewrite Rplus_opp_r.
+  replace (PI + - x) with (PI - x).
+  intro H7;
+    elim
+      (SIN (PI - x) (Rlt_le 0 (PI - x) H7)
+        (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI)));
+      intros H8 _;
+        generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5));
+          intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8).
+  reflexivity.
+  pattern PI at 2 in |- *; rewrite double_var; ring.
+  reflexivity.
+Qed.
+
+Theorem cos_gt_0 : forall x:R, - (PI / 2) < x -> x < PI / 2 -> 0 < cos x.
+Proof.
+  intros; rewrite cos_sin;
+    generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H).
+  rewrite Rplus_opp_r; intro H1;
+    generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0);
+      rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2).
+Qed.
+
+Lemma sin_ge_0 : forall x:R, 0 <= x -> x <= PI -> 0 <= sin x.
+Proof.
+  intros x H1 H2; elim H1; intro H3;
+    [ elim H2; intro H4;
+      [ left; apply (sin_gt_0 x H3 H4)
+        | rewrite H4; right; symmetry  in |- *; apply sin_PI ]
+      | rewrite <- H3; right; symmetry  in |- *; apply sin_0 ].
+Qed.
+
+Lemma cos_ge_0 : forall x:R, - (PI / 2) <= x -> x <= PI / 2 -> 0 <= cos x.
+Proof.
+  intros x H1 H2; elim H1; intro H3;
+    [ elim H2; intro H4;
+      [ left; apply (cos_gt_0 x H3 H4)
+        | rewrite H4; right; symmetry  in |- *; apply cos_PI2 ]
+      | rewrite <- H3; rewrite cos_neg; right; symmetry  in |- *; apply cos_PI2 ].
+Qed.
+
+Lemma sin_le_0 : forall x:R, PI <= x -> x <= 2 * PI -> sin x <= 0.
+Proof.
+  intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
+    rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar;
+      rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI);
+        [ rewrite (sin_period (x - PI) 1); apply sin_ge_0;
+          [ replace (x - PI) with (x + - PI);
+            [ rewrite Rplus_comm; replace 0 with (- PI + PI);
+              [ apply Rplus_le_compat_l; assumption | ring ]
+              | ring ]
+            | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
+              [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
+                [ apply Rplus_le_compat_l; assumption | ring ]
+                | ring ] ]
+          | unfold INR in |- *; ring ].
+Qed.
+
+Lemma cos_le_0 : forall x:R, PI / 2 <= x -> x <= 3 * (PI / 2) -> cos x <= 0.
+Proof.
+  intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
+    rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar;
+      rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI).
+  rewrite cos_period; apply cos_ge_0.
+  replace (- (PI / 2)) with (- PI + PI / 2).
+  unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l;
+    assumption.
+  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+    ring.
+  unfold Rminus in |- *; rewrite Rplus_comm;
+    replace (PI / 2) with (- PI + 3 * (PI / 2)).
+  apply Rplus_le_compat_l; assumption.
+  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+    ring.
+  unfold INR in |- *; ring.
+Qed.
+
+Lemma sin_lt_0 : forall x:R, PI < x -> x < 2 * PI -> sin x < 0.
+Proof.
+  intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x));
+    apply Ropp_lt_gt_contravar; rewrite <- neg_sin;
+      replace (x + PI) with (x - PI + 2 * INR 1 * PI);
+      [ rewrite (sin_period (x - PI) 1); apply sin_gt_0;
+        [ replace (x - PI) with (x + - PI);
+          [ rewrite Rplus_comm; replace 0 with (- PI + PI);
+            [ apply Rplus_lt_compat_l; assumption | ring ]
+            | ring ]
+          | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
+            [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
+              [ apply Rplus_lt_compat_l; assumption | ring ]
+              | ring ] ]
+        | unfold INR in |- *; ring ].
+Qed.
+
+Lemma sin_lt_0_var : forall x:R, - PI < x -> x < 0 -> sin x < 0.
+Proof.
+  intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H);
+    replace (2 * PI + - PI) with PI;
+    [ intro H1; rewrite Rplus_comm in H1;
+      generalize (Rplus_lt_compat_l (2 * PI) x 0 H0);
+        intro H2; rewrite (Rplus_comm (2 * PI)) in H2;
+          rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2;
+            rewrite <- (sin_period x 1); unfold INR in |- *;
+              replace (2 * 1 * PI) with (2 * PI);
+              [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ]
+      | ring ].
+Qed.
+
+Lemma cos_lt_0 : forall x:R, PI / 2 < x -> x < 3 * (PI / 2) -> cos x < 0.
+Proof.
+  intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x));
+    apply Ropp_lt_gt_contravar; rewrite <- neg_cos;
+      replace (x + PI) with (x - PI + 2 * INR 1 * PI).
+  rewrite cos_period; apply cos_gt_0.
+  replace (- (PI / 2)) with (- PI + PI / 2).
+  unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l;
+    assumption.
+  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+    ring.
+  unfold Rminus in |- *; rewrite Rplus_comm;
+    replace (PI / 2) with (- PI + 3 * (PI / 2)).
+  apply Rplus_lt_compat_l; assumption.
+  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+    ring.
+  unfold INR in |- *; ring.
+Qed.
+
+Lemma tan_gt_0 : forall x:R, 0 < x -> x < PI / 2 -> 0 < tan x.
+Proof.
+  intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0;
+    generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros;
+      generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5;
+        generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI);
+          intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply sin_gt_0; assumption.
+  apply Rinv_0_lt_compat; apply cos_gt_0; assumption.
+Qed.
+
+Lemma tan_lt_0 : forall x:R, - (PI / 2) < x -> x < 0 -> tan x < 0.
+Proof.
+  intros x H1 H2; unfold tan in |- *;
+    generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0));
+      intro H3; rewrite <- Ropp_0;
+        replace (sin x / cos x) with (- (- sin x / cos x)).
+  rewrite <- sin_neg; apply Ropp_gt_lt_contravar;
+    change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *;
+      apply Rmult_lt_0_compat.
+  apply sin_gt_0.
+  rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption.
+  apply Rlt_trans with (PI / 2).
+  rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption.
+  apply PI2_Rlt_PI.
+  apply Rinv_0_lt_compat; assumption.
+  unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma cos_ge_0_3PI2 :
+  forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x.
+Proof.
+  intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1);
+    unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x).
+  generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1;
+    generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1;
+      intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1).
+  rewrite Rplus_opp_r.
+  intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3;
+    generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3;
+      intro H3;
+        generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3).
+  replace (2 * PI + - (3 * (PI / 2))) with (PI / 2).
+  intro H4;
+    apply
+      (cos_ge_0 (2 * PI - x)
+        (Rlt_le (- (PI / 2)) (2 * PI - x)
+          (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4).
+  rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring.
+  ring.
+Qed.
+
+Lemma form1 :
+  forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2).
+Proof.
+  intros p q; pattern p at 1 in |- *;
+    replace p with ((p - q) / 2 + (p + q) / 2).
+  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
+  rewrite cos_plus; rewrite cos_minus; ring.
+  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma form2 :
+  forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2).
+Proof.
+  intros p q; pattern p at 1 in |- *;
+    replace p with ((p - q) / 2 + (p + q) / 2).
+  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
+  rewrite cos_plus; rewrite cos_minus; ring.
+  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma form3 :
+  forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2).
+Proof.
+  intros p q; pattern p at 1 in |- *;
+    replace p with ((p - q) / 2 + (p + q) / 2).
+  pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
+  rewrite sin_plus; rewrite sin_minus; ring.
+  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+Qed.
+
+Lemma form4 :
+  forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2).
+Proof.
+  intros p q; pattern p at 1 in |- *;
+    replace p with ((p - q) / 2 + (p + q) / 2).
+  pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
+  rewrite sin_plus; rewrite sin_minus; ring.
+  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+
+Qed.
+
+Lemma sin_increasing_0 :
+  forall x y:R,
+    - (PI / 2) <= x ->
+    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y.
+Proof.
+  intros; cut (sin ((x - y) / 2) < 0).
+  intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5.
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  generalize (Rmult_lt_compat_l 2 ((x - y) / 2) 0 Hyp H5).
+  unfold Rdiv in |- *.
+  rewrite <- Rmult_assoc.
+  rewrite Rinv_r_simpl_m.
+  rewrite Rmult_0_r.
+  clear H5; intro H5; apply Rminus_lt; assumption.
+  discrR.
+  elim H5; intro H6.
+  rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4).
+  change (0 < (x - y) / 2) in H6;
+    generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1).
+  rewrite Ropp_involutive.
+  intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7;
+    generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7).
+  rewrite <- double_var.
+  intro H8.
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  generalize
+    (Rmult_le_compat_l (/ 2) (x - y) PI
+      (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8).
+  repeat rewrite (Rmult_comm (/ 2)).
+  intro H9;
+    generalize
+      (sin_gt_0 ((x - y) / 2) H6
+        (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI));
+      intro H10;
+        elim
+          (Rlt_irrefl (sin ((x - y) / 2))
+            (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)).
+  generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3;
+    rewrite form4 in H3;
+      generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2).
+  rewrite <- double_var.
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  intro H4;
+    generalize
+      (Rmult_le_compat_l (/ 2) (x + y) PI
+        (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4).
+  repeat rewrite (Rmult_comm (/ 2)).
+  clear H4; intro H4;
+    generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1);
+      replace (- (PI / 2) + - (PI / 2)) with (- PI).
+  intro H5;
+    generalize
+      (Rmult_le_compat_l (/ 2) (- PI) (x + y)
+        (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5).
+  replace (/ 2 * (x + y)) with ((x + y) / 2).
+  replace (/ 2 * - PI) with (- (PI / 2)).
+  clear H5; intro H5; elim H4; intro H40.
+  elim H5; intro H50.
+  generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6;
+    generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6).
+  rewrite Rmult_0_r.
+  clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7.
+  assumption.
+  generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7;
+    generalize
+      (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2))
+        (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8;
+      generalize
+        (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3);
+        intro H9; elim (Rlt_irrefl 0 H9).
+  rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3;
+    rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3;
+      elim (Rlt_irrefl 0 H3).
+  unfold Rdiv in H3.
+  rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50;
+    rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3;
+      elim (Rlt_irrefl 0 H3).
+  unfold Rdiv in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  apply Rmult_comm.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  pattern PI at 1 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  reflexivity.
+Qed.
+
+Lemma sin_increasing_1 :
+  forall x y:R,
+    - (PI / 2) <= x ->
+    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y.
+Proof.
+  intros; generalize (Rplus_lt_compat_l x x y H3); intro H4;
+    generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H);
+      replace (- (PI / 2) + - (PI / 2)) with (- PI).
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6;
+    generalize
+      (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6);
+      replace (/ 2 * - PI) with (- (PI / 2)).
+  replace (/ 2 * (x + y)) with ((x + y) / 2).
+  clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5;
+    rewrite Rplus_comm in H5;
+      generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2).
+  rewrite <- double_var.
+  intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7;
+    generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7);
+      replace (/ 2 * PI) with (PI / 2).
+  replace (/ 2 * (x + y)) with ((x + y) / 2).
+  clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1);
+    rewrite Ropp_involutive; clear H1; intro H1;
+      generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1;
+        generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2;
+          intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2);
+            clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3);
+              replace (- y + x) with (x - y).
+  rewrite Rplus_opp_l.
+  intro H6;
+    generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6);
+      rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2).
+  clear H6; intro H6;
+    generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2);
+      replace (- (PI / 2) + - (PI / 2)) with (- PI).
+  replace (x + - y) with (x - y).
+  intro H7;
+    generalize
+      (Rmult_le_compat_l (/ 2) (- PI) (x - y)
+        (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7);
+      replace (/ 2 * - PI) with (- (PI / 2)).
+  replace (/ 2 * (x - y)) with ((x - y) / 2).
+  clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4;
+    generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8;
+      generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8);
+        clear H8; intro H8; cut (- PI < - (PI / 2)).
+  intro H9;
+    generalize
+      (sin_lt_0_var ((x - y) / 2)
+        (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6);
+      intro H10;
+        generalize
+          (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 (
+            2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11;
+          rewrite Rmult_comm; assumption.
+  apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm.
+  reflexivity.
+  pattern PI at 1 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  reflexivity.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rminus in |- *; apply Rplus_comm.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rdiv in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  apply Rmult_comm.
+  pattern PI at 1 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  reflexivity.
+Qed.
+
+Lemma sin_decreasing_0 :
+  forall x y:R,
+    x <= 3 * (PI / 2) ->
+    PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x.
+Proof.
+  intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3;
+    generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3);
+      repeat rewrite <- sin_neg;
+        generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
+          generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
+            generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
+              generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
+                replace (- PI + x) with (x - PI).
+  replace (- PI + PI / 2) with (- (PI / 2)).
+  replace (- PI + y) with (y - PI).
+  replace (- PI + 3 * (PI / 2)) with (PI / 2).
+  replace (- (PI - x)) with (x - PI).
+  replace (- (PI - y)) with (y - PI).
+  intros; change (sin (y - PI) < sin (x - PI)) in H8;
+    apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm;
+      replace (y + - PI) with (y - PI).
+  rewrite Rplus_comm; replace (x + - PI) with (x - PI).
+  apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8).
+  reflexivity.
+  reflexivity.
+  unfold Rminus in |- *; rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  apply Rplus_comm.
+  unfold Rminus in |- *; rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  apply Rplus_comm.
+  pattern PI at 2 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  ring.
+  unfold Rminus in |- *; apply Rplus_comm.
+  pattern PI at 2 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  ring.
+  unfold Rminus in |- *; apply Rplus_comm.
+Qed.
+
+Lemma sin_decreasing_1 :
+  forall x y:R,
+    x <= 3 * (PI / 2) ->
+    PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x.
+Proof.
+  intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y);
+    generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
+      generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
+        generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
+          generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
+            generalize (Rplus_lt_compat_l (- PI) x y H3);
+              replace (- PI + PI / 2) with (- (PI / 2)).
+  replace (- PI + y) with (y - PI).
+  replace (- PI + 3 * (PI / 2)) with (PI / 2).
+  replace (- PI + x) with (x - PI).
+  intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg;
+    replace (- (PI - x)) with (x - PI).
+  replace (- (PI - y)) with (y - PI).
+  apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4).
+  unfold Rminus in |- *; rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  apply Rplus_comm.
+  unfold Rminus in |- *; rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  apply Rplus_comm.
+  unfold Rminus in |- *; apply Rplus_comm.
+  pattern PI at 2 in |- *; rewrite double_var; ring.
+  unfold Rminus in |- *; apply Rplus_comm.
+  pattern PI at 2 in |- *; rewrite double_var; ring.
+Qed.
+
+Lemma cos_increasing_0 :
+  forall x y:R,
+    PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y.
+Proof.
+  intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y);
+    rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
+      unfold INR in |- *;
+        replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
+  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
+  repeat rewrite cos_shift; intro H5;
+    generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
+      generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
+        generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
+          generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4).
+  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
+  replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
+  clear H1 H2 H3 H4; intros H1 H2 H3 H4;
+    apply Rplus_lt_reg_r with (-3 * (PI / 2));
+      replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+  apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5).
+  unfold Rminus in |- *.
+  rewrite Ropp_mult_distr_l_reverse.
+  apply Rplus_comm.
+  unfold Rminus in |- *.
+  rewrite Ropp_mult_distr_l_reverse.
+  apply Rplus_comm.
+  pattern PI at 3 in |- *; rewrite double_var.
+  ring.
+  rewrite double; pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  unfold Rminus in |- *.
+  rewrite Ropp_mult_distr_l_reverse.
+  apply Rplus_comm.
+  unfold Rminus in |- *.
+  rewrite Ropp_mult_distr_l_reverse.
+  apply Rplus_comm.
+  rewrite Rmult_1_r.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  rewrite Rmult_1_r.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+Qed.
+
+Lemma cos_increasing_1 :
+  forall x y:R,
+    PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y.
+Proof.
+  intros x y H1 H2 H3 H4 H5;
+    generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
+      generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
+        generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
+          generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4);
+            generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5);
+              rewrite <- (cos_neg x); rewrite <- (cos_neg y);
+                rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
+                  unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
+  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
+  clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5;
+    replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
+  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
+  repeat rewrite cos_shift;
+    apply
+      (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1).
+  rewrite Rmult_1_r.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  rewrite Rmult_1_r.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  pattern PI at 3 in |- *; rewrite double_var; ring.
+  unfold Rminus in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  apply Rplus_comm.
+  unfold Rminus in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  apply Rplus_comm.
+Qed.
+
+Lemma cos_decreasing_0 :
+  forall x y:R,
+    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x.
+Proof.
+  intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3);
+    repeat rewrite <- neg_cos; intro H4;
+      change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4;
+        rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H);
+          generalize (Rplus_le_compat_l PI x PI H0);
+            generalize (Rplus_le_compat_l PI 0 y H1);
+              generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
+  rewrite <- double.
+  clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI;
+    apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4).
+Qed.
+
+Lemma cos_decreasing_1 :
+  forall x y:R,
+    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x.
+Proof.
+  intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos;
+    rewrite (Rplus_comm x); rewrite (Rplus_comm y);
+      generalize (Rplus_le_compat_l PI 0 x H);
+        generalize (Rplus_le_compat_l PI x PI H0);
+          generalize (Rplus_le_compat_l PI 0 y H1);
+            generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
+  rewrite <- double.
+  generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros;
+    apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H).
+Qed.
+
+Lemma tan_diff :
+  forall x y:R,
+    cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y).
+Proof.
+  intros; unfold tan in |- *; rewrite sin_minus.
+  unfold Rdiv in |- *.
+  unfold Rminus in |- *.
+  rewrite Rmult_plus_distr_r.
+  rewrite Rinv_mult_distr.
+  repeat rewrite (Rmult_comm (sin x)).
+  repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm (cos y)).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm (sin x)).
+  apply Rplus_eq_compat_l.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  rewrite <- Ropp_mult_distr_r_reverse.
+  rewrite (Rmult_comm (/ cos x)).
+  repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm (cos x)).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  reflexivity.
+  assumption.
+  assumption.
+  assumption.
+  assumption.
+Qed.
+
+Lemma tan_increasing_0 :
+  forall x y:R,
+    - (PI / 4) <= x ->
+    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y.
+Proof.
+  intros; generalize PI4_RLT_PI2; intro H4;
+    generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4);
+      intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
+        generalize
+          (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+            (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
+          generalize
+            (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+              (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
+            generalize
+              (not_eq_sym
+                (Rlt_not_eq 0 (cos x)
+                  (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+                    (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4))));
+              intro H6;
+                generalize
+                  (not_eq_sym
+                    (Rlt_not_eq 0 (cos y)
+                      (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+                        (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4))));
+                  intro H7; generalize (tan_diff x y H6 H7); intro H8;
+                    generalize (Rlt_minus (tan x) (tan y) H3); clear H3;
+                      intro H3; rewrite H8 in H3; cut (sin (x - y) < 0).
+  intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1);
+    rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10);
+      clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
+        intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11);
+          clear H11; intro H11;
+            generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
+              generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10);
+                replace (x + - y) with (x - y).
+  replace (PI / 4 + PI / 4) with (PI / 2).
+  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
+  intros; case (Rtotal_order 0 (x - y)); intro H14.
+  generalize
+    (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI));
+    intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)).
+  elim H14; intro H15.
+  rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9).
+  apply Rminus_lt; assumption.
+  pattern PI at 1 in |- *; rewrite double_var.
+  unfold Rdiv in |- *.
+  rewrite Rmult_plus_distr_r.
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_mult_distr.
+  rewrite Ropp_plus_distr.
+  replace 4 with 4.
+  reflexivity.
+  ring.
+  discrR.
+  discrR.
+  pattern PI at 1 in |- *; rewrite double_var.
+  unfold Rdiv in |- *.
+  rewrite Rmult_plus_distr_r.
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_mult_distr.
+  replace 4 with 4.
+  reflexivity.
+  ring.
+  discrR.
+  discrR.
+  reflexivity.
+  case (Rcase_abs (sin (x - y))); intro H9.
+  assumption.
+  generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9;
+    generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
+      generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
+        generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
+          replace (/ cos x * / cos y) with (/ (cos x * cos y)).
+  intro H12;
+    generalize
+      (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9
+        (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13;
+      elim
+        (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)).
+  rewrite Rinv_mult_distr.
+  reflexivity.
+  assumption.
+  assumption.
+Qed.
+
+Lemma tan_increasing_1 :
+  forall x y:R,
+    - (PI / 4) <= x ->
+    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y.
+Proof.
+  intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4;
+    generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4);
+      intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
+        generalize
+          (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+            (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
+          generalize
+            (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+              (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
+            generalize
+              (not_eq_sym
+                (Rlt_not_eq 0 (cos x)
+                  (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+                    (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4))));
+              intro H6;
+                generalize
+                  (not_eq_sym
+                    (Rlt_not_eq 0 (cos y)
+                      (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+                        (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4))));
+                  intro H7; rewrite (tan_diff x y H6 H7);
+                    generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
+                      generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
+                        generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
+                          replace (/ cos x * / cos y) with (/ (cos x * cos y)).
+  clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
+    intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11);
+      clear H11; intro H11;
+        generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
+          replace (x + - y) with (x - y).
+  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
+  clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3;
+    clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI;
+      intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1);
+        clear H1; intro H1;
+          generalize
+            (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3);
+            intro H2;
+              generalize
+                (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8);
+                rewrite Rmult_0_r; intro H4; assumption.
+  pattern PI at 1 in |- *; rewrite double_var.
+  unfold Rdiv in |- *.
+  rewrite Rmult_plus_distr_r.
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_mult_distr.
+  replace 4 with 4.
+  rewrite Ropp_plus_distr.
+  reflexivity.
+  ring.
+  discrR.
+  discrR.
+  reflexivity.
+  apply Rinv_mult_distr; assumption.
+Qed.
+
+Lemma sin_incr_0 :
+  forall x y:R,
+    - (PI / 2) <= x ->
+    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y.
+Proof.
+  intros; case (Rtotal_order (sin x) (sin y)); intro H4;
+    [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ]
+          | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
+Qed.
+
+Lemma sin_incr_1 :
+  forall x y:R,
+    - (PI / 2) <= x ->
+    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (sin x) (sin y)); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+Qed.
+
+Lemma sin_decr_0 :
+  forall x y:R,
+    x <= 3 * (PI / 2) ->
+    PI / 2 <= x ->
+    y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x.
+Proof.
+  intros; case (Rtotal_order (sin x) (sin y)); intro H4;
+    [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8;
+            rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8)
+            | elim H6; intro H7;
+              [ right; symmetry  in |- *; assumption | left; assumption ] ]
+          | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
+Qed.
+
+Lemma sin_decr_1 :
+  forall x y:R,
+    x <= 3 * (PI / 2) ->
+    PI / 2 <= x ->
+    y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (sin x) (sin y)); intro H6;
+          [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8;
+            rewrite H5 in H8; elim (Rlt_irrefl y H8)
+            | elim H6; intro H7;
+              [ right; symmetry  in |- *; assumption | left; assumption ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+Qed.
+
+Lemma cos_incr_0 :
+  forall x y:R,
+    PI <= x ->
+    x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y.
+Proof.
+  intros; case (Rtotal_order (cos x) (cos y)); intro H4;
+    [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ]
+          | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
+Qed.
+
+Lemma cos_incr_1 :
+  forall x y:R,
+    PI <= x ->
+    x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (cos x) (cos y)); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+Qed.
+
+Lemma cos_decr_0 :
+  forall x y:R,
+    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x.
+Proof.
+  intros; case (Rtotal_order (cos x) (cos y)); intro H4;
+    [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8;
+            rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8)
+            | elim H6; intro H7;
+              [ right; symmetry  in |- *; assumption | left; assumption ] ]
+          | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
+Qed.
+
+Lemma cos_decr_1 :
+  forall x y:R,
+    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (cos x) (cos y)); intro H6;
+          [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8;
+            rewrite H5 in H8; elim (Rlt_irrefl y H8)
+            | elim H6; intro H7;
+              [ right; symmetry  in |- *; assumption | left; assumption ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+Qed.
+
+Lemma tan_incr_0 :
+  forall x y:R,
+    - (PI / 4) <= x ->
+    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y.
+Proof.
+  intros; case (Rtotal_order (tan x) (tan y)); intro H4;
+    [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ]
+          | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ].
+Qed.
+
+Lemma tan_incr_1 :
+  forall x y:R,
+    - (PI / 4) <= x ->
+    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (tan x) (tan y)); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+Qed.
+
+(**********)
+Lemma sin_eq_0_1 : forall x:R, (exists k : Z, x = IZR k * PI) -> sin x = 0.
+Proof.
+  intros.
+  elim H; intros.
+  apply (Zcase_sign x0).
+  intro.
+  rewrite H1 in H0.
+  simpl in H0.
+  rewrite H0; rewrite Rmult_0_l; apply sin_0.
+  intro.
+  cut (0 <= x0)%Z.
+  intro.
+  elim (IZN x0 H2); intros.
+  rewrite H3 in H0.
+  rewrite <- INR_IZR_INZ in H0.
+  rewrite H0.
+  elim (even_odd_cor x1); intros.
+  elim H4; intro.
+  rewrite H5.
+  rewrite mult_INR.
+  simpl in |- *.
+  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite sin_period.
+  apply sin_0.
+  rewrite H5.
+  rewrite S_INR; rewrite mult_INR.
+  simpl in |- *.
+  rewrite Rmult_plus_distr_r.
+  rewrite Rmult_1_l; rewrite sin_plus.
+  rewrite sin_PI.
+  rewrite Rmult_0_r.
+  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite sin_period.
+  rewrite sin_0; ring.
+  apply le_IZR.
+  left; apply IZR_lt.
+  assert (H2 := Z.gt_lt_iff).
+  elim (H2 x0 0%Z); intros.
+  apply H3; assumption.
+  intro.
+  rewrite H0.
+  replace (sin (IZR x0 * PI)) with (- sin (- IZR x0 * PI)).
+  cut (0 <= - x0)%Z.
+  intro.
+  rewrite <- Ropp_Ropp_IZR.
+  elim (IZN (- x0) H2); intros.
+  rewrite H3.
+  rewrite <- INR_IZR_INZ.
+  elim (even_odd_cor x1); intros.
+  elim H4; intro.
+  rewrite H5.
+  rewrite mult_INR.
+  simpl in |- *.
+  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite sin_period.
+  rewrite sin_0; ring.
+  rewrite H5.
+  rewrite S_INR; rewrite mult_INR.
+  simpl in |- *.
+  rewrite Rmult_plus_distr_r.
+  rewrite Rmult_1_l; rewrite sin_plus.
+  rewrite sin_PI.
+  rewrite Rmult_0_r.
+  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite sin_period.
+  rewrite sin_0; ring.
+  apply le_IZR.
+  apply Rplus_le_reg_l with (IZR x0).
+  rewrite Rplus_0_r.
+  rewrite Ropp_Ropp_IZR.
+  rewrite Rplus_opp_r.
+  left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ].
+  assumption.
+  rewrite <- sin_neg.
+  rewrite Ropp_mult_distr_l_reverse.
+  rewrite Ropp_involutive.
+  reflexivity.
+Qed.
+
+Lemma sin_eq_0_0 (x:R) : sin x = 0 ->  exists k : Z, x = IZR k * PI.
+Proof.
+  intros Hx.
+  destruct (euclidian_division x PI PI_neq0) as (q & r & EQ & Hr & Hr').
+  exists q.
+  rewrite <- (Rplus_0_r (_*_)). subst. apply Rplus_eq_compat_l.
+  rewrite sin_plus in Hx.
+  assert (H : sin (IZR q * PI) = 0) by (apply sin_eq_0_1; now exists q).
+  rewrite H, Rmult_0_l, Rplus_0_l in Hx.
+  destruct (Rmult_integral _ _ Hx) as [H'|H'].
+  - exfalso.
+    generalize (sin2_cos2 (IZR q * PI)).
+    rewrite H, H', Rsqr_0, Rplus_0_l.
+    intros; now apply R1_neq_R0.
+  - rewrite Rabs_right in Hr'; [|left; apply PI_RGT_0].
+    destruct Hr as [Hr | ->]; trivial.
+    exfalso.
+    generalize (sin_gt_0 r Hr Hr'). rewrite H'. apply Rlt_irrefl.
+Qed.
+
+Lemma cos_eq_0_0 (x:R) :
+  cos x = 0 ->  exists k : Z, x = IZR k * PI + PI / 2.
+Proof.
+  rewrite cos_sin. intros Hx.
+  destruct (sin_eq_0_0 (PI/2 + x) Hx) as (k,Hk). clear Hx.
+  exists (k-1)%Z. rewrite <- Z_R_minus; simpl.
+  symmetry in Hk. field_simplify [Hk]. field.
+Qed.
+
+Lemma cos_eq_0_1 (x:R) :
+  (exists k : Z, x = IZR k * PI + PI / 2) -> cos x = 0.
+Proof.
+  rewrite cos_sin. intros (k,->).
+  replace (_ + _) with (IZR k * PI + PI) by field.
+  rewrite neg_sin, <- Ropp_0. apply Ropp_eq_compat.
+  apply sin_eq_0_1. now exists k.
+Qed.
+
+Lemma sin_eq_O_2PI_0 (x:R) :
+  0 <= x -> x <= 2 * PI -> sin x = 0 ->
+  x = 0 \/ x = PI \/ x = 2 * PI.
+Proof.
+  intros Lo Hi Hx. destruct (sin_eq_0_0 x Hx) as (k,Hk). clear Hx.
+  destruct (Rtotal_order PI x) as [Hx|[Hx|Hx]].
+  - right; right.
+    clear Lo. subst.
+    f_equal. change 2 with (IZR (- (-2))). f_equal.
+    apply Z.add_move_0_l.
+    apply one_IZR_lt1.
+    rewrite plus_IZR; simpl.
+    split.
+    + replace (-1) with (-2 + 1) by ring.
+      apply Rplus_lt_compat_l.
+      apply Rmult_lt_reg_r with PI; [apply PI_RGT_0|].
+      now rewrite Rmult_1_l.
+    + apply Rle_lt_trans with 0; [|apply Rlt_0_1].
+      replace 0 with (-2 + 2) by ring.
+      apply Rplus_le_compat_l.
+      apply Rmult_le_reg_r with PI; [apply PI_RGT_0|].
+      trivial.
+  - right; left; auto.
+  - left.
+    clear Hi. subst.
+    replace 0 with (IZR 0 * PI) by (simpl; ring). f_equal. f_equal.
+    apply one_IZR_lt1.
+    split.
+    + apply Rlt_le_trans with 0;
+       [rewrite <- Ropp_0; apply Ropp_gt_lt_contravar, Rlt_0_1 | ].
+      apply Rmult_le_reg_r with PI; [apply PI_RGT_0|].
+      now rewrite Rmult_0_l.
+    + apply Rmult_lt_reg_r with PI; [apply PI_RGT_0|].
+      now rewrite Rmult_1_l.
+Qed.
+
+Lemma sin_eq_O_2PI_1 (x:R) :
+  0 <= x -> x <= 2 * PI ->
+  x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0.
+Proof.
+  intros _ _ [ -> |[ -> | -> ]].
+  - now rewrite sin_0.
+  - now rewrite sin_PI.
+  - now rewrite sin_2PI.
+Qed.
+
+Lemma cos_eq_0_2PI_0 (x:R) :
+  0 <= x -> x <= 2 * PI -> cos x = 0 ->
+  x = PI / 2 \/ x = 3 * (PI / 2).
+Proof.
+  intros Lo Hi Hx.
+  destruct (Rtotal_order x (3 * (PI / 2))) as [LT|[EQ|GT]].
+  - rewrite cos_sin in Hx.
+    assert (Lo' : 0 <= PI / 2 + x).
+    { apply Rplus_le_le_0_compat. apply Rlt_le, PI2_RGT_0. trivial. }
+    assert (Hi' : PI / 2 + x <= 2 * PI).
+    { apply Rlt_le.
+      replace (2 * PI) with (PI / 2 + 3 * (PI / 2)) by field.
+      now apply Rplus_lt_compat_l. }
+    destruct (sin_eq_O_2PI_0 (PI / 2 + x) Lo' Hi' Hx) as [H|[H|H]].
+    + exfalso.
+      apply (Rplus_le_compat_l (PI/2)) in Lo.
+      rewrite Rplus_0_r, H in Lo.
+      apply (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 Lo)).
+    + left.
+      apply (Rplus_eq_compat_l (-(PI/2))) in H.
+      ring_simplify in H. rewrite H. field.
+    + right.
+      apply (Rplus_eq_compat_l (-(PI/2))) in H.
+      ring_simplify in H. rewrite H. field.
+  - now right.
+  - exfalso.
+    destruct (cos_eq_0_0 x Hx) as (k,Hk). clear Hx Lo.
+    subst.
+    assert (LT : (k < 2)%Z).
+    { apply lt_IZR. simpl.
+      apply (Rmult_lt_reg_r PI); [apply PI_RGT_0|].
+      apply Rlt_le_trans with (IZR k * PI + PI/2); trivial.
+      rewrite <- (Rplus_0_r (IZR k * PI)) at 1.
+      apply Rplus_lt_compat_l. apply PI2_RGT_0. }
+    assert (GT' : (1 < k)%Z).
+    { apply lt_IZR. simpl.
+      apply (Rmult_lt_reg_r PI); [apply PI_RGT_0|rewrite Rmult_1_l].
+      replace (3*(PI/2)) with (PI/2 + PI) in GT by field.
+      rewrite Rplus_comm in GT.
+      now apply Rplus_lt_reg_r in GT. }
+    omega.
+Qed.
+
+Lemma cos_eq_0_2PI_1 (x:R) :
+  0 <= x -> x <= 2 * PI ->
+  x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0.
+Proof.
+ intros Lo Hi [ -> | -> ].
+ - now rewrite cos_PI2.
+ - now rewrite cos_3PI2.
+Qed.
diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v
index de984415..23b8e847 100644
--- a/theories/Reals/Rtrigo_alt.v
+++ b/theories/Reals/Rtrigo_alt.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtrigo_alt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
 Require Import Rtrigo_def.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (***************************************************************)
 (** Using series definitions of cos and sin                    *)
@@ -29,7 +27,8 @@ Definition sin_approx (a:R) (n:nat) : R := sum_f_R0 (sin_term a) n.
 Definition cos_approx (a:R) (n:nat) : R := sum_f_R0 (cos_term a) n.
 
 (**********)
-Lemma PI_4 : PI <= 4.
+(*
+Lemma Alt_PI_4 : Alt_PI <= 4.
 Proof.
   assert (H0 := PI_ineq 0).
   elim H0; clear H0; intros _ H0.
@@ -39,20 +38,20 @@ Proof.
   apply Rinv_0_lt_compat; prove_sup0.
   rewrite <- Rinv_l_sym; [ rewrite Rmult_comm; assumption | discrR ].
 Qed.
-
+*)
 (**********)
-Theorem sin_bound :
+Theorem pre_sin_bound :
   forall (a:R) (n:nat),
     0 <= a ->
-    a <= PI -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)).
+    a <= 4 -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)).
 Proof.
   intros; case (Req_dec a 0); intro Hyp_a.
-  rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx in |- *;
-    apply sum_eq_R0 || (symmetry  in |- *; apply sum_eq_R0);
-      intros; unfold sin_term in |- *; rewrite pow_add;
-        simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l;
+  rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx;
+    apply sum_eq_R0 || (symmetry ; apply sum_eq_R0);
+      intros; unfold sin_term; rewrite pow_add;
+        simpl; unfold Rdiv; rewrite Rmult_0_l;
           ring.
-  unfold sin_approx in |- *; cut (0 < a).
+  unfold sin_approx; cut (0 < a).
   intro Hyp_a_pos.
   rewrite (decomp_sum (sin_term a) (2 * n + 1)).
   rewrite (decomp_sum (sin_term a) (2 * (n + 1))).
@@ -77,22 +76,22 @@ Proof.
       - sum_f_R0 (tg_alt Un) (S (2 * n))).
   intro; apply H2.
   apply alternated_series_ineq.
-  unfold Un_decreasing, Un in |- *; intro;
+  unfold Un_decreasing, Un; intro;
     cut ((2 * S (S n0) + 1)%nat = S (S (2 * S n0 + 1))).
   intro; rewrite H3.
   replace (a ^ S (S (2 * S n0 + 1))) with (a ^ (2 * S n0 + 1) * (a * a)).
-  unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  unfold Rdiv; rewrite Rmult_assoc; apply Rmult_le_compat_l.
   left; apply pow_lt; assumption.
   apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n0 + 1))))).
-  rewrite <- H3; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
-    assert (H5 := sym_eq H4); elim (fact_neq_0 _ H5).
+  rewrite <- H3; apply lt_INR_0; apply neq_O_lt; red; intro;
+    assert (H5 := eq_sym H4); elim (fact_neq_0 _ H5).
   rewrite <- H3; rewrite (Rmult_comm (INR (fact (2 * S (S n0) + 1))));
     rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r; rewrite H3; do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
     repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
   rewrite Rmult_1_r.
   do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR;
-    simpl in |- *;
+    simpl;
       replace
       (((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1 + 1) *
         ((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1)) with
@@ -102,12 +101,12 @@ Proof.
   replace 16 with (Rsqr 4); [ idtac | ring_Rsqr ].
   replace (a * a) with (Rsqr a); [ idtac | reflexivity ].
   apply Rsqr_incr_1.
-  apply Rle_trans with PI; [ assumption | apply PI_4 ].
+  assumption.
   assumption.
   left; prove_sup0.
   rewrite <- (Rplus_0_r 16); replace 20 with (16 + 4);
     [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
-  rewrite <- (Rplus_comm 20); pattern 20 at 1 in |- *; rewrite <- Rplus_0_r;
+  rewrite <- (Rplus_comm 20); pattern 20 at 1; rewrite <- Rplus_0_r;
     apply Rplus_le_compat_l.
   apply Rplus_le_le_0_compat.
   repeat apply Rmult_le_pos.
@@ -120,14 +119,14 @@ Proof.
   replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
-  simpl in |- *; ring.
+  simpl; ring.
   ring.
-  assert (H3 := cv_speed_pow_fact a); unfold Un in |- *; unfold Un_cv in H3;
-    unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *;
+  assert (H3 := cv_speed_pow_fact a); unfold Un; unfold Un_cv in H3;
+    unfold R_dist in H3; unfold Un_cv; unfold R_dist;
       intros; elim (H3 eps H4); intros N H5.
   exists N; intros; apply H5.
   replace (2 * S n0 + 1)%nat with (S (2 * S n0)).
-  unfold ge in |- *; apply le_trans with (2 * S n0)%nat.
+  unfold ge; apply le_trans with (2 * S n0)%nat.
   apply le_trans with (2 * S N)%nat.
   apply le_trans with (2 * N)%nat.
   apply le_n_2n.
@@ -138,49 +137,49 @@ Proof.
   assert (X := exist_sin (Rsqr a)); elim X; intros.
   cut (x = sin a / a).
   intro; rewrite H3 in p; unfold sin_in in p; unfold infinite_sum in p;
-    unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *;
+    unfold R_dist in p; unfold Un_cv; unfold R_dist;
       intros.
   cut (0 < eps / Rabs a).
   intro; elim (p _ H5); intros N H6.
   exists N; intros.
   replace (sum_f_R0 (tg_alt Un) n0) with
   (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))).
-  unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
+  unfold Rminus; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
     rewrite Ropp_plus_distr; rewrite Ropp_involutive;
       repeat rewrite Rplus_assoc; rewrite (Rplus_comm a);
         rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc;
           rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a).
   apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-  pattern (/ Rabs a) at 1 in |- *; rewrite <- (Rabs_Rinv a Hyp_a).
+  pattern (/ Rabs a) at 1; rewrite <- (Rabs_Rinv a Hyp_a).
   rewrite <- Rabs_mult; rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc;
     rewrite <- Rinv_l_sym; [ rewrite Rmult_1_l | assumption ];
       rewrite (Rmult_comm (/ a)); rewrite (Rmult_comm (/ Rabs a));
         rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
-          unfold Rminus, Rdiv in H6; apply H6; unfold ge in |- *;
+          unfold Rminus, Rdiv in H6; apply H6; unfold ge;
             apply le_trans with n0; [ exact H7 | apply le_n_Sn ].
   rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)).
   replace (sin_n 0) with 1.
-  simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *;
+  simpl; rewrite Rmult_1_r; unfold Rminus;
     rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
       rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse;
         rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum;
           apply sum_eq.
-  intros; unfold sin_n, Un, tg_alt in |- *;
+  intros; unfold sin_n, Un, tg_alt;
     replace ((-1) ^ S i) with (- (-1) ^ i).
   replace (a ^ (2 * S i + 1)) with (Rsqr a * Rsqr a ^ i * a).
-  unfold Rdiv in |- *; ring.
-  rewrite pow_add; rewrite pow_Rsqr; simpl in |- *; ring.
-  simpl in |- *; ring.
-  unfold sin_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1;
+  unfold Rdiv; ring.
+  rewrite pow_add; rewrite pow_Rsqr; simpl; ring.
+  simpl; ring.
+  unfold sin_n; unfold Rdiv; simpl; rewrite Rinv_1;
     rewrite Rmult_1_r; reflexivity.
   apply lt_O_Sn.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   assumption.
   apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-  unfold sin in |- *; case (exist_sin (Rsqr a)).
+  unfold sin; case (exist_sin (Rsqr a)).
   intros; cut (x = x0).
-  intro; rewrite H3; unfold Rdiv in |- *.
-  symmetry  in |- *; apply Rinv_r_simpl_m; assumption.
+  intro; rewrite H3; unfold Rdiv.
+  symmetry ; apply Rinv_r_simpl_m; assumption.
   unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum.
   apply p.
   apply s.
@@ -189,16 +188,16 @@ Proof.
   split; apply Ropp_le_contravar; assumption.
   replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with
   (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ].
-  apply sum_eq; intros; unfold sin_term, Un, tg_alt in |- *;
+  apply sum_eq; intros; unfold sin_term, Un, tg_alt;
     replace ((-1) ^ S i) with (-1 * (-1) ^ i).
-  unfold Rdiv in |- *; ring.
+  unfold Rdiv; ring.
   reflexivity.
   replace (- sum_f_R0 (tg_alt Un) (2 * n)) with
   (-1 * sum_f_R0 (tg_alt Un) (2 * n)); [ rewrite scal_sum | ring ].
   apply sum_eq; intros.
-  unfold sin_term, Un, tg_alt in |- *;
+  unfold sin_term, Un, tg_alt;
     replace ((-1) ^ S i) with (-1 * (-1) ^ i).
-  unfold Rdiv in |- *; ring.
+  unfold Rdiv; ring.
   reflexivity.
   replace (2 * (n + 1))%nat with (S (S (2 * n))).
   reflexivity.
@@ -214,7 +213,7 @@ Proof.
   apply Rplus_le_reg_l with (- a).
   rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
     rewrite (Rplus_comm (- a)); apply H3.
-  unfold sin_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1;
+  unfold sin_term; simpl; unfold Rdiv; rewrite Rinv_1;
     ring.
   replace (2 * (n + 1))%nat with (S (S (2 * n))).
   apply lt_O_Sn.
@@ -222,27 +221,26 @@ Proof.
   replace (2 * n + 1)%nat with (S (2 * n)).
   apply lt_O_Sn.
   ring.
-  inversion H; [ assumption | elim Hyp_a; symmetry  in |- *; assumption ].
+  inversion H; [ assumption | elim Hyp_a; symmetry ; assumption ].
 Qed.
 
 (**********)
-Lemma cos_bound :
+Lemma pre_cos_bound :
   forall (a:R) (n:nat),
-    - PI / 2 <= a ->
-    a <= PI / 2 ->
+    - 2 <= a -> a <= 2 ->
     cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)).
 Proof.
   cut
     ((forall (a:R) (n:nat),
       0 <= a ->
-      a <= PI / 2 ->
+      a <= 2 ->
       cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))) ->
     forall (a:R) (n:nat),
-      - PI / 2 <= a ->
-      a <= PI / 2 ->
+      - 2 <= a ->
+      a <= 2 ->
       cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))).
   intros H a n; apply H.
-  intros; unfold cos_approx in |- *.
+  intros; unfold cos_approx.
   rewrite (decomp_sum (cos_term a0) (2 * n0 + 1)).
   rewrite (decomp_sum (cos_term a0) (2 * (n0 + 1))).
   replace (cos_term a0 0) with 1.
@@ -268,21 +266,21 @@ Proof.
       - sum_f_R0 (tg_alt Un) (S (2 * n0))).
   intro; apply H3.
   apply alternated_series_ineq.
-  unfold Un_decreasing in |- *; intro; unfold Un in |- *.
+  unfold Un_decreasing; intro; unfold Un.
   cut ((2 * S (S n1))%nat = S (S (2 * S n1))).
   intro; rewrite H4;
     replace (a0 ^ S (S (2 * S n1))) with (a0 ^ (2 * S n1) * (a0 * a0)).
-  unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  unfold Rdiv; rewrite Rmult_assoc; apply Rmult_le_compat_l.
   apply pow_le; assumption.
   apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n1))))).
-  rewrite <- H4; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
-    assert (H6 := sym_eq H5); elim (fact_neq_0 _ H6).
+  rewrite <- H4; apply lt_INR_0; apply neq_O_lt; red; intro;
+    assert (H6 := eq_sym H5); elim (fact_neq_0 _ H6).
   rewrite <- H4; rewrite (Rmult_comm (INR (fact (2 * S (S n1)))));
     rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r; rewrite H4; do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
     repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
   rewrite Rmult_1_r; do 2 rewrite S_INR; rewrite mult_INR; repeat rewrite S_INR;
-    simpl in |- *;
+    simpl;
       replace
       (((0 + 1 + 1) * (INR n1 + 1) + 1 + 1) * ((0 + 1 + 1) * (INR n1 + 1) + 1))
     with (4 * INR n1 * INR n1 + 14 * INR n1 + 12); [ idtac | ring ].
@@ -291,18 +289,13 @@ Proof.
   replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ].
   replace (a0 * a0) with (Rsqr a0); [ idtac | reflexivity ].
   apply Rsqr_incr_1.
-  apply Rle_trans with (PI / 2).
   assumption.
-  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
-  prove_sup0.
-  rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m.
-  replace 4 with 4; [ apply PI_4 | ring ].
   discrR.
   assumption.
   left; prove_sup0.
-  pattern 4 at 1 in |- *; rewrite <- Rplus_0_r; replace 12 with (4 + 8);
+  pattern 4 at 1; rewrite <- Rplus_0_r; replace 12 with (4 + 8);
     [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
-  rewrite <- (Rplus_comm 12); pattern 12 at 1 in |- *; rewrite <- Rplus_0_r;
+  rewrite <- (Rplus_comm 12); pattern 12 at 1; rewrite <- Rplus_0_r;
     apply Rplus_le_compat_l.
   apply Rplus_le_le_0_compat.
   repeat apply Rmult_le_pos.
@@ -315,12 +308,12 @@ Proof.
   replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
   apply INR_fact_neq_0.
   apply INR_fact_neq_0.
-  simpl in |- *; ring.
+  simpl; ring.
   ring.
-  assert (H4 := cv_speed_pow_fact a0); unfold Un in |- *; unfold Un_cv in H4;
-    unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *;
+  assert (H4 := cv_speed_pow_fact a0); unfold Un; unfold Un_cv in H4;
+    unfold R_dist in H4; unfold Un_cv; unfold R_dist;
       intros; elim (H4 eps H5); intros N H6; exists N; intros.
-  apply H6; unfold ge in |- *; apply le_trans with (2 * S N)%nat.
+  apply H6; unfold ge; apply le_trans with (2 * S N)%nat.
   apply le_trans with (2 * N)%nat.
   apply le_n_2n.
   apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn.
@@ -328,40 +321,40 @@ Proof.
   assert (X := exist_cos (Rsqr a0)); elim X; intros.
   cut (x = cos a0).
   intro; rewrite H4 in p; unfold cos_in in p; unfold infinite_sum in p;
-    unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *;
+    unfold R_dist in p; unfold Un_cv; unfold R_dist;
       intros.
   elim (p _ H5); intros N H6.
   exists N; intros.
   replace (sum_f_R0 (tg_alt Un) n1) with
   (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
-  unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+  unfold Rminus; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
     repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1);
       rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc;
         rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp;
           rewrite Ropp_plus_distr; rewrite Ropp_involutive;
             unfold Rminus in H6; apply H6.
-  unfold ge in |- *; apply le_trans with n1.
+  unfold ge; apply le_trans with n1.
   exact H7.
   apply le_n_Sn.
   rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
   replace (cos_n 0) with 1.
-  simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *;
+  simpl; rewrite Rmult_1_r; unfold Rminus;
     rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
       rewrite Rplus_0_l;
         replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1)
     with
       (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1);
       [ idtac | ring ]; rewrite scal_sum; apply sum_eq;
-        intros; unfold cos_n, Un, tg_alt in |- *.
+        intros; unfold cos_n, Un, tg_alt.
   replace ((-1) ^ S i) with (- (-1) ^ i).
   replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i).
-  unfold Rdiv in |- *; ring.
+  unfold Rdiv; ring.
   rewrite pow_Rsqr; reflexivity.
-  simpl in |- *; ring.
-  unfold cos_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1;
+  simpl; ring.
+  unfold cos_n; unfold Rdiv; simpl; rewrite Rinv_1;
     rewrite Rmult_1_r; reflexivity.
   apply lt_O_Sn.
-  unfold cos in |- *; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p;
+  unfold cos; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p;
     unfold cos_in in c; eapply uniqueness_sum.
   apply p.
   apply c.
@@ -370,15 +363,15 @@ Proof.
   split; apply Ropp_le_contravar; assumption.
   replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with
   (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ].
-  apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *;
+  apply sum_eq; intros; unfold cos_term, Un, tg_alt;
     replace ((-1) ^ S i) with (-1 * (-1) ^ i).
-  unfold Rdiv in |- *; ring.
+  unfold Rdiv; ring.
   reflexivity.
   replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with
   (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ];
-  apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *;
+  apply sum_eq; intros; unfold cos_term, Un, tg_alt;
     replace ((-1) ^ S i) with (-1 * (-1) ^ i).
-  unfold Rdiv in |- *; ring.
+  unfold Rdiv; ring.
   reflexivity.
   replace (2 * (n0 + 1))%nat with (S (S (2 * n0))).
   reflexivity.
@@ -393,7 +386,7 @@ Proof.
   apply Rplus_le_reg_l with (-1).
   rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
     rewrite (Rplus_comm (-1)); apply H4.
-  unfold cos_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1;
+  unfold cos_term; simpl; unfold Rdiv; rewrite Rinv_1;
     ring.
   replace (2 * (n0 + 1))%nat with (S (S (2 * n0))).
   apply lt_O_Sn.
@@ -409,11 +402,9 @@ Proof.
   intro; cut (forall (x:R) (n:nat), cos_approx x n = cos_approx (- x) n).
   intro; rewrite H3; rewrite (H3 a (2 * (n + 1))%nat); rewrite cos_sym; apply H.
   left; assumption.
-  rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_le_contravar;
-    unfold Rdiv in |- *; unfold Rdiv in H0; rewrite <- Ropp_mult_distr_l_reverse;
-      exact H0.
-  intros; unfold cos_approx in |- *; apply sum_eq; intros;
-    unfold cos_term in |- *; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg;
-      unfold Rdiv in |- *; reflexivity.
+  rewrite <- (Ropp_involutive 2); apply Ropp_le_contravar; exact H0.
+  intros; unfold cos_approx; apply sum_eq; intros;
+    unfold cos_term; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg;
+      unfold Rdiv; reflexivity.
   apply Ropp_0_gt_lt_contravar; assumption.
 Qed.
diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v
index e5263f9c..a1a3b007 100644
--- a/theories/Reals/Rtrigo_calc.v
+++ b/theories/Reals/Rtrigo_calc.v
@@ -1,23 +1,21 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtrigo_calc.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
-Require Import Rtrigo.
+Require Import Rtrigo1.
 Require Import R_sqrt.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 Lemma tan_PI : tan PI = 0.
 Proof.
-  unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *;
+  unfold tan; rewrite sin_PI; rewrite cos_PI; unfold Rdiv;
     apply Rmult_0_l.
 Qed.
 
@@ -25,12 +23,12 @@ Lemma sin_3PI2 : sin (3 * (PI / 2)) = -1.
 Proof.
   replace (3 * (PI / 2)) with (PI + PI / 2).
   rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; rewrite sin_PI2; ring.
-  pattern PI at 1 in |- *; rewrite (double_var PI); ring.
+  pattern PI at 1; rewrite (double_var PI); ring.
 Qed.
 
 Lemma tan_2PI : tan (2 * PI) = 0.
 Proof.
-  unfold tan in |- *; rewrite sin_2PI; unfold Rdiv in |- *; apply Rmult_0_l.
+  unfold tan; rewrite sin_2PI; unfold Rdiv; apply Rmult_0_l.
 Qed.
 
 Lemma sin_cos_PI4 : sin (PI / 4) = cos (PI / 4).
@@ -39,9 +37,9 @@ Proof with trivial.
   replace (PI / 2 + PI / 4) with (- (PI / 4) + PI)...
   rewrite neg_sin; rewrite sin_neg; ring...
   cut (PI = PI / 2 + PI / 2); [ intro | apply double_var ]...
-  pattern PI at 2 3 in |- *; rewrite H; pattern PI at 2 3 in |- *; rewrite H...
+  pattern PI at 2 3; rewrite H; pattern PI at 2 3; rewrite H...
   assert (H0 : 2 <> 0);
-    [ discrR | unfold Rdiv in |- *; rewrite Rinv_mult_distr; try ring ]...
+    [ discrR | unfold Rdiv; rewrite Rinv_mult_distr; try ring ]...
 Qed.
 
 Lemma sin_PI3_cos_PI6 : sin (PI / 3) = cos (PI / 6).
@@ -53,10 +51,10 @@ Proof with trivial.
   assert (H2 : 2 <> 0); [ discrR | idtac ]...
   apply Rmult_eq_reg_l with 6...
   rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
-  unfold Rdiv in |- *; repeat rewrite Rmult_assoc...
+  unfold Rdiv; repeat rewrite Rmult_assoc...
   rewrite <- Rinv_l_sym...
   rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
-  pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
+  rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
     repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
   ring...
 Qed.
@@ -70,23 +68,23 @@ Proof with trivial.
   assert (H2 : 2 <> 0); [ discrR | idtac ]...
   apply Rmult_eq_reg_l with 6...
   rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
-  unfold Rdiv in |- *; repeat rewrite Rmult_assoc...
+  unfold Rdiv; repeat rewrite Rmult_assoc...
   rewrite <- Rinv_l_sym...
   rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
-  pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
+  rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
     repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
   ring...
 Qed.
 
 Lemma PI6_RGT_0 : 0 < PI / 6.
 Proof.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ].
 Qed.
 
 Lemma PI6_RLT_PI2 : PI / 6 < PI / 2.
 Proof.
-  unfold Rdiv in |- *; apply Rmult_lt_compat_l.
+  unfold Rdiv; apply Rmult_lt_compat_l.
   apply PI_RGT_0.
   apply Rinv_lt_contravar; prove_sup.
 Qed.
@@ -99,11 +97,11 @@ Proof with trivial.
   (2 * sin (PI / 6) * cos (PI / 6))...
   rewrite <- sin_2a; replace (2 * (PI / 6)) with (PI / 3)...
   rewrite sin_PI3_cos_PI6...
-  unfold Rdiv in |- *; rewrite Rmult_1_l; rewrite Rmult_assoc;
-    pattern 2 at 2 in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
+  unfold Rdiv; rewrite Rmult_1_l; rewrite Rmult_assoc;
+    pattern 2 at 2; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
       rewrite <- Rinv_l_sym...
   rewrite Rmult_1_r...
-  unfold Rdiv in |- *; rewrite Rinv_mult_distr...
+  unfold Rdiv; rewrite Rinv_mult_distr...
   rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2);
     repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
   rewrite Rmult_1_r...
@@ -121,7 +119,7 @@ Lemma sqrt2_neq_0 : sqrt 2 <> 0.
 Proof.
   assert (Hyp : 0 < 2);
     [ prove_sup0
-      | generalize (Rlt_le 0 2 Hyp); intro H1; red in |- *; intro H2;
+      | generalize (Rlt_le 0 2 Hyp); intro H1; red; intro H2;
         generalize (sqrt_eq_0 2 H1 H2); intro H; absurd (2 = 0);
           [ discrR | assumption ] ].
 Qed.
@@ -139,7 +137,7 @@ Proof.
     [ discrR
       | assert (Hyp : 0 < 3);
         [ prove_sup0
-          | generalize (Rlt_le 0 3 Hyp); intro H1; red in |- *; intro H2;
+          | generalize (Rlt_le 0 3 Hyp); intro H1; red; intro H2;
             generalize (sqrt_eq_0 3 H1 H2); intro H; absurd (3 = 0);
               [ discrR | assumption ] ] ].
 Qed.
@@ -152,7 +150,7 @@ Proof.
         intro H2;
           [ assumption
             | absurd (0 = sqrt 2);
-              [ apply (sym_not_eq (A:=R)); apply sqrt2_neq_0 | assumption ] ] ].
+              [ apply (not_eq_sym (A:=R)); apply sqrt2_neq_0 | assumption ] ] ].
 Qed.
 
 Lemma Rlt_sqrt3_0 : 0 < sqrt 3.
@@ -164,7 +162,7 @@ Proof.
           [ prove_sup0
             | generalize (Rlt_le 0 3 Hyp2); intro H2;
               generalize (lt_INR_0 1 (neq_O_lt 1 H0));
-                unfold INR in |- *; intro H3;
+                unfold INR; intro H3;
                   generalize (Rplus_lt_compat_l 2 0 1 H3);
                     rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3;
                       [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3;
@@ -175,7 +173,7 @@ Qed.
 
 Lemma PI4_RGT_0 : 0 < PI / 4.
 Proof.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ].
 Qed.
 
@@ -191,17 +189,17 @@ Proof with trivial.
   rewrite Rsqr_div...
   rewrite Rsqr_1; rewrite Rsqr_sqrt...
   assert (H : 2 <> 0); [ discrR | idtac ]...
-  unfold Rsqr in |- *; pattern (cos (PI / 4)) at 1 in |- *;
+  unfold Rsqr; pattern (cos (PI / 4)) at 1;
     rewrite <- sin_cos_PI4;
       replace (sin (PI / 4) * cos (PI / 4)) with
       (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4)))...
   rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2)...
   rewrite sin_PI2...
   apply Rmult_1_r...
-  unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr...
+  unfold Rdiv; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr...
   repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
   rewrite Rmult_1_r...
-  unfold Rdiv in |- *; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc...
+  unfold Rdiv; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc...
   rewrite <- Rinv_l_sym...
   rewrite Rmult_1_l...
   left; prove_sup...
@@ -215,18 +213,18 @@ Qed.
 
 Lemma tan_PI4 : tan (PI / 4) = 1.
 Proof.
-  unfold tan in |- *; rewrite sin_cos_PI4.
-  unfold Rdiv in |- *; apply Rinv_r.
-  change (cos (PI / 4) <> 0) in |- *; rewrite cos_PI4; apply R1_sqrt2_neq_0.
+  unfold tan; rewrite sin_cos_PI4.
+  unfold Rdiv; apply Rinv_r.
+  change (cos (PI / 4) <> 0); rewrite cos_PI4; apply R1_sqrt2_neq_0.
 Qed.
 
 Lemma cos3PI4 : cos (3 * (PI / 4)) = -1 / sqrt 2.
 Proof with trivial.
   replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))...
   rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4...
-  unfold Rdiv in |- *; rewrite Ropp_mult_distr_l_reverse...
-  unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *;
-    rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
+  unfold Rdiv; rewrite Ropp_mult_distr_l_reverse...
+  unfold Rminus; rewrite Ropp_involutive; pattern PI at 1;
+    rewrite double_var; unfold Rdiv; rewrite Rmult_plus_distr_r;
       repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
         [ ring | discrR | discrR ]...
 Qed.
@@ -235,8 +233,8 @@ Lemma sin3PI4 : sin (3 * (PI / 4)) = 1 / sqrt 2.
 Proof with trivial.
   replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))...
   rewrite sin_shift; rewrite cos_neg; rewrite cos_PI4...
-  unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *;
-    rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
+  unfold Rminus; rewrite Ropp_involutive; pattern PI at 1;
+    rewrite double_var; unfold Rdiv; rewrite Rmult_plus_distr_r;
       repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
         [ ring | discrR | discrR ]...
 Qed.
@@ -253,8 +251,8 @@ Proof with trivial.
   assert (H : 2 <> 0); [ discrR | idtac ]...
   assert (H1 : 4 <> 0); [ apply prod_neq_R0 | idtac ]...
   rewrite Rsqr_div...
-  rewrite cos2; unfold Rsqr in |- *; rewrite sin_PI6; rewrite sqrt_def...
-  unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
+  rewrite cos2; unfold Rsqr; rewrite sin_PI6; rewrite sqrt_def...
+  unfold Rdiv; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
   rewrite Rmult_minus_distr_l; rewrite (Rmult_comm 3);
     repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym...
   rewrite Rmult_1_l; rewrite Rmult_1_r...
@@ -267,14 +265,14 @@ Qed.
 
 Lemma tan_PI6 : tan (PI / 6) = 1 / sqrt 3.
 Proof.
-  unfold tan in |- *; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv in |- *;
+  unfold tan; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv;
     repeat rewrite Rmult_1_l; rewrite Rinv_mult_distr.
   rewrite Rinv_involutive.
   rewrite (Rmult_comm (/ 2)); rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
   apply Rmult_1_r.
   discrR.
   discrR.
-  red in |- *; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1;
+  red; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1;
     elim (Rlt_irrefl 0 H1).
   apply Rinv_neq_0_compat; discrR.
 Qed.
@@ -291,7 +289,7 @@ Qed.
 
 Lemma tan_PI3 : tan (PI / 3) = sqrt 3.
 Proof.
-  unfold tan in |- *; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *;
+  unfold tan; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv;
     rewrite Rmult_1_l; rewrite Rinv_involutive.
   rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   apply Rmult_1_r.
@@ -302,7 +300,7 @@ Qed.
 Lemma sin_2PI3 : sin (2 * (PI / 3)) = sqrt 3 / 2.
 Proof.
   rewrite double; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3;
-    unfold Rdiv in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2));
+    unfold Rdiv; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2));
       repeat rewrite <- Rmult_assoc; rewrite double_var;
         reflexivity.
 Qed.
@@ -312,12 +310,12 @@ Proof with trivial.
   assert (H : 2 <> 0); [ discrR | idtac ]...
   assert (H0 : 4 <> 0); [ apply prod_neq_R0 | idtac ]...
   rewrite double; rewrite cos_plus; rewrite sin_PI3; rewrite cos_PI3;
-    unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
+    unfold Rdiv; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
   rewrite Rmult_minus_distr_l; repeat rewrite Rmult_assoc;
     rewrite (Rmult_comm 2)...
   repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
   rewrite Rmult_1_r; rewrite <- Rinv_r_sym...
-  pattern 2 at 4 in |- *; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc;
+  pattern 2 at 4; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc;
     rewrite <- Rinv_l_sym...
   rewrite Rmult_1_r; rewrite Ropp_mult_distr_r_reverse; rewrite Rmult_1_r...
   rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
@@ -331,7 +329,7 @@ Qed.
 Lemma tan_2PI3 : tan (2 * (PI / 3)) = - sqrt 3.
 Proof with trivial.
   assert (H : 2 <> 0); [ discrR | idtac ]...
-  unfold tan in |- *; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv in |- *;
+  unfold tan; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv;
     rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l;
       rewrite <- Ropp_inv_permute...
   rewrite Rinv_involutive...
@@ -343,21 +341,21 @@ Qed.
 Lemma cos_5PI4 : cos (5 * (PI / 4)) = -1 / sqrt 2.
 Proof with trivial.
   replace (5 * (PI / 4)) with (PI / 4 + PI)...
-  rewrite neg_cos; rewrite cos_PI4; unfold Rdiv in |- *;
+  rewrite neg_cos; rewrite cos_PI4; unfold Rdiv;
     rewrite Ropp_mult_distr_l_reverse...
-  pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *;
+  pattern PI at 2; rewrite double_var; pattern PI at 2 3;
     rewrite double_var; assert (H : 2 <> 0);
-      [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]...
+      [ discrR | unfold Rdiv; repeat rewrite Rinv_mult_distr; try ring ]...
 Qed.
 
 Lemma sin_5PI4 : sin (5 * (PI / 4)) = -1 / sqrt 2.
 Proof with trivial.
   replace (5 * (PI / 4)) with (PI / 4 + PI)...
-  rewrite neg_sin; rewrite sin_PI4; unfold Rdiv in |- *;
+  rewrite neg_sin; rewrite sin_PI4; unfold Rdiv;
     rewrite Ropp_mult_distr_l_reverse...
-  pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *;
+  pattern PI at 2; rewrite double_var; pattern PI at 2 3;
     rewrite double_var; assert (H : 2 <> 0);
-      [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]...
+      [ discrR | unfold Rdiv; repeat rewrite Rinv_mult_distr; try ring ]...
 Qed.
 
 Lemma sin_cos5PI4 : cos (5 * (PI / 4)) = sin (5 * (PI / 4)).
@@ -369,7 +367,7 @@ Lemma Rgt_3PI2_0 : 0 < 3 * (PI / 2).
 Proof.
   apply Rmult_lt_0_compat;
     [ prove_sup0
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ].
 Qed.
 
@@ -384,7 +382,7 @@ Proof.
     generalize (Rplus_lt_compat_l PI 0 (PI / 2) H1);
       replace (PI + PI / 2) with (3 * (PI / 2)).
   rewrite Rplus_0_r; intro H2; assumption.
-  pattern PI at 2 in |- *; rewrite double_var; ring.
+  pattern PI at 2; rewrite double_var; ring.
 Qed.
 
 Lemma Rlt_3PI2_2PI : 3 * (PI / 2) < 2 * PI.
@@ -393,7 +391,7 @@ Proof.
     generalize (Rplus_lt_compat_l (3 * (PI / 2)) 0 (PI / 2) H1);
       replace (3 * (PI / 2) + PI / 2) with (2 * PI).
   rewrite Rplus_0_r; intro H2; assumption.
-  rewrite double; pattern PI at 1 2 in |- *; rewrite double_var; ring.
+  rewrite double; pattern PI at 1 2; rewrite double_var; ring.
 Qed.
 
 (***************************************************************)
@@ -406,13 +404,13 @@ Definition toDeg (x:R) : R := x * plat * / PI.
 
 Lemma rad_deg : forall x:R, toRad (toDeg x) = x.
 Proof.
-  intro; unfold toRad, toDeg in |- *;
+  intro; unfold toRad, toDeg;
     replace (x * plat * / PI * PI * / plat) with
     (x * (plat * / plat) * (PI * / PI)); [ idtac | ring ].
   repeat rewrite <- Rinv_r_sym.
   ring.
   apply PI_neq0.
-  unfold plat in |- *; discrR.
+  unfold plat; discrR.
 Qed.
 
 Lemma toRad_inj : forall x y:R, toRad x = toRad y -> x = y.
@@ -422,7 +420,7 @@ Proof.
   apply Rmult_eq_reg_l with (/ plat).
   rewrite <- (Rmult_comm (x * PI)); rewrite <- (Rmult_comm (y * PI));
     assumption.
-  apply Rinv_neq_0_compat; unfold plat in |- *; discrR.
+  apply Rinv_neq_0_compat; unfold plat; discrR.
   apply PI_neq0.
 Qed.
 
@@ -437,7 +435,7 @@ Definition tand (x:R) : R := tan (toRad x).
 
 Lemma Rsqr_sin_cos_d_one : forall x:R, Rsqr (sind x) + Rsqr (cosd x) = 1.
 Proof.
-  intro x; unfold sind in |- *; unfold cosd in |- *; apply sin2_cos2.
+  intro x; unfold sind; unfold cosd; apply sin2_cos2.
 Qed.
 
 (***************************************************)
@@ -449,10 +447,10 @@ Proof.
   intros; case (Rtotal_order 0 a); intro.
   left; apply sin_lb_gt_0; assumption.
   elim H1; intro.
-  rewrite <- H2; unfold sin_lb in |- *; unfold sin_approx in |- *;
-    unfold sum_f_R0 in |- *; unfold sin_term in |- *;
+  rewrite <- H2; unfold sin_lb; unfold sin_approx;
+    unfold sum_f_R0; unfold sin_term;
       repeat rewrite pow_ne_zero.
-  unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r;
+  unfold Rdiv; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r;
     repeat rewrite Rplus_0_r; right; reflexivity.
   discriminate.
   discriminate.
diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v
index 417cf13c..f3e69037 100644
--- a/theories/Reals/Rtrigo_def.v
+++ b/theories/Reals/Rtrigo_def.v
@@ -1,19 +1,13 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtrigo_def.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import Rbase.
-Require Import Rfunctions.
-Require Import SeqSeries.
-Require Import Rtrigo_fun.
-Require Import Max.
-Open Local Scope R_scope.
+Require Import Rbase Rfunctions SeqSeries Rtrigo_fun Max.
+Local Open Scope R_scope.
 
 (********************************)
 (** * Definition of exponential *)
@@ -33,7 +27,7 @@ Proof.
   intro;
     generalize
       (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp).
-  unfold Pser, exp_in in |- *.
+  unfold Pser, exp_in.
   trivial.
 Defined.
 
@@ -42,24 +36,24 @@ Definition exp (x:R) : R := proj1_sig (exist_exp x).
 Lemma pow_i : forall i:nat, (0 < i)%nat -> 0 ^ i = 0.
 Proof.
   intros; apply pow_ne_zero.
-  red in |- *; intro; rewrite H0 in H; elim (lt_irrefl _ H).
+  red; intro; rewrite H0 in H; elim (lt_irrefl _ H).
 Qed.
 
 Lemma exist_exp0 : { l:R | exp_in 0 l }.
 Proof.
   exists 1.
-  unfold exp_in in |- *; unfold infinite_sum in |- *; intros.
+  unfold exp_in; unfold infinite_sum; intros.
   exists 0%nat.
   intros; replace (sum_f_R0 (fun i:nat => / INR (fact i) * 0 ^ i) n) with 1.
-  unfold R_dist in |- *; replace (1 - 1) with 0;
+  unfold R_dist; replace (1 - 1) with 0;
     [ rewrite Rabs_R0; assumption | ring ].
   induction  n as [| n Hrecn].
-  simpl in |- *; rewrite Rinv_1; ring.
+  simpl; rewrite Rinv_1; ring.
   rewrite tech5.
   rewrite <- Hrecn.
-  simpl in |- *.
+  simpl.
   ring.
-  unfold ge in |- *; apply le_O_n.
+  unfold ge; apply le_O_n.
 Defined.
 
 (* Value of [exp 0] *)
@@ -67,7 +61,7 @@ Lemma exp_0 : exp 0 = 1.
 Proof.
   cut (exp_in 0 (exp 0)).
   cut (exp_in 0 1).
-  unfold exp_in in |- *; intros; eapply uniqueness_sum.
+  unfold exp_in; intros; eapply uniqueness_sum.
   apply H0.
   apply H.
   exact (proj2_sig exist_exp0).
@@ -83,14 +77,14 @@ Definition tanh (x:R) : R := sinh x / cosh x.
 
 Lemma cosh_0 : cosh 0 = 1.
 Proof.
-  unfold cosh in |- *; rewrite Ropp_0; rewrite exp_0.
-  unfold Rdiv in |- *; rewrite <- Rinv_r_sym; [ reflexivity | discrR ].
+  unfold cosh; rewrite Ropp_0; rewrite exp_0.
+  unfold Rdiv; rewrite <- Rinv_r_sym; [ reflexivity | discrR ].
 Qed.
 
 Lemma sinh_0 : sinh 0 = 0.
 Proof.
-  unfold sinh in |- *; rewrite Ropp_0; rewrite exp_0.
-  unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; apply Rmult_0_l.
+  unfold sinh; rewrite Ropp_0; rewrite exp_0.
+  unfold Rminus, Rdiv; rewrite Rplus_opp_r; apply Rmult_0_l.
 Qed.
 
 Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)).
@@ -98,8 +92,8 @@ Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)).
 Lemma simpl_cos_n :
   forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)).
 Proof.
-  intro; unfold cos_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
-  rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  intro; unfold cos_n; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  rewrite pow_add; unfold Rdiv; rewrite Rinv_mult_distr.
   rewrite Rinv_involutive.
   replace
   ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) *
@@ -107,7 +101,7 @@ Proof.
   ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1))) * INR (fact (2 * n)) *
     (-1) ^ 1); [ idtac | ring ].
   rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r.
+  rewrite Rmult_1_l; unfold pow; rewrite Rmult_1_r.
   replace (2 * (n + 1))%nat with (S (S (2 * n))); [ idtac | ring ].
   do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
     repeat rewrite Rinv_mult_distr; try (apply not_O_INR; discriminate).
@@ -136,29 +130,29 @@ Proof.
   intro; cut (0 <= up (/ eps))%Z.
   intro; assert (H2 := IZN _ H1); elim H2; intros; exists (max x 1).
   split.
-  cut (0 < IZR (Z_of_nat x)).
-  intro; rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z_of_nat x)).
-  apply Rmult_le_reg_l with (IZR (Z_of_nat x)).
+  cut (0 < IZR (Z.of_nat x)).
+  intro; rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z.of_nat x)).
+  apply Rmult_le_reg_l with (IZR (Z.of_nat x)).
   assumption.
   rewrite <- Rinv_r_sym;
-    [ idtac | red in |- *; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ].
-  apply Rmult_le_reg_l with (IZR (Z_of_nat (max x 1))).
-  apply Rlt_le_trans with (IZR (Z_of_nat x)).
+    [ idtac | red; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ].
+  apply Rmult_le_reg_l with (IZR (Z.of_nat (max x 1))).
+  apply Rlt_le_trans with (IZR (Z.of_nat x)).
   assumption.
   repeat rewrite <- INR_IZR_INZ; apply le_INR; apply le_max_l.
-  rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z_of_nat (max x 1))));
+  rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z.of_nat (max x 1))));
     rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r; repeat rewrite <- INR_IZR_INZ; apply le_INR;
     apply le_max_l.
   rewrite <- INR_IZR_INZ; apply not_O_INR.
-  red in |- *; intro; assert (H6 := le_max_r x 1); cut (0 < 1)%nat;
+  red; intro; assert (H6 := le_max_r x 1); cut (0 < 1)%nat;
     [ intro | apply lt_O_Sn ]; assert (H8 := lt_le_trans _ _ _ H7 H6);
       rewrite H5 in H8; elim (lt_irrefl _ H8).
-  pattern eps at 1 in |- *; rewrite <- Rinv_involutive.
+  pattern eps at 1; rewrite <- Rinv_involutive.
   apply Rinv_lt_contravar.
   apply Rmult_lt_0_compat; [ apply Rinv_0_lt_compat; assumption | assumption ].
   rewrite H3 in H0; assumption.
-  red in |- *; intro; rewrite H5 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H5 in H; elim (Rlt_irrefl _ H).
   apply Rlt_trans with (/ eps).
   apply Rinv_0_lt_compat; assumption.
   rewrite H3 in H0; assumption.
@@ -172,10 +166,10 @@ Qed.
 
 Lemma Alembert_cos : Un_cv (fun n:nat => Rabs (cos_n (S n) / cos_n n)) 0.
 Proof.
-  unfold Un_cv in |- *; intros.
+  unfold Un_cv; intros.
   assert (H0 := archimed_cor1 eps H).
   elim H0; intros; exists x.
-  intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *;
+  intros; rewrite simpl_cos_n; unfold R_dist; unfold Rminus;
     rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu;
       rewrite Rabs_Ropp; rewrite Rabs_right.
   rewrite mult_INR; rewrite Rinv_mult_distr.
@@ -183,7 +177,7 @@ Proof.
   intro; cut (/ INR (2 * n + 1) < eps).
   intro; rewrite <- (Rmult_1_l eps).
   apply Rmult_gt_0_lt_compat; try assumption.
-  change (0 < / INR (2 * n + 1)) in |- *; apply Rinv_0_lt_compat;
+  change (0 < / INR (2 * n + 1)); apply Rinv_0_lt_compat;
     apply lt_INR_0.
   replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
   apply Rlt_0_1.
@@ -227,7 +221,7 @@ Proof.
 Qed.
 
 Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0.
-  intro; unfold cos_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0.
+  intro; unfold cos_n; unfold Rdiv; apply prod_neq_R0.
   apply pow_nonzero; discrR.
   apply Rinv_neq_0_compat.
   apply INR_fact_neq_0.
@@ -240,7 +234,7 @@ Definition cos_in (x l:R) : Prop :=
 (**********)
 Lemma exist_cos : forall x:R, { l:R | cos_in x l }.
   intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos).
-  unfold Pser, cos_in in |- *; trivial.
+  unfold Pser, cos_in; trivial.
 Qed.
 
 
@@ -252,8 +246,8 @@ Definition sin_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n + 1)).
 Lemma simpl_sin_n :
   forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)).
 Proof.
-  intro; unfold sin_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
-  rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  intro; unfold sin_n; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  rewrite pow_add; unfold Rdiv; rewrite Rinv_mult_distr.
   rewrite Rinv_involutive.
   replace
   ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) *
@@ -261,7 +255,7 @@ Proof.
   ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1) + 1)) *
     INR (fact (2 * n + 1)) * (-1) ^ 1); [ idtac | ring ].
   rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r;
+  rewrite Rmult_1_l; unfold pow; rewrite Rmult_1_r;
     replace (2 * (n + 1) + 1)%nat with (S (S (2 * n + 1))).
   do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
     repeat rewrite Rinv_mult_distr.
@@ -297,9 +291,9 @@ Qed.
 
 Lemma Alembert_sin : Un_cv (fun n:nat => Rabs (sin_n (S n) / sin_n n)) 0.
 Proof.
-  unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H).
+  unfold Un_cv; intros; assert (H0 := archimed_cor1 eps H).
   elim H0; intros; exists x.
-  intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *;
+  intros; rewrite simpl_sin_n; unfold R_dist; unfold Rminus;
     rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu;
       rewrite Rabs_Ropp; rewrite Rabs_right.
   rewrite mult_INR; rewrite Rinv_mult_distr.
@@ -307,7 +301,7 @@ Proof.
   intro; cut (/ INR (2 * S n + 1) < eps).
   intro; rewrite <- (Rmult_1_l eps); rewrite (Rmult_comm (/ INR (2 * S n + 1)));
     apply Rmult_gt_0_lt_compat; try assumption.
-  change (0 < / INR (2 * S n + 1)) in |- *; apply Rinv_0_lt_compat;
+  change (0 < / INR (2 * S n + 1)); apply Rinv_0_lt_compat;
     apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n));
       [ apply lt_O_Sn | ring ].
   apply Rlt_0_1.
@@ -335,7 +329,7 @@ Proof.
   apply not_O_INR; discriminate.
   apply not_O_INR; discriminate.
   apply not_O_INR; discriminate.
-  left; change (0 < / INR ((2 * S n + 1) * (2 * S n))) in |- *;
+  left; change (0 < / INR ((2 * S n + 1) * (2 * S n)));
     apply Rinv_0_lt_compat.
   apply lt_INR_0.
   replace ((2 * S n + 1) * (2 * S n))%nat with
@@ -348,7 +342,7 @@ Defined.
 
 Lemma sin_no_R0 : forall n:nat, sin_n n <> 0.
 Proof.
-  intro; unfold sin_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0.
+  intro; unfold sin_n; unfold Rdiv; apply prod_neq_R0.
   apply pow_nonzero; discrR.
   apply Rinv_neq_0_compat; apply INR_fact_neq_0.
 Qed.
@@ -361,7 +355,7 @@ Definition sin_in (x l:R) : Prop :=
 Lemma exist_sin : forall x:R, { l:R | sin_in x l }.
 Proof.
   intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin).
-  unfold Pser, sin_n in |- *; trivial.
+  unfold Pser, sin_n; trivial.
 Defined.
 
 (***********************)
@@ -374,40 +368,40 @@ Definition sin (x:R) : R := let (a,_) := exist_sin (Rsqr x) in x * a.
 
 Lemma cos_sym : forall x:R, cos x = cos (- x).
 Proof.
-  intros; unfold cos in |- *; replace (Rsqr (- x)) with (Rsqr x).
+  intros; unfold cos; replace (Rsqr (- x)) with (Rsqr x).
   reflexivity.
   apply Rsqr_neg.
 Qed.
 
 Lemma sin_antisym : forall x:R, sin (- x) = - sin x.
 Proof.
-  intro; unfold sin in |- *; replace (Rsqr (- x)) with (Rsqr x);
+  intro; unfold sin; replace (Rsqr (- x)) with (Rsqr x);
     [ idtac | apply Rsqr_neg ].
   case (exist_sin (Rsqr x)); intros; ring.
 Qed.
 
 Lemma sin_0 : sin 0 = 0.
 Proof.
-  unfold sin in |- *; case (exist_sin (Rsqr 0)).
+  unfold sin; case (exist_sin (Rsqr 0)).
   intros; ring.
 Qed.
 
 Lemma exist_cos0 : { l:R | cos_in 0 l }.
 Proof.
   exists 1.
-  unfold cos_in in |- *; unfold infinite_sum in |- *; intros; exists 0%nat.
+  unfold cos_in; unfold infinite_sum; intros; exists 0%nat.
   intros.
-  unfold R_dist in |- *.
+  unfold R_dist.
   induction  n as [| n Hrecn].
-  unfold cos_n in |- *; simpl in |- *.
-  unfold Rdiv in |- *; rewrite Rinv_1.
+  unfold cos_n; simpl.
+  unfold Rdiv; rewrite Rinv_1.
   do 2 rewrite Rmult_1_r.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
   rewrite tech5.
   replace (cos_n (S n) * 0 ^ S n) with 0.
   rewrite Rplus_0_r.
-  apply Hrecn; unfold ge in |- *; apply le_O_n.
-  simpl in |- *; ring.
+  apply Hrecn; unfold ge; apply le_O_n.
+  simpl; ring.
 Defined.
 
 (* Value of [cos 0] *)
@@ -415,10 +409,10 @@ Lemma cos_0 : cos 0 = 1.
 Proof.
   cut (cos_in 0 (cos 0)).
   cut (cos_in 0 1).
-  unfold cos_in in |- *; intros; eapply uniqueness_sum.
+  unfold cos_in; intros; eapply uniqueness_sum.
   apply H0.
   apply H.
   exact (proj2_sig exist_cos0).
-  assert (H := proj2_sig (exist_cos (Rsqr 0))); unfold cos in |- *;
-    pattern 0 at 1 in |- *; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ].
+  assert (H := proj2_sig (exist_cos (Rsqr 0))); unfold cos;
+    pattern 0 at 1; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ].
 Qed.
diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v
index 2ed86abe..b131b510 100644
--- a/theories/Reals/Rtrigo_fun.v
+++ b/theories/Reals/Rtrigo_fun.v
@@ -1,17 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtrigo_fun.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (*****************************************************************)
 (**           To define transcendental functions                 *)
@@ -22,8 +20,8 @@ Open Local Scope R_scope.
 Lemma Alembert_exp :
   Un_cv (fun n:nat => Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0.
 Proof.
-  unfold Un_cv in |- *; intros; elim (Rgt_dec eps 1); intro.
-  split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist in |- *;
+  unfold Un_cv; intros; elim (Rgt_dec eps 1); intro.
+  split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist;
     rewrite (Rminus_0_r (Rabs (/ INR (S n))));
       rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
   intro; rewrite (Rabs_pos_eq (/ INR (S n))).
@@ -41,7 +39,7 @@ Proof.
               in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4;
                 rewrite (Rmult_comm (/ INR (S n))) in H4;
                   rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4;
-                    rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H4;
+                    rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (O_S n)))) in H4;
                       rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4;
                         assumption.
   apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1;
@@ -49,11 +47,11 @@ Proof.
       rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H;
         assumption.
   unfold Rgt in H1; apply Rlt_le; assumption.
-  unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+  unfold Rgt; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
 (**)
   cut (0 <= up (/ eps - 1))%Z.
   intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros;
-    rewrite (simpl_fact n); unfold R_dist in |- *;
+    rewrite (simpl_fact n); unfold R_dist;
       rewrite (Rminus_0_r (Rabs (/ INR (S n))));
         rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
   intro; rewrite (Rabs_pos_eq (/ INR (S n))).
@@ -74,28 +72,28 @@ Proof.
               in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6;
                 rewrite (Rmult_comm (/ INR (S n))) in H6;
                   rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6;
-                    rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H6;
+                    rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (O_S n)))) in H6;
                       rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6;
                         assumption.
-  cut (IZR (up (/ eps - 1)) = IZR (Z_of_nat x));
+  cut (IZR (up (/ eps - 1)) = IZR (Z.of_nat x));
     [ intro | rewrite H1; trivial ].
   elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5;
     rewrite H4 in H5; rewrite INR_IZR_INZ; assumption.
   unfold Rgt in H1; apply Rlt_le; assumption.
-  unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+  unfold Rgt; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
   apply (le_O_IZR (up (/ eps - 1)));
     apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))).
-  generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle in |- *; intro; elim H0;
+  generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle; intro; elim H0;
     clear H0; intro.
   left; unfold Rgt in H;
     generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0);
       rewrite
         (Rinv_l eps
-          (sym_not_eq (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H))))
+          (not_eq_sym (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H))))
         ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1);
-          intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus;
-            unfold Rgt in |- *; assumption.
-  right; rewrite H0; rewrite Rinv_1; apply sym_eq; apply Rminus_diag_eq; auto.
+          intro; fold (/ eps - 1 > 0); apply Rgt_minus;
+            unfold Rgt; assumption.
+  right; rewrite H0; rewrite Rinv_1; symmetry; apply Rminus_diag_eq; auto.
   elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le;
     assumption.
 Qed.
diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v
index 59afec88..fff4fec9 100644
--- a/theories/Reals/Rtrigo_reg.v
+++ b/theories/Reals/Rtrigo_reg.v
@@ -1,179 +1,31 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtrigo_reg.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import SeqSeries.
-Require Import Rtrigo.
+Require Import Rtrigo1.
 Require Import Ranalysis1.
 Require Import PSeries_reg.
-Open Local Scope nat_scope.
-Open Local Scope R_scope.
-
-Lemma CVN_R_cos :
-  forall fn:nat -> R -> R,
-    fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) ->
-    CVN_R fn.
-Proof.
-  unfold CVN_R in |- *; intros.
-  cut ((r:R) <> 0).
-  intro hyp_r; unfold CVN_r in |- *.
-  exists (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)).
-  cut
-    { l:R |
-        Un_cv
-        (fun n:nat =>
-          sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k)))
-          n) l }.
-  intro X; elim X; intros.
-  exists x.
-  split.
-  apply p.
-  intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult.
-  rewrite pow_1_abs; rewrite Rmult_1_l.
-  cut (0 < / INR (fact (2 * n))).
-  intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))).
-  apply Rmult_le_compat_l.
-  left; apply H1.
-  rewrite <- RPow_abs; apply pow_maj_Rabs.
-  rewrite Rabs_Rabsolu.
-  unfold Boule in H0; rewrite Rminus_0_r in H0.
-  left; apply H0.
-  apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-  apply Alembert_C2.
-  intro; apply Rabs_no_R0.
-  apply prod_neq_R0.
-  apply Rinv_neq_0_compat.
-  apply INR_fact_neq_0.
-  apply pow_nonzero; assumption.
-  assert (H0 := Alembert_cos).
-  unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros.
-  cut (0 < eps / Rsqr r).
-  intro; elim (H0 _ H2); intros N0 H3.
-  exists N0; intros.
-  unfold R_dist in |- *; assert (H5 := H3 _ H4).
-  unfold R_dist in H5;
-    replace
-    (Rabs
-      (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) /
-        Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with
-    (Rsqr r *
-      Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))).
-  apply Rmult_lt_reg_l with (/ Rsqr r).
-  apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
-  pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)).
-  rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r;
-    rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-  rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5.
-  unfold Rsqr in |- *; apply prod_neq_R0; assumption.
-  rewrite Rabs_Rinv.
-  rewrite Rabs_right.
-  reflexivity.
-  apply Rle_ge; apply Rle_0_sqr.
-  unfold Rsqr in |- *; apply prod_neq_R0; assumption.
-  rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult;
-    rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l;
-      repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l.
-  rewrite Rabs_Rinv.
-  rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l;
-    rewrite <- Rabs_Rinv.
-  rewrite Rinv_involutive.
-  rewrite Rinv_mult_distr.
-  rewrite Rabs_Rinv.
-  rewrite Rinv_involutive.
-  rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult;
-    rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l.
-  rewrite Rabs_Rinv.
-  do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right.
-  replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r).
-  repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-  unfold Rsqr in |- *; ring.
-  apply pow_nonzero; assumption.
-  replace (2 * S n)%nat with (S (S (2 * n))).
-  simpl in |- *; ring.
-  ring.
-  apply Rle_ge; apply pow_le; left; apply (cond_pos r).
-  apply Rle_ge; apply pow_le; left; apply (cond_pos r).
-  apply Rabs_no_R0; apply pow_nonzero; assumption.
-  apply Rabs_no_R0; apply INR_fact_neq_0.
-  apply INR_fact_neq_0.
-  apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-  apply Rabs_no_R0; apply pow_nonzero; assumption.
-  apply INR_fact_neq_0.
-  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-  apply prod_neq_R0.
-  apply pow_nonzero; discrR.
-  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-  apply H1.
-  apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
-  assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0;
-    elim (Rlt_irrefl _ H0).
-Qed.
+Local Open Scope nat_scope.
+Local Open Scope R_scope.
 
-(**********)
-Lemma continuity_cos : continuity cos.
-Proof.
-  set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)).
-  cut (CVN_R fn).
-  intro; cut (forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }).
-  intro cv; cut (forall n:nat, continuity (fn n)).
-  intro; cut (forall x:R, cos x = SFL fn cv x).
-  intro; cut (continuity (SFL fn cv) -> continuity cos).
-  intro; apply H1.
-  apply SFL_continuity; assumption.
-  unfold continuity in |- *; unfold continuity_pt in |- *;
-    unfold continue_in in |- *; unfold limit1_in in |- *;
-      unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *;
-        intros.
-  elim (H1 x _ H2); intros.
-  exists x0; intros.
-  elim H3; intros.
-  split.
-  apply H4.
-  intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6.
-  intro; unfold cos, SFL in |- *.
-  case (cv x); case (exist_cos (Rsqr x)); intros.
-  symmetry  in |- *; eapply UL_sequence.
-  apply u.
-  unfold cos_in in c; unfold infinite_sum in c; unfold Un_cv in |- *; intros.
-  elim (c _ H0); intros N0 H1.
-  exists N0; intros.
-  unfold R_dist in H1; unfold R_dist, SP in |- *.
-  replace (sum_f_R0 (fun k:nat => fn k x) n) with
-  (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n).
-  apply H1; assumption.
-  apply sum_eq; intros.
-  unfold cos_n, fn in |- *; apply Rmult_eq_compat_l.
-  unfold Rsqr in |- *; rewrite pow_sqr; reflexivity.
-  intro; unfold fn in |- *;
-    replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with
-    (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F;
-    [ idtac | reflexivity ].
-  apply continuity_mult.
-  apply derivable_continuous; apply derivable_const.
-  apply derivable_continuous; apply (derivable_pow (2 * n)).
-  apply CVN_R_CVS; apply X.
-  apply CVN_R_cos; unfold fn in |- *; reflexivity.
-Qed.
 
 (**********)
 Lemma continuity_sin : continuity sin.
 Proof.
-  unfold continuity in |- *; intro.
+  unfold continuity; intro.
   assert (H0 := continuity_cos (PI / 2 - x)).
   unfold continuity_pt in H0; unfold continue_in in H0; unfold limit1_in in H0;
     unfold limit_in in H0; simpl in H0; unfold R_dist in H0;
-      unfold continuity_pt in |- *; unfold continue_in in |- *;
-        unfold limit1_in in |- *; unfold limit_in in |- *;
-          simpl in |- *; unfold R_dist in |- *; intros.
+      unfold continuity_pt; unfold continue_in;
+        unfold limit1_in; unfold limit_in;
+          simpl; unfold R_dist; intros.
   elim (H0 _ H); intros.
   exists x0; intros.
   elim H1; intros.
@@ -182,9 +34,9 @@ Proof.
   intros; rewrite <- (cos_shift x); rewrite <- (cos_shift x1); apply H3.
   elim H4; intros.
   split.
-  unfold D_x, no_cond in |- *; split.
+  unfold D_x, no_cond; split.
   trivial.
-  red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8;
+  red; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8;
     rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive x1);
       apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2);
         apply H7.
@@ -198,7 +50,7 @@ Lemma CVN_R_sin :
     (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)) ->
     CVN_R fn.
 Proof.
-  unfold CVN_R in |- *; unfold CVN_r in |- *; intros fn H r.
+  unfold CVN_R; unfold CVN_r; intros fn H r.
   exists (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)).
   cut
     { l:R |
@@ -211,7 +63,7 @@ Proof.
   exists x.
   split.
   apply p.
-  intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult;
+  intros; rewrite H; unfold Rdiv; do 2 rewrite Rabs_mult;
     rewrite pow_1_abs; rewrite Rmult_1_l.
   cut (0 < / INR (fact (2 * n + 1))).
   intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))).
@@ -228,11 +80,11 @@ Proof.
   apply Rinv_neq_0_compat; apply INR_fact_neq_0.
   apply pow_nonzero; assumption.
   assert (H1 := Alembert_sin).
-  unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv in |- *; intros.
+  unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv; intros.
   cut (0 < eps / Rsqr r).
   intro; elim (H1 _ H3); intros N0 H4.
   exists N0; intros.
-  unfold R_dist in |- *; assert (H6 := H4 _ H5).
+  unfold R_dist; assert (H6 := H4 _ H5).
   unfold R_dist in H5;
     replace
     (Rabs
@@ -244,15 +96,15 @@ Proof.
         ((-1) ^ n / INR (fact (2 * n + 1))))).
   apply Rmult_lt_reg_l with (/ Rsqr r).
   apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
-  pattern (/ Rsqr r) at 1 in |- *; rewrite <- (Rabs_right (/ Rsqr r)).
+  pattern (/ Rsqr r) at 1; rewrite <- (Rabs_right (/ Rsqr r)).
   rewrite <- Rabs_mult.
   rewrite Rmult_minus_distr_l.
   rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l; rewrite <- (Rmult_comm eps).
   apply H6.
-  unfold Rsqr in |- *; apply prod_neq_R0; assumption.
+  unfold Rsqr; apply prod_neq_R0; assumption.
   apply Rle_ge; left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
-  unfold Rdiv in |- *; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult;
+  unfold Rdiv; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult;
     rewrite Rabs_Rabsolu; rewrite pow_1_abs.
   rewrite Rmult_1_l.
   repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l.
@@ -274,10 +126,10 @@ Proof.
   replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r).
   do 2 rewrite <- Rmult_assoc.
   rewrite <- Rinv_l_sym.
-  unfold Rsqr in |- *; ring.
+  unfold Rsqr; ring.
   apply pow_nonzero; assumption.
   replace (2 * S n)%nat with (S (S (2 * n))).
-  simpl in |- *; ring.
+  simpl; ring.
   ring.
   apply Rle_ge; apply pow_le; left; apply (cond_pos r).
   apply Rle_ge; apply pow_le; left; apply (cond_pos r).
@@ -290,16 +142,16 @@ Proof.
   apply INR_fact_neq_0.
   apply pow_nonzero; discrR.
   apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption ].
-  assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0;
+  assert (H0 := cond_pos r); red; intro; rewrite H1 in H0;
     elim (Rlt_irrefl _ H0).
 Qed.
 
 (** (sin h)/h -> 1 when h -> 0 *)
 Lemma derivable_pt_lim_sin_0 : derivable_pt_lim sin 0 1.
 Proof.
-  unfold derivable_pt_lim in |- *; intros.
+  unfold derivable_pt_lim; intros.
   set
     (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)).
   cut (CVN_R fn).
@@ -315,58 +167,58 @@ Proof.
   elim (H2 _ H); intros alp H3.
   elim H3; intros.
   exists (mkposreal _ H4).
-  simpl in |- *; intros.
-  rewrite sin_0; rewrite Rplus_0_l; unfold Rminus in |- *; rewrite Ropp_0;
+  simpl; intros.
+  rewrite sin_0; rewrite Rplus_0_l; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r.
   cut (Rabs (SFL fn cv h - SFL fn cv 0) < eps).
   intro; cut (SFL fn cv 0 = 1).
   intro; cut (SFL fn cv h = sin h / h).
   intro; rewrite H9 in H8; rewrite H10 in H8.
   apply H8.
-  unfold SFL, sin in |- *.
+  unfold SFL, sin.
   case (cv h); intros.
   case (exist_sin (Rsqr h)); intros.
-  unfold Rdiv in |- *; rewrite (Rinv_r_simpl_m h x0 H6).
+  unfold Rdiv; rewrite (Rinv_r_simpl_m h x0 H6).
   eapply UL_sequence.
   apply u.
   unfold sin_in in s; unfold sin_n, infinite_sum in s;
-    unfold SP, fn, Un_cv in |- *; intros.
+    unfold SP, fn, Un_cv; intros.
   elim (s _ H10); intros N0 H11.
   exists N0; intros.
-  unfold R_dist in |- *; unfold R_dist in H11.
+  unfold R_dist; unfold R_dist in H11.
   replace
   (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * h ^ (2 * k)) n)
     with
       (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * Rsqr h ^ i) n).
   apply H11; assumption.
-  apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr in |- *;
+  apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr;
     rewrite pow_sqr; reflexivity.
-  unfold SFL, sin in |- *.
+  unfold SFL, sin.
   case (cv 0); intros.
   eapply UL_sequence.
   apply u.
-  unfold SP, fn in |- *; unfold Un_cv in |- *; intros; exists 1%nat; intros.
-  unfold R_dist in |- *;
+  unfold SP, fn; unfold Un_cv; intros; exists 1%nat; intros.
+  unfold R_dist;
     replace
     (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k)) n)
     with 1.
-  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
   rewrite decomp_sum.
-  simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite Rinv_1;
-    rewrite Rmult_1_r; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+  simpl; rewrite Rmult_1_r; unfold Rdiv; rewrite Rinv_1;
+    rewrite Rmult_1_r; pattern 1 at 1; rewrite <- Rplus_0_r;
       apply Rplus_eq_compat_l.
-  symmetry  in |- *; apply sum_eq_R0; intros.
+  symmetry ; apply sum_eq_R0; intros.
   rewrite Rmult_0_l; rewrite Rmult_0_r; reflexivity.
   unfold ge in H10; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H10 ].
   apply H5.
   split.
-  unfold D_x, no_cond in |- *; split.
+  unfold D_x, no_cond; split.
   trivial.
-  apply (sym_not_eq (A:=R)); apply H6.
-  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply H7.
-  unfold Boule in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+  apply (not_eq_sym (A:=R)); apply H6.
+  unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply H7.
+  unfold Boule; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r).
-  intros; unfold fn in |- *;
+  intros; unfold fn;
     replace (fun x:R => (-1) ^ n / INR (fact (2 * n + 1)) * x ^ (2 * n)) with
     (fct_cte ((-1) ^ n / INR (fact (2 * n + 1))) * pow_fct (2 * n))%F;
     [ idtac | reflexivity ].
@@ -377,13 +229,13 @@ Proof.
   apply (derivable_pt_pow (2 * n) y).
   apply (X r).
   apply (CVN_R_CVS _ X).
-  apply CVN_R_sin; unfold fn in |- *; reflexivity.
+  apply CVN_R_sin; unfold fn; reflexivity.
 Qed.
 
 (** ((cos h)-1)/h -> 0 when h -> 0 *)
 Lemma derivable_pt_lim_cos_0 : derivable_pt_lim cos 0 0.
 Proof.
-  unfold derivable_pt_lim in |- *; intros.
+  unfold derivable_pt_lim; intros.
   assert (H0 := derivable_pt_lim_sin_0).
   unfold derivable_pt_lim in H0.
   cut (0 < eps / 2).
@@ -398,8 +250,8 @@ Proof.
   intro; set (delta := mkposreal _ H6).
   exists delta; intros.
   rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))).
-  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
-  unfold Rdiv in |- *; do 2 rewrite Ropp_mult_distr_l_reverse.
+  unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
+  unfold Rdiv; do 2 rewrite Ropp_mult_distr_l_reverse.
   rewrite Rabs_Ropp.
   replace (2 * Rsqr (sin (h * / 2)) * / h) with
   (sin (h / 2) * (sin (h / 2) / (h / 2) - 1) + sin (h / 2)).
@@ -409,12 +261,12 @@ Proof.
   rewrite (double_var eps); apply Rplus_lt_compat.
   apply Rle_lt_trans with (Rabs (sin (h / 2) / (h / 2) - 1)).
   rewrite Rabs_mult; rewrite Rmult_comm;
-    pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2 in |- *;
+    pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2;
       rewrite <- Rmult_1_r; apply Rmult_le_compat_l.
   apply Rabs_pos.
   assert (H9 := SIN_bound (h / 2)).
-  unfold Rabs in |- *; case (Rcase_abs (sin (h / 2))); intro.
-  pattern 1 at 3 in |- *; rewrite <- (Ropp_involutive 1).
+  unfold Rabs; case (Rcase_abs (sin (h / 2))); intro.
+  pattern 1 at 3; rewrite <- (Ropp_involutive 1).
   apply Ropp_le_contravar.
   elim H9; intros; assumption.
   elim H9; intros; assumption.
@@ -423,50 +275,50 @@ Proof.
   intro; assert (H11 := H2 _ H10 H9).
   rewrite Rplus_0_l in H11; rewrite sin_0 in H11.
   rewrite Rminus_0_r in H11; apply H11.
-  unfold Rdiv in |- *; apply prod_neq_R0.
+  unfold Rdiv; apply prod_neq_R0.
   apply H7.
   apply Rinv_neq_0_compat; discrR.
   apply Rlt_trans with (del / 2).
-  unfold Rdiv in |- *; rewrite Rabs_mult.
+  unfold Rdiv; rewrite Rabs_mult.
   rewrite (Rabs_right (/ 2)).
   do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
   apply Rinv_0_lt_compat; prove_sup0.
   apply Rlt_le_trans with (pos delta).
   apply H8.
-  unfold delta in |- *; simpl in |- *; apply Rmin_l.
+  unfold delta; simpl; apply Rmin_l.
   apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0.
-  rewrite <- (Rplus_0_r (del / 2)); pattern del at 1 in |- *;
+  rewrite <- (Rplus_0_r (del / 2)); pattern del at 1;
     rewrite (double_var del); apply Rplus_lt_compat_l;
-      unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+      unfold Rdiv; apply Rmult_lt_0_compat.
   apply (cond_pos del).
   apply Rinv_0_lt_compat; prove_sup0.
   elim H5; intros; assert (H11 := H10 (h / 2)).
   rewrite sin_0 in H11; do 2 rewrite Rminus_0_r in H11.
   apply H11.
   split.
-  unfold D_x, no_cond in |- *; split.
+  unfold D_x, no_cond; split.
   trivial.
-  apply (sym_not_eq (A:=R)); unfold Rdiv in |- *; apply prod_neq_R0.
+  apply (not_eq_sym (A:=R)); unfold Rdiv; apply prod_neq_R0.
   apply H7.
   apply Rinv_neq_0_compat; discrR.
   apply Rlt_trans with (del_c / 2).
-  unfold Rdiv in |- *; rewrite Rabs_mult.
+  unfold Rdiv; rewrite Rabs_mult.
   rewrite (Rabs_right (/ 2)).
   do 2 rewrite <- (Rmult_comm (/ 2)).
   apply Rmult_lt_compat_l.
   apply Rinv_0_lt_compat; prove_sup0.
   apply Rlt_le_trans with (pos delta).
   apply H8.
-  unfold delta in |- *; simpl in |- *; apply Rmin_r.
+  unfold delta; simpl; apply Rmin_r.
   apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0.
-  rewrite <- (Rplus_0_r (del_c / 2)); pattern del_c at 2 in |- *;
+  rewrite <- (Rplus_0_r (del_c / 2)); pattern del_c at 2;
     rewrite (double_var del_c); apply Rplus_lt_compat_l.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   apply H9.
   apply Rinv_0_lt_compat; prove_sup0.
-  rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus in |- *;
+  rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus;
     rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
-      rewrite (Rmult_comm 2); unfold Rdiv, Rsqr in |- *.
+      rewrite (Rmult_comm 2); unfold Rdiv, Rsqr.
   repeat rewrite Rmult_assoc.
   repeat apply Rmult_eq_compat_l.
   rewrite Rinv_mult_distr.
@@ -475,16 +327,16 @@ Proof.
   discrR.
   apply H7.
   apply Rinv_neq_0_compat; discrR.
-  pattern h at 2 in |- *; replace h with (2 * (h / 2)).
+  pattern h at 2; replace h with (2 * (h / 2)).
   rewrite (cos_2a_sin (h / 2)).
-  rewrite cos_0; unfold Rsqr in |- *; ring.
-  unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+  rewrite cos_0; unfold Rsqr; ring.
+  unfold Rdiv; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
   discrR.
-  unfold Rmin in |- *; case (Rle_dec del del_c); intro.
+  unfold Rmin; case (Rle_dec del del_c); intro.
   apply (cond_pos del).
   elim H5; intros; assumption.
   apply continuity_sin.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
 Qed.
 
@@ -494,10 +346,10 @@ Proof.
   intro; assert (H0 := derivable_pt_lim_sin_0).
   assert (H := derivable_pt_lim_cos_0).
   unfold derivable_pt_lim in H0, H.
-  unfold derivable_pt_lim in |- *; intros.
+  unfold derivable_pt_lim; intros.
   cut (0 < eps / 2);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ apply H1 | apply Rinv_0_lt_compat; prove_sup0 ] ].
   elim (H0 _ H2); intros alp1 H3.
   elim (H _ H2); intros alp2 H4.
@@ -512,11 +364,11 @@ Proof.
   rewrite (double_var eps); apply Rplus_lt_compat.
   apply Rle_lt_trans with (Rabs ((cos h - 1) / h)).
   rewrite Rabs_mult; rewrite Rmult_comm;
-    pattern (Rabs ((cos h - 1) / h)) at 2 in |- *; rewrite <- Rmult_1_r;
+    pattern (Rabs ((cos h - 1) / h)) at 2; rewrite <- Rmult_1_r;
       apply Rmult_le_compat_l.
   apply Rabs_pos.
   assert (H8 := SIN_bound x); elim H8; intros.
-  unfold Rabs in |- *; case (Rcase_abs (sin x)); intro.
+  unfold Rabs; case (Rcase_abs (sin x)); intro.
   rewrite <- (Ropp_involutive 1).
   apply Ropp_le_contravar; assumption.
   assumption.
@@ -526,14 +378,14 @@ Proof.
     apply H9.
   apply Rlt_le_trans with alp.
   apply H7.
-  unfold alp in |- *; apply Rmin_r.
+  unfold alp; apply Rmin_r.
   apply Rle_lt_trans with (Rabs (sin h / h - 1)).
   rewrite Rabs_mult; rewrite Rmult_comm;
-    pattern (Rabs (sin h / h - 1)) at 2 in |- *; rewrite <- Rmult_1_r;
+    pattern (Rabs (sin h / h - 1)) at 2; rewrite <- Rmult_1_r;
       apply Rmult_le_compat_l.
   apply Rabs_pos.
   assert (H8 := COS_bound x); elim H8; intros.
-  unfold Rabs in |- *; case (Rcase_abs (cos x)); intro.
+  unfold Rabs; case (Rcase_abs (cos x)); intro.
   rewrite <- (Ropp_involutive 1); apply Ropp_le_contravar; assumption.
   assumption.
   cut (Rabs h < alp1).
@@ -542,8 +394,8 @@ Proof.
     apply H9.
   apply Rlt_le_trans with alp.
   apply H7.
-  unfold alp in |- *; apply Rmin_l.
-  rewrite sin_plus; unfold Rminus, Rdiv in |- *;
+  unfold alp; apply Rmin_l.
+  rewrite sin_plus; unfold Rminus, Rdiv;
     repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
       repeat rewrite Rmult_assoc; repeat rewrite Rplus_assoc;
         apply Rplus_eq_compat_l.
@@ -552,7 +404,7 @@ Proof.
   rewrite Ropp_mult_distr_r_reverse; rewrite Ropp_mult_distr_l_reverse;
     rewrite Rmult_1_r; rewrite Rmult_1_l; rewrite Ropp_mult_distr_r_reverse;
       rewrite <- Ropp_mult_distr_l_reverse; apply Rplus_comm.
-  unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec alp1 alp2); intro.
+  unfold alp; unfold Rmin; case (Rle_dec alp1 alp2); intro.
   apply (cond_pos alp1).
   apply (cond_pos alp2).
 Qed.
@@ -567,7 +419,7 @@ Proof.
   intros; generalize (H0 _ _ _ H2 H1);
     replace (comp sin (id + fct_cte (PI / 2))%F) with
     (fun x:R => sin (x + PI / 2)); [ idtac | reflexivity ].
-  unfold derivable_pt_lim in |- *; intros.
+  unfold derivable_pt_lim; intros.
   elim (H3 eps H4); intros.
   exists x0.
   intros; rewrite <- (H (x + h)); rewrite <- (H x); apply H5; assumption.
@@ -581,26 +433,26 @@ Qed.
 
 Lemma derivable_pt_sin : forall x:R, derivable_pt sin x.
 Proof.
-  unfold derivable_pt in |- *; intro.
+  unfold derivable_pt; intro.
   exists (cos x).
   apply derivable_pt_lim_sin.
 Qed.
 
 Lemma derivable_pt_cos : forall x:R, derivable_pt cos x.
 Proof.
-  unfold derivable_pt in |- *; intro.
+  unfold derivable_pt; intro.
   exists (- sin x).
   apply derivable_pt_lim_cos.
 Qed.
 
 Lemma derivable_sin : derivable sin.
 Proof.
-  unfold derivable in |- *; intro; apply derivable_pt_sin.
+  unfold derivable; intro; apply derivable_pt_sin.
 Qed.
 
 Lemma derivable_cos : derivable cos.
 Proof.
-  unfold derivable in |- *; intro; apply derivable_pt_cos.
+  unfold derivable; intro; apply derivable_pt_cos.
 Qed.
 
 Lemma derive_pt_sin :
diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v
index 7a1319ea..41e853cc 100644
--- a/theories/Reals/SeqProp.v
+++ b/theories/Reals/SeqProp.v
@@ -1,19 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: SeqProp.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rseries.
-Require Import Classical.
 Require Import Max.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (*****************************************************************)
 (**           Convergence properties of sequences                *)
@@ -29,38 +26,17 @@ Definition has_lb (Un:nat -> R) : Prop := bound (EUn (opp_seq Un)).
 Lemma growing_cv :
   forall Un:nat -> R, Un_growing Un -> has_ub Un -> { l:R | Un_cv Un l }.
 Proof.
-  unfold Un_growing, Un_cv in |- *; intros;
-    destruct (completeness (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]].
-  exists x; intros eps H1.
-  unfold is_upper_bound in H2, H3.
-  assert (H5 : forall n:nat, Un n <= x).
-  intro n; apply (H2 (Un n) (Un_in_EUn Un n)).
-  cut (exists N : nat, x - eps < Un N).
-  intro H6; destruct H6 as [N H6]; exists N.
-  intros n H7; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps).
-  unfold Rgt in H1.
-  apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H1).
-  fold Un_growing in H; generalize (growing_prop Un n N H H7); intro H8.
-  generalize
-    (Rlt_le_trans (x - eps) (Un N) (Un n) H6 (Rge_le (Un n) (Un N) H8));
-    intro H9; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9);
-      unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps));
-        rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *;
-          rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2);
-            trivial.
-  cut (~ (forall N:nat, Un N <= x - eps)).
-  intro H6; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)).
-  intro H7; apply H6; intro N; apply Rnot_lt_le; apply H7.
-  intro H7; generalize (Un_bound_imp Un (x - eps) H7); intro H8;
-    unfold is_upper_bound in H8; generalize (H3 (x - eps) H8);
-      apply Rlt_not_le; apply tech_Rgt_minus; exact H1.
+  intros Un Hug Heub.
+  exists (projT1 (completeness (EUn Un) Heub (EUn_noempty Un))).
+  destruct (completeness _ Heub (EUn_noempty Un)) as (l, H).
+  now apply Un_cv_crit_lub.
 Qed.
 
 Lemma decreasing_growing :
   forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un).
 Proof.
   intro.
-  unfold Un_growing, opp_seq, Un_decreasing in |- *.
+  unfold Un_growing, opp_seq, Un_decreasing.
   intros.
   apply Ropp_le_contravar.
   apply H.
@@ -82,8 +58,8 @@ Proof.
   unfold Un_cv in p.
   unfold R_dist in p.
   unfold opp_seq in p.
-  unfold Un_cv in |- *.
-  unfold R_dist in |- *.
+  unfold Un_cv.
+  unfold R_dist.
   intros.
   elim (p eps H1); intros.
   exists x0; intros.
@@ -101,7 +77,7 @@ Proof.
   apply completeness.
   assumption.
   exists (Un 0%nat).
-  unfold EUn in |- *.
+  unfold EUn.
   exists 0%nat; reflexivity.
 Qed.
 
@@ -138,9 +114,9 @@ Proof.
   unfold bound in H.
   elim H; intros.
   unfold is_upper_bound in H0.
-  unfold has_ub in |- *.
+  unfold has_ub.
   exists x.
-  unfold is_upper_bound in |- *.
+  unfold is_upper_bound.
   intros.
   apply H0.
   elim H1; intros.
@@ -156,9 +132,9 @@ Proof.
   unfold bound in H.
   elim H; intros.
   unfold is_upper_bound in H0.
-  unfold has_lb in |- *.
+  unfold has_lb.
   exists x.
-  unfold is_upper_bound in |- *.
+  unfold is_upper_bound.
   intros.
   apply H0.
   elim H1; intros.
@@ -179,9 +155,9 @@ Lemma Wn_decreasing :
   forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_ub Un pr).
 Proof.
   intros.
-  unfold Un_decreasing in |- *.
+  unfold Un_decreasing.
   intro.
-  unfold sequence_ub in |- *.
+  unfold sequence_ub.
   assert (H := ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
   assert (H0 := ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
   elim H; intros.
@@ -195,7 +171,7 @@ Proof.
   elim p; intros.
   apply H2.
   elim p0; intros.
-  unfold is_upper_bound in |- *.
+  unfold is_upper_bound.
   intros.
   unfold is_upper_bound in H3.
   apply H3.
@@ -214,7 +190,7 @@ Proof.
   assert
     (H7 := H3 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4).
   apply Rle_antisym; assumption.
-  unfold lub in |- *.
+  unfold lub.
   case (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
   trivial.
   cut
@@ -228,7 +204,7 @@ Proof.
     (H7 :=
       H3 (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4).
   apply Rle_antisym; assumption.
-  unfold lub in |- *.
+  unfold lub.
   case (ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
   trivial.
 Qed.
@@ -237,9 +213,9 @@ Lemma Vn_growing :
   forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_lb Un pr).
 Proof.
   intros.
-  unfold Un_growing in |- *.
+  unfold Un_growing.
   intro.
-  unfold sequence_lb in |- *.
+  unfold sequence_lb.
   assert (H := lb_to_glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)).
   assert (H0 := lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)).
   elim H; intros.
@@ -254,14 +230,14 @@ Proof.
   apply Ropp_le_contravar.
   apply H2.
   elim p0; intros.
-  unfold is_upper_bound in |- *.
+  unfold is_upper_bound.
   intros.
   unfold is_upper_bound in H3.
   apply H3.
   elim H5; intros.
   exists (1 + x2)%nat.
   unfold opp_seq in H6.
-  unfold opp_seq in |- *.
+  unfold opp_seq.
   replace (n + (1 + x2))%nat with (S n + x2)%nat.
   assumption.
   replace (S n) with (1 + n)%nat; [ ring | ring ].
@@ -278,7 +254,7 @@ Proof.
     (Ropp_involutive (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)))
     .
   apply Ropp_eq_compat; apply Rle_antisym; assumption.
-  unfold glb in |- *.
+  unfold glb.
   case (lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)); simpl.
   intro; rewrite Ropp_involutive.
   trivial.
@@ -297,7 +273,7 @@ Proof.
       (glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)))
     .
   apply Ropp_eq_compat; apply Rle_antisym; assumption.
-  unfold glb in |- *.
+  unfold glb.
   case (lb_to_glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)); simpl.
   intro; rewrite Ropp_involutive.
   trivial.
@@ -310,7 +286,7 @@ Lemma Vn_Un_Wn_order :
 Proof.
   intros.
   split.
-  unfold sequence_lb in |- *.
+  unfold sequence_lb.
   cut { l:R | is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l }.
   intro X.
   elim X; intros.
@@ -322,7 +298,7 @@ Proof.
   apply Ropp_le_contravar.
   apply H.
   exists 0%nat.
-  unfold opp_seq in |- *.
+  unfold opp_seq.
   replace (n + 0)%nat with n; [ reflexivity | ring ].
   cut
     (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat)))
@@ -337,13 +313,13 @@ Proof.
     (Ropp_involutive (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)))
     .
   apply Ropp_eq_compat; apply Rle_antisym; assumption.
-  unfold glb in |- *.
+  unfold glb.
   case (lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)); simpl.
   intro; rewrite Ropp_involutive.
   trivial.
   apply lb_to_glb.
   apply min_ss; assumption.
-  unfold sequence_ub in |- *.
+  unfold sequence_ub.
   cut { l:R | is_lub (EUn (fun i:nat => Un (n + i)%nat)) l }.
   intro X.
   elim X; intros.
@@ -364,7 +340,7 @@ Proof.
   assert
     (H5 := H1 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2).
   apply Rle_antisym; assumption.
-  unfold lub in |- *.
+  unfold lub.
   case (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)).
   intro; trivial.
   apply ub_to_lub.
@@ -377,13 +353,13 @@ Lemma min_maj :
 Proof.
   intros.
   assert (H := Vn_Un_Wn_order Un pr1 pr2).
-  unfold has_ub in |- *.
-  unfold bound in |- *.
+  unfold has_ub.
+  unfold bound.
   unfold has_ub in pr1.
   unfold bound in pr1.
   elim pr1; intros.
   exists x.
-  unfold is_upper_bound in |- *.
+  unfold is_upper_bound.
   intros.
   unfold is_upper_bound in H0.
   elim H1; intros.
@@ -400,20 +376,20 @@ Lemma maj_min :
 Proof.
   intros.
   assert (H := Vn_Un_Wn_order Un pr1 pr2).
-  unfold has_lb in |- *.
-  unfold bound in |- *.
+  unfold has_lb.
+  unfold bound.
   unfold has_lb in pr2.
   unfold bound in pr2.
   elim pr2; intros.
   exists x.
-  unfold is_upper_bound in |- *.
+  unfold is_upper_bound.
   intros.
   unfold is_upper_bound in H0.
   elim H1; intros.
   rewrite H2.
   apply Rle_trans with (opp_seq Un x1).
   assert (H3 := H x1); elim H3; intros.
-  unfold opp_seq in |- *; apply Ropp_le_contravar.
+  unfold opp_seq; apply Ropp_le_contravar.
   assumption.
   apply H0.
   exists x1; reflexivity.
@@ -423,7 +399,7 @@ Qed.
 Lemma cauchy_maj : forall Un:nat -> R, Cauchy_crit Un -> has_ub Un.
 Proof.
   intros.
-  unfold has_ub in |- *.
+  unfold has_ub.
   apply cauchy_bound.
   assumption.
 Qed.
@@ -433,12 +409,12 @@ Lemma cauchy_opp :
   forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un).
 Proof.
   intro.
-  unfold Cauchy_crit in |- *.
-  unfold R_dist in |- *.
+  unfold Cauchy_crit.
+  unfold R_dist.
   intros.
   elim (H eps H0); intros.
   exists x; intros.
-  unfold opp_seq in |- *.
+  unfold opp_seq.
   rewrite <- Rabs_Ropp.
   replace (- (- Un n - - Un m)) with (Un n - Un m);
   [ apply H1; assumption | ring ].
@@ -448,7 +424,7 @@ Qed.
 Lemma cauchy_min : forall Un:nat -> R, Cauchy_crit Un -> has_lb Un.
 Proof.
   intros.
-  unfold has_lb in |- *.
+  unfold has_lb.
   assert (H0 := cauchy_opp _ H).
   apply cauchy_bound.
   assumption.
@@ -509,7 +485,7 @@ Qed.
 
 Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2.
 Proof.
-  intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *.
+  intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge.
   tauto.
 Qed.
 
@@ -518,68 +494,77 @@ Lemma approx_maj :
   forall (Un:nat -> R) (pr:has_ub Un) (eps:R),
     0 < eps ->  exists k : nat, Rabs (lub Un pr - Un k) < eps.
 Proof.
-  intros.
-  set (P := fun k:nat => Rabs (lub Un pr - Un k) < eps).
-  unfold P in |- *.
-  cut
-    ((exists k : nat, P k) ->
-      exists k : nat, Rabs (lub Un pr - Un k) < eps).
-  intros.
-  apply H0.
-  apply not_all_not_ex.
-  red in |- *; intro.
-  2: unfold P in |- *; trivial.
-  unfold P in H1.
-  cut (forall n:nat, Rabs (lub Un pr - Un n) >= eps).
-  intro.
-  cut (is_lub (EUn Un) (lub Un pr)).
-  intro.
-  unfold is_lub in H3.
-  unfold is_upper_bound in H3.
-  elim H3; intros.
-  cut (forall n:nat, eps <= lub Un pr - Un n).
-  intro.
-  cut (forall n:nat, Un n <= lub Un pr - eps).
-  intro.
-  cut (forall x:R, EUn Un x -> x <= lub Un pr - eps).
-  intro.
-  assert (H9 := H5 (lub Un pr - eps) H8).
-  cut (eps <= 0).
-  intro.
-  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)).
-  apply Rplus_le_reg_l with (lub Un pr - eps).
-  rewrite Rplus_0_r.
-  replace (lub Un pr - eps + eps) with (lub Un pr);
-  [ assumption | ring ].
-  intros.
-  unfold EUn in H8.
-  elim H8; intros.
-  rewrite H9; apply H7.
-  intro.
-  assert (H7 := H6 n).
-  apply Rplus_le_reg_l with (eps - Un n).
-  replace (eps - Un n + Un n) with eps.
-  replace (eps - Un n + (lub Un pr - eps)) with (lub Un pr - Un n).
-  assumption.
-  ring.
-  ring.
-  intro.
-  assert (H6 := H2 n).
-  rewrite Rabs_right in H6.
-  apply Rge_le.
-  assumption.
-  apply Rle_ge.
-  apply Rplus_le_reg_l with (Un n).
-  rewrite Rplus_0_r;
-    replace (Un n + (lub Un pr - Un n)) with (lub Un pr);
-    [ apply H4 | ring ].
-  exists n; reflexivity.
-  unfold lub in |- *.
-  case (ub_to_lub Un pr).
-  trivial.
-  intro.
-  assert (H2 := H1 n).
-  apply not_Rlt; assumption.
+  intros Un pr.
+  pose (Vn := fix aux n := match n with S n' => if Rle_lt_dec (aux n') (Un n) then Un n else aux n' | O => Un O end).
+  pose (In := fix aux n := match n with S n' => if Rle_lt_dec (Vn n) (Un n) then n else aux n' | O => O end).
+
+  assert (VUI: forall n, Vn n = Un (In n)).
+  induction n.
+  easy.
+  simpl.
+  destruct (Rle_lt_dec (Vn n) (Un (S n))) as [H1|H1].
+  destruct (Rle_lt_dec (Un (S n)) (Un (S n))) as [H2|H2].
+  easy.
+  elim (Rlt_irrefl _ H2).
+  destruct (Rle_lt_dec (Vn n) (Un (S n))) as [H2|H2].
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 H1)).
+  exact IHn.
+
+  assert (HubV : has_ub Vn).
+  destruct pr as (ub, Hub).
+  exists ub.
+  intros x (n, Hn).
+  rewrite Hn, VUI.
+  apply Hub.
+  now exists (In n).
+
+  assert (HgrV : Un_growing Vn).
+  intros n.
+  induction n.
+  simpl.
+  destruct (Rle_lt_dec (Un O) (Un 1%nat)) as [H|_].
+  exact H.
+  apply Rle_refl.
+  simpl.
+  destruct (Rle_lt_dec (Vn n) (Un (S n))) as [H1|H1].
+  destruct (Rle_lt_dec (Un (S n)) (Un (S (S n)))) as [H2|H2].
+  exact H2.
+  apply Rle_refl.
+  destruct (Rle_lt_dec (Vn n) (Un (S (S n)))) as [H2|H2].
+  exact H2.
+  apply Rle_refl.
+
+  destruct (ub_to_lub Vn HubV) as (l, Hl).
+  unfold lub.
+  destruct (ub_to_lub Un pr) as (l', Hl').
+  replace l' with l.
+  intros eps Heps.
+  destruct (Un_cv_crit_lub Vn HgrV l Hl eps Heps) as (n, Hn).
+  exists (In n).
+  rewrite <- VUI.
+  rewrite Rabs_minus_sym.
+  apply Hn.
+  apply le_refl.
+
+  apply Rle_antisym.
+  apply Hl.
+  intros n (k, Hk).
+  rewrite Hk, VUI.
+  apply Hl'.
+  now exists (In k).
+  apply Hl'.
+  intros n (k, Hk).
+  rewrite Hk.
+  apply Rle_trans with (Vn k).
+  clear.
+  induction k.
+  apply Rle_refl.
+  simpl.
+  destruct (Rle_lt_dec (Vn k) (Un (S k))) as [H|H].
+  apply Rle_refl.
+  now apply Rlt_le.
+  apply Hl.
+  now exists k.
 Qed.
 
 (**********)
@@ -587,83 +572,34 @@ Lemma approx_min :
   forall (Un:nat -> R) (pr:has_lb Un) (eps:R),
     0 < eps ->  exists k : nat, Rabs (glb Un pr - Un k) < eps.
 Proof.
-  intros.
-  set (P := fun k:nat => Rabs (glb Un pr - Un k) < eps).
-  unfold P in |- *.
-  cut
-    ((exists k : nat, P k) ->
-      exists k : nat, Rabs (glb Un pr - Un k) < eps).
-  intros.
-  apply H0.
-  apply not_all_not_ex.
-  red in |- *; intro.
-  2: unfold P in |- *; trivial.
-  unfold P in H1.
-  cut (forall n:nat, Rabs (glb Un pr - Un n) >= eps).
-  intro.
-  cut (is_lub (EUn (opp_seq Un)) (- glb Un pr)).
-  intro.
-  unfold is_lub in H3.
-  unfold is_upper_bound in H3.
-  elim H3; intros.
-  cut (forall n:nat, eps <= Un n - glb Un pr).
-  intro.
-  cut (forall n:nat, opp_seq Un n <= - glb Un pr - eps).
-  intro.
-  cut (forall x:R, EUn (opp_seq Un) x -> x <= - glb Un pr - eps).
-  intro.
-  assert (H9 := H5 (- glb Un pr - eps) H8).
-  cut (eps <= 0).
-  intro.
-  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)).
-  apply Rplus_le_reg_l with (- glb Un pr - eps).
-  rewrite Rplus_0_r.
-  replace (- glb Un pr - eps + eps) with (- glb Un pr);
-  [ assumption | ring ].
-  intros.
-  unfold EUn in H8.
-  elim H8; intros.
-  rewrite H9; apply H7.
-  intro.
-  assert (H7 := H6 n).
-  unfold opp_seq in |- *.
-  apply Rplus_le_reg_l with (eps + Un n).
-  replace (eps + Un n + - Un n) with eps.
-  replace (eps + Un n + (- glb Un pr - eps)) with (Un n - glb Un pr).
-  assumption.
-  ring.
-  ring.
-  intro.
-  assert (H6 := H2 n).
-  rewrite Rabs_left1 in H6.
-  apply Rge_le.
-  replace (Un n - glb Un pr) with (- (glb Un pr - Un n));
-  [ assumption | ring ].
-  apply Rplus_le_reg_l with (- glb Un pr).
-  rewrite Rplus_0_r;
-    replace (- glb Un pr + (glb Un pr - Un n)) with (- Un n).
-  apply H4.
-  exists n; reflexivity.
-  ring.
-  unfold glb in |- *.
-  case (lb_to_glb Un pr); simpl.
-  intro.
-  rewrite Ropp_involutive.
-  trivial.
-  intro.
-  assert (H2 := H1 n).
-  apply not_Rlt; assumption.
+  intros Un pr.
+  unfold glb.
+  destruct lb_to_glb as (lb, Hlb).
+  intros eps Heps.
+  destruct (approx_maj _ pr eps Heps) as (n, Hn).
+  exists n.
+  unfold Rminus.
+  rewrite <- Ropp_plus_distr, Rabs_Ropp.
+  replace lb with (lub (opp_seq Un) pr).
+  now rewrite <- (Ropp_involutive (Un n)).
+  unfold lub.
+  destruct ub_to_lub as (ub, Hub).
+  apply Rle_antisym.
+  apply Hub.
+  apply Hlb.
+  apply Hlb.
+  apply Hub.
 Qed.
 
 (** Unicity of limit for convergent sequences *)
 Lemma UL_sequence :
   forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2.
 Proof.
-  intros Un l1 l2; unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  intros Un l1 l2; unfold Un_cv; unfold R_dist; intros.
   apply cond_eq.
   intros; cut (0 < eps / 2);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
   elim (H (eps / 2) H2); intros.
   elim (H0 (eps / 2) H2); intros.
@@ -673,8 +609,8 @@ Proof.
   [ apply Rabs_triang | ring ].
   rewrite (double_var eps); apply Rplus_lt_compat.
   rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3;
-    unfold ge, N in |- *; apply le_max_l.
-  apply H4; unfold ge, N in |- *; apply le_max_r.
+    unfold ge, N; apply le_max_l.
+  apply H4; unfold ge, N; apply le_max_r.
 Qed.
 
 (**********)
@@ -682,10 +618,10 @@ Lemma CV_plus :
   forall (An Bn:nat -> R) (l1 l2:R),
     Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2).
 Proof.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   cut (0 < eps / 2);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
   elim (H (eps / 2) H2); intros.
   elim (H0 (eps / 2) H2); intros.
@@ -696,10 +632,10 @@ Proof.
   apply Rle_lt_trans with (Rabs (An n - l1) + Rabs (Bn n - l2)).
   apply Rabs_triang.
   rewrite (double_var eps); apply Rplus_lt_compat.
-  apply H3; unfold ge in |- *; apply le_trans with N;
-    [ unfold N in |- *; apply le_max_l | assumption ].
-  apply H4; unfold ge in |- *; apply le_trans with N;
-    [ unfold N in |- *; apply le_max_r | assumption ].
+  apply H3; unfold ge; apply le_trans with N;
+    [ unfold N; apply le_max_l | assumption ].
+  apply H4; unfold ge; apply le_trans with N;
+    [ unfold N; apply le_max_r | assumption ].
 Qed.
 
 (**********)
@@ -707,7 +643,7 @@ Lemma cv_cvabs :
   forall (Un:nat -> R) (l:R),
     Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l).
 Proof.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   elim (H eps H0); intros.
   exists x; intros.
   apply Rle_lt_trans with (Rabs (Un n - l)).
@@ -720,15 +656,15 @@ Lemma CV_Cauchy :
   forall Un:nat -> R, { l:R | Un_cv Un l } -> Cauchy_crit Un.
 Proof.
   intros Un X; elim X; intros.
-  unfold Cauchy_crit in |- *; intros.
+  unfold Cauchy_crit; intros.
   unfold Un_cv in p; unfold R_dist in p.
   cut (0 < eps / 2);
     [ intro
-      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      | unfold Rdiv; apply Rmult_lt_0_compat;
         [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
   elim (p (eps / 2) H0); intros.
   exists x0; intros.
-  unfold R_dist in |- *;
+  unfold R_dist;
     apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)).
   replace (Un n - Un m) with (Un n - x + (x - Un m));
   [ apply Rabs_triang | ring ].
@@ -759,7 +695,7 @@ Proof.
   unfold is_upper_bound in H1.
   apply H1.
   exists n; reflexivity.
-  pattern x0 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+  pattern x0 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
     apply Rlt_0_1.
   apply Rle_trans with (Rabs (Un 0%nat)).
   apply Rabs_pos.
@@ -781,7 +717,7 @@ Proof.
   assert (H1 := maj_by_pos An X).
   elim H1; intros M H2.
   elim H2; intros.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   cut (0 < eps / (2 * M)).
   intro.
   case (Req_dec l2 0); intro.
@@ -808,24 +744,24 @@ Proof.
   rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
   apply Rlt_trans with (eps / (2 * M)).
   apply H8; assumption.
-  unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  unfold Rdiv; rewrite Rinv_mult_distr.
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
   replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M));
   [ idtac | ring ].
   rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l; rewrite double.
-  pattern (eps * / M) at 1 in |- *; rewrite <- Rplus_0_r.
+  pattern (eps * / M) at 1; rewrite <- Rplus_0_r.
   apply Rplus_lt_compat_l; apply Rmult_lt_0_compat;
     [ assumption | apply Rinv_0_lt_compat; assumption ].
   discrR.
   discrR.
-  red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
-  red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
-  rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus in |- *;
+  red; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
+  red; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
+  rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus;
     rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity.
   replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ idtac | ring ].
-  symmetry  in |- *; apply Rabs_mult.
+  symmetry ; apply Rabs_mult.
   cut (0 < eps / (2 * Rabs l2)).
   intro.
   unfold Un_cv in H; unfold R_dist in H; unfold Un_cv in H0;
@@ -854,36 +790,36 @@ Proof.
   rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
   apply Rlt_le_trans with (eps / (2 * M)).
   apply H10.
-  unfold ge in |- *; apply le_trans with N.
-  unfold N in |- *; apply le_max_r.
+  unfold ge; apply le_trans with N.
+  unfold N; apply le_max_r.
   assumption.
-  unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  unfold Rdiv; rewrite Rinv_mult_distr.
   right; ring.
   discrR.
-  red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
-  red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
+  red; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
+  red; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
   apply Rmult_lt_reg_l with (/ Rabs l2).
   apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
   rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)).
   apply H9.
-  unfold ge in |- *; apply le_trans with N.
-  unfold N in |- *; apply le_max_l.
+  unfold ge; apply le_trans with N.
+  unfold N; apply le_max_l.
   assumption.
-  unfold Rdiv in |- *; right; rewrite Rinv_mult_distr.
+  unfold Rdiv; right; rewrite Rinv_mult_distr.
   ring.
   discrR.
   apply Rabs_no_R0; assumption.
   apply Rabs_no_R0; assumption.
   replace (An n * l2 - l1 * l2) with (l2 * (An n - l1));
-  [ symmetry  in |- *; apply Rabs_mult | ring ].
+  [ symmetry ; apply Rabs_mult | ring ].
   replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2));
-  [ symmetry  in |- *; apply Rabs_mult | ring ].
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  [ symmetry ; apply Rabs_mult | ring ].
+  unfold Rdiv; apply Rmult_lt_0_compat.
   assumption.
   apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
     [ prove_sup0 | apply Rabs_pos_lt; assumption ].
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+  unfold Rdiv; apply Rmult_lt_0_compat;
     [ assumption
       | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
         [ prove_sup0 | assumption ] ].
@@ -910,73 +846,6 @@ Proof.
   left; assumption.
 Qed.
 
-Lemma tech10 :
-  forall (Un:nat -> R) (x:R), Un_growing Un -> is_lub (EUn Un) x -> Un_cv Un x.
-Proof.
-  intros; cut (bound (EUn Un)).
-  intro; assert (H2 := Un_cv_crit _ H H1).
-  elim H2; intros.
-  case (total_order_T x x0); intro.
-  elim s; intro.
-  cut (forall n:nat, Un n <= x).
-  intro; unfold Un_cv in H3; cut (0 < x0 - x).
-  intro; elim (H3 (x0 - x) H5); intros.
-  cut (x1 >= x1)%nat.
-  intro; assert (H8 := H6 x1 H7).
-  unfold R_dist in H8; rewrite Rabs_left1 in H8.
-  rewrite Ropp_minus_distr in H8; unfold Rminus in H8.
-  assert (H9 := Rplus_lt_reg_r x0 _ _ H8).
-  assert (H10 := Ropp_lt_cancel _ _ H9).
-  assert (H11 := H4 x1).
-  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H11)).
-  apply Rle_minus; apply Rle_trans with x.
-  apply H4.
-  left; assumption.
-  unfold ge in |- *; apply le_n.
-  apply Rgt_minus; assumption.
-  intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros.
-  apply H4; unfold EUn in |- *; exists n; reflexivity.
-  rewrite b; assumption.
-  cut (forall n:nat, Un n <= x0).
-  intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros.
-  cut (forall y:R, EUn Un y -> y <= x0).
-  intro; assert (H8 := H6 _ H7).
-  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 r)).
-  unfold EUn in |- *; intros; elim H7; intros.
-  rewrite H8; apply H4.
-  intro; case (Rle_dec (Un n) x0); intro.
-  assumption.
-  cut (forall n0:nat, (n <= n0)%nat -> x0 < Un n0).
-  intro; unfold Un_cv in H3; cut (0 < Un n - x0).
-  intro; elim (H3 (Un n - x0) H5); intros.
-  cut (max n x1 >= x1)%nat.
-  intro; assert (H8 := H6 (max n x1) H7).
-  unfold R_dist in H8.
-  rewrite Rabs_right in H8.
-  unfold Rminus in H8; do 2 rewrite <- (Rplus_comm (- x0)) in H8.
-  assert (H9 := Rplus_lt_reg_r _ _ _ H8).
-  cut (Un n <= Un (max n x1)).
-  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H9)).
-  apply tech9; [ assumption | apply le_max_l ].
-  apply Rge_trans with (Un n - x0).
-  unfold Rminus in |- *; apply Rle_ge; do 2 rewrite <- (Rplus_comm (- x0));
-    apply Rplus_le_compat_l.
-  apply tech9; [ assumption | apply le_max_l ].
-  left; assumption.
-  unfold ge in |- *; apply le_max_r.
-  apply Rplus_lt_reg_r with x0.
-  rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm x0);
-    rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
-      apply H4; apply le_n.
-  intros; apply Rlt_le_trans with (Un n).
-  case (Rlt_le_dec x0 (Un n)); intro.
-  assumption.
-  elim n0; assumption.
-  apply tech9; assumption.
-  unfold bound in |- *; exists x; unfold is_lub in H0; elim H0; intros;
-    assumption.
-Qed.
-
 Lemma tech13 :
   forall (An:nat -> R) (k:R),
     0 <= k < 1 ->
@@ -989,15 +858,15 @@ Proof.
   intros; exists (k + (1 - k) / 2).
   split.
   split.
-  pattern k at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  pattern k at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1;
     [ elim H; intros; assumption | ring ].
   apply Rinv_0_lt_compat; prove_sup0.
   apply Rmult_lt_reg_l with 2.
   prove_sup0.
-  unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l;
-    pattern 2 at 1 in |- *; rewrite Rmult_comm; rewrite Rmult_assoc;
+  unfold Rdiv; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l;
+    pattern 2 at 1; rewrite Rmult_comm; rewrite Rmult_assoc;
       rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r;
         replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ].
   elim H; intros.
@@ -1016,7 +885,7 @@ Proof.
     repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
       repeat rewrite Rplus_0_l; apply H4.
   apply Rle_ge; elim H; intros; assumption.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros;
     replace (k + (1 - k)) with 1; [ assumption | ring ].
   apply Rinv_0_lt_compat; prove_sup0.
@@ -1041,12 +910,12 @@ Proof.
   apply Rle_lt_trans with (Rabs (Un N - l)).
   apply RRle_abs.
   apply H2.
-  unfold ge, N in |- *; apply le_max_r.
-  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l));
+  unfold ge, N; apply le_max_r.
+  unfold Rminus; do 2 rewrite <- (Rplus_comm (- l));
     apply Rplus_le_compat_l.
   apply tech9.
   assumption.
-  unfold N in |- *; apply le_max_l.
+  unfold N; apply le_max_l.
   apply Rplus_lt_reg_r with l.
   rewrite Rplus_0_r.
   replace (l + (Un n - l)) with (Un n); [ assumption | ring ].
@@ -1057,10 +926,10 @@ Lemma CV_opp :
   forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l).
 Proof.
   intros An l.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   elim (H eps H0); intros.
   exists x; intros.
-  unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l));
+  unfold opp_seq; replace (- An n - - l) with (- (An n - l));
     [ rewrite Rabs_Ropp | ring ].
   apply H1; assumption.
 Qed.
@@ -1085,10 +954,10 @@ Lemma CV_minus :
 Proof.
   intros.
   replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i).
-  unfold Rminus in |- *; apply CV_plus.
+  unfold Rminus; apply CV_plus.
   assumption.
   apply CV_opp; assumption.
-  unfold Rminus, opp_seq in |- *; reflexivity.
+  unfold Rminus, opp_seq; reflexivity.
 Qed.
 
 (** Un -> +oo *)
@@ -1100,10 +969,10 @@ Lemma cv_infty_cv_R0 :
   forall Un:nat -> R,
     (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0.
 Proof.
-  unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold cv_infty, Un_cv; unfold R_dist; intros.
   elim (H0 (/ eps)); intros N0 H2.
   exists N0; intros.
-  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+  unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r;
     rewrite (Rabs_Rinv _ (H n)).
   apply Rmult_lt_reg_l with (Rabs (Un n)).
   apply Rabs_pos_lt; apply H.
@@ -1115,7 +984,7 @@ Proof.
   rewrite Rmult_1_r; apply Rlt_le_trans with (Un n).
   apply H2; assumption.
   apply RRle_abs.
-  red in |- *; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1).
+  red; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1).
   apply Rabs_no_R0; apply H.
 Qed.
 
@@ -1124,7 +993,7 @@ Lemma decreasing_prop :
   forall (Un:nat -> R) (m n:nat),
     Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m.
 Proof.
-  unfold Un_decreasing in |- *; intros.
+  unfold Un_decreasing; intros.
   induction  n as [| n Hrecn].
   induction  m as [| m Hrecm].
   right; reflexivity.
@@ -1147,17 +1016,17 @@ Proof.
       (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 ->
         Un_cv (fun n:nat => x ^ n / INR (fact n)) 0).
   intro; apply H.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros; case (Req_dec x 0);
+  unfold Un_cv; unfold R_dist; intros; case (Req_dec x 0);
     intro.
   exists 1%nat; intros.
-  rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+  rewrite H1; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r;
     rewrite Rabs_R0; rewrite pow_ne_zero;
-      [ unfold Rdiv in |- *; rewrite Rmult_0_l; rewrite Rabs_R0; assumption
-        | red in |- *; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ].
+      [ unfold Rdiv; rewrite Rmult_0_l; rewrite Rabs_R0; assumption
+        | red; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ].
   assert (H2 := Rabs_pos_lt x H1); set (M := up (Rabs x)); cut (0 <= M)%Z.
   intro; elim (IZN M H3); intros M_nat H4.
   set (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))).
-  cut (Un_cv Un 0); unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  cut (Un_cv Un 0); unfold Un_cv; unfold R_dist; intros.
   elim (H5 eps H0); intros N H6.
   exists (M_nat + N)%nat; intros;
     cut (exists p : nat, (p >= N)%nat /\ n = (M_nat + p)%nat).
@@ -1165,7 +1034,7 @@ Proof.
   elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption.
   exists (n - M_nat)%nat.
   split.
-  unfold ge in |- *; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat;
+  unfold ge; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat;
     rewrite <- le_plus_minus.
   assumption.
   apply le_trans with (M_nat + N)%nat.
@@ -1179,43 +1048,43 @@ Proof.
   intro; cut (Un_decreasing Un).
   intro; cut (forall n:nat, Un (S n) <= Vn n).
   intro; cut (Un_cv Vn 0).
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  unfold Un_cv; unfold R_dist; intros.
   elim (H10 eps0 H5); intros N1 H11.
   exists (S N1); intros.
   cut (forall n:nat, 0 < Vn n).
   intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)).
   repeat rewrite Rabs_right.
-  unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
+  unfold Rminus; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
     replace n with (S (pred n)).
   apply H9.
-  inversion H12; simpl in |- *; reflexivity.
-  apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
+  inversion H12; simpl; reflexivity.
+  apply Rle_ge; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; left;
     apply H13.
-  apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
+  apply Rle_ge; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; left;
     apply H7.
-  apply H11; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n;
-    [ unfold ge in H12; exact H12 | inversion H12; simpl in |- *; reflexivity ].
+  apply H11; unfold ge; apply le_S_n; replace (S (pred n)) with n;
+    [ unfold ge in H12; exact H12 | inversion H12; simpl; reflexivity ].
   intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ].
   cut (cv_infty (fun n:nat => INR (S n))).
   intro; cut (Un_cv (fun n:nat => / INR (S n)) 0).
-  unfold Un_cv, R_dist in |- *; intros; unfold Vn in |- *.
+  unfold Un_cv, R_dist; intros; unfold Vn.
   cut (0 < eps1 / (Rabs x * Un 0%nat)).
   intro; elim (H11 _ H13); intros N H14.
   exists N; intros;
     replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with
     (Rabs x * Un 0%nat * (/ INR (S n) - 0));
-    [ idtac | unfold Rdiv in |- *; ring ].
+    [ idtac | unfold Rdiv; ring ].
   rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)).
   apply Rinv_0_lt_compat; apply Rabs_pos_lt.
   apply prod_neq_R0.
   apply Rabs_no_R0; assumption.
-  assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
+  assert (H16 := H7 0%nat); red; intro; rewrite H17 in H16;
     elim (Rlt_irrefl _ H16).
   rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
   rewrite Rmult_1_l.
   replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)).
   apply H14; assumption.
-  unfold Rdiv in |- *; rewrite (Rabs_right (Rabs x * Un 0%nat)).
+  unfold Rdiv; rewrite (Rabs_right (Rabs x * Un 0%nat)).
   apply Rmult_comm.
   apply Rle_ge; apply Rmult_le_pos.
   apply Rabs_pos.
@@ -1223,9 +1092,9 @@ Proof.
   apply Rabs_no_R0.
   apply prod_neq_R0;
     [ apply Rabs_no_R0; assumption
-      | assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
+      | assert (H16 := H7 0%nat); red; intro; rewrite H17 in H16;
         elim (Rlt_irrefl _ H16) ].
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   assumption.
   apply Rinv_0_lt_compat; apply Rmult_lt_0_compat.
   apply Rabs_pos_lt; assumption.
@@ -1233,7 +1102,7 @@ Proof.
   apply (cv_infty_cv_R0 (fun n:nat => INR (S n))).
   intro; apply not_O_INR; discriminate.
   assumption.
-  unfold cv_infty in |- *; intro; case (total_order_T M0 0); intro.
+  unfold cv_infty; intro; case (total_order_T M0 0); intro.
   elim s; intro.
   exists 0%nat; intros.
   apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ].
@@ -1247,13 +1116,13 @@ Proof.
   elim H10; intros; assumption.
   rewrite H12; rewrite <- INR_IZR_INZ; apply le_INR.
   apply le_trans with n; [ assumption | apply le_n_Sn ].
-  apply le_IZR; left; simpl in |- *; unfold M0_z in |- *;
+  apply le_IZR; left; simpl; unfold M0_z;
     apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ].
   intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)).
-  unfold Un in |- *; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
+  unfold Un; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
   rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x);
-    [ idtac | simpl in |- *; ring ].
-  unfold Rdiv in |- *; rewrite <- (Rmult_comm (Rabs x));
+    [ idtac | simpl; ring ].
+  unfold Rdiv; rewrite <- (Rmult_comm (Rabs x));
     repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l.
   apply Rabs_pos.
   left; apply pow_lt; assumption.
@@ -1261,33 +1130,33 @@ Proof.
   rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR;
     rewrite Rinv_mult_distr.
   apply Rmult_le_compat_l.
-  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
-    intro; assert (H10 := sym_eq H9); elim (fact_neq_0 _ H10).
+  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red;
+    intro; assert (H10 := eq_sym H9); elim (fact_neq_0 _ H10).
   left; apply Rinv_lt_contravar.
   apply Rmult_lt_0_compat; apply lt_INR_0; apply lt_O_Sn.
   apply lt_INR; apply lt_n_S.
-  pattern n at 1 in |- *; replace n with (0 + n)%nat; [ idtac | reflexivity ].
+  pattern n at 1; replace n with (0 + n)%nat; [ idtac | reflexivity ].
   apply plus_lt_compat_r.
   apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
   apply INR_fact_neq_0.
   apply not_O_INR; discriminate.
   ring.
   ring.
-  unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *;
+  unfold Vn; rewrite Rmult_assoc; unfold Rdiv;
     rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)).
   repeat apply Rmult_le_compat_l.
   apply Rabs_pos.
   left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
   apply decreasing_prop; [ assumption | apply le_O_n ].
-  unfold Un_decreasing in |- *; intro; unfold Un in |- *.
+  unfold Un_decreasing; intro; unfold Un.
   replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
-  rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
+  rewrite pow_add; unfold Rdiv; rewrite Rmult_assoc;
     apply Rmult_le_compat_l.
   left; apply pow_lt; assumption.
-  replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl in |- *; ring ].
+  replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl; ring ].
   replace (M_nat + n + 1)%nat with (S (M_nat + n)).
   apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))).
-  apply lt_INR_0; apply neq_O_lt; red in |- *; intro; assert (H9 := sym_eq H8);
+  apply lt_INR_0; apply neq_O_lt; red; intro; assert (H9 := eq_sym H8);
     elim (fact_neq_0 _ H9).
   rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
   rewrite Rmult_1_l.
@@ -1301,37 +1170,37 @@ Proof.
   apply INR_fact_neq_0.
   ring.
   ring.
-  intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  intro; unfold Un; unfold Rdiv; apply Rmult_lt_0_compat.
   apply pow_lt; assumption.
-  apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
-    assert (H8 := sym_eq H7); elim (fact_neq_0 _ H8).
-  clear Un Vn; apply INR_le; simpl in |- *.
+  apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red; intro;
+    assert (H8 := eq_sym H7); elim (fact_neq_0 _ H8).
+  clear Un Vn; apply INR_le; simpl.
   induction  M_nat as [| M_nat HrecM_nat].
   assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros.
   rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7.
   simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)).
   replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S;
     apply le_O_n.
-  apply le_IZR; simpl in |- *; left; apply Rlt_trans with (Rabs x).
+  apply le_IZR; simpl; left; apply Rlt_trans with (Rabs x).
   assumption.
   elim (archimed (Rabs x)); intros; assumption.
-  unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H eps H0); intros.
+  unfold Un_cv; unfold R_dist; intros; elim (H eps H0); intros.
   exists x0; intros;
     apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)).
-  unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
+  unfold Rminus; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
     rewrite (Rabs_right (Rabs x ^ n / INR (fact n))).
-  unfold Rdiv in |- *; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))).
+  unfold Rdiv; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))).
   rewrite RPow_abs; right; reflexivity.
   apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt;
-    red in |- *; intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
-  apply Rle_ge; unfold Rdiv in |- *; apply Rmult_le_pos.
+    red; intro; assert (H4 := eq_sym H3); elim (fact_neq_0 _ H4).
+  apply Rle_ge; unfold Rdiv; apply Rmult_le_pos.
   case (Req_dec x 0); intro.
   rewrite H3; rewrite Rabs_R0.
   induction  n as [| n Hrecn];
-    [ simpl in |- *; left; apply Rlt_0_1
-      | simpl in |- *; rewrite Rmult_0_l; right; reflexivity ].
+    [ simpl; left; apply Rlt_0_1
+      | simpl; rewrite Rmult_0_l; right; reflexivity ].
   left; apply pow_lt; apply Rabs_pos_lt; assumption.
-  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
-    intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
+  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red;
+    intro; assert (H4 := eq_sym H3); elim (fact_neq_0 _ H4).
   apply H1; assumption.
 Qed.
diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v
index 4725fe57..5140c29c 100644
--- a/theories/Reals/SeqSeries.v
+++ b/theories/Reals/SeqSeries.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: SeqSeries.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Max.
@@ -21,7 +19,7 @@ Require Export Rsigma.
 Require Export Rprod.
 Require Export Cauchy_prod.
 Require Export Alembert.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (**********)
 Lemma sum_maj1 :
@@ -43,21 +41,21 @@ Proof.
   intro; rewrite H4; rewrite H5.
   apply sum_cv_maj with
     (fun l:nat => An (S N + l)%nat) (fun (l:nat) (x:R) => fn (S N + l)%nat x) x.
-  unfold SP in |- *; apply H2.
+  unfold SP; apply H2.
   apply H3.
   intros; apply H1.
-  symmetry  in |- *; eapply UL_sequence.
+  symmetry ; eapply UL_sequence.
   apply H3.
-  unfold Un_cv in H0; unfold Un_cv in |- *; intros; elim (H0 eps H5);
+  unfold Un_cv in H0; unfold Un_cv; intros; elim (H0 eps H5);
     intros N0 H6.
   unfold R_dist in H6; exists N0; intros.
-  unfold R_dist in |- *;
+  unfold R_dist;
     replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N))
     with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2);
       [ idtac | ring ].
   replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with
   (sum_f_R0 An (S (N + n))).
-  apply H6; unfold ge in |- *; apply le_trans with n.
+  apply H6; unfold ge; apply le_trans with n.
   apply H7.
   apply le_trans with (N + n)%nat.
   apply le_plus_r.
@@ -82,12 +80,12 @@ Proof.
   reflexivity.
   apply le_lt_n_Sm; apply le_plus_l.
   apply le_O_n.
-  symmetry  in |- *; eapply UL_sequence.
+  symmetry ; eapply UL_sequence.
   apply H2.
-  unfold Un_cv in H; unfold Un_cv in |- *; intros.
+  unfold Un_cv in H; unfold Un_cv; intros.
   elim (H eps H4); intros N0 H5.
   unfold R_dist in H5; exists N0; intros.
-  unfold R_dist, SP in |- *;
+  unfold R_dist, SP;
     replace
     (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n -
       (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with
@@ -98,7 +96,7 @@ Proof.
   (sum_f_R0 (fun k:nat => fn k x) N +
     sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with
   (sum_f_R0 (fun k:nat => fn k x) (S (N + n))).
-  unfold SP in H5; apply H5; unfold ge in |- *; apply le_trans with n.
+  unfold SP in H5; apply H5; unfold ge; apply le_trans with n.
   apply H6.
   apply le_trans with (N + n)%nat.
   apply le_plus_r.
@@ -126,16 +124,16 @@ Proof.
   apply le_plus_l.
   apply le_O_n.
   exists (l2 - sum_f_R0 An N).
-  unfold Un_cv in H0; unfold Un_cv in |- *; intros.
+  unfold Un_cv in H0; unfold Un_cv; intros.
   elim (H0 eps H2); intros N0 H3.
   unfold R_dist in H3; exists N0; intros.
-  unfold R_dist in |- *;
+  unfold R_dist;
     replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N))
     with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2);
       [ idtac | ring ].
   replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with
   (sum_f_R0 An (S (N + n))).
-  apply H3; unfold ge in |- *; apply le_trans with n.
+  apply H3; unfold ge; apply le_trans with n.
   apply H4.
   apply le_trans with (N + n)%nat.
   apply le_plus_r.
@@ -162,10 +160,10 @@ Proof.
   apply le_plus_l.
   apply le_O_n.
   exists (l1 - SP fn N x).
-  unfold Un_cv in H; unfold Un_cv in |- *; intros.
+  unfold Un_cv in H; unfold Un_cv; intros.
   elim (H eps H2); intros N0 H3.
   unfold R_dist in H3; exists N0; intros.
-  unfold R_dist, SP in |- *.
+  unfold R_dist, SP.
   replace
   (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n -
     (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with
@@ -177,7 +175,7 @@ Proof.
     sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with
   (sum_f_R0 (fun k:nat => fn k x) (S (N + n))).
   unfold SP in H3; apply H3.
-  unfold ge in |- *; apply le_trans with n.
+  unfold ge; apply le_trans with n.
   apply H4.
   apply le_trans with (N + n)%nat.
   apply le_plus_r.
@@ -215,7 +213,7 @@ Lemma Rseries_CV_comp :
 Proof.
   intros An Bn H X; apply cv_cauchy_2.
   assert (H0 := cv_cauchy_1 _ X).
-  unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
+  unfold Cauchy_crit_series; unfold Cauchy_crit.
   intros; elim (H0 eps H1); intros.
   exists x; intros.
   cut
@@ -229,7 +227,7 @@ Proof.
   elim a; intro.
   rewrite (tech2 An n m); [ idtac | assumption ].
   rewrite (tech2 Bn n m); [ idtac | assumption ].
-  unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Ropp_plus_distr;
+  unfold R_dist; unfold Rminus; do 2 rewrite Ropp_plus_distr;
     do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r;
       do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right.
   apply sum_Rle; intros.
@@ -240,12 +238,12 @@ Proof.
   apply Rle_trans with (An (S n + n0)%nat); assumption.
   apply Rle_ge; apply cond_pos_sum; intro.
   elim (H (S n + n0)%nat); intros; assumption.
-  rewrite b; unfold R_dist in |- *; unfold Rminus in |- *;
+  rewrite b; unfold R_dist; unfold Rminus;
     do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right;
       reflexivity.
   rewrite (tech2 An m n); [ idtac | assumption ].
   rewrite (tech2 Bn m n); [ idtac | assumption ].
-  unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Rplus_assoc;
+  unfold R_dist; unfold Rminus; do 2 rewrite Rplus_assoc;
     rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m));
       do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l;
         do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right.
@@ -268,13 +266,13 @@ Lemma Cesaro :
     Un_cv (fun n:nat => sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n)
     l.
 Proof with trivial.
-  unfold Un_cv in |- *; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n)...
+  unfold Un_cv; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n)...
   intro; apply tech1...
   assert (H4 : forall n:nat, sum_f_R0 An n <> 0)...
-  intro; red in |- *; intro; assert (H5 := H3 n); rewrite H4 in H5;
+  intro; red; intro; assert (H5 := H3 n); rewrite H4 in H5;
     elim (Rlt_irrefl _ H5)...
   assert (H5 := cv_infty_cv_R0 _ H4 H1); assert (H6 : 0 < eps / 2)...
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat...
+  unfold Rdiv; apply Rmult_lt_0_compat...
   apply Rinv_0_lt_compat; prove_sup...
   elim (H _ H6); clear H; intros N1 H;
     set (C := Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1));
@@ -284,10 +282,10 @@ Proof with trivial.
             (forall n:nat, (N <= n)%nat -> C / sum_f_R0 An n < eps / 2))...
   case (Req_dec C 0); intro...
   exists 0%nat; intros...
-  rewrite H7; unfold Rdiv in |- *; rewrite Rmult_0_l; apply Rmult_lt_0_compat...
+  rewrite H7; unfold Rdiv; rewrite Rmult_0_l; apply Rmult_lt_0_compat...
   apply Rinv_0_lt_compat; prove_sup...
   assert (H8 : 0 < eps / (2 * Rabs C))...
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat...
+  unfold Rdiv; apply Rmult_lt_0_compat...
   apply Rinv_0_lt_compat; apply Rmult_lt_0_compat...
   prove_sup...
   apply Rabs_pos_lt...
@@ -296,23 +294,23 @@ Proof with trivial.
       rewrite Rplus_0_r in H11...
   apply Rle_lt_trans with (Rabs (C / sum_f_R0 An n))...
   apply RRle_abs...
-  unfold Rdiv in |- *; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C)...
+  unfold Rdiv; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C)...
   apply Rinv_0_lt_compat; apply Rabs_pos_lt...
   rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
   rewrite Rmult_1_l; replace (/ Rabs C * (eps * / 2)) with (eps / (2 * Rabs C))...
-  unfold Rdiv in |- *; rewrite Rinv_mult_distr...
+  unfold Rdiv; rewrite Rinv_mult_distr...
   ring...
   discrR...
   apply Rabs_no_R0...
   apply Rabs_no_R0...
   elim H7; clear H7; intros N2 H7; set (N := max N1 N2); exists (S N); intros;
-    unfold R_dist in |- *;
+    unfold R_dist;
       replace (sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n - l) with
       (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n / sum_f_R0 An n)...
   assert (H9 : (N1 < n)%nat)...
   apply lt_le_trans with (S N)...
-  apply le_lt_n_Sm; unfold N in |- *; apply le_max_l...
-  rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv in |- *;
+  apply le_lt_n_Sm; unfold N; apply le_max_l...
+  rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv;
     rewrite Rmult_plus_distr_r;
       apply Rle_lt_trans with
         (Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1 / sum_f_R0 An n) +
@@ -321,12 +319,12 @@ Proof with trivial.
             (n - S N1) / sum_f_R0 An n))...
   apply Rabs_triang...
   rewrite (double_var eps); apply Rplus_lt_compat...
-  unfold Rdiv in |- *; rewrite Rabs_mult; fold C in |- *; rewrite Rabs_right...
+  unfold Rdiv; rewrite Rabs_mult; fold C; rewrite Rabs_right...
   apply (H7 n); apply le_trans with (S N)...
-  apply le_trans with N; [ unfold N in |- *; apply le_max_r | apply le_n_Sn ]...
+  apply le_trans with N; [ unfold N; apply le_max_r | apply le_n_Sn ]...
   apply Rle_ge; left; apply Rinv_0_lt_compat...
 
-  unfold R_dist in H; unfold Rdiv in |- *; rewrite Rabs_mult;
+  unfold R_dist in H; unfold Rdiv; rewrite Rabs_mult;
     rewrite (Rabs_right (/ sum_f_R0 An n))...
   apply Rle_lt_trans with
     (sum_f_R0 (fun i:nat => Rabs (An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)))
@@ -342,22 +340,22 @@ Proof with trivial.
   do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l...
   left; apply Rinv_0_lt_compat...
   apply sum_Rle; intros; rewrite Rabs_mult;
-    pattern (An (S N1 + n0)%nat) at 2 in |- *;
+    pattern (An (S N1 + n0)%nat) at 2;
       rewrite <- (Rabs_right (An (S N1 + n0)%nat))...
   apply Rmult_le_compat_l...
   apply Rabs_pos...
-  left; apply H; unfold ge in |- *; apply le_trans with (S N1);
+  left; apply H; unfold ge; apply le_trans with (S N1);
     [ apply le_n_Sn | apply le_plus_l ]...
   apply Rle_ge; left...
   rewrite <- (scal_sum (fun i:nat => An (S N1 + i)%nat) (n - S N1) (eps / 2));
-    unfold Rdiv in |- *; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l...
-  pattern (/ 2) at 2 in |- *; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l...
+    unfold Rdiv; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l...
+  pattern (/ 2) at 2; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l...
   apply Rinv_0_lt_compat; prove_sup...
   rewrite Rmult_comm; apply Rmult_lt_reg_l with (sum_f_R0 An n)...
   rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym...
   rewrite Rmult_1_l; rewrite Rmult_1_r; rewrite (tech2 An N1 n)...
   rewrite Rplus_comm;
-    pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1 in |- *;
+    pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1;
       rewrite <- Rplus_0_r; apply Rplus_lt_compat_l...
   apply Rle_ge; left; apply Rinv_0_lt_compat...
   replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with
@@ -373,41 +371,41 @@ Lemma Cesaro_1 :
 Proof with trivial.
   intros Bn l H; set (An := fun _:nat => 1)...
   assert (H0 : forall n:nat, 0 < An n)...
-  intro; unfold An in |- *; apply Rlt_0_1...
+  intro; unfold An; apply Rlt_0_1...
   assert (H1 : forall n:nat, 0 < sum_f_R0 An n)...
   intro; apply tech1...
   assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n))...
-  unfold cv_infty in |- *; intro; case (Rle_dec M 0); intro...
+  unfold cv_infty; intro; case (Rle_dec M 0); intro...
   exists 0%nat; intros; apply Rle_lt_trans with 0...
   assert (H2 : 0 < M)...
   auto with real...
   clear n; set (m := up M); elim (archimed M); intros;
     assert (H5 : (0 <= m)%Z)...
-  apply le_IZR; unfold m in |- *; simpl in |- *; left; apply Rlt_trans with M...
-  elim (IZN _ H5); intros; exists x; intros; unfold An in |- *; rewrite sum_cte;
+  apply le_IZR; unfold m; simpl; left; apply Rlt_trans with M...
+  elim (IZN _ H5); intros; exists x; intros; unfold An; rewrite sum_cte;
     rewrite Rmult_1_l; apply Rlt_trans with (IZR (up M))...
   apply Rle_lt_trans with (INR x)...
-  rewrite INR_IZR_INZ; fold m in |- *; rewrite <- H6; right...
+  rewrite INR_IZR_INZ; fold m; rewrite <- H6; right...
   apply lt_INR; apply le_lt_n_Sm...
   assert (H3 := Cesaro _ _ _ H H0 H2)...
-  unfold Un_cv in |- *; unfold Un_cv in H3; intros; elim (H3 _ H4); intros;
-    exists (S x); intros; unfold R_dist in |- *; unfold R_dist in H5;
+  unfold Un_cv; unfold Un_cv in H3; intros; elim (H3 _ H4); intros;
+    exists (S x); intros; unfold R_dist; unfold R_dist in H5;
       apply Rle_lt_trans with
         (Rabs
           (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l))...
   right;
     replace (sum_f_R0 Bn (pred n) / INR n - l) with
     (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l)...
-  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l));
+  unfold Rminus; do 2 rewrite <- (Rplus_comm (- l));
     apply Rplus_eq_compat_l...
-  unfold An in |- *;
+  unfold An;
     replace (sum_f_R0 (fun k:nat => 1 * Bn k) (pred n)) with
     (sum_f_R0 Bn (pred n))...
   rewrite sum_cte; rewrite Rmult_1_l; replace (S (pred n)) with n...
   apply S_pred with 0%nat; apply lt_le_trans with (S x)...
   apply lt_O_Sn...
   apply sum_eq; intros; ring...
-  apply H5; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n...
+  apply H5; unfold ge; apply le_S_n; replace (S (pred n)) with n...
   apply S_pred with 0%nat; apply lt_le_trans with (S x)...
   apply lt_O_Sn...
 Qed.
diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v
index 67af68d1..d0de58b0 100644
--- a/theories/Reals/SplitAbsolu.v
+++ b/theories/Reals/SplitAbsolu.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i      $Id: SplitAbsolu.v 14641 2011-11-06 11:59:10Z herbelin $       i*)
-
 Require Import Rbasic_fun.
 
 Ltac split_case_Rabs :=
@@ -21,5 +19,5 @@ Ltac split_Rabs :=
   match goal with
     | id:context [(Rabs _)] |- _ => generalize id; clear id; try split_Rabs
     |  |- context [(Rabs ?X1)] =>
-      unfold Rabs in |- *; try split_case_Rabs; intros
+      unfold Rabs; try split_case_Rabs; intros
   end.
diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v
index 85a2cdd0..09031fd6 100644
--- a/theories/Reals/SplitRmult.v
+++ b/theories/Reals/SplitRmult.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: SplitRmult.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*)
 
 
diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v
index 79f39892..89c17821 100644
--- a/theories/Reals/Sqrt_reg.v
+++ b/theories/Reals/Sqrt_reg.v
@@ -1,18 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Sqrt_reg.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Ranalysis1.
 Require Import R_sqrt.
-Open Local Scope R_scope.
+Local Open Scope R_scope.
 
 (**********)
 Lemma sqrt_var_maj :
@@ -23,67 +21,67 @@ Proof.
   case (total_order_T h 0); intro.
   elim s; intro.
   repeat rewrite Rabs_left.
-  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)).
+  unfold Rminus; do 2 rewrite <- (Rplus_comm (-1)).
   do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive;
     apply Rplus_le_compat_l.
   apply Ropp_le_contravar; apply sqrt_le_1.
   apply Rle_0_sqr.
   apply H0.
-  pattern (1 + h) at 2 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *;
+  pattern (1 + h) at 2; rewrite <- Rmult_1_r; unfold Rsqr;
     apply Rmult_le_compat_l.
   apply H0.
-  pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+  pattern 1 at 2; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
     assumption.
   apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
-    unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+    unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l;
       rewrite Rplus_0_r.
-  pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
+  pattern 1 at 2; rewrite <- sqrt_1; apply sqrt_lt_1.
   apply Rle_0_sqr.
   left; apply Rlt_0_1.
-  pattern 1 at 2 in |- *; rewrite <- Rsqr_1; apply Rsqr_incrst_1.
-  pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+  pattern 1 at 2; rewrite <- Rsqr_1; apply Rsqr_incrst_1.
+  pattern 1 at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
     assumption.
   apply H0.
   left; apply Rlt_0_1.
   apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
-    unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+    unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l;
       rewrite Rplus_0_r.
-  pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
+  pattern 1 at 2; rewrite <- sqrt_1; apply sqrt_lt_1.
   apply H0.
   left; apply Rlt_0_1.
-  pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+  pattern 1 at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
     assumption.
   rewrite b; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right;
     reflexivity.
   repeat rewrite Rabs_right.
-  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1));
+  unfold Rminus; do 2 rewrite <- (Rplus_comm (-1));
     apply Rplus_le_compat_l.
   apply sqrt_le_1.
   apply H0.
   apply Rle_0_sqr.
-  pattern (1 + h) at 1 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *;
+  pattern (1 + h) at 1; rewrite <- Rmult_1_r; unfold Rsqr;
     apply Rmult_le_compat_l.
   apply H0.
-  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+  pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
     assumption.
   apply Rle_ge; apply Rplus_le_reg_l with 1.
-  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus;
     rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
-  pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_le_1.
+  pattern 1 at 1; rewrite <- sqrt_1; apply sqrt_le_1.
   left; apply Rlt_0_1.
   apply Rle_0_sqr.
-  pattern 1 at 1 in |- *; rewrite <- Rsqr_1; apply Rsqr_incr_1.
-  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+  pattern 1 at 1; rewrite <- Rsqr_1; apply Rsqr_incr_1.
+  pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
     assumption.
   left; apply Rlt_0_1.
   apply H0.
   apply Rle_ge; left; apply Rplus_lt_reg_r with 1.
-  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus;
     rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
-  pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
+  pattern 1 at 1; rewrite <- sqrt_1; apply sqrt_lt_1.
   left; apply Rlt_0_1.
   apply H0.
-  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+  pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
     assumption.
   rewrite sqrt_Rsqr.
   replace (1 + h - 1) with h; [ right; reflexivity | ring ].
@@ -103,14 +101,14 @@ Qed.
 (** sqrt is continuous in 1 *)
 Lemma sqrt_continuity_pt_R1 : continuity_pt sqrt 1.
 Proof.
-  unfold continuity_pt in |- *; unfold continue_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
-      unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+  unfold continuity_pt; unfold continue_in;
+    unfold limit1_in; unfold limit_in;
+      unfold dist; simpl; unfold R_dist;
         intros.
   set (alpha := Rmin eps 1).
   exists alpha; intros.
   split.
-  unfold alpha in |- *; unfold Rmin in |- *; case (Rle_dec eps 1); intro.
+  unfold alpha; unfold Rmin; case (Rle_dec eps 1); intro.
   assumption.
   apply Rlt_0_1.
   intros; elim H0; intros.
@@ -119,18 +117,18 @@ Proof.
   apply sqrt_var_maj.
   apply Rle_trans with alpha.
   left; apply H2.
-  unfold alpha in |- *; apply Rmin_r.
+  unfold alpha; apply Rmin_r.
   apply Rlt_le_trans with alpha;
-    [ apply H2 | unfold alpha in |- *; apply Rmin_l ].
+    [ apply H2 | unfold alpha; apply Rmin_l ].
 Qed.
 
 (** sqrt is continuous forall x>0 *)
 Lemma sqrt_continuity_pt : forall x:R, 0 < x -> continuity_pt sqrt x.
 Proof.
   intros; generalize sqrt_continuity_pt_R1.
-  unfold continuity_pt in |- *; unfold continue_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
-      unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+  unfold continuity_pt; unfold continue_in;
+    unfold limit1_in; unfold limit_in;
+      unfold dist; simpl; unfold R_dist;
         intros.
   cut (0 < eps / sqrt x).
   intro; elim (H0 _ H2); intros alp_1 H3.
@@ -138,9 +136,9 @@ Proof.
   set (alpha := alp_1 * x).
   exists (Rmin alpha x); intros.
   split.
-  change (0 < Rmin alpha x) in |- *; unfold Rmin in |- *;
+  change (0 < Rmin alpha x); unfold Rmin;
     case (Rle_dec alpha x); intro.
-  unfold alpha in |- *; apply Rmult_lt_0_compat; assumption.
+  unfold alpha; apply Rmult_lt_0_compat; assumption.
   apply H.
   intros; replace x0 with (x + (x0 - x)); [ idtac | ring ];
     replace (sqrt (x + (x0 - x)) - sqrt x) with
@@ -152,7 +150,7 @@ Proof.
   rewrite Rmult_1_l; rewrite Rmult_comm.
   unfold Rdiv in H5.
   case (Req_dec x x0); intro.
-  rewrite H7; unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r;
+  rewrite H7; unfold Rminus, Rdiv; rewrite Rplus_opp_r;
     rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r;
       rewrite Rabs_R0.
   apply Rmult_lt_0_compat.
@@ -160,10 +158,10 @@ Proof.
   apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption.
   apply H5.
   split.
-  unfold D_x, no_cond in |- *.
+  unfold D_x, no_cond.
   split.
   trivial.
-  red in |- *; intro.
+  red; intro.
   cut ((x0 - x) * / x = 0).
   intro.
   elim (Rmult_integral _ _ H9); intro.
@@ -172,35 +170,35 @@ Proof.
   assert (H11 := Rmult_eq_0_compat_r _ x H10).
   rewrite <- Rinv_l_sym in H11.
   elim R1_neq_R0; exact H11.
-  red in |- *; intro; rewrite H12 in H; elim (Rlt_irrefl _ H).
-  symmetry  in |- *; apply Rplus_eq_reg_l with 1; rewrite Rplus_0_r;
+  red; intro; rewrite H12 in H; elim (Rlt_irrefl _ H).
+  symmetry ; apply Rplus_eq_reg_l with 1; rewrite Rplus_0_r;
     unfold Rdiv in H8; exact H8.
-  unfold Rminus in |- *; rewrite Rplus_comm; rewrite <- Rplus_assoc;
+  unfold Rminus; rewrite Rplus_comm; rewrite <- Rplus_assoc;
     rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros.
-  unfold Rdiv in |- *; rewrite Rabs_mult.
+  unfold Rdiv; rewrite Rabs_mult.
   rewrite Rabs_Rinv.
   rewrite (Rabs_right x).
   rewrite Rmult_comm; apply Rmult_lt_reg_l with x.
   apply H.
   rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-  rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha in |- *.
+  rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha.
   apply Rlt_le_trans with (Rmin alpha x).
   apply H9.
   apply Rmin_l.
-  red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
   apply Rle_ge; left; apply H.
-  red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
   assert (H7 := sqrt_lt_R0 x H).
-  red in |- *; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7).
+  red; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7).
   apply Rle_ge; apply sqrt_positivity.
   left; apply H.
-  unfold Rminus in |- *; rewrite Rmult_plus_distr_l;
+  unfold Rminus; rewrite Rmult_plus_distr_l;
     rewrite Ropp_mult_distr_r_reverse; repeat rewrite <- sqrt_mult.
   rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
-    unfold Rdiv in |- *; rewrite Rmult_comm; rewrite Rmult_assoc;
+    unfold Rdiv; rewrite Rmult_comm; rewrite Rmult_assoc;
       rewrite <- Rinv_l_sym.
   rewrite Rmult_1_r; reflexivity.
-  red in |- *; intro; rewrite H7 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H7 in H; elim (Rlt_irrefl _ H).
   left; apply H.
   left; apply Rlt_0_1.
   left; apply H.
@@ -210,7 +208,7 @@ Proof.
   rewrite Rplus_comm.
   apply Rplus_le_reg_l with (- ((x0 - x) / x)).
   rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
-    rewrite Rplus_0_l; unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
+    rewrite Rplus_0_l; unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse.
   apply Rmult_le_reg_l with x.
   apply H.
   rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
@@ -218,13 +216,13 @@ Proof.
   rewrite Rmult_1_r; left; apply Rlt_le_trans with (Rmin alpha x).
   apply H8.
   apply Rmin_r.
-  red in |- *; intro; rewrite H9 in H; elim (Rlt_irrefl _ H).
+  red; intro; rewrite H9 in H; elim (Rlt_irrefl _ H).
   apply Rplus_le_le_0_compat.
   left; apply Rlt_0_1.
-  unfold Rdiv in |- *; apply Rmult_le_pos.
+  unfold Rdiv; apply Rmult_le_pos.
   apply Rge_le; exact r.
   left; apply Rinv_0_lt_compat; apply H.
-  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold Rdiv; apply Rmult_lt_0_compat.
   apply H1.
   apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H.
 Qed.
@@ -237,7 +235,7 @@ Proof.
   cut (continuity_pt g 0).
   intro; cut (g 0 <> 0).
   intro; assert (H2 := continuity_pt_inv g 0 H0 H1).
-  unfold derivable_pt_lim in |- *; intros; unfold continuity_pt in H2;
+  unfold derivable_pt_lim; intros; unfold continuity_pt in H2;
     unfold continue_in in H2; unfold limit1_in in H2;
       unfold limit_in in H2; simpl in H2; unfold R_dist in H2.
   elim (H2 eps H3); intros alpha H4.
@@ -249,29 +247,29 @@ Proof.
   unfold inv_fct, g in H6; replace (2 * sqrt x) with (sqrt x + sqrt (x + 0)).
   apply H6.
   split.
-  unfold D_x, no_cond in |- *.
+  unfold D_x, no_cond.
   split.
   trivial.
-  apply (sym_not_eq (A:=R)); exact H8.
-  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+  apply (not_eq_sym (A:=R)); exact H8.
+  unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r;
     apply Rlt_le_trans with alpha1.
   exact H9.
-  unfold alpha1 in |- *; apply Rmin_l.
+  unfold alpha1; apply Rmin_l.
   rewrite Rplus_0_r; ring.
   cut (0 <= x + h).
   intro; cut (0 < sqrt x + sqrt (x + h)).
   intro; apply Rmult_eq_reg_l with (sqrt x + sqrt (x + h)).
   rewrite <- Rinv_r_sym.
-  rewrite Rplus_comm; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+  rewrite Rplus_comm; unfold Rdiv; rewrite <- Rmult_assoc;
     rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt.
-  rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
+  rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc;
     rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym.
   reflexivity.
   apply H8.
   left; apply H.
   assumption.
-  red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
-  red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
+  red; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
+  red; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
   apply Rplus_lt_le_0_compat.
   apply sqrt_lt_R0; apply H.
   apply sqrt_positivity; apply H10.
@@ -281,35 +279,35 @@ Proof.
   rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc;
     rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1.
   apply H9.
-  unfold alpha1 in |- *; apply Rmin_r.
+  unfold alpha1; apply Rmin_r.
   apply Rplus_le_le_0_compat.
   left; assumption.
   apply Rge_le; apply r.
-  unfold alpha1 in |- *; unfold Rmin in |- *; case (Rle_dec alpha x); intro.
+  unfold alpha1; unfold Rmin; case (Rle_dec alpha x); intro.
   apply H5.
   apply H.
-  unfold g in |- *; rewrite Rplus_0_r.
+  unfold g; rewrite Rplus_0_r.
   cut (0 < sqrt x + sqrt x).
-  intro; red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
+  intro; red; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
   apply Rplus_lt_0_compat; apply sqrt_lt_R0; apply H.
   replace g with (fct_cte (sqrt x) + comp sqrt (fct_cte x + id))%F;
   [ idtac | reflexivity ].
   apply continuity_pt_plus.
-  apply continuity_pt_const; unfold constant, fct_cte in |- *; intro;
+  apply continuity_pt_const; unfold constant, fct_cte; intro;
     reflexivity.
   apply continuity_pt_comp.
   apply continuity_pt_plus.
-  apply continuity_pt_const; unfold constant, fct_cte in |- *; intro;
+  apply continuity_pt_const; unfold constant, fct_cte; intro;
     reflexivity.
   apply derivable_continuous_pt; apply derivable_pt_id.
   apply sqrt_continuity_pt.
-  unfold plus_fct, fct_cte, id in |- *; rewrite Rplus_0_r; apply H.
+  unfold plus_fct, fct_cte, id; rewrite Rplus_0_r; apply H.
 Qed.
 
 (**********)
 Lemma derivable_pt_sqrt : forall x:R, 0 < x -> derivable_pt sqrt x.
 Proof.
-  unfold derivable_pt in |- *; intros.
+  unfold derivable_pt; intros.
   exists (/ (2 * sqrt x)).
   apply derivable_pt_lim_sqrt; assumption.
 Qed.
@@ -332,19 +330,19 @@ Proof.
   intros; case (Rtotal_order 0 x); intro.
   apply (sqrt_continuity_pt x H0).
   elim H0; intro.
-  unfold continuity_pt in |- *; unfold continue_in in |- *;
-    unfold limit1_in in |- *; unfold limit_in in |- *;
-      simpl in |- *; unfold R_dist in |- *; intros.
+  unfold continuity_pt; unfold continue_in;
+    unfold limit1_in; unfold limit_in;
+      simpl; unfold R_dist; intros.
   exists (Rsqr eps); intros.
   split.
-  change (0 < Rsqr eps) in |- *; apply Rsqr_pos_lt.
-  red in |- *; intro; rewrite H3 in H2; elim (Rlt_irrefl _ H2).
+  change (0 < Rsqr eps); apply Rsqr_pos_lt.
+  red; intro; rewrite H3 in H2; elim (Rlt_irrefl _ H2).
   intros; elim H3; intros.
-  rewrite <- H1; rewrite sqrt_0; unfold Rminus in |- *; rewrite Ropp_0;
+  rewrite <- H1; rewrite sqrt_0; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5;
       rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5.
   case (Rcase_abs x0); intro.
-  unfold sqrt in |- *; case (Rcase_abs x0); intro.
+  unfold sqrt; case (Rcase_abs x0); intro.
   rewrite Rabs_R0; apply H2.
   assert (H6 := Rge_le _ _ r0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 r)).
   rewrite Rabs_right.
diff --git a/theories/Reals/vo.itarget b/theories/Reals/vo.itarget
index bcd47a0b..36dd0f56 100644
--- a/theories/Reals/vo.itarget
+++ b/theories/Reals/vo.itarget
@@ -9,6 +9,7 @@ DiscrR.vo
 Exp_prop.vo
 Integration.vo
 LegacyRfield.vo
+Machin.vo
 MVT.vo
 NewtonInt.vo
 PartSum.vo
@@ -17,7 +18,10 @@ Ranalysis1.vo
 Ranalysis2.vo
 Ranalysis3.vo
 Ranalysis4.vo
+Ranalysis5.vo
 Ranalysis.vo
+Ranalysis_reg.vo
+Ratan.vo
 Raxioms.vo
 Rbase.vo
 Rbasic_fun.vo
@@ -48,6 +52,7 @@ Rtrigo_calc.vo
 Rtrigo_def.vo
 Rtrigo_fun.vo
 Rtrigo_reg.vo
+Rtrigo1.vo
 Rtrigo.vo
 SeqProp.vo
 SeqSeries.vo
diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v
index 26c8ef59..779c3d9a 100644
--- a/theories/Relations/Operators_Properties.v
+++ b/theories/Relations/Operators_Properties.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Operators_Properties.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (************************************************************************)
 (** * Some properties of the operators on relations                     *)
 (************************************************************************)
@@ -19,17 +17,17 @@ Require Import Relation_Operators.
 
 Section Properties.
 
-  Implicit Arguments clos_refl_trans [A].
-  Implicit Arguments clos_refl_trans_1n [A].
-  Implicit Arguments clos_refl_trans_n1 [A].
-  Implicit Arguments clos_refl_sym_trans [A].
-  Implicit Arguments clos_refl_sym_trans_1n [A].
-  Implicit Arguments clos_refl_sym_trans_n1 [A].
-  Implicit Arguments clos_trans [A].
-  Implicit Arguments clos_trans_1n [A].
-  Implicit Arguments clos_trans_n1 [A].
-  Implicit Arguments inclusion [A].
-  Implicit Arguments preorder [A].
+  Arguments clos_refl_trans [A] R x _.
+  Arguments clos_refl_trans_1n [A] R x _.
+  Arguments clos_refl_trans_n1 [A] R x _.
+  Arguments clos_refl_sym_trans [A] R _ _.
+  Arguments clos_refl_sym_trans_1n [A] R x _.
+  Arguments clos_refl_sym_trans_n1 [A] R x _.
+  Arguments clos_trans [A] R x _.
+  Arguments clos_trans_1n [A] R x _.
+  Arguments clos_trans_n1 [A] R x _.
+  Arguments inclusion [A] R1 R2.
+  Arguments preorder [A] R.
 
   Variable A : Type.
   Variable R : relation A.
@@ -52,7 +50,7 @@ Section Properties.
 
     Lemma clos_rt_idempotent : inclusion (R*)* R*.
     Proof.
-      red in |- *.
+      red.
       induction 1; auto with sets.
       intros.
       apply rt_trans with y; auto with sets.
@@ -68,7 +66,7 @@ Section Properties.
     Lemma clos_rt_clos_rst :
       inclusion (clos_refl_trans R) (clos_refl_sym_trans R).
     Proof.
-      red in |- *.
+      red.
       induction 1; auto with sets.
       apply rst_trans with y; auto with sets.
     Qed.
@@ -89,7 +87,7 @@ Section Properties.
       inclusion (clos_refl_sym_trans (clos_refl_sym_trans R))
       (clos_refl_sym_trans R).
     Proof.
-      red in |- *.
+      red.
       induction 1; auto with sets.
       apply rst_trans with y; auto with sets.
     Qed.
diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v
index 0d901445..0e6d034e 100644
--- a/theories/Relations/Relation_Definitions.v
+++ b/theories/Relations/Relation_Definitions.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Relation_Definitions.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Section Relation_Definition.
 
   Variable A : Type.
diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v
index 6efebc46..b7159578 100644
--- a/theories/Relations/Relation_Operators.v
+++ b/theories/Relations/Relation_Operators.v
@@ -1,25 +1,25 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Relation_Operators.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (************************************************************************)
-(** *                   Bruno Barras, Cristina Cornes                   *)
+(** * Some operators on relations                                       *)
+(************************************************************************)
+(** * Initial authors: Bruno Barras, Cristina Cornes                    *)
 (** *                                                                   *)
-(** * Some of these definitions were taken from :                       *)
+(** * Some of the initial definitions were taken from :                 *)
 (** *    Constructing Recursion Operators in Type Theory                *)
 (** *    L. Paulson  JSC (1986) 2, 325-355                              *)
+(** *                                                                   *)
+(** * Further extensions by Pierre Castéran                             *)
 (************************************************************************)
 
 Require Import Relation_Definitions.
 
-(** * Some operators to build relations *)
-
 (** ** Transitive closure *)
 
 Section Transitive_Closure.
@@ -149,13 +149,13 @@ Section Lexicographic_Product.
   Variable leA : A -> A -> Prop.
   Variable leB : forall x:A, B x -> B x -> Prop.
 
-  Inductive lexprod : sigS B -> sigS B -> Prop :=
+  Inductive lexprod : sigT B -> sigT B -> Prop :=
     | left_lex :
       forall (x x':A) (y:B x) (y':B x'),
-        leA x x' -> lexprod (existS B x y) (existS B x' y')
+        leA x x' -> lexprod (existT B x y) (existT B x' y')
     | right_lex :
       forall (x:A) (y y':B x),
-        leB x y y' -> lexprod (existS B x y) (existS B x y').
+        leB x y y' -> lexprod (existT B x y) (existT B x y').
 
 End Lexicographic_Product.
 
diff --git a/theories/Relations/Relations.v b/theories/Relations/Relations.v
index 630b2822..08b7574f 100644
--- a/theories/Relations/Relations.v
+++ b/theories/Relations/Relations.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Relations.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Relation_Definitions.
 Require Export Relation_Operators.
 Require Export Operators_Properties.
@@ -16,16 +14,16 @@ Lemma inverse_image_of_equivalence :
   forall (A B:Type) (f:A -> B) (r:relation B),
     equivalence B r -> equivalence A (fun x y:A => r (f x) (f y)).
 Proof.
-  intros; split; elim H; red in |- *; auto.
+  intros; split; elim H; red; auto.
   intros _ equiv_trans _ x y z H0 H1; apply equiv_trans with (f y); assumption.
 Qed.
 
 Lemma inverse_image_of_eq :
   forall (A B:Type) (f:A -> B), equivalence A (fun x y:A => f x = f y).
 Proof.
-  split; red in |- *;
+  split; red;
     [  (* reflexivity *) reflexivity
       |  (* transitivity *) intros; transitivity (f y); assumption
-      |  (* symmetry *) intros; symmetry  in |- *; assumption ].
+      |  (* symmetry *) intros; symmetry ; assumption ].
 Qed.
 
diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v
index 90362da0..eec7aa2d 100644
--- a/theories/Setoids/Setoid.v
+++ b/theories/Setoids/Setoid.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Setoid.v 14641 2011-11-06 11:59:10Z herbelin $: i*)
-
 Require Export Coq.Classes.SetoidTactics.
 
 Export Morphisms.ProperNotations.
diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v
index 701d9f8a..3129dbb1 100644
--- a/theories/Sets/Classical_sets.v
+++ b/theories/Sets/Classical_sets.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Classical_sets.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Ensembles.
 Require Export Constructive_sets.
 Require Export Classical_Type.
@@ -40,8 +38,8 @@ Section Ensembles_classical.
     elim (not_all_ex_not U (fun x:U => ~ In U A x)).
     intros x H; apply Inhabited_intro with x.
     apply NNPP; auto with sets.
-    red in |- *; intro.
-    apply NI; red in |- *.
+    red; intro.
+    apply NI; red.
     intros x H'; elim (H x); trivial with sets.
   Qed.
 
@@ -49,7 +47,7 @@ Section Ensembles_classical.
     forall A:Ensemble U, A <> Empty_set U -> Inhabited U A.
   Proof.
     intros; apply not_included_empty_Inhabited.
-    red in |- *; auto with sets.
+    red; auto with sets.
   Qed.
 
   Lemma Inhabited_Setminus :
@@ -75,7 +73,7 @@ Section Ensembles_classical.
   Lemma Subtract_intro :
     forall (A:Ensemble U) (x y:U), In U A y -> x <> y -> In U (Subtract U A x) y.
   Proof.
-    unfold Subtract at 1 in |- *; auto with sets.
+    unfold Subtract at 1; auto with sets.
   Qed.
   Hint Resolve Subtract_intro : sets.
 
@@ -105,7 +103,7 @@ Section Ensembles_classical.
   Lemma not_SIncl_empty :
     forall X:Ensemble U, ~ Strict_Included U X (Empty_set U).
   Proof.
-    intro X; red in |- *; intro H'; try exact H'.
+    intro X; red; intro H'; try exact H'.
     lapply (Strict_Included_inv X (Empty_set U)); auto with sets.
     intro H'0; elim H'0; intros H'1 H'2; elim H'2; clear H'0.
     intros x H'0; elim H'0.
@@ -115,10 +113,10 @@ Section Ensembles_classical.
   Lemma Complement_Complement :
     forall A:Ensemble U, Complement U (Complement U A) = A.
   Proof.
-    unfold Complement in |- *; intros; apply Extensionality_Ensembles;
+    unfold Complement; intros; apply Extensionality_Ensembles;
       auto with sets.
-    red in |- *; split; auto with sets.
-    red in |- *; intros; apply NNPP; auto with sets.
+    red; split; auto with sets.
+    red; intros; apply NNPP; auto with sets.
   Qed.
 
 End Ensembles_classical.
diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v
index d3900446..f559533a 100644
--- a/theories/Sets/Constructive_sets.v
+++ b/theories/Sets/Constructive_sets.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Constructive_sets.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Ensembles.
 
 Section Ensembles_facts.
@@ -38,24 +36,24 @@ Section Ensembles_facts.
 
   Lemma Noone_in_empty : forall x:U, ~ In U (Empty_set U) x.
   Proof.
-    red in |- *; destruct 1.
+    red; destruct 1.
   Qed.
 
   Lemma Included_Empty : forall A:Ensemble U, Included U (Empty_set U) A.
   Proof.
-    intro; red in |- *.
+    intro; red.
     intros x H; elim (Noone_in_empty x); auto with sets.
   Qed.
 
   Lemma Add_intro1 :
     forall (A:Ensemble U) (x y:U), In U A y -> In U (Add U A x) y.
   Proof.
-    unfold Add at 1 in |- *; auto with sets.
+    unfold Add at 1; auto with sets.
   Qed.
 
   Lemma Add_intro2 : forall (A:Ensemble U) (x:U), In U (Add U A x) x.
   Proof.
-    unfold Add at 1 in |- *; auto with sets.
+    unfold Add at 1; auto with sets.
   Qed.
 
   Lemma Inhabited_add : forall (A:Ensemble U) (x:U), Inhabited U (Add U A x).
@@ -68,7 +66,7 @@ Section Ensembles_facts.
     forall X:Ensemble U, Inhabited U X -> X <> Empty_set U.
   Proof.
     intros X H'; elim H'.
-    intros x H'0; red in |- *; intro H'1.
+    intros x H'0; red; intro H'1.
     absurd (In U X x); auto with sets.
     rewrite H'1; auto using Noone_in_empty with sets.
   Qed.
@@ -80,7 +78,7 @@ Section Ensembles_facts.
 
   Lemma not_Empty_Add : forall (A:Ensemble U) (x:U), Empty_set U <> Add U A x.
   Proof.
-    intros; red in |- *; intro H; generalize (Add_not_Empty A x); auto with sets.
+    intros; red; intro H; generalize (Add_not_Empty A x); auto with sets.
   Qed.
 
   Lemma Singleton_inv : forall x y:U, In U (Singleton U x) y -> x = y.
@@ -123,7 +121,7 @@ Section Ensembles_facts.
     forall (A B:Ensemble U) (x:U),
       In U A x -> ~ In U B x -> In U (Setminus U A B) x.
   Proof.
-    unfold Setminus at 1 in |- *; red in |- *; auto with sets.
+    unfold Setminus at 1; red; auto with sets.
   Qed.
 
   Lemma Strict_Included_intro :
@@ -134,7 +132,7 @@ Section Ensembles_facts.
 
   Lemma Strict_Included_strict : forall X:Ensemble U, ~ Strict_Included U X X.
   Proof.
-    intro X; red in |- *; intro H'; elim H'.
+    intro X; red; intro H'; elim H'.
     intros H'0 H'1; elim H'1; auto with sets.
   Qed.
 
diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v
index c7b496cb..058eec3d 100644
--- a/theories/Sets/Cpo.v
+++ b/theories/Sets/Cpo.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Cpo.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Ensembles.
 Require Export Relations_1.
 Require Export Partial_Order.
@@ -107,4 +105,4 @@ Section Specific_orders.
     {PO_of_chain : PO U;
     Chain_cond : Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)}.
 
-End Specific_orders.
\ No newline at end of file
+End Specific_orders.
diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v
index 6c80ad40..181069d5 100644
--- a/theories/Sets/Ensembles.v
+++ b/theories/Sets/Ensembles.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Ensembles.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Section Ensembles.
   Variable U : Type.
 
diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v
index 09a0a94d..fc940e48 100644
--- a/theories/Sets/Finite_sets.v
+++ b/theories/Sets/Finite_sets.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Finite_sets.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Ensembles.
 
 Section Ensembles_finis.
@@ -63,7 +61,7 @@ Section Ensembles_finis_facts.
             (exists x : _, X = Add U A x /\ ~ In U A x /\ cardinal U A n)
       end.
   Proof.
-    induction 1; simpl in |- *; auto.
+    induction 1; simpl; auto.
     exists A; exists x; auto.
   Qed.
 
@@ -75,7 +73,7 @@ Section Ensembles_finis_facts.
 	| S n => Inhabited U X
       end.
   Proof.
-    intros X p C; elim C; simpl in |- *; trivial with sets.
+    intros X p C; elim C; simpl; trivial with sets.
   Qed.
 
 End Ensembles_finis_facts.
diff --git a/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v
index a9fe8ffe..c0613637 100644
--- a/theories/Sets/Finite_sets_facts.v
+++ b/theories/Sets/Finite_sets_facts.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Finite_sets_facts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Finite_sets.
 Require Export Constructive_sets.
 Require Export Classical_Type.
@@ -64,7 +62,7 @@ Section Finite_sets_facts.
   Theorem Singleton_is_finite : forall x:U, Finite U (Singleton U x).
   Proof.
     intro x; rewrite <- (Empty_set_zero U (Singleton U x)).
-    change (Finite U (Add U (Empty_set U) x)) in |- *; auto with sets.
+    change (Finite U (Add U (Empty_set U) x)); auto with sets.
   Qed.
 
   Theorem Union_preserves_Finite :
@@ -136,15 +134,15 @@ Section Finite_sets_facts.
     cut (S (pred n) = pred (S n)).
     intro H'5; rewrite <- H'5.
     apply card_add; auto with sets.
-    red in |- *; intro H'6; elim H'6.
+    red; intro H'6; elim H'6.
     intros H'7 H'8; try assumption.
     elim H'1; auto with sets.
-    unfold pred at 2 in |- *; symmetry  in |- *.
+    unfold pred at 2; symmetry .
     apply S_pred with (m := 0).
-    change (n > 0) in |- *.
+    change (n > 0).
     apply inh_card_gt_O with (X := X); auto with sets.
     apply Inhabited_intro with (x := x0); auto with sets.
-    red in |- *; intro H'3.
+    red; intro H'3.
     apply H'1.
     elim H'3; auto with sets.
     rewrite H'3; auto with sets.
@@ -154,7 +152,7 @@ Section Finite_sets_facts.
     intro H'4; rewrite H'4; auto with sets.
     intros H'3 H'4; try assumption.
     absurd (In U (Add U X x) x0); auto with sets.
-    red in |- *; intro H'5; try exact H'5.
+    red; intro H'5; try exact H'5.
     lapply (Add_inv U X x x0); tauto.
   Qed.
 
@@ -175,21 +173,21 @@ Section Finite_sets_facts.
     clear H'2 c2 Y.
     intros X0 c2 H'2 H'3 x0 H'4 H'5.
     elim (classic (In U X0 x)).
-    intro H'6; apply f_equal with nat.
+    intro H'6; apply f_equal.
     apply H'0 with (Y := Subtract U (Add U X0 x0) x).
     elimtype (pred (S c2) = c2); auto with sets.
     apply card_soustr_1; auto with sets.
     rewrite <- H'5.
     apply Sub_Add_new; auto with sets.
     elim (classic (x = x0)).
-    intros H'6 H'7; apply f_equal with nat.
+    intros H'6 H'7; apply f_equal.
     apply H'0 with (Y := X0); auto with sets.
     apply Simplify_add with (x := x); auto with sets.
-    pattern x at 2 in |- *; rewrite H'6; auto with sets.
+    pattern x at 2; rewrite H'6; auto with sets.
     intros H'6 H'7.
     absurd (Add U X x = Add U X0 x0); auto with sets.
     clear H'0 H' H'3 n H'5 H'4 H'2 H'1 c2.
-    red in |- *; intro H'.
+    red; intro H'.
     lapply (Extension U (Add U X x) (Add U X0 x0)); auto with sets.
     clear H'.
     intro H'; red in H'.
@@ -256,7 +254,7 @@ Section Finite_sets_facts.
     apply H'0 with (Y := X0); auto with sets arith.
     apply sincl_add_x with (x := x0).
     rewrite <- H'6; auto with sets arith.
-    pattern x0 at 1 in |- *; rewrite <- H'6; trivial with sets arith.
+    pattern x0 at 1; rewrite <- H'6; trivial with sets arith.
     intros H'6 H'7; red in H'5.
     elim H'5; intros H'8 H'9; try exact H'8; clear H'5.
     red in H'8.
diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v
index e5eae17e..bdb7c077 100644
--- a/theories/Sets/Image.v
+++ b/theories/Sets/Image.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Image.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Finite_sets.
 Require Export Constructive_sets.
 Require Export Classical_Type.
@@ -57,7 +55,7 @@ Section Image.
   Proof.
     intros X x f.
     apply Extensionality_Ensembles.
-    split; red in |- *; intros x0 H'.
+    split; red; intros x0 H'.
     elim H'; intros.
     rewrite H0.
     elim Add_inv with U X x x1; auto using Im_def with sets.
@@ -74,7 +72,7 @@ Section Image.
     intro f; try assumption.
     apply Extensionality_Ensembles.
     split; auto with sets.
-    red in |- *.
+    red.
     intros x H'; elim H'.
     intros x0 H'0; elim H'0; auto with sets.
   Qed.
@@ -104,7 +102,7 @@ Section Image.
     forall f:U -> V,
       ~ injective f ->  exists x : _, (exists y : _, f x = f y /\ x <> y).
   Proof.
-    unfold injective in |- *; intros f H.
+    unfold injective; intros f H.
     cut (exists x : _, ~ (forall y:U, f x = f y -> x = y)).
     2: apply not_all_ex_not with (P := fun x:U => forall y:U, f x = f y -> x = y);
       trivial with sets.
@@ -155,7 +153,7 @@ Section Image.
     apply cardinal_unicity with V (Add _ (Im A f) (f x)); trivial with sets.
     apply card_add; auto with sets.
     rewrite <- H1; trivial with sets.
-    red in |- *; intro; apply H'2.
+    red; intro; apply H'2.
     apply In_Image_elim with f; trivial with sets.
   Qed.
 
@@ -182,7 +180,7 @@ Section Image.
       cardinal U A n ->
       forall n':nat, cardinal V (Im A f) n' -> n' < n -> ~ injective f.
   Proof.
-    unfold not in |- *; intros A f n CAn n' CIfn' ltn'n I.
+    unfold not; intros A f n CAn n' CIfn' ltn'n I.
     cut (n' = n).
     intro E; generalize ltn'n; rewrite E; exact (lt_irrefl n).
     apply injective_preserves_cardinal with (A := A) (f := f) (n := n);
@@ -202,4 +200,4 @@ Section Image.
 
 End Image.
 
-Hint Resolve Im_def image_empty finite_image: sets v62.
\ No newline at end of file
+Hint Resolve Im_def image_empty finite_image: sets v62.
diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v
index afb9e0e1..897046ab 100644
--- a/theories/Sets/Infinite_sets.v
+++ b/theories/Sets/Infinite_sets.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Infinite_sets.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Finite_sets.
 Require Export Constructive_sets.
 Require Export Classical_Type.
@@ -58,7 +56,7 @@ Section Infinite_sets.
     intros A X H' H'0.
     elim H'0; intros H'1 H'2.
     apply Strict_super_set_contains_new_element; auto with sets.
-    red in |- *; intro H'3; apply H'.
+    red; intro H'3; apply H'.
     rewrite <- H'3; auto with sets.
   Qed.
 
@@ -78,7 +76,7 @@ Section Infinite_sets.
     split.
     apply card_add; auto with sets.
     cut (In U A x).
-    intro H'4; red in |- *; auto with sets.
+    intro H'4; red; auto with sets.
     intros x0 H'5; elim H'5; auto with sets.
     intros x1 H'6; elim H'6; auto with sets.
     elim H'3; auto with sets.
@@ -93,7 +91,7 @@ Section Infinite_sets.
     split.
     apply card_add; auto with sets.
     elim H'2; auto with sets.
-    red in |- *.
+    red.
     intros x2 H'9; elim H'9; auto with sets.
     intros x3 H'10; elim H'10; auto with sets.
     elim H'2; auto with sets.
@@ -169,11 +167,11 @@ Section Infinite_sets.
     apply ex_intro with (x := Add U x0 x1).
     split; [ split; [ try assumption | idtac ] | idtac ].
     apply card_add; auto with sets.
-    red in |- *; intro H'9; try exact H'9.
+    red; intro H'9; try exact H'9.
     apply H'1.
     elim H'4; intros H'10 H'11; rewrite <- H'11; clear H'4; auto with sets.
     elim H'4; intros H'9 H'10; try exact H'9; clear H'4; auto with sets.
-    red in |- *; auto with sets.
+    red; auto with sets.
     intros x2 H'4; elim H'4; auto with sets.
     intros x3 H'11; elim H'11; auto with sets.
     elim H'4; intros H'9 H'10; rewrite <- H'10; clear H'4; auto with sets.
@@ -237,7 +235,7 @@ Section Infinite_sets.
   Proof.
     intros A f H' H'0 H'1.
     apply NNPP.
-    red in |- *; intro H'2.
+    red; intro H'2.
     elim (Pigeonhole_bis A f); auto with sets.
   Qed.
 
diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v
index 5d073a0c..4ee7496e 100644
--- a/theories/Sets/Integers.v
+++ b/theories/Sets/Integers.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Integers.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Finite_sets.
 Require Export Constructive_sets.
 Require Export Classical_Type.
@@ -51,17 +49,17 @@ Section Integers_sect.
 
   Lemma le_reflexive : Reflexive nat le.
   Proof.
-    red in |- *; auto with arith.
+    red; auto with arith.
   Qed.
 
   Lemma le_antisym : Antisymmetric nat le.
   Proof.
-    red in |- *; intros x y H H'; rewrite (le_antisym x y); auto.
+    red; intros x y H H'; rewrite (le_antisym x y); auto.
   Qed.
 
   Lemma le_trans : Transitive nat le.
   Proof.
-    red in |- *; intros; apply le_trans with y; auto.
+    red; intros; apply le_trans with y; auto.
   Qed.
 
   Lemma le_Order : Order nat le.
@@ -85,7 +83,7 @@ Section Integers_sect.
   Lemma le_total_order : Totally_ordered nat nat_po Integers.
   Proof.
     apply Totally_ordered_definition.
-    simpl in |- *.
+    simpl.
     intros H' x y H'0.
     elim le_or_lt with (n := x) (m := y).
     intro H'1; left; auto with sets arith.
@@ -105,7 +103,7 @@ Section Integers_sect.
     intros A H'0 H'1 x H'2; try assumption.
     elim H'1; intros x0 H'3; clear H'1.
     elim le_total_order.
-    simpl in |- *.
+    simpl.
     intro H'1; try assumption.
     lapply H'1; [ intro H'4; idtac | try assumption ]; auto with sets arith.
     generalize (H'4 x0 x).
@@ -116,28 +114,28 @@ Section Integers_sect.
 	[ intro H'5; try exact H'5; clear H'4 H'1 | intro H'5; clear H'4 H'1 ]
 	| clear H'1 ].
     exists x.
-    apply Upper_Bound_definition. simpl in |- *. apply triv_nat.
+    apply Upper_Bound_definition. simpl. apply triv_nat.
     intros y H'1; elim H'1.
     generalize le_trans.
     intro H'4; red in H'4.
     intros x1 H'6; try assumption.
-    apply H'4 with (y := x0). elim H'3; simpl in |- *; auto with sets arith. trivial.
+    apply H'4 with (y := x0). elim H'3; simpl; auto with sets arith. trivial.
     intros x1 H'4; elim H'4. unfold nat_po; simpl; trivial.
     exists x0.
     apply Upper_Bound_definition.
       unfold nat_po. simpl. apply triv_nat.
     intros y H'1; elim H'1.
     intros x1 H'4; try assumption.
-    elim H'3; simpl in |- *; auto with sets arith.
+    elim H'3; simpl; auto with sets arith.
     intros x1 H'4; elim H'4; auto with sets arith.
-    red in |- *.
+    red.
     intros x1 H'1; elim H'1; apply triv_nat.
   Qed.
 
   Lemma Integers_has_no_ub :
     ~ (exists m : nat, Upper_Bound nat nat_po Integers m).
   Proof.
-    red in |- *; intro H'; elim H'.
+    red; intro H'; elim H'.
     intros x H'0.
     elim H'0; intros H'1 H'2.
     cut (In nat Integers (S x)).
@@ -152,7 +150,7 @@ Section Integers_sect.
   Lemma Integers_infinite : ~ Finite nat Integers.
   Proof.
     generalize Integers_has_no_ub.
-    intro H'; red in |- *; intro H'0; try exact H'0.
+    intro H'; red; intro H'0; try exact H'0.
     apply H'.
     apply Finite_subset_has_lub; auto with sets arith.
   Qed.
diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v
index 6187c08b..1d0abab8 100644
--- a/theories/Sets/Multiset.v
+++ b/theories/Sets/Multiset.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Multiset.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (* G. Huet 1-9-95 *)
 
 Require Import Permut Setoid.
@@ -44,14 +42,14 @@ Section multiset_defs.
 
   Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z.
   Proof.
-    unfold meq in |- *.
+    unfold meq.
     destruct x; destruct y; destruct z.
     intros; rewrite H; auto.
   Qed.
 
   Lemma meq_sym : forall x y:multiset, meq x y -> meq y x.
   Proof.
-    unfold meq in |- *.
+    unfold meq.
     destruct x; destruct y; auto.
   Qed.
 
@@ -61,12 +59,12 @@ Section multiset_defs.
 
   Lemma munion_empty_left : forall x:multiset, meq x (munion EmptyBag x).
   Proof.
-    unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto.
+    unfold meq; unfold munion; simpl; auto.
   Qed.
 
   Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag).
   Proof.
-    unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto.
+    unfold meq; unfold munion; simpl; auto.
   Qed.
 
 
@@ -74,21 +72,21 @@ Section multiset_defs.
 
   Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x).
   Proof.
-    unfold meq in |- *; unfold multiplicity in |- *; unfold munion in |- *.
+    unfold meq; unfold multiplicity; unfold munion.
     destruct x; destruct y; auto with arith.
   Qed.
 
   Lemma munion_ass :
     forall x y z:multiset, meq (munion (munion x y) z) (munion x (munion y z)).
   Proof.
-    unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
+    unfold meq; unfold munion; unfold multiplicity.
     destruct x; destruct y; destruct z; auto with arith.
   Qed.
 
   Lemma meq_left :
     forall x y z:multiset, meq x y -> meq (munion x z) (munion y z).
   Proof.
-    unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
+    unfold meq; unfold munion; unfold multiplicity.
     destruct x; destruct y; destruct z.
     intros; elim H; auto with arith.
   Qed.
@@ -96,7 +94,7 @@ Section multiset_defs.
   Lemma meq_right :
     forall x y z:multiset, meq x y -> meq (munion z x) (munion z y).
   Proof.
-    unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
+    unfold meq; unfold munion; unfold multiplicity.
     destruct x; destruct y; destruct z.
     intros; elim H; auto.
   Qed.
diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v
index e819cafa..054164da 100644
--- a/theories/Sets/Partial_Order.v
+++ b/theories/Sets/Partial_Order.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Partial_Order.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Ensembles.
 Require Export Relations_1.
 
@@ -65,13 +63,13 @@ Section Partial_order_facts.
     forall x y z:U,
       Strict_Rel_of U D x y -> Rel_of U D y z -> Strict_Rel_of U D x z.
   Proof.
-    unfold Strict_Rel_of at 1 in |- *.
-    red in |- *.
-    elim D; simpl in |- *.
+    unfold Strict_Rel_of at 1.
+    red.
+    elim D; simpl.
     intros C R H' H'0; elim H'0.
     intros H'1 H'2 H'3 x y z H'4 H'5; split.
     apply H'2 with (y := y); tauto.
-    red in |- *; intro H'6.
+    red; intro H'6.
     elim H'4; intros H'7 H'8; apply H'8; clear H'4.
     apply H'3; auto.
     rewrite H'6; tauto.
@@ -81,22 +79,22 @@ Section Partial_order_facts.
     forall x y z:U,
       Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z.
   Proof.
-    unfold Strict_Rel_of at 1 in |- *.
-    red in |- *.
-    elim D; simpl in |- *.
+    unfold Strict_Rel_of at 1.
+    red.
+    elim D; simpl.
     intros C R H' H'0; elim H'0.
     intros H'1 H'2 H'3 x y z H'4 H'5; split.
     apply H'2 with (y := y); tauto.
-    red in |- *; intro H'6.
+    red; intro H'6.
     elim H'5; intros H'7 H'8; apply H'8; clear H'5.
     apply H'3; auto.
     rewrite <- H'6; auto.
   Qed.
 
   Lemma Strict_Rel_Transitive : Transitive U (Strict_Rel_of U D).
-    red in |- *.
+    red.
     intros x y z H' H'0.
     apply Strict_Rel_Transitive_with_Rel with (y := y);
       [ intuition | unfold Strict_Rel_of in H', H'0; intuition ].
   Qed.
-End Partial_order_facts.
\ No newline at end of file
+End Partial_order_facts.
diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v
index 8699eed3..5523f64c 100644
--- a/theories/Sets/Permut.v
+++ b/theories/Sets/Permut.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Permut.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (* G. Huet 1-9-95 *)
 
 (** We consider a Set [U], given with a commutative-associative operator [op],
@@ -86,4 +84,4 @@ Section Axiomatisation.
     apply cong_left; apply perm_left.
   Qed.
 
-End Axiomatisation.
\ No newline at end of file
+End Axiomatisation.
diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v
index 372473d6..cdbeaf7b 100644
--- a/theories/Sets/Powerset.v
+++ b/theories/Sets/Powerset.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Powerset.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Ensembles.
 Require Export Relations_1.
 Require Export Relations_1_facts.
@@ -41,7 +39,7 @@ Inductive Power_set (A:Ensemble U) : Ensemble (Ensemble U) :=
 Hint Resolve Definition_of_Power_set.
 
 Theorem Empty_set_minimal : forall X:Ensemble U, Included U (Empty_set U) X.
-intro X; red in |- *.
+intro X; red.
 intros x H'; elim H'.
 Qed.
 Hint Resolve Empty_set_minimal.
@@ -81,7 +79,7 @@ Lemma Strict_inclusion_is_transitive_with_inclusion :
    Strict_Included U x y -> Included U y z -> Strict_Included U x z.
 intros x y z H' H'0; try assumption.
 elim Strict_Rel_is_Strict_Included.
-unfold contains in |- *.
+unfold contains.
 intros H'1 H'2; try assumption.
 apply H'1.
 apply Strict_Rel_Transitive_with_Rel with (y := y); auto with sets.
@@ -92,7 +90,7 @@ Lemma Strict_inclusion_is_transitive_with_inclusion_left :
    Included U x y -> Strict_Included U y z -> Strict_Included U x z.
 intros x y z H' H'0; try assumption.
 elim Strict_Rel_is_Strict_Included.
-unfold contains in |- *.
+unfold contains.
 intros H'1 H'2; try assumption.
 apply H'1.
 apply Strict_Rel_Transitive_with_Rel_left with (y := y); auto with sets.
@@ -107,14 +105,14 @@ Qed.
 
 Theorem Empty_set_is_Bottom :
  forall A:Ensemble U, Bottom (Ensemble U) (Power_set_PO A) (Empty_set U).
-intro A; apply Bottom_definition; simpl in |- *; auto with sets.
+intro A; apply Bottom_definition; simpl; auto with sets.
 Qed.
 Hint Resolve Empty_set_is_Bottom.
 
 Theorem Union_minimal :
  forall a b X:Ensemble U,
    Included U a X -> Included U b X -> Included U (Union U a b) X.
-intros a b X H' H'0; red in |- *.
+intros a b X H' H'0; red.
 intros x H'1; elim H'1; auto with sets.
 Qed.
 Hint Resolve Union_minimal.
@@ -135,13 +133,13 @@ Qed.
 
 Theorem Intersection_decreases_l :
  forall a b:Ensemble U, Included U (Intersection U a b) a.
-intros a b; red in |- *.
+intros a b; red.
 intros x H'; elim H'; auto with sets.
 Qed.
 
 Theorem Intersection_decreases_r :
  forall a b:Ensemble U, Included U (Intersection U a b) b.
-intros a b; red in |- *.
+intros a b; red.
 intros x H'; elim H'; auto with sets.
 Qed.
 Hint Resolve Union_increases_l Union_increases_r Intersection_decreases_l
@@ -153,10 +151,10 @@ Theorem Union_is_Lub :
    Included U b A ->
    Lub (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b) (Union U a b).
 intros A a b H' H'0.
-apply Lub_definition; simpl in |- *.
-apply Upper_Bound_definition; simpl in |- *; auto with sets.
+apply Lub_definition; simpl.
+apply Upper_Bound_definition; simpl; auto with sets.
 intros y H'1; elim H'1; auto with sets.
-intros y H'1; elim H'1; simpl in |- *; auto with sets.
+intros y H'1; elim H'1; simpl; auto with sets.
 Qed.
 
 Theorem Intersection_is_Glb :
@@ -166,13 +164,13 @@ Theorem Intersection_is_Glb :
    Glb (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b)
      (Intersection U a b).
 intros A a b H' H'0.
-apply Glb_definition; simpl in |- *.
-apply Lower_Bound_definition; simpl in |- *; auto with sets.
+apply Glb_definition; simpl.
+apply Lower_Bound_definition; simpl; auto with sets.
 apply Definition_of_Power_set.
 generalize Inclusion_is_transitive; intro IT; red in IT; apply IT with a;
  auto with sets.
 intros y H'1; elim H'1; auto with sets.
-intros y H'1; elim H'1; simpl in |- *; auto with sets.
+intros y H'1; elim H'1; simpl; auto with sets.
 Qed.
 
 End The_power_set_partial_order.
@@ -187,4 +185,4 @@ Hint Resolve Union_increases_r: sets v62.
 Hint Resolve Intersection_decreases_l: sets v62.
 Hint Resolve Intersection_decreases_r: sets v62.
 Hint Resolve Empty_set_is_Bottom: sets v62.
-Hint Resolve Strict_inclusion_is_transitive: sets v62.
\ No newline at end of file
+Hint Resolve Strict_inclusion_is_transitive: sets v62.
diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v
index 66c0c0bb..d24e931d 100644
--- a/theories/Sets/Powerset_Classical_facts.v
+++ b/theories/Sets/Powerset_Classical_facts.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Powerset_Classical_facts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Ensembles.
 Require Export Constructive_sets.
 Require Export Relations_1.
@@ -46,13 +44,13 @@ Section Sets_as_an_algebra.
       ~ In U A x ->
       Strict_Included U (Add U A x) (Add U B x) -> Strict_Included U A B.
   Proof.
-    intros A B x H' H'0; red in |- *.
+    intros A B x H' H'0; red.
     lapply (Strict_Included_inv U (Add U A x) (Add U B x)); auto with sets.
     clear H'0; intro H'0; split.
     apply incl_add_x with (x := x); tauto.
     elim H'0; intros H'1 H'2; elim H'2; clear H'0 H'2.
     intros x0 H'0.
-    red in |- *; intro H'2.
+    red; intro H'2.
     elim H'0; clear H'0.
     rewrite <- H'2; auto with sets.
   Qed.
@@ -60,7 +58,7 @@ Section Sets_as_an_algebra.
   Lemma incl_soustr_in :
     forall (X:Ensemble U) (x:U), In U X x -> Included U (Subtract U X x) X.
   Proof.
-    intros X x H'; red in |- *.
+    intros X x H'; red.
     intros x0 H'0; elim H'0; auto with sets.
   Qed.
 
@@ -68,7 +66,7 @@ Section Sets_as_an_algebra.
     forall (X Y:Ensemble U) (x:U),
       Included U X Y -> Included U (Subtract U X x) (Subtract U Y x).
   Proof.
-    intros X Y x H'; red in |- *.
+    intros X Y x H'; red.
     intros x0 H'0; elim H'0.
     intros H'1 H'2.
     apply Subtract_intro; auto with sets.
@@ -77,7 +75,7 @@ Section Sets_as_an_algebra.
   Lemma incl_soustr_add_l :
     forall (X:Ensemble U) (x:U), Included U (Subtract U (Add U X x) x) X.
   Proof.
-    intros X x; red in |- *.
+    intros X x; red.
     intros x0 H'; elim H'; auto with sets.
     intro H'0; elim H'0; auto with sets.
     intros t H'1 H'2; elim H'2; auto with sets.
@@ -87,10 +85,10 @@ Section Sets_as_an_algebra.
     forall (X:Ensemble U) (x:U),
       ~ In U X x -> Included U X (Subtract U (Add U X x) x).
   Proof.
-    intros X x H'; red in |- *.
+    intros X x H'; red.
     intros x0 H'0; try assumption.
     apply Subtract_intro; auto with sets.
-    red in |- *; intro H'1; apply H'; rewrite H'1; auto with sets.
+    red; intro H'1; apply H'; rewrite H'1; auto with sets.
   Qed.
   Hint Resolve incl_soustr_add_r: sets v62.
 
@@ -98,7 +96,7 @@ Section Sets_as_an_algebra.
     forall (X:Ensemble U) (x:U),
       In U X x -> Included U X (Add U (Subtract U X x) x).
   Proof.
-    intros X x H'; red in |- *.
+    intros X x H'; red.
     intros x0 H'0; try assumption.
     elim (classic (x = x0)); intro K; auto with sets.
     elim K; auto with sets.
@@ -108,7 +106,7 @@ Section Sets_as_an_algebra.
     forall (X:Ensemble U) (x:U),
       In U X x -> Included U (Add U (Subtract U X x) x) X.
   Proof.
-    intros X x H'; red in |- *.
+    intros X x H'; red.
     intros x0 H'0; elim H'0; auto with sets.
     intros y H'1; elim H'1; auto with sets.
     intros t H'1; try assumption.
@@ -120,7 +118,7 @@ Section Sets_as_an_algebra.
       x <> y -> Subtract U (Add U X x) y = Add U (Subtract U X y) x.
   Proof.
     intros X x y H'; apply Extensionality_Ensembles.
-    split; red in |- *.
+    split; red.
     intros x0 H'0; elim H'0; auto with sets.
     intro H'1; elim H'1.
     intros u H'2 H'3; try assumption.
@@ -148,7 +146,7 @@ Section Sets_as_an_algebra.
     apply H'4 with (y := Y); auto using add_soustr_2 with sets.
     red in H'0.
     elim H'0; intros H'1 H'2; try exact H'1; clear H'0. (* PB *)
-    red in |- *; intro H'0; apply H'2.
+    red; intro H'0; apply H'2.
     rewrite H'0; auto 8 using add_soustr_xy, add_soustr_1, add_soustr_2 with sets.
   Qed.
 
@@ -179,7 +177,7 @@ Section Sets_as_an_algebra.
     exists (Subtract U X x).
     split; auto using incl_soustr_in, add_soustr_xy, add_soustr_1, add_soustr_2 with sets.
     red in H'0.
-    red in |- *.
+    red.
     intros x0 H'2; try assumption.
     lapply (Subtract_inv U X x x0); auto with sets.
     intro H'3; elim H'3; intros K K'; clear H'3.
@@ -191,7 +189,7 @@ Section Sets_as_an_algebra.
     elim K'; auto with sets.
     intro H'1; left; try assumption.
     red in H'0.
-    red in |- *.
+    red.
     intros x0 H'2; try assumption.
     lapply (H'0 x0); auto with sets.
     intro H'3; try assumption.
@@ -209,7 +207,7 @@ Section Sets_as_an_algebra.
       (forall z:Ensemble U, Included U x z -> Included U z y -> x = z \/ z = y).
   Proof.
     intros A x y H'; elim H'.
-    unfold Strict_Rel_of in |- *; simpl in |- *.
+    unfold Strict_Rel_of; simpl.
     intros H'0 H'1; split; [ auto with sets | idtac ].
     intros z H'2 H'3; try assumption.
     elim (classic (x = z)); auto with sets.
@@ -229,11 +227,11 @@ Section Sets_as_an_algebra.
   Proof.
     intros A a H' x H'0 H'1; try assumption.
     apply setcover_intro; auto with sets.
-    red in |- *.
-    split; [ idtac | red in |- *; intro H'2; try exact H'2 ]; auto with sets.
+    red.
+    split; [ idtac | red; intro H'2; try exact H'2 ]; auto with sets.
     apply H'1.
     rewrite H'2; auto with sets.
-    red in |- *; intro H'2; elim H'2; clear H'2.
+    red; intro H'2; elim H'2; clear H'2.
     intros z H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2.
     lapply (Strict_Included_inv U a z); auto with sets; clear H'3.
     intro H'2; elim H'2; intros H'3 H'5; elim H'5; clear H'2 H'5.
@@ -251,7 +249,7 @@ Section Sets_as_an_algebra.
     red in K.
     elim K; intros H'11 H'12; apply H'12; clear K; auto with sets.
     rewrite H'15.
-    red in |- *.
+    red.
     intros x1 H'10; elim H'10; auto with sets.
     intros x2 H'11; elim H'11; auto with sets.
   Qed.
@@ -277,11 +275,11 @@ Section Sets_as_an_algebra.
     elim (H'7 (Add U a x)); auto with sets.
     intro H'1.
     absurd (a = Add U a x); auto with sets.
-    red in |- *; intro H'8; try exact H'8.
+    red; intro H'8; try exact H'8.
     apply H'3.
     rewrite H'8; auto with sets.
     auto with sets.
-    red in |- *.
+    red.
     intros x0 H'1; elim H'1; auto with sets.
     intros x1 H'8; elim H'8; auto with sets.
     split; [ idtac | try assumption ].
diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v
index 09edd08a..58e3f44d 100644
--- a/theories/Sets/Powerset_facts.v
+++ b/theories/Sets/Powerset_facts.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Powerset_facts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Ensembles.
 Require Export Constructive_sets.
 Require Export Relations_1.
@@ -44,7 +42,7 @@ Section Sets_as_an_algebra.
 
   Theorem Empty_set_zero' : forall x:U, Add U (Empty_set U) x = Singleton U x.
   Proof.
-    unfold Add at 1 in |- *; auto using Empty_set_zero with sets.
+    unfold Add at 1; auto using Empty_set_zero with sets.
   Qed.
 
   Lemma less_than_empty :
@@ -78,7 +76,7 @@ Section Sets_as_an_algebra.
   Theorem Couple_as_union :
     forall x y:U, Union U (Singleton U x) (Singleton U y) = Couple U x y.
   Proof.
-    intros x y; apply Extensionality_Ensembles; split; red in |- *.
+    intros x y; apply Extensionality_Ensembles; split; red.
     intros x0 H'; elim H'; (intros x1 H'0; elim H'0; auto with sets).
     intros x0 H'; elim H'; auto with sets.
   Qed.
@@ -88,7 +86,7 @@ Section Sets_as_an_algebra.
       Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z) =
       Triple U x y z.
   Proof.
-    intros x y z; apply Extensionality_Ensembles; split; red in |- *.
+    intros x y z; apply Extensionality_Ensembles; split; red.
     intros x0 H'; elim H'.
     intros x1 H'0; elim H'0; (intros x2 H'1; elim H'1; auto with sets).
     intros x1 H'0; elim H'0; auto with sets.
@@ -116,7 +114,7 @@ Section Sets_as_an_algebra.
   Proof.
     intros A B.
     apply Extensionality_Ensembles.
-    split; red in |- *; intros x H'; elim H'; auto with sets.
+    split; red; intros x H'; elim H'; auto with sets.
   Qed.
 
   Theorem Distributivity :
@@ -126,7 +124,7 @@ Section Sets_as_an_algebra.
   Proof.
     intros A B C.
     apply Extensionality_Ensembles.
-    split; red in |- *; intros x H'.
+    split; red; intros x H'.
     elim H'.
     intros x0 H'0 H'1; generalize H'0.
     elim H'1; auto with sets.
@@ -140,7 +138,7 @@ Section Sets_as_an_algebra.
   Proof.
     intros A B C.
     apply Extensionality_Ensembles.
-    split; red in |- *; intros x H'.
+    split; red; intros x H'.
     elim H'; auto with sets.
     intros x0 H'0; elim H'0; auto with sets.
     elim H'.
@@ -153,15 +151,15 @@ Section Sets_as_an_algebra.
   Theorem Union_add :
     forall (A B:Ensemble U) (x:U), Add U (Union U A B) x = Union U A (Add U B x).
   Proof.
-    unfold Add in |- *; auto using Union_associative with sets.
+    unfold Add; auto using Union_associative with sets.
   Qed.
 
   Theorem Non_disjoint_union :
     forall (X:Ensemble U) (x:U), In U X x -> Add U X x = X.
   Proof.
-    intros X x H'; unfold Add in |- *.
-    apply Extensionality_Ensembles; red in |- *.
-    split; red in |- *; auto with sets.
+    intros X x H'; unfold Add.
+    apply Extensionality_Ensembles; red.
+    split; red; auto with sets.
     intros x0 H'0; elim H'0; auto with sets.
     intros t H'1; elim H'1; auto with sets.
   Qed.
@@ -169,12 +167,12 @@ Section Sets_as_an_algebra.
   Theorem Non_disjoint_union' :
     forall (X:Ensemble U) (x:U), ~ In U X x -> Subtract U X x = X.
   Proof.
-    intros X x H'; unfold Subtract in |- *.
+    intros X x H'; unfold Subtract.
     apply Extensionality_Ensembles.
-    split; red in |- *; auto with sets.
+    split; red; auto with sets.
     intros x0 H'0; elim H'0; auto with sets.
     intros x0 H'0; apply Setminus_intro; auto with sets.
-    red in |- *; intro H'1; elim H'1.
+    red; intro H'1; elim H'1.
     lapply (Singleton_inv U x x0); auto with sets.
     intro H'4; apply H'; rewrite H'4; auto with sets.
   Qed.
@@ -188,7 +186,7 @@ Section Sets_as_an_algebra.
     forall (A B:Ensemble U) (x:U),
       Included U A B -> Included U (Add U A x) (Add U B x).
   Proof.
-    intros A B x H'; red in |- *; auto with sets.
+    intros A B x H'; red; auto with sets.
     intros x0 H'0.
     lapply (Add_inv U A x x0); auto with sets.
     intro H'1; elim H'1;
@@ -200,7 +198,7 @@ Section Sets_as_an_algebra.
     forall (A B:Ensemble U) (x:U),
       ~ In U A x -> Included U (Add U A x) (Add U B x) -> Included U A B.
   Proof.
-    unfold Included in |- *.
+    unfold Included.
     intros A B x H' H'0 x0 H'1.
     lapply (H'0 x0); auto with sets.
     intro H'2; lapply (Add_inv U B x x0); auto with sets.
@@ -214,7 +212,7 @@ Section Sets_as_an_algebra.
     forall (A:Ensemble U) (x y:U), Add U (Add U A x) y = Add U (Add U A y) x.
   Proof.
     intros A x y.
-    unfold Add in |- *.
+    unfold Add.
     rewrite (Union_associative A (Singleton U x) (Singleton U y)).
     rewrite (Union_commutative (Singleton U x) (Singleton U y)).
     rewrite <- (Union_associative A (Singleton U y) (Singleton U x));
@@ -236,7 +234,7 @@ Section Sets_as_an_algebra.
   Proof.
     intros A B x y H'; try assumption.
     rewrite <- (Union_add (Add U A x) B y).
-    unfold Add at 4 in |- *.
+    unfold Add at 4.
     rewrite (Union_commutative A (Singleton U x)).
     rewrite Union_associative.
     rewrite (Union_absorbs A B H').
diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v
index 2818b370..229ef592 100644
--- a/theories/Sets/Relations_1.v
+++ b/theories/Sets/Relations_1.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_1.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Section Relations_1.
    Variable U : Type.
 
@@ -64,4 +62,4 @@ End Relations_1.
 Hint Unfold Reflexive Transitive Antisymmetric Symmetric contains
   same_relation: sets v62.
 Hint Resolve Definition_of_preorder Definition_of_order
-  Definition_of_equivalence Definition_of_PER: sets v62.
\ No newline at end of file
+  Definition_of_equivalence Definition_of_PER: sets v62.
diff --git a/theories/Sets/Relations_1_facts.v b/theories/Sets/Relations_1_facts.v
index f002e926..c4ede814 100644
--- a/theories/Sets/Relations_1_facts.v
+++ b/theories/Sets/Relations_1_facts.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_1_facts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Relations_1.
 
 Definition Complement (U:Type) (R:Relation U) : Relation U :=
@@ -35,8 +33,8 @@ Theorem Rsym_imp_notRsym :
  forall (U:Type) (R:Relation U),
    Symmetric U R -> Symmetric U (Complement U R).
 Proof.
-unfold Symmetric, Complement in |- *.
-intros U R H' x y H'0; red in |- *; intro H'1; apply H'0; auto with sets.
+unfold Symmetric, Complement.
+intros U R H' x y H'0; red; intro H'1; apply H'0; auto with sets.
 Qed.
 
 Theorem Equiv_from_preorder :
@@ -46,8 +44,8 @@ Proof.
 intros U R H'; elim H'; intros H'0 H'1.
 apply Definition_of_equivalence.
 red in H'0; auto 10 with sets.
-2: red in |- *; intros x y h; elim h; intros H'3 H'4; auto 10 with sets.
-red in H'1; red in |- *; auto 10 with sets.
+2: red; intros x y h; elim h; intros H'3 H'4; auto 10 with sets.
+red in H'1; red; auto 10 with sets.
 intros x y z h; elim h; intros H'3 H'4; clear h.
 intro h; elim h; intros H'5 H'6; clear h.
 split; apply H'1 with y; auto 10 with sets.
@@ -72,7 +70,7 @@ Hint Resolve contains_is_preorder.
 Theorem same_relation_is_equivalence :
  forall U:Type, Equivalence (Relation U) (same_relation U).
 Proof.
-unfold same_relation at 1 in |- *; auto 10 with sets.
+unfold same_relation at 1; auto 10 with sets.
 Qed.
 Hint Resolve same_relation_is_equivalence.
 
@@ -80,14 +78,14 @@ Theorem cong_reflexive_same_relation :
  forall (U:Type) (R R':Relation U),
    same_relation U R R' -> Reflexive U R -> Reflexive U R'.
 Proof.
-unfold same_relation in |- *; intuition.
+unfold same_relation; intuition.
 Qed.
 
 Theorem cong_symmetric_same_relation :
  forall (U:Type) (R R':Relation U),
    same_relation U R R' -> Symmetric U R -> Symmetric U R'.
 Proof.
-  compute in |- *; intros; elim H; intros; clear H;
+  compute; intros; elim H; intros; clear H;
    apply (H3 y x (H0 x y (H2 x y H1))).
 (*Intuition.*)
 Qed.
@@ -96,7 +94,7 @@ Theorem cong_antisymmetric_same_relation :
  forall (U:Type) (R R':Relation U),
    same_relation U R R' -> Antisymmetric U R -> Antisymmetric U R'.
 Proof.
-  compute in |- *; intros; elim H; intros; clear H;
+  compute; intros; elim H; intros; clear H;
    apply (H0 x y (H3 x y H1) (H3 y x H2)).
 (*Intuition.*)
 Qed.
@@ -105,8 +103,8 @@ Theorem cong_transitive_same_relation :
  forall (U:Type) (R R':Relation U),
    same_relation U R R' -> Transitive U R -> Transitive U R'.
 Proof.
-intros U R R' H' H'0; red in |- *.
+intros U R R' H' H'0; red.
 elim H'.
 intros H'1 H'2 x y z H'3 H'4; apply H'2.
 apply H'0 with y; auto with sets.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v
index 710bff2b..a371f316 100644
--- a/theories/Sets/Relations_2.v
+++ b/theories/Sets/Relations_2.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_2.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Relations_1.
 
 Section Relations_2.
@@ -53,4 +51,4 @@ End Relations_2.
 Hint Resolve Rstar_0: sets v62.
 Hint Resolve Rstar1_0: sets v62.
 Hint Resolve Rstar1_1: sets v62.
-Hint Resolve Rplus_0: sets v62.
\ No newline at end of file
+Hint Resolve Rplus_0: sets v62.
diff --git a/theories/Sets/Relations_2_facts.v b/theories/Sets/Relations_2_facts.v
index 5ccdcb11..676fd719 100644
--- a/theories/Sets/Relations_2_facts.v
+++ b/theories/Sets/Relations_2_facts.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_2_facts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Relations_1.
 Require Export Relations_1_facts.
 Require Export Relations_2.
@@ -45,13 +43,13 @@ Qed.
 Theorem Rstar_contains_R :
  forall (U:Type) (R:Relation U), contains U (Rstar U R) R.
 Proof.
-intros U R; red in |- *; intros x y H'; apply Rstar_n with y; auto with sets.
+intros U R; red; intros x y H'; apply Rstar_n with y; auto with sets.
 Qed.
 
 Theorem Rstar_contains_Rplus :
  forall (U:Type) (R:Relation U), contains U (Rstar U R) (Rplus U R).
 Proof.
-intros U R; red in |- *.
+intros U R; red.
 intros x y H'; elim H'.
 generalize Rstar_contains_R; intro T; red in T; auto with sets.
 intros x0 y0 z H'0 H'1 H'2; apply Rstar_n with y0; auto with sets.
@@ -60,7 +58,7 @@ Qed.
 Theorem Rstar_transitive :
  forall (U:Type) (R:Relation U), Transitive U (Rstar U R).
 Proof.
-intros U R; red in |- *.
+intros U R; red.
 intros x y z H'; elim H'; auto with sets.
 intros x0 y0 z0 H'0 H'1 H'2 H'3; apply Rstar_n with y0; auto with sets.
 Qed.
@@ -77,7 +75,7 @@ Theorem Rstar_equiv_Rstar1 :
  forall (U:Type) (R:Relation U), same_relation U (Rstar U R) (Rstar1 U R).
 Proof.
 generalize Rstar_contains_R; intro T; red in T.
-intros U R; unfold same_relation, contains in |- *.
+intros U R; unfold same_relation, contains.
 split; intros x y H'; elim H'; auto with sets.
 generalize Rstar_transitive; intro T1; red in T1.
 intros x0 y0 z H'0 H'1 H'2 H'3; apply T1 with y0; auto with sets.
@@ -87,7 +85,7 @@ Qed.
 Theorem Rsym_imp_Rstarsym :
  forall (U:Type) (R:Relation U), Symmetric U R -> Symmetric U (Rstar U R).
 Proof.
-intros U R H'; red in |- *.
+intros U R H'; red.
 intros x y H'0; elim H'0; auto with sets.
 intros x0 y0 z H'1 H'2 H'3.
 generalize Rstar_transitive; intro T1; red in T1.
@@ -99,7 +97,7 @@ Theorem Sstar_contains_Rstar :
  forall (U:Type) (R S:Relation U),
    contains U (Rstar U S) R -> contains U (Rstar U S) (Rstar U R).
 Proof.
-unfold contains in |- *.
+unfold contains.
 intros U R S H' x y H'0; elim H'0; auto with sets.
 generalize Rstar_transitive; intro T1; red in T1.
 intros x0 y0 z H'1 H'2 H'3; apply T1 with y0; auto with sets.
@@ -150,4 +148,4 @@ elim (H'3 t); auto with sets.
 intros z1 H'5; elim H'5; intros H'8 H'10; try exact H'8; clear H'5.
 exists z1; split; [ idtac | assumption ].
 apply Rstar_n with t; auto with sets.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v
index 1f96a75a..6d1853e2 100644
--- a/theories/Sets/Relations_3.v
+++ b/theories/Sets/Relations_3.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_3.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Relations_1.
 Require Export Relations_2.
 
diff --git a/theories/Sets/Relations_3_facts.v b/theories/Sets/Relations_3_facts.v
index 3a69a231..a63f7c80 100644
--- a/theories/Sets/Relations_3_facts.v
+++ b/theories/Sets/Relations_3_facts.v
@@ -1,6 +1,6 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -24,8 +24,6 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_3_facts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Relations_1.
 Require Export Relations_1_facts.
 Require Export Relations_2.
@@ -35,7 +33,7 @@ Require Export Relations_3.
 Theorem Rstar_imp_coherent :
  forall (U:Type) (R:Relation U) (x y:U), Rstar U R x y -> coherent U R x y.
 Proof.
-intros U R x y H'; red in |- *.
+intros U R x y H'; red.
 exists y; auto with sets.
 Qed.
 Hint Resolve Rstar_imp_coherent.
@@ -43,8 +41,8 @@ Hint Resolve Rstar_imp_coherent.
 Theorem coherent_symmetric :
  forall (U:Type) (R:Relation U), Symmetric U (coherent U R).
 Proof.
-unfold coherent at 1 in |- *.
-intros U R; red in |- *.
+unfold coherent at 1.
+intros U R; red.
 intros x y H'; elim H'.
 intros z H'0; exists z; tauto.
 Qed.
@@ -52,9 +50,9 @@ Qed.
 Theorem Strong_confluence :
  forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R.
 Proof.
-intros U R H'; red in |- *.
-intro x; red in |- *; intros a b H'0.
-unfold coherent at 1 in |- *.
+intros U R H'; red.
+intro x; red; intros a b H'0.
+unfold coherent at 1.
 generalize b; clear b.
 elim H'0; clear H'0.
 intros x0 b H'1; exists b; auto with sets.
@@ -77,9 +75,9 @@ Qed.
 Theorem Strong_confluence_direct :
  forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R.
 Proof.
-intros U R H'; red in |- *.
-intro x; red in |- *; intros a b H'0.
-unfold coherent at 1 in |- *.
+intros U R H'; red.
+intro x; red; intros a b H'0.
+unfold coherent at 1.
 generalize b; clear b.
 elim H'0; clear H'0.
 intros x0 b H'1; exists b; auto with sets.
@@ -113,7 +111,7 @@ Theorem Noetherian_contains_Noetherian :
  forall (U:Type) (R R':Relation U),
    Noetherian U R -> contains U R R' -> Noetherian U R'.
 Proof.
-unfold Noetherian at 2 in |- *.
+unfold Noetherian at 2.
 intros U R R' H' H'0 x.
 elim (H' x); auto with sets.
 Qed.
@@ -122,8 +120,8 @@ Theorem Newman :
  forall (U:Type) (R:Relation U),
    Noetherian U R -> Locally_confluent U R -> Confluent U R.
 Proof.
-intros U R H' H'0; red in |- *; intro x.
-elim (H' x); unfold confluent in |- *.
+intros U R H' H'0; red; intro x.
+elim (H' x); unfold confluent.
 intros x0 H'1 H'2 y z H'3 H'4.
 generalize (Rstar_cases U R x0 y); intro h; lapply h;
  [ intro h0; elim h0;
@@ -165,7 +163,7 @@ generalize (H'2 v); intro h; lapply h;
        | clear h h0 ]
     | clear h h0 ]
  | clear h ]; auto with sets.
-red in |- *; (exists z1; split); auto with sets.
+red; (exists z1; split); auto with sets.
 apply T with y1; auto with sets.
 apply T with t; auto with sets.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Sets/Uniset.v b/theories/Sets/Uniset.v
index 48789f9a..6e38b5e5 100644
--- a/theories/Sets/Uniset.v
+++ b/theories/Sets/Uniset.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Uniset.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Sets as characteristic functions *)
 
 (* G. Huet 1-9-95 *)
@@ -53,37 +51,37 @@ Hint Unfold seq.
 
 Lemma leb_refl : forall b:bool, leb b b.
 Proof.
-destruct b; simpl in |- *; auto.
+destruct b; simpl; auto.
 Qed.
 Hint Resolve leb_refl.
 
 Lemma incl_left : forall s1 s2:uniset, seq s1 s2 -> incl s1 s2.
 Proof.
-unfold incl in |- *; intros s1 s2 E a; elim (E a); auto.
+unfold incl; intros s1 s2 E a; elim (E a); auto.
 Qed.
 
 Lemma incl_right : forall s1 s2:uniset, seq s1 s2 -> incl s2 s1.
 Proof.
-unfold incl in |- *; intros s1 s2 E a; elim (E a); auto.
+unfold incl; intros s1 s2 E a; elim (E a); auto.
 Qed.
 
 Lemma seq_refl : forall x:uniset, seq x x.
 Proof.
-destruct x; unfold seq in |- *; auto.
+destruct x; unfold seq; auto.
 Qed.
 Hint Resolve seq_refl.
 
 Lemma seq_trans : forall x y z:uniset, seq x y -> seq y z -> seq x z.
 Proof.
-unfold seq in |- *.
-destruct x; destruct y; destruct z; simpl in |- *; intros.
+unfold seq.
+destruct x; destruct y; destruct z; simpl; intros.
 rewrite H; auto.
 Qed.
 
 Lemma seq_sym : forall x y:uniset, seq x y -> seq y x.
 Proof.
-unfold seq in |- *.
-destruct x; destruct y; simpl in |- *; auto.
+unfold seq.
+destruct x; destruct y; simpl; auto.
 Qed.
 
 (** uniset union *)
@@ -92,20 +90,20 @@ Definition union (m1 m2:uniset) :=
 
 Lemma union_empty_left : forall x:uniset, seq x (union Emptyset x).
 Proof.
-unfold seq in |- *; unfold union in |- *; simpl in |- *; auto.
+unfold seq; unfold union; simpl; auto.
 Qed.
 Hint Resolve union_empty_left.
 
 Lemma union_empty_right : forall x:uniset, seq x (union x Emptyset).
 Proof.
-unfold seq in |- *; unfold union in |- *; simpl in |- *.
+unfold seq; unfold union; simpl.
 intros x a; rewrite (orb_b_false (charac x a)); auto.
 Qed.
 Hint Resolve union_empty_right.
 
 Lemma union_comm : forall x y:uniset, seq (union x y) (union y x).
 Proof.
-unfold seq in |- *; unfold charac in |- *; unfold union in |- *.
+unfold seq; unfold charac; unfold union.
 destruct x; destruct y; auto with bool.
 Qed.
 Hint Resolve union_comm.
@@ -113,14 +111,14 @@ Hint Resolve union_comm.
 Lemma union_ass :
  forall x y z:uniset, seq (union (union x y) z) (union x (union y z)).
 Proof.
-unfold seq in |- *; unfold union in |- *; unfold charac in |- *.
+unfold seq; unfold union; unfold charac.
 destruct x; destruct y; destruct z; auto with bool.
 Qed.
 Hint Resolve union_ass.
 
 Lemma seq_left : forall x y z:uniset, seq x y -> seq (union x z) (union y z).
 Proof.
-unfold seq in |- *; unfold union in |- *; unfold charac in |- *.
+unfold seq; unfold union; unfold charac.
 destruct x; destruct y; destruct z.
 intros; elim H; auto.
 Qed.
@@ -128,7 +126,7 @@ Hint Resolve seq_left.
 
 Lemma seq_right : forall x y z:uniset, seq x y -> seq (union z x) (union z y).
 Proof.
-unfold seq in |- *; unfold union in |- *; unfold charac in |- *.
+unfold seq; unfold union; unfold charac.
 destruct x; destruct y; destruct z.
 intros; elim H; auto.
 Qed.
@@ -212,4 +210,4 @@ i*)
 
 End defs.
 
-Unset Implicit Arguments.
\ No newline at end of file
+Unset Implicit Arguments.
diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v
index 76080aa9..8b1bdbd4 100644
--- a/theories/Sorting/Heap.v
+++ b/theories/Sorting/Heap.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Heap.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file is deprecated, for a tree on list, use [Mergesort.v]. *)
 
 (** A development of Treesort on Heap trees. It has an average
@@ -57,13 +55,13 @@ Section defs.
 
   Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf.
   Proof.
-    simpl in |- *; auto with datatypes.
+    simpl; auto with datatypes.
   Qed.
 
   Lemma leA_Tree_Node :
     forall (a b:A) (G D:Tree), leA a b -> leA_Tree a (Tree_Node b G D).
   Proof.
-    simpl in |- *; auto with datatypes.
+    simpl; auto with datatypes.
   Qed.
 
 
@@ -123,7 +121,7 @@ Section defs.
     forall (T:Tree) (a b:A), leA a b -> leA_Tree b T -> leA_Tree a T.
   Proof.
     simple induction T; auto with datatypes.
-    intros; simpl in |- *; apply leA_trans with b; auto with datatypes.
+    intros; simpl; apply leA_trans with b; auto with datatypes.
   Qed.
 
   (** ** Merging two sorted lists *)
@@ -215,12 +213,12 @@ Section defs.
     simple induction 1; intros.
     apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf);
       auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
-    simpl in |- *; unfold meq, munion in |- *; auto using node_is_heap with datatypes.
+    simpl; unfold meq, munion; auto using node_is_heap with datatypes.
     elim (leA_dec a a0); intros.
     elim (X a0); intros.
     apply insert_exist with (Tree_Node a T2 T0);
       auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
-    simpl in |- *; apply treesort_twist1; trivial with datatypes.
+    simpl; apply treesort_twist1; trivial with datatypes.
     elim (X a); intros T3 HeapT3 ConT3 LeA.
     apply insert_exist with (Tree_Node a0 T2 T3);
       auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
@@ -228,7 +226,7 @@ Section defs.
     apply low_trans with a; auto with datatypes.
     apply LeA; auto with datatypes.
     apply low_trans with a; auto with datatypes.
-    simpl in |- *; apply treesort_twist2; trivial with datatypes.
+    simpl; apply treesort_twist2; trivial with datatypes.
   Qed.
 
 
@@ -244,10 +242,10 @@ Section defs.
   Proof.
     simple induction l.
     apply (heap_exist nil Tree_Leaf); auto with datatypes.
-    simpl in |- *; unfold meq in |- *; exact nil_is_heap.
+    simpl; unfold meq; exact nil_is_heap.
     simple induction 1.
     intros T i m; elim (insert T i a).
-    intros; apply heap_exist with T1; simpl in |- *; auto with datatypes.
+    intros; apply heap_exist with T1; simpl; auto with datatypes.
     apply meq_trans with (munion (contents T) (singletonBag a)).
     apply meq_trans with (munion (singletonBag a) (contents T)).
     apply meq_right; trivial with datatypes.
@@ -271,7 +269,7 @@ Section defs.
     apply flat_exist with (nil (A:=A)); auto with datatypes.
     elim X; intros l1 s1 i1 m1; elim X0; intros l2 s2 i2 m2.
     elim (merge _ s1 _ s2); intros.
-    apply flat_exist with (a :: l); simpl in |- *; auto with datatypes.
+    apply flat_exist with (a :: l); simpl; auto with datatypes.
     apply meq_trans with
       (munion (list_contents _ eqA_dec l1)
 	(munion (list_contents _ eqA_dec l2) (singletonBag a))).
@@ -290,7 +288,7 @@ Section defs.
     forall l:list A,
     {m : list A | Sorted leA m & permutation _ eqA_dec l m}.
   Proof.
-    intro l; unfold permutation in |- *.
+    intro l; unfold permutation.
     elim (list_to_heap l).
     intros.
     elim (heap_to_list T); auto with datatypes.
diff --git a/theories/Sorting/Mergesort.v b/theories/Sorting/Mergesort.v
index cded23ea..301a2142 100644
--- a/theories/Sorting/Mergesort.v
+++ b/theories/Sorting/Mergesort.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Mergesort.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** A modular implementation of mergesort (the complexity is O(n.log n) in
    the length of the list) *)
 
@@ -133,7 +131,7 @@ Theorem Sorted_merge : forall l1 l2,
   Sorted l1 -> Sorted l2 -> Sorted (merge l1 l2).
 Proof.
 induction l1; induction l2; intros; simpl; auto.
-  destruct (a <=? a0) as ()_eqn:Heq1.
+  destruct (a <=? a0) eqn:Heq1.
     invert H.
       simpl. constructor; trivial; rewrite Heq1; constructor.
       assert (Sorted (merge (b::l) (a0::l2))) by (apply IHl1; auto).
diff --git a/theories/Sorting/PermutEq.v b/theories/Sorting/PermutEq.v
index 00d6e7ce..cc47b500 100644
--- a/theories/Sorting/PermutEq.v
+++ b/theories/Sorting/PermutEq.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: PermutEq.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Relations Setoid SetoidList List Multiset PermutSetoid Permutation.
 
 Set Implicit Arguments.
diff --git a/theories/Sorting/PermutSetoid.v b/theories/Sorting/PermutSetoid.v
index 87b0b08d..2cd4f5f7 100644
--- a/theories/Sorting/PermutSetoid.v
+++ b/theories/Sorting/PermutSetoid.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: PermutSetoid.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Omega Relations Multiset SetoidList.
 
 (** This file is deprecated, use [Permutation.v] instead.
@@ -54,7 +52,7 @@ Lemma list_contents_app :
   forall l m:list A,
     meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)).
 Proof.
-  simple induction l; simpl in |- *; auto with datatypes.
+  simple induction l; simpl; auto with datatypes.
   intros.
   apply meq_trans with
     (munion (singletonBag a) (munion (list_contents l0) (list_contents m)));
@@ -67,19 +65,19 @@ Definition permutation (l m:list A) := meq (list_contents l) (list_contents m).
 
 Lemma permut_refl : forall l:list A, permutation l l.
 Proof.
-  unfold permutation in |- *; auto with datatypes.
+  unfold permutation; auto with datatypes.
 Qed.
 
 Lemma permut_sym :
   forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1.
 Proof.
-  unfold permutation, meq; intros; apply sym_eq; trivial.
+  unfold permutation, meq; intros; symmetry; trivial.
 Qed.
 
 Lemma permut_trans :
   forall l m n:list A, permutation l m -> permutation m n -> permutation l n.
 Proof.
-  unfold permutation in |- *; intros.
+  unfold permutation; intros.
   apply meq_trans with (list_contents m); auto with datatypes.
 Qed.
 
@@ -104,7 +102,7 @@ Lemma permut_app :
   forall l l' m m':list A,
     permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m').
 Proof.
-  unfold permutation in |- *; intros.
+  unfold permutation; intros.
   apply meq_trans with (munion (list_contents l) (list_contents m));
     auto using permut_cons, list_contents_app with datatypes.
   apply meq_trans with (munion (list_contents l') (list_contents m'));
@@ -344,8 +342,7 @@ Proof.
   rewrite if_eqA_refl in H.
   clear IHl; omega.
   rewrite IHl; intros.
-  specialize (H a0); auto with *.
-  destruct (eqA_dec a a0); simpl; auto with *.
+  specialize (H a0). omega.
 Qed.
 
 (** Permutation is compatible with InA. *)
@@ -396,18 +393,14 @@ Proof.
   apply permut_length_1.
   red; red; intros.
   specialize (P a). simpl in *.
-  rewrite (@if_eqA_rewrite_l a1 a2 a) in P by auto.
-  (** Bug omega: le "set" suivant ne devrait pas etre necessaire *)
-  set (u:= if eqA_dec a2 a then 1 else 0) in *; omega.
+  rewrite (@if_eqA_rewrite_l a1 a2 a) in P by auto. omega.
   right.
   inversion_clear H0; [|inversion H].
   split; auto.
   apply permut_length_1.
   red; red; intros.
   specialize (P a); simpl in *.
-  rewrite (@if_eqA_rewrite_l a1 b2 a) in P by auto.
-  (** Bug omega: idem *)
-  set (u:= if eqA_dec b2 a then 1 else 0) in *; omega.
+  rewrite (@if_eqA_rewrite_l a1 b2 a) in P by auto. omega.
 Qed.
 
 (** Permutation is compatible with length. *)
@@ -492,7 +485,7 @@ Qed.
 
 End Permut_map.
 
-Require Import Permutation TheoryList.
+Require Import Permutation.
 
 Section Permut_permut.
 
diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v
index 7508ccc2..a69c4aa7 100644
--- a/theories/Sorting/Permutation.v
+++ b/theories/Sorting/Permutation.v
@@ -1,15 +1,13 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Permutation.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (*********************************************************************)
-(** ** List permutations as a composition of adjacent transpositions *)
+(** * List permutations as a composition of adjacent transpositions  *)
 (*********************************************************************)
 
 (* Adapted in May 2006 by Jean-Marc Notin from initial contents by
@@ -139,32 +137,26 @@ Proof.
   intros; apply Permutation_app; auto.
 Qed.
 
+Lemma Permutation_cons_append : forall (l : list A) x,
+  Permutation (x :: l) (l ++ x :: nil).
+Proof. induction l; intros; auto. simpl. rewrite <- IHl; auto. Qed.
+Local Hint Resolve Permutation_cons_append.
+
 Theorem Permutation_app_comm : forall (l l' : list A),
   Permutation (l ++ l') (l' ++ l).
 Proof.
   induction l as [|x l]; simpl; intro l'.
-  rewrite app_nil_r; trivial.
-  induction l' as [|y l']; simpl.
-  rewrite app_nil_r; trivial.
-  transitivity (x :: y :: l' ++ l).
-  constructor; rewrite app_comm_cons; apply IHl.
-  transitivity (y :: x :: l' ++ l); constructor.
-  transitivity (x :: l ++ l'); auto.
+  rewrite app_nil_r; trivial. rewrite IHl. 
+  rewrite app_comm_cons, Permutation_cons_append. 
+  now rewrite <- app_assoc. 
 Qed.
+Local Hint Resolve Permutation_app_comm.
 
 Theorem Permutation_cons_app : forall (l l1 l2:list A) a,
   Permutation l (l1 ++ l2) -> Permutation (a :: l) (l1 ++ a :: l2).
-Proof.
-  intros l l1; revert l.
-  induction l1.
-  simpl.
-  intros; apply perm_skip; auto.
-  simpl; intros.
-  transitivity (a0::a::l1++l2).
-  apply perm_skip; auto.
-  transitivity (a::a0::l1++l2).
-  apply perm_swap; auto.
-  apply perm_skip; auto.
+Proof. intros l l1 l2 a H. rewrite H.
+  rewrite app_comm_cons, Permutation_cons_append. 
+  now rewrite <- app_assoc. 
 Qed.
 Local Hint Resolve Permutation_cons_app.
 
@@ -173,19 +165,20 @@ Theorem Permutation_middle : forall (l1 l2:list A) a,
 Proof.
   auto.
 Qed.
+Local Hint Resolve Permutation_middle.
 
 Theorem Permutation_rev : forall (l : list A), Permutation l (rev l).
 Proof.
-  induction l as [| x l]; simpl; trivial.
-  apply Permutation_trans with (l' := [x] ++ rev l).
-  simpl; auto.
-  apply Permutation_app_comm.
+  induction l as [| x l]; simpl; trivial. now rewrite IHl at 1. 
 Qed.
 
+Add Parametric Morphism : (@rev A)
+  with signature @Permutation A ==> @Permutation A as Permutation_rev'.
+Proof. intros. now do 2 rewrite <- Permutation_rev. Qed.
+
 Theorem Permutation_length : forall (l l' : list A), Permutation l l' -> length l = length l'.
 Proof.
-  intros l l' Hperm; induction Hperm; simpl; auto.
-  apply trans_eq with (y:= (length l')); trivial.
+  intros l l' Hperm; induction Hperm; simpl; auto. now transitivity (length l').
 Qed.
 
 Theorem Permutation_ind_bis :
@@ -211,6 +204,12 @@ Ltac break_list l x l' H :=
   destruct l as [|x l']; simpl in *;
   injection H; intros; subst; clear H.
 
+Theorem Permutation_nil_app_cons : forall (l l' : list A) (x : A), ~ Permutation nil (l++x::l').
+Proof.
+  intros l l' x HF. 
+  apply Permutation_nil in HF. destruct l; discriminate.
+Qed.
+
 Theorem Permutation_app_inv : forall (l1 l2 l3 l4:list A) a,
   Permutation (l1++a::l2) (l3++a::l4) -> Permutation (l1++l2) (l3 ++ l4).
 Proof.
@@ -224,32 +223,27 @@ Proof.
   (* skip *)
   intros x l l' H IH; intros.
   break_list l1 b l1' H0; break_list l3 c l3' H1.
-  auto.
-  apply perm_trans with (l3'++c::l4); auto.
-  apply perm_trans with (l1'++a::l2); auto using Permutation_cons_app.
-  apply perm_skip.
-  apply (IH a l1' l2 l3' l4); auto.
+  auto. 
+  now rewrite H. 
+  now rewrite <- H. 
+  now rewrite (IH a _ _ _ _ eq_refl eq_refl).
   (* contradict *)
   intros x y l l' Hp IH; intros.
   break_list l1 b l1' H; break_list l3 c l3' H0.
   auto.
   break_list l3' b l3'' H.
-  auto.
-  apply perm_trans with (c::l3''++b::l4); auto.
+  auto. 
+  rewrite <- Permutation_middle in Hp. now rewrite Hp. 
   break_list l1' c l1'' H1.
-  auto.
-  apply perm_trans with (b::l1''++c::l2); auto.
+  auto. 
+  rewrite <- Permutation_middle in Hp. now rewrite Hp. 
   break_list l3' d l3'' H; break_list l1' e l1'' H1.
   auto.
-  apply perm_trans with (e::a::l1''++l2); auto.
-  apply perm_trans with (e::l1''++a::l2); auto.
-  apply perm_trans with (d::a::l3''++l4); auto.
-  apply perm_trans with (d::l3''++a::l4); auto.
-  apply perm_trans with (e::d::l1''++l2); auto.
-  apply perm_skip; apply perm_skip.
-  apply (IH a l1'' l2 l3'' l4); auto.
+  rewrite <- Permutation_middle in Hp. rewrite perm_swap. auto. 
+  rewrite perm_swap, Permutation_middle. auto.
+  now rewrite perm_swap, (IH a _ _ _ _ eq_refl eq_refl).
   (*trans*)
-  intros.
+  intros. 
   destruct (In_split a l') as (l'1,(l'2,H6)).
   apply (Permutation_in a H).
   subst l.
@@ -375,4 +369,4 @@ End Permutation_map.
 
 (* begin hide *)
 Notation Permutation_app_swap := Permutation_app_comm (only parsing).
-(* end hide *)
+(* end hide *)
\ No newline at end of file
diff --git a/theories/Sorting/Sorted.v b/theories/Sorting/Sorted.v
index 2c7c07e5..03952c95 100644
--- a/theories/Sorting/Sorted.v
+++ b/theories/Sorting/Sorted.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Sorted.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (* Made by Hugo Herbelin *)
 
 (** This file defines two notions of sorted list:
@@ -27,7 +25,7 @@ Require Import List Relations Relations_1.
 Set Implicit Arguments.
 Local Notation "[ ]" := nil (at level 0).
 Local Notation "[ a ; .. ; b ]" := (a :: .. (b :: []) ..) (at level 0).
-Implicit Arguments Transitive [U].
+Arguments Transitive [U] R.
 
 Section defs.
 
diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v
index bc1fdbcf..ab03cb5e 100644
--- a/theories/Sorting/Sorting.v
+++ b/theories/Sorting/Sorting.v
@@ -1,12 +1,10 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Sorting.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Sorted.
 Require Export Mergesort.
diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v
index 4204456f..a89b888e 100644
--- a/theories/Strings/Ascii.v
+++ b/theories/Strings/Ascii.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Ascii.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Contributed by Laurent Théry (INRIA);
     Adapted to Coq V8 by the Coq Development Team *)
 
@@ -67,7 +65,7 @@ Definition ascii_of_N (n : N) :=
 
 (** Same for [nat] *)
 
-Definition ascii_of_nat (a : nat) := ascii_of_N (N_of_nat a).
+Definition ascii_of_nat (a : nat) := ascii_of_N (N.of_nat a).
 
 (** The opposite functions *)
 
@@ -83,7 +81,7 @@ Definition N_of_ascii (a : ascii) : N :=
  let (a0,a1,a2,a3,a4,a5,a6,a7) := a in
  N_of_digits (a0::a1::a2::a3::a4::a5::a6::a7::nil).
 
-Definition nat_of_ascii (a : ascii) : nat := nat_of_N (N_of_ascii a).
+Definition nat_of_ascii (a : ascii) : nat := N.to_nat (N_of_ascii a).
 
 (** Proofs that we have indeed opposite function (below 256) *)
 
@@ -113,10 +111,10 @@ Theorem nat_ascii_embedding :
 Proof.
  intros. unfold nat_of_ascii, ascii_of_nat.
  rewrite N_ascii_embedding.
- apply nat_of_N_of_nat.
- unfold Nlt.
- change 256%N with (N_of_nat 256).
- rewrite <- N_of_nat_compare.
+ apply Nat2N.id.
+ unfold N.lt.
+ change 256%N with (N.of_nat 256).
+ rewrite <- Nat2N.inj_compare.
  rewrite <- Compare_dec.nat_compare_lt. auto.
 Qed.
 
@@ -139,7 +137,7 @@ Qed.
   which is typically not the case in coqide).
 *)
 
-Open Local Scope char_scope.
+Local Open Scope char_scope.
 
 Example Space := " ".
 Example DoubleQuote := """".
diff --git a/theories/Strings/String.v b/theories/Strings/String.v
index c26b8818..6294d156 100644
--- a/theories/Strings/String.v
+++ b/theories/Strings/String.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: String.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Contributed by Laurent Théry (INRIA);
     Adapted to Coq V8 by the Coq Development Team *)
 
@@ -26,7 +24,7 @@ Inductive string : Set :=
 
 Delimit Scope string_scope with string.
 Bind Scope string_scope with string.
-Open Local Scope string_scope.
+Local Open Scope string_scope.
 
 (** Equality is decidable *)
 
@@ -74,14 +72,14 @@ Fixpoint get (n : nat) (s : string) {struct s} : option ascii :=
 Theorem get_correct :
   forall s1 s2 : string, (forall n : nat, get n s1 = get n s2) <-> s1 = s2.
 Proof.
-intros s1; elim s1; simpl in |- *.
-intros s2; case s2; simpl in |- *; split; auto.
+intros s1; elim s1; simpl.
+intros s2; case s2; simpl; split; auto.
 intros H; generalize (H 0); intros H1; inversion H1.
 intros; discriminate.
-intros a s1' Rec s2; case s2; simpl in |- *; split; auto.
+intros a s1' Rec s2; case s2; simpl; split; auto.
 intros H; generalize (H 0); intros H1; inversion H1.
 intros; discriminate.
-intros H; generalize (H 0); simpl in |- *; intros H1; inversion H1.
+intros H; generalize (H 0); simpl; intros H1; inversion H1.
 case (Rec s).
 intros H0; rewrite H0; auto.
 intros n; exact (H (S n)).
@@ -96,9 +94,9 @@ Theorem append_correct1 :
  forall (s1 s2 : string) (n : nat),
  n < length s1 -> get n s1 = get n (s1 ++ s2).
 Proof.
-intros s1; elim s1; simpl in |- *; auto.
+intros s1; elim s1; simpl; auto.
 intros s2 n H; inversion H.
-intros a s1' Rec s2 n; case n; simpl in |- *; auto.
+intros a s1' Rec s2 n; case n; simpl; auto.
 intros n0 H; apply Rec; auto.
 apply lt_S_n; auto.
 Qed.
@@ -109,10 +107,10 @@ Theorem append_correct2 :
  forall (s1 s2 : string) (n : nat),
  get n s2 = get (n + length s1) (s1 ++ s2).
 Proof.
-intros s1; elim s1; simpl in |- *; auto.
-intros s2 n; rewrite plus_comm; simpl in |- *; auto.
-intros a s1' Rec s2 n; case n; simpl in |- *; auto.
-generalize (Rec s2 0); simpl in |- *; auto. intros.
+intros s1; elim s1; simpl; auto.
+intros s2 n; rewrite plus_comm; simpl; auto.
+intros a s1' Rec s2 n; case n; simpl; auto.
+generalize (Rec s2 0); simpl; auto. intros.
 rewrite <- Plus.plus_Snm_nSm; auto.
 Qed.
 
@@ -137,16 +135,16 @@ Theorem substring_correct1 :
  forall (s : string) (n m p : nat),
  p < m -> get p (substring n m s) = get (p + n) s.
 Proof.
-intros s; elim s; simpl in |- *; auto.
-intros n; case n; simpl in |- *; auto.
-intros m; case m; simpl in |- *; auto.
-intros a s' Rec; intros n; case n; simpl in |- *; auto.
-intros m; case m; simpl in |- *; auto.
+intros s; elim s; simpl; auto.
+intros n; case n; simpl; auto.
+intros m; case m; simpl; auto.
+intros a s' Rec; intros n; case n; simpl; auto.
+intros m; case m; simpl; auto.
 intros p H; inversion H.
-intros m' p; case p; simpl in |- *; auto.
-intros n0 H; apply Rec; simpl in |- *; auto.
+intros m' p; case p; simpl; auto.
+intros n0 H; apply Rec; simpl; auto.
 apply Lt.lt_S_n; auto.
-intros n' m p H; rewrite <- Plus.plus_Snm_nSm; simpl in |- *; auto.
+intros n' m p H; rewrite <- Plus.plus_Snm_nSm; simpl; auto.
 Qed.
 
 (** The substring has at most [m] elements *)
@@ -154,14 +152,14 @@ Qed.
 Theorem substring_correct2 :
  forall (s : string) (n m p : nat), m <= p -> get p (substring n m s) = None.
 Proof.
-intros s; elim s; simpl in |- *; auto.
-intros n; case n; simpl in |- *; auto.
-intros m; case m; simpl in |- *; auto.
-intros a s' Rec; intros n; case n; simpl in |- *; auto.
-intros m; case m; simpl in |- *; auto.
-intros m' p; case p; simpl in |- *; auto.
+intros s; elim s; simpl; auto.
+intros n; case n; simpl; auto.
+intros m; case m; simpl; auto.
+intros a s' Rec; intros n; case n; simpl; auto.
+intros m; case m; simpl; auto.
+intros m' p; case p; simpl; auto.
 intros H; inversion H.
-intros n0 H; apply Rec; simpl in |- *; auto.
+intros n0 H; apply Rec; simpl; auto.
 apply Le.le_S_n; auto.
 Qed.
 
@@ -190,11 +188,11 @@ Theorem prefix_correct :
  forall s1 s2 : string,
  prefix s1 s2 = true <-> substring 0 (length s1) s2 = s1.
 Proof.
-intros s1; elim s1; simpl in |- *; auto.
-intros s2; case s2; simpl in |- *; split; auto.
-intros a s1' Rec s2; case s2; simpl in |- *; auto.
+intros s1; elim s1; simpl; auto.
+intros s2; case s2; simpl; split; auto.
+intros a s1' Rec s2; case s2; simpl; auto.
 split; intros; discriminate.
-intros b s2'; case (ascii_dec a b); simpl in |- *; auto.
+intros b s2'; case (ascii_dec a b); simpl; auto.
 intros e; case (Rec s2'); intros H1 H2; split; intros H3; auto.
 rewrite e; rewrite H1; auto.
 apply H2; injection H3; auto.
@@ -236,28 +234,28 @@ Theorem index_correct1 :
  forall (n m : nat) (s1 s2 : string),
  index n s1 s2 = Some m -> substring m (length s1) s2 = s1.
 Proof.
-intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl in |- *;
+intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl;
  auto.
-intros n; case n; simpl in |- *; auto.
-intros m s1; case s1; simpl in |- *; auto.
+intros n; case n; simpl; auto.
+intros m s1; case s1; simpl; auto.
 intros H; injection H; intros H1; rewrite <- H1; auto.
 intros; discriminate.
 intros; discriminate.
 intros b s2' Rec n m s1.
-case n; simpl in |- *; auto.
+case n; simpl; auto.
 generalize (prefix_correct s1 (String b s2'));
  case (prefix s1 (String b s2')).
 intros H0 H; injection H; intros H1; rewrite <- H1; auto.
-case H0; simpl in |- *; auto.
-case m; simpl in |- *; auto.
+case H0; simpl; auto.
+case m; simpl; auto.
 case (index 0 s1 s2'); intros; discriminate.
 intros m'; generalize (Rec 0 m' s1); case (index 0 s1 s2'); auto.
-intros x H H0 H1; apply H; injection H1; intros H2; injection H2; auto.
+intros x H H0 H1; apply H; injection H1; auto.
 intros; discriminate.
-intros n'; case m; simpl in |- *; auto.
+intros n'; case m; simpl; auto.
 case (index n' s1 s2'); intros; discriminate.
 intros m'; generalize (Rec n' m' s1); case (index n' s1 s2'); auto.
-intros x H H1; apply H; injection H1; intros H2; injection H2; auto.
+intros x H H1; apply H; injection H1; auto.
 intros; discriminate.
 Qed.
 
@@ -269,38 +267,38 @@ Theorem index_correct2 :
  index n s1 s2 = Some m ->
  forall p : nat, n <= p -> p < m -> substring p (length s1) s2 <> s1.
 Proof.
-intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl in |- *;
+intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl;
  auto.
-intros n; case n; simpl in |- *; auto.
-intros m s1; case s1; simpl in |- *; auto.
+intros n; case n; simpl; auto.
+intros m s1; case s1; simpl; auto.
 intros H; injection H; intros H1; rewrite <- H1.
 intros p H0 H2; inversion H2.
 intros; discriminate.
 intros; discriminate.
 intros b s2' Rec n m s1.
-case n; simpl in |- *; auto.
+case n; simpl; auto.
 generalize (prefix_correct s1 (String b s2'));
  case (prefix s1 (String b s2')).
 intros H0 H; injection H; intros H1; rewrite <- H1; auto.
 intros p H2 H3; inversion H3.
-case m; simpl in |- *; auto.
+case m; simpl; auto.
 case (index 0 s1 s2'); intros; discriminate.
 intros m'; generalize (Rec 0 m' s1); case (index 0 s1 s2'); auto.
-intros x H H0 H1 p; try case p; simpl in |- *; auto.
-intros H2 H3; red in |- *; intros H4; case H0.
+intros x H H0 H1 p; try case p; simpl; auto.
+intros H2 H3; red; intros H4; case H0.
 intros H5 H6; absurd (false = true); auto with bool.
 intros n0 H2 H3; apply H; auto.
-injection H1; intros H4; injection H4; auto.
+injection H1; auto.
 apply Le.le_O_n.
 apply Lt.lt_S_n; auto.
 intros; discriminate.
-intros n'; case m; simpl in |- *; auto.
+intros n'; case m; simpl; auto.
 case (index n' s1 s2'); intros; discriminate.
 intros m'; generalize (Rec n' m' s1); case (index n' s1 s2'); auto.
-intros x H H0 p; case p; simpl in |- *; auto.
+intros x H H0 p; case p; simpl; auto.
 intros H1; inversion H1; auto.
 intros n0 H1 H2; apply H; auto.
-injection H0; intros H3; injection H3; auto.
+injection H0; auto.
 apply Le.le_S_n; auto.
 apply Lt.lt_S_n; auto.
 intros; discriminate.
@@ -314,33 +312,33 @@ Theorem index_correct3 :
  index n s1 s2 = None ->
  s1 <> EmptyString -> n <= m -> substring m (length s1) s2 <> s1.
 Proof.
-intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl in |- *;
+intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl;
  auto.
-intros n; case n; simpl in |- *; auto.
-intros m s1; case s1; simpl in |- *; auto.
-case m; intros; red in |- *; intros; discriminate.
+intros n; case n; simpl; auto.
+intros m s1; case s1; simpl; auto.
+case m; intros; red; intros; discriminate.
 intros n' m; case m; auto.
-intros s1; case s1; simpl in |- *; auto.
+intros s1; case s1; simpl; auto.
 intros b s2' Rec n m s1.
-case n; simpl in |- *; auto.
+case n; simpl; auto.
 generalize (prefix_correct s1 (String b s2'));
  case (prefix s1 (String b s2')).
 intros; discriminate.
-case m; simpl in |- *; auto with bool.
-case s1; simpl in |- *; auto.
-intros a s H H0 H1 H2; red in |- *; intros H3; case H.
+case m; simpl; auto with bool.
+case s1; simpl; auto.
+intros a s H H0 H1 H2; red; intros H3; case H.
 intros H4 H5; absurd (false = true); auto with bool.
-case s1; simpl in |- *; auto.
+case s1; simpl; auto.
 intros a s n0 H H0 H1 H2;
- change (substring n0 (length (String a s)) s2' <> String a s) in |- *;
+ change (substring n0 (length (String a s)) s2' <> String a s);
  apply (Rec 0); auto.
-generalize H0; case (index 0 (String a s) s2'); simpl in |- *; auto; intros;
+generalize H0; case (index 0 (String a s) s2'); simpl; auto; intros;
  discriminate.
 apply Le.le_O_n.
-intros n'; case m; simpl in |- *; auto.
+intros n'; case m; simpl; auto.
 intros H H0 H1; inversion H1.
 intros n0 H H0 H1; apply (Rec n'); auto.
-generalize H; case (index n' s1 s2'); simpl in |- *; auto; intros;
+generalize H; case (index n' s1 s2'); simpl; auto; intros;
  discriminate.
 apply Le.le_S_n; auto.
 Qed.
@@ -355,13 +353,13 @@ Theorem index_correct4 :
  forall (n : nat) (s : string),
  index n EmptyString s = None -> length s < n.
 Proof.
-intros n s; generalize n; clear n; elim s; simpl in |- *; auto.
-intros n; case n; simpl in |- *; auto.
+intros n s; generalize n; clear n; elim s; simpl; auto.
+intros n; case n; simpl; auto.
 intros; discriminate.
 intros; apply Lt.lt_O_Sn.
-intros a s' H n; case n; simpl in |- *; auto.
+intros a s' H n; case n; simpl; auto.
 intros; discriminate.
-intros n'; generalize (H n'); case (index n' EmptyString s'); simpl in |- *;
+intros n'; generalize (H n'); case (index n' EmptyString s'); simpl;
  auto.
 intros; discriminate.
 intros H0 H1; apply Lt.lt_n_S; auto.
diff --git a/theories/Structures/DecidableType.v b/theories/Structures/DecidableType.v
index 18153436..79e81771 100644
--- a/theories/Structures/DecidableType.v
+++ b/theories/Structures/DecidableType.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: DecidableType.v 12641 2010-01-07 15:32:52Z letouzey $ *)
-
 Require Export SetoidList.
 Require Equalities.
 
diff --git a/theories/Structures/DecidableTypeEx.v b/theories/Structures/DecidableTypeEx.v
index ac1f014b..971fcd7f 100644
--- a/theories/Structures/DecidableTypeEx.v
+++ b/theories/Structures/DecidableTypeEx.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: DecidableTypeEx.v 12641 2010-01-07 15:32:52Z letouzey $ *)
-
 Require Import DecidableType OrderedType OrderedTypeEx.
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -81,9 +79,9 @@ End PairDecidableType.
 Module PairUsualDecidableType(D1 D2:UsualDecidableType) <: UsualDecidableType.
  Definition t := prod D1.t D2.t.
  Definition eq := @eq t.
- Definition eq_refl := @refl_equal t.
- Definition eq_sym := @sym_eq t.
- Definition eq_trans := @trans_eq t.
+ Definition eq_refl := @eq_refl t.
+ Definition eq_sym := @eq_sym t.
+ Definition eq_trans := @eq_trans t.
  Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }.
  Proof.
  intros (x1,x2) (y1,y2);
diff --git a/theories/Structures/Equalities.v b/theories/Structures/Equalities.v
index 382511d9..eb537385 100644
--- a/theories/Structures/Equalities.v
+++ b/theories/Structures/Equalities.v
@@ -6,23 +6,28 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: Equalities.v 13475 2010-09-29 14:33:13Z letouzey $ *)
-
 Require Export RelationClasses.
+Require Import Bool Morphisms Setoid.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
 
+(** Structure with nothing inside.
+    Used to force a module type T into a module via Nop <+ T. (HACK!) *)
+
+Module Type Nop.
+End Nop.
+
 (** * Structure with just a base type [t] *)
 
 Module Type Typ.
-  Parameter Inline t : Type.
+  Parameter Inline(10) t : Type.
 End Typ.
 
 (** * Structure with an equality relation [eq] *)
 
 Module Type HasEq (Import T:Typ).
-  Parameter Inline eq : t -> t -> Prop.
+  Parameter Inline(30) eq : t -> t -> Prop.
 End HasEq.
 
 Module Type Eq := Typ <+ HasEq.
@@ -61,10 +66,19 @@ End HasEqDec.
 (** Having [eq_dec] is the same as having a boolean equality plus
     a correctness proof. *)
 
-Module Type HasEqBool (Import E:Eq').
+Module Type HasEqb (Import T:Typ).
   Parameter Inline eqb : t -> t -> bool.
-  Parameter eqb_eq : forall x y, eqb x y = true <-> x==y.
-End HasEqBool.
+End HasEqb.
+
+Module Type EqbSpec (T:Typ)(X:HasEq T)(Y:HasEqb T).
+  Parameter eqb_eq : forall x y, Y.eqb x y = true <-> X.eq x y.
+End EqbSpec.
+
+Module Type EqbNotation (T:Typ)(E:HasEqb T).
+  Infix "=?" := E.eqb (at level 70, no associativity).
+End EqbNotation.
+
+Module Type HasEqBool (E:Eq) := HasEqb E <+ EqbSpec E E.
 
 (** From these basic blocks, we can build many combinations
     of static standalone module types. *)
@@ -102,8 +116,10 @@ Module Type EqualityTypeBoth' := EqualityTypeBoth <+ EqNotation.
 Module Type DecidableType' := DecidableType <+ EqNotation.
 Module Type DecidableTypeOrig' := DecidableTypeOrig <+ EqNotation.
 Module Type DecidableTypeBoth' := DecidableTypeBoth <+ EqNotation.
-Module Type BooleanEqualityType' := BooleanEqualityType <+ EqNotation.
-Module Type BooleanDecidableType' := BooleanDecidableType <+ EqNotation.
+Module Type BooleanEqualityType' :=
+ BooleanEqualityType <+ EqNotation <+ EqbNotation.
+Module Type BooleanDecidableType' :=
+ BooleanDecidableType <+ EqNotation <+ EqbNotation.
 Module Type DecidableTypeFull' := DecidableTypeFull <+ EqNotation.
 
 (** * Compatibility wrapper from/to the old version of
@@ -162,6 +178,49 @@ Module Bool2Dec (E:BooleanEqualityType) <: BooleanDecidableType
  := E <+ HasEqBool2Dec.
 
 
+(** Some properties of boolean equality *)
+
+Module BoolEqualityFacts (Import E : BooleanEqualityType').
+
+(** [eqb] is compatible with [eq] *)
+
+Instance eqb_compat : Proper (E.eq ==> E.eq ==> Logic.eq) eqb.
+Proof.
+intros x x' Exx' y y' Eyy'.
+apply eq_true_iff_eq.
+now rewrite 2 eqb_eq, Exx', Eyy'.
+Qed.
+
+(** Alternative specification of [eqb] based on [reflect]. *)
+
+Lemma eqb_spec x y : reflect (x==y) (x =? y).
+Proof.
+apply iff_reflect. symmetry. apply eqb_eq.
+Defined.
+
+(** Negated form of [eqb_eq] *)
+
+Lemma eqb_neq x y : (x =? y) = false <-> x ~= y.
+Proof.
+now rewrite <- not_true_iff_false, eqb_eq.
+Qed.
+
+(** Basic equality laws for [eqb] *)
+
+Lemma eqb_refl x : (x =? x) = true.
+Proof.
+now apply eqb_eq.
+Qed.
+
+Lemma eqb_sym x y : (x =? y) = (y =? x).
+Proof.
+apply eq_true_iff_eq. now rewrite 2 eqb_eq.
+Qed.
+
+(** Transitivity is a particular case of [eqb_compat] *)
+
+End BoolEqualityFacts.
+
 
 (** * UsualDecidableType
 
diff --git a/theories/Structures/EqualitiesFacts.v b/theories/Structures/EqualitiesFacts.v
index d9b1d76f..c69885b4 100644
--- a/theories/Structures/EqualitiesFacts.v
+++ b/theories/Structures/EqualitiesFacts.v
@@ -8,21 +8,8 @@
 
 Require Import Equalities Bool SetoidList RelationPairs.
 
-(** In a BooleanEqualityType, [eqb] is compatible with [eq] *)
-
-Module BoolEqualityFacts (Import E : BooleanEqualityType).
-
-Instance eqb_compat : Proper (E.eq ==> E.eq ==> Logic.eq) eqb.
-Proof.
-intros x x' Exx' y y' Eyy'.
-apply eq_true_iff_eq.
-rewrite 2 eqb_eq, Exx', Eyy'; auto with *.
-Qed.
-
-End BoolEqualityFacts.
-
-
 (** * Keys and datas used in FMap *)
+
 Module KeyDecidableType(Import D:DecidableType).
 
  Section Elt.
@@ -42,9 +29,9 @@ Module KeyDecidableType(Import D:DecidableType).
 
   (* eqk, eqke are equalities, ltk is a strict order *)
 
-  Global Instance eqk_equiv : Equivalence eqk.
+  Global Instance eqk_equiv : Equivalence eqk := _.
 
-  Global Instance eqke_equiv : Equivalence eqke.
+  Global Instance eqke_equiv : Equivalence eqke := _.
 
   (* Additionnal facts *)
 
@@ -156,7 +143,7 @@ Module PairDecidableType(D1 D2:DecidableType) <: DecidableType.
 
  Definition eq := (D1.eq * D2.eq)%signature.
 
- Instance eq_equiv : Equivalence eq.
+ Instance eq_equiv : Equivalence eq := _.
 
  Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }.
  Proof.
@@ -172,7 +159,7 @@ End PairDecidableType.
 Module PairUsualDecidableType(D1 D2:UsualDecidableType) <: UsualDecidableType.
  Definition t := (D1.t * D2.t)%type.
  Definition eq := @eq t.
- Program Instance eq_equiv : Equivalence eq.
+ Instance eq_equiv : Equivalence eq := _.
  Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }.
  Proof.
  intros (x1,x2) (y1,y2);
diff --git a/theories/Structures/GenericMinMax.v b/theories/Structures/GenericMinMax.v
index 68f20189..ffd0649a 100644
--- a/theories/Structures/GenericMinMax.v
+++ b/theories/Structures/GenericMinMax.v
@@ -40,34 +40,34 @@ Module GenericMinMax (Import O:OrderedTypeFull') <: HasMinMax O.
  Definition max := gmax O.compare.
  Definition min := gmin O.compare.
 
- Lemma ge_not_lt : forall x y, y<=x -> x<y -> False.
+ Lemma ge_not_lt x y : y<=x -> x<y -> False.
  Proof.
- intros x y H H'.
+ intros H H'.
  apply (StrictOrder_Irreflexive x).
  rewrite le_lteq in *; destruct H as [H|H].
  transitivity y; auto.
  rewrite H in H'; auto.
  Qed.
 
- Lemma max_l : forall x y, y<=x -> max x y == x.
+ Lemma max_l x y : y<=x -> max x y == x.
  Proof.
  intros. unfold max, gmax. case compare_spec; auto with relations.
  intros; elim (ge_not_lt x y); auto.
  Qed.
 
- Lemma max_r : forall x y, x<=y -> max x y == y.
+ Lemma max_r x y : x<=y -> max x y == y.
  Proof.
  intros. unfold max, gmax. case compare_spec; auto with relations.
  intros; elim (ge_not_lt y x); auto.
  Qed.
 
- Lemma min_l : forall x y, x<=y -> min x y == x.
+ Lemma min_l x y : x<=y -> min x y == x.
  Proof.
  intros. unfold min, gmin. case compare_spec; auto with relations.
  intros; elim (ge_not_lt y x); auto.
  Qed.
 
- Lemma min_r : forall x y, y<=x -> min x y == y.
+ Lemma min_r x y : y<=x -> min x y == y.
  Proof.
  intros. unfold min, gmin. case compare_spec; auto with relations.
  intros; elim (ge_not_lt x y); auto.
@@ -76,31 +76,30 @@ Module GenericMinMax (Import O:OrderedTypeFull') <: HasMinMax O.
 End GenericMinMax.
 
 
-(** ** Consequences of the minimalist interface: facts about [max]. *)
+(** ** Consequences of the minimalist interface: facts about [max] and [min]. *)
 
-Module MaxLogicalProperties (Import O:TotalOrder')(Import M:HasMax O).
- Module Import T := !MakeOrderTac O.
+Module MinMaxLogicalProperties (Import O:TotalOrder')(Import M:HasMinMax O).
+ Module Import Private_Tac := !MakeOrderTac O O.
 
 (** An alternative caracterisation of [max], equivalent to
     [max_l /\ max_r] *)
 
-Lemma max_spec : forall n m,
-  (n < m /\ max n m == m)  \/ (m <= n /\ max n m == n).
+Lemma max_spec n m :
+  (n < m /\ max n m == m) \/ (m <= n /\ max n m == n).
 Proof.
- intros n m.
  destruct (lt_total n m); [left|right].
- split; auto. apply max_r. rewrite le_lteq; auto.
- assert (m <= n) by (rewrite le_lteq; intuition).
- split; auto. apply max_l; auto.
+ - split; auto. apply max_r. rewrite le_lteq; auto.
+ - assert (m <= n) by (rewrite le_lteq; intuition).
+   split; auto. now apply max_l.
 Qed.
 
 (** A more symmetric version of [max_spec], based only on [le].
     Beware that left and right alternatives overlap. *)
 
-Lemma max_spec_le : forall n m,
+Lemma max_spec_le n m :
  (n <= m /\ max n m == m) \/ (m <= n /\ max n m == n).
 Proof.
- intros. destruct (max_spec n m); [left|right]; intuition; order.
+ destruct (max_spec n m); [left|right]; intuition; order.
 Qed.
 
 Instance : Proper (eq==>eq==>iff) le.
@@ -108,25 +107,24 @@ Proof. repeat red. intuition order. Qed.
 
 Instance max_compat : Proper (eq==>eq==>eq) max.
 Proof.
-intros x x' Hx y y' Hy.
-assert (H1 := max_spec x y). assert (H2 := max_spec x' y').
-set (m := max x y) in *; set (m' := max x' y') in *; clearbody m m'.
-rewrite <- Hx, <- Hy in *.
-destruct (lt_total x y); intuition order.
+ intros x x' Hx y y' Hy.
+ assert (H1 := max_spec x y). assert (H2 := max_spec x' y').
+ set (m := max x y) in *; set (m' := max x' y') in *; clearbody m m'.
+ rewrite <- Hx, <- Hy in *.
+ destruct (lt_total x y); intuition order.
 Qed.
 
-
 (** A function satisfying the same specification is equal to [max]. *)
 
-Lemma max_unicity : forall n m p,
- ((n < m /\ p == m)  \/ (m <= n /\ p == n)) ->  p == max n m.
+Lemma max_unicity n m p :
+ ((n < m /\ p == m) \/ (m <= n /\ p == n)) -> p == max n m.
 Proof.
- intros. assert (Hm := max_spec n m).
+ assert (Hm := max_spec n m).
  destruct (lt_total n m); intuition; order.
 Qed.
 
-Lemma max_unicity_ext : forall f,
- (forall n m, (n < m /\ f n m == m)  \/ (m <= n /\ f n m == n)) ->
+Lemma max_unicity_ext f :
+ (forall n m, (n < m /\ f n m == m) \/ (m <= n /\ f n m == n)) ->
  (forall n m, f n m == max n m).
 Proof.
  intros. apply max_unicity; auto.
@@ -134,12 +132,12 @@ Qed.
 
 (** [max] commutes with monotone functions. *)
 
-Lemma max_mono: forall f,
+Lemma max_mono f :
  (Proper (eq ==> eq) f) ->
  (Proper (le ==> le) f) ->
  forall x y, max (f x) (f y) == f (max x y).
 Proof.
- intros f Eqf Lef x y.
+ intros Eqf Lef x y.
  destruct (max_spec x y) as [(H,E)|(H,E)]; rewrite E;
   destruct (max_spec (f x) (f y)) as [(H',E')|(H',E')]; auto.
  assert (f x <= f y) by (apply Lef; order). order.
@@ -148,237 +146,232 @@ Qed.
 
 (** *** Semi-lattice algebraic properties of [max] *)
 
-Lemma max_id : forall n, max n n == n.
+Lemma max_id n : max n n == n.
 Proof.
- intros. destruct (max_spec n n); intuition.
+ apply max_l; order.
 Qed.
 
 Notation max_idempotent := max_id (only parsing).
 
-Lemma max_assoc : forall m n p, max m (max n p) == max (max m n) p.
+Lemma max_assoc m n p : max m (max n p) == max (max m n) p.
 Proof.
- intros.
- destruct (max_spec n p) as [(H,Eq)|(H,Eq)]; rewrite Eq.
- destruct (max_spec m n) as [(H',Eq')|(H',Eq')]; rewrite Eq'.
- destruct (max_spec m p); intuition; order. order.
- destruct (max_spec m n) as [(H',Eq')|(H',Eq')]; rewrite Eq'. order.
- destruct (max_spec m p); intuition; order.
+ destruct (max_spec n p) as [(H,E)|(H,E)]; rewrite E;
+ destruct (max_spec m n) as [(H',E')|(H',E')]; rewrite E', ?E; try easy.
+ - apply max_r; order.
+ - symmetry. apply max_l; order.
 Qed.
 
-Lemma max_comm : forall n m, max n m == max m n.
+Lemma max_comm n m : max n m == max m n.
 Proof.
- intros.
- destruct (max_spec n m) as [(H,Eq)|(H,Eq)]; rewrite Eq.
- destruct (max_spec m n) as [(H',Eq')|(H',Eq')]; rewrite Eq'; order.
- destruct (max_spec m n) as [(H',Eq')|(H',Eq')]; rewrite Eq'; order.
+ destruct (max_spec m n) as [(H,E)|(H,E)]; rewrite E;
+  (apply max_r || apply max_l); order.
 Qed.
 
+Ltac solve_max :=
+ match goal with |- context [max ?n ?m] =>
+  destruct (max_spec n m); intuition; order
+ end.
+
 (** *** Least-upper bound properties of [max] *)
 
-Lemma le_max_l : forall n m, n <= max n m.
-Proof.
- intros; destruct (max_spec n m); intuition; order.
-Qed.
+Lemma le_max_l n m : n <= max n m.
+Proof. solve_max. Qed.
 
-Lemma le_max_r : forall n m, m <= max n m.
-Proof.
- intros; destruct (max_spec n m); intuition; order.
-Qed.
+Lemma le_max_r n m : m <= max n m.
+Proof. solve_max. Qed.
 
-Lemma max_l_iff : forall n m, max n m == n <-> m <= n.
-Proof.
- split. intro H; rewrite <- H. apply le_max_r. apply max_l.
-Qed.
+Lemma max_l_iff n m : max n m == n <-> m <= n.
+Proof. solve_max. Qed.
 
-Lemma max_r_iff : forall n m, max n m == m <-> n <= m.
-Proof.
- split. intro H; rewrite <- H. apply le_max_l. apply max_r.
-Qed.
+Lemma max_r_iff n m : max n m == m <-> n <= m.
+Proof. solve_max. Qed.
 
-Lemma max_le : forall n m p, p <= max n m -> p <= n \/ p <= m.
+Lemma max_le n m p : p <= max n m -> p <= n \/ p <= m.
 Proof.
- intros n m p H; destruct (max_spec n m);
-  [right|left]; intuition; order.
+ destruct (max_spec n m); [right|left]; intuition; order.
 Qed.
 
-Lemma max_le_iff : forall n m p, p <= max n m <-> p <= n \/ p <= m.
-Proof.
- intros. split. apply max_le.
- destruct (max_spec n m); intuition; order.
-Qed.
+Lemma max_le_iff n m p : p <= max n m <-> p <= n \/ p <= m.
+Proof. split. apply max_le. solve_max. Qed.
 
-Lemma max_lt_iff : forall n m p, p < max n m <-> p < n \/ p < m.
+Lemma max_lt_iff n m p : p < max n m <-> p < n \/ p < m.
 Proof.
- intros. destruct (max_spec n m); intuition;
+ destruct (max_spec n m); intuition;
   order || (right; order) || (left; order).
 Qed.
 
-Lemma max_lub_l : forall n m p, max n m <= p -> n <= p.
-Proof.
- intros; destruct (max_spec n m); intuition; order.
-Qed.
+Lemma max_lub_l n m p : max n m <= p -> n <= p.
+Proof. solve_max. Qed.
 
-Lemma max_lub_r : forall n m p, max n m <= p -> m <= p.
-Proof.
- intros; destruct (max_spec n m); intuition; order.
-Qed.
+Lemma max_lub_r n m p : max n m <= p -> m <= p.
+Proof. solve_max. Qed.
 
-Lemma max_lub : forall n m p, n <= p -> m <= p -> max n m <= p.
-Proof.
- intros; destruct (max_spec n m); intuition; order.
-Qed.
+Lemma max_lub n m p : n <= p -> m <= p -> max n m <= p.
+Proof. solve_max. Qed.
 
-Lemma max_lub_iff : forall n m p, max n m <= p <-> n <= p /\ m <= p.
-Proof.
- intros; destruct (max_spec n m); intuition; order.
-Qed.
+Lemma max_lub_iff n m p : max n m <= p <-> n <= p /\ m <= p.
+Proof. solve_max. Qed.
 
-Lemma max_lub_lt : forall n m p, n < p -> m < p -> max n m < p.
-Proof.
- intros; destruct (max_spec n m); intuition; order.
-Qed.
+Lemma max_lub_lt n m p : n < p -> m < p -> max n m < p.
+Proof. solve_max. Qed.
 
-Lemma max_lub_lt_iff : forall n m p, max n m < p <-> n < p /\ m < p.
-Proof.
- intros; destruct (max_spec n m); intuition; order.
-Qed.
+Lemma max_lub_lt_iff n m p : max n m < p <-> n < p /\ m < p.
+Proof. solve_max. Qed.
 
-Lemma max_le_compat_l : forall n m p, n <= m -> max p n <= max p m.
-Proof.
- intros.
- destruct (max_spec p n) as [(LT,E)|(LE,E)]; rewrite E.
- assert (LE' := le_max_r p m). order.
- apply le_max_l.
-Qed.
+Lemma max_le_compat_l n m p : n <= m -> max p n <= max p m.
+Proof. intros. apply max_lub_iff. solve_max. Qed.
 
-Lemma max_le_compat_r : forall n m p, n <= m -> max n p <= max m p.
-Proof.
- intros. rewrite (max_comm n p), (max_comm m p).
- auto using max_le_compat_l.
-Qed.
+Lemma max_le_compat_r n m p : n <= m -> max n p <= max m p.
+Proof. intros. apply max_lub_iff. solve_max. Qed.
 
-Lemma max_le_compat : forall n m p q, n <= m -> p <= q ->
- max n p <= max m q.
+Lemma max_le_compat n m p q : n <= m -> p <= q -> max n p <= max m q.
 Proof.
- intros  n m p q Hnm Hpq.
+ intros Hnm Hpq.
  assert (LE := max_le_compat_l _ _ m Hpq).
  assert (LE' := max_le_compat_r _ _ p Hnm).
  order.
 Qed.
 
-End MaxLogicalProperties.
-
-
-(** ** Properties concernant [min], then both [min] and [max].
+(** Properties of [min] *)
 
-   To avoid too much code duplication, we exploit that [min] can be
-   seen as a [max] of the reversed order.
-*)
-
-Module MinMaxLogicalProperties (Import O:TotalOrder')(Import M:HasMinMax O).
- Include MaxLogicalProperties O M.
- Import T.
+Lemma min_spec n m :
+ (n < m /\ min n m == n) \/ (m <= n /\ min n m == m).
+Proof.
+ destruct (lt_total n m); [left|right].
+ - split; auto. apply min_l. rewrite le_lteq; auto.
+ - assert (m <= n) by (rewrite le_lteq; intuition).
+   split; auto. now apply min_r.
+Qed.
 
- Module ORev := TotalOrderRev O.
- Module MRev <: HasMax ORev.
-  Definition max x y := M.min y x.
-  Definition max_l x y := M.min_r y x.
-  Definition max_r x y := M.min_l y x.
- End MRev.
- Module MPRev := MaxLogicalProperties ORev MRev.
+Lemma min_spec_le n m :
+ (n <= m /\ min n m == n) \/ (m <= n /\ min n m == m).
+Proof.
+ destruct (min_spec n m); [left|right]; intuition; order.
+Qed.
 
 Instance min_compat : Proper (eq==>eq==>eq) min.
-Proof. intros x x' Hx y y' Hy. apply MPRev.max_compat; assumption. Qed.
+Proof.
+intros x x' Hx y y' Hy.
+assert (H1 := min_spec x y). assert (H2 := min_spec x' y').
+set (m := min x y) in *; set (m' := min x' y') in *; clearbody m m'.
+rewrite <- Hx, <- Hy in *.
+destruct (lt_total x y); intuition order.
+Qed.
 
-Lemma min_spec : forall n m,
- (n < m /\ min n m == n) \/ (m <= n /\ min n m == m).
-Proof. intros. exact (MPRev.max_spec m n). Qed.
+Lemma min_unicity n m p :
+ ((n < m /\ p == n) \/ (m <= n /\ p == m)) ->  p == min n m.
+Proof.
+ assert (Hm := min_spec n m).
+ destruct (lt_total n m); intuition; order.
+Qed.
 
-Lemma min_spec_le : forall n m,
- (n <= m /\ min n m == n) \/ (m <= n /\ min n m == m).
-Proof. intros. exact (MPRev.max_spec_le m n). Qed.
+Lemma min_unicity_ext f :
+ (forall n m, (n < m /\ f n m == n)  \/ (m <= n /\ f n m == m)) ->
+ (forall n m, f n m == min n m).
+Proof.
+ intros. apply min_unicity; auto.
+Qed.
 
-Lemma min_mono: forall f,
+Lemma min_mono f :
  (Proper (eq ==> eq) f) ->
  (Proper (le ==> le) f) ->
  forall x y, min (f x) (f y) == f (min x y).
 Proof.
- intros. apply MPRev.max_mono; auto. compute in *; eauto.
+ intros Eqf Lef x y.
+ destruct (min_spec x y) as [(H,E)|(H,E)]; rewrite E;
+  destruct (min_spec (f x) (f y)) as [(H',E')|(H',E')]; auto.
+ assert (f x <= f y) by (apply Lef; order). order.
+ assert (f y <= f x) by (apply Lef; order). order.
 Qed.
 
-Lemma min_unicity : forall n m p,
- ((n < m /\ p == n)  \/ (m <= n /\ p == m)) ->  p == min n m.
-Proof. intros n m p. apply MPRev.max_unicity. Qed.
-
-Lemma min_unicity_ext : forall f,
- (forall n m, (n < m /\ f n m == n)  \/ (m <= n /\ f n m == m)) ->
- (forall n m, f n m == min n m).
-Proof. intros f H n m. apply MPRev.max_unicity, H; auto. Qed.
-
-Lemma min_id : forall n, min n n == n.
-Proof. intros. exact (MPRev.max_id n). Qed.
+Lemma min_id n : min n n == n.
+Proof.
+ apply min_l; order.
+Qed.
 
 Notation min_idempotent := min_id (only parsing).
 
-Lemma min_assoc : forall m n p, min m (min n p) == min (min m n) p.
-Proof. intros. symmetry; apply MPRev.max_assoc. Qed.
+Lemma min_assoc m n p : min m (min n p) == min (min m n) p.
+Proof.
+ destruct (min_spec n p) as [(H,E)|(H,E)]; rewrite E;
+ destruct (min_spec m n) as [(H',E')|(H',E')]; rewrite E', ?E; try easy.
+ - symmetry. apply min_l; order.
+ - apply min_r; order.
+Qed.
 
-Lemma min_comm : forall n m, min n m == min m n.
-Proof. intros. exact (MPRev.max_comm m n). Qed.
+Lemma min_comm n m : min n m == min m n.
+Proof.
+ destruct (min_spec m n) as [(H,E)|(H,E)]; rewrite E;
+  (apply min_r || apply min_l); order.
+Qed.
 
-Lemma le_min_r : forall n m, min n m <= m.
-Proof. intros. exact (MPRev.le_max_l m n). Qed.
+Ltac solve_min :=
+ match goal with |- context [min ?n ?m] =>
+  destruct (min_spec n m); intuition; order
+ end.
 
-Lemma le_min_l : forall n m, min n m <= n.
-Proof. intros. exact (MPRev.le_max_r m n). Qed.
+Lemma le_min_r n m : min n m <= m.
+Proof. solve_min. Qed.
 
-Lemma min_l_iff : forall n m, min n m == n <-> n <= m.
-Proof. intros n m. exact (MPRev.max_r_iff m n). Qed.
+Lemma le_min_l n m : min n m <= n.
+Proof. solve_min. Qed.
 
-Lemma min_r_iff : forall n m, min n m == m <-> m <= n.
-Proof. intros n m. exact (MPRev.max_l_iff m n). Qed.
+Lemma min_l_iff n m : min n m == n <-> n <= m.
+Proof. solve_min. Qed.
 
-Lemma min_le : forall n m p, min n m <= p -> n <= p \/ m <= p.
-Proof. intros n m p H. destruct (MPRev.max_le _ _ _ H); auto. Qed.
+Lemma min_r_iff n m : min n m == m <-> m <= n.
+Proof. solve_min. Qed.
 
-Lemma min_le_iff : forall n m p, min n m <= p <-> n <= p \/ m <= p.
-Proof. intros n m p. rewrite (MPRev.max_le_iff m n p); intuition. Qed.
+Lemma min_le n m p : min n m <= p -> n <= p \/ m <= p.
+Proof.
+ destruct (min_spec n m); [left|right]; intuition; order.
+Qed.
+
+Lemma min_le_iff n m p : min n m <= p <-> n <= p \/ m <= p.
+Proof. split. apply min_le. solve_min. Qed.
 
-Lemma min_lt_iff : forall n m p, min n m < p <-> n < p \/ m < p.
-Proof. intros n m p. rewrite (MPRev.max_lt_iff m n p); intuition. Qed.
+Lemma min_lt_iff n m p : min n m < p <-> n < p \/ m < p.
+Proof.
+ destruct (min_spec n m); intuition;
+  order || (right; order) || (left; order).
+Qed.
 
-Lemma min_glb_l : forall n m p, p <= min n m -> p <= n.
-Proof. intros n m. exact (MPRev.max_lub_r m n). Qed.
+Lemma min_glb_l n m p : p <= min n m -> p <= n.
+Proof. solve_min. Qed.
 
-Lemma min_glb_r : forall n m p, p <= min n m -> p <= m.
-Proof. intros n m. exact (MPRev.max_lub_l m n). Qed.
+Lemma min_glb_r n m p : p <= min n m -> p <= m.
+Proof. solve_min. Qed.
 
-Lemma min_glb : forall n m p, p <= n -> p <= m -> p <= min n m.
-Proof. intros. apply MPRev.max_lub; auto. Qed.
+Lemma min_glb n m p : p <= n -> p <= m -> p <= min n m.
+Proof. solve_min. Qed.
 
-Lemma min_glb_iff : forall n m p, p <= min n m <-> p <= n /\ p <= m.
-Proof. intros. rewrite (MPRev.max_lub_iff m n p); intuition. Qed.
+Lemma min_glb_iff n m p : p <= min n m <-> p <= n /\ p <= m.
+Proof. solve_min. Qed.
 
-Lemma min_glb_lt : forall n m p, p < n -> p < m -> p < min n m.
-Proof. intros. apply MPRev.max_lub_lt; auto. Qed.
+Lemma min_glb_lt n m p : p < n -> p < m -> p < min n m.
+Proof. solve_min. Qed.
 
-Lemma min_glb_lt_iff : forall n m p, p < min n m <-> p < n /\ p < m.
-Proof. intros. rewrite (MPRev.max_lub_lt_iff m n p); intuition. Qed.
+Lemma min_glb_lt_iff n m p : p < min n m <-> p < n /\ p < m.
+Proof. solve_min. Qed.
 
-Lemma min_le_compat_l : forall n m p, n <= m -> min p n <= min p m.
-Proof. intros n m. exact (MPRev.max_le_compat_r m n). Qed.
+Lemma min_le_compat_l n m p : n <= m -> min p n <= min p m.
+Proof. intros. apply min_glb_iff. solve_min. Qed.
 
-Lemma min_le_compat_r : forall n m p, n <= m -> min n p <= min m p.
-Proof. intros n m. exact (MPRev.max_le_compat_l m n). Qed.
+Lemma min_le_compat_r n m p : n <= m -> min n p <= min m p.
+Proof. intros. apply min_glb_iff. solve_min. Qed.
 
-Lemma min_le_compat : forall n m p q, n <= m -> p <= q ->
+Lemma min_le_compat n m p q : n <= m -> p <= q ->
  min n p <= min m q.
-Proof. intros. apply MPRev.max_le_compat; auto. Qed.
-
+Proof.
+ intros Hnm Hpq.
+ assert (LE := min_le_compat_l _ _ m Hpq).
+ assert (LE' := min_le_compat_r _ _ p Hnm).
+ order.
+Qed.
 
 (** *** Combined properties of min and max *)
 
-Lemma min_max_absorption : forall n m, max n (min n m) == n.
+Lemma min_max_absorption n m : max n (min n m) == n.
 Proof.
  intros.
  destruct (min_spec n m) as [(C,E)|(C,E)]; rewrite E.
@@ -386,7 +379,7 @@ Proof.
  destruct (max_spec n m); intuition; order.
 Qed.
 
-Lemma max_min_absorption : forall n m, min n (max n m) == n.
+Lemma max_min_absorption n m : min n (max n m) == n.
 Proof.
  intros.
  destruct (max_spec n m) as [(C,E)|(C,E)]; rewrite E.
@@ -396,35 +389,35 @@ Qed.
 
 (** Distributivity *)
 
-Lemma max_min_distr : forall n m p,
+Lemma max_min_distr n m p :
  max n (min m p) == min (max n m) (max n p).
 Proof.
- intros. symmetry. apply min_mono.
+ symmetry. apply min_mono.
  eauto with *.
  repeat red; intros. apply max_le_compat_l; auto.
 Qed.
 
-Lemma min_max_distr : forall n m p,
+Lemma min_max_distr n m p :
  min n (max m p) == max (min n m) (min n p).
 Proof.
- intros. symmetry. apply max_mono.
+ symmetry. apply max_mono.
  eauto with *.
  repeat red; intros. apply min_le_compat_l; auto.
 Qed.
 
 (** Modularity *)
 
-Lemma max_min_modular : forall n m p,
+Lemma max_min_modular n m p :
  max n (min m (max n p)) == min (max n m) (max n p).
 Proof.
- intros. rewrite <- max_min_distr.
+ rewrite <- max_min_distr.
  destruct (max_spec n p) as [(C,E)|(C,E)]; rewrite E; auto with *.
  destruct (min_spec m n) as [(C',E')|(C',E')]; rewrite E'.
  rewrite 2 max_l; try order. rewrite min_le_iff; auto.
  rewrite 2 max_l; try order. rewrite min_le_iff; auto.
 Qed.
 
-Lemma min_max_modular : forall n m p,
+Lemma min_max_modular n m p :
  min n (max m (min n p)) == max (min n m) (min n p).
 Proof.
  intros. rewrite <- min_max_distr.
@@ -436,7 +429,7 @@ Qed.
 
 (** Disassociativity *)
 
-Lemma max_min_disassoc : forall n m p,
+Lemma max_min_disassoc n m p :
  min n (max m p) <= max (min n m) p.
 Proof.
  intros. rewrite min_max_distr.
@@ -445,24 +438,24 @@ Qed.
 
 (** Anti-monotonicity swaps the role of [min] and [max] *)
 
-Lemma max_min_antimono : forall f,
+Lemma max_min_antimono f :
  Proper (eq==>eq) f ->
  Proper (le==>inverse le) f ->
  forall x y, max (f x) (f y) == f (min x y).
 Proof.
- intros f Eqf Lef x y.
+ intros Eqf Lef x y.
  destruct (min_spec x y) as [(H,E)|(H,E)]; rewrite E;
   destruct (max_spec (f x) (f y)) as [(H',E')|(H',E')]; auto.
  assert (f y <= f x) by (apply Lef; order). order.
  assert (f x <= f y) by (apply Lef; order). order.
 Qed.
 
-Lemma min_max_antimono : forall f,
+Lemma min_max_antimono f :
  Proper (eq==>eq) f ->
  Proper (le==>inverse le) f ->
  forall x y, min (f x) (f y) == f (max x y).
 Proof.
- intros f Eqf Lef x y.
+ intros Eqf Lef x y.
  destruct (max_spec x y) as [(H,E)|(H,E)]; rewrite E;
   destruct (min_spec (f x) (f y)) as [(H',E')|(H',E')]; auto.
  assert (f y <= f x) by (apply Lef; order). order.
@@ -478,11 +471,11 @@ Module MinMaxDecProperties (Import O:OrderedTypeFull')(Import M:HasMinMax O).
 
 (** Induction principles for [max]. *)
 
-Lemma max_case_strong : forall n m (P:t -> Type),
+Lemma max_case_strong n m (P:t -> Type) :
   (forall x y, x==y -> P x -> P y) ->
   (m<=n -> P n) -> (n<=m -> P m) -> P (max n m).
 Proof.
-intros n m P Compat Hl Hr.
+intros Compat Hl Hr.
 destruct (CompSpec2Type (compare_spec n m)) as [EQ|LT|GT].
 assert (n<=m) by (rewrite le_lteq; auto).
 apply (Compat m), Hr; auto. symmetry; apply max_r; auto.
@@ -492,26 +485,26 @@ assert (m<=n) by (rewrite le_lteq; auto).
 apply (Compat n), Hl; auto. symmetry; apply max_l; auto.
 Defined.
 
-Lemma max_case : forall n m (P:t -> Type),
+Lemma max_case n m (P:t -> Type) :
   (forall x y, x == y -> P x -> P y) ->
   P n -> P m -> P (max n m).
 Proof. intros. apply max_case_strong; auto. Defined.
 
 (** [max] returns one of its arguments. *)
 
-Lemma max_dec : forall n m, {max n m == n} + {max n m == m}.
+Lemma max_dec n m : {max n m == n} + {max n m == m}.
 Proof.
- intros n m. apply max_case; auto with relations.
+ apply max_case; auto with relations.
  intros x y H [E|E]; [left|right]; rewrite <-H; auto.
 Defined.
 
 (** Idem for [min] *)
 
-Lemma min_case_strong : forall n m (P:O.t -> Type),
+Lemma min_case_strong n m (P:O.t -> Type) :
  (forall x y, x == y -> P x -> P y) ->
  (n<=m -> P n) -> (m<=n -> P m) -> P (min n m).
 Proof.
-intros n m P Compat Hl Hr.
+intros Compat Hl Hr.
 destruct (CompSpec2Type (compare_spec n m)) as [EQ|LT|GT].
 assert (n<=m) by (rewrite le_lteq; auto).
 apply (Compat n), Hl; auto. symmetry; apply min_l; auto.
@@ -521,12 +514,12 @@ assert (m<=n) by (rewrite le_lteq; auto).
 apply (Compat m), Hr; auto. symmetry; apply min_r; auto.
 Defined.
 
-Lemma min_case : forall n m (P:O.t -> Type),
+Lemma min_case n m (P:O.t -> Type) :
   (forall x y, x == y -> P x -> P y) ->
   P n -> P m -> P (min n m).
 Proof. intros. apply min_case_strong; auto. Defined.
 
-Lemma min_dec : forall n m, {min n m == n} + {min n m == m}.
+Lemma min_dec n m : {min n m == n} + {min n m == m}.
 Proof.
  intros. apply min_case; auto with relations.
  intros x y H [E|E]; [left|right]; rewrite <- E; auto with relations.
@@ -556,19 +549,19 @@ Module UsualMinMaxLogicalProperties
 
  Include MinMaxLogicalProperties O M.
 
- Lemma max_monotone : forall f, Proper (le ==> le) f ->
+ Lemma max_monotone f : Proper (le ==> le) f ->
   forall x y, max (f x) (f y) = f (max x y).
  Proof. intros; apply max_mono; auto. congruence. Qed.
 
- Lemma min_monotone : forall f, Proper (le ==> le) f ->
+ Lemma min_monotone f : Proper (le ==> le) f ->
   forall x y, min (f x) (f y) = f (min x y).
  Proof. intros; apply min_mono; auto. congruence. Qed.
 
- Lemma min_max_antimonotone : forall f, Proper (le ==> inverse le) f ->
+ Lemma min_max_antimonotone f : Proper (le ==> inverse le) f ->
   forall x y, min (f x) (f y) = f (max x y).
  Proof. intros; apply min_max_antimono; auto. congruence. Qed.
 
- Lemma max_min_antimonotone : forall f, Proper (le ==> inverse le) f ->
+ Lemma max_min_antimonotone f : Proper (le ==> inverse le) f ->
   forall x y, max (f x) (f y) = f (min x y).
  Proof. intros; apply max_min_antimono; auto. congruence. Qed.
 
@@ -578,29 +571,29 @@ End UsualMinMaxLogicalProperties.
 Module UsualMinMaxDecProperties
  (Import O:UsualOrderedTypeFull')(Import M:HasMinMax O).
 
- Module P := MinMaxDecProperties O M.
+ Module Import Private_Dec := MinMaxDecProperties O M.
 
  Lemma max_case_strong : forall n m (P:t -> Type),
   (m<=n -> P n) -> (n<=m -> P m) -> P (max n m).
- Proof. intros; apply P.max_case_strong; auto. congruence. Defined.
+ Proof. intros; apply max_case_strong; auto. congruence. Defined.
 
  Lemma max_case : forall n m (P:t -> Type),
   P n -> P m -> P (max n m).
  Proof. intros; apply max_case_strong; auto. Defined.
 
  Lemma max_dec : forall n m, {max n m = n} + {max n m = m}.
- Proof. exact P.max_dec. Defined.
+ Proof. exact max_dec. Defined.
 
  Lemma min_case_strong : forall n m (P:O.t -> Type),
   (n<=m -> P n) -> (m<=n -> P m) -> P (min n m).
- Proof. intros; apply P.min_case_strong; auto. congruence. Defined.
+ Proof. intros; apply min_case_strong; auto. congruence. Defined.
 
  Lemma min_case : forall n m (P:O.t -> Type),
   P n -> P m -> P (min n m).
  Proof. intros. apply min_case_strong; auto. Defined.
 
  Lemma min_dec : forall n m, {min n m = n} + {min n m = m}.
- Proof. exact P.min_dec. Defined.
+ Proof. exact min_dec. Defined.
 
 End UsualMinMaxDecProperties.
 
diff --git a/theories/Structures/OrderedType.v b/theories/Structures/OrderedType.v
index 57f491d2..75578195 100644
--- a/theories/Structures/OrderedType.v
+++ b/theories/Structures/OrderedType.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: OrderedType.v 12732 2010-02-10 22:46:59Z letouzey $ *)
-
 Require Export SetoidList Morphisms OrdersTac.
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -22,6 +20,10 @@ Inductive Compare (X : Type) (lt eq : X -> X -> Prop) (x y : X) : Type :=
   | EQ : eq x y -> Compare lt eq x y
   | GT : lt y x -> Compare lt eq x y.
 
+Arguments LT [X lt eq x y] _.
+Arguments EQ [X lt eq x y] _.
+Arguments GT [X lt eq x y] _.
+
 Module Type MiniOrderedType.
 
   Parameter Inline t : Type.
@@ -106,19 +108,21 @@ Module OrderedTypeFacts (Import O: OrderedType).
   Lemma lt_total : forall x y, lt x y \/ eq x y \/ lt y x.
   Proof. intros; destruct (compare x y); auto. Qed.
 
-  Module OrderElts <: Orders.TotalOrder.
-  Definition t := t.
-  Definition eq := eq.
-  Definition lt := lt.
-  Definition le x y := lt x y \/ eq x y.
-  Definition eq_equiv := eq_equiv.
-  Definition lt_strorder := lt_strorder.
-  Definition lt_compat := lt_compat.
-  Definition lt_total := lt_total.
-  Lemma le_lteq : forall x y, le x y <-> lt x y \/ eq x y.
-  Proof. unfold le; intuition. Qed.
-  End OrderElts.
-  Module OrderTac := !MakeOrderTac OrderElts.
+  Module TO.
+   Definition t := t.
+   Definition eq := eq.
+   Definition lt := lt.
+   Definition le x y := lt x y \/ eq x y.
+  End TO.
+  Module IsTO.
+   Definition eq_equiv := eq_equiv.
+   Definition lt_strorder := lt_strorder.
+   Definition lt_compat := lt_compat.
+   Definition lt_total := lt_total.
+   Lemma le_lteq x y : TO.le x y <-> lt x y \/ eq x y.
+   Proof. reflexivity. Qed.
+  End IsTO.
+  Module OrderTac := !MakeOrderTac TO IsTO.
   Ltac order := OrderTac.order.
 
   Lemma le_eq x y z : ~lt x y -> eq y z -> ~lt x z. Proof. order. Qed.
@@ -143,7 +147,7 @@ Module OrderedTypeFacts (Import O: OrderedType).
 
   Lemma elim_compare_eq :
    forall x y : t,
-   eq x y -> exists H : eq x y, compare x y = EQ _ H.
+   eq x y -> exists H : eq x y, compare x y = EQ H.
   Proof.
    intros; case (compare x y); intros H'; try (exfalso; order).
    exists H'; auto.
@@ -151,7 +155,7 @@ Module OrderedTypeFacts (Import O: OrderedType).
 
   Lemma elim_compare_lt :
    forall x y : t,
-   lt x y -> exists H : lt x y, compare x y = LT _ H.
+   lt x y -> exists H : lt x y, compare x y = LT H.
   Proof.
    intros; case (compare x y); intros H'; try (exfalso; order).
    exists H'; auto.
@@ -159,7 +163,7 @@ Module OrderedTypeFacts (Import O: OrderedType).
 
   Lemma elim_compare_gt :
    forall x y : t,
-   lt y x -> exists H : lt y x, compare x y = GT _ H.
+   lt y x -> exists H : lt y x, compare x y = GT H.
   Proof.
    intros; case (compare x y); intros H'; try (exfalso; order).
    exists H'; auto.
@@ -318,16 +322,13 @@ Module KeyOrderedType(O:OrderedType).
   Hint Immediate eqk_sym eqke_sym.
 
   Global Instance eqk_equiv : Equivalence eqk.
-  Proof. split; eauto. Qed.
+  Proof. constructor; eauto. Qed.
 
   Global Instance eqke_equiv : Equivalence eqke.
   Proof. split; eauto. Qed.
 
   Global Instance ltk_strorder : StrictOrder ltk.
-  Proof.
-   split; eauto.
-   intros (x,e); compute; apply (StrictOrder_Irreflexive x).
-  Qed.
+  Proof. constructor; eauto. intros x; apply (irreflexivity (x:=fst x)). Qed.
 
   Global Instance ltk_compat : Proper (eqk==>eqk==>iff) ltk.
   Proof.
diff --git a/theories/Structures/OrderedTypeAlt.v b/theories/Structures/OrderedTypeAlt.v
index f6c1532b..b054496e 100644
--- a/theories/Structures/OrderedTypeAlt.v
+++ b/theories/Structures/OrderedTypeAlt.v
@@ -5,8 +5,6 @@
 (*    //   *      This file is distributed under the terms of the      *)
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
-(* $Id: OrderedTypeAlt.v 12384 2009-10-13 14:39:51Z letouzey $ *)
-
 Require Import OrderedType.
 
 (** * An alternative (but equivalent) presentation for an Ordered Type
diff --git a/theories/Structures/OrderedTypeEx.v b/theories/Structures/OrderedTypeEx.v
index 128cd576..83130deb 100644
--- a/theories/Structures/OrderedTypeEx.v
+++ b/theories/Structures/OrderedTypeEx.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: OrderedTypeEx.v 13297 2010-07-19 23:32:42Z letouzey $ *)
-
 Require Import OrderedType.
 Require Import ZArith.
 Require Import Omega.
@@ -23,9 +21,9 @@ Module Type UsualOrderedType.
  Parameter Inline t : Type.
  Definition eq := @eq t.
  Parameter Inline lt : t -> t -> Prop.
- Definition eq_refl := @refl_equal t.
- Definition eq_sym := @sym_eq t.
- Definition eq_trans := @trans_eq t.
+ Definition eq_refl := @eq_refl t.
+ Definition eq_sym := @eq_sym t.
+ Definition eq_trans := @eq_trans t.
  Axiom lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z.
  Axiom lt_not_eq : forall x y : t, lt x y -> ~ eq x y.
  Parameter compare : forall x y : t, Compare lt eq x y.
@@ -43,9 +41,9 @@ Module Nat_as_OT <: UsualOrderedType.
   Definition t := nat.
 
   Definition eq := @eq nat.
-  Definition eq_refl := @refl_equal t.
-  Definition eq_sym := @sym_eq t.
-  Definition eq_trans := @trans_eq t.
+  Definition eq_refl := @eq_refl t.
+  Definition eq_sym := @eq_sym t.
+  Definition eq_trans := @eq_trans t.
 
   Definition lt := lt.
 
@@ -55,12 +53,12 @@ Module Nat_as_OT <: UsualOrderedType.
   Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y.
   Proof. unfold lt, eq; intros; omega. Qed.
 
-  Definition compare : forall x y : t, Compare lt eq x y.
+  Definition compare x y : Compare lt eq x y.
   Proof.
-    intros x y; destruct (nat_compare x y) as [ | | ]_eqn.
-    apply EQ. apply nat_compare_eq; assumption.
-    apply LT. apply nat_compare_Lt_lt; assumption.
-    apply GT. apply nat_compare_Gt_gt; assumption.
+    case_eq (nat_compare x y); intro.
+    - apply EQ. now apply nat_compare_eq.
+    - apply LT. now apply nat_compare_Lt_lt.
+    - apply GT. now apply nat_compare_Gt_gt.
   Defined.
 
   Definition eq_dec := eq_nat_dec.
@@ -70,15 +68,15 @@ End Nat_as_OT.
 
 (** [Z] is an ordered type with respect to the usual order on integers. *)
 
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 Module Z_as_OT <: UsualOrderedType.
 
   Definition t := Z.
   Definition eq := @eq Z.
-  Definition eq_refl := @refl_equal t.
-  Definition eq_sym := @sym_eq t.
-  Definition eq_trans := @trans_eq t.
+  Definition eq_refl := @eq_refl t.
+  Definition eq_sym := @eq_sym t.
+  Definition eq_trans := @eq_trans t.
 
   Definition lt (x y:Z) := (x<y).
 
@@ -88,89 +86,73 @@ Module Z_as_OT <: UsualOrderedType.
   Lemma lt_not_eq : forall x y, x<y -> ~ x=y.
   Proof. intros; omega. Qed.
 
-  Definition compare : forall x y, Compare lt eq x y.
+  Definition compare x y : Compare lt eq x y.
   Proof.
-    intros x y; destruct (x ?= y) as [ | | ]_eqn.
-    apply EQ; apply Zcompare_Eq_eq; assumption.
-    apply LT; assumption.
-    apply GT; apply Zgt_lt; assumption.
+    case_eq (x ?= y); intro.
+    - apply EQ. now apply Z.compare_eq.
+    - apply LT. assumption.
+    - apply GT. now apply Z.gt_lt.
   Defined.
 
-  Definition eq_dec := Z_eq_dec.
+  Definition eq_dec := Z.eq_dec.
 
 End Z_as_OT.
 
 (** [positive] is an ordered type with respect to the usual order on natural numbers. *)
 
-Open Local Scope positive_scope.
+Local Open Scope positive_scope.
 
 Module Positive_as_OT <: UsualOrderedType.
   Definition t:=positive.
   Definition eq:=@eq positive.
-  Definition eq_refl := @refl_equal t.
-  Definition eq_sym := @sym_eq t.
-  Definition eq_trans := @trans_eq t.
+  Definition eq_refl := @eq_refl t.
+  Definition eq_sym := @eq_sym t.
+  Definition eq_trans := @eq_trans t.
 
-  Definition lt p q:= (p ?= q) Eq = Lt.
+  Definition lt := Pos.lt.
 
-  Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z.
-  Proof.
-  unfold lt; intros x y z.
-  change ((Zpos x < Zpos y)%Z -> (Zpos y < Zpos z)%Z -> (Zpos x < Zpos z)%Z).
-  omega.
-  Qed.
+  Definition lt_trans := Pos.lt_trans.
 
   Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y.
   Proof.
-  intros; intro.
-  rewrite H0 in H.
-  unfold lt in H.
-  rewrite Pcompare_refl in H; discriminate.
+  intros x y H. contradict H. rewrite H. apply Pos.lt_irrefl.
   Qed.
 
-  Definition compare : forall x y : t, Compare lt eq x y.
+  Definition compare x y : Compare lt eq x y.
   Proof.
-  intros x y. destruct ((x ?= y) Eq) as [ | | ]_eqn.
-  apply EQ; apply Pcompare_Eq_eq; assumption.
-  apply LT; assumption.
-  apply GT; apply ZC1; assumption.
+  case_eq (x ?= y); intros H.
+  - apply EQ. now apply Pos.compare_eq.
+  - apply LT; assumption.
+  - apply GT. now apply Pos.gt_lt.
   Defined.
 
-  Definition eq_dec : forall x y, { eq x y } + { ~ eq x y }.
-  Proof.
-   intros; unfold eq; decide equality.
-  Defined.
+  Definition eq_dec := Pos.eq_dec.
 
 End Positive_as_OT.
 
 
 (** [N] is an ordered type with respect to the usual order on natural numbers. *)
 
-Open Local Scope positive_scope.
-
 Module N_as_OT <: UsualOrderedType.
   Definition t:=N.
   Definition eq:=@eq N.
-  Definition eq_refl := @refl_equal t.
-  Definition eq_sym := @sym_eq t.
-  Definition eq_trans := @trans_eq t.
+  Definition eq_refl := @eq_refl t.
+  Definition eq_sym := @eq_sym t.
+  Definition eq_trans := @eq_trans t.
 
-  Definition lt:=Nlt.
-  Definition lt_trans := Nlt_trans.
-  Definition lt_not_eq := Nlt_not_eq.
+  Definition lt := N.lt.
+  Definition lt_trans := N.lt_trans.
+  Definition lt_not_eq := N.lt_neq.
 
-  Definition compare : forall x y : t, Compare lt eq x y.
+  Definition compare x y : Compare lt eq x y.
   Proof.
-  intros x y. destruct (x ?= y)%N as [ | | ]_eqn.
-  apply EQ; apply Ncompare_Eq_eq; assumption.
-  apply LT; assumption.
-  apply GT. apply Ngt_Nlt; assumption.
+  case_eq (x ?= y)%N; intro.
+  - apply EQ. now apply N.compare_eq.
+  - apply LT. assumption.
+  - apply GT. now apply N.gt_lt.
   Defined.
 
-  Definition eq_dec : forall x y, { eq x y } + { ~ eq x y }.
-  Proof.
-   intros. unfold eq. decide equality. apply Positive_as_OT.eq_dec.
-  Defined.
+  Definition eq_dec := N.eq_dec.
 
 End N_as_OT.
 
@@ -250,9 +232,9 @@ End PairOrderedType.
 Module PositiveOrderedTypeBits <: UsualOrderedType.
   Definition t:=positive.
   Definition eq:=@eq positive.
-  Definition eq_refl := @refl_equal t.
-  Definition eq_sym := @sym_eq t.
-  Definition eq_trans := @trans_eq t.
+  Definition eq_refl := @eq_refl t.
+  Definition eq_sym := @eq_sym t.
+  Definition eq_trans := @eq_trans t.
 
   Fixpoint bits_lt (p q:positive) : Prop :=
    match p, q with
@@ -296,38 +278,38 @@ Module PositiveOrderedTypeBits <: UsualOrderedType.
   Definition compare : forall x y : t, Compare lt eq x y.
   Proof.
   induction x; destruct y.
-  (* I I *)
-  destruct (IHx y).
-  apply LT; auto.
-  apply EQ; rewrite e; red; auto.
-  apply GT; auto.
-  (* I O *)
-  apply GT; simpl; auto.
-  (* I H *)
-  apply GT; simpl; auto.
-  (* O I *)
-  apply LT; simpl; auto.
-  (* O O *)
-  destruct (IHx y).
-  apply LT; auto.
-  apply EQ; rewrite e; red; auto.
-  apply GT; auto.
-  (* O H *)
-  apply LT; simpl; auto.
-  (* H I *)
-  apply LT; simpl; auto.
-  (* H O *)
-  apply GT; simpl; auto.
-  (* H H *)
-  apply EQ; red; auto.
+  - (* I I *)
+    destruct (IHx y).
+    apply LT; auto.
+    apply EQ; rewrite e; red; auto.
+    apply GT; auto.
+  - (* I O *)
+    apply GT; simpl; auto.
+  - (* I H *)
+    apply GT; simpl; auto.
+  - (* O I *)
+    apply LT; simpl; auto.
+  - (* O O *)
+    destruct (IHx y).
+    apply LT; auto.
+    apply EQ; rewrite e; red; auto.
+    apply GT; auto.
+  - (* O H *)
+    apply LT; simpl; auto.
+  - (* H I *)
+    apply LT; simpl; auto.
+  - (* H O *)
+    apply GT; simpl; auto.
+  - (* H H *)
+    apply EQ; red; auto.
   Qed.
 
   Lemma eq_dec (x y: positive): {x = y} + {x <> y}.
   Proof.
-  intros. case_eq ((x ?= y) Eq); intros.
-  left. apply Pcompare_Eq_eq; auto.
-  right. red. intro. subst y. rewrite (Pcompare_refl x) in H. discriminate.
-  right. red. intro. subst y. rewrite (Pcompare_refl x) in H. discriminate.
+  intros. case_eq (x ?= y); intros.
+  - left. now apply Pos.compare_eq.
+  - right. intro. subst y. now rewrite (Pos.compare_refl x) in *.
+  - right. intro. subst y. now rewrite (Pos.compare_refl x) in *.
   Qed.
 
 End PositiveOrderedTypeBits.
diff --git a/theories/Structures/Orders.v b/theories/Structures/Orders.v
index 5567b743..1d025439 100644
--- a/theories/Structures/Orders.v
+++ b/theories/Structures/Orders.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: Orders.v 13276 2010-07-10 14:34:44Z letouzey $ *)
-
 Require Export Relations Morphisms Setoid Equalities.
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -67,20 +65,34 @@ Module Type LeIsLtEq (Import E:EqLtLe').
   Axiom le_lteq : forall x y, x<=y <-> x<y \/ x==y.
 End LeIsLtEq.
 
-Module Type HasCompare (Import E:EqLt).
+Module Type StrOrder := EqualityType <+ HasLt <+ IsStrOrder.
+Module Type StrOrder' := StrOrder <+ EqLtNotation.
+
+(** Versions with a decidable ternary comparison *)
+
+Module Type HasCmp (Import T:Typ).
   Parameter Inline compare : t -> t -> comparison.
-  Axiom compare_spec : forall x y, CompSpec eq lt x y (compare x y).
-End HasCompare.
+End HasCmp.
+
+Module Type CmpNotation (T:Typ)(C:HasCmp T).
+  Infix "?=" := C.compare (at level 70, no associativity).
+End CmpNotation.
+
+Module Type CmpSpec (Import E:EqLt')(Import C:HasCmp E).
+  Axiom compare_spec : forall x y, CompareSpec (x==y) (x<y) (y<x) (compare x y).
+End CmpSpec.
+
+Module Type HasCompare (E:EqLt) := HasCmp E <+ CmpSpec E.
 
-Module Type StrOrder := EqualityType <+ HasLt <+ IsStrOrder.
 Module Type DecStrOrder := StrOrder <+ HasCompare.
+Module Type DecStrOrder' := DecStrOrder <+ EqLtNotation <+ CmpNotation.
+
 Module Type OrderedType <: DecidableType := DecStrOrder <+ HasEqDec.
-Module Type OrderedTypeFull := OrderedType <+ HasLe <+ LeIsLtEq.
+Module Type OrderedType' := OrderedType <+ EqLtNotation <+ CmpNotation.
 
-Module Type StrOrder' := StrOrder <+ EqLtNotation.
-Module Type DecStrOrder' := DecStrOrder <+ EqLtNotation.
-Module Type OrderedType' := OrderedType <+ EqLtNotation.
-Module Type OrderedTypeFull' := OrderedTypeFull <+ EqLtLeNotation.
+Module Type OrderedTypeFull := OrderedType <+ HasLe <+ LeIsLtEq.
+Module Type OrderedTypeFull' :=
+ OrderedTypeFull <+ EqLtLeNotation <+ CmpNotation.
 
 (** NB: in [OrderedType], an [eq_dec] could be deduced from [compare].
   But adding this redundant field allows to see an [OrderedType] as a
@@ -169,50 +181,63 @@ Module OTF_to_TotalOrder (O:OrderedTypeFull) <: TotalOrder
 Local Coercion is_true : bool >-> Sortclass.
 Hint Unfold is_true.
 
-Module Type HasLeBool (Import T:Typ).
-  Parameter Inline leb : t -> t -> bool.
-End HasLeBool.
-
-Module Type HasLtBool (Import T:Typ).
-  Parameter Inline ltb : t -> t -> bool.
-End HasLtBool.
+Module Type HasLeb (Import T:Typ).
+ Parameter Inline leb : t -> t -> bool.
+End HasLeb.
 
-Module Type LeBool := Typ <+ HasLeBool.
-Module Type LtBool := Typ <+ HasLtBool.
+Module Type HasLtb (Import T:Typ).
+ Parameter Inline ltb : t -> t -> bool.
+End HasLtb.
 
-Module Type LeBoolNotation (E:LeBool).
-  Infix "<=?" := E.leb (at level 35).
-End LeBoolNotation.
+Module Type LebNotation (T:Typ)(E:HasLeb T).
+ Infix "<=?" := E.leb (at level 35).
+End LebNotation.
 
-Module Type LtBoolNotation (E:LtBool).
-  Infix "<?" := E.ltb (at level 35).
-End LtBoolNotation.
+Module Type LtbNotation (T:Typ)(E:HasLtb T).
+ Infix "<?" := E.ltb (at level 35).
+End LtbNotation.
 
-Module Type LeBool' := LeBool <+ LeBoolNotation.
-Module Type LtBool' := LtBool <+ LtBoolNotation.
+Module Type LebSpec (T:Typ)(X:HasLe T)(Y:HasLeb T).
+ Parameter leb_le : forall x y, Y.leb x y = true <-> X.le x y.
+End LebSpec.
 
-Module Type LeBool_Le (T:Typ)(X:HasLeBool T)(Y:HasLe T).
- Parameter leb_le : forall x y, X.leb x y = true <-> Y.le x y.
-End LeBool_Le.
+Module Type LtbSpec (T:Typ)(X:HasLt T)(Y:HasLtb T).
+ Parameter ltb_lt : forall x y, Y.ltb x y = true <-> X.lt x y.
+End LtbSpec.
 
-Module Type LtBool_Lt (T:Typ)(X:HasLtBool T)(Y:HasLt T).
- Parameter ltb_lt : forall x y, X.ltb x y = true <-> Y.lt x y.
-End LtBool_Lt.
+Module Type LeBool := Typ <+ HasLeb.
+Module Type LtBool := Typ <+ HasLtb.
+Module Type LeBool' := LeBool <+ LebNotation.
+Module Type LtBool' := LtBool <+ LtbNotation.
 
-Module Type LeBoolIsTotal (Import X:LeBool').
+Module Type LebIsTotal (Import X:LeBool').
  Axiom leb_total : forall x y, (x <=? y) = true \/ (y <=? x) = true.
-End LeBoolIsTotal.
+End LebIsTotal.
 
-Module Type TotalLeBool := LeBool <+ LeBoolIsTotal.
-Module Type TotalLeBool' := LeBool' <+ LeBoolIsTotal.
+Module Type TotalLeBool := LeBool <+ LebIsTotal.
+Module Type TotalLeBool' := LeBool' <+ LebIsTotal.
 
-Module Type LeBoolIsTransitive (Import X:LeBool').
+Module Type LebIsTransitive (Import X:LeBool').
  Axiom leb_trans : Transitive X.leb.
-End LeBoolIsTransitive.
+End LebIsTransitive.
+
+Module Type TotalTransitiveLeBool := TotalLeBool <+ LebIsTransitive.
+Module Type TotalTransitiveLeBool' := TotalLeBool' <+ LebIsTransitive.
+
+(** Grouping all boolean comparison functions *)
+
+Module Type HasBoolOrdFuns (T:Typ) := HasEqb T <+ HasLtb T <+ HasLeb T.
+
+Module Type HasBoolOrdFuns' (T:Typ) :=
+ HasBoolOrdFuns T <+ EqbNotation T <+ LtbNotation T <+ LebNotation T.
 
-Module Type TotalTransitiveLeBool := TotalLeBool <+ LeBoolIsTransitive.
-Module Type TotalTransitiveLeBool' := TotalLeBool' <+ LeBoolIsTransitive.
+Module Type BoolOrdSpecs (O:EqLtLe)(F:HasBoolOrdFuns O) :=
+ EqbSpec O O F <+ LtbSpec O O F <+ LebSpec O O F.
 
+Module Type OrderFunctions (E:EqLtLe) :=
+  HasCompare E <+ HasBoolOrdFuns E <+ BoolOrdSpecs E.
+Module Type OrderFunctions' (E:EqLtLe) :=
+  HasCompare E <+ CmpNotation E <+ HasBoolOrdFuns' E <+ BoolOrdSpecs E.
 
 (** * From [OrderedTypeFull] to [TotalTransitiveLeBool] *)
 
diff --git a/theories/Structures/OrdersAlt.v b/theories/Structures/OrdersAlt.v
index 21ef8eb8..5dd917a7 100644
--- a/theories/Structures/OrdersAlt.v
+++ b/theories/Structures/OrdersAlt.v
@@ -11,8 +11,6 @@
  * Institution: LRI, CNRS UMR 8623 - Université Paris Sud
  *              91405 Orsay, France *)
 
-(* $Id: OrdersAlt.v 12754 2010-02-12 16:21:48Z letouzey $ *)
-
 Require Import OrderedType Orders.
 Set Implicit Arguments.
 
@@ -142,7 +140,7 @@ Module OT_from_Alt (Import O:OrderedTypeAlt) <: OrderedType.
  Lemma lt_eq : forall x y z, lt x y -> eq y z -> lt x z.
  Proof.
   unfold lt, eq; intros x y z Hxy Hyz.
-  destruct (compare x z) as [ ]_eqn:Hxz; auto.
+  destruct (compare x z) eqn:Hxz; auto.
   rewrite compare_sym, CompOpp_iff in Hyz. simpl in Hyz.
   rewrite (compare_trans Hxz Hyz) in Hxy; discriminate.
   rewrite compare_sym, CompOpp_iff in Hxy. simpl in Hxy.
@@ -152,7 +150,7 @@ Module OT_from_Alt (Import O:OrderedTypeAlt) <: OrderedType.
  Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z.
  Proof.
   unfold lt, eq; intros x y z Hxy Hyz.
-  destruct (compare x z) as [ ]_eqn:Hxz; auto.
+  destruct (compare x z) eqn:Hxz; auto.
   rewrite compare_sym, CompOpp_iff in Hxy. simpl in Hxy.
   rewrite (compare_trans Hxy Hxz) in Hyz; discriminate.
   rewrite compare_sym, CompOpp_iff in Hyz. simpl in Hyz.
@@ -171,7 +169,7 @@ Module OT_from_Alt (Import O:OrderedTypeAlt) <: OrderedType.
  Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y).
  Proof.
   unfold eq, lt, compare; intros.
-  destruct (O.compare x y) as [ ]_eqn:H; auto.
+  destruct (O.compare x y) eqn:H; auto.
   apply CompGt.
   rewrite compare_sym, H; auto.
  Qed.
diff --git a/theories/Structures/OrdersEx.v b/theories/Structures/OrdersEx.v
index 9f83d82b..e071d053 100644
--- a/theories/Structures/OrdersEx.v
+++ b/theories/Structures/OrdersEx.v
@@ -11,20 +11,18 @@
  * Institution: LRI, CNRS UMR 8623 - Université Paris Sud
  *              91405 Orsay, France *)
 
-(* $Id: OrdersEx.v 12641 2010-01-07 15:32:52Z letouzey $ *)
-
-Require Import Orders NatOrderedType POrderedType NOrderedType
- ZOrderedType RelationPairs EqualitiesFacts.
+Require Import Orders NPeano POrderedType NArith
+ ZArith RelationPairs EqualitiesFacts.
 
 (** * Examples of Ordered Type structures. *)
 
 
 (** Ordered Type for [nat], [Positive], [N], [Z] with the usual order. *)
 
-Module Nat_as_OT := NatOrderedType.Nat_as_OT.
+Module Nat_as_OT := NPeano.Nat.
 Module Positive_as_OT := POrderedType.Positive_as_OT.
-Module N_as_OT := NOrderedType.N_as_OT.
-Module Z_as_OT := ZOrderedType.Z_as_OT.
+Module N_as_OT := BinNat.N.
+Module Z_as_OT := BinInt.Z.
 
 (** An OrderedType can now directly be seen as a DecidableType *)
 
diff --git a/theories/Structures/OrdersFacts.v b/theories/Structures/OrdersFacts.v
index a28b7977..2e9c0cf5 100644
--- a/theories/Structures/OrdersFacts.v
+++ b/theories/Structures/OrdersFacts.v
@@ -6,15 +6,76 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-Require Import Basics OrdersTac.
+Require Import Bool Basics OrdersTac.
 Require Export Orders.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
 
-(** * Properties of [OrderedTypeFull] *)
+(** * Properties of [compare] *)
 
-Module OrderedTypeFullFacts (Import O:OrderedTypeFull').
+Module Type CompareFacts (Import O:DecStrOrder').
+
+ Local Infix "?=" := compare (at level 70, no associativity).
+
+ Lemma compare_eq_iff x y : (x ?= y) = Eq <-> x==y.
+ Proof.
+ case compare_spec; intro H; split; try easy; intro EQ;
+  contradict H; rewrite EQ; apply irreflexivity.
+ Qed.
+
+ Lemma compare_eq x y : (x ?= y) = Eq -> x==y.
+ Proof.
+ apply compare_eq_iff.
+ Qed.
+
+ Lemma compare_lt_iff x y : (x ?= y) = Lt <-> x<y.
+ Proof.
+ case compare_spec; intro H; split; try easy; intro LT;
+  contradict LT; rewrite H; apply irreflexivity.
+ Qed.
+
+ Lemma compare_gt_iff x y : (x ?= y) = Gt <-> y<x.
+ Proof.
+ case compare_spec; intro H; split; try easy; intro LT;
+  contradict LT; rewrite H; apply irreflexivity.
+ Qed.
+
+ Lemma compare_nlt_iff x y : (x ?= y) <> Lt <-> ~(x<y).
+ Proof.
+ rewrite compare_lt_iff; intuition.
+ Qed.
+
+ Lemma compare_ngt_iff x y : (x ?= y) <> Gt <-> ~(y<x).
+ Proof.
+ rewrite compare_gt_iff; intuition.
+ Qed.
+
+ Hint Rewrite compare_eq_iff compare_lt_iff compare_gt_iff : order.
+
+ Instance compare_compat : Proper (eq==>eq==>Logic.eq) compare.
+ Proof.
+ intros x x' Hxx' y y' Hyy'.
+ case (compare_spec x' y'); autorewrite with order; now rewrite Hxx', Hyy'.
+ Qed.
+
+ Lemma compare_refl x : (x ?= x) = Eq.
+ Proof.
+ case compare_spec; intros; trivial; now elim irreflexivity with x.
+ Qed.
+
+ Lemma compare_antisym x y : (y ?= x) = CompOpp (x ?= y).
+ Proof.
+ case (compare_spec x y); simpl; autorewrite with order;
+  trivial; now symmetry.
+ Qed.
+
+End CompareFacts.
+
+
+ (** * Properties of [OrderedTypeFull] *)
+
+Module Type OrderedTypeFullFacts (Import O:OrderedTypeFull').
 
  Module OrderTac := OTF_to_OrderTac O.
  Ltac order := OrderTac.order.
@@ -47,6 +108,18 @@ Module OrderedTypeFullFacts (Import O:OrderedTypeFull').
  Lemma eq_is_le_ge : forall x y, x==y <-> x<=y /\ y<=x.
  Proof. iorder. Qed.
 
+ Include CompareFacts O.
+
+ Lemma compare_le_iff x y : compare x y <> Gt <-> x<=y.
+ Proof.
+ rewrite le_not_gt_iff. apply compare_ngt_iff.
+ Qed.
+
+ Lemma compare_ge_iff x y : compare x y <> Lt <-> y<=x.
+ Proof.
+ rewrite le_not_gt_iff. apply compare_nlt_iff.
+ Qed.
+
 End OrderedTypeFullFacts.
 
 
@@ -84,50 +157,9 @@ Module OrderedTypeFacts (Import O: OrderedType').
 
   Definition lt_irrefl (x:t) : ~x<x := StrictOrder_Irreflexive x.
 
-  (** Some more about [compare] *)
-
-  Lemma compare_eq_iff : forall x y, (x ?= y) = Eq <-> x==y.
-  Proof.
-   intros; elim_compare x y; intuition; try discriminate; order.
-  Qed.
-
-  Lemma compare_lt_iff : forall x y, (x ?= y) = Lt <-> x<y.
-  Proof.
-   intros; elim_compare x y; intuition; try discriminate; order.
-  Qed.
-
-  Lemma compare_gt_iff : forall x y, (x ?= y) = Gt <-> y<x.
-  Proof.
-   intros; elim_compare x y; intuition; try discriminate; order.
-  Qed.
-
-  Lemma compare_ge_iff : forall x y, (x ?= y) <> Lt <-> y<=x.
-  Proof.
-   intros; rewrite compare_lt_iff; intuition.
-  Qed.
-
-  Lemma compare_le_iff : forall x y, (x ?= y) <> Gt <-> x<=y.
-  Proof.
-   intros; rewrite compare_gt_iff; intuition.
-  Qed.
-
-  Hint Rewrite compare_eq_iff compare_lt_iff compare_gt_iff : order.
-
-  Instance compare_compat : Proper (eq==>eq==>Logic.eq) compare.
-  Proof.
-  intros x x' Hxx' y y' Hyy'.
-  elim_compare x' y'; autorewrite with order; order.
-  Qed.
-
-  Lemma compare_refl : forall x, (x ?= x) = Eq.
-  Proof.
-   intros; elim_compare x x; auto; order.
-  Qed.
-
-  Lemma compare_antisym : forall x y, (y ?= x) = CompOpp (x ?= y).
-  Proof.
-   intros; elim_compare x y; simpl; autorewrite with order; order.
-  Qed.
+  Include CompareFacts O.
+  Notation compare_le_iff := compare_ngt_iff (only parsing).
+  Notation compare_ge_iff := compare_nlt_iff (only parsing).
 
   (** For compatibility reasons *)
   Definition eq_dec := eq_dec.
@@ -162,10 +194,6 @@ Module OrderedTypeFacts (Import O: OrderedType').
 End OrderedTypeFacts.
 
 
-
-
-
-
 (** * Tests of the order tactic
 
     Is it at least capable of proving some basic properties ? *)
@@ -208,7 +236,7 @@ Module OrderedTypeRev (O:OrderedTypeFull) <: OrderedTypeFull.
 
 Definition t := O.t.
 Definition eq := O.eq.
-Instance eq_equiv : Equivalence eq.
+Program Instance eq_equiv : Equivalence eq.
 Definition eq_dec := O.eq_dec.
 
 Definition lt := flip O.lt.
@@ -232,3 +260,195 @@ Qed.
 
 End OrderedTypeRev.
 
+Unset Implicit Arguments.
+
+(** * Order relations derived from a [compare] function.
+
+  We factorize here some common properties for ZArith, NArith
+  and co, where [lt] and [le] are defined in terms of [compare].
+  Note that we do not require anything here concerning compatibility
+  of [compare] w.r.t [eq], nor anything concerning transitivity.
+*)
+
+Module Type CompareBasedOrder (Import E:EqLtLe')(Import C:HasCmp E).
+ Include CmpNotation E C.
+ Include IsEq E.
+ Axiom compare_eq_iff : forall x y, (x ?= y) = Eq <-> x == y.
+ Axiom compare_lt_iff : forall x y, (x ?= y) = Lt <-> x < y.
+ Axiom compare_le_iff : forall x y, (x ?= y) <> Gt <-> x <= y.
+ Axiom compare_antisym : forall x y, (y ?= x) = CompOpp (x ?= y).
+End CompareBasedOrder.
+
+Module Type CompareBasedOrderFacts
+ (Import E:EqLtLe')
+ (Import C:HasCmp E)
+ (Import O:CompareBasedOrder E C).
+
+ Lemma compare_spec x y : CompareSpec (x==y) (x<y) (y<x) (x?=y).
+ Proof.
+  case_eq (compare x y); intros H; constructor.
+  now apply compare_eq_iff.
+  now apply compare_lt_iff.
+  rewrite compare_antisym, CompOpp_iff in H. now apply compare_lt_iff.
+ Qed.
+
+ Lemma compare_eq x y : (x ?= y) = Eq -> x==y.
+ Proof.
+ apply compare_eq_iff.
+ Qed.
+
+ Lemma compare_refl x : (x ?= x) = Eq.
+ Proof.
+ now apply compare_eq_iff.
+ Qed.
+
+ Lemma compare_gt_iff x y : (x ?= y) = Gt <-> y<x.
+ Proof.
+ now rewrite <- compare_lt_iff, compare_antisym, CompOpp_iff.
+ Qed.
+
+ Lemma compare_ge_iff x y : (x ?= y) <> Lt <-> y<=x.
+ Proof.
+ now rewrite <- compare_le_iff, compare_antisym, CompOpp_iff.
+ Qed.
+
+ Lemma compare_ngt_iff x y : (x ?= y) <> Gt <-> ~(y<x).
+ Proof.
+ rewrite compare_gt_iff; intuition.
+ Qed.
+
+ Lemma compare_nlt_iff x y : (x ?= y) <> Lt <-> ~(x<y).
+ Proof.
+ rewrite compare_lt_iff; intuition.
+ Qed.
+
+ Lemma compare_nle_iff x y : (x ?= y) = Gt <-> ~(x<=y).
+ Proof.
+ rewrite <- compare_le_iff.
+ destruct compare; split; easy || now destruct 1.
+ Qed.
+
+ Lemma compare_nge_iff x y : (x ?= y) = Lt <-> ~(y<=x).
+ Proof.
+ now rewrite <- compare_nle_iff, compare_antisym, CompOpp_iff.
+ Qed.
+
+ Lemma lt_irrefl x : ~ (x<x).
+ Proof.
+ now rewrite <- compare_lt_iff, compare_refl.
+ Qed.
+
+ Lemma lt_eq_cases n m : n <= m <-> n < m \/ n==m.
+ Proof.
+ rewrite <- compare_lt_iff, <- compare_le_iff, <- compare_eq_iff.
+ destruct (n ?= m); now intuition.
+ Qed.
+
+End CompareBasedOrderFacts.
+
+(** Basic facts about boolean comparisons *)
+
+Module Type BoolOrderFacts
+ (Import E:EqLtLe')
+ (Import C:HasCmp E)
+ (Import F:HasBoolOrdFuns' E)
+ (Import O:CompareBasedOrder E C)
+ (Import S:BoolOrdSpecs E F).
+
+Include CompareBasedOrderFacts E C O.
+
+(** Nota : apart from [eqb_compare] below, facts about [eqb]
+  are in BoolEqualityFacts *)
+
+(** Alternate specifications based on [BoolSpec] and [reflect] *)
+
+Lemma leb_spec0 x y : reflect (x<=y) (x<=?y).
+Proof.
+ apply iff_reflect. symmetry. apply leb_le.
+Defined.
+
+Lemma leb_spec x y : BoolSpec (x<=y) (y<x) (x<=?y).
+Proof.
+ case leb_spec0; constructor; trivial.
+ now rewrite <- compare_lt_iff, compare_nge_iff.
+Qed.
+
+Lemma ltb_spec0 x y : reflect (x<y) (x<?y).
+Proof.
+ apply iff_reflect. symmetry. apply ltb_lt.
+Defined.
+
+Lemma ltb_spec x y : BoolSpec (x<y) (y<=x) (x<?y).
+Proof.
+ case ltb_spec0; constructor; trivial.
+ now rewrite <- compare_le_iff, compare_ngt_iff.
+Qed.
+
+(** Negated variants of the specifications *)
+
+Lemma leb_nle x y : x <=? y = false <-> ~ (x <= y).
+Proof.
+now rewrite <- not_true_iff_false, leb_le.
+Qed.
+
+Lemma leb_gt x y : x <=? y = false <-> y < x.
+Proof.
+now rewrite leb_nle, <- compare_lt_iff, compare_nge_iff.
+Qed.
+
+Lemma ltb_nlt x y : x <? y = false <-> ~ (x < y).
+Proof.
+now rewrite <- not_true_iff_false, ltb_lt.
+Qed.
+
+Lemma ltb_ge x y : x <? y = false <-> y <= x.
+Proof.
+now rewrite ltb_nlt, <- compare_le_iff, compare_ngt_iff.
+Qed.
+
+(** Basic equality laws for boolean tests *)
+
+Lemma leb_refl x : x <=? x = true.
+Proof.
+apply leb_le. apply lt_eq_cases. now right.
+Qed.
+
+Lemma leb_antisym x y : y <=? x = negb (x <? y).
+Proof.
+apply eq_true_iff_eq. now rewrite negb_true_iff, leb_le, ltb_ge.
+Qed.
+
+Lemma ltb_irrefl x : x <? x = false.
+Proof.
+apply ltb_ge. apply lt_eq_cases. now right.
+Qed.
+
+Lemma ltb_antisym x y : y <? x = negb (x <=? y).
+Proof.
+apply eq_true_iff_eq. now rewrite negb_true_iff, ltb_lt, leb_gt.
+Qed.
+
+(** Relation bewteen [compare] and the boolean comparisons *)
+
+Lemma eqb_compare x y :
+ (x =? y) = match compare x y with Eq => true | _ => false end.
+Proof.
+apply eq_true_iff_eq. rewrite eqb_eq, <- compare_eq_iff.
+destruct compare; now split.
+Qed.
+
+Lemma ltb_compare x y :
+ (x <? y) = match compare x y with Lt => true | _ => false end.
+Proof.
+apply eq_true_iff_eq. rewrite ltb_lt, <- compare_lt_iff.
+destruct compare; now split.
+Qed.
+
+Lemma leb_compare x y :
+ (x <=? y) = match compare x y with Gt => false | _ => true end.
+Proof.
+apply eq_true_iff_eq. rewrite leb_le, <- compare_le_iff.
+destruct compare; split; try easy. now destruct 1.
+Qed.
+
+End BoolOrderFacts.
diff --git a/theories/Structures/OrdersLists.v b/theories/Structures/OrdersLists.v
index 2ed07026..f83b6377 100644
--- a/theories/Structures/OrdersLists.v
+++ b/theories/Structures/OrdersLists.v
@@ -86,11 +86,11 @@ Module KeyOrderedType(Import O:OrderedType).
 
   (* eqk, eqke are equalities, ltk is a strict order *)
 
-  Global Instance eqk_equiv : Equivalence eqk.
+  Global Instance eqk_equiv : Equivalence eqk := _.
 
-  Global Instance eqke_equiv : Equivalence eqke.
+  Global Instance eqke_equiv : Equivalence eqke := _.
 
-  Global Instance ltk_strorder : StrictOrder ltk.
+  Global Instance ltk_strorder : StrictOrder ltk := _.
 
   Global Instance ltk_compat : Proper (eqk==>eqk==>iff) ltk.
   Proof. unfold eqk, ltk; auto with *. Qed.
diff --git a/theories/Structures/OrdersTac.v b/theories/Structures/OrdersTac.v
index 66a672c9..68ffc379 100644
--- a/theories/Structures/OrdersTac.v
+++ b/theories/Structures/OrdersTac.v
@@ -40,16 +40,26 @@ Definition trans_ord o o' :=
 Local Infix "+" := trans_ord.
 
 
-(** ** The requirements of the tactic : [TotalOrder].
+(** ** The tactic requirements : a total order
 
-   [TotalOrder] contains an equivalence [eq],
-   a strict order [lt] total and compatible with [eq], and
-   a larger order [le] synonym for [lt\/eq].
+   We need :
+   - an equivalence [eq],
+   - a strict order [lt] total and compatible with [eq],
+   - a larger order [le] synonym for [lt\/eq].
+
+   This used to be provided here via a [TotalOrder], but
+   for technical reasons related to extraction, we now ask
+   for two sperate parts: relations in a [EqLtLe] + properties in
+   [IsTotalOrder]. Note that [TotalOrder = EqLtLe <+ IsTotalOrder]
 *)
 
+Module Type IsTotalOrder (O:EqLtLe) :=
+ IsEq O <+ IsStrOrder O <+ LeIsLtEq O <+ LtIsTotal O.
+
 (** ** Properties that will be used by the [order] tactic *)
 
-Module OrderFacts(Import O:TotalOrder').
+Module OrderFacts (Import O:EqLtLe)(P:IsTotalOrder O).
+Include EqLtLeNotation O.
 
 (** Reflexivity rules *)
 
@@ -57,7 +67,7 @@ Lemma eq_refl : forall x, x==x.
 Proof. reflexivity. Qed.
 
 Lemma le_refl : forall x, x<=x.
-Proof. intros; rewrite le_lteq; right; reflexivity. Qed.
+Proof. intros; rewrite P.le_lteq; right; reflexivity. Qed.
 
 Lemma lt_irrefl : forall x, ~ x<x.
 Proof. intros; apply StrictOrder_Irreflexive. Qed.
@@ -69,7 +79,7 @@ Proof. auto with *. Qed.
 
 Lemma le_antisym : forall x y, x<=y -> y<=x -> x==y.
 Proof.
- intros x y; rewrite 2 le_lteq. intuition.
+ intros x y; rewrite 2 P.le_lteq. intuition.
  elim (StrictOrder_Irreflexive x); transitivity y; auto.
 Qed.
 
@@ -90,7 +100,7 @@ Local Notation "#" := interp_ord.
 
 Lemma trans : forall o o' x y z, #o x y -> #o' y z -> #(o+o') x z.
 Proof.
-destruct o, o'; simpl; intros x y z; rewrite ?le_lteq; intuition;
+destruct o, o'; simpl; intros x y z; rewrite ?P.le_lteq; intuition;
  subst_eqns; eauto using (StrictOrder_Transitive x y z) with *.
 Qed.
 
@@ -114,19 +124,19 @@ Proof. eauto using eq_trans, eq_sym. Qed.
 
 Lemma not_neq_eq : forall x y, ~~x==y -> x==y.
 Proof.
-intros x y H. destruct (lt_total x y) as [H'|[H'|H']]; auto;
+intros x y H. destruct (P.lt_total x y) as [H'|[H'|H']]; auto;
  destruct H; intro H; rewrite H in H'; eapply lt_irrefl; eauto.
 Qed.
 
 Lemma not_ge_lt : forall x y, ~y<=x -> x<y.
 Proof.
-intros x y H. destruct (lt_total x y); auto.
-destruct H. rewrite le_lteq. intuition.
+intros x y H. destruct (P.lt_total x y); auto.
+destruct H. rewrite P.le_lteq. intuition.
 Qed.
 
 Lemma not_gt_le : forall x y, ~y<x -> x<=y.
 Proof.
-intros x y H. rewrite le_lteq. generalize (lt_total x y); intuition.
+intros x y H. rewrite P.le_lteq. generalize (P.lt_total x y); intuition.
 Qed.
 
 Lemma le_neq_lt : forall x y, x<=y -> ~x==y -> x<y.
@@ -138,9 +148,9 @@ End OrderFacts.
 
 (** ** [MakeOrderTac] : The functor providing the order tactic. *)
 
-Module MakeOrderTac (Import O:TotalOrder').
-
-Include OrderFacts O.
+Module MakeOrderTac (Import O:EqLtLe)(P:IsTotalOrder O).
+Include OrderFacts O P.
+Include EqLtLeNotation O.
 
 (** order_eq : replace x by y in all (in)equations hyps thanks
    to equality EQ (where eq has been hidden in order to avoid
@@ -257,37 +267,10 @@ End MakeOrderTac.
 
 Module OTF_to_OrderTac (OTF:OrderedTypeFull).
  Module TO := OTF_to_TotalOrder OTF.
- Include !MakeOrderTac TO.
+ Include !MakeOrderTac OTF TO.
 End OTF_to_OrderTac.
 
 Module OT_to_OrderTac (OT:OrderedType).
  Module OTF := OT_to_Full OT.
  Include !OTF_to_OrderTac OTF.
 End OT_to_OrderTac.
-
-Module TotalOrderRev (O:TotalOrder) <: TotalOrder.
-
-Definition t := O.t.
-Definition eq := O.eq.
-Definition lt := flip O.lt.
-Definition le := flip O.le.
-Include EqLtLeNotation.
-
-(* No Instance syntax to avoid saturating the Equivalence tables *)
-Definition eq_equiv := O.eq_equiv.
-
-Instance lt_strorder: StrictOrder lt.
-Proof. unfold lt; auto with *. Qed.
-Instance lt_compat : Proper (eq==>eq==>iff) lt.
-Proof. unfold lt; auto with *. Qed.
-
-Lemma le_lteq : forall x y, x<=y <-> x<y \/ x==y.
-Proof. intros; unfold le, lt, flip. rewrite O.le_lteq; intuition. Qed.
-
-Lemma lt_total : forall x y, x<y \/ x==y \/ y<x.
-Proof.
- intros x y; unfold lt, eq, flip.
- generalize (O.lt_total x y); intuition.
-Qed.
-
-End TotalOrderRev.
diff --git a/theories/Unicode/Utf8.v b/theories/Unicode/Utf8.v
index 41a98ef2..6d2da154 100644
--- a/theories/Unicode/Utf8.v
+++ b/theories/Unicode/Utf8.v
@@ -1,49 +1,13 @@
 (* -*- coding:utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* Logic *)
-Notation "∀ x , P" := (forall x , P)
-  (at level 200, x ident, right associativity) : type_scope.
-Notation "∀ x y , P" := (forall x y , P)
-  (at level 200, x ident, y ident, right associativity) : type_scope.
-Notation "∀ x y z , P" := (forall x y z , P)
-  (at level 200, x ident, y ident, z ident, right associativity) : type_scope.
-Notation "∀ x y z u , P" := (forall x y z u , P)
-  (at level 200, x ident, y ident, z ident, u ident, right associativity)
-  : type_scope.
-Notation "∀ x : t , P" := (forall x : t , P)
-  (at level 200, x ident, right associativity) : type_scope.
-Notation "∀ x y : t , P" := (forall x y : t , P)
-  (at level 200, x ident, y ident, right associativity) : type_scope.
-Notation "∀ x y z : t , P" := (forall x y z : t , P)
-  (at level 200, x ident, y ident, z ident, right associativity) : type_scope.
-Notation "∀ x y z u : t , P" := (forall x y z u : t , P)
-  (at level 200, x ident, y ident, z ident, u ident, right associativity)
-  : type_scope.
-
-Notation "∃ x , P" := (exists x , P)
-  (at level 200, x ident, right associativity) : type_scope.
-Notation "∃ x : t , P" := (exists x : t, P)
-  (at level 200, x ident, right associativity) : type_scope.
-
-Notation "x ∨ y" := (x \/ y) (at level 85, right associativity) : type_scope.
-Notation "x ∧ y" := (x /\ y) (at level 80, right associativity) : type_scope.
-Notation "x → y" := (x -> y) (at level 90, right associativity): type_scope.
-Notation "x ↔ y" := (x <-> y) (at level 95, no associativity): type_scope.
-Notation "¬ x" := (~x) (at level 75, right associativity) : type_scope.
-Notation "x ≠ y" := (x <> y) (at level 70) : type_scope.
-
-(* Abstraction *)
-(* Not nice
-Notation  "'λ' x : T , y" := ([x:T] y) (at level 1, x,T,y at level 10).
-Notation  "'λ' x := T , y" := ([x:=T] y) (at level 1, x,T,y at level 10).
-*)
+Require Export Utf8_core.
 
 (* Arithmetic *)
 Notation "x ≤ y" := (le x y) (at level 70, no associativity).
@@ -51,10 +15,10 @@ Notation "x ≥ y" := (ge x y) (at level 70, no associativity).
 
 (* test *)
 (*
-Goal ∀ x, True -> (∃ y , x ≥ y + 1) ∨ x ≤ 0.
+Check ∀ x z, True -> (∃ y v, x + v ≥ y + z) ∨ x ≤ 0.
 *)
 
 (* Integer Arithmetic *)
 (* TODO: this should come after ZArith
-Notation "x ≤ y" := (Zle x y) (at level 1, y at level 10).
+Notation "x ≤ y" := (Z.le x y) (at level 70, no associativity).
 *)
diff --git a/theories/Unicode/Utf8_core.v b/theories/Unicode/Utf8_core.v
index ce637413..f9670d17 100644
--- a/theories/Unicode/Utf8_core.v
+++ b/theories/Unicode/Utf8_core.v
@@ -1,12 +1,14 @@
 (* -*- coding:utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+
+
 (* Logic *)
 Notation "∀  x .. y , P" := (forall x, .. (forall y, P) ..)
   (at level 200, x binder, y binder, right associativity) : type_scope.
@@ -15,7 +17,9 @@ Notation "∃  x .. y , P" := (exists x, .. (exists y, P) ..)
 
 Notation "x ∨ y" := (x \/ y) (at level 85, right associativity) : type_scope.
 Notation "x ∧ y" := (x /\ y) (at level 80, right associativity) : type_scope.
-Notation "x → y" := (x -> y) (at level 90, right associativity): type_scope.
+Notation "x → y" := (x -> y)
+  (at level 90, y at level 200, right associativity): type_scope.
+
 Notation "x ↔ y" := (x <-> y) (at level 95, no associativity): type_scope.
 Notation "¬ x" := (~x) (at level 75, right associativity) : type_scope.
 Notation "x ≠ y" := (x <> y) (at level 70) : type_scope.
diff --git a/theories/Vectors/Fin.v b/theories/Vectors/Fin.v
new file mode 100644
index 00000000..a5e37f34
--- /dev/null
+++ b/theories/Vectors/Fin.v
@@ -0,0 +1,184 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+Require Arith_base.
+
+(** [fin n] is a convinient way to represent \[1 .. n\]
+
+[fin n] can be seen as a n-uplet of unit where [F1] is the first element of
+the n-uplet and [FS] set (n-1)-uplet of all the element but the first.
+
+   Author: Pierre Boutillier
+   Institution: PPS, INRIA 12/2010-01/2012
+*)
+
+Inductive t : nat -> Set :=
+|F1 : forall {n}, t (S n)
+|FS : forall {n}, t n -> t (S n).
+
+Section SCHEMES.
+Definition case0 P (p: t 0): P p :=
+  match p as p' in t n return
+    match n as n' return t n' -> Type
+  with |0 => fun f0 => P f0 |S _ => fun _ => @ID end p'
+  with |F1 _ => @id |FS _ _ => @id end.
+
+Definition caseS (P: forall {n}, t (S n) -> Type)
+  (P1: forall n, @P n F1) (PS : forall {n} (p: t n), P (FS p))
+  {n} (p: t (S n)): P p :=
+  match p with
+  |F1 k => P1 k
+  |FS k pp => PS pp
+  end.
+
+Definition rectS (P: forall {n}, t (S n) -> Type)
+  (P1: forall n, @P n F1) (PS : forall {n} (p: t (S n)), P p -> P (FS p)):
+  forall {n} (p: t (S n)), P p :=
+fix rectS_fix {n} (p: t (S n)): P p:=
+  match p with
+  |F1 k => P1 k
+  |FS 0 pp => case0 (fun f => P (FS f)) pp
+  |FS (S k) pp => PS pp (rectS_fix pp)
+  end.
+
+Definition rect2 (P: forall {n} (a b: t n), Type)
+  (H0: forall n, @P (S n) F1 F1)
+  (H1: forall {n} (f: t n), P F1 (FS f))
+  (H2: forall {n} (f: t n), P (FS f) F1)
+  (HS: forall {n} (f g : t n), P f g -> P (FS f) (FS g)):
+    forall {n} (a b: t n), P a b :=
+fix rect2_fix {n} (a: t n): forall (b: t n), P a b :=
+match a with
+  |F1 m => fun (b: t (S m)) => match b as b' in t n'
+                   return match n',b' with
+                            |0,_ => @ID
+                            |S n0,b0 => P F1 b0
+                          end with
+                     |F1 m' => H0 m'
+                     |FS m' b' => H1 b'
+                   end
+  |FS m a' => fun (b: t (S m)) => match b with
+                         |F1 m' => fun aa: t m' => H2 aa
+                         |FS m' b' => fun aa: t m' => HS aa b' (rect2_fix aa b')
+                       end a'
+end.
+End SCHEMES.
+
+Definition FS_inj {n} (x y: t n) (eq: FS x = FS y): x = y :=
+match eq in _ = a return
+  match a as a' in t m return match m with |0 => Prop |S n' => t n' -> Prop end
+  with @F1 _ =>  fun _ => True |@FS _ y => fun x' => x' = y end x with
+  eq_refl => eq_refl
+end.
+
+(** [to_nat f] = p iff [f] is the p{^ th} element of [fin m]. *)
+Fixpoint to_nat {m} (n : t m) : {i | i < m} :=
+  match n in t k return {i | i< k} with
+    |F1 j => exist (fun i => i< S j) 0 (Lt.lt_0_Sn j)
+    |FS _ p => match to_nat p with |exist i P => exist _ (S i) (Lt.lt_n_S _ _ P) end
+  end.
+
+(** [of_nat p n] answers the p{^ th} element of [fin n] if p < n or a proof of
+p >= n else *)
+Fixpoint of_nat (p n : nat) : (t n) + { exists m, p = n + m } :=
+  match n with
+   |0 => inright _ (ex_intro (fun x => p = 0 + x) p (@eq_refl _ p))
+   |S n' => match p with
+      |0 => inleft _ (F1)
+      |S p' => match of_nat p' n' with
+        |inleft f => inleft _ (FS f)
+        |inright arg => inright _ (match arg with |ex_intro m e =>
+          ex_intro (fun x => S p' = S n' + x) m (f_equal S e) end)
+      end
+    end
+  end.
+
+(** [of_nat_lt p n H] answers the p{^ th} element of [fin n]
+it behaves much better than [of_nat p n] on open term *)
+Fixpoint of_nat_lt {p n : nat} : p < n -> t n :=
+  match n with
+    |0 => fun H : p < 0 => False_rect _ (Lt.lt_n_O p H)
+    |S n' => match p with
+      |0 => fun _ => @F1 n'
+      |S p' => fun H => FS (of_nat_lt (Lt.lt_S_n _ _ H))
+    end
+  end.
+
+Lemma of_nat_to_nat_inv {m} (p : t m) : of_nat_lt (proj2_sig (to_nat p)) = p.
+Proof.
+induction p.
+ reflexivity.
+ simpl; destruct (to_nat p). simpl. subst p; repeat f_equal. apply Peano_dec.le_unique.
+Qed.
+
+(** [weak p f] answers a function witch is the identity for the p{^  th} first
+element of [fin (p + m)] and [FS (FS .. (FS (f k)))] for [FS (FS .. (FS k))]
+with p FSs *)
+Fixpoint weak {m}{n} p (f : t m -> t n) :
+  t (p + m) -> t (p + n) :=
+match p as p' return t (p' + m) -> t (p' + n) with
+  |0 => f
+  |S p' => fun x => match x with
+     |F1 n' => fun eq : n' = p' + m => F1
+     |FS n' y => fun eq : n' = p' + m => FS (weak p' f (eq_rect _ t y _ eq))
+  end (eq_refl _)
+end.
+
+(** The p{^ th} element of [fin m] viewed as the p{^ th} element of
+[fin (m + n)] *)
+Fixpoint L {m} n (p : t m) : t (m + n) :=
+  match p with |F1 _ => F1 |FS _ p' => FS (L n p') end.
+
+Lemma L_sanity {m} n (p : t m) : proj1_sig (to_nat (L n p)) = proj1_sig (to_nat p).
+Proof.
+induction p.
+  reflexivity.
+  simpl; destruct (to_nat (L n p)); simpl in *; rewrite IHp. now destruct (to_nat p).
+Qed.
+
+(** The p{^ th} element of [fin m] viewed as the p{^ th} element of
+[fin (n + m)]
+Really really ineficient !!! *)
+Definition L_R {m} n (p : t m) : t (n + m).
+induction n.
+  exact p.
+  exact ((fix LS k (p: t k) :=
+    match p with
+      |F1 k' => @F1 (S k')
+      |FS _ p' => FS (LS _ p')
+    end) _ IHn).
+Defined.
+
+(** The p{^ th} element of [fin m] viewed as the (n + p){^ th} element of
+[fin (n + m)] *)
+Fixpoint R {m} n (p : t m) : t (n + m) :=
+  match n with |0 => p |S n' => FS (R n' p) end.
+
+Lemma R_sanity {m} n (p : t m) : proj1_sig (to_nat (R n p)) = n + proj1_sig (to_nat p).
+Proof.
+induction n.
+  reflexivity.
+  simpl; destruct (to_nat (R n p)); simpl in *; rewrite IHn. now destruct (to_nat p).
+Qed.
+
+Fixpoint depair {m n} (o : t m) (p : t n) : t (m * n) :=
+match o with
+  |F1 m' => L (m' * n) p
+  |FS m' o' => R n (depair o' p)
+end.
+
+Lemma depair_sanity {m n} (o : t m) (p : t n) :
+  proj1_sig (to_nat (depair o p)) = n * (proj1_sig (to_nat o)) + (proj1_sig (to_nat p)).
+Proof.
+induction o ; simpl.
+  rewrite L_sanity. now rewrite Mult.mult_0_r.
+
+  rewrite R_sanity. rewrite IHo.
+  rewrite Plus.plus_assoc. destruct (to_nat o); simpl; rewrite Mult.mult_succ_r.
+    now rewrite (Plus.plus_comm n).
+Qed.
diff --git a/theories/Vectors/Vector.v b/theories/Vectors/Vector.v
new file mode 100644
index 00000000..f3e5e338
--- /dev/null
+++ b/theories/Vectors/Vector.v
@@ -0,0 +1,22 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** Vectors.
+
+   Author: Pierre Boutillier
+   Institution: PPS, INRIA 12/2010
+
+Originally from the contribution bit vector by Jean Duprat (ENS Lyon).
+
+Based on contents from Util/VecUtil of the CoLoR contribution *)
+
+Require Fin.
+Require VectorDef.
+Require VectorSpec.
+Include VectorDef.
+Include VectorSpec.
diff --git a/theories/Vectors/VectorDef.v b/theories/Vectors/VectorDef.v
new file mode 100644
index 00000000..32ffcb3d
--- /dev/null
+++ b/theories/Vectors/VectorDef.v
@@ -0,0 +1,318 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** Definitions of Vectors and functions to use them
+
+   Author: Pierre Boutillier
+   Institution: PPS, INRIA 12/2010
+*)
+
+(**
+Names should be "caml name in list.ml" if exists and order of arguments
+have to be the same. complain if you see mistakes ... *)
+
+Require Import Arith_base.
+Require Vectors.Fin.
+Import EqNotations.
+Local Open Scope nat_scope.
+
+(**
+A vector is a list of size n whose elements belong to a set A. *)
+
+Inductive t A : nat -> Type :=
+  |nil : t A 0
+  |cons : forall (h:A) (n:nat), t A n -> t A (S n).
+
+Local Notation "[]" := (nil _).
+Local Notation "h :: t" := (cons _ h _ t) (at level 60, right associativity).
+
+Section SCHEMES.
+
+(** An induction scheme for non-empty vectors *)
+
+Definition rectS {A} (P:forall {n}, t A (S n) -> Type)
+ (bas: forall a: A, P (a :: []))
+ (rect: forall a {n} (v: t A (S n)), P v -> P (a :: v)) :=
+ fix rectS_fix {n} (v: t A (S n)) : P v :=
+ match v with
+ |nil => fun devil => False_rect (@ID) devil
+ |cons a 0 v =>
+   match v as vnn in t _ nn
+       return
+         match nn,vnn with
+         |0,vm =>  P (a :: vm)
+         |S _,_ => _
+         end
+     with
+     |nil => bas a
+     |_ :: _ => fun devil => False_rect (@ID) devil
+     end
+ |cons a (S nn') v => rect a v (rectS_fix v)
+ end.
+
+(** An induction scheme for 2 vectors of same length *)
+Definition rect2 {A B} (P:forall {n}, t A n -> t B n -> Type)
+  (bas : P [] []) (rect : forall {n v1 v2}, P v1 v2 ->
+    forall a b, P (a :: v1) (b :: v2)) :=
+fix rect2_fix {n} (v1:t A n):
+  forall v2 : t B n, P v1 v2 :=
+match v1 as v1' in t _ n1
+  return forall v2 : t B n1, P v1' v2 with
+  |[] => fun v2 =>
+     match v2 with
+       |[] => bas
+       |_ :: _ => fun devil => False_rect (@ID) devil
+     end
+  |h1 :: t1 => fun v2 =>
+    match v2 with
+      |[] => fun devil => False_rect (@ID) devil
+      |h2 :: t2 => fun t1' =>
+        rect (rect2_fix t1' t2) h1 h2
+    end t1
+end.
+
+(** A vector of length [0] is [nil] *)
+Definition case0 {A} (P:t A 0 -> Type) (H:P (nil A)) v:P v :=
+match v with
+  |[] => H
+end.
+
+(** A vector of length [S _] is [cons] *)
+Definition caseS {A} (P : forall {n}, t A (S n) -> Type)
+  (H : forall h {n} t, @P n (h :: t)) {n} (v: t A (S n)) : P v :=
+match v as v' in t _ m return match m, v' with |0, _ => False -> True |S _, v0 => P v' end with
+  |[] => fun devil => False_rect _ devil (* subterm !!! *)
+  |h :: t => H h t
+end.
+End SCHEMES.
+
+Section BASES.
+(** The first element of a non empty vector *)
+Definition hd {A} {n} (v:t A (S n)) := Eval cbv delta beta in
+(caseS (fun n v => A) (fun h n t => h) v).
+
+(** The last element of an non empty vector *)
+Definition last {A} {n} (v : t A (S n)) := Eval cbv delta in
+(rectS (fun _ _ => A) (fun a => a) (fun _ _ _ H => H) v).
+
+(** Build a vector of n{^ th} [a] *)
+Fixpoint const {A} (a:A) (n:nat) :=
+  match n return t A n with
+  | O => nil A
+  | S n => a :: (const a n)
+  end.
+
+(** The [p]{^ th} element of a vector of length [m].
+
+Computational behavior of this function should be the same as
+ocaml function. *)
+Definition nth {A} := 
+fix nth_fix {m} (v' : t A m) (p : Fin.t m) {struct v'} : A :=
+match p in Fin.t m' return t A m' -> A with
+ |Fin.F1 q => fun v => caseS (fun n v' => A) (fun h n t => h) v
+ |Fin.FS q p' => fun v => (caseS (fun n v' => Fin.t n -> A)
+   (fun h n t p0 => nth_fix t p0) v) p'
+end v'.
+
+(** An equivalent definition of [nth]. *)
+Definition nth_order {A} {n} (v: t A n) {p} (H: p < n) :=
+(nth v (Fin.of_nat_lt H)).
+
+(** Put [a] at the p{^ th} place of [v] *)
+Fixpoint replace {A n} (v : t A n) (p: Fin.t n) (a : A) {struct p}: t A n :=
+  match p with
+  |Fin.F1 k => fun v': t A (S k) => caseS (fun n _ => t A (S n)) (fun h _ t => a :: t) v'
+  |Fin.FS k p' => fun v' =>
+    (caseS (fun n _ => Fin.t n -> t A (S n)) (fun h _ t p2 => h :: (replace t p2 a)) v') p'
+  end v.
+
+(** Version of replace with [lt] *)
+Definition replace_order {A n} (v: t A n) {p} (H: p < n) :=
+replace v (Fin.of_nat_lt H).
+
+(** Remove the first element of a non empty vector *)
+Definition tl {A} {n} (v:t A (S n)) := Eval cbv delta beta in
+(caseS (fun n v => t A n) (fun h n t => t) v).
+
+(** Remove last element of a non-empty vector *)
+Definition shiftout {A} {n:nat} (v:t A (S n)) : t A n :=
+Eval cbv delta beta in (rectS (fun n _ => t A n) (fun a => [])
+  (fun h _ _ H => h :: H) v).
+
+(** Add an element at the end of a vector *)
+Fixpoint shiftin {A} {n:nat} (a : A) (v:t A n) : t A (S n) :=
+match v with
+  |[] => a :: []
+  |h :: t => h :: (shiftin a t)
+end.
+
+(** Copy last element of a vector *)
+Definition shiftrepeat {A} {n} (v:t A (S n)) : t A (S (S n)) :=
+Eval cbv delta beta in (rectS (fun n _ => t A (S (S n)))
+  (fun h =>  h :: h :: []) (fun h _ _ H => h :: H) v).
+
+(** Remove [p] last elements of a vector *)
+Lemma trunc : forall {A} {n} (p:nat), n > p -> t A n
+  -> t A (n - p).
+Proof.
+  induction p as [| p f]; intros H v.
+  rewrite <- minus_n_O.
+  exact v.
+
+  apply shiftout.
+
+  rewrite minus_Sn_m.
+  apply f.
+  auto with *.
+  exact v.
+  auto with *.
+Defined.
+
+(** Concatenation of two vectors *)
+Fixpoint append {A}{n}{p} (v:t A n) (w:t A p):t A (n+p) :=
+  match v with
+  | [] => w
+  | a :: v' => a :: (append v' w)
+  end.
+
+Infix "++" := append.
+
+(** Two definitions of the tail recursive function that appends two lists but
+reverses the first one *)
+
+(** This one has the exact expected computational behavior *)
+Fixpoint rev_append_tail {A n p} (v : t A n) (w: t A p)
+  : t A (tail_plus n p) :=
+  match v with
+  | [] => w
+  | a :: v' => rev_append_tail v' (a :: w)
+  end.
+
+Import EqdepFacts.
+
+(** This one has a better type *)
+Definition rev_append {A n p} (v: t A n) (w: t A p)
+  :t A (n + p) :=
+  rew <- (plus_tail_plus n p) in (rev_append_tail v w).
+
+(** rev [a₁ ; a₂ ; .. ; an] is [an ; a{n-1} ; .. ; a₁]
+
+Caution : There is a lot of rewrite garbage in this definition *)
+Definition rev {A n} (v : t A n) : t A n :=
+ rew <- (plus_n_O _) in (rev_append v []).
+
+End BASES.
+Local Notation "v [@ p ]" := (nth v p) (at level 1).
+
+Section ITERATORS.
+(** * Here are special non dependent useful instantiation of induction
+schemes *)
+
+(** Uniform application on the arguments of the vector *)
+Definition map {A} {B} (f : A -> B) : forall {n} (v:t A n), t B n :=
+  fix map_fix {n} (v : t A n) : t B n := match v with
+  | [] => []
+  | a :: v' => (f a) :: (map_fix v')
+  end.
+
+(** map2 g [x1 .. xn] [y1 .. yn] = [(g x1 y1) .. (g xn yn)] *)
+Definition map2 {A B C} (g:A -> B -> C) {n} (v1:t A n) (v2:t B n)
+  : t C n :=
+Eval cbv delta beta in rect2 (fun n _ _ => t C n) (nil C)
+  (fun _ _ _ H a b => (g a b) :: H) v1 v2.
+
+(** fold_left f b [x1 .. xn] = f .. (f (f b x1) x2) .. xn *)
+Definition fold_left {A B:Type} (f:B->A->B): forall (b:B) {n} (v:t A n), B :=
+  fix fold_left_fix (b:B) {n} (v : t A n) : B := match v with
+    | [] => b
+    | a :: w => (fold_left_fix (f b a) w)
+  end.
+
+(** fold_right f [x1 .. xn] b = f x1 (f x2 .. (f xn b) .. ) *)
+Definition fold_right {A B : Type} (f : A->B->B) :=
+  fix fold_right_fix {n} (v : t A n) (b:B)
+  {struct v} : B :=
+  match v with
+    | [] => b
+    | a :: w => f a (fold_right_fix w b)
+  end.
+
+(** fold_right2 g [x1 .. xn] [y1 .. yn] c = g x1 y1 (g x2 y2 .. (g xn yn c) .. ) *)
+Definition fold_right2 {A B C} (g:A -> B -> C -> C) {n} (v:t A n)
+  (w : t B n) (c:C) : C :=
+Eval cbv delta beta in rect2 (fun _ _ _ => C) c
+  (fun _ _ _ H a b => g a b H) v w.
+
+(** fold_left2 f b [x1 .. xn] [y1 .. yn] = g .. (g (g a x1 y1) x2 y2) .. xn yn *)
+Definition fold_left2 {A B C: Type} (f : A -> B -> C -> A) :=
+fix fold_left2_fix (a : A) {n} (v : t B n) : t C n -> A :=
+match v in t _ n0 return t C n0 -> A with
+  |[] => fun w => match w in t _ n1
+    return match n1 with |0 => A |S _ => @ID end with
+    |[] => a
+    |_ :: _ => @id end
+  |cons vh vn vt => fun w => match w in t _ n1
+    return match n1 with |0 => @ID |S n => t B n -> A end with
+    |[] => @id
+    |wh :: wt => fun vt' => fold_left2_fix (f a vh wh) vt' wt end vt
+end.
+
+End ITERATORS.
+
+Section SCANNING.
+Inductive Forall {A} (P: A -> Prop): forall {n} (v: t A n), Prop :=
+ |Forall_nil: Forall P []
+ |Forall_cons {n} x (v: t A n): P x -> Forall P v -> Forall P (x::v).
+Hint Constructors Forall.
+
+Inductive Exists {A} (P:A->Prop): forall {n}, t A n -> Prop :=
+ |Exists_cons_hd {m} x (v: t A m): P x -> Exists P (x::v)
+ |Exists_cons_tl {m} x (v: t A m): Exists P v -> Exists P (x::v).
+Hint Constructors Exists.
+
+Inductive In {A} (a:A): forall {n}, t A n -> Prop :=
+ |In_cons_hd {m} (v: t A m): In a (a::v)
+ |In_cons_tl {m} x (v: t A m): In a v -> In a (x::v).
+Hint Constructors In.
+
+Inductive Forall2 {A B} (P:A->B->Prop): forall {n}, t A n -> t B n -> Prop :=
+ |Forall2_nil: Forall2 P [] []
+ |Forall2_cons {m} x1 x2 (v1:t A m) v2: P x1 x2 -> Forall2 P v1 v2 ->
+    Forall2 P (x1::v1) (x2::v2).
+Hint Constructors Forall2.
+
+Inductive Exists2 {A B} (P:A->B->Prop): forall {n}, t A n -> t B n -> Prop :=
+ |Exists2_cons_hd {m} x1 x2 (v1: t A m) (v2: t B m): P x1 x2 -> Exists2 P (x1::v1) (x2::v2)
+ |Exists2_cons_tl {m} x1 x2 (v1:t A m) v2: Exists2 P v1 v2 -> Exists2 P (x1::v1) (x2::v2).
+Hint Constructors Exists2.
+
+End SCANNING.
+
+Section VECTORLIST.
+(** * vector <=> list functions *)
+
+Fixpoint of_list {A} (l : list A) : t A (length l) :=
+match l as l' return t A (length l') with
+  |Datatypes.nil => []
+  |(h :: tail)%list => (h :: (of_list tail))
+end.
+
+Definition to_list {A}{n} (v : t A n) : list A :=
+Eval cbv delta beta in fold_right (fun h H => Datatypes.cons h H) v Datatypes.nil.
+End VECTORLIST.
+
+Module VectorNotations.
+Notation "[]" := [] : vector_scope.
+Notation "h :: t" := (h :: t) (at level 60, right associativity)
+  : vector_scope.
+Notation " [ x ] " := (x :: []) : vector_scope.
+Notation " [ x ; .. ; y ] " := (cons _ x _ .. (cons _ y _ (nil _)) ..) : vector_scope
+.
+Notation "v [@ p ]" := (nth v p) (at level 1, format "v [@ p ]") : vector_scope.
+Open Scope vector_scope.
+End VectorNotations.
diff --git a/theories/Vectors/VectorSpec.v b/theories/Vectors/VectorSpec.v
new file mode 100644
index 00000000..2f4086e5
--- /dev/null
+++ b/theories/Vectors/VectorSpec.v
@@ -0,0 +1,119 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** Proofs of specification for functions defined over Vector
+
+   Author: Pierre Boutillier
+   Institution: PPS, INRIA 12/2010
+*)
+
+Require Fin.
+Require Import VectorDef.
+Import VectorNotations.
+
+Definition cons_inj A a1 a2 n (v1 v2 : t A n)
+ (eq : a1 :: v1 = a2 :: v2) : a1 = a2 /\ v1 = v2 :=
+   match eq in _ = x return caseS _ (fun a2' _ v2' => fun v1' => a1 = a2' /\ v1' = v2') x v1
+   with | eq_refl => conj eq_refl eq_refl
+   end.
+
+(** Lemmas are done for functions that use [Fin.t] but thanks to [Peano_dec.le_unique], all
+is true for the one that use [lt] *)
+
+Lemma eq_nth_iff A n (v1 v2: t A n):
+  (forall p1 p2, p1 = p2 -> v1 [@ p1 ] = v2 [@ p2 ]) <-> v1 = v2.
+Proof.
+split.
+  revert n v1 v2; refine (@rect2 _ _ _ _ _); simpl; intros.
+    reflexivity.
+    f_equal. apply (H0 Fin.F1 Fin.F1 eq_refl).
+    apply H. intros p1 p2 H1;
+    apply (H0 (Fin.FS p1) (Fin.FS p2) (f_equal (@Fin.FS n) H1)).
+  intros; now f_equal.
+Qed.
+
+Lemma nth_order_last A: forall n (v: t A (S n)) (H: n < S n),
+ nth_order v H = last v.
+Proof.
+unfold nth_order; refine (@rectS _ _ _ _); now simpl.
+Qed.
+
+Lemma shiftin_nth A a n (v: t A n) k1 k2 (eq: k1 = k2):
+  nth (shiftin a v) (Fin.L_R 1 k1) = nth v k2.
+Proof.
+subst k2; induction k1.
+  generalize dependent n. apply caseS ; intros. now simpl.
+  generalize dependent n. refine (@caseS _ _ _) ; intros. now simpl.
+Qed.
+
+Lemma shiftin_last A a n (v: t A n): last (shiftin a v) = a.
+Proof.
+induction v ;now simpl.
+Qed.
+
+Lemma shiftrepeat_nth A: forall n k (v: t A (S n)),
+  nth (shiftrepeat v) (Fin.L_R 1 k) = nth v k.
+Proof.
+refine (@Fin.rectS _ _ _); intros.
+  revert n v; refine (@caseS _ _ _); simpl; intros. now destruct t.
+  revert p H.
+  refine (match v as v' in t _ m return match m as m' return t A m' -> Type with
+    |S (S n) => fun v => forall p : Fin.t (S n),
+      (forall v0 : t A (S n), (shiftrepeat v0) [@ Fin.L_R 1 p ] = v0 [@p]) ->
+      (shiftrepeat v) [@Fin.L_R 1 (Fin.FS p)] = v [@Fin.FS p]
+    |_ => fun _ => @ID end v' with
+  |[] => @id |h :: t => _ end). destruct n0. exact @id. now simpl.
+Qed.
+
+Lemma shiftrepeat_last A: forall n (v: t A (S n)), last (shiftrepeat v) = last v.
+Proof.
+refine (@rectS _ _ _ _); now simpl.
+Qed.
+
+Lemma const_nth A (a: A) n (p: Fin.t n): (const a n)[@ p] = a.
+Proof.
+now induction p.
+Qed.
+
+Lemma nth_map {A B} (f: A -> B) {n} v (p1 p2: Fin.t n) (eq: p1 = p2):
+  (map f v) [@ p1] = f (v [@ p2]).
+Proof.
+subst p2; induction p1.
+  revert n v; refine (@caseS _ _ _); now simpl.
+  revert n v p1 IHp1; refine (@caseS _  _ _); now simpl.
+Qed.
+
+Lemma nth_map2 {A B C} (f: A -> B -> C) {n} v w (p1 p2 p3: Fin.t n):
+  p1 = p2 -> p2 = p3 -> (map2 f v w) [@p1] = f (v[@p2]) (w[@p3]).
+Proof.
+intros; subst p2; subst p3; revert n v w p1.
+refine (@rect2 _ _ _ _ _); simpl.
+  exact (Fin.case0 _).
+  intros n v1 v2 H a b p; revert n p v1 v2 H; refine (@Fin.caseS _ _ _);
+    now simpl.
+Qed.
+
+Lemma fold_left_right_assoc_eq {A B} {f: A -> B -> A}
+  (assoc: forall a b c, f (f a b) c = f (f a c) b)
+  {n} (v: t B n): forall a, fold_left f a v = fold_right (fun x y => f y x) v a.
+Proof.
+assert (forall n h (v: t B n) a, fold_left f (f a h) v = f (fold_left f a v) h).
+  induction v0.
+    now simpl.
+    intros; simpl. rewrite<- IHv0. now f_equal.
+  induction v.
+    reflexivity.
+    simpl. intros; now rewrite<- (IHv).
+Qed.
+
+Lemma to_list_of_list_opp {A} (l: list A): to_list (of_list l) = l.
+Proof.
+induction l.
+  reflexivity.
+  unfold to_list; simpl. now f_equal.
+Qed.
diff --git a/theories/Vectors/vo.itarget b/theories/Vectors/vo.itarget
new file mode 100644
index 00000000..7f00d016
--- /dev/null
+++ b/theories/Vectors/vo.itarget
@@ -0,0 +1,4 @@
+Fin.vo
+VectorDef.vo
+VectorSpec.vo
+Vector.vo
diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v
index ccfef1e6..8f5c0957 100644
--- a/theories/Wellfounded/Disjoint_Union.v
+++ b/theories/Wellfounded/Disjoint_Union.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Disjoint_Union.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Author: Cristina Cornes
     From : Constructing Recursion Operators in Type Theory
            L. Paulson  JSC (1986) 2, 325-355 *)
@@ -43,7 +41,7 @@ Section Wf_Disjoint_Union.
     well_founded leA -> well_founded leB -> well_founded Le_AsB.
   Proof.
     intros.
-    unfold well_founded in |- *.
+    unfold well_founded.
     destruct a as [a| b].
     apply (acc_A_sum a).
     apply (H a).
diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v
index fad1978e..c7cc29b5 100644
--- a/theories/Wellfounded/Inclusion.v
+++ b/theories/Wellfounded/Inclusion.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Inclusion.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Author: Bruno Barras *)
 
 Require Import Relation_Definitions.
@@ -26,7 +24,7 @@ Section WfInclusion.
 
   Theorem wf_incl : inclusion A R1 R2 -> well_founded R2 -> well_founded R1.
   Proof.
-    unfold well_founded in |- *; auto with sets.
+    unfold well_founded; auto with sets.
   Qed.
 
 End WfInclusion.
diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v
index 204cff19..e38b2157 100644
--- a/theories/Wellfounded/Inverse_Image.v
+++ b/theories/Wellfounded/Inverse_Image.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Inverse_Image.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Author: Bruno Barras *)
 
 Section Inverse_Image.
@@ -33,7 +31,7 @@ Section Inverse_Image.
 
   Theorem wf_inverse_image : well_founded R -> well_founded Rof.
   Proof.
-    red in |- *; intros; apply Acc_inverse_image; auto.
+    red; intros; apply Acc_inverse_image; auto.
   Qed.
 
   Variable F : A -> B -> Prop.
@@ -51,7 +49,7 @@ Section Inverse_Image.
 
   Theorem wf_inverse_rel : well_founded R -> well_founded RoF.
   Proof.
-    red in |- *; constructor; intros.
+    red; constructor; intros.
     case H0; intros.
     apply (Acc_inverse_rel x); auto.
   Qed.
diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v
index bc8803ad..13db01a3 100644
--- a/theories/Wellfounded/Lexicographic_Exponentiation.v
+++ b/theories/Wellfounded/Lexicographic_Exponentiation.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Lexicographic_Exponentiation.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Author: Cristina Cornes
 
     From : Constructing Recursion Operators in Type Theory
@@ -38,11 +36,11 @@ Section Wf_Lexicographic_Exponentiation.
   Proof.
     simple induction x.
     simple induction z.
-    simpl in |- *; intros H.
+    simpl; intros H.
     inversion_clear H.
-    simpl in |- *; intros; apply (Lt_nil A leA).
+    simpl; intros; apply (Lt_nil A leA).
     intros a l HInd.
-    simpl in |- *.
+    simpl.
     intros.
     inversion_clear H.
     apply (Lt_hd A leA); auto with sets.
@@ -56,7 +54,7 @@ Section Wf_Lexicographic_Exponentiation.
       ltl x (y ++ z) -> ltl x y \/ (exists y' : List, x = y ++ y' /\ ltl y' z).
   Proof.
     intros x y; generalize x.
-    elim y; simpl in |- *.
+    elim y; simpl.
     right.
     exists x0; auto with sets.
     intros.
@@ -198,7 +196,7 @@ Section Wf_Lexicographic_Exponentiation.
           Descl x0 /\ Descl (l0 ++ Cons x1 Nil)).
 
 
-    simpl in |- *.
+    simpl.
     split.
     generalize (app_inj_tail _ _ _ _ H2); simple induction 1.
     simple induction 1; auto with sets.
@@ -241,7 +239,7 @@ Section Wf_Lexicographic_Exponentiation.
   Proof.
     intros a b x.
     case x.
-    simpl in |- *.
+    simpl.
     simple induction 1.
     intros.
     inversion H1; auto with sets.
@@ -269,7 +267,7 @@ Section Wf_Lexicographic_Exponentiation.
     case x.
     intros; apply (Lt_nil A leA).
 
-    simpl in |- *; intros.
+    simpl; intros.
     inversion_clear H0.
     apply (Lt_hd A leA a b); auto with sets.
 
@@ -286,17 +284,17 @@ Section Wf_Lexicographic_Exponentiation.
     apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)).
     auto with sets.
 
-    unfold lex_exp in |- *; simpl in |- *; auto with sets.
+    unfold lex_exp; simpl; auto with sets.
   Qed.
 
 
   Theorem wf_lex_exp : well_founded leA -> well_founded Lex_Exp.
   Proof.
-    unfold well_founded at 2 in |- *.
+    unfold well_founded at 2.
     simple induction a; intros x y.
     apply Acc_intro.
     simple induction y0.
-    unfold lex_exp at 1 in |- *; simpl in |- *.
+    unfold lex_exp at 1; simpl.
     apply rev_ind with
       (A := A)
       (P := fun x:List =>
@@ -337,8 +335,8 @@ Section Wf_Lexicographic_Exponentiation.
     intro.
     apply Acc_intro.
     simple induction y2.
-    unfold lex_exp at 1 in |- *.
-    simpl in |- *; intros x4 y3. intros.
+    unfold lex_exp at 1.
+    simpl; intros x4 y3. intros.
     apply (H0 x4 y3); auto with sets.
 
     intros.
@@ -359,7 +357,7 @@ Section Wf_Lexicographic_Exponentiation.
     generalize (HInd2 f); intro.
     apply Acc_intro.
     simple induction y3.
-    unfold lex_exp at 1 in |- *; simpl in |- *; intros.
+    unfold lex_exp at 1; simpl; intros.
     apply H15; auto with sets.
   Qed.
 
diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v
index e0f0cc8f..c3e8c92c 100644
--- a/theories/Wellfounded/Lexicographic_Product.v
+++ b/theories/Wellfounded/Lexicographic_Product.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Lexicographic_Product.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Authors: Bruno Barras, Cristina Cornes *)
 
 Require Import Eqdep.
@@ -29,7 +27,7 @@ Section WfLexicographic_Product.
     forall x:A,
       Acc leA x ->
       (forall x0:A, clos_trans A leA x0 x -> well_founded (leB x0)) ->
-      forall y:B x, Acc (leB x) y -> Acc LexProd (existS B x y).
+      forall y:B x, Acc (leB x) y -> Acc LexProd (existT B x y).
   Proof.
     induction 1 as [x _ IHAcc]; intros H2 y.
     induction 1 as [x0 H IHAcc0]; intros.
@@ -56,18 +54,18 @@ Section WfLexicographic_Product.
     subst x1.
     apply IHAcc0.
     elim inj_pair2 with A B x y' x0; assumption.
-  Qed.
+  Defined.
 
   Theorem wf_lexprod :
     well_founded leA ->
     (forall x:A, well_founded (leB x)) -> well_founded LexProd.
   Proof.
-    intros wfA wfB; unfold well_founded in |- *.
+    intros wfA wfB; unfold well_founded.
     destruct a.
     apply acc_A_B_lexprod; auto with sets; intros.
     red in wfB.
     auto with sets.
-  Qed.
+  Defined.
 
 
 End WfLexicographic_Product.
@@ -90,16 +88,16 @@ Section Wf_Symmetric_Product.
     inversion_clear H5; auto with sets.
     apply IHAcc; auto.
     apply Acc_intro; trivial.
-  Qed.
+  Defined.
 
 
   Lemma wf_symprod :
     well_founded leA -> well_founded leB -> well_founded Symprod.
   Proof.
-    red in |- *.
+    red.
     destruct a.
     apply Acc_symprod; auto with sets.
-  Qed.
+  Defined.
 
 End Wf_Symmetric_Product.
 
@@ -130,7 +128,7 @@ Section Swap.
 
     apply sp_noswap.
     apply left_sym; auto with sets.
-  Qed.
+  Defined.
 
 
   Lemma Acc_swapprod :
@@ -158,14 +156,14 @@ Section Swap.
     apply right_sym; auto with sets.
 
     auto with sets.
-  Qed.
+  Defined.
 
 
   Lemma wf_swapprod : well_founded R -> well_founded SwapProd.
   Proof.
-    red in |- *.
+    red.
     destruct a; intros.
     apply Acc_swapprod; auto with sets.
-  Qed.
+  Defined.
 
 End Swap.
diff --git a/theories/Wellfounded/Transitive_Closure.v b/theories/Wellfounded/Transitive_Closure.v
index 59832b1b..943840cd 100644
--- a/theories/Wellfounded/Transitive_Closure.v
+++ b/theories/Wellfounded/Transitive_Closure.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Transitive_Closure.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Author: Bruno Barras *)
 
 Require Import Relation_Definitions.
@@ -20,7 +18,7 @@ Section Wf_Transitive_Closure.
   Notation trans_clos := (clos_trans A R).
 
   Lemma incl_clos_trans : inclusion A R trans_clos.
-    red in |- *; auto with sets.
+    red; auto with sets.
   Qed.
 
   Lemma Acc_clos_trans : forall x:A, Acc R x -> Acc trans_clos x.
@@ -41,7 +39,7 @@ Section Wf_Transitive_Closure.
 
   Theorem wf_clos_trans : well_founded R -> well_founded trans_clos.
   Proof.
-    unfold well_founded in |- *; auto with sets.
+    unfold well_founded; auto with sets.
   Defined.
 
 End Wf_Transitive_Closure.
diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v
index 84d75754..5e4fec65 100644
--- a/theories/Wellfounded/Union.v
+++ b/theories/Wellfounded/Union.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Union.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Author: Bruno Barras *)
 
 Require Import Relation_Operators.
@@ -53,7 +51,7 @@ Section WfUnion.
 
     elim strip_commut with x x0 y0; auto with sets; intros.
     apply Acc_inv_trans with x1; auto with sets.
-    unfold union in |- *.
+    unfold union.
     elim H11; auto with sets; intros.
     apply t_trans with y1; auto with sets.
 
@@ -67,7 +65,7 @@ Section WfUnion.
   Theorem wf_union :
     commut A R1 R2 -> well_founded R1 -> well_founded R2 -> well_founded Union.
   Proof.
-    unfold well_founded in |- *.
+    unfold well_founded.
     intros.
     apply Acc_union; auto with sets.
   Qed.
diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v
index cec21555..df6d9ed6 100644
--- a/theories/Wellfounded/Well_Ordering.v
+++ b/theories/Wellfounded/Well_Ordering.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Well_Ordering.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Author: Cristina Cornes.
     From: Constructing Recursion Operators in Type Theory
     L. Paulson  JSC (1986) 2, 325-355 *)
@@ -27,7 +25,7 @@ Section WellOrdering.
 
   Theorem wf_WO : well_founded le_WO.
   Proof.
-    unfold well_founded in |- *; intro.
+    unfold well_founded; intro.
     apply Acc_intro.
     elim a.
     intros.
@@ -39,7 +37,7 @@ Section WellOrdering.
     apply (H v0 y0).
     cut (f = f1).
     intros E; rewrite E; auto.
-    symmetry  in |- *.
+    symmetry .
     apply (inj_pair2 A (fun a0:A => B a0 -> WO) a0 f1 f H5).
   Qed.
 
@@ -63,7 +61,7 @@ Section Characterisation_wf_relations.
     apply (well_founded_induction_type H (fun a:A => WO A B)); auto.
     intros x H1.
     apply (sup A B x).
-    unfold B at 1 in |- *.
+    unfold B at 1.
     destruct 1 as [x0].
     apply (H1 x0); auto.
 Qed.
diff --git a/theories/Wellfounded/Wellfounded.v b/theories/Wellfounded/Wellfounded.v
index 03b7b210..b8c6653b 100644
--- a/theories/Wellfounded/Wellfounded.v
+++ b/theories/Wellfounded/Wellfounded.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Wellfounded.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Export Disjoint_Union.
 Require Export Inclusion.
 Require Export Inverse_Image.
diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v
index e2b89d84..eeec9042 100644
--- a/theories/ZArith/BinInt.v
+++ b/theories/ZArith/BinInt.v
@@ -1,1158 +1,1759 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: BinInt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+Require Export BinNums BinPos Pnat.
+Require Import BinNat Bool Plus Mult Equalities GenericMinMax
+ OrdersFacts ZAxioms ZProperties.
+Require BinIntDef.
 
 (***********************************************************)
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
+(** * Binary Integers *)
 (***********************************************************)
 
-Require Export BinPos.
-Require Export Pnat.
-Require Import BinNat.
-Require Import Plus.
-Require Import Mult.
-
-Unset Boxed Definitions.
-
-(*****************************)
-(** * Binary integer numbers *)
-
-Inductive Z : Set :=
-  | Z0 : Z
-  | Zpos : positive -> Z
-  | Zneg : positive -> Z.
-
-
-(** Automatically open scope positive_scope for the constructors of Z *)
-Delimit Scope Z_scope with Z.
-Bind Scope Z_scope with Z.
-Arguments Scope Zpos [positive_scope].
-Arguments Scope Zneg [positive_scope].
-
-(** ** Subtraction of positive into Z *)
-
-Definition Zdouble_plus_one (x:Z) :=
-  match x with
-    | Z0 => Zpos 1
-    | Zpos p => Zpos p~1
-    | Zneg p => Zneg (Pdouble_minus_one p)
-  end.
-
-Definition Zdouble_minus_one (x:Z) :=
-  match x with
-    | Z0 => Zneg 1
-    | Zneg p => Zneg p~1
-    | Zpos p => Zpos (Pdouble_minus_one p)
-  end.
-
-Definition Zdouble (x:Z) :=
-  match x with
-    | Z0 => Z0
-    | Zpos p => Zpos p~0
-    | Zneg p => Zneg p~0
-  end.
-
-Open Local Scope positive_scope.
-
-Fixpoint ZPminus (x y:positive) {struct y} : Z :=
-  match x, y with
-    | p~1, q~1 => Zdouble (ZPminus p q)
-    | p~1, q~0 => Zdouble_plus_one (ZPminus p q)
-    | p~1, 1 => Zpos p~0
-    | p~0, q~1 => Zdouble_minus_one (ZPminus p q)
-    | p~0, q~0 => Zdouble (ZPminus p q)
-    | p~0, 1 => Zpos (Pdouble_minus_one p)
-    | 1, q~1 => Zneg q~0
-    | 1, q~0 => Zneg (Pdouble_minus_one q)
-    | 1, 1 => Z0
-  end.
-
-Close Local Scope positive_scope.
-
-(** ** Addition on integers *)
-
-Definition Zplus (x y:Z) :=
-  match x, y with
-    | Z0, y => y
-    | Zpos x', Z0 => Zpos x'
-    | Zneg x', Z0 => Zneg x'
-    | Zpos x', Zpos y' => Zpos (x' + y')
-    | Zpos x', Zneg y' =>
-      match (x' ?= y')%positive Eq with
-	| Eq => Z0
-	| Lt => Zneg (y' - x')
-	| Gt => Zpos (x' - y')
-      end
-    | Zneg x', Zpos y' =>
-      match (x' ?= y')%positive Eq with
-	| Eq => Z0
-	| Lt => Zpos (y' - x')
-	| Gt => Zneg (x' - y')
-      end
-    | Zneg x', Zneg y' => Zneg (x' + y')
-  end.
-
-Infix "+" := Zplus : Z_scope.
-
-(** ** Opposite *)
-
-Definition Zopp (x:Z) :=
-  match x with
-    | Z0 => Z0
-    | Zpos x => Zneg x
-    | Zneg x => Zpos x
-  end.
-
-Notation "- x" := (Zopp x) : Z_scope.
-
-(** ** Successor on integers *)
-
-Definition Zsucc (x:Z) := (x + Zpos 1)%Z.
-
-(** ** Predecessor on integers *)
-
-Definition Zpred (x:Z) := (x + Zneg 1)%Z.
-
-(** ** Subtraction on integers *)
-
-Definition Zminus (m n:Z) := (m + - n)%Z.
-
-Infix "-" := Zminus : Z_scope.
-
-(** ** Multiplication on integers *)
-
-Definition Zmult (x y:Z) :=
-  match x, y with
-    | Z0, _ => Z0
-    | _, Z0 => Z0
-    | Zpos x', Zpos y' => Zpos (x' * y')
-    | Zpos x', Zneg y' => Zneg (x' * y')
-    | Zneg x', Zpos y' => Zneg (x' * y')
-    | Zneg x', Zneg y' => Zpos (x' * y')
-  end.
-
-Infix "*" := Zmult : Z_scope.
-
-(** ** Comparison of integers *)
-
-Definition Zcompare (x y:Z) :=
-  match x, y with
-    | Z0, Z0 => Eq
-    | Z0, Zpos y' => Lt
-    | Z0, Zneg y' => Gt
-    | Zpos x', Z0 => Gt
-    | Zpos x', Zpos y' => (x' ?= y')%positive Eq
-    | Zpos x', Zneg y' => Gt
-    | Zneg x', Z0 => Lt
-    | Zneg x', Zpos y' => Lt
-    | Zneg x', Zneg y' => CompOpp ((x' ?= y')%positive Eq)
-  end.
-
-Infix "?=" := Zcompare (at level 70, no associativity) : Z_scope.
+(** Initial author: Pierre Crégut, CNET, Lannion, France *)
 
-Ltac elim_compare com1 com2 :=
-  case (Dcompare (com1 ?= com2)%Z);
-    [ idtac | let x := fresh "H" in
-      (intro x; case x; clear x) ].
+(** The type [Z] and its constructors [Z0] and [Zpos] and [Zneg]
+    are now defined in [BinNums.v] *)
 
-(** ** Sign function *)
+Local Open Scope Z_scope.
 
-Definition Zsgn (z:Z) : Z :=
-  match z with
-    | Z0 => Z0
-    | Zpos p => Zpos 1
-    | Zneg p => Zneg 1
-  end.
+(** Every definitions and early properties about binary integers
+    are placed in a module [Z] for qualification purpose. *)
 
-(** ** Direct, easier to handle variants of successor and addition *)
+Module Z
+ <: ZAxiomsSig
+ <: UsualOrderedTypeFull
+ <: UsualDecidableTypeFull
+ <: TotalOrder.
 
-Definition Zsucc' (x:Z) :=
-  match x with
-    | Z0 => Zpos 1
-    | Zpos x' => Zpos (Psucc x')
-    | Zneg x' => ZPminus 1 x'
-  end.
+(** * Definitions of operations, now in a separate file *)
 
-Definition Zpred' (x:Z) :=
-  match x with
-    | Z0 => Zneg 1
-    | Zpos x' => ZPminus x' 1
-    | Zneg x' => Zneg (Psucc x')
-  end.
+Include BinIntDef.Z.
 
-Definition Zplus' (x y:Z) :=
-  match x, y with
-    | Z0, y => y
-    | x, Z0 => x
-    | Zpos x', Zpos y' => Zpos (x' + y')
-    | Zpos x', Zneg y' => ZPminus x' y'
-    | Zneg x', Zpos y' => ZPminus y' x'
-    | Zneg x', Zneg y' => Zneg (x' + y')
-  end.
+(** When including property functors, only inline t eq zero one two *)
 
-Open Local Scope Z_scope.
+Set Inline Level 30.
 
-(**********************************************************************)
-(** ** Inductive specification of Z *)
+(** * Logic Predicates *)
 
-Theorem Zind :
-  forall P:Z -> Prop,
-    P Z0 ->
-    (forall x:Z, P x -> P (Zsucc' x)) ->
-    (forall x:Z, P x -> P (Zpred' x)) -> forall n:Z, P n.
-Proof.
-  intros P H0 Hs Hp z; destruct z.
-  assumption.
-  apply Pind with (P := fun p => P (Zpos p)).
-    change (P (Zsucc' Z0)) in |- *; apply Hs; apply H0.
-    intro n; exact (Hs (Zpos n)).
-  apply Pind with (P := fun p => P (Zneg p)).
-    change (P (Zpred' Z0)) in |- *; apply Hp; apply H0.
-    intro n; exact (Hp (Zneg n)).
-Qed.
+Definition eq := @Logic.eq Z.
+Definition eq_equiv := @eq_equivalence Z.
 
-(**********************************************************************)
-(** * Misc properties about binary integer operations *)
+Definition lt x y := (x ?= y) = Lt.
+Definition gt x y := (x ?= y) = Gt.
+Definition le x y := (x ?= y) <> Gt.
+Definition ge x y := (x ?= y) <> Lt.
 
+Infix "<=" := le : Z_scope.
+Infix "<" := lt : Z_scope.
+Infix ">=" := ge : Z_scope.
+Infix ">" := gt : Z_scope.
 
-(**********************************************************************)
-(** ** Properties of opposite on binary integer numbers *)
+Notation "x <= y <= z" := (x <= y /\ y <= z) : Z_scope.
+Notation "x <= y < z" := (x <= y /\ y < z) : Z_scope.
+Notation "x < y < z" := (x < y /\ y < z) : Z_scope.
+Notation "x < y <= z" := (x < y /\ y <= z) : Z_scope.
+
+Definition divide x y := exists z, y = z*x.
+Notation "( x | y )" := (divide x y) (at level 0).
+
+Definition Even a := exists b, a = 2*b.
+Definition Odd a := exists b, a = 2*b+1.
 
-Theorem Zopp_0 : Zopp Z0 = Z0.
+(** * Decidability of equality. *)
+
+Definition eq_dec (x y : Z) : {x = y} + {x <> y}.
 Proof.
-  reflexivity.
+ decide equality; apply Pos.eq_dec.
+Defined.
+
+(** * Properties of [pos_sub] *)
+
+(** [pos_sub] can be written in term of positive comparison
+    and subtraction (cf. earlier definition of addition of Z) *)
+
+Lemma pos_sub_spec p q :
+ pos_sub p q =
+ match (p ?= q)%positive with
+   | Eq => 0
+   | Lt => neg (q - p)
+   | Gt => pos (p - q)
+ end.
+Proof.
+ revert q. induction p; destruct q; simpl; trivial;
+ rewrite ?Pos.compare_xI_xI, ?Pos.compare_xO_xI,
+  ?Pos.compare_xI_xO, ?Pos.compare_xO_xO, IHp; simpl;
+ case Pos.compare_spec; intros; simpl; trivial;
+  (now rewrite Pos.sub_xI_xI) || (now rewrite Pos.sub_xO_xO) ||
+  (now rewrite Pos.sub_xO_xI) || (now rewrite Pos.sub_xI_xO) ||
+  subst; unfold Pos.sub; simpl; now rewrite Pos.sub_mask_diag.
 Qed.
 
-Theorem Zopp_neg : forall p:positive, - Zneg p = Zpos p.
+Lemma pos_sub_discr p q :
+  match pos_sub p q with
+  | Z0 => p = q
+  | pos k => p = q + k
+  | neg k => q = p + k
+  end%positive.
 Proof.
-  reflexivity.
+ rewrite pos_sub_spec.
+ case Pos.compare_spec; auto; intros;
+  now rewrite Pos.add_comm, Pos.sub_add.
 Qed.
 
-(** [opp] is involutive *)
+(** Particular cases of the previous result *)
 
-Theorem Zopp_involutive : forall n:Z, - - n = n.
+Lemma pos_sub_diag p : pos_sub p p = 0.
 Proof.
-  intro x; destruct x; reflexivity.
+ now rewrite pos_sub_spec, Pos.compare_refl.
 Qed.
 
-(** Injectivity of the opposite *)
+Lemma pos_sub_lt p q : (p < q)%positive -> pos_sub p q = neg (q - p).
+Proof.
+ intros H. now rewrite pos_sub_spec, H.
+Qed.
 
-Theorem Zopp_inj : forall n m:Z, - n = - m -> n = m.
+Lemma pos_sub_gt p q : (q < p)%positive -> pos_sub p q = pos (p - q).
 Proof.
-  intros x y; case x; case y; simpl in |- *; intros;
-    [ trivial
-      | discriminate H
-      | discriminate H
-      | discriminate H
-      | simplify_eq H; intro E; rewrite E; trivial
-      | discriminate H
-      | discriminate H
-      | discriminate H
-      | simplify_eq H; intro E; rewrite E; trivial ].
+ intros H. now rewrite pos_sub_spec, Pos.compare_antisym, H.
 Qed.
 
-(**********************************************************************)
-(** ** Other properties of binary integer numbers *)
+(** The opposite of [pos_sub] is [pos_sub] with reversed arguments *)
 
-Lemma ZL0 : 2%nat = (1 + 1)%nat.
+Lemma pos_sub_opp p q : - pos_sub p q = pos_sub q p.
 Proof.
-  reflexivity.
+ revert q; induction p; destruct q; simpl; trivial;
+ rewrite <- IHp; now destruct pos_sub.
 Qed.
 
-(**********************************************************************)
-(** * Properties of the addition on integers *)
+(** In the following module, we group results that are needed now
+  to prove specifications of operations, but will also be provided
+  later by the generic functor of properties. *)
 
-(** ** Zero is left neutral for addition *)
+Module Import Private_BootStrap.
 
-Theorem Zplus_0_l : forall n:Z, Z0 + n = n.
-Proof.
-  intro x; destruct x; reflexivity.
-Qed.
+(** * Properties of addition *)
 
-(** ** Zero is right neutral for addition *)
+(** ** Zero is neutral for addition *)
 
-Theorem Zplus_0_r : forall n:Z, n + Z0 = n.
+Lemma add_0_r n : n + 0 = n.
 Proof.
-  intro x; destruct x; reflexivity.
+ now destruct n.
 Qed.
 
 (** ** Addition is commutative *)
 
-Theorem Zplus_comm : forall n m:Z, n + m = m + n.
+Lemma add_comm n m : n + m = m + n.
 Proof.
-  intro x; induction x as [| p| p]; intro y; destruct y as [| q| q];
-    simpl in |- *; try reflexivity.
-  rewrite Pplus_comm; reflexivity.
-  rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity.
-  rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity.
-  rewrite Pplus_comm; reflexivity.
+ destruct n, m; simpl; trivial; now rewrite Pos.add_comm.
 Qed.
 
 (** ** Opposite distributes over addition *)
 
-Theorem Zopp_plus_distr : forall n m:Z, - (n + m) = - n + - m.
+Lemma opp_add_distr n m : - (n + m) = - n + - m.
 Proof.
-  intro x; destruct x as [| p| p]; intro y; destruct y as [| q| q];
-    simpl in |- *; reflexivity || destruct ((p ?= q)%positive Eq);
-      reflexivity.
+ destruct n, m; simpl; trivial using pos_sub_opp.
 Qed.
 
-Theorem Zopp_succ : forall n:Z, Zopp (Zsucc n) = Zpred (Zopp n).
+(** ** Opposite is injective *)
+
+Lemma opp_inj n m : -n = -m -> n = m.
 Proof.
-intro; unfold Zsucc; now rewrite Zopp_plus_distr.
+ destruct n, m; simpl; intros H; destr_eq H; now f_equal.
+Qed.
+
+(** ** Addition is associative *)
+
+Lemma pos_sub_add p q r :
+  pos_sub (p + q) r = pos p + pos_sub q r.
+Proof.
+ simpl. rewrite !pos_sub_spec.
+ case (Pos.compare_spec q r); intros E0.
+ - (* q = r *)
+   subst.
+   assert (H := Pos.lt_add_r r p).
+   rewrite Pos.add_comm in H. apply Pos.lt_gt in H.
+   now rewrite H, Pos.add_sub.
+ - (* q < r *)
+   rewrite pos_sub_spec.
+   assert (Hr : (r = (r-q)+q)%positive) by (now rewrite Pos.sub_add).
+   rewrite Hr at 1. rewrite Pos.add_compare_mono_r.
+   case Pos.compare_spec; intros E1; trivial; f_equal.
+   rewrite Pos.add_comm. apply Pos.sub_add_distr.
+   rewrite Hr, Pos.add_comm. now apply Pos.add_lt_mono_r.
+   symmetry. apply Pos.sub_sub_distr; trivial.
+ - (* r < q *)
+   assert (LT : (r < p + q)%positive).
+   { apply Pos.lt_trans with q; trivial.
+     rewrite Pos.add_comm. apply Pos.lt_add_r. }
+   apply Pos.lt_gt in LT. rewrite LT. f_equal.
+   symmetry. now apply Pos.add_sub_assoc.
+Qed.
+
+Lemma add_assoc n m p : n + (m + p) = n + m + p.
+Proof.
+ assert (AUX : forall x y z, pos x + (y + z) = pos x + y + z).
+ { intros x [|y|y] [|z|z]; rewrite ?add_0_r; trivial.
+   - simpl. now rewrite Pos.add_assoc.
+   - simpl (_ + neg _). symmetry. apply pos_sub_add.
+   - simpl (neg _ + _); simpl (_ + neg _).
+     now rewrite (add_comm _ (pos _)), <- 2 pos_sub_add, Pos.add_comm.
+   - apply opp_inj. rewrite !opp_add_distr. simpl opp.
+     simpl (neg _ + _); simpl (_ + neg _).
+     rewrite add_comm, Pos.add_comm. apply pos_sub_add. }
+ destruct n.
+ - trivial.
+ - apply AUX.
+ - apply opp_inj. rewrite !opp_add_distr. simpl opp. apply AUX.
+Qed.
+
+(** ** Subtraction and successor *)
+
+Lemma sub_succ_l n m : succ n - m = succ (n - m).
+Proof.
+ unfold sub, succ. now rewrite <- 2 add_assoc, (add_comm 1).
 Qed.
 
 (** ** Opposite is inverse for addition *)
 
-Theorem Zplus_opp_r : forall n:Z, n + - n = Z0.
+Lemma add_opp_diag_r n : n + - n = 0.
 Proof.
-  intro x; destruct x as [| p| p]; simpl in |- *;
-    [ reflexivity
-      | rewrite (Pcompare_refl p); reflexivity
-      | rewrite (Pcompare_refl p); reflexivity ].
+ destruct n; simpl; trivial; now rewrite pos_sub_diag.
 Qed.
 
-Theorem Zplus_opp_l : forall n:Z, - n + n = Z0.
+Lemma add_opp_diag_l n : - n + n = 0.
 Proof.
-  intro; rewrite Zplus_comm; apply Zplus_opp_r.
+ rewrite add_comm. apply add_opp_diag_r.
 Qed.
 
-Hint Local Resolve Zplus_0_l Zplus_0_r.
+(** ** Commutativity of multiplication *)
 
-(** ** Addition is associative *)
+Lemma mul_comm n m : n * m = m * n.
+Proof.
+ destruct n, m; simpl; trivial; f_equal; apply Pos.mul_comm.
+Qed.
 
-Lemma weak_assoc :
-  forall (p q:positive) (n:Z), Zpos p + (Zpos q + n) = Zpos p + Zpos q + n.
-Proof.
-  intros x y z'; case z';
-    [ auto with arith
-      | intros z; simpl in |- *; rewrite Pplus_assoc; auto with arith
-      | intros z; simpl in |- *; ElimPcompare y z; intros E0; rewrite E0;
-	ElimPcompare (x + y)%positive z; intros E1; rewrite E1;
-	  [ absurd ((x + y ?= z)%positive Eq = Eq);
-	    [  (* Case 1 *)
-              rewrite nat_of_P_gt_Gt_compare_complement_morphism;
-		[ discriminate
-		  | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0);
-		    elim (ZL4 x); intros k E2; rewrite E2;
-		      simpl in |- *; unfold gt, lt in |- *;
-			apply le_n_S; apply le_plus_r ]
-	      | assumption ]
-	    | absurd ((x + y ?= z)%positive Eq = Lt);
-	      [  (* Case 2 *)
-		rewrite nat_of_P_gt_Gt_compare_complement_morphism;
-		  [ discriminate
-		    | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0);
-		      elim (ZL4 x); intros k E2; rewrite E2;
-			simpl in |- *; unfold gt, lt in |- *;
-			  apply le_n_S; apply le_plus_r ]
-		| assumption ]
-	    | rewrite (Pcompare_Eq_eq y z E0);
-          (* Case 3 *)
-	      elim (Pminus_mask_Gt (x + z) z);
-		[ intros t H; elim H; intros H1 H2; elim H2; intros H3 H4;
-		  unfold Pminus in |- *; rewrite H1; cut (x = t);
-		    [ intros E; rewrite E; auto with arith
-		      | apply Pplus_reg_r with (r := z); rewrite <- H3;
-			rewrite Pplus_comm; trivial with arith ]
-		  | pattern z at 1 in |- *; rewrite <- (Pcompare_Eq_eq y z E0);
-		    assumption ]
-	    | elim (Pminus_mask_Gt z y);
-	      [  (* Case 4 *)
-		intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
-		  unfold Pminus at 1 in |- *; rewrite H1; cut (x = k);
-		    [ intros E; rewrite E; rewrite (Pcompare_refl k);
-		      trivial with arith
-		      | apply Pplus_reg_r with (r := y); rewrite (Pplus_comm k y);
-			rewrite H3; apply Pcompare_Eq_eq; assumption ]
-		| apply ZC2; assumption ]
-	    | elim (Pminus_mask_Gt z y);
-	      [  (* Case 5 *)
-		intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
-		  unfold Pminus at 1 3 5 in |- *; rewrite H1;
-		    cut ((x ?= k)%positive Eq = Lt);
-		      [ intros E2; rewrite E2; elim (Pminus_mask_Gt k x);
-			[ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9;
-			  elim (Pminus_mask_Gt z (x + y));
-			    [ intros j H10; elim H10; intros H11 H12; elim H12;
-			      intros H13 H14; unfold Pminus in |- *;
-				rewrite H6; rewrite H11; cut (i = j);
-				  [ intros E; rewrite E; auto with arith
-				    | apply (Pplus_reg_l (x + y)); rewrite H13;
-				      rewrite (Pplus_comm x y); rewrite <- Pplus_assoc;
-					rewrite H8; assumption ]
-			      | apply ZC2; assumption ]
-			  | apply ZC2; assumption ]
-			| apply nat_of_P_lt_Lt_compare_complement_morphism;
-			  apply plus_lt_reg_l with (p := nat_of_P y);
-			    do 2 rewrite <- nat_of_P_plus_morphism;
-			      apply nat_of_P_lt_Lt_compare_morphism;
-				rewrite H3; rewrite Pplus_comm; assumption ]
-		| apply ZC2; assumption ]
-	    | elim (Pminus_mask_Gt z y);
-	      [  (* Case 6 *)
-		intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
-		  elim (Pminus_mask_Gt (x + y) z);
-		    [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9;
-		      unfold Pminus in |- *; rewrite H1; rewrite H6;
-			cut ((x ?= k)%positive Eq = Gt);
-			  [ intros H10; elim (Pminus_mask_Gt x k H10); intros j H11;
-			    elim H11; intros H12 H13; elim H13;
-			      intros H14 H15; rewrite H10; rewrite H12;
-				cut (i = j);
-				  [ intros H16; rewrite H16; auto with arith
-				    | apply (Pplus_reg_l (z + k)); rewrite <- (Pplus_assoc z k j);
-				      rewrite H14; rewrite (Pplus_comm z k);
-					rewrite <- Pplus_assoc; rewrite H8;
-					  rewrite (Pplus_comm x y); rewrite Pplus_assoc;
-					    rewrite (Pplus_comm k y); rewrite H3;
-					      trivial with arith ]
-			    | apply nat_of_P_gt_Gt_compare_complement_morphism;
-			      unfold lt, gt in |- *;
-				apply plus_lt_reg_l with (p := nat_of_P y);
-				  do 2 rewrite <- nat_of_P_plus_morphism;
-				    apply nat_of_P_lt_Lt_compare_morphism;
-				      rewrite H3; rewrite Pplus_comm; apply ZC1;
-					assumption ]
-		      | assumption ]
-		| apply ZC2; assumption ]
-	    | absurd ((x + y ?= z)%positive Eq = Eq);
-	      [  (* Case 7 *)
-		rewrite nat_of_P_gt_Gt_compare_complement_morphism;
-		  [ discriminate
-		    | rewrite nat_of_P_plus_morphism; unfold gt in |- *;
-		      apply lt_le_trans with (m := nat_of_P y);
-			[ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
-			  | apply le_plus_r ] ]
-		| assumption ]
-	    | absurd ((x + y ?= z)%positive Eq = Lt);
-	      [  (* Case 8 *)
-		rewrite nat_of_P_gt_Gt_compare_complement_morphism;
-		  [ discriminate
-		    | unfold gt in |- *; apply lt_le_trans with (m := nat_of_P y);
-		      [ exact (nat_of_P_gt_Gt_compare_morphism y z E0)
-			| rewrite nat_of_P_plus_morphism; apply le_plus_r ] ]
-		| assumption ]
-	    | elim Pminus_mask_Gt with (1 := E0); intros k H1;
-          (* Case 9 *)
-	      elim Pminus_mask_Gt with (1 := E1); intros i H2;
-		elim H1; intros H3 H4; elim H4; intros H5 H6;
-		  elim H2; intros H7 H8; elim H8; intros H9 H10;
-		    unfold Pminus in |- *; rewrite H3; rewrite H7;
-		      cut ((x + k)%positive = i);
-			[ intros E; rewrite E; auto with arith
-			  | apply (Pplus_reg_l z); rewrite (Pplus_comm x k); rewrite Pplus_assoc;
-			    rewrite H5; rewrite H9; rewrite Pplus_comm;
-			      trivial with arith ] ] ].
-Qed.
-
-Hint Local Resolve weak_assoc.
-
-Theorem Zplus_assoc : forall n m p:Z, n + (m + p) = n + m + p.
-Proof.
-  intros x y z; case x; case y; case z; auto with arith; intros;
-    [ rewrite (Zplus_comm (Zneg p0)); rewrite weak_assoc;
-      rewrite (Zplus_comm (Zpos p1 + Zneg p0)); rewrite weak_assoc;
-	rewrite (Zplus_comm (Zpos p1)); trivial with arith
-      | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
-	rewrite Zplus_comm; rewrite <- weak_assoc;
-	  rewrite (Zplus_comm (- Zpos p1));
-	    rewrite (Zplus_comm (Zpos p0 + - Zpos p1)); rewrite (weak_assoc p);
-	      rewrite weak_assoc; rewrite (Zplus_comm (Zpos p0));
-		trivial with arith
-      | rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0) (Zpos p));
-	rewrite <- weak_assoc; rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0));
-	  trivial with arith
-      | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
-	rewrite (Zplus_comm (- Zpos p0)); rewrite weak_assoc;
-	  rewrite (Zplus_comm (Zpos p1 + - Zpos p0)); rewrite weak_assoc;
-	    rewrite (Zplus_comm (Zpos p)); trivial with arith
-      | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
-	apply weak_assoc
-      | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
-	apply weak_assoc ].
-Qed.
-
-
-Lemma Zplus_assoc_reverse : forall n m p:Z, n + m + p = n + (m + p).
-Proof.
-  intros; symmetry  in |- *; apply Zplus_assoc.
-Qed.
-
-(** ** Associativity mixed with commutativity *)
-
-Theorem Zplus_permute : forall n m p:Z, n + (m + p) = m + (n + p).
-Proof.
-  intros n m p; rewrite Zplus_comm; rewrite <- Zplus_assoc;
-    rewrite (Zplus_comm p n); trivial with arith.
-Qed.
-
-(** ** Addition simplifies *)
-
-Theorem Zplus_reg_l : forall n m p:Z, n + m = n + p -> m = p.
-  intros n m p H; cut (- n + (n + m) = - n + (n + p));
-    [ do 2 rewrite Zplus_assoc; rewrite (Zplus_comm (- n) n);
-      rewrite Zplus_opp_r; simpl in |- *; trivial with arith
-      | rewrite H; trivial with arith ].
-Qed.
-
-(** ** Addition and successor permutes *)
-
-Lemma Zplus_succ_l : forall n m:Z, Zsucc n + m = Zsucc (n + m).
-Proof.
-  intros x y; unfold Zsucc in |- *; rewrite (Zplus_comm (x + y));
-    rewrite Zplus_assoc; rewrite (Zplus_comm (Zpos 1));
-      trivial with arith.
-Qed.
-
-Lemma Zplus_succ_r_reverse : forall n m:Z, Zsucc (n + m) = n + Zsucc m.
-Proof.
-  intros n m; unfold Zsucc in |- *; rewrite Zplus_assoc; trivial with arith.
+(** ** Associativity of multiplication *)
+
+Lemma mul_assoc n m p : n * (m * p) = n * m * p.
+Proof.
+ destruct n, m, p; simpl; trivial; f_equal; apply Pos.mul_assoc.
 Qed.
 
-Notation Zplus_succ_r := Zplus_succ_r_reverse (only parsing).
+(** Multiplication and constants *)
 
-Lemma Zplus_succ_comm : forall n m:Z, Zsucc n + m = n + Zsucc m.
+Lemma mul_1_l n : 1 * n = n.
 Proof.
-  unfold Zsucc in |- *; intros n m; rewrite <- Zplus_assoc;
-    rewrite (Zplus_comm (Zpos 1)); trivial with arith.
+ now destruct n.
 Qed.
 
-(** ** Misc properties, usually redundant or non natural *)
+Lemma mul_1_r n : n * 1 = n.
+Proof.
+ destruct n; simpl; now rewrite ?Pos.mul_1_r.
+Qed.
+
+(** ** Multiplication and Opposite *)
 
-Lemma Zplus_0_r_reverse : forall n:Z, n = n + Z0.
+Lemma mul_opp_l n m : - n * m = - (n * m).
 Proof.
-  symmetry  in |- *; apply Zplus_0_r.
+ now destruct n, m.
 Qed.
 
-Lemma Zplus_0_simpl_l : forall n m:Z, n + Z0 = m -> n = m.
+Lemma mul_opp_r n m : n * - m = - (n * m).
 Proof.
-  intros n m; rewrite Zplus_0_r; intro; assumption.
+ now destruct n, m.
 Qed.
 
-Lemma Zplus_0_simpl_l_reverse : forall n m:Z, n = m + Z0 -> n = m.
+Lemma mul_opp_opp n m : - n * - m = n * m.
 Proof.
-  intros n m; rewrite Zplus_0_r; intro; assumption.
+ now destruct n, m.
 Qed.
 
-Lemma Zplus_eq_compat : forall n m p q:Z, n = m -> p = q -> n + p = m + q.
+Lemma mul_opp_comm n m : - n * m = n * - m.
 Proof.
-  intros; rewrite H; rewrite H0; reflexivity.
+ now destruct n, m.
 Qed.
 
-Lemma Zplus_opp_expand : forall n m p:Z, n + - m = n + - p + (p + - m).
+(** ** Distributivity of multiplication over addition *)
+
+Lemma mul_add_distr_pos (p:positive) n m :
+ pos p * (n + m) = pos p * n + pos p * m.
 Proof.
-  intros x y z.
-  rewrite <- (Zplus_assoc x).
-  rewrite (Zplus_assoc (- z)).
-  rewrite Zplus_opp_l.
-  reflexivity.
+ destruct n as [|n|n], m as [|m|m]; simpl; trivial;
+ rewrite ?pos_sub_spec, ?Pos.mul_compare_mono_l; try case Pos.compare_spec;
+ intros; now rewrite ?Pos.mul_add_distr_l, ?Pos.mul_sub_distr_l.
 Qed.
 
-(************************************************************************)
-(** * Properties of successor and predecessor on binary integer numbers *)
+Lemma mul_add_distr_l n m p : n * (m + p) = n * m + n * p.
+Proof.
+ destruct n as [|n|n]. trivial.
+ apply mul_add_distr_pos.
+ change (neg n) with (- pos n).
+ rewrite !mul_opp_l, <- opp_add_distr. f_equal.
+ apply mul_add_distr_pos.
+Qed.
 
-Theorem Zsucc_discr : forall n:Z, n <> Zsucc n.
+Lemma mul_add_distr_r n m p : (n + m) * p = n * p + m * p.
 Proof.
-  intros n; cut (Z0 <> Zpos 1);
-    [ unfold not in |- *; intros H1 H2; apply H1; apply (Zplus_reg_l n);
-      rewrite Zplus_0_r; exact H2
-      | discriminate ].
+ rewrite !(mul_comm _ p). apply mul_add_distr_l.
 Qed.
 
-Theorem Zpos_succ_morphism :
-  forall p:positive, Zpos (Psucc p) = Zsucc (Zpos p).
+(** ** Basic properties of divisibility *)
+
+Lemma divide_Zpos p q : (pos p|pos q) <-> (p|q)%positive.
 Proof.
-  intro; rewrite Pplus_one_succ_r; unfold Zsucc in |- *; simpl in |- *;
-    trivial with arith.
+ split.
+ intros ([ |r|r],H); simpl in *; destr_eq H. exists r; auto.
+ intros (r,H). exists (pos r); simpl; now f_equal.
 Qed.
 
-(** ** Successor and predecessor are inverse functions *)
+Lemma divide_Zpos_Zneg_r n p : (n|pos p) <-> (n|neg p).
+Proof.
+ split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- H.
+Qed.
 
-Theorem Zsucc_pred : forall n:Z, n = Zsucc (Zpred n).
+Lemma divide_Zpos_Zneg_l n p : (pos p|n) <-> (neg p|n).
 Proof.
-  intros n; unfold Zsucc, Zpred in |- *; rewrite <- Zplus_assoc; simpl in |- *;
-    rewrite Zplus_0_r; trivial with arith.
+ split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- mul_opp_r.
 Qed.
 
-Hint Immediate Zsucc_pred: zarith.
+(** ** Conversions between [Z.testbit] and [N.testbit] *)
 
-Theorem Zpred_succ : forall n:Z, n = Zpred (Zsucc n).
+Lemma testbit_of_N a n :
+ testbit (of_N a) (of_N n) = N.testbit a n.
 Proof.
-  intros m; unfold Zpred, Zsucc in |- *; rewrite <- Zplus_assoc; simpl in |- *;
-    rewrite Zplus_comm; auto with arith.
+ destruct a as [|a], n; simpl; trivial. now destruct a.
 Qed.
 
-Theorem Zsucc_inj : forall n m:Z, Zsucc n = Zsucc m -> n = m.
+Lemma testbit_of_N' a n : 0<=n ->
+ testbit (of_N a) n = N.testbit a (to_N n).
 Proof.
-  intros n m H.
-  change (Zneg 1 + Zpos 1 + n = Zneg 1 + Zpos 1 + m) in |- *;
-    do 2 rewrite <- Zplus_assoc; do 2 rewrite (Zplus_comm (Zpos 1));
-      unfold Zsucc in H; rewrite H; trivial with arith.
+ intro Hn. rewrite <- testbit_of_N. f_equal.
+ destruct n; trivial; now destruct Hn.
 Qed.
 
-(*************************************************************************)
-(** ** Properties of the direct definition of successor and predecessor  *)
+Lemma testbit_Zpos a n : 0<=n ->
+ testbit (pos a) n = N.testbit (N.pos a) (to_N n).
+Proof.
+ intro Hn. now rewrite <- testbit_of_N'.
+Qed.
 
-Theorem Zsucc_succ' : forall n:Z, Zsucc n = Zsucc' n.
+Lemma testbit_Zneg a n : 0<=n ->
+ testbit (neg a) n = negb (N.testbit (Pos.pred_N a) (to_N n)).
 Proof.
-destruct n as [| p | p]; simpl.
-reflexivity.
-now rewrite Pplus_one_succ_r.
-now destruct p as [q | q |].
+ intro Hn.
+ rewrite <- testbit_of_N' by trivial.
+ destruct n as [ |n|n];
+  [ | simpl; now destruct (Pos.pred_N a) | now destruct Hn].
+ unfold testbit.
+ now destruct a as [|[ | | ]| ].
 Qed.
 
-Theorem Zpred_pred' : forall n:Z, Zpred n = Zpred' n.
+End Private_BootStrap.
+
+(** * Proofs of specifications *)
+
+(** ** Specification of constants *)
+
+Lemma one_succ : 1 = succ 0.
 Proof.
-destruct n as [| p | p]; simpl.
 reflexivity.
-now destruct p as [q | q |].
-now rewrite Pplus_one_succ_r.
 Qed.
 
-Theorem Zsucc'_inj : forall n m:Z, Zsucc' n = Zsucc' m -> n = m.
+Lemma two_succ : 2 = succ 1.
 Proof.
-intros n m; do 2 rewrite <- Zsucc_succ'; now apply Zsucc_inj.
+reflexivity.
 Qed.
 
-Theorem Zsucc'_pred' : forall n:Z, Zsucc' (Zpred' n) = n.
+(** ** Specification of addition *)
+
+Lemma add_0_l n : 0 + n = n.
 Proof.
-intro; rewrite <- Zsucc_succ'; rewrite <- Zpred_pred';
-symmetry; apply Zsucc_pred.
+ now destruct n.
 Qed.
 
-Theorem Zpred'_succ' : forall n:Z, Zpred' (Zsucc' n) = n.
+Lemma add_succ_l n m : succ n + m = succ (n + m).
 Proof.
-intro; apply Zsucc'_inj; now rewrite Zsucc'_pred'.
+ unfold succ. now rewrite 2 (add_comm _ 1), add_assoc.
 Qed.
 
-Theorem Zpred'_inj : forall n m:Z, Zpred' n = Zpred' m -> n = m.
+(** ** Specification of opposite *)
+
+Lemma opp_0 : -0 = 0.
 Proof.
-intros n m H.
-rewrite <- (Zsucc'_pred' n); rewrite <- (Zsucc'_pred' m); now rewrite H.
+ reflexivity.
 Qed.
 
-Theorem Zsucc'_discr : forall n:Z, n <> Zsucc' n.
+Lemma opp_succ n : -(succ n) = pred (-n).
 Proof.
-  intro x; destruct x; simpl in |- *.
-  discriminate.
-  injection; apply Psucc_discr.
-  destruct p; simpl in |- *.
-    discriminate.
-    intro H; symmetry  in H; injection H; apply double_moins_un_xO_discr.
-    discriminate.
+ unfold succ, pred. apply opp_add_distr.
 Qed.
 
-(** Misc properties, usually redundant or non natural *)
+(** ** Specification of successor and predecessor *)
 
-Lemma Zsucc_eq_compat : forall n m:Z, n = m -> Zsucc n = Zsucc m.
+Lemma succ_pred n : succ (pred n) = n.
 Proof.
-  intros n m H; rewrite H; reflexivity.
+ unfold succ, pred. now rewrite <- add_assoc, add_opp_diag_r, add_0_r.
 Qed.
 
-Lemma Zsucc_inj_contrapositive : forall n m:Z, n <> m -> Zsucc n <> Zsucc m.
+Lemma pred_succ n : pred (succ n) = n.
 Proof.
-  unfold not in |- *; intros n m H1 H2; apply H1; apply Zsucc_inj; assumption.
+ unfold succ, pred. now rewrite <- add_assoc, add_opp_diag_r, add_0_r.
 Qed.
 
-(**********************************************************************)
-(** * Properties of subtraction on binary integer numbers *)
+(** ** Specification of subtraction *)
 
-(** ** [minus] and [Z0] *)
-
-Lemma Zminus_0_r : forall n:Z, n - Z0 = n.
+Lemma sub_0_r n : n - 0 = n.
 Proof.
-  intro; unfold Zminus in |- *; simpl in |- *; rewrite Zplus_0_r;
-    trivial with arith.
+ apply add_0_r.
 Qed.
 
-Lemma Zminus_0_l_reverse : forall n:Z, n = n - Z0.
+Lemma sub_succ_r n m : n - succ m = pred (n - m).
 Proof.
-  intro; symmetry  in |- *; apply Zminus_0_r.
+ unfold sub, succ, pred. now rewrite opp_add_distr, add_assoc.
 Qed.
 
-Lemma Zminus_diag : forall n:Z, n - n = Z0.
+(** ** Specification of multiplication *)
+
+Lemma mul_0_l n : 0 * n = 0.
 Proof.
-  intro; unfold Zminus in |- *; rewrite Zplus_opp_r; trivial with arith.
+ reflexivity.
 Qed.
 
-Lemma Zminus_diag_reverse : forall n:Z, Z0 = n - n.
+Lemma mul_succ_l n m : succ n * m = n * m + m.
 Proof.
-  intro; symmetry  in |- *; apply Zminus_diag.
+ unfold succ. now rewrite mul_add_distr_r, mul_1_l.
 Qed.
 
+(** ** Specification of comparisons and order *)
 
-(** ** Relating [minus] with [plus] and [Zsucc] *)
+Lemma eqb_eq n m : (n =? m) = true <-> n = m.
+Proof.
+ destruct n, m; simpl; try (now split); rewrite Pos.eqb_eq;
+ split; (now injection 1) || (intros; now f_equal).
+Qed.
 
-Lemma Zminus_plus_distr : forall n m p:Z, n - (m + p) = n - m - p.
+Lemma ltb_lt n m : (n <? m) = true <-> n < m.
 Proof.
-intros; unfold Zminus; rewrite Zopp_plus_distr; apply Zplus_assoc.
+ unfold ltb, lt. destruct compare; easy'.
 Qed.
 
-Lemma Zminus_succ_l : forall n m:Z, Zsucc (n - m) = Zsucc n - m.
+Lemma leb_le n m : (n <=? m) = true <-> n <= m.
 Proof.
-  intros n m; unfold Zminus, Zsucc in |- *; rewrite (Zplus_comm n (- m));
-    rewrite <- Zplus_assoc; apply Zplus_comm.
+ unfold leb, le. destruct compare; easy'.
 Qed.
 
-Lemma Zminus_succ_r : forall n m:Z, n - (Zsucc m) = Zpred (n - m).
+Lemma compare_eq_iff n m : (n ?= m) = Eq <-> n = m.
 Proof.
-intros; unfold Zsucc; now rewrite Zminus_plus_distr.
+destruct n, m; simpl; rewrite ?CompOpp_iff, ?Pos.compare_eq_iff;
+ split; congruence.
 Qed.
 
-Lemma Zplus_minus_eq : forall n m p:Z, n = m + p -> p = n - m.
+Lemma compare_sub n m : (n ?= m) = (n - m ?= 0).
 Proof.
-  intros n m p H; unfold Zminus in |- *; apply (Zplus_reg_l m);
-    rewrite (Zplus_comm m (n + - m)); rewrite <- Zplus_assoc;
-      rewrite Zplus_opp_l; rewrite Zplus_0_r; rewrite H;
-	trivial with arith.
+ destruct n as [|n|n], m as [|m|m]; simpl; trivial;
+ rewrite <- ? Pos.compare_antisym, ?pos_sub_spec;
+ case Pos.compare_spec; trivial.
 Qed.
 
-Lemma Zminus_plus : forall n m:Z, n + m - n = m.
+Lemma compare_antisym n m : (m ?= n) = CompOpp (n ?= m).
 Proof.
-  intros n m; unfold Zminus in |- *; rewrite (Zplus_comm n m);
-    rewrite <- Zplus_assoc; rewrite Zplus_opp_r; apply Zplus_0_r.
+destruct n, m; simpl; trivial; now rewrite <- ?Pos.compare_antisym.
 Qed.
 
-Lemma Zplus_minus : forall n m:Z, n + (m - n) = m.
+Lemma compare_lt_iff n m : (n ?= m) = Lt <-> n < m.
+Proof. reflexivity. Qed.
+
+Lemma compare_le_iff n m : (n ?= m) <> Gt <-> n <= m.
+Proof. reflexivity. Qed.
+
+(** Some more advanced properties of comparison and orders,
+    including [compare_spec] and [lt_irrefl] and [lt_eq_cases]. *)
+
+Include BoolOrderFacts.
+
+(** Remaining specification of [lt] and [le] *)
+
+Lemma lt_succ_r n m : n < succ m <-> n<=m.
 Proof.
-  unfold Zminus in |- *; intros n m; rewrite Zplus_permute; rewrite Zplus_opp_r;
-    apply Zplus_0_r.
+ unfold lt, le. rewrite compare_sub, sub_succ_r.
+ rewrite (compare_sub n m).
+ destruct (n-m) as [|[ | | ]|]; easy'.
 Qed.
 
-Lemma Zminus_plus_simpl_l : forall n m p:Z, p + n - (p + m) = n - m.
+(** ** Specification of minimum and maximum *)
+
+Lemma max_l n m : m<=n -> max n m = n.
 Proof.
-  intros n m p; unfold Zminus in |- *; rewrite Zopp_plus_distr;
-    rewrite Zplus_assoc; rewrite (Zplus_comm p); rewrite <- (Zplus_assoc n p);
-      rewrite Zplus_opp_r; rewrite Zplus_0_r; trivial with arith.
+ unfold le, max. rewrite (compare_antisym n m).
+ case compare; intuition.
 Qed.
 
-Lemma Zminus_plus_simpl_l_reverse : forall n m p:Z, n - m = p + n - (p + m).
+Lemma max_r n m :  n<=m -> max n m = m.
 Proof.
-  intros; symmetry  in |- *; apply Zminus_plus_simpl_l.
+ unfold le, max. case compare_spec; intuition.
 Qed.
 
-Lemma Zminus_plus_simpl_r : forall n m p:Z, n + p - (m + p) = n - m.
+Lemma min_l n m : n<=m -> min n m = n.
 Proof.
-  intros x y n.
-  unfold Zminus in |- *.
-  rewrite Zopp_plus_distr.
-  rewrite (Zplus_comm (- y) (- n)).
-  rewrite Zplus_assoc.
-  rewrite <- (Zplus_assoc x n (- n)).
-  rewrite (Zplus_opp_r n).
-  rewrite <- Zplus_0_r_reverse.
-  reflexivity.
+ unfold le, min. case compare_spec; intuition.
 Qed.
 
-Lemma Zpos_minus_morphism : forall a b:positive, Pcompare a b Eq = Lt ->
-  Zpos (b-a) = Zpos b - Zpos a.
+Lemma min_r n m : m<=n -> min n m = m.
 Proof.
-  intros.
-  simpl.
-  change Eq with (CompOpp Eq).
-  rewrite <- Pcompare_antisym.
-  rewrite H; simpl; auto.
+ unfold le, min.
+ rewrite (compare_antisym n m). case compare_spec; intuition.
 Qed.
 
-(** ** Misc redundant properties *)
+(** ** Specification of absolute value *)
 
-Lemma Zeq_minus : forall n m:Z, n = m -> n - m = Z0.
+Lemma abs_eq n : 0 <= n -> abs n = n.
 Proof.
-  intros x y H; rewrite H; symmetry  in |- *; apply Zminus_diag_reverse.
+ destruct n; trivial. now destruct 1.
 Qed.
 
-Lemma Zminus_eq : forall n m:Z, n - m = Z0 -> n = m.
+Lemma abs_neq n : n <= 0 -> abs n = - n.
 Proof.
-  intros x y H; rewrite <- (Zplus_minus y x); rewrite H; apply Zplus_0_r.
+ destruct n; trivial. now destruct 1.
 Qed.
 
+(** ** Specification of sign *)
 
-(**********************************************************************)
-(** * Properties of multiplication on binary integer numbers *)
-
-Theorem Zpos_mult_morphism :
-  forall p q:positive, Zpos (p*q) = Zpos p * Zpos q.
+Lemma sgn_null n : n = 0 -> sgn n = 0.
 Proof.
-  auto.
+ intros. now subst.
 Qed.
 
-(** ** One is neutral for multiplication *)
-
-Theorem Zmult_1_l : forall n:Z, Zpos 1 * n = n.
+Lemma sgn_pos n : 0 < n -> sgn n = 1.
 Proof.
-  intro x; destruct x; reflexivity.
+ now destruct n.
 Qed.
 
-Theorem Zmult_1_r : forall n:Z, n * Zpos 1 = n.
+Lemma sgn_neg n : n < 0 -> sgn n = -1.
 Proof.
-  intro x; destruct x; simpl in |- *; try rewrite Pmult_1_r; reflexivity.
+ now destruct n.
 Qed.
 
-(** ** Zero property of multiplication *)
+(** ** Specification of power *)
 
-Theorem Zmult_0_l : forall n:Z, Z0 * n = Z0.
+Lemma pow_0_r n : n^0 = 1.
 Proof.
-  intro x; destruct x; reflexivity.
+ reflexivity.
 Qed.
 
-Theorem Zmult_0_r : forall n:Z, n * Z0 = Z0.
+Lemma pow_succ_r n m : 0<=m -> n^(succ m) = n * n^m.
 Proof.
-  intro x; destruct x; reflexivity.
+ destruct m as [|m|m]; (now destruct 1) || (intros _); simpl; trivial.
+ unfold pow_pos. now rewrite Pos.add_comm, Pos.iter_add.
 Qed.
 
-Hint Local Resolve Zmult_0_l Zmult_0_r.
+Lemma pow_neg_r n m : m<0 -> n^m = 0.
+Proof.
+ now destruct m.
+Qed.
 
-Lemma Zmult_0_r_reverse : forall n:Z, Z0 = n * Z0.
+(** For folding back a [pow_pos] into a [pow] *)
+
+Lemma pow_pos_fold n p : pow_pos n p = n ^ (pos p).
 Proof.
-  intro x; destruct x; reflexivity.
+ reflexivity.
 Qed.
 
-(** ** Commutativity of multiplication *)
+(** ** Specification of square *)
 
-Theorem Zmult_comm : forall n m:Z, n * m = m * n.
+Lemma square_spec n : square n = n * n.
 Proof.
-  intros x y; destruct x as [| p| p]; destruct y as [| q| q]; simpl in |- *;
-    try rewrite (Pmult_comm p q); reflexivity.
+ destruct n; trivial; simpl; f_equal; apply Pos.square_spec.
 Qed.
 
-(** ** Associativity of multiplication *)
+(** ** Specification of square root *)
 
-Theorem Zmult_assoc : forall n m p:Z, n * (m * p) = n * m * p.
+Lemma sqrtrem_spec n : 0<=n ->
+ let (s,r) := sqrtrem n in n = s*s + r /\ 0 <= r <= 2*s.
 Proof.
-  intros x y z; destruct x; destruct y; destruct z; simpl in |- *;
-    try rewrite Pmult_assoc; reflexivity.
+ destruct n. now repeat split.
+ generalize (Pos.sqrtrem_spec p). simpl.
+ destruct 1; simpl; subst; now repeat split.
+ now destruct 1.
 Qed.
 
-Lemma Zmult_assoc_reverse : forall n m p:Z, n * m * p = n * (m * p).
+Lemma sqrt_spec n : 0<=n ->
+ let s := sqrt n in s*s <= n < (succ s)*(succ s).
 Proof.
-  intros n m p; rewrite Zmult_assoc; trivial with arith.
+ destruct n. now repeat split. unfold sqrt.
+ intros _. simpl succ. rewrite Pos.add_1_r. apply (Pos.sqrt_spec p).
+ now destruct 1.
 Qed.
 
-(** ** Associativity mixed with commutativity *)
+Lemma sqrt_neg n : n<0 -> sqrt n = 0.
+Proof.
+ now destruct n.
+Qed.
 
-Theorem Zmult_permute : forall n m p:Z, n * (m * p) = m * (n * p).
+Lemma sqrtrem_sqrt n : fst (sqrtrem n) = sqrt n.
 Proof.
-  intros x y z; rewrite (Zmult_assoc y x z); rewrite (Zmult_comm y x).
-  apply Zmult_assoc.
+ destruct n; try reflexivity.
+ unfold sqrtrem, sqrt, Pos.sqrt.
+ destruct (Pos.sqrtrem p) as (s,r). now destruct r.
 Qed.
 
-(** ** Z is integral *)
+(** ** Specification of logarithm *)
 
-Theorem Zmult_integral_l : forall n m:Z, n <> Z0 -> m * n = Z0 -> m = Z0.
+Lemma log2_spec n : 0 < n -> 2^(log2 n) <= n < 2^(succ (log2 n)).
 Proof.
-  intros x y; destruct x as [| p| p].
-  intro H; absurd (Z0 = Z0); trivial.
-  intros _ H; destruct y as [| q| q]; reflexivity || discriminate.
-  intros _ H; destruct y as [| q| q]; reflexivity || discriminate.
+ assert (Pow : forall p q, pos (p^q) = (pos p)^(pos q)).
+ { intros. now apply Pos.iter_swap_gen. }
+ destruct n as [|[p|p|]|]; intros Hn; split; try easy; unfold log2;
+  simpl succ; rewrite ?Pos.add_1_r, <- Pow.
+ change (2^Pos.size p <= Pos.succ (p~0))%positive.
+ apply Pos.lt_le_incl, Pos.lt_succ_r, Pos.size_le.
+ apply Pos.size_gt.
+ apply Pos.size_le.
+ apply Pos.size_gt.
 Qed.
 
-
-Theorem Zmult_integral : forall n m:Z, n * m = Z0 -> n = Z0 \/ m = Z0.
+Lemma log2_nonpos n : n<=0 -> log2 n = 0.
 Proof.
-  intros x y; destruct x; destruct y; auto; simpl in |- *; intro H;
-    discriminate H.
+ destruct n as [|p|p]; trivial; now destruct 1.
 Qed.
 
+(** Specification of parity functions *)
+
+Lemma even_spec n : even n = true <-> Even n.
+Proof.
+ split.
+ exists (div2 n). now destruct n as [|[ | | ]|[ | | ]].
+ intros (m,->). now destruct m.
+Qed.
 
-Lemma Zmult_1_inversion_l :
-  forall n m:Z, n * m = Zpos 1 -> n = Zpos 1 \/ n = Zneg 1.
+Lemma odd_spec n : odd n = true <-> Odd n.
 Proof.
-  intros x y; destruct x as [| p| p]; intro; [ discriminate | left | right ];
-    (destruct y as [| q| q]; try discriminate; simpl in H; injection H; clear H;
-      intro H; rewrite Pmult_1_inversion_l with (1 := H);
-	reflexivity).
+ split.
+ exists (div2 n). destruct n as [|[ | | ]|[ | | ]]; simpl; try easy.
+ now rewrite Pos.pred_double_succ.
+ intros (m,->). now destruct m as [|[ | | ]|[ | | ]].
 Qed.
 
 (** ** Multiplication and Doubling *)
 
-Lemma Zdouble_mult : forall z, Zdouble z = (Zpos 2) * z.
+Lemma double_spec n : double n = 2*n.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma succ_double_spec n : succ_double n = 2*n + 1.
+Proof.
+ now destruct n.
+Qed.
+
+Lemma pred_double_spec n : pred_double n = 2*n - 1.
+Proof.
+ now destruct n.
+Qed.
+
+(** ** Correctness proofs for Trunc division *)
+
+Lemma pos_div_eucl_eq a b : 0 < b ->
+  let (q, r) := pos_div_eucl a b in pos a = q * b + r.
+Proof.
+ intros Hb.
+ induction a; unfold pos_div_eucl; fold pos_div_eucl.
+ - (* ~1 *)
+   destruct pos_div_eucl as (q,r).
+   change (pos a~1) with (2*(pos a)+1).
+   rewrite IHa, mul_add_distr_l, mul_assoc.
+   destruct ltb.
+   now rewrite add_assoc.
+   rewrite mul_add_distr_r, mul_1_l, <- !add_assoc. f_equal.
+   unfold sub. now rewrite (add_comm _ (-b)), add_assoc, add_opp_diag_r.
+ - (* ~0 *)
+   destruct pos_div_eucl as (q,r).
+   change (pos a~0) with (2*pos a).
+   rewrite IHa, mul_add_distr_l, mul_assoc.
+   destruct ltb.
+   trivial.
+   rewrite mul_add_distr_r, mul_1_l, <- !add_assoc. f_equal.
+   unfold sub. now rewrite (add_comm _ (-b)), add_assoc, add_opp_diag_r.
+ - (* 1 *)
+   case leb_spec; trivial.
+   intros Hb'.
+   destruct b as [|b|b]; try easy; clear Hb.
+   replace b with 1%positive; trivial.
+   apply Pos.le_antisym. apply Pos.le_1_l. now apply Pos.lt_succ_r.
+Qed.
+
+Lemma div_eucl_eq a b : b<>0 ->
+ let (q, r) := div_eucl a b in a = b * q + r.
+Proof.
+ destruct a as [ |a|a], b as [ |b|b]; unfold div_eucl; trivial;
+  (now destruct 1) || intros _;
+  generalize (pos_div_eucl_eq a (pos b) (eq_refl _));
+  destruct pos_div_eucl as (q,r); rewrite mul_comm.
+ - (* pos pos *)
+   trivial.
+ - (* pos neg *)
+   intros ->.
+   destruct r as [ |r|r]; rewrite <- !mul_opp_comm; trivial;
+    rewrite mul_add_distr_l, mul_1_r, <- add_assoc; f_equal;
+   now rewrite add_assoc, add_opp_diag_r.
+ - (* neg pos *)
+   change (neg a) with (- pos a). intros ->.
+   rewrite (opp_add_distr _ r), <- mul_opp_r.
+   destruct r as [ |r|r]; trivial;
+    rewrite opp_add_distr, mul_add_distr_l, <- add_assoc; f_equal;
+    unfold sub; now rewrite add_assoc, mul_opp_r, mul_1_r, add_opp_diag_l.
+ - (* neg neg *)
+   change (neg a) with (- pos a). intros ->.
+   now rewrite opp_add_distr, <- mul_opp_l.
+Qed.
+
+Lemma div_mod a b : b<>0 -> a = b*(a/b) + (a mod b).
+Proof.
+ intros Hb. generalize (div_eucl_eq a b Hb).
+ unfold div, modulo. now destruct div_eucl.
+Qed.
+
+Lemma pos_div_eucl_bound a b : 0<b -> 0 <= snd (pos_div_eucl a b) < b.
+Proof.
+ assert (AUX : forall m p, m < pos (p~0) -> m - pos p < pos p).
+  intros m p. unfold lt.
+  rewrite (compare_sub m), (compare_sub _ (pos _)). unfold sub.
+  rewrite <- add_assoc. simpl opp; simpl (neg _ + _).
+  now rewrite Pos.add_diag.
+ intros Hb.
+ destruct b as [|b|b]; discriminate Hb || clear Hb.
+ induction a; unfold pos_div_eucl; fold pos_div_eucl.
+ (* ~1 *)
+ destruct pos_div_eucl as (q,r).
+ simpl in IHa; destruct IHa as (Hr,Hr').
+ case ltb_spec; intros H; unfold snd. split; trivial. now destruct r.
+ split. unfold le.
+  now rewrite compare_antisym, <- compare_sub, <- compare_antisym.
+ apply AUX. rewrite <- succ_double_spec.
+ destruct r; try easy. unfold lt in *; simpl in *.
+  now rewrite Pos.compare_xI_xO, Hr'.
+ (* ~0 *)
+ destruct pos_div_eucl as (q,r).
+ simpl in IHa; destruct IHa as (Hr,Hr').
+ case ltb_spec; intros H; unfold snd. split; trivial. now destruct r.
+ split. unfold le.
+  now rewrite compare_antisym, <- compare_sub, <- compare_antisym.
+ apply AUX. destruct r; try easy.
+ (* 1 *)
+ case leb_spec; intros H; simpl; split; try easy.
+ red; simpl. now apply Pos.le_succ_l.
+Qed.
+
+Lemma mod_pos_bound a b : 0 < b -> 0 <= a mod b < b.
+Proof.
+ destruct b as [|b|b]; try easy; intros _.
+ destruct a as [|a|a]; unfold modulo, div_eucl.
+ now split.
+ now apply pos_div_eucl_bound.
+ generalize (pos_div_eucl_bound a (pos b) (eq_refl _)).
+ destruct pos_div_eucl as (q,r); unfold snd; intros (Hr,Hr').
+ destruct r as [|r|r]; (now destruct Hr) || clear Hr.
+ now split.
+ split. unfold le.
+  now rewrite compare_antisym, <- compare_sub, <- compare_antisym, Hr'.
+ unfold lt in *; simpl in *. rewrite pos_sub_gt by trivial.
+ simpl. now apply Pos.sub_decr.
+Qed.
+
+Definition mod_bound_pos a b (_:0<=a) := mod_pos_bound a b.
+
+Lemma mod_neg_bound a b : b < 0 -> b < a mod b <= 0.
+Proof.
+ destruct b as [|b|b]; try easy; intros _.
+ destruct a as [|a|a]; unfold modulo, div_eucl.
+ now split.
+ generalize (pos_div_eucl_bound a (pos b) (eq_refl _)).
+ destruct pos_div_eucl as (q,r); unfold snd; intros (Hr,Hr').
+ destruct r as [|r|r]; (now destruct Hr) || clear Hr.
+ now split.
+ split.
+ unfold lt in *; simpl in *. rewrite pos_sub_lt by trivial.
+ rewrite <- Pos.compare_antisym. now apply Pos.sub_decr.
+ change (neg b - neg r <= 0). unfold le, lt in *.
+  rewrite <- compare_sub. simpl in *.
+  now rewrite <- Pos.compare_antisym, Hr'.
+ generalize (pos_div_eucl_bound a (pos b) (eq_refl _)).
+ destruct pos_div_eucl as (q,r); unfold snd; intros (Hr,Hr').
+ split; destruct r; try easy.
+  red; simpl; now rewrite <- Pos.compare_antisym.
+Qed.
+
+(** ** Correctness proofs for Floor division *)
+
+Theorem quotrem_eq a b : let (q,r) := quotrem a b in a = q * b + r.
 Proof.
-  reflexivity.
+ destruct a as [|a|a], b as [|b|b]; simpl; trivial;
+ generalize (N.pos_div_eucl_spec a (N.pos b)); case N.pos_div_eucl; trivial;
+  intros q r;
+  try change (neg a) with (-pos a);
+  change (pos a) with (of_N (N.pos a)); intros ->; now destruct q, r.
 Qed.
 
-Lemma Zdouble_plus_one_mult : forall z,
-  Zdouble_plus_one z = (Zpos 2) * z + (Zpos 1).
+Lemma quot_rem' a b : a = b*(a÷b) + rem a b.
 Proof.
-  destruct z; simpl; auto with zarith.
+ rewrite mul_comm. generalize (quotrem_eq a b).
+ unfold quot, rem. now destruct quotrem.
 Qed.
 
-(** ** Multiplication and Opposite *)
+Lemma quot_rem a b : b<>0 -> a = b*(a÷b) + rem a b.
+Proof. intros _. apply quot_rem'. Qed.
 
-Theorem Zopp_mult_distr_l : forall n m:Z, - (n * m) = - n * m.
+Lemma rem_bound_pos a b : 0<=a -> 0<b -> 0 <= rem a b < b.
 Proof.
-  intros x y; destruct x; destruct y; reflexivity.
+ intros Ha Hb.
+ destruct b as [|b|b]; (now discriminate Hb) || clear Hb;
+ destruct a as [|a|a]; (now destruct Ha) || clear Ha.
+ compute. now split.
+ unfold rem, quotrem.
+ assert (H := N.pos_div_eucl_remainder a (N.pos b)).
+ destruct N.pos_div_eucl as (q,[|r]); simpl; split; try easy.
+ now apply H.
 Qed.
 
-Theorem Zopp_mult_distr_r : forall n m:Z, - (n * m) = n * - m.
+Lemma rem_opp_l' a b : rem (-a) b = - (rem a b).
 Proof.
-  intros x y; rewrite (Zmult_comm x y); rewrite Zopp_mult_distr_l;
-    apply Zmult_comm.
+ destruct a, b; trivial; unfold rem; simpl;
+  now destruct N.pos_div_eucl as (q,[|r]).
 Qed.
 
-Lemma Zopp_mult_distr_l_reverse : forall n m:Z, - n * m = - (n * m).
+Lemma rem_opp_r' a b : rem a (-b) = rem a b.
 Proof.
-  intros x y; symmetry  in |- *; apply Zopp_mult_distr_l.
+ destruct a, b; trivial; unfold rem; simpl;
+  now destruct N.pos_div_eucl as (q,[|r]).
 Qed.
 
-Theorem Zmult_opp_comm : forall n m:Z, - n * m = n * - m.
+Lemma rem_opp_l a b : b<>0 -> rem (-a) b = - (rem a b).
+Proof. intros _. apply rem_opp_l'. Qed.
+
+Lemma rem_opp_r a b : b<>0 -> rem a (-b) = rem a b.
+Proof. intros _. apply rem_opp_r'. Qed.
+
+(** ** Correctness proofs for gcd *)
+
+Lemma ggcd_gcd a b : fst (ggcd a b) = gcd a b.
 Proof.
-  intros x y; rewrite Zopp_mult_distr_l_reverse; rewrite Zopp_mult_distr_r;
-    trivial with arith.
+ destruct a as [ |p|p], b as [ |q|q]; simpl; auto;
+  generalize (Pos.ggcd_gcd p q); destruct Pos.ggcd as (g,(aa,bb));
+  simpl; congruence.
 Qed.
 
-Theorem Zmult_opp_opp : forall n m:Z, - n * - m = n * m.
+Lemma ggcd_correct_divisors a b :
+  let '(g,(aa,bb)) := ggcd a b in
+  a = g*aa /\ b = g*bb.
 Proof.
-  intros x y; destruct x; destruct y; reflexivity.
+ destruct a as [ |p|p], b as [ |q|q]; simpl; rewrite ?Pos.mul_1_r; auto;
+  generalize (Pos.ggcd_correct_divisors p q);
+  destruct Pos.ggcd as (g,(aa,bb)); simpl; destruct 1; now subst.
 Qed.
 
-Theorem Zopp_eq_mult_neg_1 : forall n:Z, - n = n * Zneg 1.
+Lemma gcd_divide_l a b : (gcd a b | a).
 Proof.
-  intro x; induction x; intros; rewrite Zmult_comm; auto with arith.
+ rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b).
+ destruct ggcd as (g,(aa,bb)); simpl. intros (H,_). exists aa.
+  now rewrite mul_comm.
 Qed.
 
-(** ** Distributivity of multiplication over addition *)
+Lemma gcd_divide_r a b : (gcd a b | b).
+Proof.
+ rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b).
+ destruct ggcd as (g,(aa,bb)); simpl. intros (_,H). exists bb.
+  now rewrite mul_comm.
+Qed.
 
-Lemma weak_Zmult_plus_distr_r :
-  forall (p:positive) (n m:Z), Zpos p * (n + m) = Zpos p * n + Zpos p * m.
+Lemma gcd_greatest a b c : (c|a) -> (c|b) -> (c | gcd a b).
 Proof.
-  intros x y' z'; case y'; case z'; auto with arith; intros y z;
-    (simpl in |- *; rewrite Pmult_plus_distr_l; trivial with arith) ||
-      (simpl in |- *; ElimPcompare z y; intros E0; rewrite E0;
-	[ rewrite (Pcompare_Eq_eq z y E0); rewrite (Pcompare_refl (x * y));
-          trivial with arith
-	  | cut ((x * z ?= x * y)%positive Eq = Lt);
-            [ intros E; rewrite E; rewrite Pmult_minus_distr_l;
-              [ trivial with arith | apply ZC2; assumption ]
-              | apply nat_of_P_lt_Lt_compare_complement_morphism;
-		do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x);
-		  intros h H1; rewrite H1; apply mult_S_lt_compat_l;
-		    exact (nat_of_P_lt_Lt_compare_morphism z y E0) ]
-	  | cut ((x * z ?= x * y)%positive Eq = Gt);
-            [ intros E; rewrite E; rewrite Pmult_minus_distr_l; auto with arith
-              | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *;
-		do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x);
-		  intros h H1; rewrite H1; apply mult_S_lt_compat_l;
-		    exact (nat_of_P_gt_Gt_compare_morphism z y E0) ] ]).
+ assert (H : forall p q r, (r|pos p) -> (r|pos q) -> (r|pos (Pos.gcd p q))).
+ { intros p q [|r|r] H H'.
+   destruct H; now rewrite mul_comm in *.
+   apply divide_Zpos, Pos.gcd_greatest; now apply divide_Zpos.
+   apply divide_Zpos_Zneg_l, divide_Zpos, Pos.gcd_greatest;
+    now apply divide_Zpos, divide_Zpos_Zneg_l.
+ }
+ destruct a, b; simpl; auto; intros; try apply H; trivial;
+  now apply divide_Zpos_Zneg_r.
 Qed.
 
-Theorem Zmult_plus_distr_r : forall n m p:Z, n * (m + p) = n * m + n * p.
+Lemma gcd_nonneg a b : 0 <= gcd a b.
 Proof.
-  intros x y z; case x;
-    [ auto with arith
-      | intros x'; apply weak_Zmult_plus_distr_r
-      | intros p; apply Zopp_inj; rewrite Zopp_plus_distr;
-	do 3 rewrite <- Zopp_mult_distr_l_reverse; rewrite Zopp_neg;
-	  apply weak_Zmult_plus_distr_r ].
+ now destruct a, b.
 Qed.
 
-Theorem Zmult_plus_distr_l : forall n m p:Z, (n + m) * p = n * p + m * p.
+(** ggcd and opp : an auxiliary result used in QArith *)
+
+Theorem ggcd_opp a b :
+  ggcd (-a) b = (let '(g,(aa,bb)) := ggcd a b in (g,(-aa,bb))).
 Proof.
-  intros n m p; rewrite Zmult_comm; rewrite Zmult_plus_distr_r;
-    do 2 rewrite (Zmult_comm p); trivial with arith.
+ destruct a as [|a|a], b as [|b|b]; unfold ggcd, opp; auto;
+  destruct (Pos.ggcd a b) as (g,(aa,bb)); auto.
 Qed.
 
-(** ** Distributivity of multiplication over subtraction *)
+(** ** Proofs of specifications for bitwise operations *)
 
-Lemma Zmult_minus_distr_r : forall n m p:Z, (n - m) * p = n * p - m * p.
+Lemma div2_spec a : div2 a = shiftr a 1.
 Proof.
-  intros x y z; unfold Zminus in |- *.
-  rewrite <- Zopp_mult_distr_l_reverse.
-  apply Zmult_plus_distr_l.
+ reflexivity.
 Qed.
 
+Lemma testbit_0_l n : testbit 0 n = false.
+Proof.
+ now destruct n.
+Qed.
 
-Lemma Zmult_minus_distr_l : forall n m p:Z, p * (n - m) = p * n - p * m.
+Lemma testbit_neg_r a n : n<0 -> testbit a n = false.
 Proof.
-  intros x y z; rewrite (Zmult_comm z (x - y)).
-  rewrite (Zmult_comm z x).
-  rewrite (Zmult_comm z y).
-  apply Zmult_minus_distr_r.
+ now destruct n.
 Qed.
 
-(** ** Simplification of multiplication for non-zero integers *)
+Lemma testbit_odd_0 a : testbit (2*a+1) 0 = true.
+Proof.
+ now destruct a as [|a|[a|a|]].
+Qed.
 
-Lemma Zmult_reg_l : forall n m p:Z, p <> Z0 -> p * n = p * m -> n = m.
+Lemma testbit_even_0 a : testbit (2*a) 0 = false.
 Proof.
-  intros x y z H H0.
-  generalize (Zeq_minus _ _ H0).
-  intro.
-  apply Zminus_eq.
-  rewrite <- Zmult_minus_distr_l in H1.
-  clear H0; destruct (Zmult_integral _ _ H1).
-  contradiction.
-  trivial.
+ now destruct a.
 Qed.
 
-Lemma Zmult_reg_r : forall n m p:Z, p <> Z0 -> n * p = m * p -> n = m.
+Lemma testbit_odd_succ a n : 0<=n ->
+ testbit (2*a+1) (succ n) = testbit a n.
 Proof.
-  intros x y z Hz.
-  rewrite (Zmult_comm x z).
-  rewrite (Zmult_comm y z).
-  intro; apply Zmult_reg_l with z; assumption.
+ destruct n as [|n|n]; (now destruct 1) || intros _.
+ destruct a as [|[a|a|]|[a|a|]]; simpl; trivial. now destruct a.
+ unfold testbit; simpl.
+ destruct a as [|a|[a|a|]]; simpl; trivial;
+  rewrite ?Pos.add_1_r, ?Pos.pred_N_succ; now destruct n.
 Qed.
 
-(** ** Addition and multiplication by 2 *)
+Lemma testbit_even_succ a n : 0<=n ->
+ testbit (2*a) (succ n) = testbit a n.
+Proof.
+ destruct n as [|n|n]; (now destruct 1) || intros _.
+ destruct a as [|[a|a|]|[a|a|]]; simpl; trivial. now destruct a.
+ unfold testbit; simpl.
+ destruct a as [|a|[a|a|]]; simpl; trivial;
+  rewrite ?Pos.add_1_r, ?Pos.pred_N_succ; now destruct n.
+Qed.
 
-Lemma Zplus_diag_eq_mult_2 : forall n:Z, n + n = n * Zpos 2.
+(** Correctness proofs about [Z.shiftr] and [Z.shiftl] *)
+
+Lemma shiftr_spec_aux a n m : 0<=n -> 0<=m ->
+ testbit (shiftr a n) m = testbit a (m+n).
 Proof.
-  intros x; pattern x at 1 2 in |- *; rewrite <- (Zmult_1_r x);
-    rewrite <- Zmult_plus_distr_r; reflexivity.
+ intros Hn Hm. unfold shiftr.
+ destruct n as [ |n|n]; (now destruct Hn) || clear Hn; simpl.
+ now rewrite add_0_r.
+ assert (forall p, to_N (m + pos p) = (to_N m + N.pos p)%N).
+  destruct m; trivial; now destruct Hm.
+ assert (forall p, 0 <= m + pos p).
+  destruct m; easy || now destruct Hm.
+ destruct a as [ |a|a].
+ (* a = 0 *)
+ replace (Pos.iter n div2 0) with 0
+  by (apply Pos.iter_invariant; intros; subst; trivial).
+ now rewrite 2 testbit_0_l.
+ (* a > 0 *)
+ change (pos a) with (of_N (N.pos a)) at 1.
+ rewrite <- (Pos.iter_swap_gen _ _ _ N.div2) by now intros [|[ | | ]].
+ rewrite testbit_Zpos, testbit_of_N', H; trivial.
+ exact (N.shiftr_spec' (N.pos a) (N.pos n) (to_N m)).
+ (* a < 0 *)
+ rewrite <- (Pos.iter_swap_gen _ _ _ Pos.div2_up) by trivial.
+ rewrite 2 testbit_Zneg, H; trivial. f_equal.
+ rewrite (Pos.iter_swap_gen _ _ _ _ N.div2) by exact N.pred_div2_up.
+ exact (N.shiftr_spec' (Pos.pred_N a) (N.pos n) (to_N m)).
 Qed.
 
-(** ** Multiplication and successor *)
+Lemma shiftl_spec_low a n m : m<n ->
+ testbit (shiftl a n) m = false.
+Proof.
+ intros H. destruct n as [|n|n], m as [|m|m]; try easy; simpl shiftl.
+ destruct (Pos.succ_pred_or n) as [-> | <-];
+  rewrite ?Pos.iter_succ; apply testbit_even_0.
+ destruct a as [ |a|a].
+ (* a = 0 *)
+ replace (Pos.iter n (mul 2) 0) with 0
+  by (apply Pos.iter_invariant; intros; subst; trivial).
+ apply testbit_0_l.
+ (* a > 0 *)
+ rewrite <- (Pos.iter_swap_gen _ _ _ xO) by trivial.
+ rewrite testbit_Zpos by easy.
+ exact (N.shiftl_spec_low (N.pos a) (N.pos n) (N.pos m) H).
+ (* a < 0 *)
+ rewrite <- (Pos.iter_swap_gen _ _ _ xO) by trivial.
+ rewrite testbit_Zneg by easy.
+ now rewrite (N.pos_pred_shiftl_low a (N.pos n)).
+Qed.
+
+Lemma shiftl_spec_high a n m : 0<=m -> n<=m ->
+ testbit (shiftl a n) m = testbit a (m-n).
+Proof.
+ intros Hm H.
+ destruct n as [ |n|n]. simpl. now rewrite sub_0_r.
+ (* n > 0 *)
+ destruct m as [ |m|m]; try (now destruct H).
+ assert (0 <= pos m - pos n).
+  red. now rewrite compare_antisym, <- compare_sub, <- compare_antisym.
+ assert (EQ : to_N (pos m - pos n) = (N.pos m - N.pos n)%N).
+  red in H. simpl in H. simpl to_N.
+  rewrite pos_sub_spec, Pos.compare_antisym.
+  destruct (Pos.compare_spec n m) as [H'|H'|H']; try (now destruct H).
+  subst. now rewrite N.sub_diag.
+  simpl. destruct (Pos.sub_mask_pos' m n H') as (p & -> & <-).
+  f_equal. now rewrite Pos.add_comm, Pos.add_sub.
+ destruct a; unfold shiftl.
+ (* ... a = 0 *)
+ replace (Pos.iter n (mul 2) 0) with 0
+  by (apply Pos.iter_invariant; intros; subst; trivial).
+ now rewrite 2 testbit_0_l.
+ (* ... a > 0 *)
+ rewrite <- (Pos.iter_swap_gen _ _ _ xO) by trivial.
+ rewrite 2 testbit_Zpos, EQ by easy.
+ exact (N.shiftl_spec_high' (N.pos p) (N.pos n) (N.pos m) H).
+ (* ... a < 0 *)
+ rewrite <- (Pos.iter_swap_gen _ _ _ xO) by trivial.
+ rewrite 2 testbit_Zneg, EQ by easy. f_equal.
+ simpl to_N.
+ rewrite <- N.shiftl_spec_high by easy.
+ now apply (N.pos_pred_shiftl_high p (N.pos n)).
+ (* n < 0 *)
+ unfold sub. simpl.
+ now apply (shiftr_spec_aux a (pos n) m).
+Qed.
+
+Lemma shiftr_spec a n m : 0<=m ->
+ testbit (shiftr a n) m = testbit a (m+n).
+Proof.
+ intros Hm.
+ destruct (leb_spec 0 n).
+ now apply shiftr_spec_aux.
+ destruct (leb_spec (-n) m) as [LE|GT].
+ unfold shiftr.
+ rewrite (shiftl_spec_high a (-n) m); trivial. now destruct n.
+ unfold shiftr.
+ rewrite (shiftl_spec_low a (-n) m); trivial.
+ rewrite testbit_neg_r; trivial.
+ red in GT. rewrite compare_sub in GT. now destruct n.
+Qed.
+
+(** Correctness proofs for bitwise operations *)
+
+Lemma lor_spec a b n :
+ testbit (lor a b) n = testbit a n || testbit b n.
+Proof.
+ destruct (leb_spec 0 n) as [Hn|Hn]; [|now rewrite !testbit_neg_r].
+ destruct a as [ |a|a], b as [ |b|b];
+  rewrite ?testbit_0_l, ?orb_false_r; trivial; unfold lor;
+  rewrite ?testbit_Zpos, ?testbit_Zneg, ?N.pos_pred_succ by trivial.
+ now rewrite <- N.lor_spec.
+ now rewrite N.ldiff_spec, negb_andb, negb_involutive, orb_comm.
+ now rewrite N.ldiff_spec, negb_andb, negb_involutive.
+ now rewrite N.land_spec, negb_andb.
+Qed.
+
+Lemma land_spec a b n :
+ testbit (land a b) n = testbit a n && testbit b n.
+Proof.
+ destruct (leb_spec 0 n) as [Hn|Hn]; [|now rewrite !testbit_neg_r].
+ destruct a as [ |a|a], b as [ |b|b];
+  rewrite ?testbit_0_l, ?andb_false_r; trivial; unfold land;
+  rewrite ?testbit_Zpos, ?testbit_Zneg, ?testbit_of_N', ?N.pos_pred_succ
+   by trivial.
+ now rewrite <- N.land_spec.
+ now rewrite N.ldiff_spec.
+ now rewrite N.ldiff_spec, andb_comm.
+ now rewrite N.lor_spec, negb_orb.
+Qed.
+
+Lemma ldiff_spec a b n :
+ testbit (ldiff a b) n = testbit a n && negb (testbit b n).
+Proof.
+ destruct (leb_spec 0 n) as [Hn|Hn]; [|now rewrite !testbit_neg_r].
+ destruct a as [ |a|a], b as [ |b|b];
+  rewrite ?testbit_0_l, ?andb_true_r; trivial; unfold ldiff;
+  rewrite ?testbit_Zpos, ?testbit_Zneg, ?testbit_of_N', ?N.pos_pred_succ
+   by trivial.
+ now rewrite <- N.ldiff_spec.
+ now rewrite N.land_spec, negb_involutive.
+ now rewrite N.lor_spec, negb_orb.
+ now rewrite N.ldiff_spec, negb_involutive, andb_comm.
+Qed.
+
+Lemma lxor_spec a b n :
+ testbit (lxor a b) n = xorb (testbit a n) (testbit b n).
+Proof.
+ destruct (leb_spec 0 n) as [Hn|Hn]; [|now rewrite !testbit_neg_r].
+ destruct a as [ |a|a], b as [ |b|b];
+  rewrite ?testbit_0_l, ?xorb_false_l, ?xorb_false_r; trivial; unfold lxor;
+  rewrite ?testbit_Zpos, ?testbit_Zneg, ?testbit_of_N', ?N.pos_pred_succ
+   by trivial.
+ now rewrite <- N.lxor_spec.
+ now rewrite N.lxor_spec, negb_xorb_r.
+ now rewrite N.lxor_spec, negb_xorb_l.
+ now rewrite N.lxor_spec, xorb_negb_negb.
+Qed.
 
-Lemma Zmult_succ_r : forall n m:Z, n * Zsucc m = n * m + n.
+(** ** Induction principles based on successor / predecessor *)
+
+Lemma peano_ind (P : Z -> Prop) :
+  P 0 ->
+  (forall x, P x -> P (succ x)) ->
+  (forall x, P x -> P (pred x)) ->
+  forall z, P z.
 Proof.
-  intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_r;
-    rewrite (Zmult_comm n (Zpos 1)); rewrite Zmult_1_l;
-      trivial with arith.
+ intros H0 Hs Hp z; destruct z.
+ assumption.
+ induction p using Pos.peano_ind.
+  now apply (Hs 0).
+  rewrite <- Pos.add_1_r.
+  now apply (Hs (pos p)).
+ induction p using Pos.peano_ind.
+  now apply (Hp 0).
+  rewrite <- Pos.add_1_r.
+  now apply (Hp (neg p)).
 Qed.
 
-Lemma Zmult_succ_r_reverse : forall n m:Z, n * m + n = n * Zsucc m.
+Lemma bi_induction (P : Z -> Prop) :
+  Proper (eq ==> iff) P ->
+  P 0 ->
+  (forall x, P x <-> P (succ x)) ->
+  forall z, P z.
 Proof.
-  intros; symmetry  in |- *; apply Zmult_succ_r.
+ intros _ H0 Hs. induction z using peano_ind.
+ assumption.
+ now apply -> Hs.
+ apply Hs. now rewrite succ_pred.
 Qed.
 
-Lemma Zmult_succ_l : forall n m:Z, Zsucc n * m = n * m + m.
+
+(** * Proofs of morphisms, obvious since eq is Leibniz *)
+
+Local Obligation Tactic := simpl_relation.
+Program Definition succ_wd : Proper (eq==>eq) succ := _.
+Program Definition pred_wd : Proper (eq==>eq) pred := _.
+Program Definition opp_wd : Proper (eq==>eq) opp := _.
+Program Definition add_wd : Proper (eq==>eq==>eq) add := _.
+Program Definition sub_wd : Proper (eq==>eq==>eq) sub := _.
+Program Definition mul_wd : Proper (eq==>eq==>eq) mul := _.
+Program Definition lt_wd : Proper (eq==>eq==>iff) lt := _.
+Program Definition div_wd : Proper (eq==>eq==>eq) div := _.
+Program Definition mod_wd : Proper (eq==>eq==>eq) modulo := _.
+Program Definition quot_wd : Proper (eq==>eq==>eq) quot := _.
+Program Definition rem_wd : Proper (eq==>eq==>eq) rem := _.
+Program Definition pow_wd : Proper (eq==>eq==>eq) pow := _.
+Program Definition testbit_wd : Proper (eq==>eq==>Logic.eq) testbit := _.
+
+(** The Bind Scope prevents Z to stay associated with abstract_scope.
+    (TODO FIX) *)
+
+Include ZProp. Bind Scope Z_scope with Z.
+Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
+
+(** In generic statements, the predicates [lt] and [le] have been
+  favored, whereas [gt] and [ge] don't even exist in the abstract
+  layers. The use of [gt] and [ge] is hence not recommended. We provide
+  here the bare minimal results to related them with [lt] and [le]. *)
+
+Lemma gt_lt_iff n m : n > m <-> m < n.
 Proof.
-  intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_l;
-    rewrite Zmult_1_l; trivial with arith.
+ unfold lt, gt. now rewrite compare_antisym, CompOpp_iff.
 Qed.
 
-Lemma Zmult_succ_l_reverse : forall n m:Z, n * m + m = Zsucc n * m.
+Lemma gt_lt n m : n > m -> m < n.
 Proof.
-  intros; symmetry  in |- *; apply Zmult_succ_l.
+ apply gt_lt_iff.
 Qed.
 
+Lemma lt_gt n m : n < m -> m > n.
+Proof.
+ apply gt_lt_iff.
+Qed.
 
+Lemma ge_le_iff n m : n >= m <-> m <= n.
+Proof.
+ unfold le, ge. now rewrite compare_antisym, CompOpp_iff.
+Qed.
 
-(** ** Misc redundant properties *)
+Lemma ge_le n m : n >= m -> m <= n.
+Proof.
+ apply ge_le_iff.
+Qed.
 
-Lemma Z_eq_mult : forall n m:Z, m = Z0 -> m * n = Z0.
+Lemma le_ge n m : n <= m -> m >= n.
 Proof.
-  intros x y H; rewrite H; auto with arith.
+ apply ge_le_iff.
 Qed.
 
+(** We provide a tactic converting from one style to the other. *)
 
+Ltac swap_greater := rewrite ?gt_lt_iff in *; rewrite ?ge_le_iff in *.
 
-(**********************************************************************)
-(** * Relating binary positive numbers and binary integers *)
+(** Similarly, the boolean comparisons [ltb] and [leb] are favored
+  over their dual [gtb] and [geb]. We prove here the equivalence
+  and a few minimal results. *)
 
-Lemma Zpos_eq : forall p q:positive, p = q -> Zpos p = Zpos q.
+Lemma gtb_ltb n m : (n >? m) = (m <? n).
 Proof.
-  intros; f_equal; auto.
+ unfold gtb, ltb. rewrite compare_antisym. now case compare.
 Qed.
 
-Lemma Zpos_eq_rev : forall p q:positive, Zpos p = Zpos q -> p = q.
+Lemma geb_leb n m : (n >=? m) = (m <=? n).
 Proof.
-  inversion 1; auto.
+ unfold geb, leb. rewrite compare_antisym. now case compare.
 Qed.
 
-Lemma Zpos_eq_iff : forall p q:positive, p = q <-> Zpos p = Zpos q.
+Lemma gtb_lt n m : (n >? m) = true <-> m < n.
 Proof.
-  split; [apply Zpos_eq|apply Zpos_eq_rev].
+ rewrite gtb_ltb. apply ltb_lt.
 Qed.
 
-Lemma Zpos_xI : forall p:positive, Zpos p~1 = Zpos 2 * Zpos p + Zpos 1.
+Lemma geb_le n m : (n >=? m) = true <-> m <= n.
 Proof.
-  intro; apply refl_equal.
+ rewrite geb_leb. apply leb_le.
 Qed.
 
-Lemma Zpos_xO : forall p:positive, Zpos p~0 = Zpos 2 * Zpos p.
+Lemma gtb_spec n m : BoolSpec (m<n) (n<=m) (n >? m).
 Proof.
-  intro; apply refl_equal.
+ rewrite gtb_ltb. apply ltb_spec.
 Qed.
 
-Lemma Zneg_xI : forall p:positive, Zneg p~1 = Zpos 2 * Zneg p - Zpos 1.
+Lemma geb_spec n m : BoolSpec (m<=n) (n<m) (n >=? m).
 Proof.
-  intro; apply refl_equal.
+ rewrite geb_leb. apply leb_spec.
 Qed.
 
-Lemma Zneg_xO : forall p:positive, Zneg p~0 = Zpos 2 * Zneg p.
+(** TODO : to add in Numbers ? *)
+
+Lemma add_reg_l n m p : n + m = n + p -> m = p.
 Proof.
-  reflexivity.
+ exact (proj1 (add_cancel_l m p n)).
 Qed.
 
-Lemma Zpos_plus_distr : forall p q:positive, Zpos (p + q) = Zpos p + Zpos q.
+Lemma mul_reg_l n m p : p <> 0 -> p * n = p * m -> n = m.
 Proof.
-  intros p p'; destruct p;
-    [ destruct p' as [p0| p0| ]
-      | destruct p' as [p0| p0| ]
-      | destruct p' as [p| p| ] ]; reflexivity.
+ exact (fun Hp => proj1 (mul_cancel_l n m p Hp)).
 Qed.
 
-Lemma Zneg_plus_distr : forall p q:positive, Zneg (p + q) = Zneg p + Zneg q.
+Lemma mul_reg_r n m p : p <> 0 -> n * p = m * p -> n = m.
 Proof.
-  intros p p'; destruct p;
-    [ destruct p' as [p0| p0| ]
-      | destruct p' as [p0| p0| ]
-      | destruct p' as [p| p| ] ]; reflexivity.
+ exact (fun Hp => proj1 (mul_cancel_r n m p Hp)).
 Qed.
 
-(**********************************************************************)
-(** * Order relations *)
+Lemma opp_eq_mul_m1 n : - n = n * -1.
+Proof.
+ rewrite mul_comm. now destruct n.
+Qed.
 
-Definition Zlt (x y:Z) := (x ?= y) = Lt.
-Definition Zgt (x y:Z) := (x ?= y) = Gt.
-Definition Zle (x y:Z) := (x ?= y) <> Gt.
-Definition Zge (x y:Z) := (x ?= y) <> Lt.
-Definition Zne (x y:Z) := x <> y.
+Lemma add_diag n : n + n = 2 * n.
+Proof.
+ change 2 with (1+1). now rewrite mul_add_distr_r, !mul_1_l.
+Qed.
+
+(** * Comparison and opposite *)
 
-Infix "<=" := Zle : Z_scope.
-Infix "<" := Zlt : Z_scope.
-Infix ">=" := Zge : Z_scope.
-Infix ">" := Zgt : Z_scope.
+Lemma compare_opp n m : (- n ?= - m) = (m ?= n).
+Proof.
+ destruct n, m; simpl; trivial; intros; now rewrite <- Pos.compare_antisym.
+Qed.
 
+(** * Comparison and addition *)
+
+Lemma add_compare_mono_l n m p : (n + m ?= n + p) = (m ?= p).
+Proof.
+ rewrite (compare_sub m p), compare_sub. f_equal.
+ unfold sub. rewrite opp_add_distr, (add_comm n m), add_assoc.
+ f_equal. now rewrite <- add_assoc, add_opp_diag_r, add_0_r.
+Qed.
+
+End Z.
+
+(** Re-export Notations *)
+
+Infix "+" := Z.add : Z_scope.
+Notation "- x" := (Z.opp x) : Z_scope.
+Infix "-" := Z.sub : Z_scope.
+Infix "*" := Z.mul : Z_scope.
+Infix "^" := Z.pow : Z_scope.
+Infix "/" := Z.div : Z_scope.
+Infix "mod" := Z.modulo (at level 40, no associativity) : Z_scope.
+Infix "÷" := Z.quot (at level 40, left associativity) : Z_scope.
+Infix "?=" := Z.compare (at level 70, no associativity) : Z_scope.
+Infix "=?" := Z.eqb (at level 70, no associativity) : Z_scope.
+Infix "<=?" := Z.leb (at level 70, no associativity) : Z_scope.
+Infix "<?" := Z.ltb (at level 70, no associativity) : Z_scope.
+Infix ">=?" := Z.geb (at level 70, no associativity) : Z_scope.
+Infix ">?" := Z.gtb (at level 70, no associativity) : Z_scope.
+Notation "( x | y )" := (Z.divide x y) (at level 0) : Z_scope.
+Infix "<=" := Z.le : Z_scope.
+Infix "<" := Z.lt : Z_scope.
+Infix ">=" := Z.ge : Z_scope.
+Infix ">" := Z.gt : Z_scope.
 Notation "x <= y <= z" := (x <= y /\ y <= z) : Z_scope.
 Notation "x <= y < z" := (x <= y /\ y < z) : Z_scope.
 Notation "x < y < z" := (x < y /\ y < z) : Z_scope.
 Notation "x < y <= z" := (x < y /\ y <= z) : Z_scope.
 
-(**********************************************************************)
-(** * Absolute value on integers *)
-
-Definition Zabs_nat (x:Z) : nat :=
-  match x with
-    | Z0 => 0%nat
-    | Zpos p => nat_of_P p
-    | Zneg p => nat_of_P p
-  end.
-
-Definition Zabs (z:Z) : Z :=
-  match z with
-    | Z0 => Z0
-    | Zpos p => Zpos p
-    | Zneg p => Zpos p
-  end.
-
-(**********************************************************************)
-(** * From [nat] to [Z] *)
-
-Definition Z_of_nat (x:nat) :=
-  match x with
-    | O => Z0
-    | S y => Zpos (P_of_succ_nat y)
-  end.
-
-Require Import BinNat.
-
-Definition Zabs_N (z:Z) :=
-  match z with
-    | Z0 => 0%N
-    | Zpos p => Npos p
-    | Zneg p => Npos p
-  end.
-
-Definition Z_of_N (x:N) :=
-  match x with
-    | N0 => Z0
-    | Npos p => Zpos p
-  end.
+(** Conversions from / to positive numbers *)
+
+Module Pos2Z.
+
+Lemma id p : Z.to_pos (Z.pos p) = p.
+Proof. reflexivity. Qed.
+
+Lemma inj p q : Z.pos p = Z.pos q -> p = q.
+Proof. now injection 1. Qed.
+
+Lemma inj_iff p q : Z.pos p = Z.pos q <-> p = q.
+Proof. split. apply inj. intros; now f_equal. Qed.
+
+Lemma is_pos p : 0 < Z.pos p.
+Proof. reflexivity. Qed.
+
+Lemma is_nonneg p : 0 <= Z.pos p.
+Proof. easy. Qed.
+
+Lemma inj_1 : Z.pos 1 = 1.
+Proof. reflexivity. Qed.
+
+Lemma inj_xO p : Z.pos p~0 = 2 * Z.pos p.
+Proof. reflexivity. Qed.
+
+Lemma inj_xI p : Z.pos p~1 = 2 * Z.pos p + 1.
+Proof. reflexivity. Qed.
+
+Lemma inj_succ p : Z.pos (Pos.succ p) = Z.succ (Z.pos p).
+Proof. simpl. now rewrite Pos.add_1_r. Qed.
+
+Lemma inj_add p q : Z.pos (p+q) = Z.pos p + Z.pos q.
+Proof. reflexivity. Qed.
+
+Lemma inj_sub p q : (p < q)%positive ->
+ Z.pos (q-p) = Z.pos q - Z.pos p.
+Proof. intros. simpl. now rewrite Z.pos_sub_gt. Qed.
+
+Lemma inj_sub_max p q : Z.pos (p - q) = Z.max 1 (Z.pos p - Z.pos q).
+Proof.
+  simpl. rewrite Z.pos_sub_spec. case Pos.compare_spec; intros.
+  - subst; now rewrite Pos.sub_diag.
+  - now rewrite Pos.sub_lt.
+  - now destruct (p-q)%positive.
+Qed.
+
+Lemma inj_pred p : p <> 1%positive ->
+ Z.pos (Pos.pred p) = Z.pred (Z.pos p).
+Proof. destruct p; easy || now destruct 1. Qed.
+
+Lemma inj_mul p q : Z.pos (p*q) = Z.pos p * Z.pos q.
+Proof. reflexivity. Qed.
+
+Lemma inj_pow_pos p q : Z.pos (p^q) = Z.pow_pos (Z.pos p) q.
+Proof. now apply Pos.iter_swap_gen. Qed.
+
+Lemma inj_pow p q : Z.pos (p^q) = (Z.pos p)^(Z.pos q).
+Proof. apply inj_pow_pos. Qed.
+
+Lemma inj_square p : Z.pos (Pos.square p) = Z.square (Z.pos p).
+Proof. reflexivity. Qed.
+
+Lemma inj_compare p q : (p ?= q)%positive = (Z.pos p ?= Z.pos q).
+Proof. reflexivity. Qed.
+
+Lemma inj_leb p q : (p <=? q)%positive = (Z.pos p <=? Z.pos q).
+Proof. reflexivity. Qed.
+
+Lemma inj_ltb p q : (p <? q)%positive = (Z.pos p <? Z.pos q).
+Proof. reflexivity. Qed.
+
+Lemma inj_eqb p q : (p =? q)%positive = (Z.pos p =? Z.pos q).
+Proof. reflexivity. Qed.
+
+Lemma inj_max p q : Z.pos (Pos.max p q) = Z.max (Z.pos p) (Z.pos q).
+Proof.
+ unfold Z.max, Pos.max. rewrite inj_compare. now case Z.compare_spec.
+Qed.
+
+Lemma inj_min p q : Z.pos (Pos.min p q) = Z.min (Z.pos p) (Z.pos q).
+Proof.
+ unfold Z.min, Pos.min. rewrite inj_compare. now case Z.compare_spec.
+Qed.
+
+Lemma inj_sqrt p : Z.pos (Pos.sqrt p) = Z.sqrt (Z.pos p).
+Proof. reflexivity. Qed.
+
+Lemma inj_gcd p q : Z.pos (Pos.gcd p q) = Z.gcd (Z.pos p) (Z.pos q).
+Proof. reflexivity. Qed.
+
+Definition inj_divide p q : (Z.pos p|Z.pos q) <-> (p|q)%positive.
+Proof. apply Z.Private_BootStrap.divide_Zpos. Qed.
+
+Lemma inj_testbit a n : 0<=n ->
+ Z.testbit (Z.pos a) n = N.testbit (N.pos a) (Z.to_N n).
+Proof. apply Z.Private_BootStrap.testbit_Zpos. Qed.
+
+(** Some results concerning Z.neg *)
+
+Lemma inj_neg p q : Z.neg p = Z.neg q -> p = q.
+Proof. now injection 1. Qed.
+
+Lemma inj_neg_iff p q : Z.neg p = Z.neg q <-> p = q.
+Proof. split. apply inj_neg. intros; now f_equal. Qed.
+
+Lemma neg_is_neg p : Z.neg p < 0.
+Proof. reflexivity. Qed.
+
+Lemma neg_is_nonpos p : Z.neg p <= 0.
+Proof. easy. Qed.
+
+Lemma neg_xO p : Z.neg p~0 = 2 * Z.neg p.
+Proof. reflexivity. Qed.
+
+Lemma neg_xI p : Z.neg p~1 = 2 * Z.neg p - 1.
+Proof. reflexivity. Qed.
+
+Lemma opp_neg p : - Z.neg p = Z.pos p.
+Proof. reflexivity. Qed.
+
+Lemma opp_pos p : - Z.pos p = Z.neg p.
+Proof. reflexivity. Qed.
+
+Lemma add_neg_neg p q : Z.neg p + Z.neg q = Z.neg (p+q).
+Proof. reflexivity. Qed.
+
+Lemma add_pos_neg p q : Z.pos p + Z.neg q = Z.pos_sub p q.
+Proof. reflexivity. Qed.
+
+Lemma add_neg_pos p q : Z.neg p + Z.pos q = Z.pos_sub q p.
+Proof. reflexivity. Qed.
+
+Lemma divide_pos_neg_r n p : (n|Z.pos p) <-> (n|Z.neg p).
+Proof. apply Z.Private_BootStrap.divide_Zpos_Zneg_r. Qed.
+
+Lemma divide_pos_neg_l n p : (Z.pos p|n) <-> (Z.neg p|n).
+Proof. apply Z.Private_BootStrap.divide_Zpos_Zneg_l. Qed.
+
+Lemma testbit_neg a n : 0<=n ->
+ Z.testbit (Z.neg a) n = negb (N.testbit (Pos.pred_N a) (Z.to_N n)).
+Proof. apply Z.Private_BootStrap.testbit_Zneg. Qed.
+
+End Pos2Z.
+
+Module Z2Pos.
+
+Lemma id x : 0 < x -> Z.pos (Z.to_pos x) = x.
+Proof. now destruct x. Qed.
+
+Lemma inj x y : 0 < x -> 0 < y -> Z.to_pos x = Z.to_pos y -> x = y.
+Proof.
+ destruct x; simpl; try easy. intros _ H ->. now apply id.
+Qed.
+
+Lemma inj_iff x y : 0 < x -> 0 < y -> (Z.to_pos x = Z.to_pos y <-> x = y).
+Proof. split. now apply inj. intros; now f_equal. Qed.
+
+Lemma to_pos_nonpos x : x <= 0 -> Z.to_pos x = 1%positive.
+Proof. destruct x; trivial. now destruct 1. Qed.
+
+Lemma inj_1 : Z.to_pos 1 = 1%positive.
+Proof. reflexivity. Qed.
+
+Lemma inj_double x : 0 < x ->
+ Z.to_pos (Z.double x) = (Z.to_pos x)~0%positive.
+Proof. now destruct x. Qed.
+
+Lemma inj_succ_double x : 0 < x ->
+ Z.to_pos (Z.succ_double x) = (Z.to_pos x)~1%positive.
+Proof. now destruct x. Qed.
+
+Lemma inj_succ x : 0 < x -> Z.to_pos (Z.succ x) = Pos.succ (Z.to_pos x).
+Proof.
+ destruct x; try easy. simpl. now rewrite Pos.add_1_r.
+Qed.
+
+Lemma inj_add x y : 0 < x -> 0 < y ->
+ Z.to_pos (x+y) = (Z.to_pos x + Z.to_pos y)%positive.
+Proof. destruct x; easy || now destruct y. Qed.
+
+Lemma inj_sub x y : 0 < x < y ->
+ Z.to_pos (y-x) = (Z.to_pos y - Z.to_pos x)%positive.
+Proof.
+ destruct x; try easy. destruct y; try easy. simpl.
+ intros. now rewrite Z.pos_sub_gt.
+Qed.
+
+Lemma inj_pred x : 1 < x -> Z.to_pos (Z.pred x) = Pos.pred (Z.to_pos x).
+Proof. now destruct x as [|[x|x|]|]. Qed.
+
+Lemma inj_mul x y : 0 < x -> 0 < y ->
+ Z.to_pos (x*y) = (Z.to_pos x * Z.to_pos y)%positive.
+Proof. destruct x; easy || now destruct y. Qed.
+
+Lemma inj_pow x y : 0 < x -> 0 < y ->
+ Z.to_pos (x^y) = (Z.to_pos x ^ Z.to_pos y)%positive.
+Proof.
+ intros. apply Pos2Z.inj. rewrite Pos2Z.inj_pow, !id; trivial.
+ apply Z.pow_pos_nonneg. trivial. now apply Z.lt_le_incl.
+Qed.
+
+Lemma inj_pow_pos x p : 0 < x ->
+ Z.to_pos (Z.pow_pos x p) = ((Z.to_pos x)^p)%positive.
+Proof. intros. now apply (inj_pow x (Z.pos p)). Qed.
+
+Lemma inj_compare x y : 0 < x -> 0 < y ->
+ (x ?= y) = (Z.to_pos x ?= Z.to_pos y)%positive.
+Proof. destruct x; easy || now destruct y. Qed.
+
+Lemma inj_leb x y : 0 < x -> 0 < y ->
+ (x <=? y) = (Z.to_pos x <=? Z.to_pos y)%positive.
+Proof. destruct x; easy || now destruct y. Qed.
+
+Lemma inj_ltb x y : 0 < x -> 0 < y ->
+ (x <? y) = (Z.to_pos x <? Z.to_pos y)%positive.
+Proof. destruct x; easy || now destruct y. Qed.
+
+Lemma inj_eqb x y : 0 < x -> 0 < y ->
+ (x =? y) = (Z.to_pos x =? Z.to_pos y)%positive.
+Proof. destruct x; easy || now destruct y. Qed.
+
+Lemma inj_max x y :
+ Z.to_pos (Z.max x y) = Pos.max (Z.to_pos x) (Z.to_pos y).
+Proof.
+ destruct x; simpl; try rewrite Pos.max_1_l.
+ - now destruct y.
+ - destruct y; simpl; now rewrite ?Pos.max_1_r, <- ?Pos2Z.inj_max.
+ - destruct y; simpl; rewrite ?Pos.max_1_r; trivial.
+   apply to_pos_nonpos. now apply Z.max_lub.
+Qed.
+
+Lemma inj_min x y :
+ Z.to_pos (Z.min x y) = Pos.min (Z.to_pos x) (Z.to_pos y).
+Proof.
+ destruct x; simpl; try rewrite Pos.min_1_l.
+ - now destruct y.
+ - destruct y; simpl; now rewrite ?Pos.min_1_r, <- ?Pos2Z.inj_min.
+ - destruct y; simpl; rewrite ?Pos.min_1_r; trivial.
+   apply to_pos_nonpos. apply Z.min_le_iff. now left.
+Qed.
+
+Lemma inj_sqrt x : Z.to_pos (Z.sqrt x) = Pos.sqrt (Z.to_pos x).
+Proof. now destruct x. Qed.
+
+Lemma inj_gcd x y : 0 < x -> 0 < y ->
+ Z.to_pos (Z.gcd x y) = Pos.gcd (Z.to_pos x) (Z.to_pos y).
+Proof. destruct x; easy || now destruct y. Qed.
+
+End Z2Pos.
+
+(** Compatibility Notations *)
+
+Notation Zdouble_plus_one := Z.succ_double (compat "8.3").
+Notation Zdouble_minus_one := Z.pred_double (compat "8.3").
+Notation Zdouble := Z.double (compat "8.3").
+Notation ZPminus := Z.pos_sub (compat "8.3").
+Notation Zsucc' := Z.succ (compat "8.3").
+Notation Zpred' := Z.pred (compat "8.3").
+Notation Zplus' := Z.add (compat "8.3").
+Notation Zplus := Z.add (compat "8.3"). (* Slightly incompatible *)
+Notation Zopp := Z.opp (compat "8.3").
+Notation Zsucc := Z.succ (compat "8.3").
+Notation Zpred := Z.pred (compat "8.3").
+Notation Zminus := Z.sub (compat "8.3").
+Notation Zmult := Z.mul (compat "8.3").
+Notation Zcompare := Z.compare (compat "8.3").
+Notation Zsgn := Z.sgn (compat "8.3").
+Notation Zle := Z.le (compat "8.3").
+Notation Zge := Z.ge (compat "8.3").
+Notation Zlt := Z.lt (compat "8.3").
+Notation Zgt := Z.gt (compat "8.3").
+Notation Zmax := Z.max (compat "8.3").
+Notation Zmin := Z.min (compat "8.3").
+Notation Zabs := Z.abs (compat "8.3").
+Notation Zabs_nat := Z.abs_nat (compat "8.3").
+Notation Zabs_N := Z.abs_N (compat "8.3").
+Notation Z_of_nat := Z.of_nat (compat "8.3").
+Notation Z_of_N := Z.of_N (compat "8.3").
+
+Notation Zind := Z.peano_ind (compat "8.3").
+Notation Zopp_0 := Z.opp_0 (compat "8.3").
+Notation Zopp_involutive := Z.opp_involutive (compat "8.3").
+Notation Zopp_inj := Z.opp_inj (compat "8.3").
+Notation Zplus_0_l := Z.add_0_l (compat "8.3").
+Notation Zplus_0_r := Z.add_0_r (compat "8.3").
+Notation Zplus_comm := Z.add_comm (compat "8.3").
+Notation Zopp_plus_distr := Z.opp_add_distr (compat "8.3").
+Notation Zopp_succ := Z.opp_succ (compat "8.3").
+Notation Zplus_opp_r := Z.add_opp_diag_r (compat "8.3").
+Notation Zplus_opp_l := Z.add_opp_diag_l (compat "8.3").
+Notation Zplus_assoc := Z.add_assoc (compat "8.3").
+Notation Zplus_permute := Z.add_shuffle3 (compat "8.3").
+Notation Zplus_reg_l := Z.add_reg_l (compat "8.3").
+Notation Zplus_succ_l := Z.add_succ_l (compat "8.3").
+Notation Zplus_succ_comm := Z.add_succ_comm (compat "8.3").
+Notation Zsucc_discr := Z.neq_succ_diag_r (compat "8.3").
+Notation Zsucc_inj := Z.succ_inj (compat "8.3").
+Notation Zsucc'_inj := Z.succ_inj (compat "8.3").
+Notation Zsucc'_pred' := Z.succ_pred (compat "8.3").
+Notation Zpred'_succ' := Z.pred_succ (compat "8.3").
+Notation Zpred'_inj := Z.pred_inj (compat "8.3").
+Notation Zsucc'_discr := Z.neq_succ_diag_r (compat "8.3").
+Notation Zminus_0_r := Z.sub_0_r (compat "8.3").
+Notation Zminus_diag := Z.sub_diag (compat "8.3").
+Notation Zminus_plus_distr := Z.sub_add_distr (compat "8.3").
+Notation Zminus_succ_r := Z.sub_succ_r (compat "8.3").
+Notation Zminus_plus := Z.add_simpl_l (compat "8.3").
+Notation Zmult_0_l := Z.mul_0_l (compat "8.3").
+Notation Zmult_0_r := Z.mul_0_r (compat "8.3").
+Notation Zmult_1_l := Z.mul_1_l (compat "8.3").
+Notation Zmult_1_r := Z.mul_1_r (compat "8.3").
+Notation Zmult_comm := Z.mul_comm (compat "8.3").
+Notation Zmult_assoc := Z.mul_assoc (compat "8.3").
+Notation Zmult_permute := Z.mul_shuffle3 (compat "8.3").
+Notation Zmult_1_inversion_l := Z.mul_eq_1 (compat "8.3").
+Notation Zdouble_mult := Z.double_spec (compat "8.3").
+Notation Zdouble_plus_one_mult := Z.succ_double_spec (compat "8.3").
+Notation Zopp_mult_distr_l_reverse := Z.mul_opp_l (compat "8.3").
+Notation Zmult_opp_opp := Z.mul_opp_opp (compat "8.3").
+Notation Zmult_opp_comm := Z.mul_opp_comm (compat "8.3").
+Notation Zopp_eq_mult_neg_1 := Z.opp_eq_mul_m1 (compat "8.3").
+Notation Zmult_plus_distr_r := Z.mul_add_distr_l (compat "8.3").
+Notation Zmult_plus_distr_l := Z.mul_add_distr_r (compat "8.3").
+Notation Zmult_minus_distr_r := Z.mul_sub_distr_r (compat "8.3").
+Notation Zmult_reg_l := Z.mul_reg_l (compat "8.3").
+Notation Zmult_reg_r := Z.mul_reg_r (compat "8.3").
+Notation Zmult_succ_l := Z.mul_succ_l (compat "8.3").
+Notation Zmult_succ_r := Z.mul_succ_r (compat "8.3").
+
+Notation Zpos_xI := Pos2Z.inj_xI (compat "8.3").
+Notation Zpos_xO := Pos2Z.inj_xO (compat "8.3").
+Notation Zneg_xI := Pos2Z.neg_xI (compat "8.3").
+Notation Zneg_xO := Pos2Z.neg_xO (compat "8.3").
+Notation Zopp_neg := Pos2Z.opp_neg (compat "8.3").
+Notation Zpos_succ_morphism := Pos2Z.inj_succ (compat "8.3").
+Notation Zpos_mult_morphism := Pos2Z.inj_mul (compat "8.3").
+Notation Zpos_minus_morphism := Pos2Z.inj_sub (compat "8.3").
+Notation Zpos_eq_rev := Pos2Z.inj (compat "8.3").
+Notation Zpos_plus_distr := Pos2Z.inj_add (compat "8.3").
+Notation Zneg_plus_distr := Pos2Z.add_neg_neg (compat "8.3").
+
+Notation Z := Z (only parsing).
+Notation Z_rect := Z_rect (only parsing).
+Notation Z_rec := Z_rec (only parsing).
+Notation Z_ind := Z_ind (only parsing).
+Notation Z0 := Z0 (only parsing).
+Notation Zpos := Zpos (only parsing).
+Notation Zneg := Zneg (only parsing).
+
+(** Compatibility lemmas. These could be notations,
+    but scope information would be lost.
+*)
+
+Notation SYM1 lem := (fun n => eq_sym (lem n)).
+Notation SYM2 lem := (fun n m => eq_sym (lem n m)).
+Notation SYM3 lem := (fun n m p => eq_sym (lem n m p)).
+
+Lemma Zplus_assoc_reverse : forall n m p, n+m+p = n+(m+p).
+Proof (SYM3 Z.add_assoc).
+Lemma Zplus_succ_r_reverse : forall n m, Z.succ (n+m) = n+Z.succ m.
+Proof (SYM2 Z.add_succ_r).
+Notation Zplus_succ_r := Zplus_succ_r_reverse (only parsing).
+Lemma Zplus_0_r_reverse : forall n, n = n + 0.
+Proof (SYM1 Z.add_0_r).
+Lemma Zplus_eq_compat : forall n m p q, n=m -> p=q -> n+p=m+q.
+Proof (f_equal2 Z.add).
+Lemma Zsucc_pred : forall n, n = Z.succ (Z.pred n).
+Proof (SYM1 Z.succ_pred).
+Lemma Zpred_succ : forall n, n = Z.pred (Z.succ n).
+Proof (SYM1 Z.pred_succ).
+Lemma Zsucc_eq_compat : forall n m, n = m -> Z.succ n = Z.succ m.
+Proof (f_equal Z.succ).
+Lemma Zminus_0_l_reverse : forall n, n = n - 0.
+Proof (SYM1 Z.sub_0_r).
+Lemma Zminus_diag_reverse : forall n, 0 = n-n.
+Proof (SYM1 Z.sub_diag).
+Lemma Zminus_succ_l : forall n m, Z.succ (n - m) = Z.succ n - m.
+Proof (SYM2 Z.sub_succ_l).
+Lemma Zplus_minus_eq : forall n m p, n = m + p -> p = n - m.
+Proof. intros. now apply Z.add_move_l. Qed.
+Lemma Zplus_minus : forall n m, n + (m - n) = m.
+Proof (fun n m => eq_trans (Z.add_comm n (m-n)) (Z.sub_add n m)).
+Lemma Zminus_plus_simpl_l : forall n m p, p + n - (p + m) = n - m.
+Proof (fun n m p => Z.add_add_simpl_l_l p n m).
+Lemma Zminus_plus_simpl_l_reverse : forall n m p, n - m = p + n - (p + m).
+Proof (SYM3 Zminus_plus_simpl_l).
+Lemma Zminus_plus_simpl_r : forall n m p, n + p - (m + p) = n - m.
+Proof (fun n m p => Z.add_add_simpl_r_r n p m).
+Lemma Zeq_minus : forall n m, n = m -> n - m = 0.
+Proof (fun n m => proj2 (Z.sub_move_0_r n m)).
+Lemma Zminus_eq : forall n m, n - m = 0 -> n = m.
+Proof (fun n m => proj1 (Z.sub_move_0_r n m)).
+Lemma Zmult_0_r_reverse : forall n, 0 = n * 0.
+Proof (SYM1 Z.mul_0_r).
+Lemma Zmult_assoc_reverse : forall n m p, n * m * p = n * (m * p).
+Proof (SYM3 Z.mul_assoc).
+Lemma Zmult_integral : forall n m, n * m = 0 -> n = 0 \/ m = 0.
+Proof (fun n m => proj1 (Z.mul_eq_0 n m)).
+Lemma Zmult_integral_l : forall n m, n <> 0 -> m * n = 0 -> m = 0.
+Proof (fun n m H H' => Z.mul_eq_0_l m n H' H).
+Lemma Zopp_mult_distr_l : forall n m, - (n * m) = - n * m.
+Proof (SYM2 Z.mul_opp_l).
+Lemma Zopp_mult_distr_r : forall n m, - (n * m) = n * - m.
+Proof (SYM2 Z.mul_opp_r).
+Lemma Zmult_minus_distr_l : forall n m p, p * (n - m) = p * n - p * m.
+Proof (fun n m p => Z.mul_sub_distr_l p n m).
+Lemma Zmult_succ_r_reverse : forall n m, n * m + n = n * Z.succ m.
+Proof (SYM2 Z.mul_succ_r).
+Lemma Zmult_succ_l_reverse : forall n m, n * m + m = Z.succ n * m.
+Proof (SYM2 Z.mul_succ_l).
+Lemma Zpos_eq : forall p q, p = q -> Z.pos p = Z.pos q.
+Proof. congruence. Qed.
+Lemma Zpos_eq_iff : forall p q, p = q <-> Z.pos p = Z.pos q.
+Proof (fun p q => iff_sym (Pos2Z.inj_iff p q)).
+
+Hint Immediate Zsucc_pred: zarith.
+
+(* Not kept :
+Zplus_0_simpl_l
+Zplus_0_simpl_l_reverse
+Zplus_opp_expand
+Zsucc_inj_contrapositive
+Zsucc_succ'
+Zpred_pred'
+*)
+
+(* No compat notation for :
+weak_assoc (now Z.add_assoc_pos)
+weak_Zmult_plus_distr_r (now Z.mul_add_distr_pos)
+*)
+
+(** Obsolete stuff *)
+
+Definition Zne (x y:Z) := x <> y. (* TODO : to remove someday ? *)
+
+Ltac elim_compare com1 com2 :=
+  case (Dcompare (com1 ?= com2)%Z);
+    [ idtac | let x := fresh "H" in
+      (intro x; case x; clear x) ].
+
+Lemma ZL0 : 2%nat = (1 + 1)%nat.
+Proof.
+  reflexivity.
+Qed.
+
+Lemma Zplus_diag_eq_mult_2 n : n + n = n * 2.
+Proof.
+ rewrite Z.mul_comm. apply Z.add_diag.
+Qed.
+
+Lemma Z_eq_mult n m : m = 0 -> m * n = 0.
+Proof.
+ intros; now subst.
+Qed.
diff --git a/theories/ZArith/BinIntDef.v b/theories/ZArith/BinIntDef.v
new file mode 100644
index 00000000..958ce2ef
--- /dev/null
+++ b/theories/ZArith/BinIntDef.v
@@ -0,0 +1,619 @@
+(* -*- coding: utf-8 -*- *)
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Export BinNums.
+Require Import BinPos BinNat.
+
+Local Open Scope Z_scope.
+
+(***********************************************************)
+(** * Binary Integers, Definitions of Operations *)
+(***********************************************************)
+
+(** Initial author: Pierre Crégut, CNET, Lannion, France *)
+
+Module Z.
+
+Definition t := Z.
+
+(** ** Nicer names [Z.pos] and [Z.neg] for contructors *)
+
+Notation pos := Zpos.
+Notation neg := Zneg.
+
+(** ** Constants *)
+
+Definition zero := 0.
+Definition one := 1.
+Definition two := 2.
+
+(** ** Doubling and variants *)
+
+Definition double x :=
+  match x with
+    | 0 => 0
+    | pos p => pos p~0
+    | neg p => neg p~0
+  end.
+
+Definition succ_double x :=
+  match x with
+    | 0 => 1
+    | pos p => pos p~1
+    | neg p => neg (Pos.pred_double p)
+  end.
+
+Definition pred_double x :=
+  match x with
+    | 0 => -1
+    | neg p => neg p~1
+    | pos p => pos (Pos.pred_double p)
+  end.
+
+(** ** Subtraction of positive into Z *)
+
+Fixpoint pos_sub (x y:positive) {struct y} : Z :=
+  match x, y with
+    | p~1, q~1 => double (pos_sub p q)
+    | p~1, q~0 => succ_double (pos_sub p q)
+    | p~1, 1 => pos p~0
+    | p~0, q~1 => pred_double (pos_sub p q)
+    | p~0, q~0 => double (pos_sub p q)
+    | p~0, 1 => pos (Pos.pred_double p)
+    | 1, q~1 => neg q~0
+    | 1, q~0 => neg (Pos.pred_double q)
+    | 1, 1 => Z0
+  end%positive.
+
+(** ** Addition *)
+
+Definition add x y :=
+  match x, y with
+    | 0, y => y
+    | x, 0 => x
+    | pos x', pos y' => pos (x' + y')
+    | pos x', neg y' => pos_sub x' y'
+    | neg x', pos y' => pos_sub y' x'
+    | neg x', neg y' => neg (x' + y')
+  end.
+
+Infix "+" := add : Z_scope.
+
+(** ** Opposite *)
+
+Definition opp x :=
+  match x with
+    | 0 => 0
+    | pos x => neg x
+    | neg x => pos x
+  end.
+
+Notation "- x" := (opp x) : Z_scope.
+
+(** ** Successor *)
+
+Definition succ x := x + 1.
+
+(** ** Predecessor *)
+
+Definition pred x := x + -1.
+
+(** ** Subtraction *)
+
+Definition sub m n := m + -n.
+
+Infix "-" := sub : Z_scope.
+
+(** ** Multiplication *)
+
+Definition mul x y :=
+  match x, y with
+    | 0, _ => 0
+    | _, 0 => 0
+    | pos x', pos y' => pos (x' * y')
+    | pos x', neg y' => neg (x' * y')
+    | neg x', pos y' => neg (x' * y')
+    | neg x', neg y' => pos (x' * y')
+  end.
+
+Infix "*" := mul : Z_scope.
+
+(** ** Power function *)
+
+Definition pow_pos (z:Z) (n:positive) := Pos.iter n (mul z) 1.
+
+Definition pow x y :=
+  match y with
+    | pos p => pow_pos x p
+    | 0 => 1
+    | neg _ => 0
+  end.
+
+Infix "^" := pow : Z_scope.
+
+(** ** Square *)
+
+Definition square x :=
+  match x with
+    | 0 => 0
+    | pos p => pos (Pos.square p)
+    | neg p => pos (Pos.square p)
+  end.
+
+(** ** Comparison *)
+
+Definition compare x y :=
+  match x, y with
+    | 0, 0 => Eq
+    | 0, pos y' => Lt
+    | 0, neg y' => Gt
+    | pos x', 0 => Gt
+    | pos x', pos y' => (x' ?= y')%positive
+    | pos x', neg y' => Gt
+    | neg x', 0 => Lt
+    | neg x', pos y' => Lt
+    | neg x', neg y' => CompOpp ((x' ?= y')%positive)
+  end.
+
+Infix "?=" := compare (at level 70, no associativity) : Z_scope.
+
+(** ** Sign function *)
+
+Definition sgn z :=
+  match z with
+    | 0 => 0
+    | pos p => 1
+    | neg p => -1
+  end.
+
+(** Boolean equality and comparisons *)
+
+Definition leb x y :=
+  match x ?= y with
+    | Gt => false
+    | _ => true
+  end.
+
+Definition ltb x y :=
+  match x ?= y with
+    | Lt => true
+    | _ => false
+  end.
+
+(** Nota: [geb] and [gtb] are provided for compatibility,
+  but [leb] and [ltb] should rather be used instead, since
+  more results will be available on them. *)
+
+Definition geb x y :=
+  match x ?= y with
+    | Lt => false
+    | _ => true
+  end.
+
+Definition gtb x y :=
+  match x ?= y with
+    | Gt => true
+    | _ => false
+  end.
+
+Fixpoint eqb x y :=
+  match x, y with
+    | 0, 0 => true
+    | pos p, pos q => Pos.eqb p q
+    | neg p, neg q => Pos.eqb p q
+    | _, _ => false
+  end.
+
+Infix "=?" := eqb (at level 70, no associativity) : Z_scope.
+Infix "<=?" := leb (at level 70, no associativity) : Z_scope.
+Infix "<?" := ltb (at level 70, no associativity) : Z_scope.
+Infix ">=?" := geb (at level 70, no associativity) : Z_scope.
+Infix ">?" := gtb (at level 70, no associativity) : Z_scope.
+
+(** ** Minimum and maximum *)
+
+Definition max n m :=
+  match n ?= m with
+    | Eq | Gt => n
+    | Lt => m
+  end.
+
+Definition min n m :=
+  match n ?= m with
+    | Eq | Lt => n
+    | Gt => m
+  end.
+
+(** ** Absolute value *)
+
+Definition abs z :=
+  match z with
+    | 0 => 0
+    | pos p => pos p
+    | neg p => pos p
+  end.
+
+(** ** Conversions *)
+
+(** From [Z] to [nat] via absolute value *)
+
+Definition abs_nat (z:Z) : nat :=
+  match z with
+    | 0 => 0%nat
+    | pos p => Pos.to_nat p
+    | neg p => Pos.to_nat p
+  end.
+
+(** From [Z] to [N] via absolute value *)
+
+Definition abs_N (z:Z) : N :=
+  match z with
+    | 0 => 0%N
+    | pos p => N.pos p
+    | neg p => N.pos p
+  end.
+
+(** From [Z] to [nat] by rounding negative numbers to 0 *)
+
+Definition to_nat (z:Z) : nat :=
+  match z with
+    | pos p => Pos.to_nat p
+    | _ => O
+  end.
+
+(** From [Z] to [N] by rounding negative numbers to 0 *)
+
+Definition to_N (z:Z) : N :=
+  match z with
+    | pos p => N.pos p
+    | _ => 0%N
+  end.
+
+(** From [nat] to [Z] *)
+
+Definition of_nat (n:nat) : Z :=
+  match n with
+   | O => 0
+   | S n => pos (Pos.of_succ_nat n)
+  end.
+
+(** From [N] to [Z] *)
+
+Definition of_N (n:N) : Z :=
+  match n with
+    | 0%N => 0
+    | N.pos p => pos p
+  end.
+
+(** From [Z] to [positive] by rounding nonpositive numbers to 1 *)
+
+Definition to_pos (z:Z) : positive :=
+  match z with
+    | pos p => p
+    | _ => 1%positive
+  end.
+
+(** ** Iteration of a function
+
+    By convention, iterating a negative number of times is identity.
+*)
+
+Definition iter (n:Z) {A} (f:A -> A) (x:A) :=
+  match n with
+    | pos p => Pos.iter p f x
+    | _ => x
+  end.
+
+(** ** Euclidean divisions for binary integers *)
+
+(** Concerning the many possible variants of integer divisions,
+    see the headers of the generic files [ZDivFloor], [ZDivTrunc],
+    [ZDivEucl], and the article by R. Boute mentioned there.
+    We provide here two flavours, Floor and Trunc, while
+    the Euclid convention can be found in file Zeuclid.v
+    For non-zero b, they all satisfy [a = b*(a/b) + (a mod b)]
+    and [ |a mod b| < |b| ], but the sign of the modulo will differ
+    when [a<0] and/or [b<0].
+*)
+
+(** ** Floor division *)
+
+(** [div_eucl] provides a Truncated-Toward-Bottom (a.k.a Floor)
+  Euclidean division. Its projections are named [div] (noted "/")
+  and [modulo] (noted with an infix "mod").
+  These functions correspond to the `div` and `mod` of Haskell.
+  This is the historical convention of Coq.
+
+  The main properties of this convention are :
+    - we have [sgn (a mod b) = sgn (b)]
+    - [div a b] is the greatest integer smaller or equal to the exact
+      fraction [a/b].
+    - there is no easy sign rule.
+
+  In addition, note that we arbitrary take [a/0 = 0] and [a mod 0 = 0].
+*)
+
+(** First, a division for positive numbers. Even if the second
+   argument is a Z, the answer is arbitrary is it isn't a Zpos. *)
+
+Fixpoint pos_div_eucl (a:positive) (b:Z) : Z * Z :=
+  match a with
+    | xH => if 2 <=? b then (0, 1) else (1, 0)
+    | xO a' =>
+      let (q, r) := pos_div_eucl a' b in
+      let r' := 2 * r in
+      if r' <? b then (2 * q, r') else (2 * q + 1, r' - b)
+    | xI a' =>
+      let (q, r) := pos_div_eucl a' b in
+      let r' := 2 * r + 1 in
+      if r' <? b then (2 * q, r') else (2 * q + 1, r' - b)
+  end.
+
+(** Then the general euclidean division *)
+
+Definition div_eucl (a b:Z) : Z * Z :=
+  match a, b with
+    | 0, _ => (0, 0)
+    | _, 0 => (0, 0)
+    | pos a', pos _ => pos_div_eucl a' b
+    | neg a', pos _ =>
+      let (q, r) := pos_div_eucl a' b in
+	match r with
+	  | 0 => (- q, 0)
+	  | _ => (- (q + 1), b - r)
+	end
+    | neg a', neg b' =>
+      let (q, r) := pos_div_eucl a' (pos b') in (q, - r)
+    | pos a', neg b' =>
+      let (q, r) := pos_div_eucl a' (pos b') in
+	match r with
+	  | 0 => (- q, 0)
+	  | _ => (- (q + 1), b + r)
+	end
+  end.
+
+Definition div (a b:Z) : Z := let (q, _) := div_eucl a b in q.
+Definition modulo (a b:Z) : Z := let (_, r) := div_eucl a b in r.
+
+Infix "/" := div : Z_scope.
+Infix "mod" := modulo (at level 40, no associativity) : Z_scope.
+
+
+(** ** Trunc Division *)
+
+(** [quotrem] provides a Truncated-Toward-Zero Euclidean division.
+  Its projections are named [quot] (noted "÷") and [rem].
+  These functions correspond to the `quot` and `rem` of Haskell.
+  This division convention is used in most programming languages,
+  e.g. Ocaml.
+
+  With this convention:
+   - we have [sgn(a rem b) = sgn(a)]
+   - sign rule for division: [quot (-a) b = quot a (-b) = -(quot a b)]
+   - and for modulo: [a rem (-b) = a rem b] and [(-a) rem b = -(a rem b)]
+
+ Note that we arbitrary take here [quot a 0 = 0] and [a rem 0 = a].
+*)
+
+Definition quotrem (a b:Z) : Z * Z :=
+  match a, b with
+   | 0,  _ => (0, 0)
+   | _, 0  => (0, a)
+   | pos a, pos b =>
+     let (q, r) := N.pos_div_eucl a (N.pos b) in (of_N q, of_N r)
+   | neg a, pos b =>
+     let (q, r) := N.pos_div_eucl a (N.pos b) in (-of_N q, - of_N r)
+   | pos a, neg b =>
+     let (q, r) := N.pos_div_eucl a (N.pos b) in (-of_N q, of_N r)
+   | neg a, neg b =>
+     let (q, r) := N.pos_div_eucl a (N.pos b) in (of_N q, - of_N r)
+  end.
+
+Definition quot a b := fst (quotrem a b).
+Definition rem a b := snd (quotrem a b).
+
+Infix "÷" := quot (at level 40, left associativity) : Z_scope.
+(** No infix notation for rem, otherwise it becomes a keyword *)
+
+
+(** ** Parity functions *)
+
+Definition even z :=
+  match z with
+    | 0 => true
+    | pos (xO _) => true
+    | neg (xO _) => true
+    | _ => false
+  end.
+
+Definition odd z :=
+  match z with
+    | 0 => false
+    | pos (xO _) => false
+    | neg (xO _) => false
+    | _ => true
+  end.
+
+
+(** ** Division by two *)
+
+(** [div2] performs rounding toward bottom, it is hence a particular
+   case of [div], and for all relative number [n] we have:
+   [n = 2 * div2 n + if odd n then 1 else 0].  *)
+
+Definition div2 z :=
+ match z with
+   | 0 => 0
+   | pos 1 => 0
+   | pos p => pos (Pos.div2 p)
+   | neg p => neg (Pos.div2_up p)
+ end.
+
+(** [quot2] performs rounding toward zero, it is hence a particular
+   case of [quot], and for all relative number [n] we have:
+   [n = 2 * quot2 n + if odd n then sgn n else 0].  *)
+
+Definition quot2 (z:Z) :=
+  match z with
+    | 0 => 0
+    | pos 1 => 0
+    | pos p => pos (Pos.div2 p)
+    | neg 1 => 0
+    | neg p => neg (Pos.div2 p)
+  end.
+
+(** NB: [Z.quot2] used to be named [Z.div2] in Coq <= 8.3 *)
+
+
+(** * Base-2 logarithm *)
+
+Definition log2 z :=
+  match z with
+    | pos (p~1) => pos (Pos.size p)
+    | pos (p~0) => pos (Pos.size p)
+    | _ => 0
+  end.
+
+
+(** ** Square root *)
+
+Definition sqrtrem n :=
+ match n with
+  | 0 => (0, 0)
+  | pos p =>
+    match Pos.sqrtrem p with
+     | (s, IsPos r) => (pos s, pos r)
+     | (s, _) => (pos s, 0)
+    end
+  | neg _ => (0,0)
+ end.
+
+Definition sqrt n :=
+ match n with
+  | pos p => pos (Pos.sqrt p)
+  | _ => 0
+ end.
+
+
+(** ** Greatest Common Divisor *)
+
+Definition gcd a b :=
+  match a,b with
+    | 0, _ => abs b
+    | _, 0 => abs a
+    | pos a, pos b => pos (Pos.gcd a b)
+    | pos a, neg b => pos (Pos.gcd a b)
+    | neg a, pos b => pos (Pos.gcd a b)
+    | neg a, neg b => pos (Pos.gcd a b)
+  end.
+
+(** A generalized gcd, also computing division of a and b by gcd. *)
+
+Definition ggcd a b : Z*(Z*Z) :=
+  match a,b with
+    | 0, _ => (abs b,(0, sgn b))
+    | _, 0 => (abs a,(sgn a, 0))
+    | pos a, pos b =>
+       let '(g,(aa,bb)) := Pos.ggcd a b in (pos g, (pos aa, pos bb))
+    | pos a, neg b =>
+       let '(g,(aa,bb)) := Pos.ggcd a b in (pos g, (pos aa, neg bb))
+    | neg a, pos b =>
+       let '(g,(aa,bb)) := Pos.ggcd a b in (pos g, (neg aa, pos bb))
+    | neg a, neg b =>
+       let '(g,(aa,bb)) := Pos.ggcd a b in (pos g, (neg aa, neg bb))
+  end.
+
+
+(** ** Bitwise functions *)
+
+(** When accessing the bits of negative numbers, all functions
+  below will use the two's complement representation. For instance,
+  [-1] will correspond to an infinite stream of true bits. If this
+  isn't what you're looking for, you can use [abs] first and then
+  access the bits of the absolute value.
+*)
+
+(** [testbit] : accessing the [n]-th bit of a number [a].
+    For negative [n], we arbitrarily answer [false]. *)
+
+Definition testbit a n :=
+ match n with
+   | 0 => odd a
+   | pos p =>
+     match a with
+       | 0 => false
+       | pos a => Pos.testbit a (N.pos p)
+       | neg a => negb (N.testbit (Pos.pred_N a) (N.pos p))
+     end
+   | neg _ => false
+ end.
+
+(** Shifts
+
+   Nota: a shift to the right by [-n] will be a shift to the left
+   by [n], and vice-versa.
+
+   For fulfilling the two's complement convention, shifting to
+   the right a negative number should correspond to a division
+   by 2 with rounding toward bottom, hence the use of [div2]
+   instead of [quot2].
+*)
+
+Definition shiftl a n :=
+ match n with
+   | 0 => a
+   | pos p => Pos.iter p (mul 2) a
+   | neg p => Pos.iter p div2 a
+ end.
+
+Definition shiftr a n := shiftl a (-n).
+
+(** Bitwise operations [lor] [land] [ldiff] [lxor] *)
+
+Definition lor a b :=
+ match a, b with
+   | 0, _ => b
+   | _, 0 => a
+   | pos a, pos b => pos (Pos.lor a b)
+   | neg a, pos b => neg (N.succ_pos (N.ldiff (Pos.pred_N a) (N.pos b)))
+   | pos a, neg b => neg (N.succ_pos (N.ldiff (Pos.pred_N b) (N.pos a)))
+   | neg a, neg b => neg (N.succ_pos (N.land (Pos.pred_N a) (Pos.pred_N b)))
+ end.
+
+Definition land a b :=
+ match a, b with
+   | 0, _ => 0
+   | _, 0 => 0
+   | pos a, pos b => of_N (Pos.land a b)
+   | neg a, pos b => of_N (N.ldiff (N.pos b) (Pos.pred_N a))
+   | pos a, neg b => of_N (N.ldiff (N.pos a) (Pos.pred_N b))
+   | neg a, neg b => neg (N.succ_pos (N.lor (Pos.pred_N a) (Pos.pred_N b)))
+ end.
+
+Definition ldiff a b :=
+ match a, b with
+   | 0, _ => 0
+   | _, 0 => a
+   | pos a, pos b => of_N (Pos.ldiff a b)
+   | neg a, pos b => neg (N.succ_pos (N.lor (Pos.pred_N a) (N.pos b)))
+   | pos a, neg b => of_N (N.land (N.pos a) (Pos.pred_N b))
+   | neg a, neg b => of_N (N.ldiff (Pos.pred_N b) (Pos.pred_N a))
+ end.
+
+Definition lxor a b :=
+ match a, b with
+   | 0, _ => b
+   | _, 0 => a
+   | pos a, pos b => of_N (Pos.lxor a b)
+   | neg a, pos b => neg (N.succ_pos (N.lxor (Pos.pred_N a) (N.pos b)))
+   | pos a, neg b => neg (N.succ_pos (N.lxor (N.pos a) (Pos.pred_N b)))
+   | neg a, neg b => of_N (N.lxor (Pos.pred_N a) (Pos.pred_N b))
+ end.
+
+End Z.
\ No newline at end of file
diff --git a/theories/ZArith/Int.v b/theories/ZArith/Int.v
index c0123ca8..99ecd150 100644
--- a/theories/ZArith/Int.v
+++ b/theories/ZArith/Int.v
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: Int.v 12363 2009-09-28 15:04:07Z letouzey $ *)
-
 (** * An light axiomatization of integers (used in FSetAVL). *)
 
 (** We define a signature for an integer datatype based on [Z].
@@ -18,28 +16,26 @@
 
 Require Import ZArith.
 Delimit Scope Int_scope with I.
-
+Local Open Scope Int_scope.
 
 (** * a specification of integers *)
 
 Module Type Int.
 
-  Open Scope Int_scope.
-
-  Parameter int : Set.
+  Parameter t : Set.
+  Bind Scope Int_scope with t.
 
-  Parameter i2z : int -> Z.
-  Arguments Scope i2z [ Int_scope ].
+  Parameter i2z : t -> Z.
 
-  Parameter _0 : int.
-  Parameter _1 : int.
-  Parameter _2 : int.
-  Parameter _3 : int.
-  Parameter plus : int -> int -> int.
-  Parameter opp : int -> int.
-  Parameter minus : int -> int -> int.
-  Parameter mult : int -> int -> int.
-  Parameter max : int -> int -> int.
+  Parameter _0 : t.
+  Parameter _1 : t.
+  Parameter _2 : t.
+  Parameter _3 : t.
+  Parameter plus : t -> t -> t.
+  Parameter opp : t -> t.
+  Parameter minus : t -> t -> t.
+  Parameter mult : t -> t -> t.
+  Parameter max : t -> t -> t.
 
   Notation "0" := _0 : Int_scope.
   Notation "1" := _1 : Int_scope.
@@ -56,10 +52,10 @@ Module Type Int.
 
   Notation "x == y" := (i2z x = i2z y)
     (at level 70, y at next level, no associativity) : Int_scope.
-  Notation "x <= y" := (Zle (i2z x) (i2z y)): Int_scope.
-  Notation "x < y" := (Zlt (i2z x) (i2z y)) : Int_scope.
-  Notation "x >= y" := (Zge (i2z x) (i2z y)) : Int_scope.
-  Notation "x > y" := (Zgt (i2z x) (i2z y)): Int_scope.
+  Notation "x <= y" := (i2z x <= i2z y)%Z : Int_scope.
+  Notation "x < y" := (i2z x < i2z y)%Z : Int_scope.
+  Notation "x >= y" := (i2z x >= i2z y)%Z : Int_scope.
+  Notation "x > y" := (i2z x > i2z y)%Z : Int_scope.
   Notation "x <= y <= z" := (x <= y /\ y <= z) : Int_scope.
   Notation "x <= y < z" := (x <= y /\ y < z) : Int_scope.
   Notation "x < y < z" := (x < y /\ y < z) : Int_scope.
@@ -67,41 +63,39 @@ Module Type Int.
 
   (** Some decidability fonctions (informative). *)
 
-  Axiom gt_le_dec : forall x y: int, {x > y} + {x <= y}.
-  Axiom ge_lt_dec :  forall x y : int, {x >= y} + {x < y}.
-  Axiom eq_dec : forall x y : int, { x == y } + {~ x==y }.
+  Axiom gt_le_dec : forall x y : t, {x > y} + {x <= y}.
+  Axiom ge_lt_dec :  forall x y : t, {x >= y} + {x < y}.
+  Axiom eq_dec : forall x y : t, { x == y } + {~ x==y }.
 
   (** Specifications *)
 
   (** First, we ask [i2z] to be injective. Said otherwise, our ad-hoc equality
       [==] and the generic [=] are in fact equivalent. We define [==]
-      nonetheless since the translation to [Z] for using automatic tactic is easier. *)
+      nonetheless since the translation to [Z] for using automatic tactic
+      is easier. *)
 
-  Axiom i2z_eq : forall n p : int, n == p -> n = p.
+  Axiom i2z_eq : forall n p : t, n == p -> n = p.
 
    (** Then, we express the specifications of the above parameters using their
        Z counterparts. *)
 
-  Open Scope Z_scope.
-  Axiom i2z_0 : i2z _0 = 0.
-  Axiom i2z_1 : i2z _1 = 1.
-  Axiom i2z_2 : i2z _2 = 2.
-  Axiom i2z_3 : i2z _3 = 3.
-  Axiom i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p.
-  Axiom i2z_opp : forall n, i2z (-n) = -i2z n.
-  Axiom i2z_minus : forall n p, i2z (n - p) = i2z n - i2z p.
-  Axiom i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p.
-  Axiom i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p).
+  Axiom i2z_0 : i2z _0 = 0%Z.
+  Axiom i2z_1 : i2z _1 = 1%Z.
+  Axiom i2z_2 : i2z _2 = 2%Z.
+  Axiom i2z_3 : i2z _3 = 3%Z.
+  Axiom i2z_plus : forall n p, i2z (n + p) = (i2z n + i2z p)%Z.
+  Axiom i2z_opp : forall n, i2z (-n) = (-i2z n)%Z.
+  Axiom i2z_minus : forall n p, i2z (n - p) = (i2z n - i2z p)%Z.
+  Axiom i2z_mult : forall n p, i2z (n * p) = (i2z n * i2z p)%Z.
+  Axiom i2z_max : forall n p, i2z (max n p) = Z.max (i2z n) (i2z p).
 
 End Int.
 
 
 (** * Facts and  tactics using [Int] *)
 
-Module MoreInt (I:Int).
-  Import I.
-
-  Open Scope Int_scope.
+Module MoreInt (Import I:Int).
+  Local Notation int := I.t.
 
   (** A magic (but costly) tactic that goes from [int] back to the [Z]
       friendly world ... *)
@@ -110,13 +104,14 @@ Module MoreInt (I:Int).
     i2z_0 i2z_1 i2z_2 i2z_3 i2z_plus i2z_opp i2z_minus i2z_mult i2z_max : i2z.
 
   Ltac i2z := match goal with
-		| H : (eq (A:=int) ?a ?b) |- _ =>
-		  generalize (f_equal i2z H);
-		    try autorewrite with i2z; clear H; intro H; i2z
-		| |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); try autorewrite with i2z; i2z
-		| H : _ |- _ => progress autorewrite with i2z in H; i2z
-		| _ => try autorewrite with i2z
-	      end.
+    | H : ?a = ?b |- _ =>
+      generalize (f_equal i2z H);
+	try autorewrite with i2z; clear H; intro H; i2z
+    | |- ?a = ?b =>
+      apply (i2z_eq a b); try autorewrite with i2z; i2z
+    | H : _ |- _ => progress autorewrite with i2z in H; i2z
+    | _ => try autorewrite with i2z
+  end.
 
   (** A reflexive version of the [i2z] tactic *)
 
@@ -126,14 +121,14 @@ Module MoreInt (I:Int).
       Anyhow, [i2z_refl] is enough for applying [romega]. *)
 
   Ltac i2z_gen := match goal with
-    | |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); i2z_gen
-    | H : (eq (A:=int) ?a ?b) |- _ =>
+    | |- ?a = ?b => apply (i2z_eq a b); i2z_gen
+    | H : ?a = ?b |- _ =>
        generalize (f_equal i2z H); clear H; i2z_gen
-    | H : (eq (A:=Z) ?a ?b) |- _ => revert H; i2z_gen
-    | H : (Zlt ?a ?b) |- _ => revert H; i2z_gen
-    | H : (Zle ?a ?b) |- _ => revert H; i2z_gen
-    | H : (Zgt ?a ?b) |- _ => revert H; i2z_gen
-    | H : (Zge ?a ?b) |- _ => revert H; i2z_gen
+    | H : eq (A:=Z) ?a ?b |- _ => revert H; i2z_gen
+    | H : Z.lt ?a ?b |- _ => revert H; i2z_gen
+    | H : Z.le ?a ?b |- _ => revert H; i2z_gen
+    | H : Z.gt ?a ?b |- _ => revert H; i2z_gen
+    | H : Z.ge ?a ?b |- _ => revert H; i2z_gen
     | H : _ -> ?X |- _ =>
       (* A [Set] or [Type] part cannot be dealt with easily
          using the [ExprP] datatype. So we forget it, leaving
@@ -203,11 +198,11 @@ Module MoreInt (I:Int).
 
     with z2ez trm :=
     match constr:trm with
-      | (?x+?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZplus ex ey)
-      | (?x-?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZminus ex ey)
-      | (?x*?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZmult ex ey)
-      | (Zmax ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EZmax ex ey)
-      | (-?x)%Z =>  let ex := z2ez x in constr:(EZopp ex)
+      | (?x + ?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZplus ex ey)
+      | (?x - ?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZminus ex ey)
+      | (?x * ?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZmult ex ey)
+      | (Z.max ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EZmax ex ey)
+      | (- ?x)%Z =>  let ex := z2ez x in constr:(EZopp ex)
       | i2z ?x => let ex := i2ei x in constr:(EZofI ex)
       | ?x => constr:(EZraw x)
     end.
@@ -222,10 +217,10 @@ Module MoreInt (I:Int).
       | (?x \/ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPor ex ey)
       | (~ ?x) => let ex := p2ep x in constr:(EPneg ex)
       | (eq (A:=Z) ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EPeq ex ey)
-      | (?x<?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPlt ex ey)
-      | (?x<=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPle ex ey)
-      | (?x>?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPgt ex ey)
-      | (?x>=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPge ex ey)
+      | (?x < ?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPlt ex ey)
+      | (?x <= ?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPle ex ey)
+      | (?x > ?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPgt ex ey)
+      | (?x >= ?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPge ex ey)
       | ?x =>  constr:(EPraw x)
     end.
 
@@ -252,7 +247,7 @@ Module MoreInt (I:Int).
       | EZplus e1 e2 => ((ez2z e1)+(ez2z e2))%Z
       | EZminus e1 e2 => ((ez2z e1)-(ez2z e2))%Z
       | EZmult e1 e2 => ((ez2z e1)*(ez2z e2))%Z
-      | EZmax e1 e2 => Zmax (ez2z e1) (ez2z e2)
+      | EZmax e1 e2 => Z.max (ez2z e1) (ez2z e2)
       | EZopp e => (-(ez2z e))%Z
       | EZofI e => i2z (ei2i e)
       | EZraw z => z
@@ -362,30 +357,29 @@ End MoreInt.
 (** It's always nice to know that our [Int] interface is realizable :-) *)
 
 Module Z_as_Int <: Int.
-  Open Scope Z_scope.
-  Definition int := Z.
+  Local Open Scope Z_scope.
+  Definition t := Z.
   Definition _0 := 0.
   Definition _1 := 1.
   Definition _2 := 2.
   Definition _3 := 3.
-  Definition plus := Zplus.
-  Definition opp := Zopp.
-  Definition minus := Zminus.
-  Definition mult := Zmult.
-  Definition max := Zmax.
+  Definition plus := Z.add.
+  Definition opp := Z.opp.
+  Definition minus := Z.sub.
+  Definition mult := Z.mul.
+  Definition max := Z.max.
   Definition gt_le_dec := Z_gt_le_dec.
   Definition ge_lt_dec := Z_ge_lt_dec.
-  Definition eq_dec := Z_eq_dec.
-  Definition i2z : int -> Z := fun n => n.
+  Definition eq_dec := Z.eq_dec.
+  Definition i2z : t -> Z := fun n => n.
   Lemma i2z_eq : forall n p, i2z n=i2z p -> n = p. Proof. auto. Qed.
   Lemma i2z_0 : i2z _0 = 0.  Proof. auto. Qed.
   Lemma i2z_1 : i2z _1 = 1.  Proof. auto. Qed.
   Lemma i2z_2 : i2z _2 = 2.  Proof. auto. Qed.
   Lemma i2z_3 : i2z _3 = 3.  Proof. auto. Qed.
-  Lemma i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p.  Proof. auto. Qed.
-  Lemma i2z_opp : forall n, i2z (- n)  = - i2z n.  Proof. auto. Qed.
-  Lemma i2z_minus : forall n p, i2z (n - p)  = i2z n - i2z p.  Proof. auto. Qed.
-  Lemma i2z_mult : forall n p, i2z (n * p)  = i2z n * i2z p.  Proof. auto. Qed.
-  Lemma i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). Proof. auto. Qed.
+  Lemma i2z_plus n p : i2z (n + p) = i2z n + i2z p.  Proof. auto. Qed.
+  Lemma i2z_opp n : i2z (- n) = - i2z n.  Proof. auto. Qed.
+  Lemma i2z_minus n p : i2z (n - p) = i2z n - i2z p.  Proof. auto. Qed.
+  Lemma i2z_mult n p : i2z (n * p) = i2z n * i2z p.  Proof. auto. Qed.
+  Lemma i2z_max n p : i2z (max n p) = Z.max (i2z n) (i2z p). Proof. auto. Qed.
 End Z_as_Int.
-
diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v
index 0fe6d623..3935e124 100644
--- a/theories/ZArith/Wf_Z.v
+++ b/theories/ZArith/Wf_Z.v
@@ -1,123 +1,83 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Wf_Z.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import BinInt.
 Require Import Zcompare.
 Require Import Zorder.
 Require Import Znat.
 Require Import Zmisc.
 Require Import Wf_nat.
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 (** Our purpose is to write an induction shema for {0,1,2,...}
   similar to the [nat] schema (Theorem [Natlike_rec]). For that the
   following implications will be used :
 <<
- (n:nat)(Q n)==(n:nat)(P (inject_nat n)) ===> (x:Z)`x > 0) -> (P x)
+ ∀n:nat, Q n == ∀n:nat, P (Z.of_nat n) ===> ∀x:Z, x <= 0 -> P x
 
        	     /\
              ||
              ||
 
-  (Q O) (n:nat)(Q n)->(Q (S n)) <=== (P 0) (x:Z) (P x) -> (P (Zs x))
+ (Q O) ∧ (∀n:nat, Q n -> Q (S n)) <=== (P 0) ∧ (∀x:Z, P x -> P (Z.succ x))
 
-      	       	       	       	<=== (inject_nat (S n))=(Zs (inject_nat n))
+				  <=== (Z.of_nat (S n) = Z.succ (Z.of_nat n))
 
-      	       	       	       	<=== inject_nat_complete
+				  <=== Z_of_nat_complete
 >>
   Then the  diagram will be closed and the theorem proved. *)
 
-Lemma Z_of_nat_complete :
-  forall x:Z, 0 <= x ->  exists n : nat, x = Z_of_nat n.
-Proof.
-  intro x; destruct x; intros;
-    [ exists 0%nat; auto with arith
-      | specialize (ZL4 p); intros Hp; elim Hp; intros; exists (S x); intros;
-	simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x);
-	  intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos);
-	    apply nat_of_P_inj; auto with arith
-      | absurd (0 <= Zneg p);
-	[ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *;
-	  auto with arith
-	  | assumption ] ].
-Qed.
-
-Lemma ZL4_inf : forall y:positive, {h : nat | nat_of_P y = S h}.
+Lemma Z_of_nat_complete (x : Z) :
+ 0 <= x -> exists n : nat, x = Z.of_nat n.
 Proof.
-  intro y; induction y as [p H| p H1| ];
-    [ elim H; intros x H1; exists (S x + S x)%nat; unfold nat_of_P in |- *;
-      simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism;
-	unfold nat_of_P in H1; rewrite H1; auto with arith
-      | elim H1; intros x H2; exists (x + S x)%nat; unfold nat_of_P in |- *;
-	simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism;
-	  unfold nat_of_P in H2; rewrite H2; auto with arith
-      | exists 0%nat; auto with arith ].
+ intros H. exists (Z.to_nat x). symmetry. now apply Z2Nat.id.
 Qed.
 
-Lemma Z_of_nat_complete_inf :
- forall x:Z, 0 <= x -> {n : nat | x = Z_of_nat n}.
+Lemma Z_of_nat_complete_inf (x : Z) :
+ 0 <= x -> {n : nat | x = Z.of_nat n}.
 Proof.
-  intro x; destruct x; intros;
-    [ exists 0%nat; auto with arith
-      | specialize (ZL4_inf p); intros Hp; elim Hp; intros x0 H0; exists (S x0);
-	intros; simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x0);
-	  intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos);
-	    apply nat_of_P_inj; auto with arith
-      | absurd (0 <= Zneg p);
-	[ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *;
-	  auto with arith
-	  | assumption ] ].
+ intros H. exists (Z.to_nat x). symmetry. now apply Z2Nat.id.
 Qed.
 
 Lemma Z_of_nat_prop :
   forall P:Z -> Prop,
-    (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x.
+    (forall n:nat, P (Z.of_nat n)) -> forall x:Z, 0 <= x -> P x.
 Proof.
-  intros P H x H0.
-  specialize (Z_of_nat_complete x H0).
-  intros Hn; elim Hn; intros.
-  rewrite H1; apply H.
+ intros P H x Hx. now destruct (Z_of_nat_complete x Hx) as (n,->).
 Qed.
 
 Lemma Z_of_nat_set :
  forall P:Z -> Set,
-   (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x.
+   (forall n:nat, P (Z.of_nat n)) -> forall x:Z, 0 <= x -> P x.
 Proof.
-  intros P H x H0.
-  specialize (Z_of_nat_complete_inf x H0).
-  intros Hn; elim Hn; intros.
-  rewrite p; apply H.
+ intros P H x Hx. now destruct (Z_of_nat_complete_inf x Hx) as (n,->).
 Qed.
 
 Lemma natlike_ind :
  forall P:Z -> Prop,
    P 0 ->
-   (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x.
+   (forall x:Z, 0 <= x -> P x -> P (Z.succ x)) ->
+   forall x:Z, 0 <= x -> P x.
 Proof.
-  intros P H H0 x H1; apply Z_of_nat_prop;
-    [ simple induction n;
-      [ simpl in |- *; assumption
-	| intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ]
-      | assumption ].
+ intros P Ho Hrec x Hx; apply Z_of_nat_prop; trivial.
+ induction n. exact Ho.
+ rewrite Nat2Z.inj_succ. apply Hrec; trivial using Nat2Z.is_nonneg.
 Qed.
 
 Lemma natlike_rec :
  forall P:Z -> Set,
    P 0 ->
-   (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x.
+   (forall x:Z, 0 <= x -> P x -> P (Z.succ x)) ->
+   forall x:Z, 0 <= x -> P x.
 Proof.
-  intros P H H0 x H1; apply Z_of_nat_set;
-    [ simple induction n;
-      [ simpl in |- *; assumption
-	| intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ]
-      | assumption ].
+ intros P Ho Hrec x Hx; apply Z_of_nat_set; trivial.
+ induction n. exact Ho.
+ rewrite Nat2Z.inj_succ. apply Hrec; trivial using Nat2Z.is_nonneg.
 Qed.
 
 Section Efficient_Rec.
@@ -129,76 +89,62 @@ Section Efficient_Rec.
 
   Let R_wf : well_founded R.
   Proof.
-    set
-      (f :=
-	fun z =>
-	  match z with
-	    | Zpos p => nat_of_P p
-	    | Z0 => 0%nat
-	    | Zneg _ => 0%nat
-	  end) in *.
-    apply well_founded_lt_compat with f.
-    unfold R, f in |- *; clear f R.
-    intros x y; case x; intros; elim H; clear H.
-    case y; intros; apply lt_O_nat_of_P || inversion H0.
-    case y; intros; apply nat_of_P_lt_Lt_compare_morphism || inversion H0; auto.
-    intros; elim H; auto.
+   apply well_founded_lt_compat with Z.to_nat.
+   intros x y (Hx,H). apply Z2Nat.inj_lt; Z.order.
   Qed.
 
   Lemma natlike_rec2 :
     forall P:Z -> Type,
       P 0 ->
-      (forall z:Z, 0 <= z -> P z -> P (Zsucc z)) -> forall z:Z, 0 <= z -> P z.
+      (forall z:Z, 0 <= z -> P z -> P (Z.succ z)) ->
+      forall z:Z, 0 <= z -> P z.
   Proof.
-    intros P Ho Hrec z; pattern z in |- *;
-      apply (well_founded_induction_type R_wf).
-    intro x; case x.
-    trivial.
-    intros.
-    assert (0 <= Zpred (Zpos p)).
-    apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial.
-    rewrite Zsucc_pred.
-    apply Hrec.
-    auto.
-    apply X; auto; unfold R in |- *; intuition; apply Zlt_pred.
-    intros; elim H; simpl in |- *; trivial.
+   intros P Ho Hrec.
+   induction z as [z IH] using (well_founded_induction_type R_wf).
+   destruct z; intros Hz.
+   - apply Ho.
+   - set (y:=Z.pred (Zpos p)).
+     assert (LE : 0 <= y) by (unfold y; now apply Z.lt_le_pred).
+     assert (EQ : Zpos p = Z.succ y) by (unfold y; now rewrite Z.succ_pred).
+     rewrite EQ. apply Hrec, IH; trivial.
+     split; trivial. unfold y; apply Z.lt_pred_l.
+   - now destruct Hz.
   Qed.
 
-  (** A variant of the previous using [Zpred] instead of [Zs]. *)
+  (** A variant of the previous using [Z.pred] instead of [Z.succ]. *)
 
   Lemma natlike_rec3 :
     forall P:Z -> Type,
       P 0 ->
-      (forall z:Z, 0 < z -> P (Zpred z) -> P z) -> forall z:Z, 0 <= z -> P z.
+      (forall z:Z, 0 < z -> P (Z.pred z) -> P z) ->
+      forall z:Z, 0 <= z -> P z.
   Proof.
-    intros P Ho Hrec z; pattern z in |- *;
-      apply (well_founded_induction_type R_wf).
-    intro x; case x.
-    trivial.
-    intros; apply Hrec.
-    unfold Zlt in |- *; trivial.
-    assert (0 <= Zpred (Zpos p)).
-    apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial.
-    apply X; auto; unfold R in |- *; intuition; apply Zlt_pred.
-    intros; elim H; simpl in |- *; trivial.
+   intros P Ho Hrec.
+   induction z as [z IH] using (well_founded_induction_type R_wf).
+   destruct z; intros Hz.
+   - apply Ho.
+   - assert (EQ : 0 <= Z.pred (Zpos p)) by now apply Z.lt_le_pred.
+     apply Hrec. easy. apply IH; trivial. split; trivial.
+     apply Z.lt_pred_l.
+   - now destruct Hz.
   Qed.
 
-  (** A more general induction principle on non-negative numbers using [Zlt]. *)
+  (** A more general induction principle on non-negative numbers using [Z.lt]. *)
 
   Lemma Zlt_0_rec :
     forall P:Z -> Type,
       (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) ->
       forall x:Z, 0 <= x -> P x.
   Proof.
-    intros P Hrec z; pattern z in |- *; apply (well_founded_induction_type R_wf).
-    intro x; case x; intros.
-    apply Hrec; intros.
-    assert (H2 : 0 < 0).
-    apply Zle_lt_trans with y; intuition.
-    inversion H2.
-    assumption.
-    firstorder.
-    unfold Zle, Zcompare in H; elim H; auto.
+   intros P Hrec.
+   induction x as [x IH] using (well_founded_induction_type R_wf).
+   destruct x; intros Hx.
+   - apply Hrec; trivial. intros y (Hy,Hy').
+     assert (0 < 0) by now apply Z.le_lt_trans with y.
+     discriminate.
+   - apply Hrec; trivial. intros y (Hy,Hy').
+     apply IH; trivial. now split.
+   - now destruct Hx.
   Defined.
 
   Lemma Zlt_0_ind :
@@ -209,7 +155,7 @@ Section Efficient_Rec.
     exact Zlt_0_rec.
   Qed.
 
-  (** Obsolete version of [Zlt] induction principle on non-negative numbers *)
+  (** Obsolete version of [Z.lt] induction principle on non-negative numbers *)
 
   Lemma Z_lt_rec :
     forall P:Z -> Type,
@@ -227,29 +173,22 @@ Section Efficient_Rec.
     exact Z_lt_rec.
   Qed.
 
-  (** An even more general induction principle using [Zlt]. *)
+  (** An even more general induction principle using [Z.lt]. *)
 
   Lemma Zlt_lower_bound_rec :
     forall P:Z -> Type, forall z:Z,
       (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) ->
       forall x:Z, z <= x -> P x.
   Proof.
-    intros P z Hrec x.
-    assert (Hexpand : forall x, x = x - z + z).
-    intro; unfold Zminus; rewrite <- Zplus_assoc; rewrite Zplus_opp_l;
-      rewrite Zplus_0_r; trivial.
-    intro Hz.
-    rewrite (Hexpand x); pattern (x - z) in |- *; apply Zlt_0_rec.
-    2: apply Zplus_le_reg_r with z; rewrite <- Hexpand; assumption.
-    intros x0 Hlt_x0 H.
-    apply Hrec.
-    2: change z with (0+z); apply Zplus_le_compat_r; assumption.
-    intro y; rewrite (Hexpand y); intros.
-    destruct H0.
-    apply Hlt_x0.
-    split.
-    apply Zplus_le_reg_r with z; assumption.
-    apply Zplus_lt_reg_r with z; assumption.
+    intros P z Hrec x Hx.
+    rewrite <- (Z.sub_simpl_r x z). apply Z.le_0_sub in Hx.
+    pattern (x - z); apply Zlt_0_rec; trivial.
+    clear x Hx. intros x IH Hx.
+    apply Hrec. intros y (Hy,Hy').
+    rewrite <- (Z.sub_simpl_r y z). apply IH; split.
+    now rewrite Z.le_0_sub.
+    now apply Z.lt_sub_lt_add_r.
+    now rewrite <- (Z.add_le_mono_r 0 x z).
   Qed.
 
   Lemma Zlt_lower_bound_ind :
diff --git a/theories/ZArith/ZArith.v b/theories/ZArith/ZArith.v
index bc79e373..033dc11f 100644
--- a/theories/ZArith/ZArith.v
+++ b/theories/ZArith/ZArith.v
@@ -1,21 +1,22 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ZArith.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Library for manipulating integers based on binary encoding *)
 
 Require Export ZArith_base.
 
+(** Extra definitions *)
+
+Require Export Zpow_def.
+
 (** Extra modules using [Omega] or [Ring]. *)
 
 Require Export Zcomplements.
-Require Export Zsqrt.
 Require Export Zpower.
 Require Export Zdiv.
 Require Export Zlogarithm.
diff --git a/theories/ZArith/ZArith_base.v b/theories/ZArith/ZArith_base.v
index 8cdae80d..38b6c44d 100644
--- a/theories/ZArith/ZArith_base.v
+++ b/theories/ZArith/ZArith_base.v
@@ -1,17 +1,16 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ZArith_base.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 (** Library for manipulating integers based on binary encoding.
     These are the basic modules, required by [Omega] and [Ring] for instance.
     The full library is [ZArith]. *)
 
+Require Export BinNums.
 Require Export BinPos.
 Require Export BinNat.
 Require Export BinInt.
@@ -29,8 +28,8 @@ Require Export Zbool.
 Require Export Zmisc.
 Require Export Wf_Z.
 
-Hint Resolve Zle_refl Zplus_comm Zplus_assoc Zmult_comm Zmult_assoc Zplus_0_l
-  Zplus_0_r Zmult_1_l Zplus_opp_l Zplus_opp_r Zmult_plus_distr_l
-  Zmult_plus_distr_r: zarith.
+Hint Resolve Z.le_refl Z.add_comm Z.add_assoc Z.mul_comm Z.mul_assoc Z.add_0_l
+  Z.add_0_r Z.mul_1_l Z.add_opp_diag_l Z.add_opp_diag_r Z.mul_add_distr_l
+  Z.mul_add_distr_r: zarith.
 
 Require Export Zhints.
diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v
index b6766640..ff4f5e7b 100644
--- a/theories/ZArith/ZArith_dec.v
+++ b/theories/ZArith/ZArith_dec.v
@@ -1,19 +1,17 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ZArith_dec.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Sumbool.
 
 Require Import BinInt.
 Require Import Zorder.
 Require Import Zcompare.
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 (* begin hide *)
 (* Trivial, to deprecate? *)
@@ -23,68 +21,43 @@ Proof.
 Defined.
 (* end hide *)
 
-Lemma Zcompare_rect :
-  forall (P:Type) (n m:Z),
-    ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P.
+Lemma Zcompare_rect (P:Type) (n m:Z) :
+  ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P.
 Proof.
-  intros * H1 H2 H3.
+  intros H1 H2 H3.
   destruct (n ?= m); auto.
 Defined.
 
-Lemma Zcompare_rec :
-  forall (P:Set) (n m:Z),
-    ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P.
-Proof.
-  intro; apply Zcompare_rect.
-Defined.
+Lemma Zcompare_rec (P:Set) (n m:Z) :
+  ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P.
+Proof. apply Zcompare_rect. Defined.
+
+Notation Z_eq_dec := Z.eq_dec (compat "8.3").
 
 Section decidability.
 
   Variables x y : Z.
 
-  (** * Decidability of equality on binary integers *)
-
-  Definition Z_eq_dec : {x = y} + {x <> y}.
-  Proof.
-    decide equality; apply positive_eq_dec.
-  Defined.
-
   (** * Decidability of order on binary integers *)
 
   Definition Z_lt_dec : {x < y} + {~ x < y}.
   Proof.
-    unfold Zlt in |- *.
-    apply Zcompare_rec with (n := x) (m := y); intro H.
-    right. rewrite H. discriminate.
-    left; assumption.
-    right. rewrite H. discriminate.
+    unfold Z.lt; case Z.compare; (now left) || (now right).
   Defined.
 
   Definition Z_le_dec : {x <= y} + {~ x <= y}.
   Proof.
-    unfold Zle in |- *.
-    apply Zcompare_rec with (n := x) (m := y); intro H.
-    left. rewrite H. discriminate.
-    left. rewrite H. discriminate.
-    right. tauto.
+    unfold Z.le; case Z.compare; (now left) || (right; tauto).
   Defined.
 
   Definition Z_gt_dec : {x > y} + {~ x > y}.
   Proof.
-    unfold Zgt in |- *.
-    apply Zcompare_rec with (n := x) (m := y); intro H.
-    right. rewrite H. discriminate.
-    right. rewrite H. discriminate.
-    left; assumption.
+    unfold Z.gt; case Z.compare; (now left) || (now right).
   Defined.
 
   Definition Z_ge_dec : {x >= y} + {~ x >= y}.
   Proof.
-    unfold Zge in |- *.
-    apply Zcompare_rec with (n := x) (m := y); intro H.
-    left. rewrite H. discriminate.
-    right. tauto.
-    left. rewrite H. discriminate.
+    unfold Z.ge; case Z.compare; (now left) || (right; tauto).
   Defined.
 
   Definition Z_lt_ge_dec : {x < y} + {x >= y}.
@@ -94,16 +67,15 @@ Section decidability.
 
   Lemma Z_lt_le_dec : {x < y} + {y <= x}.
   Proof.
-    intros.
     elim Z_lt_ge_dec.
-    intros; left; assumption.
-    intros; right; apply Zge_le; assumption.
+    * now left.
+    * right; now apply Z.ge_le.
   Defined.
 
   Definition Z_le_gt_dec : {x <= y} + {x > y}.
   Proof.
     elim Z_le_dec; auto with arith.
-    intro. right. apply Znot_le_gt; auto with arith.
+    intro. right. Z.swap_greater. now apply Z.nle_gt.
   Defined.
 
   Definition Z_gt_le_dec : {x > y} + {x <= y}.
@@ -114,15 +86,15 @@ Section decidability.
   Definition Z_ge_lt_dec : {x >= y} + {x < y}.
   Proof.
     elim Z_ge_dec; auto with arith.
-    intro. right. apply Znot_ge_lt; auto with arith.
+    intro. right. Z.swap_greater. now apply Z.lt_nge.
   Defined.
 
   Definition Z_le_lt_eq_dec : x <= y -> {x < y} + {x = y}.
   Proof.
     intro H.
     apply Zcompare_rec with (n := x) (m := y).
-    intro. right. elim (Zcompare_Eq_iff_eq x y); auto with arith.
-    intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith.
+    intro. right. elim (Z.compare_eq_iff x y); auto with arith.
+    intro. left. elim (Z.compare_eq_iff x y); auto with arith.
     intro H1. absurd (x > y); auto with arith.
   Defined.
 
@@ -139,8 +111,8 @@ Proof.
   assumption.
   intro.
   right.
-  apply Zle_lt_trans with (m := x).
-  apply Zge_le.
+  apply Z.le_lt_trans with (m := x).
+  apply Z.ge_le.
   assumption.
   assumption.
 Defined.
@@ -149,20 +121,16 @@ Lemma Zlt_cotrans_pos : forall n m:Z, 0 < n + m -> {0 < n} + {0 < m}.
 Proof.
   intros x y H.
   case (Zlt_cotrans 0 (x + y) H x).
-  intro.
-  left.
-  assumption.
-  intro.
-  right.
-  apply Zplus_lt_reg_l with (p := x).
-  rewrite Zplus_0_r.
-  assumption.
+  - now left.
+  - right.
+    apply Z.add_lt_mono_l with (p := x).
+    now rewrite Z.add_0_r.
 Defined.
 
 Lemma Zlt_cotrans_neg : forall n m:Z, n + m < 0 -> {n < 0} + {m < 0}.
 Proof.
   intros x y H; case (Zlt_cotrans (x + y) 0 H x); intro Hxy;
-    [ right; apply Zplus_lt_reg_l with (p := x); rewrite Zplus_0_r | left ];
+    [ right; apply Z.add_lt_mono_l with (p := x); rewrite Z.add_0_r | left ];
     assumption.
 Defined.
 
@@ -174,7 +142,7 @@ Proof.
   left.
   assumption.
   intro H0.
-  generalize (Zge_le _ _ H0).
+  generalize (Z.ge_le _ _ H0).
   intro.
   case (Z_le_lt_eq_dec _ _ H1).
   intro.
@@ -183,7 +151,7 @@ Proof.
   intro.
   apply False_rec.
   apply H.
-  symmetry  in |- *.
+  symmetry .
   assumption.
 Defined.
 
@@ -196,17 +164,17 @@ Proof.
   left.
   assumption.
   intro H.
-  generalize (Zge_le _ _ H).
+  generalize (Z.ge_le _ _ H).
   intro H0.
   case (Z_le_lt_eq_dec y x H0).
   intro H1.
   left.
   right.
-  apply Zlt_gt.
+  apply Z.lt_gt.
   assumption.
   intro.
   right.
-  symmetry  in |- *.
+  symmetry .
   assumption.
 Defined.
 
@@ -214,7 +182,7 @@ Defined.
 Lemma Z_dec' : forall n m:Z, {n < m} + {m < n} + {n = m}.
 Proof.
   intros x y.
-  case (Z_eq_dec x y); intro H;
+  case (Z.eq_dec x y); intro H;
     [ right; assumption | left; apply (not_Zeq_inf _ _ H) ].
 Defined.
 
@@ -222,12 +190,12 @@ Defined.
 (* To deprecate ? *)
 Corollary Z_zerop : forall x:Z, {x = 0} + {x <> 0}.
 Proof.
-  exact (fun x:Z => Z_eq_dec x 0).
+  exact (fun x:Z => Z.eq_dec x 0).
 Defined.
 
 Corollary Z_notzerop : forall (x:Z), {x <> 0} + {x = 0}.
 Proof (fun x => sumbool_not _ _ (Z_zerop x)).
 
 Corollary Z_noteq_dec : forall (x y:Z), {x <> y} + {x = y}.
-Proof (fun x y => sumbool_not _ _ (Z_eq_dec x y)).
+Proof (fun x y => sumbool_not _ _ (Z.eq_dec x y)).
 (* end hide *)
diff --git a/theories/ZArith/ZOdiv.v b/theories/ZArith/ZOdiv.v
index 70f6866e..17c5bae3 100644
--- a/theories/ZArith/ZOdiv.v
+++ b/theories/ZArith/ZOdiv.v
@@ -1,947 +1,88 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-
-Require Import BinPos BinNat Nnat ZArith_base ROmega ZArithRing.
 Require Export ZOdiv_def.
-Require Zdiv.
-
-Open Scope Z_scope.
-
-(** This file provides results about the Round-Toward-Zero Euclidean
-  division [ZOdiv_eucl], whose projections are [ZOdiv] and [ZOmod].
-  Definition of this division can be found in file [ZOdiv_def].
-
-  This division and the one defined in Zdiv agree only on positive
-  numbers. Otherwise, Zdiv performs Round-Toward-Bottom.
-
-  The current approach is compatible with the division of usual
-  programming languages such as Ocaml. In addition, it has nicer
-  properties with respect to opposite and other usual operations.
-*)
-
-(** Since ZOdiv and Zdiv are not meant to be used concurrently,
-   we reuse the same notation. *)
-
-Infix "/" := ZOdiv : Z_scope.
-Infix "mod" := ZOmod (at level 40, no associativity) : Z_scope.
-
-Infix "/" := Ndiv : N_scope.
-Infix "mod" := Nmod (at level 40, no associativity) : N_scope.
-
-(** Auxiliary results on the ad-hoc comparison [NPgeb]. *)
-
-Lemma NPgeb_Zge : forall (n:N)(p:positive),
-  NPgeb n p = true -> Z_of_N n >= Zpos p.
-Proof.
- destruct n as [|n]; simpl; intros.
- discriminate.
- red; simpl; destruct Pcompare; now auto.
-Qed.
-
-Lemma NPgeb_Zlt : forall (n:N)(p:positive),
-  NPgeb n p = false -> Z_of_N n < Zpos p.
-Proof.
- destruct n as [|n]; simpl; intros.
- red; auto.
- red; simpl; destruct Pcompare; now auto.
-Qed.
-
-(** * Relation between division on N and on Z. *)
-
-Lemma Ndiv_Z0div : forall a b:N,
-  Z_of_N (a/b) = (Z_of_N a / Z_of_N b).
-Proof.
-  intros.
-  destruct a; destruct b; simpl; auto.
-  unfold Ndiv, ZOdiv; simpl; destruct Pdiv_eucl; auto.
-Qed.
-
-Lemma Nmod_Z0mod : forall a b:N,
-  Z_of_N (a mod b) = (Z_of_N a) mod (Z_of_N b).
-Proof.
-  intros.
-  destruct a; destruct b; simpl; auto.
-  unfold Nmod, ZOmod; simpl; destruct Pdiv_eucl; auto.
-Qed.
-
-(** * Characterization of this euclidean division. *)
-
-(** First, the usual equation [a=q*b+r]. Notice that [a mod 0]
-   has been chosen to be [a], so this equation holds even for [b=0].
-*)
-
-Theorem N_div_mod_eq : forall a b,
-  a = (b * (Ndiv a b) + (Nmod a b))%N.
-Proof.
-  intros; generalize (Ndiv_eucl_correct a b).
-  unfold Ndiv, Nmod; destruct Ndiv_eucl; simpl.
-  intro H; rewrite H; rewrite Nmult_comm; auto.
-Qed.
-
-Theorem ZO_div_mod_eq : forall a b,
-  a = b * (ZOdiv a b) + (ZOmod a b).
-Proof.
-  intros; generalize (ZOdiv_eucl_correct a b).
-  unfold ZOdiv, ZOmod; destruct ZOdiv_eucl; simpl.
-  intro H; rewrite H; rewrite Zmult_comm; auto.
-Qed.
-
-(** Then, the inequalities constraining the remainder. *)
-
-Theorem Pdiv_eucl_remainder : forall a b:positive,
-  Z_of_N (snd (Pdiv_eucl a b)) < Zpos b.
-Proof.
-  induction a; cbv beta iota delta [Pdiv_eucl]; fold Pdiv_eucl; cbv zeta.
-  intros b; generalize (IHa b); case Pdiv_eucl.
-    intros q1 r1 Hr1; simpl in Hr1.
-    case_eq (NPgeb (2*r1+1) b); intros; unfold snd.
-    romega with *.
-    apply NPgeb_Zlt; auto.
-  intros b; generalize (IHa b); case Pdiv_eucl.
-    intros q1 r1 Hr1; simpl in Hr1.
-    case_eq (NPgeb (2*r1) b); intros; unfold snd.
-    romega with *.
-    apply NPgeb_Zlt; auto.
-  destruct b; simpl; romega with *.
-Qed.
-
-Theorem Nmod_lt : forall (a b:N), b<>0%N ->
-  (a mod b < b)%N.
-Proof.
-  destruct b as [ |b]; intro H; try solve [elim H;auto].
-  destruct a as [ |a]; try solve [compute;auto]; unfold Nmod, Ndiv_eucl.
-  generalize (Pdiv_eucl_remainder a b); destruct Pdiv_eucl; simpl.
-  romega with *.
-Qed.
-
-(** The remainder is bounded by the divisor, in term of absolute values *)
-
-Theorem ZOmod_lt : forall a b:Z, b<>0 ->
-  Zabs (a mod b) < Zabs b.
-Proof.
-  destruct b as [ |b|b]; intro H; try solve [elim H;auto];
-  destruct a as [ |a|a]; try solve [compute;auto]; unfold ZOmod, ZOdiv_eucl;
-  generalize (Pdiv_eucl_remainder a b); destruct Pdiv_eucl; simpl;
-  try rewrite Zabs_Zopp; rewrite Zabs_eq; auto; apply Z_of_N_le_0.
-Qed.
-
-(** The sign of the remainder is the one of [a]. Due to the possible
-   nullity of [a], a general result is to be stated in the following form:
-*)
-
-Theorem ZOmod_sgn : forall a b:Z,
-  0 <= Zsgn (a mod b) * Zsgn a.
-Proof.
-  destruct b as [ |b|b]; destruct a as [ |a|a]; simpl; auto with zarith;
-  unfold ZOmod, ZOdiv_eucl; destruct Pdiv_eucl;
-  simpl; destruct n0; simpl; auto with zarith.
-Qed.
-
-(** This can also be said in a simplier way: *)
-
-Theorem Zsgn_pos_iff : forall z, 0 <= Zsgn z <-> 0 <= z.
-Proof.
- destruct z; simpl; intuition auto with zarith.
-Qed.
-
-Theorem ZOmod_sgn2 : forall a b:Z,
-  0 <= (a mod b) * a.
-Proof.
-  intros; rewrite <-Zsgn_pos_iff, Zsgn_Zmult; apply ZOmod_sgn.
-Qed.
-
-(** Reformulation of [ZOdiv_lt] and [ZOmod_sgn] in 2
-  then 4 particular cases. *)
-
-Theorem ZOmod_lt_pos : forall a b:Z, 0<=a -> b<>0 ->
-  0 <= a mod b < Zabs b.
-Proof.
-  intros.
-  assert (0 <= a mod b).
-   generalize (ZOmod_sgn a b).
-   destruct (Zle_lt_or_eq 0 a H).
-   rewrite <- Zsgn_pos in H1; rewrite H1; romega with *.
-   subst a; simpl; auto.
-  generalize (ZOmod_lt a b H0); romega with *.
-Qed.
-
-Theorem ZOmod_lt_neg : forall a b:Z, a<=0 -> b<>0 ->
-  -Zabs b < a mod b <= 0.
-Proof.
-  intros.
-  assert (a mod b <= 0).
-   generalize (ZOmod_sgn a b).
-   destruct (Zle_lt_or_eq a 0 H).
-   rewrite <- Zsgn_neg in H1; rewrite H1; romega with *.
-   subst a; simpl; auto.
-  generalize (ZOmod_lt a b H0); romega with *.
-Qed.
-
-Theorem ZOmod_lt_pos_pos : forall a b:Z, 0<=a -> 0<b -> 0 <= a mod b < b.
-Proof.
-  intros; generalize (ZOmod_lt_pos a b); romega with *.
-Qed.
-
-Theorem ZOmod_lt_pos_neg : forall a b:Z, 0<=a -> b<0 -> 0 <= a mod b < -b.
-Proof.
-  intros; generalize (ZOmod_lt_pos a b); romega with *.
-Qed.
-
-Theorem ZOmod_lt_neg_pos : forall a b:Z, a<=0 -> 0<b -> -b < a mod b <= 0.
-Proof.
-  intros; generalize (ZOmod_lt_neg a b); romega with *.
-Qed.
-
-Theorem ZOmod_lt_neg_neg : forall a b:Z, a<=0 -> b<0 -> b < a mod b <= 0.
-Proof.
-  intros; generalize (ZOmod_lt_neg a b); romega with *.
-Qed.
-
-(** * Division and Opposite *)
-
-(* The precise equalities that are invalid with "historic" Zdiv. *)
-
-Theorem ZOdiv_opp_l : forall a b:Z, (-a)/b = -(a/b).
-Proof.
- destruct a; destruct b; simpl; auto;
-  unfold ZOdiv, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith.
-Qed.
-
-Theorem ZOdiv_opp_r : forall a b:Z, a/(-b) = -(a/b).
-Proof.
- destruct a; destruct b; simpl; auto;
-  unfold ZOdiv, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith.
-Qed.
-
-Theorem ZOmod_opp_l : forall a b:Z, (-a) mod b = -(a mod b).
-Proof.
- destruct a; destruct b; simpl; auto;
-  unfold ZOmod, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith.
-Qed.
-
-Theorem ZOmod_opp_r : forall a b:Z, a mod (-b) = a mod b.
-Proof.
- destruct a; destruct b; simpl; auto;
-  unfold ZOmod, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith.
-Qed.
-
-Theorem ZOdiv_opp_opp : forall a b:Z, (-a)/(-b) = a/b.
-Proof.
- destruct a; destruct b; simpl; auto;
-  unfold ZOdiv, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith.
-Qed.
-
-Theorem ZOmod_opp_opp : forall a b:Z, (-a) mod (-b) = -(a mod b).
-Proof.
- destruct a; destruct b; simpl; auto;
-  unfold ZOmod, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith.
-Qed.
-
-(** * Unicity results *)
-
-Definition Remainder a b r :=
-  (0 <= a /\ 0 <= r < Zabs b) \/ (a <= 0 /\ -Zabs b < r <= 0).
-
-Definition Remainder_alt a b r :=
-  Zabs r < Zabs b /\ 0 <= r * a.
-
-Lemma Remainder_equiv : forall a b r,
- Remainder a b r <-> Remainder_alt a b r.
-Proof.
-  unfold Remainder, Remainder_alt; intuition.
-  romega with *.
-  romega with *.
-  rewrite <-(Zmult_opp_opp).
-  apply Zmult_le_0_compat; romega.
-  assert (0 <= Zsgn r * Zsgn a) by (rewrite <-Zsgn_Zmult, Zsgn_pos_iff; auto).
-  destruct r; simpl Zsgn in *; romega with *.
-Qed.
-
-Theorem ZOdiv_mod_unique_full:
- forall a b q r, Remainder a b r ->
-   a = b*q + r -> q = a/b /\ r = a mod b.
-Proof.
-  destruct 1 as [(H,H0)|(H,H0)]; intros.
-  apply Zdiv.Zdiv_mod_unique with b; auto.
-  apply ZOmod_lt_pos; auto.
-  romega with *.
-  rewrite <- H1; apply ZO_div_mod_eq.
-
-  rewrite <- (Zopp_involutive a).
-  rewrite ZOdiv_opp_l, ZOmod_opp_l.
-  generalize (Zdiv.Zdiv_mod_unique b (-q) (-a/b) (-r) (-a mod b)).
-  generalize (ZOmod_lt_pos (-a) b).
-  rewrite <-ZO_div_mod_eq, <-Zopp_mult_distr_r, <-Zopp_plus_distr, <-H1.
-  romega with *.
-Qed.
-
-Theorem ZOdiv_unique_full:
- forall a b q r, Remainder a b r ->
-  a = b*q + r -> q = a/b.
-Proof.
- intros; destruct (ZOdiv_mod_unique_full a b q r); auto.
-Qed.
-
-Theorem ZOdiv_unique:
- forall a b q r, 0 <= a -> 0 <= r < b ->
-   a = b*q + r -> q = a/b.
-Proof.
-  intros; eapply ZOdiv_unique_full; eauto.
-  red; romega with *.
-Qed.
-
-Theorem ZOmod_unique_full:
- forall a b q r, Remainder a b r ->
-  a = b*q + r -> r = a mod b.
-Proof.
- intros; destruct (ZOdiv_mod_unique_full a b q r); auto.
-Qed.
-
-Theorem ZOmod_unique:
- forall a b q r, 0 <= a -> 0 <= r < b ->
-   a = b*q + r -> r = a mod b.
-Proof.
-  intros; eapply ZOmod_unique_full; eauto.
-  red; romega with *.
-Qed.
-
-(** * Basic values of divisions and modulo. *)
-
-Lemma ZOmod_0_l: forall a, 0 mod a = 0.
-Proof.
-  destruct a; simpl; auto.
-Qed.
-
-Lemma ZOmod_0_r: forall a, a mod 0 = a.
-Proof.
-  destruct a; simpl; auto.
-Qed.
-
-Lemma ZOdiv_0_l: forall a, 0/a = 0.
-Proof.
-  destruct a; simpl; auto.
-Qed.
-
-Lemma ZOdiv_0_r: forall a, a/0 = 0.
-Proof.
-  destruct a; simpl; auto.
-Qed.
-
-Lemma ZOmod_1_r: forall a, a mod 1 = 0.
-Proof.
-  intros; symmetry; apply ZOmod_unique_full with a; auto with zarith.
-  rewrite Remainder_equiv; red; simpl; auto with zarith.
-Qed.
-
-Lemma ZOdiv_1_r: forall a, a/1 = a.
-Proof.
-  intros; symmetry; apply ZOdiv_unique_full with 0; auto with zarith.
-  rewrite Remainder_equiv; red; simpl; auto with zarith.
-Qed.
-
-Hint Resolve ZOmod_0_l ZOmod_0_r ZOdiv_0_l ZOdiv_0_r ZOdiv_1_r ZOmod_1_r
- : zarith.
-
-Lemma ZOdiv_1_l: forall a, 1 < a -> 1/a = 0.
-Proof.
-  intros; symmetry; apply ZOdiv_unique with 1; auto with zarith.
-Qed.
-
-Lemma ZOmod_1_l: forall a, 1 < a ->  1 mod a = 1.
-Proof.
-  intros; symmetry; apply ZOmod_unique with 0; auto with zarith.
-Qed.
-
-Lemma ZO_div_same : forall a:Z, a<>0 -> a/a = 1.
-Proof.
-  intros; symmetry; apply ZOdiv_unique_full with 0; auto with *.
-  rewrite Remainder_equiv; red; simpl; romega with *.
-Qed.
-
-Lemma ZO_mod_same : forall a, a mod a = 0.
-Proof.
-  destruct a; intros; symmetry.
-  compute; auto.
-  apply ZOmod_unique with 1; auto with *; romega with *.
-  apply ZOmod_unique_full with 1; auto with *; red; romega with *.
-Qed.
-
-Lemma ZO_mod_mult : forall a b, (a*b) mod b = 0.
-Proof.
-  intros a b; destruct (Z_eq_dec b 0) as [Hb|Hb].
-  subst; simpl; rewrite ZOmod_0_r; auto with zarith.
-  symmetry; apply ZOmod_unique_full with a; [ red; romega with * | ring ].
-Qed.
-
-Lemma ZO_div_mult : forall a b:Z, b <> 0 -> (a*b)/b = a.
-Proof.
-  intros; symmetry; apply ZOdiv_unique_full with 0; auto with zarith;
-   [ red; romega with * | ring].
-Qed.
-
-(** * Order results about ZOmod and ZOdiv *)
-
-(* Division of positive numbers is positive. *)
-
-Lemma ZO_div_pos: forall a b, 0 <= a -> 0 <= b -> 0 <= a/b.
-Proof.
-  intros.
-  destruct (Zle_lt_or_eq 0 b H0).
-  assert (H2:=ZOmod_lt_pos_pos a b H H1).
-  rewrite (ZO_div_mod_eq a b) in H.
-  destruct (Z_lt_le_dec (a/b) 0); auto.
-  assert (b*(a/b) <= -b).
-   replace (-b) with (b*-1); [ | ring].
-   apply Zmult_le_compat_l; auto with zarith.
-  romega.
-  subst b; rewrite ZOdiv_0_r; auto.
-Qed.
-
-(** As soon as the divisor is greater or equal than 2,
-    the division is strictly decreasing. *)
-
-Lemma ZO_div_lt : forall a b:Z, 0 < a -> 2 <= b -> a/b < a.
-Proof.
-  intros.
-  assert (Hb : 0 < b) by romega.
-  assert (H1 : 0 <= a/b) by (apply ZO_div_pos; auto with zarith).
-  assert (H2 : 0 <= a mod b < b) by (apply ZOmod_lt_pos_pos; auto with zarith).
-  destruct (Zle_lt_or_eq 0 (a/b) H1) as [H3|H3]; [ | rewrite <- H3; auto].
-  pattern a at 2; rewrite (ZO_div_mod_eq a b).
-  apply Zlt_le_trans with (2*(a/b)).
-  romega.
-  apply Zle_trans with (b*(a/b)).
-  apply Zmult_le_compat_r; auto.
-  romega.
-Qed.
-
-(** A division of a small number by a bigger one yields zero. *)
-
-Theorem ZOdiv_small: forall a b, 0 <= a < b -> a/b = 0.
-Proof.
-  intros a b H; apply sym_equal; apply ZOdiv_unique with a; auto with zarith.
-Qed.
-
-(** Same situation, in term of modulo: *)
-
-Theorem ZOmod_small: forall a n, 0 <= a < n -> a mod n = a.
-Proof.
-  intros a b H; apply sym_equal; apply ZOmod_unique with 0; auto with zarith.
-Qed.
-
-(** [Zge] is compatible with a positive division. *)
-
-Lemma ZO_div_monotone_pos : forall a b c:Z, 0<=c -> 0<=a<=b -> a/c <= b/c.
-Proof.
-  intros.
-  destruct H0.
-  destruct (Zle_lt_or_eq 0 c H);
-   [ clear H | subst c; do 2 rewrite ZOdiv_0_r; auto].
-  generalize (ZO_div_mod_eq a c).
-  generalize (ZOmod_lt_pos_pos a c H0 H2).
-  generalize (ZO_div_mod_eq b c).
-  generalize (ZOmod_lt_pos_pos b c (Zle_trans _ _ _ H0 H1) H2).
-  intros.
-  elim (Z_le_gt_dec (a / c) (b / c)); auto with zarith.
-  intro.
-  absurd (a - b >= 1).
-  omega.
-  replace (a-b) with (c * (a/c-b/c) + a mod c - b mod c) by
-    (symmetry; pattern a at 1; rewrite H5; pattern b at 1; rewrite H3; ring).
-  assert (c * (a / c - b / c) >= c * 1).
-  apply Zmult_ge_compat_l.
-  omega.
-  omega.
-  assert (c * 1 = c).
-  ring.
-  omega.
-Qed.
-
-Lemma ZO_div_monotone : forall a b c, 0<=c -> a<=b -> a/c <= b/c.
-Proof.
-  intros.
-  destruct (Z_le_gt_dec 0 a).
-  apply ZO_div_monotone_pos; auto with zarith.
-  destruct (Z_le_gt_dec 0 b).
-  apply Zle_trans with 0.
-  apply Zle_left_rev.
-  simpl.
-  rewrite <- ZOdiv_opp_l.
-  apply ZO_div_pos; auto with zarith.
-  apply ZO_div_pos; auto with zarith.
-  rewrite <-(Zopp_involutive a), (ZOdiv_opp_l (-a)).
-  rewrite <-(Zopp_involutive b), (ZOdiv_opp_l (-b)).
-  generalize (ZO_div_monotone_pos (-b) (-a) c H).
-  romega.
-Qed.
-
-(** With our choice of division, rounding of (a/b) is always done toward zero: *)
-
-Lemma ZO_mult_div_le : forall a b:Z, 0 <= a -> 0 <= b*(a/b) <= a.
-Proof.
-  intros a b Ha.
-  destruct b as [ |b|b].
-  simpl; auto with zarith.
-  split.
-  apply Zmult_le_0_compat; auto with zarith.
-  apply ZO_div_pos; auto with zarith.
-  generalize (ZO_div_mod_eq a (Zpos b)) (ZOmod_lt_pos_pos a (Zpos b) Ha); romega with *.
-  change (Zneg b) with (-Zpos b); rewrite ZOdiv_opp_r, Zmult_opp_opp.
-  split.
-  apply Zmult_le_0_compat; auto with zarith.
-  apply ZO_div_pos; auto with zarith.
-  generalize (ZO_div_mod_eq a (Zpos b)) (ZOmod_lt_pos_pos a (Zpos b) Ha); romega with *.
-Qed.
-
-Lemma ZO_mult_div_ge : forall a b:Z, a <= 0 -> a <= b*(a/b) <= 0.
-Proof.
-  intros a b Ha.
-  destruct b as [ |b|b].
-  simpl; auto with zarith.
-  split.
-  generalize (ZO_div_mod_eq a (Zpos b)) (ZOmod_lt_neg_pos a (Zpos b) Ha); romega with *.
-  apply Zle_left_rev; unfold Zplus.
-  rewrite Zopp_mult_distr_r, <-ZOdiv_opp_l.
-  apply Zmult_le_0_compat; auto with zarith.
-  apply ZO_div_pos; auto with zarith.
-  change (Zneg b) with (-Zpos b); rewrite ZOdiv_opp_r, Zmult_opp_opp.
-  split.
-  generalize (ZO_div_mod_eq a (Zpos b)) (ZOmod_lt_neg_pos a (Zpos b) Ha); romega with *.
-  apply Zle_left_rev; unfold Zplus.
-  rewrite Zopp_mult_distr_r, <-ZOdiv_opp_l.
-  apply Zmult_le_0_compat; auto with zarith.
-  apply ZO_div_pos; auto with zarith.
-Qed.
-
-(** The previous inequalities between [b*(a/b)] and [a] are exact
-    iff the modulo is zero. *)
-
-Lemma ZO_div_exact_full_1 : forall a b:Z, a = b*(a/b) -> a mod b = 0.
-Proof.
-  intros; generalize (ZO_div_mod_eq a b); romega.
-Qed.
-
-Lemma ZO_div_exact_full_2 : forall a b:Z, a mod b = 0 -> a = b*(a/b).
-Proof.
-  intros; generalize (ZO_div_mod_eq a b); romega.
-Qed.
-
-(** A modulo cannot grow beyond its starting point. *)
-
-Theorem ZOmod_le: forall a b, 0 <= a -> 0 <= b -> a mod b <= a.
-Proof.
-  intros a b H1 H2.
-  destruct (Zle_lt_or_eq _ _ H2).
-  case (Zle_or_lt b a); intros H3.
-  case (ZOmod_lt_pos_pos a b); auto with zarith.
-  rewrite ZOmod_small; auto with zarith.
-  subst; rewrite ZOmod_0_r; auto with zarith.
-Qed.
-
-(** Some additionnal inequalities about Zdiv. *)
-
-Theorem ZOdiv_le_upper_bound:
-  forall a b q, 0 < b -> a <= q*b -> a/b <= q.
-Proof.
-  intros.
-  rewrite <- (ZO_div_mult q b); auto with zarith.
-  apply ZO_div_monotone; auto with zarith.
-Qed.
-
-Theorem ZOdiv_lt_upper_bound:
-  forall a b q, 0 <= a -> 0 < b -> a < q*b -> a/b < q.
-Proof.
-  intros a b q H1 H2 H3.
-  apply Zmult_lt_reg_r with b; auto with zarith.
-  apply Zle_lt_trans with (2 := H3).
-  pattern a at 2; rewrite (ZO_div_mod_eq a b); auto with zarith.
-  rewrite (Zmult_comm b); case (ZOmod_lt_pos_pos a b); auto with zarith.
-Qed.
-
-Theorem ZOdiv_le_lower_bound:
-  forall a b q, 0 < b -> q*b <= a -> q <= a/b.
-Proof.
-  intros.
-  rewrite <- (ZO_div_mult q b); auto with zarith.
-  apply ZO_div_monotone; auto with zarith.
-Qed.
-
-Theorem ZOdiv_sgn: forall a b,
-  0 <= Zsgn (a/b) * Zsgn a * Zsgn b.
-Proof.
-  destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith;
-  unfold ZOdiv; simpl; destruct Pdiv_eucl; simpl; destruct n; simpl; auto with zarith.
-Qed.
-
-(** * Relations between usual operations and Zmod and Zdiv *)
-
-(** First, a result that used to be always valid with Zdiv,
-    but must be restricted here.
-    For instance, now (9+(-5)*2) mod 2 = -1 <> 1 = 9 mod 2 *)
-
-Lemma ZO_mod_plus : forall a b c:Z,
- 0 <= (a+b*c) * a ->
- (a + b * c) mod c = a mod c.
-Proof.
-  intros; destruct (Z_eq_dec a 0) as [Ha|Ha].
-  subst; simpl; rewrite ZOmod_0_l; apply ZO_mod_mult.
-  intros; destruct (Z_eq_dec c 0) as [Hc|Hc].
-  subst; do 2 rewrite ZOmod_0_r; romega.
-  symmetry; apply ZOmod_unique_full with (a/c+b); auto with zarith.
-  rewrite Remainder_equiv; split.
-  apply ZOmod_lt; auto.
-  apply Zmult_le_0_reg_r with (a*a); eauto.
-  destruct a; simpl; auto with zarith.
-  replace ((a mod c)*(a+b*c)*(a*a)) with (((a mod c)*a)*((a+b*c)*a)) by ring.
-  apply Zmult_le_0_compat; auto.
-  apply ZOmod_sgn2.
-  rewrite Zmult_plus_distr_r, Zmult_comm.
-  generalize (ZO_div_mod_eq a c); romega.
-Qed.
-
-Lemma ZO_div_plus : forall a b c:Z,
- 0 <= (a+b*c) * a -> c<>0 ->
- (a + b * c) / c = a / c + b.
-Proof.
-  intros; destruct (Z_eq_dec a 0) as [Ha|Ha].
-  subst; simpl; apply ZO_div_mult; auto.
-  symmetry.
-  apply ZOdiv_unique_full with (a mod c); auto with zarith.
-  rewrite Remainder_equiv; split.
-  apply ZOmod_lt; auto.
-  apply Zmult_le_0_reg_r with (a*a); eauto.
-  destruct a; simpl; auto with zarith.
-  replace ((a mod c)*(a+b*c)*(a*a)) with (((a mod c)*a)*((a+b*c)*a)) by ring.
-  apply Zmult_le_0_compat; auto.
-  apply ZOmod_sgn2.
-  rewrite Zmult_plus_distr_r, Zmult_comm.
-  generalize (ZO_div_mod_eq a c); romega.
-Qed.
-
-Theorem ZO_div_plus_l: forall a b c : Z,
- 0 <= (a*b+c)*c -> b<>0 ->
- b<>0 -> (a * b + c) / b = a + c / b.
-Proof.
-  intros a b c; rewrite Zplus_comm; intros; rewrite ZO_div_plus;
-  try apply Zplus_comm; auto with zarith.
-Qed.
-
-(** Cancellations. *)
-
-Lemma ZOdiv_mult_cancel_r : forall a b c:Z,
- c<>0 -> (a*c)/(b*c) = a/b.
-Proof.
- intros a b c Hc.
- destruct (Z_eq_dec b 0).
- subst; simpl; do 2 rewrite ZOdiv_0_r; auto.
- symmetry.
- apply ZOdiv_unique_full with ((a mod b)*c); auto with zarith.
- rewrite Remainder_equiv.
- split.
- do 2 rewrite Zabs_Zmult.
- apply Zmult_lt_compat_r.
- romega with *.
- apply ZOmod_lt; auto.
- replace ((a mod b)*c*(a*c)) with (((a mod b)*a)*(c*c)) by ring.
- apply Zmult_le_0_compat.
- apply ZOmod_sgn2.
- destruct c; simpl; auto with zarith.
- pattern a at 1; rewrite (ZO_div_mod_eq a b); ring.
-Qed.
-
-Lemma ZOdiv_mult_cancel_l : forall a b c:Z,
- c<>0 -> (c*a)/(c*b) = a/b.
-Proof.
-  intros.
-  rewrite (Zmult_comm c a); rewrite (Zmult_comm c b).
-  apply ZOdiv_mult_cancel_r; auto.
-Qed.
-
-Lemma ZOmult_mod_distr_l: forall a b c,
-  (c*a) mod (c*b) = c * (a mod b).
-Proof.
-  intros; destruct (Z_eq_dec c 0) as [Hc|Hc].
-  subst; simpl; rewrite ZOmod_0_r; auto.
-  destruct (Z_eq_dec b 0) as [Hb|Hb].
-  subst; repeat rewrite Zmult_0_r || rewrite ZOmod_0_r; auto.
-  assert (c*b <> 0).
-   contradict Hc; eapply Zmult_integral_l; eauto.
-  rewrite (Zplus_minus_eq _ _ _ (ZO_div_mod_eq (c*a) (c*b))).
-  rewrite (Zplus_minus_eq _ _ _ (ZO_div_mod_eq a b)).
-  rewrite ZOdiv_mult_cancel_l; auto with zarith.
-  ring.
-Qed.
-
-Lemma ZOmult_mod_distr_r: forall a b c,
-  (a*c) mod (b*c) = (a mod b) * c.
-Proof.
-  intros; repeat rewrite (fun x => (Zmult_comm x c)).
-  apply ZOmult_mod_distr_l; auto.
-Qed.
-
-(** Operations modulo. *)
-
-Theorem ZOmod_mod: forall a n, (a mod n) mod n = a mod n.
-Proof.
-  intros.
-  generalize (ZOmod_sgn2 a n).
-  pattern a at 2 4; rewrite (ZO_div_mod_eq a n); auto with zarith.
-  rewrite Zplus_comm; rewrite (Zmult_comm n).
-  intros.
-  apply sym_equal; apply ZO_mod_plus; auto with zarith.
-  rewrite Zmult_comm; auto.
-Qed.
-
-Theorem ZOmult_mod: forall a b n,
- (a * b) mod n = ((a mod n) * (b mod n)) mod n.
-Proof.
-  intros.
-  generalize (Zmult_le_0_compat _ _ (ZOmod_sgn2 a n) (ZOmod_sgn2 b n)).
-  pattern a at 2 3; rewrite (ZO_div_mod_eq a n); auto with zarith.
-  pattern b at 2 3; rewrite (ZO_div_mod_eq b n); auto with zarith.
-  set (A:=a mod n); set (B:=b mod n); set (A':=a/n); set (B':=b/n).
-  replace (A*(n*A'+A)*(B*(n*B'+B))) with (((n*A' + A) * (n*B' + B))*(A*B))
-   by ring.
-  replace ((n*A' + A) * (n*B' + B))
-   with (A*B + (A'*B+B'*A+n*A'*B')*n) by ring.
-  intros.
-  apply ZO_mod_plus; auto with zarith.
-Qed.
-
-(** addition and modulo
-
-  Generally speaking, unlike with Zdiv, we don't have
-       (a+b) mod n = (a mod n + b mod n) mod n
-  for any a and b.
-  For instance, take (8 + (-10)) mod 3 = -2 whereas
-  (8 mod 3 + (-10 mod 3)) mod 3 = 1. *)
-
-Theorem ZOplus_mod: forall a b n,
- 0 <= a * b ->
- (a + b) mod n = (a mod n + b mod n) mod n.
-Proof.
-  assert (forall a b n, 0<a -> 0<b ->
-           (a + b) mod n = (a mod n + b mod n) mod n).
-  intros a b n Ha Hb.
-  assert (H : 0<=a+b) by (romega with * ); revert H.
-  pattern a at 1 2; rewrite (ZO_div_mod_eq a n); auto with zarith.
-  pattern b at 1 2; rewrite (ZO_div_mod_eq b n); auto with zarith.
-  replace ((n * (a / n) + a mod n) + (n * (b / n) + b mod n))
-     with ((a mod n + b mod n) + (a / n + b / n) * n) by ring.
-  intros.
-  apply ZO_mod_plus; auto with zarith.
-  apply Zmult_le_0_compat; auto with zarith.
-  apply Zplus_le_0_compat.
-  apply Zmult_le_reg_r with a; auto with zarith.
-  simpl; apply ZOmod_sgn2; auto.
-  apply Zmult_le_reg_r with b; auto with zarith.
-  simpl; apply ZOmod_sgn2; auto.
-  (* general situation *)
-  intros a b n Hab.
-  destruct (Z_eq_dec a 0).
-  subst; simpl; symmetry; apply ZOmod_mod.
-  destruct (Z_eq_dec b 0).
-  subst; simpl; do 2 rewrite Zplus_0_r; symmetry; apply ZOmod_mod.
-  assert (0<a /\ 0<b \/ a<0 /\ b<0).
-   destruct a; destruct b; simpl in *; intuition; romega with *.
-  destruct H0.
-  apply H; intuition.
-  rewrite <-(Zopp_involutive a), <-(Zopp_involutive b).
-  rewrite <- Zopp_plus_distr; rewrite ZOmod_opp_l.
-  rewrite (ZOmod_opp_l (-a)),(ZOmod_opp_l (-b)).
-  match goal with |- _ = (-?x+-?y) mod n =>
-   rewrite <-(Zopp_plus_distr x y), ZOmod_opp_l end.
-  f_equal; apply H; auto with zarith.
-Qed.
-
-Lemma ZOplus_mod_idemp_l: forall a b n,
- 0 <= a * b ->
- (a mod n + b) mod n = (a + b) mod n.
-Proof.
-  intros.
-  rewrite ZOplus_mod.
-  rewrite ZOmod_mod.
-  symmetry.
-  apply ZOplus_mod; auto.
-  destruct (Z_eq_dec a 0).
-  subst; rewrite ZOmod_0_l; auto.
-  destruct (Z_eq_dec b 0).
-  subst; rewrite Zmult_0_r; auto with zarith.
-  apply Zmult_le_reg_r with (a*b).
-  assert (a*b <> 0).
-   intro Hab.
-   rewrite (Zmult_integral_l _ _ n1 Hab) in n0; auto with zarith.
-  auto with zarith.
-  simpl.
-  replace (a mod n * b * (a*b)) with ((a mod n * a)*(b*b)) by ring.
-  apply Zmult_le_0_compat.
-  apply ZOmod_sgn2.
-  destruct b; simpl; auto with zarith.
-Qed.
-
-Lemma ZOplus_mod_idemp_r: forall a b n,
- 0 <= a*b ->
- (b + a mod n) mod n = (b + a) mod n.
-Proof.
-  intros.
-  rewrite Zplus_comm, (Zplus_comm b a).
-  apply ZOplus_mod_idemp_l; auto.
-Qed.
-
-Lemma ZOmult_mod_idemp_l: forall a b n, (a mod n * b) mod n = (a * b) mod n.
-Proof.
-  intros; rewrite ZOmult_mod, ZOmod_mod, <- ZOmult_mod; auto.
-Qed.
-
-Lemma ZOmult_mod_idemp_r: forall a b n, (b * (a mod n)) mod n = (b * a) mod n.
-Proof.
-  intros; rewrite ZOmult_mod, ZOmod_mod, <- ZOmult_mod; auto.
-Qed.
-
-(** Unlike with Zdiv, the following result is true without restrictions. *)
-
-Lemma ZOdiv_ZOdiv : forall a b c, (a/b)/c = a/(b*c).
-Proof.
-  (* particular case: a, b, c positive *)
-  assert (forall a b c, a>0 -> b>0 -> c>0 -> (a/b)/c = a/(b*c)).
-   intros a b c H H0 H1.
-   pattern a at 2;rewrite (ZO_div_mod_eq a b).
-   pattern (a/b) at 2;rewrite (ZO_div_mod_eq (a/b) c).
-   replace (b * (c * (a / b / c) + (a / b) mod c) + a mod b) with
-    ((a / b / c)*(b * c)  + (b * ((a / b) mod c) + a mod b)) by ring.
-   assert (b*c<>0).
-    intro H2;
-    assert (H3: c <> 0) by auto with zarith;
-    rewrite (Zmult_integral_l _ _ H3 H2) in H0; auto with zarith.
-   assert (0<=a/b) by (apply (ZO_div_pos a b); auto with zarith).
-   assert (0<=a mod b < b) by (apply ZOmod_lt_pos_pos; auto with zarith).
-   assert (0<=(a/b) mod c < c) by
-    (apply ZOmod_lt_pos_pos; auto with zarith).
-   rewrite ZO_div_plus_l; auto with zarith.
-   rewrite (ZOdiv_small (b * ((a / b) mod c) + a mod b)).
-   ring.
-   split.
-   apply Zplus_le_0_compat;auto with zarith.
-   apply Zle_lt_trans with (b * ((a / b) mod c) + (b-1)).
-   apply Zplus_le_compat;auto with zarith.
-   apply Zle_lt_trans with (b * (c-1) + (b - 1)).
-   apply Zplus_le_compat;auto with zarith.
-   replace (b * (c - 1) + (b - 1)) with (b*c-1);try ring;auto with zarith.
-   repeat (apply Zmult_le_0_compat || apply Zplus_le_0_compat); auto with zarith.
-   apply (ZO_div_pos (a/b) c); auto with zarith.
-  (* b c positive, a general *)
-  assert (forall a b c, b>0 -> c>0 -> (a/b)/c = a/(b*c)).
-   intros; destruct a as [ |a|a]; try reflexivity.
-   apply H; auto with zarith.
-   change (Zneg a) with (-Zpos a); repeat rewrite ZOdiv_opp_l.
-   f_equal; apply H; auto with zarith.
-  (* c positive, a b general *)
-  assert (forall a b c, c>0 -> (a/b)/c = a/(b*c)).
-   intros; destruct b as [ |b|b].
-   repeat rewrite ZOdiv_0_r; reflexivity.
-   apply H0; auto with zarith.
-   change (Zneg b) with (-Zpos b);
-   repeat (rewrite ZOdiv_opp_r || rewrite ZOdiv_opp_l || rewrite <- Zopp_mult_distr_l).
-   f_equal; apply H0; auto with zarith.
-  (* a b c general *)
-  intros; destruct c as [ |c|c].
-  rewrite Zmult_0_r; repeat rewrite ZOdiv_0_r; reflexivity.
-  apply H1; auto with zarith.
-  change (Zneg c) with (-Zpos c);
-  rewrite <- Zopp_mult_distr_r; do 2 rewrite ZOdiv_opp_r.
-  f_equal; apply H1; auto with zarith.
-Qed.
-
-(** A last inequality: *)
-
-Theorem ZOdiv_mult_le:
- forall a b c, 0<=a -> 0<=b -> 0<=c -> c*(a/b) <= (c*a)/b.
-Proof.
-  intros a b c Ha Hb Hc.
-  destruct (Zle_lt_or_eq _ _ Ha);
-   [ | subst; rewrite ZOdiv_0_l, Zmult_0_r, ZOdiv_0_l; auto].
-  destruct (Zle_lt_or_eq _ _ Hb);
-   [ | subst; rewrite ZOdiv_0_r, ZOdiv_0_r, Zmult_0_r; auto].
-  destruct (Zle_lt_or_eq _ _ Hc);
-   [ | subst; rewrite ZOdiv_0_l; auto].
-  case (ZOmod_lt_pos_pos a b); auto with zarith; intros Hu1 Hu2.
-  case (ZOmod_lt_pos_pos c b); auto with zarith; intros Hv1 Hv2.
-  apply Zmult_le_reg_r with b; auto with zarith.
-  rewrite <- Zmult_assoc.
-  replace (a / b * b) with (a - a mod b).
-  replace (c * a / b * b) with (c * a - (c * a) mod b).
-  rewrite Zmult_minus_distr_l.
-  unfold Zminus; apply Zplus_le_compat_l.
-  match goal with |- - ?X <= -?Y => assert (Y <= X); auto with zarith end.
-  apply Zle_trans with ((c mod b) * (a mod b)); auto with zarith.
-  rewrite ZOmult_mod; auto with zarith.
-  apply (ZOmod_le ((c mod b) * (a mod b)) b); auto with zarith.
-  apply Zmult_le_compat_r; auto with zarith.
-  apply (ZOmod_le c b); auto.
-  pattern (c * a) at 1; rewrite (ZO_div_mod_eq (c * a) b); try ring;
-    auto with zarith.
-  pattern a at 1; rewrite (ZO_div_mod_eq a b); try ring; auto with zarith.
-Qed.
-
-(** ZOmod is related to divisibility (see more in Znumtheory) *)
-
-Lemma ZOmod_divides : forall a b,
- a mod b = 0 <-> exists c, a = b*c.
-Proof.
- split; intros.
- exists (a/b).
- pattern a at 1; rewrite (ZO_div_mod_eq a b).
- rewrite H; auto with zarith.
- destruct H as [c Hc].
- destruct (Z_eq_dec b 0).
- subst b; simpl in *; subst a; auto.
- symmetry.
- apply ZOmod_unique_full with c; auto with zarith.
- red; romega with *.
-Qed.
-
-(** * Interaction with "historic" Zdiv *)
-
-(** They agree at least on positive numbers: *)
-
-Theorem ZOdiv_eucl_Zdiv_eucl_pos : forall a b:Z, 0 <= a -> 0 < b ->
-  a/b = Zdiv.Zdiv a b /\ a mod b = Zdiv.Zmod a b.
-Proof.
-  intros.
-  apply Zdiv.Zdiv_mod_unique with b.
-  apply ZOmod_lt_pos; auto with zarith.
-  rewrite Zabs_eq; auto with *; apply Zdiv.Z_mod_lt; auto with *.
-  rewrite <- Zdiv.Z_div_mod_eq; auto with *.
-  symmetry; apply ZO_div_mod_eq; auto with *.
-Qed.
-
-Theorem ZOdiv_Zdiv_pos : forall a b, 0 <= a -> 0 <= b ->
-  a/b = Zdiv.Zdiv a b.
-Proof.
- intros a b Ha Hb.
- destruct (Zle_lt_or_eq _ _ Hb).
- generalize (ZOdiv_eucl_Zdiv_eucl_pos a b Ha H); intuition.
- subst; rewrite ZOdiv_0_r, Zdiv.Zdiv_0_r; reflexivity.
-Qed.
-
-Theorem ZOmod_Zmod_pos : forall a b, 0 <= a -> 0 < b ->
-  a mod b = Zdiv.Zmod a b.
-Proof.
- intros a b Ha Hb; generalize (ZOdiv_eucl_Zdiv_eucl_pos a b Ha Hb);
- intuition.
-Qed.
-
-(** Modulos are null at the same places *)
-
-Theorem ZOmod_Zmod_zero : forall a b, b<>0 ->
- (a mod b = 0 <-> Zdiv.Zmod a b = 0).
-Proof.
- intros.
- rewrite ZOmod_divides, Zdiv.Zmod_divides; intuition.
-Qed.
+Require Import BinInt Zquot.
+
+Notation ZO_div_mod_eq := Z.quot_rem' (only parsing).
+Notation ZOmod_lt := Zrem_lt (only parsing).
+Notation ZOmod_sgn := Zrem_sgn (only parsing).
+Notation ZOmod_sgn2 := Zrem_sgn2 (only parsing).
+Notation ZOmod_lt_pos := Zrem_lt_pos (only parsing).
+Notation ZOmod_lt_neg := Zrem_lt_neg (only parsing).
+Notation ZOmod_lt_pos_pos := Zrem_lt_pos_pos (only parsing).
+Notation ZOmod_lt_pos_neg := Zrem_lt_pos_neg (only parsing).
+Notation ZOmod_lt_neg_pos := Zrem_lt_neg_pos (only parsing).
+Notation ZOmod_lt_neg_neg := Zrem_lt_neg_neg (only parsing).
+
+Notation ZOdiv_opp_l := Zquot_opp_l (only parsing).
+Notation ZOdiv_opp_r := Zquot_opp_r (only parsing).
+Notation ZOmod_opp_l := Zrem_opp_l (only parsing).
+Notation ZOmod_opp_r := Zrem_opp_r (only parsing).
+Notation ZOdiv_opp_opp := Zquot_opp_opp (only parsing).
+Notation ZOmod_opp_opp := Zrem_opp_opp (only parsing).
+
+Notation Remainder := Remainder (only parsing).
+Notation Remainder_alt := Remainder_alt (only parsing).
+Notation Remainder_equiv := Remainder_equiv (only parsing).
+Notation ZOdiv_mod_unique_full := Zquot_mod_unique_full (only parsing).
+Notation ZOdiv_unique_full := Zquot_unique_full (only parsing).
+Notation ZOdiv_unique := Zquot_unique (only parsing).
+Notation ZOmod_unique_full := Zrem_unique_full (only parsing).
+Notation ZOmod_unique := Zrem_unique (only parsing).
+
+Notation ZOmod_0_l := Zrem_0_l (only parsing).
+Notation ZOmod_0_r := Zrem_0_r (only parsing).
+Notation ZOdiv_0_l := Zquot_0_l (only parsing).
+Notation ZOdiv_0_r := Zquot_0_r (only parsing).
+Notation ZOmod_1_r := Zrem_1_r (only parsing).
+Notation ZOdiv_1_r := Zquot_1_r (only parsing).
+Notation ZOdiv_1_l := Zquot_1_l (only parsing).
+Notation ZOmod_1_l := Zrem_1_l (only parsing).
+Notation ZO_div_same := Z_quot_same (only parsing).
+Notation ZO_mod_same := Z_rem_same (only parsing).
+Notation ZO_mod_mult := Z_rem_mult (only parsing).
+Notation ZO_div_mult := Z_quot_mult (only parsing).
+
+Notation ZO_div_pos := Z_quot_pos (only parsing).
+Notation ZO_div_lt := Z_quot_lt (only parsing).
+Notation ZOdiv_small := Zquot_small (only parsing).
+Notation ZOmod_small := Zrem_small (only parsing).
+Notation ZO_div_monotone := Z_quot_monotone (only parsing).
+Notation ZO_mult_div_le := Z_mult_quot_le (only parsing).
+Notation ZO_mult_div_ge := Z_mult_quot_ge (only parsing).
+Definition ZO_div_exact_full_1 a b := proj1 (Z_quot_exact_full a b).
+Definition ZO_div_exact_full_2 a b := proj2 (Z_quot_exact_full a b).
+Notation ZOmod_le := Zrem_le (only parsing).
+Notation ZOdiv_le_upper_bound := Zquot_le_upper_bound (only parsing).
+Notation ZOdiv_lt_upper_bound := Zquot_lt_upper_bound (only parsing).
+Notation ZOdiv_le_lower_bound := Zquot_le_lower_bound (only parsing).
+Notation ZOdiv_sgn := Zquot_sgn (only parsing).
+
+Notation ZO_mod_plus := Z_rem_plus (only parsing).
+Notation ZO_div_plus := Z_quot_plus (only parsing).
+Notation ZO_div_plus_l := Z_quot_plus_l (only parsing).
+Notation ZOdiv_mult_cancel_r := Zquot_mult_cancel_r (only parsing).
+Notation ZOdiv_mult_cancel_l := Zquot_mult_cancel_l (only parsing).
+Notation ZOmult_mod_distr_l := Zmult_rem_distr_l (only parsing).
+Notation ZOmult_mod_distr_r := Zmult_rem_distr_r (only parsing).
+Notation ZOmod_mod := Zrem_rem (only parsing).
+Notation ZOmult_mod := Zmult_rem (only parsing).
+Notation ZOplus_mod := Zplus_rem (only parsing).
+Notation ZOplus_mod_idemp_l := Zplus_rem_idemp_l (only parsing).
+Notation ZOplus_mod_idemp_r := Zplus_rem_idemp_r (only parsing).
+Notation ZOmult_mod_idemp_l := Zmult_rem_idemp_l (only parsing).
+Notation ZOmult_mod_idemp_r := Zmult_rem_idemp_r (only parsing).
+Notation ZOdiv_ZOdiv := Zquot_Zquot (only parsing).
+Notation ZOdiv_mult_le := Zquot_mult_le (only parsing).
+Notation ZOmod_divides := Zrem_divides (only parsing).
+
+Notation ZOdiv_eucl_Zdiv_eucl_pos := Zquotrem_Zdiv_eucl_pos (only parsing).
+Notation ZOdiv_Zdiv_pos := Zquot_Zdiv_pos (only parsing).
+Notation ZOmod_Zmod_pos := Zrem_Zmod_pos (only parsing).
+Notation ZOmod_Zmod_zero := Zrem_Zmod_zero (only parsing).
diff --git a/theories/ZArith/ZOdiv_def.v b/theories/ZArith/ZOdiv_def.v
index 71d6cad4..38d25797 100644
--- a/theories/ZArith/ZOdiv_def.v
+++ b/theories/ZArith/ZOdiv_def.v
@@ -1,136 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+Require Import BinInt.
 
-Require Import BinPos BinNat Nnat ZArith_base.
+Notation ZOdiv_eucl := Z.quotrem (only parsing).
+Notation ZOdiv := Z.quot (only parsing).
+Notation ZOmod := Z.rem (only parsing).
 
-Open Scope Z_scope.
-
-Definition NPgeb (a:N)(b:positive) :=
-  match a with
-   | N0 => false
-   | Npos na => match Pcompare na b Eq with Lt => false | _ => true end
-  end.
-
-Fixpoint Pdiv_eucl (a b:positive) : N * N :=
-  match a with
-    | xH =>
-       match b with xH => (1, 0)%N | _ => (0, 1)%N end
-    | xO a' =>
-       let (q, r) := Pdiv_eucl a' b in
-       let r' := (2 * r)%N in
-        if (NPgeb r' b) then (2 * q + 1, (Nminus r'  (Npos b)))%N
-        else  (2 * q, r')%N
-    | xI a' =>
-       let (q, r) := Pdiv_eucl a' b in
-       let r' := (2 * r + 1)%N in
-        if (NPgeb r' b) then (2 * q + 1, (Nminus r' (Npos b)))%N
-        else  (2 * q, r')%N
-  end.
-
-Definition ZOdiv_eucl (a b:Z) : Z * Z :=
-  match a, b with
-   | Z0,  _ => (Z0, Z0)
-   | _, Z0  => (Z0, a)
-   | Zpos na, Zpos nb =>
-         let (nq, nr) := Pdiv_eucl na nb in
-         (Z_of_N nq, Z_of_N nr)
-   | Zneg na, Zpos nb =>
-         let (nq, nr) := Pdiv_eucl na nb in
-         (Zopp (Z_of_N nq), Zopp (Z_of_N nr))
-   | Zpos na, Zneg nb =>
-         let (nq, nr) := Pdiv_eucl na nb in
-         (Zopp (Z_of_N nq), Z_of_N nr)
-   | Zneg na, Zneg nb =>
-         let (nq, nr) := Pdiv_eucl na nb in
-         (Z_of_N nq, Zopp (Z_of_N nr))
-  end.
-
-Definition ZOdiv a b := fst (ZOdiv_eucl a b).
-Definition ZOmod a b := snd (ZOdiv_eucl a b).
-
-
-Definition Ndiv_eucl (a b:N) : N * N :=
-  match a, b with
-   | N0,  _ => (N0, N0)
-   | _, N0  => (N0, a)
-   | Npos na, Npos nb => Pdiv_eucl na nb
-  end.
-
-Definition Ndiv a b := fst (Ndiv_eucl a b).
-Definition Nmod a b := snd (Ndiv_eucl a b).
-
-
-(* Proofs of specifications for these euclidean divisions. *)
-
-Theorem NPgeb_correct: forall (a:N)(b:positive),
-  if NPgeb a b then a = (Nminus a (Npos b) + Npos b)%N else True.
-Proof.
-  destruct a; intros; simpl; auto.
-  generalize (Pcompare_Eq_eq p b).
-  case_eq (Pcompare p b Eq); intros; auto.
-  rewrite H0; auto.
-  now rewrite Pminus_mask_diag.
-  destruct (Pminus_mask_Gt p b H) as [d [H2 [H3 _]]].
-  rewrite H2. rewrite <- H3.
-  simpl; f_equal; apply Pplus_comm.
-Qed.
-
-Hint Rewrite Z_of_N_plus Z_of_N_mult Z_of_N_minus Zmult_1_l Zmult_assoc
- Zmult_plus_distr_l Zmult_plus_distr_r : zdiv.
-Hint Rewrite <- Zplus_assoc : zdiv.
-
-Theorem Pdiv_eucl_correct: forall a b,
-  let (q,r) := Pdiv_eucl a b in
-  Zpos a = Z_of_N q * Zpos b + Z_of_N r.
-Proof.
-  induction a; cbv beta iota delta [Pdiv_eucl]; fold Pdiv_eucl; cbv zeta.
-  intros b; generalize (IHa b); case Pdiv_eucl.
-    intros q1 r1 Hq1.
-     generalize (NPgeb_correct (2 * r1 + 1) b); case NPgeb; intros H.
-     set (u := Nminus (2 * r1 + 1) (Npos b)) in * |- *.
-     assert (HH: Z_of_N u = (Z_of_N (2 * r1 + 1) - Zpos b)%Z).
-        rewrite H; autorewrite with zdiv; simpl.
-        rewrite Zplus_comm, Zminus_plus; trivial.
-     rewrite HH; autorewrite with zdiv; simpl Z_of_N.
-     rewrite Zpos_xI, Hq1.
-     autorewrite with zdiv; f_equal; rewrite Zplus_minus; trivial.
-     rewrite Zpos_xI, Hq1; autorewrite with zdiv; auto.
-  intros b; generalize (IHa b); case Pdiv_eucl.
-    intros q1 r1 Hq1.
-     generalize (NPgeb_correct (2 * r1) b); case NPgeb; intros H.
-     set (u := Nminus (2 * r1) (Npos b)) in * |- *.
-     assert (HH: Z_of_N u = (Z_of_N (2 * r1) - Zpos b)%Z).
-        rewrite H; autorewrite with zdiv; simpl.
-        rewrite Zplus_comm, Zminus_plus; trivial.
-     rewrite HH; autorewrite with zdiv; simpl Z_of_N.
-     rewrite Zpos_xO, Hq1.
-     autorewrite with zdiv; f_equal; rewrite Zplus_minus; trivial.
-     rewrite Zpos_xO, Hq1; autorewrite with zdiv; auto.
-  destruct b; auto.
-Qed.
-
-Theorem ZOdiv_eucl_correct: forall a b,
-  let (q,r) := ZOdiv_eucl a b in a = q * b + r.
-Proof.
-  destruct a; destruct b; simpl; auto;
-  generalize (Pdiv_eucl_correct p p0); case Pdiv_eucl; auto; intros;
-  try change (Zneg p) with (Zopp (Zpos p)); rewrite H.
-    destruct n; auto.
-  repeat (rewrite Zopp_plus_distr || rewrite Zopp_mult_distr_l); trivial.
-  repeat (rewrite Zopp_plus_distr || rewrite Zopp_mult_distr_r); trivial.
-Qed.
-
-Theorem Ndiv_eucl_correct: forall a b,
-  let (q,r) := Ndiv_eucl a b in a = (q * b + r)%N.
-Proof.
-  destruct a; destruct b; simpl; auto;
-  generalize (Pdiv_eucl_correct p p0); case Pdiv_eucl; auto; intros;
-  destruct n; destruct n0; simpl; simpl in H; try discriminate;
-  injection H; intros; subst; trivial.
-Qed.
+Notation ZOdiv_eucl_correct := Z.quotrem_eq.
diff --git a/theories/ZArith/ZOrderedType.v b/theories/ZArith/ZOrderedType.v
deleted file mode 100644
index de4e4e98..00000000
--- a/theories/ZArith/ZOrderedType.v
+++ /dev/null
@@ -1,60 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-Require Import BinInt Zcompare Zorder Zbool ZArith_dec
- Equalities Orders OrdersTac.
-
-Local Open Scope Z_scope.
-
-(** * DecidableType structure for binary integers *)
-
-Module Z_as_UBE <: UsualBoolEq.
- Definition t := Z.
- Definition eq := @eq Z.
- Definition eqb := Zeq_bool.
- Definition eqb_eq x y := iff_sym (Zeq_is_eq_bool x y).
-End Z_as_UBE.
-
-Module Z_as_DT <: UsualDecidableTypeFull := Make_UDTF Z_as_UBE.
-
-(** Note that the last module fulfills by subtyping many other
-    interfaces, such as [DecidableType] or [EqualityType]. *)
-
-
-(** * OrderedType structure for binary integers *)
-
-Module Z_as_OT <: OrderedTypeFull.
- Include Z_as_DT.
- Definition lt := Zlt.
- Definition le := Zle.
- Definition compare := Zcompare.
-
- Instance lt_strorder : StrictOrder Zlt.
- Proof. split; [ exact Zlt_irrefl | exact Zlt_trans ]. Qed.
-
- Instance lt_compat : Proper (Logic.eq==>Logic.eq==>iff) Zlt.
- Proof. repeat red; intros; subst; auto. Qed.
-
- Definition le_lteq := Zle_lt_or_eq_iff.
- Definition compare_spec := Zcompare_spec.
-
-End Z_as_OT.
-
-(** Note that [Z_as_OT] can also be seen as a [UsualOrderedType]
-   and a [OrderedType] (and also as a [DecidableType]). *)
-
-
-
-(** * An [order] tactic for integers *)
-
-Module ZOrder := OTF_to_OrderTac Z_as_OT.
-Ltac z_order := ZOrder.order.
-
-(** Note that [z_order] is domain-agnostic: it will not prove
-    [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
-
diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v
index 0f6e62b7..08d1a931 100644
--- a/theories/ZArith/Zabs.v
+++ b/theories/ZArith/Zabs.v
@@ -1,226 +1,106 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zabs.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
 
-(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
+(** Binary Integers : properties of absolute value *)
+(** Initial author : Pierre Crégut (CNET, Lannion, France) *)
+
+(** THIS FILE IS DEPRECATED.
+    It is now almost entirely made of compatibility formulations
+    for results already present in BinInt.Z. *)
 
 Require Import Arith_base.
 Require Import BinPos.
 Require Import BinInt.
+Require Import Zcompare.
 Require Import Zorder.
-Require Import Zmax.
 Require Import Znat.
 Require Import ZArith_dec.
 
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 (**********************************************************************)
 (** * Properties of absolute value *)
 
-Lemma Zabs_eq : forall n:Z, 0 <= n -> Zabs n = n.
-Proof.
-  intro x; destruct x; auto with arith.
-  compute in |- *; intros; absurd (Gt = Gt); trivial with arith.
-Qed.
-
-Lemma Zabs_non_eq : forall n:Z, n <= 0 -> Zabs n = - n.
-Proof.
-  intro x; destruct x; auto with arith.
-  compute in |- *; intros; absurd (Gt = Gt); trivial with arith.
-Qed.
-
-Theorem Zabs_Zopp : forall n:Z, Zabs (- n) = Zabs n.
-Proof.
-  intros z; case z; simpl in |- *; auto.
-Qed.
+Notation Zabs_eq := Z.abs_eq (compat "8.3").
+Notation Zabs_non_eq := Z.abs_neq (compat "8.3").
+Notation Zabs_Zopp := Z.abs_opp (compat "8.3").
+Notation Zabs_pos := Z.abs_nonneg (compat "8.3").
+Notation Zabs_involutive := Z.abs_involutive (compat "8.3").
+Notation Zabs_eq_case := Z.abs_eq_cases (compat "8.3").
+Notation Zabs_triangle := Z.abs_triangle (compat "8.3").
+Notation Zsgn_Zabs := Z.sgn_abs (compat "8.3").
+Notation Zabs_Zsgn := Z.abs_sgn (compat "8.3").
+Notation Zabs_Zmult := Z.abs_mul (compat "8.3").
+Notation Zabs_square := Z.abs_square (compat "8.3").
 
 (** * Proving a property of the absolute value by cases *)
 
 Lemma Zabs_ind :
   forall (P:Z -> Prop) (n:Z),
-    (n >= 0 -> P n) -> (n <= 0 -> P (- n)) -> P (Zabs n).
+    (n >= 0 -> P n) -> (n <= 0 -> P (- n)) -> P (Z.abs n).
 Proof.
-  intros P x H H0; elim (Z_lt_ge_dec x 0); intro.
-  assert (x <= 0). apply Zlt_le_weak; assumption.
-  rewrite Zabs_non_eq. apply H0. assumption. assumption.
-  rewrite Zabs_eq. apply H; assumption. apply Zge_le. assumption.
+ intros. apply Z.abs_case_strong; Z.swap_greater; trivial.
+ intros x y Hx; now subst.
 Qed.
 
-Theorem Zabs_intro : forall P (n:Z), P (- n) -> P n -> P (Zabs n).
+Theorem Zabs_intro : forall P (n:Z), P (- n) -> P n -> P (Z.abs n).
 Proof.
-  intros P z; case z; simpl in |- *; auto.
+ now destruct n.
 Qed.
 
-Definition Zabs_dec : forall x:Z, {x = Zabs x} + {x = - Zabs x}.
+Definition Zabs_dec : forall x:Z, {x = Z.abs x} + {x = - Z.abs x}.
 Proof.
-  intro x; destruct x; auto with arith.
+ destruct x; auto.
 Defined.
 
-Lemma Zabs_pos : forall n:Z, 0 <= Zabs n.
-  intro x; destruct x; auto with arith; compute in |- *; intros H; inversion H.
-Qed.
-
-Lemma Zabs_involutive : forall x:Z, Zabs (Zabs x) = Zabs x.
-Proof.
-  intros; apply Zabs_eq; apply Zabs_pos.
-Qed.
-
-Theorem Zabs_eq_case : forall n m:Z, Zabs n = Zabs m -> n = m \/ n = - m.
-Proof.
-  intros z1 z2; case z1; case z2; simpl in |- *; auto;
-    try (intros; discriminate); intros p1 p2 H1; injection H1;
-      (intros H2; rewrite H2); auto.
-Qed.
-
-Lemma Zabs_spec : forall x:Z,
-  0 <= x /\ Zabs x = x \/
-  0 > x /\ Zabs x = -x.
-Proof.
- intros; unfold Zabs, Zle, Zgt; destruct x; simpl; intuition discriminate.
-Qed.
-
-(** * Triangular inequality *)
-
-Hint Local Resolve Zle_neg_pos: zarith.
-
-Theorem Zabs_triangle : forall n m:Z, Zabs (n + m) <= Zabs n + Zabs m.
-Proof.
-  intros z1 z2; case z1; case z2; try (simpl in |- *; auto with zarith; fail).
-  intros p1 p2;
-    apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1));
-      try rewrite Zopp_plus_distr; auto with zarith.
-  apply Zplus_le_compat; simpl in |- *; auto with zarith.
-  apply Zplus_le_compat; simpl in |- *; auto with zarith.
-  intros p1 p2;
-    apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1));
-      try rewrite Zopp_plus_distr; auto with zarith.
-  apply Zplus_le_compat; simpl in |- *; auto with zarith.
-  apply Zplus_le_compat; simpl in |- *; auto with zarith.
-Qed.
-
-(** * Absolute value and multiplication *)
-
-Lemma Zsgn_Zabs : forall n:Z, n * Zsgn n = Zabs n.
-Proof.
-  intro x; destruct x; rewrite Zmult_comm; auto with arith.
-Qed.
-
-Lemma Zabs_Zsgn : forall n:Z, Zabs n * Zsgn n = n.
-Proof.
-  intro x; destruct x; rewrite Zmult_comm; auto with arith.
-Qed.
-
-Theorem Zabs_Zmult : forall n m:Z, Zabs (n * m) = Zabs n * Zabs m.
-Proof.
-  intros z1 z2; case z1; case z2; simpl in |- *; auto.
-Qed.
-
-Theorem Zabs_square : forall a, Zabs a * Zabs a = a * a.
+Lemma Zabs_spec x :
+  0 <= x /\ Z.abs x = x \/
+  0 > x /\ Z.abs x = -x.
 Proof.
-  destruct a; simpl; auto.
-Qed.
-
-(** * Results about absolute value in nat. *)
-
-Theorem inj_Zabs_nat : forall z:Z, Z_of_nat (Zabs_nat z) = Zabs z.
-Proof.
-  destruct z; simpl; auto; symmetry; apply Zpos_eq_Z_of_nat_o_nat_of_P.
-Qed.
-
-Theorem Zabs_nat_Z_of_nat: forall n, Zabs_nat (Z_of_nat n) = n.
-Proof.
-  destruct n; simpl; auto.
-  apply nat_of_P_o_P_of_succ_nat_eq_succ.
-Qed.
-
-Lemma Zabs_nat_mult: forall n m:Z, Zabs_nat (n*m) = (Zabs_nat n * Zabs_nat m)%nat.
-Proof.
-  intros; apply inj_eq_rev.
-  rewrite inj_mult; repeat rewrite inj_Zabs_nat; apply Zabs_Zmult.
-Qed.
-
-Lemma Zabs_nat_Zsucc:
- forall p, 0 <= p ->  Zabs_nat (Zsucc p) = S (Zabs_nat p).
-Proof.
-  intros; apply inj_eq_rev.
-  rewrite inj_S; repeat rewrite inj_Zabs_nat, Zabs_eq; auto with zarith.
-Qed.
-
-Lemma Zabs_nat_Zplus:
- forall x y, 0<=x -> 0<=y -> Zabs_nat (x+y) = (Zabs_nat x + Zabs_nat y)%nat.
-Proof.
-  intros; apply inj_eq_rev.
-  rewrite inj_plus; repeat rewrite inj_Zabs_nat, Zabs_eq; auto with zarith.
-  apply Zplus_le_0_compat; auto.
-Qed.
-
-Lemma Zabs_nat_Zminus:
- forall x y, 0 <= x <= y ->  Zabs_nat (y - x) = (Zabs_nat y - Zabs_nat x)%nat.
-Proof.
-  intros x y (H,H').
-  assert (0 <= y) by (apply Zle_trans with x; auto).
-  assert (0 <= y-x) by (apply Zle_minus_le_0; auto).
-  apply inj_eq_rev.
-  rewrite inj_minus; repeat rewrite inj_Zabs_nat, Zabs_eq; auto.
-  rewrite Zmax_right; auto.
-Qed.
-
-Lemma Zabs_nat_le :
-  forall n m:Z, 0 <= n <= m -> (Zabs_nat n <= Zabs_nat m)%nat.
-Proof.
-  intros n m (H,H'); apply inj_le_rev.
-  repeat rewrite inj_Zabs_nat, Zabs_eq; auto.
-  apply Zle_trans with n; auto.
-Qed.
-
-Lemma Zabs_nat_lt :
-  forall n m:Z, 0 <= n < m -> (Zabs_nat n < Zabs_nat m)%nat.
-Proof.
-  intros n m (H,H'); apply inj_lt_rev.
-  repeat rewrite inj_Zabs_nat, Zabs_eq; auto.
-  apply Zlt_le_weak; apply Zle_lt_trans with n; auto.
+ Z.swap_greater. apply Z.abs_spec.
 Qed.
 
 (** * Some results about the sign function. *)
 
-Lemma Zsgn_Zmult : forall a b, Zsgn (a*b) = Zsgn a * Zsgn b.
-Proof.
-  destruct a; destruct b; simpl; auto.
-Qed.
-
-Lemma Zsgn_Zopp : forall a, Zsgn (-a) = - Zsgn a.
-Proof.
-  destruct a; simpl; auto.
-Qed.
+Notation Zsgn_Zmult := Z.sgn_mul (compat "8.3").
+Notation Zsgn_Zopp := Z.sgn_opp (compat "8.3").
+Notation Zsgn_pos := Z.sgn_pos_iff (compat "8.3").
+Notation Zsgn_neg := Z.sgn_neg_iff (compat "8.3").
+Notation Zsgn_null := Z.sgn_null_iff (compat "8.3").
 
 (** A characterization of the sign function: *)
 
-Lemma Zsgn_spec : forall x:Z,
-  0 < x /\ Zsgn x = 1 \/
-  0 = x /\ Zsgn x = 0 \/
-  0 > x /\ Zsgn x = -1.
+Lemma Zsgn_spec x :
+  0 < x /\ Z.sgn x = 1 \/
+  0 = x /\ Z.sgn x = 0 \/
+  0 > x /\ Z.sgn x = -1.
 Proof.
- intros; unfold Zsgn, Zle, Zgt; destruct x; compute; intuition.
+ intros. Z.swap_greater. apply Z.sgn_spec.
 Qed.
 
-Lemma Zsgn_pos : forall x:Z, Zsgn x = 1 <-> 0 < x.
-Proof.
- destruct x; now intuition.
-Qed.
+(** Compatibility *)
 
-Lemma Zsgn_neg : forall x:Z, Zsgn x = -1 <-> x < 0.
+Notation inj_Zabs_nat := Zabs2Nat.id_abs (compat "8.3").
+Notation Zabs_nat_Z_of_nat := Zabs2Nat.id (compat "8.3").
+Notation Zabs_nat_mult := Zabs2Nat.inj_mul (compat "8.3").
+Notation Zabs_nat_Zsucc := Zabs2Nat.inj_succ (compat "8.3").
+Notation Zabs_nat_Zplus := Zabs2Nat.inj_add (compat "8.3").
+Notation Zabs_nat_Zminus := (fun n m => Zabs2Nat.inj_sub m n) (compat "8.3").
+Notation Zabs_nat_compare := Zabs2Nat.inj_compare (compat "8.3").
+
+Lemma Zabs_nat_le n m : 0 <= n <= m -> (Z.abs_nat n <= Z.abs_nat m)%nat.
 Proof.
- destruct x; now intuition.
+ intros (H,H'). apply Zabs2Nat.inj_le; trivial. now transitivity n.
 Qed.
 
-Lemma Zsgn_null : forall x:Z, Zsgn x = 0 <-> x = 0.
+Lemma Zabs_nat_lt n m : 0 <= n < m -> (Z.abs_nat n < Z.abs_nat m)%nat.
 Proof.
- destruct x; now intuition.
+ intros (H,H'). apply Zabs2Nat.inj_lt; trivial.
+  transitivity n; trivial. now apply Z.lt_le_incl.
 Qed.
-
diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v
index a4eebfb2..f20bc4bb 100644
--- a/theories/ZArith/Zbool.v
+++ b/theories/ZArith/Zbool.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Zbool.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Import BinInt.
 Require Import Zeven.
 Require Import Zorder.
@@ -15,8 +13,7 @@ Require Import Zcompare.
 Require Import ZArith_dec.
 Require Import Sumbool.
 
-Unset Boxed Definitions.
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 (** * Boolean operations from decidability of order *)
 (** The decidability of equality and order relations over
@@ -28,7 +25,7 @@ Definition Z_ge_lt_bool (x y:Z) := bool_of_sumbool (Z_ge_lt_dec x y).
 Definition Z_le_gt_bool (x y:Z) := bool_of_sumbool (Z_le_gt_dec x y).
 Definition Z_gt_le_bool (x y:Z) := bool_of_sumbool (Z_gt_le_dec x y).
 
-Definition Z_eq_bool (x y:Z) := bool_of_sumbool (Z_eq_dec x y).
+Definition Z_eq_bool (x y:Z) := bool_of_sumbool (Z.eq_dec x y).
 Definition Z_noteq_bool (x y:Z) := bool_of_sumbool (Z_noteq_dec x y).
 
 Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x).
@@ -36,29 +33,13 @@ Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x).
 (**********************************************************************)
 (** * Boolean comparisons of binary integers *)
 
-Definition Zle_bool (x y:Z) :=
-  match x ?= y with
-    | Gt => false
-    | _ => true
-  end.
+Notation Zle_bool := Z.leb (compat "8.3").
+Notation Zge_bool := Z.geb (compat "8.3").
+Notation Zlt_bool := Z.ltb (compat "8.3").
+Notation Zgt_bool := Z.gtb (compat "8.3").
 
-Definition Zge_bool (x y:Z) :=
-  match x ?= y with
-    | Lt => false
-    | _ => true
-  end.
-
-Definition Zlt_bool (x y:Z) :=
-  match x ?= y with
-    | Lt => true
-    | _ => false
-  end.
-
-Definition Zgt_bool (x y:Z) :=
-  match x ?= y with
-    | Gt => true
-    | _ => false
-  end.
+(** We now provide a direct [Z.eqb] that doesn't refer to [Z.compare].
+   The old [Zeq_bool] is kept for compatibility. *)
 
 Definition Zeq_bool (x y:Z) :=
   match x ?= y with
@@ -74,162 +55,130 @@ Definition Zneq_bool (x y:Z) :=
 
 (** Properties in term of [if ... then ... else ...] *)
 
-Lemma Zle_cases :
-  forall n m:Z, if Zle_bool n m then (n <= m) else (n > m).
+Lemma Zle_cases n m : if n <=? m then n <= m else n > m.
 Proof.
-  intros x y; unfold Zle_bool, Zle, Zgt in |- *.
-  case (x ?= y); auto; discriminate.
+ case Z.leb_spec; now Z.swap_greater.
 Qed.
 
-Lemma Zlt_cases :
-  forall n m:Z, if Zlt_bool n m then (n < m) else (n >= m).
+Lemma Zlt_cases n m : if n <? m then n < m else n >= m.
 Proof.
-  intros x y; unfold Zlt_bool, Zlt, Zge in |- *.
-  case (x ?= y); auto; discriminate.
+ case Z.ltb_spec; now Z.swap_greater.
 Qed.
 
-Lemma Zge_cases :
-  forall n m:Z, if Zge_bool n m then (n >= m) else (n < m).
+Lemma Zge_cases n m : if n >=? m then n >= m else n < m.
 Proof.
-  intros x y; unfold Zge_bool, Zge, Zlt in |- *.
-  case (x ?= y); auto; discriminate.
+ rewrite Z.geb_leb. case Z.leb_spec; now Z.swap_greater.
 Qed.
 
-Lemma Zgt_cases :
-  forall n m:Z, if Zgt_bool n m then (n > m) else (n <= m).
+Lemma Zgt_cases n m : if n >? m then n > m else n <= m.
 Proof.
-  intros x y; unfold Zgt_bool, Zgt, Zle in |- *.
-  case (x ?= y); auto; discriminate.
+ rewrite Z.gtb_ltb. case Z.ltb_spec; now Z.swap_greater.
 Qed.
 
-(** Lemmas on [Zle_bool] used in contrib/graphs *)
+(** Lemmas on [Z.leb] used in contrib/graphs *)
 
-Lemma Zle_bool_imp_le : forall n m:Z, Zle_bool n m = true -> (n <= m).
+Lemma Zle_bool_imp_le n m : (n <=? m) = true -> (n <= m).
 Proof.
-  unfold Zle_bool, Zle in |- *. intros x y. unfold not in |- *.
-  case (x ?= y); intros; discriminate.
+ apply Z.leb_le.
 Qed.
 
-Lemma Zle_imp_le_bool : forall n m:Z, (n <= m) -> Zle_bool n m = true.
+Lemma Zle_imp_le_bool n m : (n <= m) -> (n <=? m) = true.
 Proof.
-  unfold Zle, Zle_bool in |- *. intros x y. case (x ?= y); trivial. intro. elim (H (refl_equal _)).
+ apply Z.leb_le.
 Qed.
 
-Lemma Zle_bool_refl : forall n:Z, Zle_bool n n = true.
-Proof.
-  intro. apply Zle_imp_le_bool. apply Zeq_le. reflexivity.
-Qed.
+Notation Zle_bool_refl := Z.leb_refl (compat "8.3").
 
-Lemma Zle_bool_antisym :
-  forall n m:Z, Zle_bool n m = true -> Zle_bool m n = true -> n = m.
+Lemma Zle_bool_antisym n m :
+ (n <=? m) = true -> (m <=? n) = true -> n = m.
 Proof.
-  intros. apply Zle_antisym. apply Zle_bool_imp_le. assumption.
-  apply Zle_bool_imp_le. assumption.
+ rewrite !Z.leb_le. apply Z.le_antisymm.
 Qed.
 
-Lemma Zle_bool_trans :
-  forall n m p:Z,
-    Zle_bool n m = true -> Zle_bool m p = true -> Zle_bool n p = true.
+Lemma Zle_bool_trans n m p :
+ (n <=? m) = true -> (m <=? p) = true -> (n <=? p) = true.
 Proof.
-  intros x y z; intros. apply Zle_imp_le_bool. apply Zle_trans with (m := y). apply Zle_bool_imp_le. assumption.
-  apply Zle_bool_imp_le. assumption.
+ rewrite !Z.leb_le. apply Z.le_trans.
 Qed.
 
-Definition Zle_bool_total :
-  forall x y:Z, {Zle_bool x y = true} + {Zle_bool y x = true}.
+Definition Zle_bool_total x y :
+  { x <=? y = true } + { y <=? x = true }.
 Proof.
-  intros x y; intros. unfold Zle_bool in |- *. cut ((x ?= y) = Gt <-> (y ?= x) = Lt).
-  case (x ?= y). left. reflexivity.
-  left. reflexivity.
-  right. rewrite (proj1 H (refl_equal _)). reflexivity.
-  apply Zcompare_Gt_Lt_antisym.
+ case_eq (x <=? y); intros H.
+ - left; trivial.
+ - right. apply Z.leb_gt in H. now apply Z.leb_le, Z.lt_le_incl.
 Defined.
 
-Lemma Zle_bool_plus_mono :
-  forall n m p q:Z,
-    Zle_bool n m = true ->
-    Zle_bool p q = true -> Zle_bool (n + p) (m + q) = true.
+Lemma Zle_bool_plus_mono n m p q :
+ (n <=? m) = true ->
+ (p <=? q) = true ->
+ (n + p <=? m + q) = true.
 Proof.
-  intros. apply Zle_imp_le_bool. apply Zplus_le_compat. apply Zle_bool_imp_le. assumption.
-  apply Zle_bool_imp_le. assumption.
+ rewrite !Z.leb_le. apply Z.add_le_mono.
 Qed.
 
-Lemma Zone_pos : Zle_bool 1 0 = false.
+Lemma Zone_pos : 1 <=? 0 = false.
 Proof.
-  reflexivity.
+ reflexivity.
 Qed.
 
-Lemma Zone_min_pos : forall n:Z, Zle_bool n 0 = false -> Zle_bool 1 n = true.
+Lemma Zone_min_pos n : (n <=? 0) = false -> (1 <=? n) = true.
 Proof.
-  intros x; intros. apply Zle_imp_le_bool. change (Zsucc 0 <= x) in |- *. apply Zgt_le_succ. generalize H.
-  unfold Zle_bool, Zgt in |- *. case (x ?= 0). intro H0. discriminate H0.
-  intro H0. discriminate H0.
-  reflexivity.
+ rewrite Z.leb_le, Z.leb_gt. apply Z.le_succ_l.
 Qed.
 
 (** Properties in term of [iff] *)
 
-Lemma Zle_is_le_bool : forall n m:Z, (n <= m) <-> Zle_bool n m = true.
+Lemma Zle_is_le_bool n m : (n <= m) <-> (n <=? m) = true.
 Proof.
-  intros. split. intro. apply Zle_imp_le_bool. assumption.
-  intro. apply Zle_bool_imp_le. assumption.
+ symmetry. apply Z.leb_le.
 Qed.
 
-Lemma Zge_is_le_bool : forall n m:Z, (n >= m) <-> Zle_bool m n = true.
+Lemma Zge_is_le_bool n m : (n >= m) <-> (m <=? n) = true.
 Proof.
-  intros. split. intro. apply Zle_imp_le_bool. apply Zge_le. assumption.
-  intro. apply Zle_ge. apply Zle_bool_imp_le. assumption.
+ Z.swap_greater. symmetry. apply Z.leb_le.
 Qed.
 
-Lemma Zlt_is_lt_bool : forall n m:Z, (n < m) <-> Zlt_bool n m = true.
+Lemma Zlt_is_lt_bool n m : (n < m) <-> (n <? m) = true.
 Proof.
-intros n m; unfold Zlt_bool, Zlt.
-destruct (n ?= m); simpl; split; now intro.
+ symmetry. apply Z.ltb_lt.
 Qed.
 
-Lemma Zgt_is_gt_bool : forall n m:Z, (n > m) <-> Zgt_bool n m = true.
+Lemma Zgt_is_gt_bool n m : (n > m) <-> (n >? m) = true.
 Proof.
-intros n m; unfold Zgt_bool, Zgt.
-destruct (n ?= m); simpl; split; now intro.
+ Z.swap_greater. rewrite Z.gtb_ltb. symmetry. apply Z.ltb_lt.
 Qed.
 
-Lemma Zlt_is_le_bool :
-  forall n m:Z, (n < m) <-> Zle_bool n (m - 1) = true.
+Lemma Zlt_is_le_bool n m : (n < m) <-> (n <=? m - 1) = true.
 Proof.
-  intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H.
-  assumption.
-  intro. rewrite (Zsucc_pred y). apply Zle_lt_succ. apply Zle_bool_imp_le. assumption.
+ rewrite Z.leb_le. apply Z.lt_le_pred.
 Qed.
 
-Lemma Zgt_is_le_bool :
-  forall n m:Z, (n > m) <-> Zle_bool m (n - 1) = true.
+Lemma Zgt_is_le_bool n m : (n > m) <-> (m <=? n - 1) = true.
 Proof.
-  intros x y. apply iff_trans with (y < x). split. exact (Zgt_lt x y).
-  exact (Zlt_gt y x).
-  exact (Zlt_is_le_bool y x).
+ Z.swap_greater. rewrite Z.leb_le. apply Z.lt_le_pred.
 Qed.
 
-Lemma Zeq_is_eq_bool : forall x y, x = y <-> Zeq_bool x y = true.
+(** Properties of the deprecated [Zeq_bool] *)
+
+Lemma Zeq_is_eq_bool x y : x = y <-> Zeq_bool x y = true.
 Proof.
-  intros; unfold Zeq_bool.
-  generalize (Zcompare_Eq_iff_eq x y); destruct Zcompare; intuition;
-   try discriminate.
+ unfold Zeq_bool.
+ rewrite <- Z.compare_eq_iff. destruct Z.compare; now split.
 Qed.
 
-Lemma Zeq_bool_eq : forall x y, Zeq_bool x y = true -> x = y.
+Lemma Zeq_bool_eq x y : Zeq_bool x y = true -> x = y.
 Proof.
-  intros x y H; apply <- Zeq_is_eq_bool; auto.
+ apply Zeq_is_eq_bool.
 Qed.
 
-Lemma Zeq_bool_neq : forall x y, Zeq_bool x y = false -> x <> y.
+Lemma Zeq_bool_neq x y : Zeq_bool x y = false -> x <> y.
 Proof.
-  unfold Zeq_bool; red ; intros; subst.
-  rewrite Zcompare_refl in H.
-  discriminate.
+ rewrite Zeq_is_eq_bool; now destruct Zeq_bool.
 Qed.
 
-Lemma Zeq_bool_if : forall x y, if Zeq_bool x y then x=y else x<>y.
+Lemma Zeq_bool_if x y : if Zeq_bool x y then x=y else x<>y.
 Proof.
-  intros. generalize (Zeq_bool_eq x y)(Zeq_bool_neq x y).
-  destruct Zeq_bool; auto.
-Qed.
\ No newline at end of file
+ generalize (Zeq_bool_eq x y) (Zeq_bool_neq x y).
+ destruct Zeq_bool; auto.
+Qed.
diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v
index ae5302ee..fe91698f 100644
--- a/theories/ZArith/Zcompare.v
+++ b/theories/ZArith/Zcompare.v
@@ -1,387 +1,91 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $$ i*)
+(** Binary Integers : results about Z.compare *)
+(** Initial author: Pierre Crégut (CNET, Lannion, France *)
 
-(**********************************************************************)
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France)            *)
-(**********************************************************************)
+(** THIS FILE IS DEPRECATED.
+    It is now almost entirely made of compatibility formulations
+    for results already present in BinInt.Z. *)
 
-Require Export BinPos.
-Require Export BinInt.
-Require Import Lt.
-Require Import Gt.
-Require Import Plus.
-Require Import Mult.
+Require Export BinPos BinInt.
+Require Import Lt Gt Plus Mult. (* Useless now, for compatibility only *)
 
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 (***************************)
 (** * Comparison on integers *)
 
-Lemma Zcompare_refl : forall n:Z, (n ?= n) = Eq.
-Proof.
-  intro x; destruct x as [| p| p]; simpl in |- *;
-    [ reflexivity | apply Pcompare_refl | rewrite Pcompare_refl; reflexivity ].
-Qed.
-
-Lemma Zcompare_Eq_eq : forall n m:Z, (n ?= m) = Eq -> n = m.
-Proof.
-  intros x y; destruct x as [| x'| x']; destruct y as [| y'| y']; simpl in |- *;
-    intro H; reflexivity || (try discriminate H);
-      [ rewrite (Pcompare_Eq_eq x' y' H); reflexivity
-	| rewrite (Pcompare_Eq_eq x' y');
-	  [ reflexivity
-	    | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ].
-Qed.
-
-Ltac destr_zcompare :=
- match goal with |- context [Zcompare ?x ?y] =>
-  let H := fresh "H" in
-  case_eq (Zcompare x y); intro H;
-   [generalize (Zcompare_Eq_eq _ _ H); clear H; intro H |
-    change (x<y)%Z in H |
-    change (x>y)%Z in H ]
- end.
-
-Lemma Zcompare_Eq_iff_eq : forall n m:Z, (n ?= m) = Eq <-> n = m.
-Proof.
-  intros x y; split; intro E;
-    [ apply Zcompare_Eq_eq; assumption | rewrite E; apply Zcompare_refl ].
-Qed.
-
-Lemma Zcompare_antisym : forall n m:Z, CompOpp (n ?= m) = (m ?= n).
-Proof.
-  intros x y; destruct x; destruct y; simpl in |- *;
-    reflexivity || discriminate H || rewrite Pcompare_antisym;
-      reflexivity.
-Qed.
-
 Lemma Zcompare_Gt_Lt_antisym : forall n m:Z, (n ?= m) = Gt <-> (m ?= n) = Lt.
-Proof.
-  intros x y.
-  rewrite <- Zcompare_antisym. change Gt with (CompOpp Lt).
-  split.
-  auto using CompOpp_inj.
-  intros; f_equal; auto.
-Qed.
-
-Lemma Zcompare_spec : forall n m, CompSpec eq Zlt n m (n ?= m).
-Proof.
-  intros.
-  destruct (n?=m) as [ ]_eqn:H; constructor; auto.
-  apply Zcompare_Eq_eq; auto.
-  red; rewrite <- Zcompare_antisym, H; auto.
-Qed.
+Proof Z.gt_lt_iff.
 
+Lemma Zcompare_antisym n m : CompOpp (n ?= m) = (m ?= n).
+Proof eq_sym (Z.compare_antisym n m).
 
 (** * Transitivity of comparison *)
 
 Lemma Zcompare_Lt_trans :
   forall n m p:Z, (n ?= m) = Lt -> (m ?= p) = Lt -> (n ?= p) = Lt.
-Proof.
-  intros x y z; case x; case y; case z; simpl;
-    try discriminate; auto with arith.
-  intros; eapply Plt_trans; eauto.
-  intros p q r; rewrite 3 Pcompare_antisym; simpl.
-  intros; eapply Plt_trans; eauto.
-Qed.
+Proof Z.lt_trans.
 
 Lemma Zcompare_Gt_trans :
   forall n m p:Z, (n ?= m) = Gt -> (m ?= p) = Gt -> (n ?= p) = Gt.
 Proof.
-  intros n m p Hnm Hmp.
-  apply <- Zcompare_Gt_Lt_antisym.
-  apply -> Zcompare_Gt_Lt_antisym in Hnm.
-  apply -> Zcompare_Gt_Lt_antisym in Hmp.
-  eapply Zcompare_Lt_trans; eauto.
+ intros n m p. change (n > m -> m > p -> n > p).
+ Z.swap_greater. intros. now transitivity m.
 Qed.
 
 (** * Comparison and opposite *)
 
-Lemma Zcompare_opp : forall n m:Z, (n ?= m) = (- m ?= - n).
+Lemma Zcompare_opp n m : (n ?= m) = (- m ?= - n).
 Proof.
-  intros x y; case x; case y; simpl in |- *; auto with arith; intros;
-    rewrite <- ZC4; trivial with arith.
+ symmetry. apply Z.compare_opp.
 Qed.
 
-Hint Local Resolve Pcompare_refl.
-
 (** * Comparison first-order specification *)
 
-Lemma Zcompare_Gt_spec :
-  forall n m:Z, (n ?= m) = Gt ->  exists h : positive, n + - m = Zpos h.
+Lemma Zcompare_Gt_spec n m : (n ?= m) = Gt ->  exists h, n + - m = Zpos h.
 Proof.
-  intros x y; case x; case y;
-    [ simpl in |- *; intros H; discriminate H
-      | simpl in |- *; intros p H; discriminate H
-      | intros p H; exists p; simpl in |- *; auto with arith
-      | intros p H; exists p; simpl in |- *; auto with arith
-      | intros q p H; exists (p - q)%positive; unfold Zplus, Zopp in |- *;
-	unfold Zcompare in H; rewrite H; trivial with arith
-      | intros q p H; exists (p + q)%positive; simpl in |- *; trivial with arith
-      | simpl in |- *; intros p H; discriminate H
-      | simpl in |- *; intros q p H; discriminate H
-      | unfold Zcompare in |- *; intros q p; rewrite <- ZC4; intros H;
-	exists (q - p)%positive; simpl in |- *; rewrite (ZC1 q p H);
-	  trivial with arith ].
+ rewrite Z.compare_sub. unfold Z.sub.
+ destruct (n+-m) as [|p|p]; try discriminate. now exists p.
 Qed.
 
 (** * Comparison and addition *)
 
-Lemma weaken_Zcompare_Zplus_compatible :
-  (forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m)) ->
-  forall n m p:Z, (p + n ?= p + m) = (n ?= m).
+Lemma Zcompare_plus_compat n m p : (p + n ?= p + m) = (n ?= m).
 Proof.
-  intros H x y z; destruct z;
-    [ reflexivity
-      | apply H
-      | rewrite (Zcompare_opp x y); rewrite Zcompare_opp;
-	do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg;
-	  apply H ].
+ apply Z.add_compare_mono_l.
 Qed.
 
-Hint Local Resolve ZC4.
-
-Lemma weak_Zcompare_Zplus_compatible :
-  forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m).
-Proof.
-  intros x y z; case x; case y; simpl in |- *; auto with arith;
-    [ intros p; apply nat_of_P_lt_Lt_compare_complement_morphism; apply ZL17
-      | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
-	apply nat_of_P_gt_Gt_compare_complement_morphism;
-	  rewrite nat_of_P_minus_morphism;
-	    [ unfold gt in |- *; apply ZL16 | assumption ]
-      | intros p; ElimPcompare z p; intros E; auto with arith;
-	apply nat_of_P_gt_Gt_compare_complement_morphism;
-	  unfold gt in |- *; apply ZL17
-      | intros p q; ElimPcompare q p; intros E; rewrite E;
-	[ rewrite (Pcompare_Eq_eq q p E); apply Pcompare_refl
-	  | apply nat_of_P_lt_Lt_compare_complement_morphism;
-	    do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
-	      apply nat_of_P_lt_Lt_compare_morphism with (1 := E)
-	  | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *;
-	    do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
-	      exact (nat_of_P_gt_Gt_compare_morphism q p E) ]
-      | intros p q; ElimPcompare z p; intros E; rewrite E; auto with arith;
-	apply nat_of_P_gt_Gt_compare_complement_morphism;
-	  rewrite nat_of_P_minus_morphism;
-	    [ unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
-	      [ apply ZL16 | apply ZL17 ]
-	      | assumption ]
-      | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
-	simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
-	  rewrite nat_of_P_minus_morphism; [ apply ZL16 | assumption ]
-      | intros p q; ElimPcompare z q; intros E; rewrite E; auto with arith;
-	simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
-	  rewrite nat_of_P_minus_morphism;
-	    [ apply lt_trans with (m := nat_of_P z); [ apply ZL16 | apply ZL17 ]
-	      | assumption ]
-      | intros p q; ElimPcompare z q; intros E0; rewrite E0; ElimPcompare z p;
-	intros E1; rewrite E1; ElimPcompare q p; intros E2;
-	  rewrite E2; auto with arith;
-	    [ absurd ((q ?= p)%positive Eq = Lt);
-	      [ rewrite <- (Pcompare_Eq_eq z q E0);
-		rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
-		  discriminate
-		| assumption ]
-	      | absurd ((q ?= p)%positive Eq = Gt);
-		[ rewrite <- (Pcompare_Eq_eq z q E0);
-		  rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
-		    discriminate
-		  | assumption ]
-	      | absurd ((z ?= p)%positive Eq = Lt);
-		[ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
-		  rewrite (Pcompare_refl q); discriminate
-		  | assumption ]
-	      | absurd ((z ?= p)%positive Eq = Lt);
-		[ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
-		  | assumption ]
-	      | absurd ((z ?= p)%positive Eq = Gt);
-		[ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
-		  rewrite (Pcompare_refl q); discriminate
-		  | assumption ]
-	      | absurd ((z ?= p)%positive Eq = Gt);
-		[ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
-		  | assumption ]
-	      | absurd ((z ?= q)%positive Eq = Lt);
-		[ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
-		  rewrite (Pcompare_refl p); discriminate
-		  | assumption ]
-	      | absurd ((p ?= q)%positive Eq = Gt);
-		[ rewrite <- (Pcompare_Eq_eq z p E1); rewrite E0; discriminate
-		  | apply ZC2; assumption ]
-	      | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2);
-		rewrite (Pcompare_refl (p - z)); auto with arith
-	      | simpl in |- *; rewrite <- ZC4;
-		apply nat_of_P_gt_Gt_compare_complement_morphism;
-		  rewrite nat_of_P_minus_morphism;
-		    [ rewrite nat_of_P_minus_morphism;
-		      [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z);
-			rewrite le_plus_minus_r;
-			  [ rewrite le_plus_minus_r;
-			    [ apply nat_of_P_lt_Lt_compare_morphism; assumption
-			      | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-				assumption ]
-			    | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-			      assumption ]
-			| apply ZC2; assumption ]
-		      | apply ZC2; assumption ]
-	      | simpl in |- *; rewrite <- ZC4;
-		apply nat_of_P_lt_Lt_compare_complement_morphism;
-		  rewrite nat_of_P_minus_morphism;
-		    [ rewrite nat_of_P_minus_morphism;
-		      [ apply plus_lt_reg_l with (p := nat_of_P z);
-			rewrite le_plus_minus_r;
-			  [ rewrite le_plus_minus_r;
-			    [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
-			      assumption
-			      | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-				assumption ]
-			    | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-			      assumption ]
-			| apply ZC2; assumption ]
-		      | apply ZC2; assumption ]
-	      | absurd ((z ?= q)%positive Eq = Lt);
-		[ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
-		  | assumption ]
-	      | absurd ((q ?= p)%positive Eq = Lt);
-		[ cut ((q ?= p)%positive Eq = Gt);
-		  [ intros E; rewrite E; discriminate
-		    | apply nat_of_P_gt_Gt_compare_complement_morphism;
-		      unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
-			[ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
-			  | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
-		  | assumption ]
-	      | absurd ((z ?= q)%positive Eq = Gt);
-		[ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
-		  rewrite (Pcompare_refl p); discriminate
-		  | assumption ]
-	      | absurd ((z ?= q)%positive Eq = Gt);
-		[ rewrite (Pcompare_Eq_eq z p E1); rewrite ZC1;
-		  [ discriminate | assumption ]
-		  | assumption ]
-	      | absurd ((z ?= q)%positive Eq = Gt);
-		[ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
-		  | assumption ]
-	      | absurd ((q ?= p)%positive Eq = Gt);
-		[ rewrite ZC1;
-		  [ discriminate
-		    | apply nat_of_P_gt_Gt_compare_complement_morphism;
-		      unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
-			[ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
-			  | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
-		  | assumption ]
-	      | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); apply Pcompare_refl
-	      | simpl in |- *; apply nat_of_P_gt_Gt_compare_complement_morphism;
-		unfold gt in |- *; rewrite nat_of_P_minus_morphism;
-		  [ rewrite nat_of_P_minus_morphism;
-		    [ apply plus_lt_reg_l with (p := nat_of_P p);
-		      rewrite le_plus_minus_r;
-			[ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P q);
-			  rewrite plus_assoc; rewrite le_plus_minus_r;
-			    [ rewrite (plus_comm (nat_of_P q)); apply plus_lt_compat_l;
-			      apply nat_of_P_lt_Lt_compare_morphism;
-				assumption
-			      | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-				apply ZC1; assumption ]
-			  | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-			    apply ZC1; assumption ]
-		      | assumption ]
-		    | assumption ]
-	      | simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
-		rewrite nat_of_P_minus_morphism;
-		  [ rewrite nat_of_P_minus_morphism;
-		    [ apply plus_lt_reg_l with (p := nat_of_P q);
-		      rewrite le_plus_minus_r;
-			[ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p);
-			  rewrite plus_assoc; rewrite le_plus_minus_r;
-			    [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l;
-			      apply nat_of_P_lt_Lt_compare_morphism;
-				apply ZC1; assumption
-			      | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-				apply ZC1; assumption ]
-			  | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-			    apply ZC1; assumption ]
-		      | assumption ]
-		    | assumption ] ] ].
-Qed.
-
-Lemma Zcompare_plus_compat : forall n m p:Z, (p + n ?= p + m) = (n ?= m).
+Lemma Zplus_compare_compat (r:comparison) (n m p q:Z) :
+  (n ?= m) = r -> (p ?= q) = r -> (n + p ?= m + q) = r.
 Proof.
-  exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible).
+ rewrite (Z.compare_sub n), (Z.compare_sub p), (Z.compare_sub (n+p)).
+ unfold Z.sub. rewrite Z.opp_add_distr. rewrite Z.add_shuffle1.
+ destruct (n+-m), (p+-q); simpl; intros; now subst.
 Qed.
 
-Lemma Zplus_compare_compat :
-  forall (r:comparison) (n m p q:Z),
-    (n ?= m) = r -> (p ?= q) = r -> (n + p ?= m + q) = r.
+Lemma Zcompare_succ_Gt n : (Z.succ n ?= n) = Gt.
 Proof.
-  intros r x y z t; case r;
-    [ intros H1 H2; elim (Zcompare_Eq_iff_eq x y); elim (Zcompare_Eq_iff_eq z t);
-      intros H3 H4 H5 H6; rewrite H3;
-	[ rewrite H5;
-	  [ elim (Zcompare_Eq_iff_eq (y + t) (y + t)); auto with arith
-	    | auto with arith ]
-	  | auto with arith ]
-      | intros H1 H2; elim (Zcompare_Gt_Lt_antisym (y + t) (x + z)); intros H3 H4;
-	apply H3; apply Zcompare_Gt_trans with (m := y + z);
-	  [ rewrite Zcompare_plus_compat; elim (Zcompare_Gt_Lt_antisym t z);
-	    auto with arith
-	    | do 2 rewrite <- (Zplus_comm z); rewrite Zcompare_plus_compat;
-	      elim (Zcompare_Gt_Lt_antisym y x); auto with arith ]
-      | intros H1 H2; apply Zcompare_Gt_trans with (m := x + t);
-	[ rewrite Zcompare_plus_compat; assumption
-	  | do 2 rewrite <- (Zplus_comm t); rewrite Zcompare_plus_compat;
-	    assumption ] ].
+ apply Z.lt_gt. apply Z.lt_succ_diag_r.
 Qed.
 
-Lemma Zcompare_succ_Gt : forall n:Z, (Zsucc n ?= n) = Gt.
+Lemma Zcompare_Gt_not_Lt n m : (n ?= m) = Gt <-> (n ?= m+1) <> Lt.
 Proof.
-  intro x; unfold Zsucc in |- *; pattern x at 2 in |- *;
-    rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat;
-      reflexivity.
-Qed.
-
-Lemma Zcompare_Gt_not_Lt : forall n m:Z, (n ?= m) = Gt <-> (n ?= m + 1) <> Lt.
-Proof.
-  intros x y; split;
-    [ intro H; elim_compare x (y + 1);
-      [ intro H1; rewrite H1; discriminate
-	| intros H1; elim Zcompare_Gt_spec with (1 := H); intros h H2;
-	  absurd ((nat_of_P h > 0)%nat /\ (nat_of_P h < 1)%nat);
-	    [ unfold not in |- *; intros H3; elim H3; intros H4 H5;
-              absurd (nat_of_P h > 0)%nat;
-		[ unfold gt in |- *; apply le_not_lt; apply le_S_n; exact H5
-		  | assumption ]
-	      | split;
-		[ elim (ZL4 h); intros i H3; rewrite H3; apply gt_Sn_O
-		  | change (nat_of_P h < nat_of_P 1)%nat in |- *;
-		    apply nat_of_P_lt_Lt_compare_morphism;
-		      change ((Zpos h ?= 1) = Lt) in |- *; rewrite <- H2;
-			rewrite <- (fun m n:Z => Zcompare_plus_compat m n y);
-			  rewrite (Zplus_comm x); rewrite Zplus_assoc;
-			    rewrite Zplus_opp_r; simpl in |- *; exact H1 ] ]
-	| intros H1; rewrite H1; discriminate ]
-      | intros H; elim_compare x (y + 1);
-	[ intros H1; elim (Zcompare_Eq_iff_eq x (y + 1)); intros H2 H3;
-	  rewrite (H2 H1); exact (Zcompare_succ_Gt y)
-	  | intros H1; absurd ((x ?= y + 1) = Lt); assumption
-	  | intros H1; apply Zcompare_Gt_trans with (m := Zsucc y);
-	    [ exact H1 | exact (Zcompare_succ_Gt y) ] ] ].
+ change (n > m <-> n >= m+1). Z.swap_greater. symmetry. apply Z.le_succ_l.
 Qed.
 
 (** * Successor and comparison *)
 
-Lemma Zcompare_succ_compat : forall n m:Z, (Zsucc n ?= Zsucc m) = (n ?= m).
+Lemma Zcompare_succ_compat n m : (Z.succ n ?= Z.succ m) = (n ?= m).
 Proof.
-  intros n m; unfold Zsucc in |- *; do 2 rewrite (fun t:Z => Zplus_comm t 1);
-    rewrite Zcompare_plus_compat; auto with arith.
+ rewrite <- 2 Z.add_1_l. apply Z.add_compare_mono_l.
 Qed.
 
 (** * Multiplication and comparison *)
@@ -389,28 +93,24 @@ Qed.
 Lemma Zcompare_mult_compat :
   forall (p:positive) (n m:Z), (Zpos p * n ?= Zpos p * m) = (n ?= m).
 Proof.
-  intros x; induction x as [p H| p H| ];
-    [ intros y z; cut (Zpos (xI p) = Zpos p + Zpos p + 1);
-      [ intros E; rewrite E; do 4 rewrite Zmult_plus_distr_l;
-	do 2 rewrite Zmult_1_l; apply Zplus_compare_compat;
-	  [ apply Zplus_compare_compat; apply H | trivial with arith ]
-	| simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
-      | intros y z; cut (Zpos (xO p) = Zpos p + Zpos p);
-	[ intros E; rewrite E; do 2 rewrite Zmult_plus_distr_l;
-	  apply Zplus_compare_compat; apply H
-	  | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
-      | intros y z; do 2 rewrite Zmult_1_l; trivial with arith ].
+ intros p [|n|n] [|m|m]; simpl; trivial; now rewrite Pos.mul_compare_mono_l.
 Qed.
 
+Lemma Zmult_compare_compat_l n m p:
+  p > 0 -> (n ?= m) = (p * n ?= p * m).
+Proof.
+ intros; destruct p; try discriminate.
+ symmetry. apply Zcompare_mult_compat.
+Qed.
 
-(** * Reverting [x ?= y] to trichotomy *)
-
-Lemma rename :
-  forall (A:Type) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x.
+Lemma Zmult_compare_compat_r n m p :
+  p > 0 -> (n ?= m) = (n * p ?= m * p).
 Proof.
-  auto with arith.
+ intros; rewrite 2 (Z.mul_comm _ p); now apply Zmult_compare_compat_l.
 Qed.
 
+(** * Relating [x ?= y] to [=], [<=], [<], [>=] or [>] *)
+
 Lemma Zcompare_elim :
   forall (c1 c2 c3:Prop) (n m:Z),
     (n = m -> c1) ->
@@ -421,11 +121,7 @@ Lemma Zcompare_elim :
                        | Gt => c3
                      end.
 Proof.
-  intros c1 c2 c3 x y; intros.
-  apply rename with (x := x ?= y); intro r; elim r;
-    [ intro; apply H; apply (Zcompare_Eq_eq x y); assumption
-      | unfold Zlt in H0; assumption
-      | unfold Zgt in H1; assumption ].
+ intros. case Z.compare_spec; trivial. now Z.swap_greater.
 Qed.
 
 Lemma Zcompare_eq_case :
@@ -436,26 +132,9 @@ Lemma Zcompare_eq_case :
                      | Gt => c3
                    end.
 Proof.
-  intros c1 c2 c3 x y; intros.
-  rewrite H0; rewrite Zcompare_refl.
-  assumption.
+ intros. subst. now rewrite Z.compare_refl.
 Qed.
 
-(** * Decompose an egality between two [?=] relations into 3 implications *)
-
-Lemma Zcompare_egal_dec :
-  forall n m p q:Z,
-    (n < m -> p < q) ->
-    ((n ?= m) = Eq -> (p ?= q) = Eq) ->
-    (n > m -> p > q) -> (n ?= m) = (p ?= q).
-Proof.
-  intros x1 y1 x2 y2.
-  unfold Zgt in |- *; unfold Zlt in |- *; case (x1 ?= y1); case (x2 ?= y2);
-    auto with arith; symmetry  in |- *; auto with arith.
-Qed.
-
-(** * Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *)
-
 Lemma Zle_compare :
   forall n m:Z,
     n <= m -> match n ?= m with
@@ -464,7 +143,7 @@ Lemma Zle_compare :
 		| Gt => False
               end.
 Proof.
-  intros x y; unfold Zle in |- *; elim (x ?= y); auto with arith.
+  intros. case Z.compare_spec; trivial; Z.order.
 Qed.
 
 Lemma Zlt_compare :
@@ -475,8 +154,7 @@ Lemma Zlt_compare :
               | Gt => False
             end.
 Proof.
-  intros x y; unfold Zlt in |- *; elim (x ?= y); intros;
-    discriminate || trivial with arith.
+  intros x y H; now rewrite H.
 Qed.
 
 Lemma Zge_compare :
@@ -487,7 +165,7 @@ Lemma Zge_compare :
 		| Gt => True
               end.
 Proof.
-  intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith.
+  intros. now case Z.compare_spec.
 Qed.
 
 Lemma Zgt_compare :
@@ -498,26 +176,23 @@ Lemma Zgt_compare :
                | Gt => True
              end.
 Proof.
-  intros x y; unfold Zgt in |- *; elim (x ?= y); intros;
-    discriminate || trivial with arith.
+  intros x y H; now rewrite H.
 Qed.
 
-(*********************)
-(** * Other properties *)
+(** Compatibility notations *)
 
-Lemma Zmult_compare_compat_l :
-  forall n m p:Z, p > 0 -> (n ?= m) = (p * n ?= p * m).
-Proof.
-  intros x y z H; destruct z.
-  discriminate H.
-  rewrite Zcompare_mult_compat; reflexivity.
-  discriminate H.
-Qed.
-
-Lemma Zmult_compare_compat_r :
-  forall n m p:Z, p > 0 -> (n ?= m) = (n * p ?= m * p).
-Proof.
-  intros x y z H; rewrite (Zmult_comm x z); rewrite (Zmult_comm y z);
-    apply Zmult_compare_compat_l; assumption.
-Qed.
+Notation Zcompare_refl := Z.compare_refl (compat "8.3").
+Notation Zcompare_Eq_eq := Z.compare_eq (compat "8.3").
+Notation Zcompare_Eq_iff_eq := Z.compare_eq_iff (compat "8.3").
+Notation Zcompare_spec := Z.compare_spec (compat "8.3").
+Notation Zmin_l := Z.min_l (compat "8.3").
+Notation Zmin_r := Z.min_r (compat "8.3").
+Notation Zmax_l := Z.max_l (compat "8.3").
+Notation Zmax_r := Z.max_r (compat "8.3").
+Notation Zabs_eq := Z.abs_eq (compat "8.3").
+Notation Zabs_non_eq := Z.abs_neq (compat "8.3").
+Notation Zsgn_0 := Z.sgn_null (compat "8.3").
+Notation Zsgn_1 := Z.sgn_pos (compat "8.3").
+Notation Zsgn_m1 := Z.sgn_neg (compat "8.3").
 
+(** Not kept: Zcompare_egal_dec *)
diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v
index ca72f8a8..b4163ef9 100644
--- a/theories/ZArith/Zcomplements.v
+++ b/theories/ZArith/Zcomplements.v
@@ -1,46 +1,22 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zcomplements.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import ZArithRing.
 Require Import ZArith_base.
 Require Export Omega.
 Require Import Wf_nat.
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 
 (**********************************************************************)
 (** About parity *)
 
-Lemma two_or_two_plus_one :
-  forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}.
-Proof.
-  intro x; destruct x.
-  left; split with 0; reflexivity.
-
-  destruct p.
-  right; split with (Zpos p); reflexivity.
-
-  left; split with (Zpos p); reflexivity.
-
-  right; split with 0; reflexivity.
-
-  destruct p.
-  right; split with (Zneg (1 + p)).
-  rewrite BinInt.Zneg_xI.
-  rewrite BinInt.Zneg_plus_distr.
-  omega.
-
-  left; split with (Zneg p); reflexivity.
-
-  right; split with (-1); reflexivity.
-Qed.
+Notation two_or_two_plus_one := Z_modulo_2 (only parsing).
 
 (**********************************************************************)
 (** The biggest power of 2 that is stricly less than [a]
@@ -58,31 +34,14 @@ Fixpoint floor_pos (a:positive) : positive :=
 Definition floor (a:positive) := Zpos (floor_pos a).
 
 Lemma floor_gt0 : forall p:positive, floor p > 0.
-Proof.
-  intro.
-  compute in |- *.
-  trivial.
-Qed.
+Proof. reflexivity. Qed.
 
 Lemma floor_ok : forall p:positive, floor p <= Zpos p < 2 * floor p.
 Proof.
-  unfold floor in |- *.
-  intro a; induction a as [p| p| ].
-
-  simpl in |- *.
-  repeat rewrite BinInt.Zpos_xI.
-  rewrite (BinInt.Zpos_xO (xO (floor_pos p))).
-  rewrite (BinInt.Zpos_xO (floor_pos p)).
-  omega.
-
-  simpl in |- *.
-  repeat rewrite BinInt.Zpos_xI.
-  rewrite (BinInt.Zpos_xO (xO (floor_pos p))).
-  rewrite (BinInt.Zpos_xO (floor_pos p)).
-  rewrite (BinInt.Zpos_xO p).
-  omega.
-
-  simpl in |- *; omega.
+ unfold floor. induction p; simpl.
+ - rewrite !Pos2Z.inj_xI, (Pos2Z.inj_xO (xO _)), Pos2Z.inj_xO. omega.
+ - rewrite (Pos2Z.inj_xO (xO _)), (Pos2Z.inj_xO p), Pos2Z.inj_xO. omega.
+ - omega.
 Qed.
 
 (**********************************************************************)
@@ -90,41 +49,39 @@ Qed.
 
 Theorem Z_lt_abs_rec :
   forall P:Z -> Set,
-    (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) ->
+    (forall n:Z, (forall m:Z, Z.abs m < Z.abs n -> P m) -> P n) ->
     forall n:Z, P n.
 Proof.
   intros P HP p.
   set (Q := fun z => 0 <= z -> P z * P (- z)) in *.
-  cut (Q (Zabs p)); [ intros | apply (Z_lt_rec Q); auto with zarith ].
+  cut (Q (Z.abs p)); [ intros | apply (Z_lt_rec Q); auto with zarith ].
   elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
-  unfold Q in |- *; clear Q; intros.
-  apply pair; apply HP.
-  rewrite Zabs_eq; auto; intros.
-  elim (H (Zabs m)); intros; auto with zarith.
+  unfold Q; clear Q; intros.
+  split; apply HP.
+  rewrite Z.abs_eq; auto; intros.
+  elim (H (Z.abs m)); intros; auto with zarith.
   elim (Zabs_dec m); intro eq; rewrite eq; trivial.
-  rewrite Zabs_non_eq; auto with zarith.
-  rewrite Zopp_involutive; intros.
-  elim (H (Zabs m)); intros; auto with zarith.
+  rewrite Z.abs_neq, Z.opp_involutive; auto with zarith; intros.
+  elim (H (Z.abs m)); intros; auto with zarith.
   elim (Zabs_dec m); intro eq; rewrite eq; trivial.
 Qed.
 
 Theorem Z_lt_abs_induction :
   forall P:Z -> Prop,
-    (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) ->
+    (forall n:Z, (forall m:Z, Z.abs m < Z.abs n -> P m) -> P n) ->
     forall n:Z, P n.
 Proof.
   intros P HP p.
   set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *.
-  cut (Q (Zabs p)); [ intros | apply (Z_lt_induction Q); auto with zarith ].
+  cut (Q (Z.abs p)); [ intros | apply (Z_lt_induction Q); auto with zarith ].
   elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
-  unfold Q in |- *; clear Q; intros.
+  unfold Q; clear Q; intros.
   split; apply HP.
-  rewrite Zabs_eq; auto; intros.
-  elim (H (Zabs m)); intros; auto with zarith.
+  rewrite Z.abs_eq; auto; intros.
+  elim (H (Z.abs m)); intros; auto with zarith.
   elim (Zabs_dec m); intro eq; rewrite eq; trivial.
-  rewrite Zabs_non_eq; auto with zarith.
-  rewrite Zopp_involutive; intros.
-  elim (H (Zabs m)); intros; auto with zarith.
+  rewrite Z.abs_neq, Z.opp_involutive; auto with zarith; intros.
+  elim (H (Z.abs m)); intros; auto with zarith.
   elim (Zabs_dec m); intro eq; rewrite eq; trivial.
 Qed.
 
@@ -134,25 +91,12 @@ Lemma Zcase_sign :
   forall (n:Z) (P:Prop), (n = 0 -> P) -> (n > 0 -> P) -> (n < 0 -> P) -> P.
 Proof.
   intros x P Hzero Hpos Hneg.
-  induction  x as [| p| p].
-  apply Hzero; trivial.
-  apply Hpos; apply Zorder.Zgt_pos_0.
-  apply Hneg; apply Zorder.Zlt_neg_0.
+  destruct x; [apply Hzero|apply Hpos|apply Hneg]; easy.
 Qed.
 
-Lemma sqr_pos : forall n:Z, n * n >= 0.
+Lemma sqr_pos n : n * n >= 0.
 Proof.
-  intro x.
-  apply (Zcase_sign x (x * x >= 0)).
-  intros H; rewrite H; omega.
-  intros H; replace 0 with (0 * 0).
-  apply Zmult_ge_compat; omega.
-  omega.
-  intros H; replace 0 with (0 * 0).
-  replace (x * x) with (- x * - x).
-  apply Zmult_ge_compat; omega.
-  ring.
-  omega.
+ Z.swap_greater. apply Z.square_nonneg.
 Qed.
 
 (**********************************************************************)
@@ -163,11 +107,11 @@ Require Import List.
 Fixpoint Zlength_aux (acc:Z) (A:Type) (l:list A) : Z :=
   match l with
     | nil => acc
-    | _ :: l => Zlength_aux (Zsucc acc) A l
+    | _ :: l => Zlength_aux (Z.succ acc) A l
   end.
 
 Definition Zlength := Zlength_aux 0.
-Implicit Arguments Zlength [A].
+Arguments Zlength [A] l.
 
 Section Zlength_properties.
 
@@ -175,38 +119,33 @@ Section Zlength_properties.
 
   Implicit Type l : list A.
 
-  Lemma Zlength_correct : forall l, Zlength l = Z_of_nat (length l).
+  Lemma Zlength_correct l : Zlength l = Z.of_nat (length l).
   Proof.
-    assert (forall l (acc:Z), Zlength_aux acc A l = acc + Z_of_nat (length l)).
-    simple induction l.
-    simpl in |- *; auto with zarith.
-    intros; simpl (length (a :: l0)) in |- *; rewrite Znat.inj_S.
-    simpl in |- *; rewrite H; auto with zarith.
-    unfold Zlength in |- *; intros; rewrite H; auto.
+    assert (H : forall l acc, Zlength_aux acc A l = acc + Z.of_nat (length l)).
+    clear l. induction l.
+    auto with zarith.
+    intros. simpl length; simpl Zlength_aux.
+     rewrite IHl, Nat2Z.inj_succ; auto with zarith.
+    unfold Zlength. now rewrite H.
   Qed.
 
   Lemma Zlength_nil : Zlength (A:=A) nil = 0.
-  Proof.
-    auto.
-  Qed.
+  Proof. reflexivity. Qed.
 
-  Lemma Zlength_cons : forall (x:A) l, Zlength (x :: l) = Zsucc (Zlength l).
+  Lemma Zlength_cons (x:A) l : Zlength (x :: l) = Z.succ (Zlength l).
   Proof.
-    intros; do 2 rewrite Zlength_correct.
-    simpl (length (x :: l)) in |- *; rewrite Znat.inj_S; auto.
+    intros. now rewrite !Zlength_correct, <- Nat2Z.inj_succ.
   Qed.
 
-  Lemma Zlength_nil_inv : forall l, Zlength l = 0 -> l = nil.
+  Lemma Zlength_nil_inv l : Zlength l = 0 -> l = nil.
   Proof.
-    intro l; rewrite Zlength_correct.
-    case l; auto.
-    intros x l'; simpl (length (x :: l')) in |- *.
-    rewrite Znat.inj_S.
-    intros; exfalso; generalize (Zle_0_nat (length l')); omega.
+    rewrite Zlength_correct.
+    destruct l as [|x l]; auto.
+    now rewrite <- Nat2Z.inj_0, Nat2Z.inj_iff.
   Qed.
 
 End Zlength_properties.
 
-Implicit Arguments Zlength_correct [A].
-Implicit Arguments Zlength_cons [A].
-Implicit Arguments Zlength_nil_inv [A].
+Arguments Zlength_correct [A] l.
+Arguments Zlength_cons [A] x l.
+Arguments Zlength_nil_inv [A] l _.
diff --git a/theories/ZArith/Zdigits.v b/theories/ZArith/Zdigits.v
index c43b241d..fa8f5c27 100644
--- a/theories/ZArith/Zdigits.v
+++ b/theories/ZArith/Zdigits.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zdigits.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Bit vectors interpreted as integers.
     Contribution by Jean Duprat (ENS Lyon). *)
 
@@ -47,17 +45,17 @@ Section VALUE_OF_BOOLEAN_VECTORS.
     exact 0%Z.
 
     inversion H0.
-    exact (bit_value a + 2 * H H2)%Z.
+    exact (bit_value h + 2 * H H2)%Z.
   Defined.
 
   Lemma two_compl_value : forall n:nat, Bvector (S n) -> Z.
   Proof.
     simple induction n; intros.
     inversion H.
-    exact (- bit_value a)%Z.
+    exact (- bit_value h)%Z.
 
     inversion H0.
-    exact (bit_value a + 2 * H H2)%Z.
+    exact (bit_value h + 2 * H H2)%Z.
   Defined.
 
 End VALUE_OF_BOOLEAN_VECTORS.
@@ -66,7 +64,7 @@ Section ENCODING_VALUE.
 
 (** We compute the binary value via a Horner scheme.
     Computation stops at the vector length without checks.
-    We define a function Zmod2 similar to Zdiv2 returning the
+    We define a function Zmod2 similar to Z.div2 returning the
     quotient of division z=2q+r with 0<=r<=1.
     The two's complement value is also computed via a Horner scheme
     with Zmod2, the parameter is the size minus one.
@@ -90,16 +88,16 @@ Section ENCODING_VALUE.
 
 
   Lemma Zmod2_twice :
-    forall z:Z, z = (2 * Zmod2 z + bit_value (Zeven.Zodd_bool z))%Z.
+    forall z:Z, z = (2 * Zmod2 z + bit_value (Z.odd z))%Z.
   Proof.
-    destruct z; simpl in |- *.
+    destruct z; simpl.
     trivial.
 
-    destruct p; simpl in |- *; trivial.
+    destruct p; simpl; trivial.
 
-    destruct p; simpl in |- *.
-    destruct p as [p| p| ]; simpl in |- *.
-    rewrite <- (Pdouble_minus_one_o_succ_eq_xI p); trivial.
+    destruct p; simpl.
+    destruct p as [p| p| ]; simpl.
+    rewrite <- (Pos.pred_double_succ p); trivial.
 
     trivial.
 
@@ -115,15 +113,15 @@ Section ENCODING_VALUE.
     simple induction n; intros.
     exact Bnil.
 
-    exact (Bcons (Zeven.Zodd_bool H0) n0 (H (Zeven.Zdiv2 H0))).
+    exact (Bcons (Z.odd H0) n0 (H (Z.div2 H0))).
   Defined.
 
   Lemma Z_to_two_compl : forall n:nat, Z -> Bvector (S n).
   Proof.
     simple induction n; intros.
-    exact (Bcons (Zeven.Zodd_bool H) 0 Bnil).
+    exact (Bcons (Z.odd H) 0 Bnil).
 
-    exact (Bcons (Zeven.Zodd_bool H0) (S n0) (H (Zmod2 H0))).
+    exact (Bcons (Z.odd H0) (S n0) (H (Zmod2 H0))).
   Defined.
 
 End ENCODING_VALUE.
@@ -136,7 +134,7 @@ Section Z_BRIC_A_BRAC.
 
   Lemma binary_value_Sn :
     forall (n:nat) (b:bool) (bv:Bvector n),
-      binary_value (S n) (Vcons bool b n bv) =
+      binary_value (S n) ( b :: bv) =
       (bit_value b + 2 * binary_value n bv)%Z.
   Proof.
     intros; auto.
@@ -147,17 +145,17 @@ Section Z_BRIC_A_BRAC.
       (z >= 0)%Z ->
       Z_to_binary (S n) (bit_value b + 2 * z) = Bcons b n (Z_to_binary n z).
   Proof.
-    destruct b; destruct z; simpl in |- *; auto.
+    destruct b; destruct z; simpl; auto.
     intro H; elim H; trivial.
   Qed.
 
   Lemma binary_value_pos :
     forall (n:nat) (bv:Bvector n), (binary_value n bv >= 0)%Z.
   Proof.
-    induction bv as [| a n v IHbv]; simpl in |- *.
+    induction bv as [| a n v IHbv]; simpl.
     omega.
 
-    destruct a; destruct (binary_value n v); simpl in |- *; auto.
+    destruct a; destruct (binary_value n v); simpl; auto.
     auto with zarith.
   Qed.
 
@@ -176,34 +174,34 @@ Section Z_BRIC_A_BRAC.
   Proof.
     destruct b; destruct z as [| p| p]; auto.
     destruct p as [p| p| ]; auto.
-    destruct p as [p| p| ]; simpl in |- *; auto.
-    intros; rewrite (Psucc_o_double_minus_one_eq_xO p); trivial.
+    destruct p as [p| p| ]; simpl; auto.
+    intros; rewrite (Pos.succ_pred_double p); trivial.
   Qed.
 
   Lemma Z_to_binary_Sn_z :
     forall (n:nat) (z:Z),
       Z_to_binary (S n) z =
-      Bcons (Zeven.Zodd_bool z) n (Z_to_binary n (Zeven.Zdiv2 z)).
+      Bcons (Z.odd z) n (Z_to_binary n (Z.div2 z)).
   Proof.
     intros; auto.
   Qed.
 
   Lemma Z_div2_value :
     forall z:Z,
-      (z >= 0)%Z -> (bit_value (Zeven.Zodd_bool z) + 2 * Zeven.Zdiv2 z)%Z = z.
+      (z >= 0)%Z -> (bit_value (Z.odd z) + 2 * Z.div2 z)%Z = z.
   Proof.
     destruct z as [| p| p]; auto.
     destruct p; auto.
     intro H; elim H; trivial.
   Qed.
 
-  Lemma Pdiv2 : forall z:Z, (z >= 0)%Z -> (Zeven.Zdiv2 z >= 0)%Z.
+  Lemma Pdiv2 : forall z:Z, (z >= 0)%Z -> (Z.div2 z >= 0)%Z.
   Proof.
     destruct z as [| p| p].
     auto.
 
     destruct p; auto.
-    simpl in |- *; intros; omega.
+    simpl; intros; omega.
 
     intro H; elim H; trivial.
   Qed.
@@ -211,39 +209,39 @@ Section Z_BRIC_A_BRAC.
   Lemma Zdiv2_two_power_nat :
     forall (z:Z) (n:nat),
       (z >= 0)%Z ->
-      (z < two_power_nat (S n))%Z -> (Zeven.Zdiv2 z < two_power_nat n)%Z.
+      (z < two_power_nat (S n))%Z -> (Z.div2 z < two_power_nat n)%Z.
   Proof.
     intros.
-    cut (2 * Zeven.Zdiv2 z < 2 * two_power_nat n)%Z; intros.
+    cut (2 * Z.div2 z < 2 * two_power_nat n)%Z; intros.
     omega.
 
     rewrite <- two_power_nat_S.
     destruct (Zeven.Zeven_odd_dec z); intros.
     rewrite <- Zeven.Zeven_div2; auto.
 
-    generalize (Zeven.Zodd_div2 z H z0); omega.
+    generalize (Zeven.Zodd_div2 z z0); omega.
   Qed.
 
   Lemma Z_to_two_compl_Sn_z :
     forall (n:nat) (z:Z),
       Z_to_two_compl (S n) z =
-      Bcons (Zeven.Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z)).
+      Bcons (Z.odd z) (S n) (Z_to_two_compl n (Zmod2 z)).
   Proof.
     intros; auto.
   Qed.
 
   Lemma Zeven_bit_value :
-    forall z:Z, Zeven.Zeven z -> bit_value (Zeven.Zodd_bool z) = 0%Z.
+    forall z:Z, Zeven.Zeven z -> bit_value (Z.odd z) = 0%Z.
   Proof.
-    destruct z; unfold bit_value in |- *; auto.
+    destruct z; unfold bit_value; auto.
     destruct p; tauto || (intro H; elim H).
     destruct p; tauto || (intro H; elim H).
   Qed.
 
   Lemma Zodd_bit_value :
-    forall z:Z, Zeven.Zodd z -> bit_value (Zeven.Zodd_bool z) = 1%Z.
+    forall z:Z, Zeven.Zodd z -> bit_value (Z.odd z) = 1%Z.
   Proof.
-    destruct z; unfold bit_value in |- *; auto.
+    destruct z; unfold bit_value; auto.
     intros; elim H.
     destruct p; tauto || (intros; elim H).
     destruct p; tauto || (intros; elim H).
@@ -312,7 +310,7 @@ Section COHERENT_VALUE.
       (z < two_power_nat n)%Z -> binary_value n (Z_to_binary n z) = z.
   Proof.
     induction n as [| n IHn].
-    unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros; omega.
+    unfold two_power_nat, shift_nat; simpl; intros; omega.
 
     intros; rewrite Z_to_binary_Sn_z.
     rewrite binary_value_Sn.
@@ -330,7 +328,7 @@ Section COHERENT_VALUE.
       (z < two_power_nat n)%Z -> two_compl_value n (Z_to_two_compl n z) = z.
   Proof.
     induction n as [| n IHn].
-    unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros.
+    unfold two_power_nat, shift_nat; simpl; intros.
     assert (z = (-1)%Z \/ z = 0%Z). omega.
     intuition; subst z; trivial.
 
diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v
index df22371e..27fb21bc 100644
--- a/theories/ZArith/Zdiv.v
+++ b/theories/ZArith/Zdiv.v
@@ -1,200 +1,57 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zdiv.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(** * Euclidean Division *)
 
-(* Contribution by Claude Marché and Xavier Urbain *)
-
-(** Euclidean Division
-
-    Defines first of function that allows Coq to normalize.
-    Then only after proves the main required property.
-*)
+(** Initial Contribution by Claude Marché and Xavier Urbain *)
 
 Require Export ZArith_base.
-Require Import Zbool.
-Require Import Omega.
-Require Import ZArithRing.
-Require Import Zcomplements.
-Require Export Setoid.
-Open Local Scope Z_scope.
-
-(** * Definitions of Euclidian operations *)
-
-(** Euclidean division of a positive by a integer
-    (that is supposed to be positive).
-
-    Total function than returns an arbitrary value when
-    divisor is not positive
-
-*)
-
-Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) : Z * Z :=
-  match a with
-    | xH => if Zge_bool b 2 then (0, 1) else (1, 0)
-    | xO a' =>
-      let (q, r) := Zdiv_eucl_POS a' b in
-	let r' := 2 * r in
-	  if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
-    | xI a' =>
-      let (q, r) := Zdiv_eucl_POS a' b in
-	let r' := 2 * r + 1 in
-	  if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
-  end.
-
-
-(** Euclidean division of integers.
-
-    Total function than returns (0,0) when dividing by 0.
-*)
-
-(**
-
-  The pseudo-code is:
-
-  if b = 0 : (0,0)
-
-  if b <> 0 and a = 0 : (0,0)
-
-  if b > 0 and a < 0 : let (q,r) = div_eucl_pos (-a) b in
-                       if r = 0 then (-q,0) else (-(q+1),b-r)
-
-  if b < 0 and a < 0 : let (q,r) = div_eucl (-a) (-b) in (q,-r)
-
-  if b < 0 and a > 0 : let (q,r) = div_eucl a (-b) in
-                       if r = 0 then (-q,0) else (-(q+1),b+r)
-
-  In other word, when b is non-zero, q is chosen to be the greatest integer
-  smaller or equal to a/b. And sgn(r)=sgn(b) and |r| < |b| (at least when
-  r is not null).
-*)
+Require Import Zbool Omega ZArithRing Zcomplements Setoid Morphisms.
+Local Open Scope Z_scope.
 
-(* Nota: At least two others conventions also exist for euclidean division.
-   They all satify the equation a=b*q+r, but differ on the choice of (q,r)
-   on negative numbers.
+(** The definition of the division is now in [BinIntDef], the initial
+    specifications and properties are in [BinInt]. *)
 
-   * Ocaml uses Round-Toward-Zero division: (-a)/b = a/(-b) = -(a/b).
-     Hence (-a) mod b = - (a mod b)
-           a mod (-b) = a mod b
-     And: |r| < |b| and sgn(r) = sgn(a)  (notice the a here instead of b).
+Notation Zdiv_eucl_POS := Z.pos_div_eucl (compat "8.3").
+Notation Zdiv_eucl := Z.div_eucl (compat "8.3").
+Notation Zdiv := Z.div (compat "8.3").
+Notation Zmod := Z.modulo (compat "8.3").
 
-   * Another solution is to always pick a non-negative remainder:
-     a=b*q+r with 0 <= r < |b|
-*)
-
-Definition Zdiv_eucl (a b:Z) : Z * Z :=
-  match a, b with
-    | Z0, _ => (0, 0)
-    | _, Z0 => (0, 0)
-    | Zpos a', Zpos _ => Zdiv_eucl_POS a' b
-    | Zneg a', Zpos _ =>
-      let (q, r) := Zdiv_eucl_POS a' b in
-	match r with
-	  | Z0 => (- q, 0)
-	  | _ => (- (q + 1), b - r)
-	end
-    | Zneg a', Zneg b' => let (q, r) := Zdiv_eucl_POS a' (Zpos b') in (q, - r)
-    | Zpos a', Zneg b' =>
-      let (q, r) := Zdiv_eucl_POS a' (Zpos b') in
-	match r with
-	  | Z0 => (- q, 0)
-	  | _ => (- (q + 1), b + r)
-	end
-  end.
-
-
-(** Division and modulo are projections of [Zdiv_eucl] *)
-
-Definition Zdiv (a b:Z) : Z := let (q, _) := Zdiv_eucl a b in q.
-
-Definition Zmod (a b:Z) : Z := let (_, r) := Zdiv_eucl a b in r.
-
-(** Syntax *)
-
-Infix "/" := Zdiv : Z_scope.
-Infix "mod" := Zmod (at level 40, no associativity) : Z_scope.
-
-(* Tests:
-
-Eval compute in (Zdiv_eucl 7 3).
-
-Eval compute in (Zdiv_eucl (-7) 3).
+Notation Zdiv_eucl_eq := Z.div_eucl_eq (compat "8.3").
+Notation Z_div_mod_eq_full := Z.div_mod (compat "8.3").
+Notation Zmod_POS_bound := Z.pos_div_eucl_bound (compat "8.3").
+Notation Zmod_pos_bound := Z.mod_pos_bound (compat "8.3").
+Notation Zmod_neg_bound := Z.mod_neg_bound (compat "8.3").
 
-Eval compute in (Zdiv_eucl 7 (-3)).
+(** * Main division theorems *)
 
-Eval compute in (Zdiv_eucl (-7) (-3)).
-
-*)
-
-
-(** * Main division theorem *)
-
-(** First a lemma for two positive arguments *)
+(** NB: many things are stated twice for compatibility reasons *)
 
 Lemma Z_div_mod_POS :
   forall b:Z,
     b > 0 ->
     forall a:positive,
-      let (q, r) := Zdiv_eucl_POS a b in Zpos a = b * q + r /\ 0 <= r < b.
+      let (q, r) := Z.pos_div_eucl a b in Zpos a = b * q + r /\ 0 <= r < b.
 Proof.
-simple induction a; cbv beta iota delta [Zdiv_eucl_POS] in |- *;
-  fold Zdiv_eucl_POS in |- *; cbv zeta.
-
-intro p; case (Zdiv_eucl_POS p b); intros q r [H0 H1].
-generalize (Zgt_cases b (2 * r + 1)).
-case (Zgt_bool b (2 * r + 1));
- (rewrite BinInt.Zpos_xI; rewrite H0; split; [ ring | omega ]).
-
-intros p; case (Zdiv_eucl_POS p b); intros q r [H0 H1].
-generalize (Zgt_cases b (2 * r)).
-case (Zgt_bool b (2 * r)); rewrite BinInt.Zpos_xO;
- change (Zpos (xO p)) with (2 * Zpos p) in |- *; rewrite H0;
- (split; [ ring | omega ]).
-
-generalize (Zge_cases b 2).
-case (Zge_bool b 2); (intros; split; [ try ring | omega ]).
-omega.
+ intros b Hb a. Z.swap_greater.
+ generalize (Z.pos_div_eucl_eq a b Hb) (Z.pos_div_eucl_bound a b Hb).
+ destruct Z.pos_div_eucl. rewrite Z.mul_comm. auto.
 Qed.
 
-(** Then the usual situation of a positive [b] and no restriction on [a] *)
-
-Theorem Z_div_mod :
-  forall a b:Z,
-    b > 0 -> let (q, r) := Zdiv_eucl a b in a = b * q + r /\ 0 <= r < b.
+Theorem Z_div_mod a b :
+  b > 0 ->
+  let (q, r) := Z.div_eucl a b in a = b * q + r /\ 0 <= r < b.
 Proof.
-  intros a b; case a; case b; try (simpl in |- *; intros; omega).
-  unfold Zdiv_eucl in |- *; intros; apply Z_div_mod_POS; trivial.
-
-  intros; discriminate.
-
-  intros.
-  generalize (Z_div_mod_POS (Zpos p) H p0).
-  unfold Zdiv_eucl in |- *.
-  case (Zdiv_eucl_POS p0 (Zpos p)).
-  intros z z0.
-  case z0.
-
-  intros [H1 H2].
-  split; trivial.
-  change (Zneg p0) with (- Zpos p0); rewrite H1; ring.
-
-  intros p1 [H1 H2].
-  split; trivial.
-  change (Zneg p0) with (- Zpos p0); rewrite H1; ring.
-  generalize (Zorder.Zgt_pos_0 p1); omega.
-
-  intros p1 [H1 H2].
-  split; trivial.
-  change (Zneg p0) with (- Zpos p0); rewrite H1; ring.
-  generalize (Zorder.Zlt_neg_0 p1); omega.
-
-  intros; discriminate.
+ Z.swap_greater. intros Hb.
+ assert (Hb' : b<>0) by (now destruct b).
+ generalize (Z.div_eucl_eq a b Hb') (Z.mod_pos_bound a b Hb).
+ unfold Z.modulo. destruct Z.div_eucl. auto.
 Qed.
 
 (** For stating the fully general result, let's give a short name
@@ -204,10 +61,10 @@ Definition Remainder r b :=  0 <= r < b \/ b < r <= 0.
 
 (** Another equivalent formulation: *)
 
-Definition Remainder_alt r b :=  Zabs r < Zabs b /\ Zsgn r <> - Zsgn b.
+Definition Remainder_alt r b :=  Z.abs r < Z.abs b /\ Z.sgn r <> - Z.sgn b.
 
-(* In the last formulation, [ Zsgn r <> - Zsgn b ] is less nice than saying
-    [ Zsgn r = Zsgn b ], but at least it works even when [r] is null. *)
+(* In the last formulation, [ Z.sgn r <> - Z.sgn b ] is less nice than saying
+    [ Z.sgn r = Z.sgn b ], but at least it works even when [r] is null. *)
 
 Lemma Remainder_equiv : forall r b, Remainder r b <-> Remainder_alt r b.
 Proof.
@@ -218,90 +75,44 @@ Hint Unfold Remainder.
 
 (** Now comes the fully general result about Euclidean division. *)
 
-Theorem Z_div_mod_full :
-  forall a b:Z,
-    b <> 0 -> let (q, r) := Zdiv_eucl a b in a = b * q + r /\ Remainder r b.
+Theorem Z_div_mod_full a b :
+  b <> 0 ->
+  let (q, r) := Z.div_eucl a b in a = b * q + r /\ Remainder r b.
 Proof.
-  destruct b as [|b|b].
-  (* b = 0 *)
-  intro H; elim H; auto.
-  (* b > 0 *)
-  intros _.
-  assert (Zpos b > 0) by auto with zarith.
-  generalize (Z_div_mod a (Zpos b) H).
-  destruct Zdiv_eucl as (q,r); intuition; simpl; auto.
-  (* b < 0 *)
-  intros _.
-  assert (Zpos b > 0) by auto with zarith.
-  generalize (Z_div_mod a (Zpos b) H).
-  unfold Remainder.
-  destruct a as [|a|a].
-  (* a = 0 *)
-  simpl; intuition.
-  (* a > 0 *)
-  unfold Zdiv_eucl; destruct Zdiv_eucl_POS as (q,r).
-  destruct r as [|r|r]; [ | | omega with *].
-  rewrite <- Zmult_opp_comm; simpl Zopp; intuition.
-  rewrite <- Zmult_opp_comm; simpl Zopp.
-  rewrite Zmult_plus_distr_r; omega with *.
-  (* a < 0 *)
-  unfold Zdiv_eucl.
-  generalize (Z_div_mod_POS (Zpos b) H a).
-  destruct Zdiv_eucl_POS as (q,r).
-  destruct r as [|r|r]; change (Zneg b) with (-Zpos b).
-  rewrite Zmult_opp_comm; omega with *.
-  rewrite <- Zmult_opp_comm, Zmult_plus_distr_r;
-   repeat rewrite Zmult_opp_comm; omega.
-  rewrite Zmult_opp_comm; omega with *.
+ intros Hb.
+ generalize (Z.div_eucl_eq a b Hb)
+  (Z.mod_pos_bound a b) (Z.mod_neg_bound a b).
+ unfold Z.modulo. destruct Z.div_eucl as (q,r).
+ intros EQ POS NEG.
+ split; auto.
+ red; destruct b.
+  now destruct Hb. left; now apply POS. right; now apply NEG.
 Qed.
 
-(** The same results as before, stated separately in terms of Zdiv and Zmod *)
-
-Lemma Z_mod_remainder : forall a b:Z, b<>0 -> Remainder (a mod b) b.
-Proof.
-  unfold Zmod; intros a b Hb; generalize (Z_div_mod_full a b Hb); auto.
-  destruct Zdiv_eucl; tauto.
-Qed.
+(** The same results as before, stated separately in terms of Z.div and Z.modulo *)
 
-Lemma Z_mod_lt : forall a b:Z, b > 0 -> 0 <= a mod b < b.
+Lemma Z_mod_remainder a b : b<>0 -> Remainder (a mod b) b.
 Proof.
-  unfold Zmod; intros a b Hb; generalize (Z_div_mod a b Hb).
-  destruct Zdiv_eucl; tauto.
+  unfold Z.modulo; intros Hb; generalize (Z_div_mod_full a b Hb); auto.
+  destruct Z.div_eucl; tauto.
 Qed.
 
-Lemma Z_mod_neg : forall a b:Z, b < 0 -> b < a mod b <= 0.
-Proof.
-  unfold Zmod; intros a b Hb.
-  assert (Hb' : b<>0) by (auto with zarith).
-  generalize (Z_div_mod_full a b Hb').
-  destruct Zdiv_eucl.
-  unfold Remainder; intuition.
-Qed.
+Lemma Z_mod_lt a b : b > 0 -> 0 <= a mod b < b.
+Proof (fun Hb => Z.mod_pos_bound a b (Z.gt_lt _ _ Hb)).
 
-Lemma Z_div_mod_eq_full : forall a b:Z, b <> 0 -> a = b*(a/b) + (a mod b).
-Proof.
-  unfold Zdiv, Zmod; intros a b Hb; generalize (Z_div_mod_full a b Hb).
-  destruct Zdiv_eucl; tauto.
-Qed.
+Lemma Z_mod_neg a b : b < 0 -> b < a mod b <= 0.
+Proof (Z.mod_neg_bound a b).
 
-Lemma Z_div_mod_eq : forall a b:Z, b > 0 -> a = b*(a/b) + (a mod b).
+Lemma Z_div_mod_eq a b : b > 0 -> a = b*(a/b) + (a mod b).
 Proof.
-  intros; apply Z_div_mod_eq_full; auto with zarith.
+  intros Hb; apply Z.div_mod; auto with zarith.
 Qed.
 
-Lemma Zmod_eq_full : forall a b:Z, b<>0 -> a mod b = a - (a/b)*b.
-Proof.
-  intros.
-  rewrite <- Zeq_plus_swap, Zplus_comm, Zmult_comm; symmetry.
-  apply Z_div_mod_eq_full; auto.
-Qed.
+Lemma Zmod_eq_full a b : b<>0 -> a mod b = a - (a/b)*b.
+Proof. intros. rewrite Z.mul_comm. now apply Z.mod_eq. Qed.
 
-Lemma Zmod_eq : forall a b:Z, b>0 -> a mod b = a - (a/b)*b.
-Proof.
-  intros.
-  rewrite <- Zeq_plus_swap, Zplus_comm, Zmult_comm; symmetry.
-  apply Z_div_mod_eq; auto.
-Qed.
+Lemma Zmod_eq a b : b>0 -> a mod b = a - (a/b)*b.
+Proof. intros. apply Zmod_eq_full. now destruct b. Qed.
 
 (** Existence theorem *)
 
@@ -309,89 +120,51 @@ Theorem Zdiv_eucl_exist : forall (b:Z)(Hb:b>0)(a:Z),
  {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < b}.
 Proof.
   intros b Hb a.
-  exists (Zdiv_eucl a b).
+  exists (Z.div_eucl a b).
   exact (Z_div_mod a b Hb).
 Qed.
 
-Implicit Arguments Zdiv_eucl_exist.
+Arguments Zdiv_eucl_exist : default implicits.
 
 
 (** Uniqueness theorems *)
 
-Theorem Zdiv_mod_unique :
- forall b q1 q2 r1 r2:Z,
-  0 <= r1 < Zabs b -> 0 <= r2 < Zabs b ->
+Theorem Zdiv_mod_unique b q1 q2 r1 r2 :
+  0 <= r1 < Z.abs b -> 0 <= r2 < Z.abs b ->
   b*q1+r1 = b*q2+r2 -> q1=q2 /\ r1=r2.
 Proof.
-intros b q1 q2 r1 r2 Hr1 Hr2 H.
-destruct (Z_eq_dec q1 q2) as [Hq|Hq].
+intros Hr1 Hr2 H. rewrite <- (Z.abs_sgn b), <- !Z.mul_assoc in H.
+destruct (Z.div_mod_unique (Z.abs b) (Z.sgn b * q1) (Z.sgn b * q2) r1 r2); auto.
 split; trivial.
-rewrite Hq in H; omega.
-elim (Zlt_not_le (Zabs (r2 - r1)) (Zabs b)).
-omega with *.
-replace (r2-r1) with (b*(q1-q2)) by (rewrite Zmult_minus_distr_l; omega).
-replace (Zabs b) with ((Zabs b)*1) by ring.
-rewrite Zabs_Zmult.
-apply Zmult_le_compat_l; auto with *.
-omega with *.
+apply Z.mul_cancel_l with (Z.sgn b); trivial.
+rewrite Z.sgn_null_iff, <- Z.abs_0_iff. destruct Hr1; Z.order.
 Qed.
 
 Theorem Zdiv_mod_unique_2 :
  forall b q1 q2 r1 r2:Z,
   Remainder r1 b -> Remainder r2 b ->
   b*q1+r1 = b*q2+r2 -> q1=q2 /\ r1=r2.
-Proof.
-unfold Remainder.
-intros b q1 q2 r1 r2 Hr1 Hr2 H.
-destruct (Z_eq_dec q1 q2) as [Hq|Hq].
-split; trivial.
-rewrite Hq in H; omega.
-elim (Zlt_not_le (Zabs (r2 - r1)) (Zabs b)).
-omega with *.
-replace (r2-r1) with (b*(q1-q2)) by (rewrite Zmult_minus_distr_l; omega).
-replace (Zabs b) with ((Zabs b)*1) by ring.
-rewrite Zabs_Zmult.
-apply Zmult_le_compat_l; auto with *.
-omega with *.
-Qed.
+Proof Z.div_mod_unique.
 
 Theorem Zdiv_unique_full:
  forall a b q r, Remainder r b ->
    a = b*q + r -> q = a/b.
-Proof.
-  intros.
-  assert (b <> 0) by (unfold Remainder in *; omega with *).
-  generalize (Z_div_mod_full a b H1).
-  unfold Zdiv; destruct Zdiv_eucl as (q',r').
-  intros (H2,H3); rewrite H2 in H0.
-  destruct (Zdiv_mod_unique_2 b q q' r r'); auto.
-Qed.
+Proof Z.div_unique.
 
 Theorem Zdiv_unique:
  forall a b q r, 0 <= r < b ->
    a = b*q + r -> q = a/b.
-Proof.
-  intros; eapply Zdiv_unique_full; eauto.
-Qed.
+Proof. intros; eapply Zdiv_unique_full; eauto. Qed.
 
 Theorem Zmod_unique_full:
  forall a b q r, Remainder r b ->
   a = b*q + r ->  r = a mod b.
-Proof.
-  intros.
-  assert (b <> 0) by (unfold Remainder in *; omega with *).
-  generalize (Z_div_mod_full a b H1).
-  unfold Zmod; destruct Zdiv_eucl as (q',r').
-  intros (H2,H3); rewrite H2 in H0.
-  destruct (Zdiv_mod_unique_2 b q q' r r'); auto.
-Qed.
+Proof Z.mod_unique.
 
 Theorem Zmod_unique:
  forall a b q r, 0 <= r < b ->
   a = b*q + r -> r = a mod b.
-Proof.
-  intros; eapply Zmod_unique_full; eauto.
-Qed.
+Proof. intros; eapply Zmod_unique_full; eauto. Qed.
 
 (** * Basic values of divisions and modulo. *)
 
@@ -415,70 +188,44 @@ Proof.
   destruct a; simpl; auto.
 Qed.
 
+Ltac zero_or_not a :=
+  destruct (Z.eq_dec a 0);
+  [subst; rewrite ?Zmod_0_l, ?Zdiv_0_l, ?Zmod_0_r, ?Zdiv_0_r;
+   auto with zarith|].
+
 Lemma Zmod_1_r: forall a, a mod 1 = 0.
-Proof.
-  intros; symmetry; apply Zmod_unique with a; auto with zarith.
-Qed.
+Proof. intros. zero_or_not a. apply Z.mod_1_r. Qed.
 
 Lemma Zdiv_1_r: forall a, a/1 = a.
-Proof.
-  intros; symmetry; apply Zdiv_unique with 0; auto with zarith.
-Qed.
+Proof. intros. zero_or_not a. apply Z.div_1_r. Qed.
 
 Hint Resolve Zmod_0_l Zmod_0_r Zdiv_0_l Zdiv_0_r Zdiv_1_r Zmod_1_r
  : zarith.
 
 Lemma Zdiv_1_l: forall a, 1 < a -> 1/a = 0.
-Proof.
-  intros; symmetry; apply Zdiv_unique with 1; auto with zarith.
-Qed.
+Proof Z.div_1_l.
 
 Lemma Zmod_1_l: forall a, 1 < a ->  1 mod a = 1.
-Proof.
-  intros; symmetry; apply Zmod_unique with 0; auto with zarith.
-Qed.
+Proof Z.mod_1_l.
 
 Lemma Z_div_same_full : forall a:Z, a<>0 -> a/a = 1.
-Proof.
-  intros; symmetry; apply Zdiv_unique_full with 0; auto with *; red; omega.
-Qed.
+Proof Z.div_same.
 
 Lemma Z_mod_same_full : forall a, a mod a = 0.
-Proof.
-  destruct a; intros; symmetry.
-  compute; auto.
-  apply Zmod_unique with 1; auto with *; omega with *.
-  apply Zmod_unique_full with 1; auto with *; red; omega with *.
-Qed.
+Proof. intros. zero_or_not a. apply Z.mod_same; auto. Qed.
 
 Lemma Z_mod_mult : forall a b, (a*b) mod b = 0.
-Proof.
-  intros a b; destruct (Z_eq_dec b 0) as [Hb|Hb].
-  subst; simpl; rewrite Zmod_0_r; auto.
-  symmetry; apply Zmod_unique_full with a; [ red; omega | ring ].
-Qed.
+Proof. intros. zero_or_not b. apply Z.mod_mul. auto. Qed.
 
 Lemma Z_div_mult_full : forall a b:Z, b <> 0 -> (a*b)/b = a.
-Proof.
-  intros; symmetry; apply Zdiv_unique_full with 0; auto with zarith;
-   [ red; omega | ring].
-Qed.
+Proof Z.div_mul.
 
-(** * Order results about Zmod and Zdiv *)
+(** * Order results about Z.modulo and Z.div *)
 
 (* Division of positive numbers is positive. *)
 
 Lemma Z_div_pos: forall a b, b > 0 -> 0 <= a -> 0 <= a/b.
-Proof.
-  intros.
-  rewrite (Z_div_mod_eq a b H) in H0.
-  assert (H1:=Z_mod_lt a b H).
-  destruct (Z_lt_le_dec (a/b) 0); auto.
-  assert (b*(a/b) <= -b).
-   replace (-b) with (b*-1); [ | ring].
-   apply Zmult_le_compat_l; auto with zarith.
-  omega.
-Qed.
+Proof. intros. apply Z.div_pos; auto with zarith. Qed.
 
 Lemma Z_div_ge0: forall a b, b > 0 -> a >= 0 -> a/b >=0.
 Proof.
@@ -489,366 +236,165 @@ Qed.
     the division is strictly decreasing. *)
 
 Lemma Z_div_lt : forall a b:Z, b >= 2 -> a > 0 -> a/b < a.
-Proof.
-  intros. cut (b > 0); [ intro Hb | omega ].
-  generalize (Z_div_mod a b Hb).
-  cut (a >= 0); [ intro Ha | omega ].
-  generalize (Z_div_ge0 a b Hb Ha).
-  unfold Zdiv in |- *; case (Zdiv_eucl a b); intros q r H1 [H2 H3].
-  cut (a >= 2 * q -> q < a); [ intro h; apply h; clear h | intros; omega ].
-  apply Zge_trans with (b * q).
-  omega.
-  auto with zarith.
-Qed.
-
+Proof. intros. apply Z.div_lt; auto with zarith. Qed.
 
 (** A division of a small number by a bigger one yields zero. *)
 
 Theorem Zdiv_small: forall a b, 0 <= a < b -> a/b = 0.
-Proof.
-  intros a b H; apply sym_equal; apply Zdiv_unique with a; auto with zarith.
-Qed.
+Proof Z.div_small.
 
 (** Same situation, in term of modulo: *)
 
 Theorem Zmod_small: forall a n, 0 <= a < n -> a mod n = a.
-Proof.
-  intros a b H; apply sym_equal; apply Zmod_unique with 0; auto with zarith.
-Qed.
+Proof Z.mod_small.
 
-(** [Zge] is compatible with a positive division. *)
+(** [Z.ge] is compatible with a positive division. *)
 
 Lemma Z_div_ge : forall a b c:Z, c > 0 -> a >= b -> a/c >= b/c.
-Proof.
-  intros a b c cPos aGeb.
-  generalize (Z_div_mod_eq a c cPos).
-  generalize (Z_mod_lt a c cPos).
-  generalize (Z_div_mod_eq b c cPos).
-  generalize (Z_mod_lt b c cPos).
-  intros.
-  elim (Z_ge_lt_dec (a / c) (b / c)); trivial.
-  intro.
-  absurd (b - a >= 1).
-  omega.
-  replace (b-a) with (c * (b/c-a/c) + b mod c - a mod c) by
-    (symmetry; pattern a at 1; rewrite H2; pattern b at 1; rewrite H0; ring).
-  assert (c * (b / c - a / c) >= c * 1).
-  apply Zmult_ge_compat_l.
-  omega.
-  omega.
-  assert (c * 1 = c).
-  ring.
-  omega.
-Qed.
+Proof. intros. apply Z.le_ge. apply Z.div_le_mono; auto with zarith. Qed.
 
-(** Same, with [Zle]. *)
+(** Same, with [Z.le]. *)
 
 Lemma Z_div_le : forall a b c:Z, c > 0 -> a <= b -> a/c <= b/c.
-Proof.
-  intros a b c H H0.
-  apply Zge_le.
-  apply Z_div_ge; auto with *.
-Qed.
+Proof. intros. apply Z.div_le_mono; auto with zarith. Qed.
 
 (** With our choice of division, rounding of (a/b) is always done toward bottom: *)
 
 Lemma Z_mult_div_ge : forall a b:Z, b > 0 -> b*(a/b) <= a.
-Proof.
-  intros a b H; generalize (Z_div_mod_eq a b H) (Z_mod_lt a b H); omega.
-Qed.
+Proof. intros. apply Z.mul_div_le; auto with zarith. Qed.
 
 Lemma Z_mult_div_ge_neg : forall a b:Z, b < 0 -> b*(a/b) >= a.
-Proof.
-  intros a b H.
-  generalize (Z_div_mod_eq_full a _ (Zlt_not_eq _ _ H)) (Z_mod_neg a _ H); omega.
-Qed.
+Proof. intros. apply Z.le_ge. apply Z.mul_div_ge; auto with zarith. Qed.
 
 (** The previous inequalities are exact iff the modulo is zero. *)
 
 Lemma Z_div_exact_full_1 : forall a b:Z, a = b*(a/b) -> a mod b = 0.
-Proof.
-  intros; destruct (Z_eq_dec b 0) as [Hb|Hb].
-  subst b; simpl in *; subst; auto.
-  generalize (Z_div_mod_eq_full a b Hb); omega.
-Qed.
+Proof. intros a b. zero_or_not b. rewrite Z.div_exact; auto. Qed.
 
 Lemma Z_div_exact_full_2 : forall a b:Z, b <> 0 -> a mod b = 0 -> a = b*(a/b).
-Proof.
-  intros; generalize (Z_div_mod_eq_full a b H); omega.
-Qed.
+Proof. intros; rewrite Z.div_exact; auto. Qed.
 
 (** A modulo cannot grow beyond its starting point. *)
 
 Theorem Zmod_le: forall a b, 0 < b -> 0 <= a -> a mod b <= a.
-Proof.
-  intros a b H1 H2; case (Zle_or_lt b a); intros H3.
-  case (Z_mod_lt a b); auto with zarith.
-  rewrite Zmod_small; auto with zarith.
-Qed.
+Proof. intros. apply Z.mod_le; auto. Qed.
 
-(** Some additionnal inequalities about Zdiv. *)
+(** Some additionnal inequalities about Z.div. *)
 
 Theorem Zdiv_lt_upper_bound:
   forall a b q, 0 < b -> a < q*b -> a/b < q.
-Proof.
-  intros a b q H1 H2.
-  apply Zmult_lt_reg_r with b; auto with zarith.
-  apply Zle_lt_trans with (2 := H2).
-  pattern a at 2; rewrite (Z_div_mod_eq a b); auto with zarith.
-  rewrite (Zmult_comm b); case (Z_mod_lt a b); auto with zarith.
-Qed.
+Proof. intros a b q; rewrite Z.mul_comm; apply Z.div_lt_upper_bound. Qed.
 
 Theorem Zdiv_le_upper_bound:
   forall a b q, 0 < b -> a <= q*b -> a/b <= q.
-Proof.
-  intros.
-  rewrite <- (Z_div_mult_full q b); auto with zarith.
-  apply Z_div_le; auto with zarith.
-Qed.
+Proof. intros a b q; rewrite Z.mul_comm; apply Z.div_le_upper_bound. Qed.
 
 Theorem Zdiv_le_lower_bound:
   forall a b q, 0 < b -> q*b <= a -> q <= a/b.
-Proof.
-  intros.
-  rewrite <- (Z_div_mult_full q b); auto with zarith.
-  apply Z_div_le; auto with zarith.
-Qed.
+Proof. intros a b q; rewrite Z.mul_comm; apply Z.div_le_lower_bound. Qed.
 
 (** A division of respect opposite monotonicity for the divisor *)
 
 Lemma Zdiv_le_compat_l: forall p q r, 0 <= p -> 0 < q < r ->
     p / r <= p / q.
-Proof.
-  intros p q r H H1.
-  apply Zdiv_le_lower_bound; auto with zarith.
-  rewrite Zmult_comm.
-  pattern p at 2; rewrite (Z_div_mod_eq p r); auto with zarith.
-  apply Zle_trans with (r * (p / r)); auto with zarith.
-  apply Zmult_le_compat_r; auto with zarith.
-  apply Zdiv_le_lower_bound; auto with zarith.
-  case (Z_mod_lt p r); auto with zarith.
-Qed.
+Proof. intros; apply Z.div_le_compat_l; auto with zarith. Qed.
 
 Theorem Zdiv_sgn: forall a b,
-  0 <= Zsgn (a/b) * Zsgn a * Zsgn b.
+  0 <= Z.sgn (a/b) * Z.sgn a * Z.sgn b.
 Proof.
   destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith;
-  generalize (Z_div_pos (Zpos a) (Zpos b)); unfold Zdiv, Zdiv_eucl;
-  destruct Zdiv_eucl_POS as (q,r); destruct r; omega with *.
+  generalize (Z.div_pos (Zpos a) (Zpos b)); unfold Z.div, Z.div_eucl;
+  destruct Z.pos_div_eucl as (q,r); destruct r; omega with *.
 Qed.
 
-(** * Relations between usual operations and Zmod and Zdiv *)
+(** * Relations between usual operations and Z.modulo and Z.div *)
 
 Lemma Z_mod_plus_full : forall a b c:Z, (a + b * c) mod c = a mod c.
-Proof.
-  intros; destruct (Z_eq_dec c 0) as [Hc|Hc].
-  subst; do 2 rewrite Zmod_0_r; auto.
-  symmetry; apply Zmod_unique_full with (a/c+b); auto with zarith.
-  red; generalize (Z_mod_lt a c)(Z_mod_neg a c); omega.
-  rewrite Zmult_plus_distr_r, Zmult_comm.
-  generalize (Z_div_mod_eq_full a c Hc); omega.
-Qed.
+Proof. intros. zero_or_not c. apply Z.mod_add; auto. Qed.
 
 Lemma Z_div_plus_full : forall a b c:Z, c <> 0 -> (a + b * c) / c = a / c + b.
-Proof.
-  intro; symmetry.
-  apply Zdiv_unique_full with (a mod c); auto with zarith.
-  red; generalize (Z_mod_lt a c)(Z_mod_neg a c); omega.
-  rewrite Zmult_plus_distr_r, Zmult_comm.
-  generalize (Z_div_mod_eq_full a c H); omega.
-Qed.
+Proof Z.div_add.
 
 Theorem Z_div_plus_full_l: forall a b c : Z, b <> 0 -> (a * b + c) / b = a + c / b.
-Proof.
-  intros a b c H; rewrite Zplus_comm; rewrite Z_div_plus_full;
-  try apply Zplus_comm; auto with zarith.
-Qed.
+Proof Z.div_add_l.
 
-(** [Zopp] and [Zdiv], [Zmod].
+(** [Z.opp] and [Z.div], [Z.modulo].
     Due to the choice of convention for our Euclidean division,
-    some of the relations about [Zopp] and divisions are rather complex. *)
+    some of the relations about [Z.opp] and divisions are rather complex. *)
 
 Lemma Zdiv_opp_opp : forall a b:Z, (-a)/(-b) = a/b.
-Proof.
-  intros [|a|a] [|b|b]; try reflexivity; unfold Zdiv; simpl;
-  destruct (Zdiv_eucl_POS a (Zpos b)); destruct z0; try reflexivity.
-Qed.
+Proof. intros. zero_or_not b. apply Z.div_opp_opp; auto. Qed.
 
 Lemma Zmod_opp_opp : forall a b:Z, (-a) mod (-b) = - (a mod b).
-Proof.
-  intros; destruct (Z_eq_dec b 0) as [Hb|Hb].
-  subst; do 2 rewrite Zmod_0_r; auto.
-  intros; symmetry.
-  apply Zmod_unique_full with ((-a)/(-b)); auto.
-  generalize (Z_mod_remainder a b Hb); destruct 1; [right|left]; omega.
-  rewrite Zdiv_opp_opp.
-  pattern a at 1; rewrite (Z_div_mod_eq_full a b Hb); ring.
-Qed.
+Proof. intros. zero_or_not b. apply Z.mod_opp_opp; auto. Qed.
 
 Lemma Z_mod_zero_opp_full : forall a b:Z, a mod b = 0 -> (-a) mod b = 0.
-Proof.
-  intros; destruct (Z_eq_dec b 0) as [Hb|Hb].
-  subst; rewrite Zmod_0_r; auto.
-  rewrite Z_div_exact_full_2 with a b; auto.
-  replace (- (b * (a / b))) with (0 + - (a / b) * b).
-  rewrite Z_mod_plus_full; auto.
-  ring.
-Qed.
+Proof. intros. zero_or_not b. apply Z.mod_opp_l_z; auto. Qed.
 
 Lemma Z_mod_nz_opp_full : forall a b:Z, a mod b <> 0 ->
  (-a) mod b = b - (a mod b).
-Proof.
-  intros.
-  assert (b<>0) by (contradict H; subst; rewrite Zmod_0_r; auto).
-  symmetry; apply Zmod_unique_full with (-1-a/b); auto.
-  generalize (Z_mod_remainder a b H0); destruct 1; [left|right]; omega.
-  rewrite Zmult_minus_distr_l.
-  pattern a at 1; rewrite (Z_div_mod_eq_full a b H0); ring.
-Qed.
+Proof. intros. zero_or_not b. apply Z.mod_opp_l_nz; auto. Qed.
 
 Lemma Z_mod_zero_opp_r : forall a b:Z, a mod b = 0 -> a mod (-b) = 0.
-Proof.
-  intros.
-  rewrite <- (Zopp_involutive a).
-  rewrite Zmod_opp_opp.
-  rewrite Z_mod_zero_opp_full; auto.
-Qed.
+Proof. intros. zero_or_not b. apply Z.mod_opp_r_z; auto. Qed.
 
 Lemma Z_mod_nz_opp_r : forall a b:Z, a mod b <> 0 ->
  a mod (-b) = (a mod b) - b.
-Proof.
-  intros.
-  pattern a at 1; rewrite <- (Zopp_involutive a).
-  rewrite Zmod_opp_opp.
-  rewrite Z_mod_nz_opp_full; auto; omega.
-Qed.
+Proof. intros. zero_or_not b. apply Z.mod_opp_r_nz; auto. Qed.
 
 Lemma Z_div_zero_opp_full : forall a b:Z, a mod b = 0 -> (-a)/b = -(a/b).
-Proof.
-  intros; destruct (Z_eq_dec b 0) as [Hb|Hb].
-  subst; do 2 rewrite Zdiv_0_r; auto.
-  symmetry; apply Zdiv_unique_full with 0; auto.
-  red; omega.
-  pattern a at 1; rewrite (Z_div_mod_eq_full a b Hb).
-  rewrite H; ring.
-Qed.
+Proof. intros. zero_or_not b. apply Z.div_opp_l_z; auto. Qed.
 
 Lemma Z_div_nz_opp_full : forall a b:Z, a mod b <> 0 ->
  (-a)/b = -(a/b)-1.
-Proof.
-  intros.
-  assert (b<>0) by (contradict H; subst; rewrite Zmod_0_r; auto).
-  symmetry; apply Zdiv_unique_full with (b-a mod b); auto.
-  generalize (Z_mod_remainder a b H0); destruct 1; [left|right]; omega.
-  pattern a at 1; rewrite (Z_div_mod_eq_full a b H0); ring.
-Qed.
+Proof. intros a b. zero_or_not b. intros; rewrite Z.div_opp_l_nz; auto. Qed.
 
 Lemma Z_div_zero_opp_r : forall a b:Z, a mod b = 0 -> a/(-b) = -(a/b).
-Proof.
-  intros.
-  pattern a at 1; rewrite <- (Zopp_involutive a).
-  rewrite Zdiv_opp_opp.
-  rewrite Z_div_zero_opp_full; auto.
-Qed.
+Proof. intros. zero_or_not b. apply Z.div_opp_r_z; auto. Qed.
 
 Lemma Z_div_nz_opp_r : forall a b:Z, a mod b <> 0 ->
  a/(-b) = -(a/b)-1.
-Proof.
-  intros.
-  pattern a at 1; rewrite <- (Zopp_involutive a).
-  rewrite Zdiv_opp_opp.
-  rewrite Z_div_nz_opp_full; auto; omega.
-Qed.
+Proof. intros a b. zero_or_not b. intros; rewrite Z.div_opp_r_nz; auto. Qed.
 
 (** Cancellations. *)
 
-Lemma Zdiv_mult_cancel_r : forall a b c:Z,
+Lemma  Zdiv_mult_cancel_r : forall a b c:Z,
  c <> 0 -> (a*c)/(b*c) = a/b.
-Proof.
-assert (X: forall a b c, b > 0 -> c > 0 -> (a*c) / (b*c) = a / b).
- intros a b c Hb Hc.
- symmetry.
- apply Zdiv_unique with ((a mod b)*c); auto with zarith.
- destruct (Z_mod_lt a b Hb); split.
- apply Zmult_le_0_compat; auto with zarith.
- apply Zmult_lt_compat_r; auto with zarith.
- pattern a at 1; rewrite (Z_div_mod_eq a b Hb); ring.
-intros a b c Hc.
-destruct (Z_dec b 0) as [Hb|Hb].
-destruct Hb as [Hb|Hb]; destruct (not_Zeq_inf _ _ Hc); auto with *.
-rewrite <- (Zdiv_opp_opp a), <- (Zmult_opp_opp b), <-(Zmult_opp_opp a);
- auto with *.
-rewrite <- (Zdiv_opp_opp a), <- Zdiv_opp_opp, Zopp_mult_distr_l,
- Zopp_mult_distr_l; auto with *.
-rewrite <- Zdiv_opp_opp, Zopp_mult_distr_r, Zopp_mult_distr_r; auto with *.
-rewrite Hb; simpl; do 2 rewrite Zdiv_0_r; auto.
-Qed.
+Proof. intros. zero_or_not b. apply Z.div_mul_cancel_r; auto. Qed.
 
 Lemma Zdiv_mult_cancel_l : forall a b c:Z,
  c<>0 -> (c*a)/(c*b) = a/b.
 Proof.
-  intros.
-  rewrite (Zmult_comm c a); rewrite (Zmult_comm c b).
-  apply Zdiv_mult_cancel_r; auto.
+ intros. rewrite (Z.mul_comm c b); zero_or_not b.
+ rewrite (Z.mul_comm b c). apply Z.div_mul_cancel_l; auto.
 Qed.
 
 Lemma Zmult_mod_distr_l: forall a b c,
   (c*a) mod (c*b) = c * (a mod b).
 Proof.
-  intros; destruct (Z_eq_dec c 0) as [Hc|Hc].
-  subst; simpl; rewrite Zmod_0_r; auto.
-  destruct (Z_eq_dec b 0) as [Hb|Hb].
-  subst; repeat rewrite Zmult_0_r || rewrite Zmod_0_r; auto.
-  assert (c*b <> 0).
-   contradict Hc; eapply Zmult_integral_l; eauto.
-  rewrite (Zplus_minus_eq _ _ _ (Z_div_mod_eq_full (c*a) (c*b) H)).
-  rewrite (Zplus_minus_eq _ _ _ (Z_div_mod_eq_full a b Hb)).
-  rewrite Zdiv_mult_cancel_l; auto with zarith.
-  ring.
+ intros. zero_or_not c. rewrite (Z.mul_comm c b); zero_or_not b.
+ rewrite (Z.mul_comm b c). apply Z.mul_mod_distr_l; auto.
 Qed.
 
 Lemma Zmult_mod_distr_r: forall a b c,
   (a*c) mod (b*c) = (a mod b) * c.
 Proof.
-  intros; repeat rewrite (fun x => (Zmult_comm x c)).
-  apply Zmult_mod_distr_l; auto.
+ intros. zero_or_not b. rewrite (Z.mul_comm b c); zero_or_not c.
+ rewrite (Z.mul_comm c b). apply Z.mul_mod_distr_r; auto.
 Qed.
 
 (** Operations modulo. *)
 
 Theorem Zmod_mod: forall a n, (a mod n) mod n = a mod n.
-Proof.
-  intros; destruct (Z_eq_dec n 0) as [Hb|Hb].
-  subst; do 2 rewrite Zmod_0_r; auto.
-  pattern a at 2; rewrite (Z_div_mod_eq_full a n); auto with zarith.
-  rewrite Zplus_comm; rewrite Zmult_comm.
-  apply sym_equal; apply Z_mod_plus_full; auto with zarith.
-Qed.
+Proof. intros. zero_or_not n. apply Z.mod_mod; auto. Qed.
 
 Theorem Zmult_mod: forall a b n,
  (a * b) mod n = ((a mod n) * (b mod n)) mod n.
-Proof.
-  intros; destruct (Z_eq_dec n 0) as [Hb|Hb].
-  subst; do 2 rewrite Zmod_0_r; auto.
-  pattern a at 1; rewrite (Z_div_mod_eq_full a n); auto with zarith.
-  pattern b at 1; rewrite (Z_div_mod_eq_full b n); auto with zarith.
-  set (A:=a mod n); set (B:=b mod n); set (A':=a/n); set (B':=b/n).
-  replace ((n*A' + A) * (n*B' + B))
-   with (A*B + (A'*B+B'*A+n*A'*B')*n) by ring.
-  apply Z_mod_plus_full; auto with zarith.
-Qed.
+Proof. intros. zero_or_not n. apply Z.mul_mod; auto. Qed.
 
 Theorem Zplus_mod: forall a b n,
  (a + b) mod n = (a mod n + b mod n) mod n.
-Proof.
-  intros; destruct (Z_eq_dec n 0) as [Hb|Hb].
-  subst; do 2 rewrite Zmod_0_r; auto.
-  pattern a at 1; rewrite (Z_div_mod_eq_full a n); auto with zarith.
-  pattern b at 1; rewrite (Z_div_mod_eq_full b n); auto with zarith.
-  replace ((n * (a / n) + a mod n) + (n * (b / n) + b mod n))
-     with ((a mod n + b mod n) + (a / n + b / n) * n) by ring.
-  apply Z_mod_plus_full; auto with zarith.
-Qed.
+Proof. intros. zero_or_not n. apply Z.add_mod; auto. Qed.
 
 Theorem Zminus_mod: forall a b n,
  (a - b) mod n = (a mod n - b mod n) mod n.
@@ -897,54 +443,53 @@ Qed.
 (** For a specific number N, equality modulo N is hence a nice setoid
    equivalence, compatible with [+], [-] and [*]. *)
 
-Definition eqm N a b := (a mod N = b mod N).
+Section EqualityModulo.
+Variable N:Z.
 
-Lemma eqm_refl N : forall a, (eqm N) a a.
+Definition eqm a b := (a mod N = b mod N).
+Infix "==" := eqm (at level 70).
+
+Lemma eqm_refl : forall a, a == a.
 Proof. unfold eqm; auto. Qed.
 
-Lemma eqm_sym N : forall a b, (eqm N) a b -> (eqm N) b a.
+Lemma eqm_sym : forall a b, a == b -> b == a.
 Proof. unfold eqm; auto. Qed.
 
-Lemma eqm_trans N : forall a b c,
-  (eqm N) a b -> (eqm N) b c -> (eqm N) a c.
+Lemma eqm_trans : forall a b c,
+  a == b -> b == c -> a == c.
 Proof. unfold eqm; eauto with *. Qed.
 
-Add Parametric Relation N : Z (eqm N)
-  reflexivity proved by (eqm_refl N)
-  symmetry proved by (eqm_sym N)
-  transitivity proved by (eqm_trans N) as eqm_setoid.
+Instance eqm_setoid : Equivalence eqm.
+Proof.
+ constructor; [exact eqm_refl | exact eqm_sym | exact eqm_trans].
+Qed.
 
-Add Parametric Morphism N : Zplus
-  with signature (eqm N) ==> (eqm N) ==> (eqm N) as Zplus_eqm.
+Instance Zplus_eqm : Proper (eqm ==> eqm ==> eqm) Z.add.
 Proof.
-  unfold eqm; intros; rewrite Zplus_mod, H, H0, <- Zplus_mod; auto.
+  unfold eqm; repeat red; intros. rewrite Zplus_mod, H, H0, <- Zplus_mod; auto.
 Qed.
 
-Add Parametric Morphism N : Zminus
-  with signature (eqm N) ==> (eqm N) ==> (eqm N) as Zminus_eqm.
+Instance Zminus_eqm : Proper (eqm ==> eqm ==> eqm) Z.sub.
 Proof.
-  unfold eqm; intros; rewrite Zminus_mod, H, H0, <- Zminus_mod; auto.
+  unfold eqm; repeat red; intros. rewrite Zminus_mod, H, H0, <- Zminus_mod; auto.
 Qed.
 
-Add Parametric Morphism N : Zmult
-  with signature (eqm N) ==> (eqm N) ==> (eqm N) as Zmult_eqm.
+Instance Zmult_eqm : Proper (eqm ==> eqm ==> eqm) Z.mul.
 Proof.
-  unfold eqm; intros; rewrite Zmult_mod, H, H0, <- Zmult_mod; auto.
+  unfold eqm; repeat red; intros. rewrite Zmult_mod, H, H0, <- Zmult_mod; auto.
 Qed.
 
-Add Parametric Morphism N : Zopp
-  with signature (eqm N) ==> (eqm N) as Zopp_eqm.
+Instance Zopp_eqm : Proper (eqm ==> eqm) Z.opp.
 Proof.
-  intros; change ((eqm N) (-x) (-y)) with ((eqm N) (0-x) (0-y)).
-  rewrite H; red; auto.
+  intros x y H. change ((-x)==(-y)) with ((0-x)==(0-y)). now rewrite H.
 Qed.
 
-Lemma Zmod_eqm N : forall a, (eqm N) (a mod N) a.
+Lemma Zmod_eqm : forall a, (a mod N) == a.
 Proof.
   intros; exact (Zmod_mod a N).
 Qed.
 
-(* NB: Zmod and Zdiv are not morphisms with respect to eqm.
+(* NB: Z.modulo and Z.div are not morphisms with respect to eqm.
     For instance, let (==) be (eqm 2). Then we have (3 == 1) but:
     ~ (3 mod 3 == 1 mod 3)
     ~ (1 mod 3 == 1 mod 1)
@@ -952,32 +497,12 @@ Qed.
     ~ (1/3 == 1/1)
 *)
 
+End EqualityModulo.
+
 Lemma Zdiv_Zdiv : forall a b c, 0<=b -> 0<=c -> (a/b)/c = a/(b*c).
 Proof.
-  intros a b c Hb Hc.
-  destruct (Zle_lt_or_eq _ _ Hb); [ | subst; rewrite Zdiv_0_r, Zdiv_0_r, Zdiv_0_l; auto].
-  destruct (Zle_lt_or_eq _ _ Hc); [ | subst; rewrite Zmult_0_r, Zdiv_0_r, Zdiv_0_r; auto].
-  pattern a at 2;rewrite (Z_div_mod_eq_full a b);auto with zarith.
-  pattern (a/b) at 2;rewrite (Z_div_mod_eq_full (a/b) c);auto with zarith.
-  replace (b * (c * (a / b / c) + (a / b) mod c) + a mod b) with
-    ((a / b / c)*(b * c)  + (b * ((a / b) mod c) + a mod b)) by ring.
-  rewrite Z_div_plus_full_l; auto with zarith.
-  rewrite (Zdiv_small (b * ((a / b) mod c) + a mod b)).
-  ring.
-  split.
-  apply Zplus_le_0_compat;auto with zarith.
-  apply Zmult_le_0_compat;auto with zarith.
-  destruct (Z_mod_lt (a/b) c);auto with zarith.
-  destruct (Z_mod_lt a b);auto with zarith.
-  apply Zle_lt_trans with (b * ((a / b) mod c) + (b-1)).
-  destruct (Z_mod_lt a b);auto with zarith.
-  apply Zle_lt_trans with (b * (c-1) + (b - 1)).
-  apply Zplus_le_compat;auto with zarith.
-  destruct (Z_mod_lt (a/b) c);auto with zarith.
-  replace (b * (c - 1) + (b - 1)) with (b*c-1);try ring;auto with zarith.
-  intro H1;
-  assert (H2: c <> 0) by auto with zarith;
-  rewrite (Zmult_integral_l _ _ H2 H1) in H; auto with zarith.
+ intros. zero_or_not b. rewrite Z.mul_comm. zero_or_not c.
+ rewrite Z.mul_comm. apply Z.div_div; auto with zarith.
 Qed.
 
 (** Unfortunately, the previous result isn't always true on negative numbers.
@@ -988,40 +513,40 @@ Qed.
 Theorem Zdiv_mult_le:
  forall a b c, 0<=a -> 0<=b -> 0<=c -> c*(a/b) <= (c*a)/b.
 Proof.
-  intros a b c H1 H2 H3.
-  destruct (Zle_lt_or_eq _ _ H2);
-   [ | subst; rewrite Zdiv_0_r, Zdiv_0_r, Zmult_0_r; auto].
-  case (Z_mod_lt a b); auto with zarith; intros Hu1 Hu2.
-  case (Z_mod_lt c b); auto with zarith; intros Hv1 Hv2.
-  apply Zmult_le_reg_r with b; auto with zarith.
-  rewrite <- Zmult_assoc.
-  replace (a / b * b) with (a - a mod b).
-  replace (c * a / b * b) with (c * a - (c * a) mod b).
-  rewrite Zmult_minus_distr_l.
-  unfold Zminus; apply Zplus_le_compat_l.
-  match goal with |- - ?X <= -?Y => assert (Y <= X); auto with zarith end.
-  apply Zle_trans with ((c mod b) * (a mod b)); auto with zarith.
-  rewrite Zmult_mod; auto with zarith.
-  apply (Zmod_le ((c mod b) * (a mod b)) b); auto with zarith.
-  apply Zmult_le_compat_r; auto with zarith.
-  apply (Zmod_le c b); auto.
-  pattern (c * a) at 1; rewrite (Z_div_mod_eq (c * a) b); try ring;
-    auto with zarith.
-  pattern a at 1; rewrite (Z_div_mod_eq a b); try ring; auto with zarith.
-Qed.
+ intros. zero_or_not b. apply Z.div_mul_le; auto with zarith. Qed.
 
-(** Zmod is related to divisibility (see more in Znumtheory) *)
+(** Z.modulo is related to divisibility (see more in Znumtheory) *)
 
 Lemma Zmod_divides : forall a b, b<>0 ->
  (a mod b = 0 <-> exists c, a = b*c).
 Proof.
- split; intros.
- exists (a/b).
- pattern a at 1; rewrite (Z_div_mod_eq_full a b); auto with zarith.
- destruct H0 as [c Hc].
- symmetry.
- apply Zmod_unique_full with c; auto with zarith.
- red; omega with *.
+ intros. rewrite Z.mod_divide; trivial.
+ split; intros (c,Hc); exists c; subst; auto with zarith.
+Qed.
+
+(** Particular case : dividing by 2 is related with parity *)
+
+Lemma Zdiv2_div : forall a, Z.div2 a = a/2.
+Proof Z.div2_div.
+
+Lemma Zmod_odd : forall a, a mod 2 = if Z.odd a then 1 else 0.
+Proof.
+ intros a. now rewrite <- Z.bit0_odd, <- Z.bit0_mod.
+Qed.
+
+Lemma Zmod_even : forall a, a mod 2 = if Z.even a then 0 else 1.
+Proof.
+ intros a. rewrite Zmod_odd, Zodd_even_bool. now destruct Z.even.
+Qed.
+
+Lemma Zodd_mod : forall a, Z.odd a = Zeq_bool (a mod 2) 1.
+Proof.
+ intros a. rewrite Zmod_odd. now destruct Z.odd.
+Qed.
+
+Lemma Zeven_mod : forall a, Z.even a = Zeq_bool (a mod 2) 0.
+Proof.
+ intros a. rewrite Zmod_even. now destruct Z.even.
 Qed.
 
 (** * Compatibility *)
@@ -1068,19 +593,19 @@ Proof.
   intros; apply Z_mod_zero_opp_full; auto with zarith.
 Qed.
 
-(** * A direct way to compute Zmod *)
+(** * A direct way to compute Z.modulo *)
 
 Fixpoint Zmod_POS (a : positive) (b : Z) : Z  :=
   match a with
    | xI a' =>
       let r := Zmod_POS a' b in
       let r' := (2 * r + 1) in
-      if Zgt_bool b r' then r' else (r' - b)
+      if r' <? b then r' else (r' - b)
    | xO a' =>
       let r := Zmod_POS a' b in
       let r' := (2 * r) in
-      if Zgt_bool b r' then r' else (r' - b)
-   | xH => if Zge_bool b 2 then 1 else 0
+      if r' <? b then r' else (r' - b)
+   | xH => if 2 <=? b then 1 else 0
   end.
 
 Definition Zmod' a b :=
@@ -1105,30 +630,28 @@ Definition Zmod' a b :=
   end.
 
 
-Theorem Zmod_POS_correct: forall a b, Zmod_POS a b = (snd (Zdiv_eucl_POS a b)).
+Theorem Zmod_POS_correct a b : Zmod_POS a b = snd (Z.pos_div_eucl a b).
 Proof.
-  intros a b; elim a; simpl; auto.
-  intros p Rec; rewrite  Rec.
-  case (Zdiv_eucl_POS p b); intros z1 z2; simpl; auto.
-  match goal with |- context [Zgt_bool _ ?X] => case (Zgt_bool b X) end; auto.
-  intros p Rec; rewrite  Rec.
-  case (Zdiv_eucl_POS p b); intros z1 z2; simpl; auto.
-  match goal with |- context [Zgt_bool _ ?X] => case (Zgt_bool b X) end; auto.
-  case (Zge_bool b 2); auto.
+  induction a as [a IH|a IH| ]; simpl; rewrite ?IH.
+  destruct (Z.pos_div_eucl a b) as (p,q); simpl;
+   case Z.ltb_spec; reflexivity.
+  destruct (Z.pos_div_eucl a b) as (p,q); simpl;
+   case Z.ltb_spec; reflexivity.
+  case Z.leb_spec; trivial.
 Qed.
 
-Theorem Zmod'_correct: forall a b, Zmod' a b = Zmod a b.
+Theorem Zmod'_correct: forall a b, Zmod' a b = a mod b.
 Proof.
-  intros a b; unfold Zmod; case a; simpl; auto.
+  intros a b; unfold Z.modulo; case a; simpl; auto.
   intros p; case b; simpl; auto.
   intros p1; refine (Zmod_POS_correct _ _); auto.
   intros p1; rewrite Zmod_POS_correct; auto.
-  case (Zdiv_eucl_POS p (Zpos p1)); simpl; intros z1 z2; case z2; auto.
+  case (Z.pos_div_eucl p (Zpos p1)); simpl; intros z1 z2; case z2; auto.
   intros p; case b; simpl; auto.
   intros p1; rewrite Zmod_POS_correct; auto.
-  case (Zdiv_eucl_POS p (Zpos p1)); simpl; intros z1 z2; case z2; auto.
+  case (Z.pos_div_eucl p (Zpos p1)); simpl; intros z1 z2; case z2; auto.
   intros p1; rewrite Zmod_POS_correct; simpl; auto.
-  case (Zdiv_eucl_POS p (Zpos p1)); auto.
+  case (Z.pos_div_eucl p (Zpos p1)); auto.
 Qed.
 
 
@@ -1140,30 +663,46 @@ Theorem Zdiv_eucl_extended :
   forall b:Z,
     b <> 0 ->
     forall a:Z,
-      {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Zabs b}.
+      {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Z.abs b}.
 Proof.
   intros b Hb a.
   elim (Z_le_gt_dec 0 b); intro Hb'.
   cut (b > 0); [ intro Hb'' | omega ].
-  rewrite Zabs_eq; [ apply Zdiv_eucl_exist; assumption | assumption ].
+  rewrite Z.abs_eq; [ apply Zdiv_eucl_exist; assumption | assumption ].
   cut (- b > 0); [ intro Hb'' | omega ].
   elim (Zdiv_eucl_exist Hb'' a); intros qr.
   elim qr; intros q r Hqr.
   exists (- q, r).
   elim Hqr; intros.
   split.
-  rewrite <- Zmult_opp_comm; assumption.
-  rewrite Zabs_non_eq; [ assumption | omega ].
+  rewrite <- Z.mul_opp_comm; assumption.
+  rewrite Z.abs_neq; [ assumption | omega ].
 Qed.
 
-Implicit Arguments Zdiv_eucl_extended.
+Arguments Zdiv_eucl_extended : default implicits.
 
-(** A third convention: Ocaml.
+(** * Division and modulo in Z agree with same in nat: *)
 
-     See files ZOdiv_def.v and ZOdiv.v.
+Require Import NPeano.
 
-     Ocaml uses Round-Toward-Zero division: (-a)/b = a/(-b) = -(a/b).
-     Hence (-a) mod b = - (a mod b)
-           a mod (-b) = a mod b
-     And: |r| < |b| and sgn(r) = sgn(a)  (notice the a here instead of b).
-*)
+Lemma div_Zdiv (n m: nat): m <> O ->
+  Z.of_nat (n / m) = Z.of_nat n / Z.of_nat m.
+Proof.
+ intros.
+ apply (Zdiv_unique _ _ _ (Z.of_nat (n mod m))).
+  split. auto with zarith.
+  now apply inj_lt, Nat.mod_upper_bound.
+ rewrite <- Nat2Z.inj_mul, <- Nat2Z.inj_add.
+ now apply inj_eq, Nat.div_mod.
+Qed.
+
+Lemma mod_Zmod (n m: nat): m <> O ->
+  Z.of_nat (n mod m) = (Z.of_nat n) mod (Z.of_nat m).
+Proof.
+ intros.
+ apply (Zmod_unique _ _ (Z.of_nat n / Z.of_nat m)).
+  split. auto with zarith.
+  now apply inj_lt, Nat.mod_upper_bound.
+ rewrite <- div_Zdiv, <- Nat2Z.inj_mul, <- Nat2Z.inj_add by trivial.
+ now apply inj_eq, Nat.div_mod.
+Qed.
diff --git a/theories/ZArith/Zeuclid.v b/theories/ZArith/Zeuclid.v
new file mode 100644
index 00000000..1dfe2fb3
--- /dev/null
+++ b/theories/ZArith/Zeuclid.v
@@ -0,0 +1,52 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Morphisms BinInt ZDivEucl.
+Local Open Scope Z_scope.
+
+(** * Definitions of division for binary integers, Euclid convention. *)
+
+(** In this convention, the remainder is always positive.
+    For other conventions, see [Z.div] and [Z.quot] in file [BinIntDef].
+    To avoid collision with the other divisions, we place this one
+    under a module.
+*)
+
+Module ZEuclid.
+
+ Definition modulo a b := Z.modulo a (Z.abs b).
+ Definition div a b := (Z.sgn b) * (Z.div a (Z.abs b)).
+
+ Instance mod_wd : Proper (eq==>eq==>eq) modulo.
+ Proof. congruence. Qed.
+ Instance div_wd : Proper (eq==>eq==>eq) div.
+ Proof. congruence. Qed.
+
+ Theorem div_mod a b : b<>0 -> a = b*(div a b) + modulo a b.
+ Proof.
+  intros Hb. unfold div, modulo.
+  rewrite Z.mul_assoc. rewrite Z.sgn_abs. apply Z.div_mod.
+  now destruct b.
+ Qed.
+
+ Lemma mod_always_pos a b : b<>0 -> 0 <= modulo a b < Z.abs b.
+ Proof.
+  intros Hb. unfold modulo.
+  apply Z.mod_pos_bound.
+  destruct b; compute; trivial. now destruct Hb.
+ Qed.
+
+ Lemma mod_bound_pos a b : 0<=a -> 0<b -> 0 <= modulo a b < b.
+ Proof.
+  intros _ Hb. rewrite <- (Z.abs_eq b) at 3 by Z.order.
+  apply mod_always_pos. Z.order.
+ Qed.
+
+ Include ZEuclidProp Z Z Z.
+
+End ZEuclid.
diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v
index 883b7f15..dd48e84f 100644
--- a/theories/ZArith/Zeven.v
+++ b/theories/ZArith/Zeven.v
@@ -1,22 +1,25 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zeven.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(** Binary Integers : Parity and Division by Two *)
+(** Initial author : Pierre Crégut (CNET, Lannion, France) *)
+
+(** THIS FILE IS DEPRECATED.
+    It is now almost entirely made of compatibility formulations
+    for results already present in BinInt.Z. *)
 
 Require Import BinInt.
 
 Open Scope Z_scope.
 
-(*******************************************************************)
-(** About parity: even and odd predicates on Z, division by 2 on Z *)
-
-(***************************************************)
-(** * [Zeven], [Zodd] and their related properties *)
+(** Historical formulation of even and odd predicates, based on
+    case analysis. We now rather recommend using [Z.Even] and
+    [Z.Odd], which are based on the exist predicate. *)
 
 Definition Zeven (z:Z) :=
   match z with
@@ -35,281 +38,251 @@ Definition Zodd (z:Z) :=
     | _ => False
   end.
 
-Definition Zeven_bool (z:Z) :=
-  match z with
-    | Z0 => true
-    | Zpos (xO _) => true
-    | Zneg (xO _) => true
-    | _ => false
-  end.
+Lemma Zeven_equiv z : Zeven z <-> Z.Even z.
+Proof.
+ rewrite <- Z.even_spec.
+ destruct z as [|p|p]; try destruct p; simpl; intuition.
+Qed.
 
-Definition Zodd_bool (z:Z) :=
-  match z with
-    | Z0 => false
-    | Zpos (xO _) => false
-    | Zneg (xO _) => false
-    | _ => true
-  end.
+Lemma Zodd_equiv z : Zodd z <-> Z.Odd z.
+Proof.
+ rewrite <- Z.odd_spec.
+ destruct z as [|p|p]; try destruct p; simpl; intuition.
+Qed.
+
+Theorem Zeven_ex_iff n : Zeven n <-> exists m, n = 2*m.
+Proof (Zeven_equiv n).
+
+Theorem Zodd_ex_iff n : Zodd n <-> exists m, n = 2*m + 1.
+Proof (Zodd_equiv n).
+
+(** Boolean tests of parity (now in BinInt.Z) *)
+
+Notation Zeven_bool := Z.even (compat "8.3").
+Notation Zodd_bool := Z.odd (compat "8.3").
+
+Lemma Zeven_bool_iff n : Z.even n = true <-> Zeven n.
+Proof.
+ now rewrite Z.even_spec, Zeven_equiv.
+Qed.
+
+Lemma Zodd_bool_iff n : Z.odd n = true <-> Zodd n.
+Proof.
+ now rewrite Z.odd_spec, Zodd_equiv.
+Qed.
+
+Ltac boolify_even_odd := rewrite <- ?Zeven_bool_iff, <- ?Zodd_bool_iff.
+
+Lemma Zodd_even_bool n : Z.odd n = negb (Z.even n).
+Proof.
+ symmetry. apply Z.negb_even.
+Qed.
+
+Lemma Zeven_odd_bool n : Z.even n = negb (Z.odd n).
+Proof.
+ symmetry. apply Z.negb_odd.
+Qed.
 
-Definition Zeven_odd_dec : forall z:Z, {Zeven z} + {Zodd z}.
+Definition Zeven_odd_dec n : {Zeven n} + {Zodd n}.
 Proof.
-  intro z. case z;
-  [ left; compute in |- *; trivial
-    | intro p; case p; intros;
-      (right; compute in |- *; exact I) || (left; compute in |- *; exact I)
-    | intro p; case p; intros;
-      (right; compute in |- *; exact I) || (left; compute in |- *; exact I) ].
+ destruct n as [|p|p]; try destruct p; simpl; (now left) || (now right).
 Defined.
 
-Definition Zeven_dec : forall z:Z, {Zeven z} + {~ Zeven z}.
+Definition Zeven_dec n : {Zeven n} + {~ Zeven n}.
 Proof.
-  intro z. case z;
-  [ left; compute in |- *; trivial
-    | intro p; case p; intros;
-      (left; compute in |- *; exact I) || (right; compute in |- *; trivial)
-    | intro p; case p; intros;
-      (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ].
+ destruct n as [|p|p]; try destruct p; simpl; (now left) || (now right).
 Defined.
 
-Definition Zodd_dec : forall z:Z, {Zodd z} + {~ Zodd z}.
+Definition Zodd_dec n : {Zodd n} + {~ Zodd n}.
 Proof.
-  intro z. case z;
-  [ right; compute in |- *; trivial
-    | intro p; case p; intros;
-      (left; compute in |- *; exact I) || (right; compute in |- *; trivial)
-    | intro p; case p; intros;
-      (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ].
+ destruct n as [|p|p]; try destruct p; simpl; (now left) || (now right).
 Defined.
 
-Lemma Zeven_not_Zodd : forall n:Z, Zeven n -> ~ Zodd n.
+Lemma Zeven_not_Zodd n : Zeven n -> ~ Zodd n.
 Proof.
-  intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *;
-    trivial.
+ boolify_even_odd. rewrite <- Z.negb_odd. destruct Z.odd; intuition.
 Qed.
 
-Lemma Zodd_not_Zeven : forall n:Z, Zodd n -> ~ Zeven n.
+Lemma Zodd_not_Zeven n : Zodd n -> ~ Zeven n.
 Proof.
-  intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *;
-    trivial.
+ boolify_even_odd. rewrite <- Z.negb_odd. destruct Z.odd; intuition.
 Qed.
 
-Lemma Zeven_Sn : forall n:Z, Zodd n -> Zeven (Zsucc n).
+Lemma Zeven_Sn n : Zodd n -> Zeven (Z.succ n).
 Proof.
-  intro z; destruct z; unfold Zsucc in |- *;
-    [ idtac | destruct p | destruct p ]; simpl in |- *;
-      trivial.
-  unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
+ boolify_even_odd. now rewrite Z.even_succ.
 Qed.
 
-Lemma Zodd_Sn : forall n:Z, Zeven n -> Zodd (Zsucc n).
+Lemma Zodd_Sn n : Zeven n -> Zodd (Z.succ n).
 Proof.
-  intro z; destruct z; unfold Zsucc in |- *;
-    [ idtac | destruct p | destruct p ]; simpl in |- *;
-      trivial.
-  unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
+ boolify_even_odd. now rewrite Z.odd_succ.
 Qed.
 
-Lemma Zeven_pred : forall n:Z, Zodd n -> Zeven (Zpred n).
+Lemma Zeven_pred n : Zodd n -> Zeven (Z.pred n).
 Proof.
-  intro z; destruct z; unfold Zpred in |- *;
-    [ idtac | destruct p | destruct p ]; simpl in |- *;
-      trivial.
-  unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
+ boolify_even_odd. now rewrite Z.even_pred.
 Qed.
 
-Lemma Zodd_pred : forall n:Z, Zeven n -> Zodd (Zpred n).
+Lemma Zodd_pred n : Zeven n -> Zodd (Z.pred n).
 Proof.
-  intro z; destruct z; unfold Zpred in |- *;
-    [ idtac | destruct p | destruct p ]; simpl in |- *;
-      trivial.
-  unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
+ boolify_even_odd. now rewrite Z.odd_pred.
 Qed.
 
 Hint Unfold Zeven Zodd: zarith.
 
+Notation Zeven_bool_succ := Z.even_succ (compat "8.3").
+Notation Zeven_bool_pred := Z.even_pred (compat "8.3").
+Notation Zodd_bool_succ := Z.odd_succ (compat "8.3").
+Notation Zodd_bool_pred := Z.odd_pred (compat "8.3").
 
 (******************************************************************)
-(** * Definition of [Zdiv2] and properties wrt [Zeven] and [Zodd] *)
+(** * Definition of [Z.quot2], [Z.div2] and properties wrt [Zeven]
+  and [Zodd] *)
 
-(** [Zdiv2] is defined on all [Z], but notice that for odd negative
-    integers it is not the euclidean quotient: in that case we have
-      [n = 2*(n/2)-1] *)
+Notation Zdiv2 := Z.div2 (compat "8.3").
+Notation Zquot2 := Z.quot2 (compat "8.3").
 
-Definition Zdiv2 (z:Z) :=
-  match z with
-    | Z0 => 0
-    | Zpos xH => 0
-    | Zpos p => Zpos (Pdiv2 p)
-    | Zneg xH => 0
-    | Zneg p => Zneg (Pdiv2 p)
-  end.
+(** Properties of [Z.div2] *)
 
-Lemma Zeven_div2 : forall n:Z, Zeven n -> n = 2 * Zdiv2 n.
+Lemma Zdiv2_odd_eqn n : n = 2*(Z.div2 n) + if Z.odd n then 1 else 0.
+Proof (Z.div2_odd n).
+
+Lemma Zeven_div2 n : Zeven n -> n = 2 * Z.div2 n.
 Proof.
-  intro x; destruct x.
-  auto with arith.
-  destruct p; auto with arith.
-  intros. absurd (Zeven (Zpos (xI p))); red in |- *; auto with arith.
-  intros. absurd (Zeven 1); red in |- *; auto with arith.
-  destruct p; auto with arith.
-  intros. absurd (Zeven (Zneg (xI p))); red in |- *; auto with arith.
-  intros. absurd (Zeven (-1)); red in |- *; auto with arith.
+ boolify_even_odd. rewrite <- Z.negb_odd, Bool.negb_true_iff.
+ intros Hn. rewrite (Zdiv2_odd_eqn n) at 1. now rewrite Hn, Z.add_0_r.
 Qed.
 
-Lemma Zodd_div2 : forall n:Z, n >= 0 -> Zodd n -> n = 2 * Zdiv2 n + 1.
+Lemma Zodd_div2 n : Zodd n -> n = 2 * Z.div2 n + 1.
 Proof.
-  intro x; destruct x.
-  intros. absurd (Zodd 0); red in |- *; auto with arith.
-  destruct p; auto with arith.
-  intros. absurd (Zodd (Zpos (xO p))); red in |- *; auto with arith.
-  intros. absurd (Zneg p >= 0); red in |- *; auto with arith.
+ boolify_even_odd.
+ intros Hn. rewrite (Zdiv2_odd_eqn n) at 1. now rewrite Hn.
 Qed.
 
-Lemma Zodd_div2_neg :
-  forall n:Z, n <= 0 -> Zodd n -> n = 2 * Zdiv2 n - 1.
+(** Properties of [Z.quot2] *)
+
+(** TODO: move to Numbers someday *)
+
+Lemma Zquot2_odd_eqn n : n = 2*(Z.quot2 n) + if Z.odd n then Z.sgn n else 0.
 Proof.
-  intro x; destruct x.
-  intros. absurd (Zodd 0); red in |- *; auto with arith.
-  intros. absurd (Zneg p >= 0); red in |- *; auto with arith.
-  destruct p; auto with arith.
-  intros. absurd (Zodd (Zneg (xO p))); red in |- *; auto with arith.
+ now destruct n as [ |[p|p| ]|[p|p| ]].
 Qed.
 
-Lemma Z_modulo_2 :
-  forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}.
+Lemma Zeven_quot2 n : Zeven n -> n = 2 * Z.quot2 n.
 Proof.
-  intros x.
-  elim (Zeven_odd_dec x); intro.
-  left. split with (Zdiv2 x). exact (Zeven_div2 x a).
-  right. generalize b; clear b; case x.
-  intro b; inversion b.
-  intro p; split with (Zdiv2 (Zpos p)). apply (Zodd_div2 (Zpos p)); trivial.
-  unfold Zge, Zcompare in |- *; simpl in |- *; discriminate.
-  intro p; split with (Zdiv2 (Zpred (Zneg p))).
-  pattern (Zneg p) at 1 in |- *; rewrite (Zsucc_pred (Zneg p)).
-  pattern (Zpred (Zneg p)) at 1 in |- *; rewrite (Zeven_div2 (Zpred (Zneg p))).
-  reflexivity.
-  apply Zeven_pred; assumption.
+ intros Hn. apply Zeven_bool_iff in Hn.
+ rewrite (Zquot2_odd_eqn n) at 1.
+ now rewrite Zodd_even_bool, Hn, Z.add_0_r.
 Qed.
 
-Lemma Zsplit2 :
-  forall n:Z,
-    {p : Z * Z |
-      let (x1, x2) := p in n = x1 + x2 /\ (x1 = x2 \/ x2 = x1 + 1)}.
+Lemma Zodd_quot2 n : n >= 0 -> Zodd n -> n = 2 * Z.quot2 n + 1.
 Proof.
-  intros x.
-  elim (Z_modulo_2 x); intros [y Hy]; rewrite Zmult_comm in Hy;
-    rewrite <- Zplus_diag_eq_mult_2 in Hy.
-  exists (y, y); split.
-  assumption.
-  left; reflexivity.
-  exists (y, (y + 1)%Z); split.
-  rewrite Zplus_assoc; assumption.
-  right; reflexivity.
+ intros Hn Hn'. apply Zodd_bool_iff in Hn'.
+ rewrite (Zquot2_odd_eqn n) at 1. rewrite Hn'. f_equal.
+ destruct n; (now destruct Hn) || easy.
 Qed.
 
+Lemma Zodd_quot2_neg n : n <= 0 -> Zodd n -> n = 2 * Z.quot2 n - 1.
+Proof.
+ intros Hn Hn'. apply Zodd_bool_iff in Hn'.
+ rewrite (Zquot2_odd_eqn n) at 1; rewrite Hn'. unfold Z.sub. f_equal.
+ destruct n; (now destruct Hn) || easy.
+Qed.
 
-Theorem Zeven_ex: forall n, Zeven n -> exists m, n = 2 * m.
+Lemma Zquot2_opp n : Z.quot2 (-n) = - Z.quot2 n.
 Proof.
-  intro n; exists (Zdiv2 n); apply Zeven_div2; auto.
+ now destruct n as [ |[p|p| ]|[p|p| ]].
 Qed.
 
-Theorem Zodd_ex: forall n, Zodd n -> exists m, n = 2 * m + 1.
+Lemma Zquot2_quot n : Z.quot2 n = n ÷ 2.
 Proof.
-  destruct n; intros.
-  inversion H.
-  exists (Zdiv2 (Zpos p)).
-  apply Zodd_div2; simpl; auto; compute; inversion 1.
-  exists (Zdiv2 (Zneg p) - 1).
-  unfold Zminus.
-  rewrite Zmult_plus_distr_r.
-  rewrite <- Zplus_assoc.
-  assert (Zneg p <= 0) by (compute; inversion 1).
-  exact (Zodd_div2_neg _ H0 H).
+ assert (AUX : forall m, 0 < m -> Z.quot2 m = m ÷ 2).
+ { intros m Hm.
+   apply Z.quot_unique with (if Z.odd m then Z.sgn m else 0).
+   now apply Z.lt_le_incl.
+   rewrite Z.sgn_pos by trivial.
+   destruct (Z.odd m); now split.
+   apply Zquot2_odd_eqn. }
+ destruct (Z.lt_trichotomy 0 n) as [POS|[NUL|NEG]].
+ - now apply AUX.
+ - now subst.
+ - apply Z.opp_inj. rewrite <- Z.quot_opp_l, <- Zquot2_opp.
+   apply AUX. now destruct n. easy.
 Qed.
 
-Theorem Zeven_2p: forall p, Zeven (2 * p).
+(** More properties of parity *)
+
+Lemma Z_modulo_2 n : {y | n = 2 * y} + {y | n = 2 * y + 1}.
 Proof.
-  destruct p; simpl; auto.
+ destruct (Zeven_odd_dec n) as [Hn|Hn].
+ - left. exists (Z.div2 n). exact (Zeven_div2 n Hn).
+ - right. exists (Z.div2 n). exact (Zodd_div2 n Hn).
 Qed.
 
-Theorem Zodd_2p_plus_1: forall p, Zodd (2 * p + 1).
+Lemma Zsplit2 n :
+ {p : Z * Z | let (x1, x2) := p in n = x1 + x2 /\ (x1 = x2 \/ x2 = x1 + 1)}.
 Proof.
-  destruct p; simpl; auto.
-  destruct p; simpl; auto.
+ destruct (Z_modulo_2 n) as [(y,Hy)|(y,Hy)];
+  rewrite <- Z.add_diag in Hy.
+ - exists (y, y). split. assumption. now left.
+ - exists (y, y + 1). split. now rewrite Z.add_assoc. now right.
 Qed.
 
-Theorem Zeven_plus_Zodd: forall a b,
- Zeven a -> Zodd b -> Zodd (a + b).
+Theorem Zeven_ex n : Zeven n -> exists m, n = 2 * m.
 Proof.
-  intros a b H1 H2; case Zeven_ex with (1 := H1); intros x H3; try rewrite H3; auto.
-  case Zodd_ex with (1 := H2); intros y H4; try rewrite H4; auto.
-  replace (2 * x + (2 * y + 1)) with (2 * (x + y) + 1); try apply Zodd_2p_plus_1; auto with zarith.
-  rewrite Zmult_plus_distr_r, Zplus_assoc; auto.
+ exists (Z.div2 n); apply Zeven_div2; auto.
 Qed.
 
-Theorem Zeven_plus_Zeven: forall a b,
- Zeven a -> Zeven b -> Zeven (a + b).
+Theorem Zodd_ex n : Zodd n -> exists m, n = 2 * m + 1.
 Proof.
-  intros a b H1 H2; case Zeven_ex with (1 := H1); intros x H3; try rewrite H3; auto.
-  case Zeven_ex with (1 := H2); intros y H4; try rewrite H4; auto.
-  replace (2 * x + 2 * y) with (2 * (x + y)); try apply Zeven_2p; auto with zarith.
-  apply Zmult_plus_distr_r; auto.
+ exists (Z.div2 n); apply Zodd_div2; auto.
 Qed.
 
-Theorem Zodd_plus_Zeven: forall a b,
- Zodd a -> Zeven b -> Zodd (a + b).
+Theorem Zeven_2p p : Zeven (2 * p).
 Proof.
-  intros a b H1 H2; rewrite Zplus_comm; apply Zeven_plus_Zodd; auto.
+ now destruct p.
 Qed.
 
-Theorem Zodd_plus_Zodd: forall a b,
- Zodd a -> Zodd b -> Zeven (a + b).
+Theorem Zodd_2p_plus_1 p : Zodd (2 * p + 1).
 Proof.
-  intros a b H1 H2; case Zodd_ex with (1 := H1); intros x H3; try rewrite H3; auto.
-  case Zodd_ex with (1 := H2); intros y H4; try rewrite H4; auto.
-  replace ((2 * x + 1) + (2 * y + 1)) with (2 * (x + y + 1)); try apply Zeven_2p; auto.
-  (* ring part *)
-  do 2 rewrite Zmult_plus_distr_r; auto.
-  repeat rewrite <- Zplus_assoc; f_equal.
-  rewrite (Zplus_comm 1).
-  repeat rewrite <- Zplus_assoc; auto.
+ destruct p as [|p|p]; now try destruct p.
 Qed.
 
-Theorem Zeven_mult_Zeven_l: forall a b,
- Zeven a -> Zeven (a * b).
+Theorem Zeven_plus_Zodd a b : Zeven a -> Zodd b -> Zodd (a + b).
 Proof.
-  intros a b H1; case Zeven_ex with (1 := H1); intros x H3; try rewrite H3; auto.
-  replace (2 * x * b) with (2 * (x * b)); try apply Zeven_2p; auto with zarith.
-  (* ring part *)
-  apply Zmult_assoc.
+ boolify_even_odd. rewrite <- Z.negb_odd, Bool.negb_true_iff.
+ intros Ha Hb. now rewrite Z.odd_add, Ha, Hb.
 Qed.
 
-Theorem Zeven_mult_Zeven_r: forall a b,
- Zeven b -> Zeven (a * b).
+Theorem Zeven_plus_Zeven a b : Zeven a -> Zeven b -> Zeven (a + b).
 Proof.
-  intros a b H1; case Zeven_ex with (1 := H1); intros x H3; try rewrite H3; auto.
-  replace (a * (2 * x)) with (2 * (x * a)); try apply Zeven_2p; auto.
-  (* ring part *)
-  rewrite (Zmult_comm x a).
-  do 2 rewrite Zmult_assoc.
-  rewrite (Zmult_comm 2 a); auto.
+ boolify_even_odd. intros Ha Hb. now rewrite Z.even_add, Ha, Hb.
 Qed.
 
-Hint Rewrite Zmult_plus_distr_r Zmult_plus_distr_l
-     Zplus_assoc Zmult_1_r Zmult_1_l : Zexpand.
+Theorem Zodd_plus_Zeven a b : Zodd a -> Zeven b -> Zodd (a + b).
+Proof.
+ intros. rewrite Z.add_comm. now apply Zeven_plus_Zodd.
+Qed.
+
+Theorem Zodd_plus_Zodd a b : Zodd a -> Zodd b -> Zeven (a + b).
+Proof.
+ boolify_even_odd. rewrite <- 2 Z.negb_even, 2 Bool.negb_true_iff.
+ intros Ha Hb. now rewrite Z.even_add, Ha, Hb.
+Qed.
+
+Theorem Zeven_mult_Zeven_l a b : Zeven a -> Zeven (a * b).
+Proof.
+ boolify_even_odd. intros Ha. now rewrite Z.even_mul, Ha.
+Qed.
+
+Theorem Zeven_mult_Zeven_r a b : Zeven b -> Zeven (a * b).
+Proof.
+ intros. rewrite Z.mul_comm. now apply Zeven_mult_Zeven_l.
+Qed.
 
-Theorem Zodd_mult_Zodd: forall a b,
- Zodd a -> Zodd b -> Zodd (a * b).
+Theorem Zodd_mult_Zodd a b : Zodd a -> Zodd b -> Zodd (a * b).
 Proof.
-  intros a b H1 H2; case Zodd_ex with (1 := H1); intros x H3; try rewrite H3; auto.
-  case Zodd_ex with (1 := H2); intros y H4; try rewrite H4; auto.
-  replace ((2 * x + 1) * (2 * y + 1)) with (2 * (2 * x * y + x + y) + 1); try apply Zodd_2p_plus_1; auto.
-  (* ring part *)
-  autorewrite with Zexpand; f_equal.
-  repeat rewrite <- Zplus_assoc; f_equal.
-  repeat rewrite <- Zmult_assoc; f_equal.
-  repeat rewrite Zmult_assoc; f_equal; apply Zmult_comm.
+ boolify_even_odd. intros Ha Hb. now rewrite Z.odd_mul, Ha, Hb.
 Qed.
 
 (* for compatibility *)
diff --git a/theories/ZArith/Zgcd_alt.v b/theories/ZArith/Zgcd_alt.v
index 86fe0ef9..40d2b129 100644
--- a/theories/ZArith/Zgcd_alt.v
+++ b/theories/ZArith/Zgcd_alt.v
@@ -1,23 +1,21 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zgcd_alt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-(** * Zgcd_alt : an alternate version of Zgcd, based on Euler's algorithm *)
+(** * Zgcd_alt : an alternate version of Z.gcd, based on Euclid's algorithm *)
 
 (**
 Author: Pierre Letouzey
 *)
 
-(** The alternate [Zgcd_alt] given here used to be the main [Zgcd]
-    function (see file [Znumtheory]), but this main [Zgcd] is now
+(** The alternate [Zgcd_alt] given here used to be the main [Z.gcd]
+    function (see file [Znumtheory]), but this main [Z.gcd] is now
     based on a modern binary-efficient algorithm. This earlier
-    version, based on Euler's algorithm of iterated modulo, is kept
+    version, based on Euclid's algorithm of iterated modulo, is kept
     here due to both its intrinsic interest and its use as reference
     point when proving gcd on Int31 numbers *)
 
@@ -37,22 +35,22 @@ Open Scope Z_scope.
    match n with
      | O => 1 (* arbitrary, since n should be big enough *)
      | S n => match a with
-  	        | Z0 => Zabs b
-  	        | Zpos _ => Zgcdn n (Zmod b a) a
-  	        | Zneg a => Zgcdn n (Zmod b (Zpos a)) (Zpos a)
+	        | Z0 => Z.abs b
+	        | Zpos _ => Zgcdn n (Z.modulo b a) a
+	        | Zneg a => Zgcdn n (Z.modulo b (Zpos a)) (Zpos a)
   	      end
    end.
 
  Definition Zgcd_bound (a:Z) :=
    match a with
      | Z0 => S O
-     | Zpos p => let n := Psize p in (n+n)%nat
-     | Zneg p => let n := Psize p in (n+n)%nat
+     | Zpos p => let n := Pos.size_nat p in (n+n)%nat
+     | Zneg p => let n := Pos.size_nat p in (n+n)%nat
    end.
 
  Definition Zgcd_alt a b := Zgcdn (Zgcd_bound a) a b.
 
- (** A first obvious fact : [Zgcd a b] is positive. *)
+ (** A first obvious fact : [Z.gcd a b] is positive. *)
 
  Lemma Zgcdn_pos : forall n a b,
    0 <= Zgcdn n a b.
@@ -64,28 +62,28 @@ Open Scope Z_scope.
 
  Lemma Zgcd_alt_pos : forall a b, 0 <= Zgcd_alt a b.
  Proof.
-   intros; unfold Zgcd; apply Zgcdn_pos; auto.
+   intros; unfold Z.gcd; apply Zgcdn_pos; auto.
  Qed.
 
- (** We now prove that Zgcd is indeed a gcd. *)
+ (** We now prove that Z.gcd is indeed a gcd. *)
 
  (** 1) We prove a weaker & easier bound. *)
 
  Lemma Zgcdn_linear_bound : forall n a b,
-   Zabs a < Z_of_nat n -> Zis_gcd a b (Zgcdn n a b).
+   Z.abs a < Z.of_nat n -> Zis_gcd a b (Zgcdn n a b).
  Proof.
    induction n.
    simpl; intros.
-   exfalso; generalize (Zabs_pos a); omega.
+   exfalso; generalize (Z.abs_nonneg a); omega.
    destruct a; intros; simpl;
      [ generalize (Zis_gcd_0_abs b); intuition | | ];
-   unfold Zmod;
-   generalize (Z_div_mod b (Zpos p) (refl_equal Gt));
-   destruct (Zdiv_eucl b (Zpos p)) as (q,r);
+   unfold Z.modulo;
+   generalize (Z_div_mod b (Zpos p) (eq_refl Gt));
+   destruct (Z.div_eucl b (Zpos p)) as (q,r);
    intros (H0,H1);
-   rewrite inj_S in H; simpl Zabs in H;
-   (assert (H2: Zabs r < Z_of_nat n) by
-    (rewrite Zabs_eq; auto with zarith));
+   rewrite Nat2Z.inj_succ in H; simpl Z.abs in H;
+   (assert (H2: Z.abs r < Z.of_nat n) by
+    (rewrite Z.abs_eq; auto with zarith));
     assert (IH:=IHn r (Zpos p) H2); clear IHn;
     simpl in IH |- *;
     rewrite H0.
@@ -124,7 +122,7 @@ Open Scope Z_scope.
  Proof.
    induction 1.
    auto with zarith.
-   apply Zle_trans with (fibonacci m); auto.
+   apply Z.le_trans with (fibonacci m); auto.
    clear.
    destruct m.
    simpl; auto with zarith.
@@ -144,53 +142,38 @@ Open Scope Z_scope.
    fibonacci (S (S n)) <= b.
  Proof.
    induction n.
-   simpl; intros.
-   destruct a; omega.
-   intros.
-   destruct a; [simpl in *; omega| | destruct H; discriminate].
-   revert H1; revert H0.
-   set (m:=S n) in *; (assert (m=S n) by auto); clearbody m.
-   pattern m at 2; rewrite H0.
-   simpl Zgcdn.
-   unfold Zmod; generalize (Z_div_mod b (Zpos p) (refl_equal Gt)).
-   destruct (Zdiv_eucl b (Zpos p)) as (q,r).
-   intros (H1,H2).
-   destruct H2.
-   destruct (Zle_lt_or_eq _ _ H2).
-   generalize (IHn _ _ (conj H4 H3)).
-   intros H5 H6 H7.
-   replace (fibonacci (S (S m))) with (fibonacci (S m) + fibonacci m) by auto.
-   assert (r = Zpos p * (-q) + b) by (rewrite H1; ring).
-   destruct H5; auto.
-   pattern r at 1; rewrite H8.
-   apply Zis_gcd_sym.
-   apply Zis_gcd_for_euclid2; auto.
-   apply Zis_gcd_sym; auto.
-   split; auto.
-   rewrite H1.
-   apply Zplus_le_compat; auto.
-   apply Zle_trans with (Zpos p * 1); auto.
-   ring_simplify (Zpos p * 1); auto.
-   apply Zmult_le_compat_l.
-   destruct q.
-   omega.
-   assert (0 < Zpos p0) by (compute; auto).
-   omega.
-   assert (Zpos p * Zneg p0 < 0) by (compute; auto).
-   omega.
-   compute; intros; discriminate.
-   (* r=0 *)
-   subst r.
-   simpl; rewrite H0.
-   intros.
-   simpl in H4.
-   simpl in H5.
-   destruct n.
-   simpl in H5.
-   simpl.
-   omega.
-   simpl in H5.
-   elim H5; auto.
+   intros [|a|a]; intros; simpl; omega.
+   intros [|a|a] b (Ha,Ha'); [simpl; omega | | easy ].
+   remember (S n) as m.
+   rewrite Heqm at 2. simpl Zgcdn.
+   unfold Z.modulo; generalize (Z_div_mod b (Zpos a) eq_refl).
+   destruct (Z.div_eucl b (Zpos a)) as (q,r).
+   intros (EQ,(Hr,Hr')).
+   Z.le_elim Hr.
+   - (* r > 0 *)
+     replace (fibonacci (S (S m))) with (fibonacci (S m) + fibonacci m) by auto.
+     intros.
+     destruct (IHn r (Zpos a) (conj Hr Hr')); auto.
+     + assert (EQ' : r = Zpos a * (-q) + b) by (rewrite EQ; ring).
+       rewrite EQ' at 1.
+       apply Zis_gcd_sym.
+       apply Zis_gcd_for_euclid2; auto.
+       apply Zis_gcd_sym; auto.
+     + split; auto.
+       rewrite EQ.
+       apply Z.add_le_mono; auto.
+       apply Z.le_trans with (Zpos a * 1); auto.
+       now rewrite Z.mul_1_r.
+       apply Z.mul_le_mono_nonneg_l; auto with zarith.
+       change 1 with (Z.succ 0). apply Z.le_succ_l.
+       destruct q; auto with zarith.
+       assert (Zpos a * Zneg p < 0) by now compute. omega.
+   - (* r = 0 *)
+     clear IHn EQ Hr'; intros _.
+     subst r; simpl; rewrite Heqm.
+     destruct n.
+     + simpl. omega.
+     + now destruct 1.
  Qed.
 
  (** 3b) We reformulate the previous result in a more positive way. *)
@@ -201,18 +184,18 @@ Open Scope Z_scope.
  Proof.
    destruct a; [ destruct 1; exfalso; omega | | destruct 1; discriminate].
    cut (forall k n b,
-     k = (S (nat_of_P p) - n)%nat ->
+     k = (S (Pos.to_nat p) - n)%nat ->
      0 < Zpos p < b -> Zpos p < fibonacci (S n) ->
      Zis_gcd (Zpos p) b (Zgcdn n (Zpos p) b)).
    destruct 2; eauto.
    clear n; induction k.
    intros.
-   assert (nat_of_P p < n)%nat by omega.
+   assert (Pos.to_nat p < n)%nat by omega.
    apply Zgcdn_linear_bound.
    simpl.
    generalize (inj_le _ _ H2).
-   rewrite inj_S.
-   rewrite <- Zpos_eq_Z_of_nat_o_nat_of_P; auto.
+   rewrite Nat2Z.inj_succ.
+   rewrite positive_nat_Z; auto.
    omega.
    intros.
    generalize (Zgcdn_worst_is_fibonacci n (Zpos p) b H0); intros.
@@ -235,77 +218,69 @@ Open Scope Z_scope.
    induction p; [ | | compute; auto ];
     simpl Zgcd_bound in *;
     rewrite plus_comm; simpl plus;
-    set (n:= (Psize p+Psize p)%nat) in *; simpl;
+    set (n:= (Pos.size_nat p+Pos.size_nat p)%nat) in *; simpl;
     assert (n <> O) by (unfold n; destruct p; simpl; auto).
 
    destruct n as [ |m]; [elim H; auto| ].
-   generalize (fibonacci_pos m); rewrite Zpos_xI; omega.
+   generalize (fibonacci_pos m); rewrite Pos2Z.inj_xI; omega.
 
    destruct n as [ |m]; [elim H; auto| ].
-   generalize (fibonacci_pos m); rewrite Zpos_xO; omega.
+   generalize (fibonacci_pos m); rewrite Pos2Z.inj_xO; omega.
  Qed.
 
  (* 5) the end: we glue everything together and take care of
     situations not corresponding to [0<a<b]. *)
 
- Lemma Zgcdn_is_gcd :
-   forall n a b, (Zgcd_bound a <= n)%nat ->
-     Zis_gcd a b (Zgcdn n a b).
+ Lemma Zgcd_bound_opp a : Zgcd_bound (-a) = Zgcd_bound a.
+ Proof.
+  now destruct a.
+ Qed.
+
+ Lemma Zgcdn_opp n a b : Zgcdn n (-a) b = Zgcdn n a b.
+ Proof.
+  induction n; simpl; auto.
+  destruct a; simpl; auto.
+ Qed.
+
+ Lemma Zgcdn_is_gcd_pos n a b : (Zgcd_bound (Zpos a) <= n)%nat ->
+   Zis_gcd (Zpos a) b (Zgcdn n (Zpos a) b).
+ Proof.
+  intros.
+  generalize (Zgcd_bound_fibonacci (Zpos a)).
+  simpl Zgcd_bound in *.
+  remember (Pos.size_nat a+Pos.size_nat a)%nat as m.
+  assert (1 < m)%nat.
+  { rewrite Heqm; destruct a; simpl; rewrite 1?plus_comm;
+    auto with arith. }
+  destruct m as [ |m]; [inversion H0; auto| ].
+  destruct n as [ |n]; [inversion H; auto| ].
+  simpl Zgcdn.
+  unfold Z.modulo.
+  generalize (Z_div_mod b (Zpos a) (eq_refl Gt)).
+  destruct (Z.div_eucl b (Zpos a)) as (q,r).
+  intros (->,(H1,H2)) H3.
+  apply Zis_gcd_for_euclid2.
+  Z.le_elim H1.
+  + apply Zgcdn_ok_before_fibonacci; auto.
+    apply Z.lt_le_trans with (fibonacci (S m));
+    [ omega | apply fibonacci_incr; auto].
+  + subst r; simpl.
+    destruct m as [ |m]; [exfalso; omega| ].
+    destruct n as [ |n]; [exfalso; omega| ].
+    simpl; apply Zis_gcd_sym; apply Zis_gcd_0.
+ Qed.
+
+ Lemma Zgcdn_is_gcd n a b :
+   (Zgcd_bound a <= n)%nat -> Zis_gcd a b (Zgcdn n a b).
  Proof.
-   destruct a; intros.
-   simpl in H.
-   destruct n; [exfalso; omega | ].
-   simpl; generalize (Zis_gcd_0_abs b); intuition.
-   (*Zpos*)
-   generalize (Zgcd_bound_fibonacci (Zpos p)).
-   simpl Zgcd_bound in *.
-   remember (Psize p+Psize p)%nat as m.
-   assert (1 < m)%nat.
-     rewrite Heqm; destruct p; simpl; rewrite 1? plus_comm;
-       auto with arith.
-   destruct m as [ |m]; [inversion H0; auto| ].
-   destruct n as [ |n]; [inversion H; auto| ].
-   simpl Zgcdn.
-   unfold Zmod.
-   generalize (Z_div_mod b (Zpos p) (refl_equal Gt)).
-   destruct (Zdiv_eucl b (Zpos p)) as (q,r).
-   intros (H2,H3) H4.
-   rewrite H2.
-   apply Zis_gcd_for_euclid2.
-   destruct H3.
-   destruct (Zle_lt_or_eq _ _ H1).
-   apply Zgcdn_ok_before_fibonacci; auto.
-   apply Zlt_le_trans with (fibonacci (S m)); [ omega | apply fibonacci_incr; auto].
-   subst r; simpl.
-   destruct m as [ |m]; [exfalso; omega| ].
-   destruct n as [ |n]; [exfalso; omega| ].
-   simpl; apply Zis_gcd_sym; apply Zis_gcd_0.
-   (*Zneg*)
-   generalize (Zgcd_bound_fibonacci (Zpos p)).
-   simpl Zgcd_bound in *.
-   remember (Psize p+Psize p)%nat as m.
-   assert (1 < m)%nat.
-     rewrite Heqm; destruct p; simpl; rewrite 1? plus_comm;
-       auto with arith.
-   destruct m as [ |m]; [inversion H0; auto| ].
-   destruct n as [ |n]; [inversion H; auto| ].
-   simpl Zgcdn.
-   unfold Zmod.
-   generalize (Z_div_mod b (Zpos p) (refl_equal Gt)).
-   destruct (Zdiv_eucl b (Zpos p)) as (q,r).
-   intros (H1,H2) H3.
-   rewrite H1.
-   apply Zis_gcd_minus.
-   apply Zis_gcd_sym.
-   apply Zis_gcd_for_euclid2.
-   destruct H2.
-   destruct (Zle_lt_or_eq _ _ H2).
-   apply Zgcdn_ok_before_fibonacci; auto.
-   apply Zlt_le_trans with (fibonacci (S m)); [ omega | apply fibonacci_incr; auto].
-   subst r; simpl.
-   destruct m as [ |m]; [exfalso; omega| ].
-   destruct n as [ |n]; [exfalso; omega| ].
-   simpl; apply Zis_gcd_sym; apply Zis_gcd_0.
+   destruct a.
+   - simpl; intros.
+     destruct n; [exfalso; omega | ].
+     simpl; generalize (Zis_gcd_0_abs b); intuition.
+   - apply Zgcdn_is_gcd_pos.
+   - rewrite <- Zgcd_bound_opp, <- Zgcdn_opp.
+     intros. apply Zis_gcd_minus, Zis_gcd_sym. simpl Z.opp.
+     now apply Zgcdn_is_gcd_pos.
  Qed.
 
  Lemma Zgcd_is_gcd :
diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v
index c2348967..8b879fbe 100644
--- a/theories/ZArith/Zhints.v
+++ b/theories/ZArith/Zhints.v
@@ -1,13 +1,11 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zhints.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** This file centralizes the lemmas about [Z], classifying them
     according to the way they can be used in automatic search  *)
 
@@ -45,495 +43,59 @@ Hint Resolve
   (** Should clearly be declared as hints                               *)
 
   (** Lemmas ending by eq *)
-  Zsucc_eq_compat (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *)
-
-  (** Lemmas ending by Zgt *)
-  Zsucc_gt_compat (* :(n,m:Z)`m > n`->`(Zs m) > (Zs n)` *)
-  Zgt_succ (* :(n:Z)`(Zs n) > n` *)
-  Zorder.Zgt_pos_0 (* :(p:positive)`(POS p) > 0` *)
-  Zplus_gt_compat_l (* :(n,m,p:Z)`n > m`->`p+n > p+m` *)
-  Zplus_gt_compat_r (* :(n,m,p:Z)`n > m`->`n+p > m+p` *)
-
-  (** Lemmas ending by Zlt *)
-  Zlt_succ (* :(n:Z)`n < (Zs n)` *)
-  Zsucc_lt_compat (* :(n,m:Z)`n < m`->`(Zs n) < (Zs m)` *)
-  Zlt_pred (* :(n:Z)`(Zpred n) < n` *)
-  Zplus_lt_compat_l (* :(n,m,p:Z)`n < m`->`p+n < p+m` *)
-  Zplus_lt_compat_r (* :(n,m,p:Z)`n < m`->`n+p < m+p` *)
-
-  (** Lemmas ending by Zle *)
-  Zle_0_nat (* :(n:nat)`0 <= (inject_nat n)` *)
-  Zorder.Zle_0_pos (* :(p:positive)`0 <= (POS p)` *)
-  Zle_refl (* :(n:Z)`n <= n` *)
-  Zle_succ (* :(n:Z)`n <= (Zs n)` *)
-  Zsucc_le_compat (* :(n,m:Z)`m <= n`->`(Zs m) <= (Zs n)` *)
-  Zle_pred (* :(n:Z)`(Zpred n) <= n` *)
-  Zle_min_l (* :(n,m:Z)`(Zmin n m) <= n` *)
-  Zle_min_r (* :(n,m:Z)`(Zmin n m) <= m` *)
-  Zplus_le_compat_l (* :(n,m,p:Z)`n <= m`->`p+n <= p+m` *)
-  Zplus_le_compat_r (* :(a,b,c:Z)`a <= b`->`a+c <= b+c` *)
-  Zabs_pos (* :(x:Z)`0 <= |x|` *)
+  Zsucc_eq_compat (* n = m -> Z.succ n = Z.succ m *)
+
+  (** Lemmas ending by Z.gt *)
+  Zsucc_gt_compat (* m > n -> Z.succ m > Z.succ n *)
+  Zgt_succ (* Z.succ n > n *)
+  Zorder.Zgt_pos_0 (* Z.pos p > 0 *)
+  Zplus_gt_compat_l (* n > m -> p+n > p+m *)
+  Zplus_gt_compat_r (* n > m -> n+p > m+p *)
+
+  (** Lemmas ending by Z.lt *)
+  Pos2Z.is_pos (* 0 < Z.pos p *)
+  Z.lt_succ_diag_r (* n < Z.succ n *)
+  Zsucc_lt_compat (* n < m -> Z.succ n < Z.succ m *)
+  Z.lt_pred_l (* Z.pred n < n *)
+  Zplus_lt_compat_l (* n < m -> p+n < p+m *)
+  Zplus_lt_compat_r (* n < m -> n+p < m+p *)
+
+  (** Lemmas ending by Z.le *)
+  Nat2Z.is_nonneg (* 0 <= Z.of_nat n *)
+  Pos2Z.is_nonneg (* 0 <= Z.pos p *)
+  Z.le_refl (* n <= n *)
+  Z.le_succ_diag_r (* n <= Z.succ n *)
+  Zsucc_le_compat (* m <= n -> Z.succ m <= Z.succ n *)
+  Z.le_pred_l (* Z.pred n <= n *)
+  Z.le_min_l (* Z.min n m <= n *)
+  Z.le_min_r (* Z.min n m <= m *)
+  Zplus_le_compat_l (* n <= m -> p+n <= p+m *)
+  Zplus_le_compat_r (* a <= b -> a+c <= b+c *)
+  Z.abs_nonneg (* 0 <= |x| *)
 
   (** ** Irreversible simplification lemmas *)
   (** Probably to be declared as hints, when no other simplification is possible *)
 
   (** Lemmas ending by eq *)
-  BinInt.Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *)
-  Zplus_eq_compat (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *)
+  Z_eq_mult (* y = 0 -> y*x = 0 *)
+  Zplus_eq_compat (* n = m -> p = q -> n+p = m+q *)
 
-  (** Lemmas ending by Zge *)
-  Zorder.Zmult_ge_compat_r (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *)
-  Zorder.Zmult_ge_compat_l (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *)
+  (** Lemmas ending by Z.ge *)
+  Zorder.Zmult_ge_compat_r (* a >= b -> c >= 0 -> a*c >= b*c *)
+  Zorder.Zmult_ge_compat_l (* a >= b -> c >= 0 -> c*a >= c*b *)
   Zorder.Zmult_ge_compat (* :
-      (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *)
+      a >= c -> b >= d -> c >= 0 -> d >= 0 -> a*b >= c*d *)
 
-  (** Lemmas ending by Zlt *)
-  Zorder.Zmult_gt_0_compat (* :(a,b:Z)`a > 0`->`b > 0`->`a*b > 0` *)
-  Zlt_lt_succ (* :(n,m:Z)`n < m`->`n < (Zs m)` *)
+  (** Lemmas ending by Z.lt *)
+  Zorder.Zmult_gt_0_compat (* a > 0 -> b > 0 -> a*b > 0 *)
+  Z.lt_lt_succ_r (* n < m -> n < Z.succ m *)
 
-  (** Lemmas ending by Zle *)
-  Zorder.Zmult_le_0_compat (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x*y` *)
-  Zorder.Zmult_le_compat_r (* :(a,b,c:Z)`a <= b`->`0 <= c`->`a*c <= b*c` *)
-  Zorder.Zmult_le_compat_l (* :(a,b,c:Z)`a <= b`->`0 <= c`->`c*a <= c*b` *)
-  Zplus_le_0_compat (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x+y` *)
-  Zle_le_succ (* :(x,y:Z)`x <= y`->`x <= (Zs y)` *)
-  Zplus_le_compat (* :(n,m,p,q:Z)`n <= m`->`p <= q`->`n+p <= m+q` *)
+  (** Lemmas ending by Z.le *)
+  Z.mul_nonneg_nonneg (* 0 <= x -> 0 <= y -> 0 <= x*y *)
+  Zorder.Zmult_le_compat_r (* a <= b -> 0 <= c -> a*c <= b*c *)
+  Zorder.Zmult_le_compat_l (* a <= b -> 0 <= c -> c*a <= c*b *)
+  Z.add_nonneg_nonneg (* 0 <= x -> 0 <= y -> 0 <= x+y *)
+  Z.le_le_succ_r (* x <= y -> x <= Z.succ y *)
+  Z.add_le_mono (* n <= m -> p <= q -> n+p <= m+q *)
 
   : zarith.
-
-(**********************************************************************)
-(** *        Reversible lemmas relating operators                     *)
-(** Probably to be declared as hints but need to define precedences   *)
-
-(** ** Conversion between comparisons/predicates and arithmetic operators *)
-
-(** Lemmas ending by eq *)
-(**
-<<
-Zegal_left: (x,y:Z)`x = y`->`x+(-y) = 0`
-Zabs_eq: (x:Z)`0 <= x`->`|x| = x`
-Zeven_div2: (x:Z)(Zeven x)->`x = 2*(Zdiv2 x)`
-Zodd_div2: (x:Z)`x >= 0`->(Zodd x)->`x = 2*(Zdiv2 x)+1`
->>
-*)
-
-(** Lemmas ending by Zgt *)
-(**
-<<
-Zgt_left_rev: (x,y:Z)`x+(-y) > 0`->`x > y`
-Zgt_left_gt: (x,y:Z)`x > y`->`x+(-y) > 0`
->>
-*)
-
-(** Lemmas ending by Zlt *)
-(**
-<<
-Zlt_left_rev: (x,y:Z)`0 < y+(-x)`->`x < y`
-Zlt_left_lt: (x,y:Z)`x < y`->`0 < y+(-x)`
-Zlt_O_minus_lt: (n,m:Z)`0 < n-m`->`m < n`
->>
-*)
-
-(** Lemmas ending by Zle *)
-(**
-<<
-Zle_left: (x,y:Z)`x <= y`->`0 <= y+(-x)`
-Zle_left_rev: (x,y:Z)`0 <= y+(-x)`->`x <= y`
-Zlt_left: (x,y:Z)`x < y`->`0 <= y+(-1)+(-x)`
-Zge_left: (x,y:Z)`x >= y`->`0 <= x+(-y)`
-Zgt_left: (x,y:Z)`x > y`->`0 <= x+(-1)+(-y)`
->>
-*)
-
-(** ** Conversion between nat comparisons and Z comparisons *)
-
-(** Lemmas ending by eq *)
-(**
-<<
-inj_eq: (x,y:nat)x=y->`(inject_nat x) = (inject_nat y)`
->>
-*)
-
-(** Lemmas ending by Zge *)
-(**
-<<
-inj_ge: (x,y:nat)(ge x y)->`(inject_nat x) >= (inject_nat y)`
->>
-*)
-
-(** Lemmas ending by Zgt *)
-(**
-<<
-inj_gt: (x,y:nat)(gt x y)->`(inject_nat x) > (inject_nat y)`
->>
-*)
-
-(** Lemmas ending by Zlt *)
-(**
-<<
-inj_lt: (x,y:nat)(lt x y)->`(inject_nat x) < (inject_nat y)`
->>
-*)
-
-(** Lemmas ending by Zle *)
-(**
-<<
-inj_le: (x,y:nat)(le x y)->`(inject_nat x) <= (inject_nat y)`
->>
-*)
-
-(** ** Conversion between comparisons *)
-
-(** Lemmas ending by Zge *)
-(**
-<<
-not_Zlt: (x,y:Z)~`x < y`->`x >= y`
-Zle_ge: (m,n:Z)`m <= n`->`n >= m`
->>
-*)
-
-(** Lemmas ending by Zgt *)
-(**
-<<
-Zle_gt_S: (n,p:Z)`n <= p`->`(Zs p) > n`
-not_Zle: (x,y:Z)~`x <= y`->`x > y`
-Zlt_gt: (m,n:Z)`m < n`->`n > m`
-Zle_S_gt: (n,m:Z)`(Zs n) <= m`->`m > n`
->>
-*)
-
-(** Lemmas ending by Zlt *)
-(**
-<<
-not_Zge: (x,y:Z)~`x >= y`->`x < y`
-Zgt_lt: (m,n:Z)`m > n`->`n < m`
-Zle_lt_n_Sm: (n,m:Z)`n <= m`->`n < (Zs m)`
->>
-*)
-
-(** Lemmas ending by Zle *)
-(**
-<<
-Zlt_ZERO_pred_le_ZERO: (x:Z)`0 < x`->`0 <= (Zpred x)`
-not_Zgt: (x,y:Z)~`x > y`->`x <= y`
-Zgt_le_S: (n,p:Z)`p > n`->`(Zs n) <= p`
-Zgt_S_le: (n,p:Z)`(Zs p) > n`->`n <= p`
-Zge_le: (m,n:Z)`m >= n`->`n <= m`
-Zlt_le_S: (n,p:Z)`n < p`->`(Zs n) <= p`
-Zlt_n_Sm_le: (n,m:Z)`n < (Zs m)`->`n <= m`
-Zlt_le_weak: (n,m:Z)`n < m`->`n <= m`
-Zle_refl: (n,m:Z)`n = m`->`n <= m`
->>
-*)
-
-(** ** Irreversible simplification involving several comparaisons *)
-(**    useful with clear precedences *)
-
-(** Lemmas ending by Zlt *)
-(**
-<<
-Zlt_le_reg :(a,b,c,d:Z)`a < b`->`c <= d`->`a+c < b+d`
-Zle_lt_reg : (a,b,c,d:Z)`a <= b`->`c < d`->`a+c < b+d`
->>
-*)
-
-(** ** What is decreasing here ? *)
-
-(** Lemmas ending by eq *)
-(**
-<<
-Zplus_minus: (n,m,p:Z)`n = m+p`->`p = n-m`
->>
-*)
-
-(** Lemmas ending by Zgt *)
-(**
-<<
-Zgt_pred: (n,p:Z)`p > (Zs n)`->`(Zpred p) > n`
->>
-*)
-
-(** Lemmas ending by Zlt *)
-(**
-<<
-Zlt_pred: (n,p:Z)`(Zs n) < p`->`n < (Zpred p)`
->>
-*)
-
-(**********************************************************************)
-(** *                Useful Bottom-up lemmas                          *)
-
-(** ** Bottom-up simplification: should be used *)
-
-(** Lemmas ending by eq *)
-(**
-<<
-Zeq_add_S: (n,m:Z)`(Zs n) = (Zs m)`->`n = m`
-Zsimpl_plus_l: (n,m,p:Z)`n+m = n+p`->`m = p`
-Zplus_unit_left: (n,m:Z)`n+0 = m`->`n = m`
-Zplus_unit_right: (n,m:Z)`n = m+0`->`n = m`
->>
-*)
-
-(** Lemmas ending by Zgt *)
-(**
-<<
-Zsimpl_gt_plus_l: (n,m,p:Z)`p+n > p+m`->`n > m`
-Zsimpl_gt_plus_r: (n,m,p:Z)`n+p > m+p`->`n > m`
-Zgt_S_n: (n,p:Z)`(Zs p) > (Zs n)`->`p > n`
->>
-*)
-
-(** Lemmas ending by Zlt *)
-(**
-<<
-Zsimpl_lt_plus_l: (n,m,p:Z)`p+n < p+m`->`n < m`
-Zsimpl_lt_plus_r: (n,m,p:Z)`n+p < m+p`->`n < m`
-Zlt_S_n: (n,m:Z)`(Zs n) < (Zs m)`->`n < m`
->>
-*)
-
-(** Lemmas ending by Zle *)
-(** << Zsimpl_le_plus_l: (p,n,m:Z)`p+n <= p+m`->`n <= m`
-Zsimpl_le_plus_r: (p,n,m:Z)`n+p <= m+p`->`n <= m`
-Zle_S_n: (n,m:Z)`(Zs m) <= (Zs n)`->`m <= n` >> *)
-
-(** ** Bottom-up irreversible (syntactic) simplification *)
-
-(** Lemmas ending by Zle *)
-(**
-<<
-Zle_trans_S: (n,m:Z)`(Zs n) <= m`->`n <= m`
->>
-*)
-
-(** ** Other unclearly simplifying lemmas *)
-
-(** Lemmas ending by Zeq *)
-(**
-<<
-Zmult_eq: (x,y:Z)`x <> 0`->`y*x = 0`->`y = 0`
->>
-*)
-
-(* Lemmas ending by Zgt *)
-(**
-<<
-Zmult_gt: (x,y:Z)`x > 0`->`x*y > 0`->`y > 0`
->>
-*)
-
-(* Lemmas ending by Zlt *)
-(**
-<<
-pZmult_lt: (x,y:Z)`x > 0`->`0 < y*x`->`0 < y`
->>
-*)
-
-(* Lemmas ending by Zle *)
-(**
-<<
-Zmult_le: (x,y:Z)`x > 0`->`0 <= y*x`->`0 <= y`
-OMEGA1: (x,y:Z)`x = y`->`0 <= x`->`0 <= y`
->>
-*)
-
-
-(**********************************************************************)
-(** *        Irreversible lemmas with meta-variables                  *)
-(** To be used by EAuto                                               *)
-
-(* Hints Immediate *)
-(** Lemmas ending by eq *)
-(**
-<<
-Zle_antisym: (n,m:Z)`n <= m`->`m <= n`->`n = m`
->>
-*)
-
-(** Lemmas ending by Zge *)
-(**
-<<
-Zge_trans: (n,m,p:Z)`n >= m`->`m >= p`->`n >= p`
->>
-*)
-
-(** Lemmas ending by Zgt *)
-(**
-<<
-Zgt_trans: (n,m,p:Z)`n > m`->`m > p`->`n > p`
-Zgt_trans_S: (n,m,p:Z)`(Zs n) > m`->`m > p`->`n > p`
-Zle_gt_trans: (n,m,p:Z)`m <= n`->`m > p`->`n > p`
-Zgt_le_trans: (n,m,p:Z)`n > m`->`p <= m`->`n > p`
->>
-*)
-
-(** Lemmas ending by Zlt *)
-(**
-<<
-Zlt_trans: (n,m,p:Z)`n < m`->`m < p`->`n < p`
-Zlt_le_trans: (n,m,p:Z)`n < m`->`m <= p`->`n < p`
-Zle_lt_trans: (n,m,p:Z)`n <= m`->`m < p`->`n < p`
->>
-*)
-
-(** Lemmas ending by Zle *)
-(**
-<<
-Zle_trans: (n,m,p:Z)`n <= m`->`m <= p`->`n <= p`
->>
-*)
-
-
-(**********************************************************************)
-(** *               Unclear or too specific lemmas                    *)
-(** Not to be used ?                                                  *)
-
-(** ** Irreversible and too specific (not enough regular) *)
-
-(** Lemmas ending by Zle *)
-(**
-<<
-Zle_mult: (x,y:Z)`x > 0`->`0 <= y`->`0 <= y*x`
-Zle_mult_approx: (x,y,z:Z)`x > 0`->`z > 0`->`0 <= y`->`0 <= y*x+z`
-OMEGA6: (x,y,z:Z)`0 <= x`->`y = 0`->`0 <= x+y*z`
-OMEGA7: (x,y,z,t:Z)`z > 0`->`t > 0`->`0 <= x`->`0 <= y`->`0 <= x*z+y*t`
->>
-*)
-
-(** ** Expansion and too specific ? *)
-
-(** Lemmas ending by Zge *)
-(**
-<<
-Zge_mult_simpl: (a,b,c:Z)`c > 0`->`a*c >= b*c`->`a >= b`
->>
-*)
-
-(** Lemmas ending by Zgt *)
-(**
-<<
-Zgt_mult_simpl: (a,b,c:Z)`c > 0`->`a*c > b*c`->`a > b`
-Zgt_square_simpl: (x,y:Z)`x >= 0`->`y >= 0`->`x*x > y*y`->`x > y`
->>
-*)
-
-(** Lemmas ending by Zle *)
-(**
-<<
-Zle_mult_simpl: (a,b,c:Z)`c > 0`->`a*c <= b*c`->`a <= b`
-Zmult_le_approx: (x,y,z:Z)`x > 0`->`x > z`->`0 <= y*x+z`->`0 <= y`
->>
-*)
-
-(** ** Reversible but too specific ? *)
-
-(** Lemmas ending by Zlt *)
-(**
-<<
-Zlt_minus: (n,m:Z)`0 < m`->`n-m < n`
->>
-*)
-
-(**********************************************************************)
-(** *               Lemmas to be used as rewrite rules                *)
-(** but can also be used as hints                                     *)
-
-(** Left-to-right simplification lemmas (a symbol disappears) *)
-
-(**
-<<
-Zcompare_n_S: (n,m:Z)(Zcompare (Zs n) (Zs m))=(Zcompare n m)
-Zmin_n_n: (n:Z)`(Zmin n n) = n`
-Zmult_1_n: (n:Z)`1*n = n`
-Zmult_n_1: (n:Z)`n*1 = n`
-Zminus_plus: (n,m:Z)`n+m-n = m`
-Zle_plus_minus: (n,m:Z)`n+(m-n) = m`
-Zopp_Zopp: (x:Z)`(-(-x)) = x`
-Zero_left: (x:Z)`0+x = x`
-Zero_right: (x:Z)`x+0 = x`
-Zplus_inverse_r: (x:Z)`x+(-x) = 0`
-Zplus_inverse_l: (x:Z)`(-x)+x = 0`
-Zopp_intro: (x,y:Z)`(-x) = (-y)`->`x = y`
-Zmult_one: (x:Z)`1*x = x`
-Zero_mult_left: (x:Z)`0*x = 0`
-Zero_mult_right: (x:Z)`x*0 = 0`
-Zmult_Zopp_Zopp: (x,y:Z)`(-x)*(-y) = x*y`
->>
-*)
-
-(** Right-to-left simplification lemmas (a symbol disappears) *)
-
-(**
-<<
-Zpred_Sn: (m:Z)`m = (Zpred (Zs m))`
-Zs_pred: (n:Z)`n = (Zs (Zpred n))`
-Zplus_n_O: (n:Z)`n = n+0`
-Zmult_n_O: (n:Z)`0 = n*0`
-Zminus_n_O: (n:Z)`n = n-0`
-Zminus_n_n: (n:Z)`0 = n-n`
-Zred_factor6: (x:Z)`x = x+0`
-Zred_factor0: (x:Z)`x = x*1`
->>
-*)
-
-(** Unclear orientation (no symbol disappears) *)
-
-(**
-<<
-Zplus_n_Sm: (n,m:Z)`(Zs (n+m)) = n+(Zs m)`
-Zmult_n_Sm: (n,m:Z)`n*m+n = n*(Zs m)`
-Zmin_SS: (n,m:Z)`(Zs (Zmin n m)) = (Zmin (Zs n) (Zs m))`
-Zplus_assoc_l: (n,m,p:Z)`n+(m+p) = n+m+p`
-Zplus_assoc_r: (n,m,p:Z)`n+m+p = n+(m+p)`
-Zplus_permute: (n,m,p:Z)`n+(m+p) = m+(n+p)`
-Zplus_Snm_nSm: (n,m:Z)`(Zs n)+m = n+(Zs m)`
-Zminus_plus_simpl: (n,m,p:Z)`n-m = p+n-(p+m)`
-Zminus_Sn_m: (n,m:Z)`(Zs (n-m)) = (Zs n)-m`
-Zmult_plus_distr_l: (n,m,p:Z)`(n+m)*p = n*p+m*p`
-Zmult_minus_distr: (n,m,p:Z)`(n-m)*p = n*p-m*p`
-Zmult_assoc_r: (n,m,p:Z)`n*m*p = n*(m*p)`
-Zmult_assoc_l: (n,m,p:Z)`n*(m*p) = n*m*p`
-Zmult_permute: (n,m,p:Z)`n*(m*p) = m*(n*p)`
-Zmult_Sm_n: (n,m:Z)`n*m+m = (Zs n)*m`
-Zmult_Zplus_distr: (x,y,z:Z)`x*(y+z) = x*y+x*z`
-Zmult_plus_distr: (n,m,p:Z)`(n+m)*p = n*p+m*p`
-Zopp_Zplus: (x,y:Z)`(-(x+y)) = (-x)+(-y)`
-Zplus_sym: (x,y:Z)`x+y = y+x`
-Zplus_assoc: (x,y,z:Z)`x+(y+z) = x+y+z`
-Zmult_sym: (x,y:Z)`x*y = y*x`
-Zmult_assoc: (x,y,z:Z)`x*(y*z) = x*y*z`
-Zopp_Zmult: (x,y:Z)`(-x)*y = (-(x*y))`
-Zplus_S_n: (x,y:Z)`(Zs x)+y = (Zs (x+y))`
-Zopp_one: (x:Z)`(-x) = x*(-1)`
-Zopp_Zmult_r: (x,y:Z)`(-(x*y)) = x*(-y)`
-Zmult_Zopp_left: (x,y:Z)`(-x)*y = x*(-y)`
-Zopp_Zmult_l: (x,y:Z)`(-(x*y)) = (-x)*y`
-Zred_factor1: (x:Z)`x+x = x*2`
-Zred_factor2: (x,y:Z)`x+x*y = x*(1+y)`
-Zred_factor3: (x,y:Z)`x*y+x = x*(1+y)`
-Zred_factor4: (x,y,z:Z)`x*y+x*z = x*(y+z)`
-Zminus_Zplus_compatible: (x,y,n:Z)`x+n-(y+n) = x-y`
-Zmin_plus: (x,y,n:Z)`(Zmin (x+n) (y+n)) = (Zmin x y)+n`
->>
-*)
-
-(** nat <-> Z *)
-(**
-<<
-inj_S: (y:nat)`(inject_nat (S y)) = (Zs (inject_nat y))`
-inj_plus: (x,y:nat)`(inject_nat (plus x y)) = (inject_nat x)+(inject_nat y)`
-inj_mult: (x,y:nat)`(inject_nat (mult x y)) = (inject_nat x)*(inject_nat y)`
-inj_minus1:
- (x,y:nat)(le y x)->`(inject_nat (minus x y)) = (inject_nat x)-(inject_nat y)`
-inj_minus2: (x,y:nat)(gt y x)->`(inject_nat (minus x y)) = 0`
->>
-*)
-
-(** Too specific ? *)
-(**
-<<
-Zred_factor5: (x,y:Z)`x*0+y = y`
->>
-*)
-
diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v
index 59e76830..319e2c26 100644
--- a/theories/ZArith/Zlogarithm.v
+++ b/theories/ZArith/Zlogarithm.v
@@ -1,17 +1,21 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zlogarithm.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (**********************************************************************)
-(** The integer logarithms with base 2.
 
-    There are three logarithms,
+(** The integer logarithms with base 2. *)
+
+(** THIS FILE IS DEPRECATED.
+    Please rather use [Z.log2] (or [Z.log2_up]), which
+    are defined in [BinIntDef], and whose properties can
+    be found in [BinInt.Z]. *)
+
+(*  There are three logarithms defined here,
     depending on the rounding of the real 2-based logarithm:
     - [Log_inf]: [y = (Log_inf x) iff 2^y <= x < 2^(y+1)]
       i.e. [Log_inf x] is the biggest integer that is smaller than [Log x]
@@ -20,11 +24,8 @@
     - [Log_nearest]: [y= (Log_nearest x) iff 2^(y-1/2) < x <= 2^(y+1/2)]
       i.e. [Log_nearest x] is the integer nearest from [Log x] *)
 
-Require Import ZArith_base.
-Require Import Omega.
-Require Import Zcomplements.
-Require Import Zpower.
-Open Local Scope Z_scope.
+Require Import ZArith_base Omega Zcomplements Zpower.
+Local Open Scope Z_scope.
 
 Section Log_pos. (* Log of positive integers *)
 
@@ -32,43 +33,64 @@ Section Log_pos. (* Log of positive integers *)
 
   Fixpoint log_inf (p:positive) : Z :=
     match p with
-      | xH => 0	(* 1 *)
-      | xO q => Zsucc (log_inf q)	(* 2n *)
-      | xI q => Zsucc (log_inf q)	(* 2n+1 *)
+      | xH => 0 (* 1 *)
+      | xO q => Z.succ (log_inf q)       (* 2n *)
+      | xI q => Z.succ (log_inf q)       (* 2n+1 *)
     end.
 
   Fixpoint log_sup (p:positive) : Z :=
     match p with
       | xH => 0	(* 1 *)
-      | xO n => Zsucc (log_sup n) (* 2n *)
-      | xI n => Zsucc (Zsucc (log_inf n))	(* 2n+1 *)
+      | xO n => Z.succ (log_sup n) (* 2n *)
+      | xI n => Z.succ (Z.succ (log_inf n))	(* 2n+1 *)
     end.
 
   Hint Unfold log_inf log_sup.
 
+  Lemma Psize_log_inf : forall p, Zpos (Pos.size p) = Z.succ (log_inf p).
+  Proof.
+   induction p; simpl; now rewrite ?Pos2Z.inj_succ, ?IHp.
+  Qed.
+
+  Lemma Zlog2_log_inf : forall p, Z.log2 (Zpos p) = log_inf p.
+  Proof.
+   unfold Z.log2. destruct p; simpl; trivial; apply Psize_log_inf.
+  Qed.
+
+  Lemma Zlog2_up_log_sup : forall p, Z.log2_up (Zpos p) = log_sup p.
+  Proof.
+   induction p; simpl.
+   - change (Zpos p~1) with (2*(Zpos p)+1).
+     rewrite Z.log2_up_succ_double, Zlog2_log_inf; try easy.
+     unfold Z.succ. now rewrite !(Z.add_comm _ 1), Z.add_assoc.
+   - change (Zpos p~0) with (2*Zpos p).
+     now rewrite Z.log2_up_double, IHp.
+   - reflexivity.
+  Qed.
+
   (** Then we give the specifications of [log_inf] and [log_sup]
     and prove their validity *)
 
-  Hint Resolve Zle_trans: zarith.
+  Hint Resolve Z.le_trans: zarith.
 
   Theorem log_inf_correct :
     forall x:positive,
-      0 <= log_inf x /\ two_p (log_inf x) <= Zpos x < two_p (Zsucc (log_inf x)).
+      0 <= log_inf x /\ two_p (log_inf x) <= Zpos x < two_p (Z.succ (log_inf x)).
   Proof.
-    simple induction x; intros; simpl in |- *;
+    simple induction x; intros; simpl;
       [ elim H; intros Hp HR; clear H; split;
 	[ auto with zarith
-	  | rewrite two_p_S with (x := Zsucc (log_inf p)) by (apply Zle_le_succ; trivial);
+	  | rewrite two_p_S with (x := Z.succ (log_inf p)) by (apply Z.le_le_succ_r; trivial);
 	    rewrite two_p_S by trivial;
-	    rewrite two_p_S in HR by trivial; rewrite (BinInt.Zpos_xI p);
+	    rewrite two_p_S in HR by trivial; rewrite (BinInt.Pos2Z.inj_xI p);
 		omega ]
 	| elim H; intros Hp HR; clear H; split;
 	  [ auto with zarith
-	    | rewrite two_p_S with (x := Zsucc (log_inf p)) by (apply Zle_le_succ; trivial);
+	    | rewrite two_p_S with (x := Z.succ (log_inf p)) by (apply Z.le_le_succ_r; trivial);
 	      rewrite two_p_S by trivial;
-	      rewrite two_p_S in HR by trivial; rewrite (BinInt.Zpos_xO p);
+	      rewrite two_p_S in HR by trivial; rewrite (BinInt.Pos2Z.inj_xO p);
 		  omega ]
-	| unfold two_power_pos in |- *; unfold shift_pos in |- *; simpl in |- *;
+	| unfold two_power_pos; unfold shift_pos; simpl;
 	  omega ].
   Qed.
 
@@ -81,7 +103,7 @@ Section Log_pos. (* Log of positive integers *)
 
   Lemma log_sup_correct1 : forall p:positive, 0 <= log_sup p.
   Proof.
-    simple induction p; intros; simpl in |- *; auto with zarith.
+    simple induction p; intros; simpl; auto with zarith.
   Qed.
 
   (** For every [p], either [p] is a power of two and [(log_inf p)=(log_sup p)]
@@ -90,46 +112,46 @@ Section Log_pos. (* Log of positive integers *)
   Theorem log_sup_log_inf :
     forall p:positive,
       IF Zpos p = two_p (log_inf p) then Zpos p = two_p (log_sup p)
-    else log_sup p = Zsucc (log_inf p).
+    else log_sup p = Z.succ (log_inf p).
   Proof.
     simple induction p; intros;
-      [ elim H; right; simpl in |- *;
+      [ elim H; right; simpl;
 	rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
-	  rewrite BinInt.Zpos_xI; unfold Zsucc in |- *; omega
+	  rewrite BinInt.Pos2Z.inj_xI; unfold Z.succ; omega
 	| elim H; clear H; intro Hif;
-	  [ left; simpl in |- *;
+	  [ left; simpl;
 	    rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
 	      rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0));
 		rewrite <- (proj1 Hif); rewrite <- (proj2 Hif);
 		  auto
-	    | right; simpl in |- *;
+	    | right; simpl;
 	      rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
-		rewrite BinInt.Zpos_xO; unfold Zsucc in |- *;
+		rewrite BinInt.Pos2Z.inj_xO; unfold Z.succ;
 		  omega ]
 	| left; auto ].
   Qed.
 
   Theorem log_sup_correct2 :
-    forall x:positive, two_p (Zpred (log_sup x)) < Zpos x <= two_p (log_sup x).
+    forall x:positive, two_p (Z.pred (log_sup x)) < Zpos x <= two_p (log_sup x).
   Proof.
     intro.
     elim (log_sup_log_inf x).
     (* x is a power of two and [log_sup = log_inf] *)
     intros [E1 E2]; rewrite E2.
-    split; [ apply two_p_pred; apply log_sup_correct1 | apply Zle_refl ].
+    split; [ apply two_p_pred; apply log_sup_correct1 | apply Z.le_refl ].
     intros [E1 E2]; rewrite E2.
-    rewrite <- (Zpred_succ (log_inf x)).
+    rewrite (Z.pred_succ (log_inf x)).
     generalize (log_inf_correct2 x); omega.
   Qed.
 
   Lemma log_inf_le_log_sup : forall p:positive, log_inf p <= log_sup p.
   Proof.
-    simple induction p; simpl in |- *; intros; omega.
+    simple induction p; simpl; intros; omega.
   Qed.
 
-  Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Zsucc (log_inf p).
+  Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Z.succ (log_inf p).
   Proof.
-    simple induction p; simpl in |- *; intros; omega.
+    simple induction p; simpl; intros; omega.
   Qed.
 
   (** Now it's possible to specify and build the [Log] rounded to the nearest *)
@@ -139,22 +161,20 @@ Section Log_pos. (* Log of positive integers *)
       | xH => 0
       | xO xH => 1
       | xI xH => 2
-      | xO y => Zsucc (log_near y)
-      | xI y => Zsucc (log_near y)
+      | xO y => Z.succ (log_near y)
+      | xI y => Z.succ (log_near y)
     end.
 
   Theorem log_near_correct1 : forall p:positive, 0 <= log_near p.
   Proof.
-    simple induction p; simpl in |- *; intros;
+    simple induction p; simpl; intros;
       [ elim p0; auto with zarith
 	| elim p0; auto with zarith
 	| trivial with zarith ].
-    intros; apply Zle_le_succ.
-    generalize H0; elim p1; intros; simpl in |- *;
-      [ assumption | assumption | apply Zorder.Zle_0_pos ].
-    intros; apply Zle_le_succ.
-    generalize H0; elim p1; intros; simpl in |- *;
-      [ assumption | assumption | apply Zorder.Zle_0_pos ].
+    intros; apply Z.le_le_succ_r.
+    generalize H0; now elim p1.
+    intros; apply Z.le_le_succ_r.
+    generalize H0; now elim p1.
   Qed.
 
   Theorem log_near_correct2 :
@@ -162,9 +182,9 @@ Section Log_pos. (* Log of positive integers *)
   Proof.
     simple induction p.
     intros p0 [Einf| Esup].
-    simpl in |- *. rewrite Einf.
+    simpl. rewrite Einf.
     case p0; [ left | left | right ]; reflexivity.
-    simpl in |- *; rewrite Esup.
+    simpl; rewrite Esup.
     elim (log_sup_log_inf p0).
     generalize (log_inf_le_log_sup p0).
     generalize (log_sup_le_Slog_inf p0).
@@ -172,10 +192,10 @@ Section Log_pos. (* Log of positive integers *)
     intros; omega.
     case p0; intros; auto with zarith.
     intros p0 [Einf| Esup].
-    simpl in |- *.
+    simpl.
     repeat rewrite Einf.
     case p0; intros; auto with zarith.
-    simpl in |- *.
+    simpl.
     repeat rewrite Esup.
     case p0; intros; auto with zarith.
     auto.
@@ -196,20 +216,20 @@ Section divers.
 
   Lemma ZERO_le_N_digits : forall x:Z, 0 <= N_digits x.
   Proof.
-    simple induction x; simpl in |- *;
-      [ apply Zle_refl | exact log_inf_correct1 | exact log_inf_correct1 ].
+    simple induction x; simpl;
+      [ apply Z.le_refl | exact log_inf_correct1 | exact log_inf_correct1 ].
   Qed.
 
-  Lemma log_inf_shift_nat : forall n:nat, log_inf (shift_nat n 1) = Z_of_nat n.
+  Lemma log_inf_shift_nat : forall n:nat, log_inf (shift_nat n 1) = Z.of_nat n.
   Proof.
     simple induction n; intros;
-      [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ].
+      [ try trivial | rewrite Nat2Z.inj_succ; rewrite <- H; reflexivity ].
   Qed.
 
-  Lemma log_sup_shift_nat : forall n:nat, log_sup (shift_nat n 1) = Z_of_nat n.
+  Lemma log_sup_shift_nat : forall n:nat, log_sup (shift_nat n 1) = Z.of_nat n.
   Proof.
     simple induction n; intros;
-      [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ].
+      [ try trivial | rewrite Nat2Z.inj_succ; rewrite <- H; reflexivity ].
   Qed.
 
   (** [Is_power p] means that p is a power of two *)
@@ -225,21 +245,21 @@ Section divers.
   Proof.
     split;
       [ elim p;
-	[ simpl in |- *; tauto
-	  | simpl in |- *; intros; generalize (H H0); intro H1; elim H1;
+	[ simpl; tauto
+	  | simpl; intros; generalize (H H0); intro H1; elim H1;
 	    intros y0 Hy0; exists (S y0); rewrite Hy0; reflexivity
 	  | intro; exists 0%nat; reflexivity ]
-	| intros; elim H; intros; rewrite H0; elim x; intros; simpl in |- *; trivial ].
+	| intros; elim H; intros; rewrite H0; elim x; intros; simpl; trivial ].
   Qed.
 
   Lemma Is_power_or : forall p:positive, Is_power p \/ ~ Is_power p.
   Proof.
     simple induction p;
-      [ intros; right; simpl in |- *; tauto
+      [ intros; right; simpl; tauto
 	| intros; elim H;
-	  [ intros; left; simpl in |- *; exact H0
-	    | intros; right; simpl in |- *; exact H0 ]
-	| left; simpl in |- *; trivial ].
+	  [ intros; left; simpl; exact H0
+	    | intros; right; simpl; exact H0 ]
+	| left; simpl; trivial ].
   Qed.
 
 End divers.
diff --git a/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v
index cb2fcf26..31880c17 100644
--- a/theories/ZArith/Zmax.v
+++ b/theories/ZArith/Zmax.v
@@ -1,106 +1,60 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zmax.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
 
-(** THIS FILE IS DEPRECATED. Use [Zminmax] instead. *)
-
-Require Export BinInt Zorder Zminmax.
-
-Open Local Scope Z_scope.
-
-(** [Zmax] is now [Zminmax.Zmax]. Code that do things like
-  [unfold Zmin.Zmin] will have to be adapted, and neither
-  a [Definition] or a [Notation] here can help much. *)
-
-
-(** * Characterization of maximum on binary integer numbers *)
-
-Definition Zmax_case := Z.max_case.
-Definition Zmax_case_strong := Z.max_case_strong.
-
-Lemma Zmax_spec : forall x y,
-  x >= y /\ Zmax x y = x  \/ x < y /\ Zmax x y = y.
+(** THIS FILE IS DEPRECATED. *)
+
+Require Export BinInt Zcompare Zorder.
+
+Local Open Scope Z_scope.
+
+(** Definition [Z.max] is now [BinInt.Z.max]. *)
+
+(** Exact compatibility *)
+
+Notation Zmax_case := Z.max_case (compat "8.3").
+Notation Zmax_case_strong := Z.max_case_strong (compat "8.3").
+Notation Zmax_right := Z.max_r (compat "8.3").
+Notation Zle_max_l := Z.le_max_l (compat "8.3").
+Notation Zle_max_r := Z.le_max_r (compat "8.3").
+Notation Zmax_lub := Z.max_lub (compat "8.3").
+Notation Zmax_lub_lt := Z.max_lub_lt (compat "8.3").
+Notation Zle_max_compat_r := Z.max_le_compat_r (compat "8.3").
+Notation Zle_max_compat_l := Z.max_le_compat_l (compat "8.3").
+Notation Zmax_idempotent := Z.max_id (compat "8.3").
+Notation Zmax_n_n := Z.max_id (compat "8.3").
+Notation Zmax_comm := Z.max_comm (compat "8.3").
+Notation Zmax_assoc := Z.max_assoc (compat "8.3").
+Notation Zmax_irreducible_dec := Z.max_dec (compat "8.3").
+Notation Zmax_le_prime := Z.max_le (compat "8.3").
+Notation Zsucc_max_distr := Z.succ_max_distr (compat "8.3").
+Notation Zmax_SS := Z.succ_max_distr (compat "8.3").
+Notation Zplus_max_distr_l := Z.add_max_distr_l (compat "8.3").
+Notation Zplus_max_distr_r := Z.add_max_distr_r (compat "8.3").
+Notation Zmax_plus := Z.add_max_distr_r (compat "8.3").
+Notation Zmax1 := Z.le_max_l (compat "8.3").
+Notation Zmax2 := Z.le_max_r (compat "8.3").
+Notation Zmax_irreducible_inf := Z.max_dec (compat "8.3").
+Notation Zmax_le_prime_inf := Z.max_le (compat "8.3").
+Notation Zpos_max := Pos2Z.inj_max (compat "8.3").
+Notation Zpos_minus := Pos2Z.inj_sub_max (compat "8.3").
+
+(** Slightly different lemmas *)
+
+Lemma Zmax_spec x y :
+  x >= y /\ Z.max x y = x  \/ x < y /\ Z.max x y = y.
 Proof.
- intros x y. rewrite Zge_iff_le. destruct (Z.max_spec x y); auto.
+ Z.swap_greater. destruct (Z.max_spec x y); auto.
 Qed.
 
-Lemma Zmax_left : forall n m, n>=m -> Zmax n m = n.
-Proof. intros x y. rewrite Zge_iff_le. apply Zmax_l. Qed.
-
-Definition Zmax_right : forall n m, n<=m -> Zmax n m = m := Zmax_r.
-
-(** * Least upper bound properties of max *)
-
-Definition Zle_max_l : forall n m, n <= Zmax n m := Z.le_max_l.
-Definition Zle_max_r : forall n m, m <= Zmax n m := Z.le_max_r.
-
-Definition Zmax_lub : forall n m p, n <= p -> m <= p -> Zmax n m <= p
- := Z.max_lub.
-
-Definition Zmax_lub_lt : forall n m p:Z, n < p -> m < p -> Zmax n m < p
- := Z.max_lub_lt.
-
-
-(** * Compatibility with order *)
-
-Definition Zle_max_compat_r : forall n m p, n <= m -> Zmax n p <= Zmax m p
- := Z.max_le_compat_r.
-
-Definition Zle_max_compat_l : forall n m p, n <= m -> Zmax p n <= Zmax p m
- := Z.max_le_compat_l.
-
+Lemma Zmax_left n m : n>=m -> Z.max n m = n.
+Proof. Z.swap_greater. apply Z.max_l. Qed.
 
-(** * Semi-lattice properties of max *)
-
-Definition Zmax_idempotent : forall n, Zmax n n = n := Z.max_id.
-Definition Zmax_comm : forall n m, Zmax n m = Zmax m n := Z.max_comm.
-Definition Zmax_assoc : forall n m p, Zmax n (Zmax m p) = Zmax (Zmax n m) p
- := Z.max_assoc.
-
-(** * Additional properties of max *)
-
-Lemma Zmax_irreducible_dec : forall n m, {Zmax n m = n} + {Zmax n m = m}.
-Proof. exact Z.max_dec. Qed.
-
-Definition Zmax_le_prime : forall n m p, p <= Zmax n m -> p <= n \/ p <= m
- := Z.max_le.
-
-
-(** * Operations preserving max *)
-
-Definition Zsucc_max_distr :
-  forall n m:Z, Zsucc (Zmax n m) = Zmax (Zsucc n) (Zsucc m)
- := Z.succ_max_distr.
-
-Definition Zplus_max_distr_l : forall n m p:Z, Zmax (p + n) (p + m) = p + Zmax n m
- := Z.plus_max_distr_l.
-
-Definition Zplus_max_distr_r : forall n m p:Z, Zmax (n + p) (m + p) = Zmax n m + p
- := Z.plus_max_distr_r.
-
-(** * Maximum and Zpos *)
-
-Definition Zpos_max : forall p q, Zpos (Pmax p q) = Zmax (Zpos p) (Zpos q)
- := Z.pos_max.
-
-Definition Zpos_max_1 : forall p, Zmax 1 (Zpos p) = Zpos p
- := Z.pos_max_1.
-
-(** * Characterization of Pminus in term of Zminus and Zmax *)
-
-Definition Zpos_minus :
- forall p q, Zpos (Pminus p q) = Zmax 1 (Zpos p - Zpos q)
- := Zpos_minus.
-
-(* begin hide *)
-(* Compatibility *)
-Notation Zmax1 := Zle_max_l (only parsing).
-Notation Zmax2 := Zle_max_r (only parsing).
-Notation Zmax_irreducible_inf := Zmax_irreducible_dec (only parsing).
-Notation Zmax_le_prime_inf := Zmax_le_prime (only parsing).
-(* end hide *)
+Lemma Zpos_max_1 p : Z.max 1 (Z.pos p) = Z.pos p.
+Proof.
+ now destruct p.
+Qed.
diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v
index 7b9ad469..30b88d8f 100644
--- a/theories/ZArith/Zmin.v
+++ b/theories/ZArith/Zmin.v
@@ -1,90 +1,57 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zmin.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
 
-(** THIS FILE IS DEPRECATED. Use [Zminmax] instead. *)
+(** THIS FILE IS DEPRECATED. *)
 
-Require Import BinInt Zorder Zminmax.
+Require Import BinInt Zcompare Zorder.
 
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
-(** [Zmin] is now [Zminmax.Zmin]. Code that do things like
-  [unfold Zmin.Zmin] will have to be adapted, and neither
-  a [Definition] or a [Notation] here can help much. *)
+(** Definition [Z.min] is now [BinInt.Z.min]. *)
 
+(** Exact compatibility *)
 
-(** * Characterization of the minimum on binary integer numbers *)
+Notation Zmin_case := Z.min_case (compat "8.3").
+Notation Zmin_case_strong := Z.min_case_strong (compat "8.3").
+Notation Zle_min_l := Z.le_min_l (compat "8.3").
+Notation Zle_min_r := Z.le_min_r (compat "8.3").
+Notation Zmin_glb := Z.min_glb (compat "8.3").
+Notation Zmin_glb_lt := Z.min_glb_lt (compat "8.3").
+Notation Zle_min_compat_r := Z.min_le_compat_r (compat "8.3").
+Notation Zle_min_compat_l := Z.min_le_compat_l (compat "8.3").
+Notation Zmin_idempotent := Z.min_id (compat "8.3").
+Notation Zmin_n_n := Z.min_id (compat "8.3").
+Notation Zmin_comm := Z.min_comm (compat "8.3").
+Notation Zmin_assoc := Z.min_assoc (compat "8.3").
+Notation Zmin_irreducible_inf := Z.min_dec (compat "8.3").
+Notation Zsucc_min_distr := Z.succ_min_distr (compat "8.3").
+Notation Zmin_SS := Z.succ_min_distr (compat "8.3").
+Notation Zplus_min_distr_r := Z.add_min_distr_r (compat "8.3").
+Notation Zmin_plus := Z.add_min_distr_r (compat "8.3").
+Notation Zpos_min := Pos2Z.inj_min (compat "8.3").
 
-Definition Zmin_case := Z.min_case.
-Definition Zmin_case_strong := Z.min_case_strong.
+(** Slightly different lemmas *)
 
-Lemma Zmin_spec : forall x y,
-  x <= y /\ Zmin x y = x  \/  x > y /\ Zmin x y = y.
+Lemma Zmin_spec x y :
+  x <= y /\ Z.min x y = x  \/  x > y /\ Z.min x y = y.
 Proof.
- intros x y. rewrite Zgt_iff_lt, Z.min_comm. destruct (Z.min_spec y x); auto.
+ Z.swap_greater. rewrite Z.min_comm. destruct (Z.min_spec y x); auto.
 Qed.
 
-(** * Greatest lower bound properties of min *)
-
-Definition Zle_min_l : forall n m, Zmin n m <= n := Z.le_min_l.
-Definition Zle_min_r : forall n m, Zmin n m <= m := Z.le_min_r.
-
-Definition Zmin_glb : forall n m p, p <= n -> p <= m -> p <= Zmin n m
- := Z.min_glb.
-Definition Zmin_glb_lt : forall n m p, p < n -> p < m -> p < Zmin n m
- := Z.min_glb_lt.
-
-(** * Compatibility with order *)
-
-Definition Zle_min_compat_r : forall n m p, n <= m -> Zmin n p <= Zmin m p
- := Z.min_le_compat_r.
-Definition Zle_min_compat_l : forall n m p, n <= m -> Zmin p n <= Zmin p m
- := Z.min_le_compat_l.
-
-(** * Semi-lattice properties of min *)
-
-Definition Zmin_idempotent : forall n, Zmin n n = n := Z.min_id.
-Notation Zmin_n_n := Zmin_idempotent (only parsing).
-Definition Zmin_comm : forall n m, Zmin n m = Zmin m n := Z.min_comm.
-Definition Zmin_assoc : forall n m p, Zmin n (Zmin m p) = Zmin (Zmin n m) p
- := Z.min_assoc.
-
-(** * Additional properties of min *)
-
-Lemma Zmin_irreducible_inf : forall n m, {Zmin n m = n} + {Zmin n m = m}.
-Proof. exact Z.min_dec. Qed.
-
-Lemma Zmin_irreducible : forall n m, Zmin n m = n \/ Zmin n m = m.
-Proof. intros; destruct (Z.min_dec n m); auto. Qed.
-
-Notation Zmin_or := Zmin_irreducible (only parsing).
-
-Lemma Zmin_le_prime_inf : forall n m p, Zmin n m <= p -> {n <= p} + {m <= p}.
-Proof. intros n m p; apply Zmin_case; auto. Qed.
-
-(** * Operations preserving min *)
-
-Definition Zsucc_min_distr :
- forall n m, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m)
- := Z.succ_min_distr.
-
-Notation Zmin_SS := Z.succ_min_distr (only parsing).
-
-Definition Zplus_min_distr_r :
- forall n m p, Zmin (n + p) (m + p) = Zmin n m + p
- := Z.plus_min_distr_r.
-
-Notation Zmin_plus := Z.plus_min_distr_r (only parsing).
-
-(** * Minimum and Zpos *)
-
-Definition Zpos_min : forall p q, Zpos (Pmin p q) = Zmin (Zpos p) (Zpos q)
- := Z.pos_min.
+Lemma Zmin_irreducible n m : Z.min n m = n \/ Z.min n m = m.
+Proof. destruct (Z.min_dec n m); auto. Qed.
 
+Notation Zmin_or := Zmin_irreducible (compat "8.3").
 
+Lemma Zmin_le_prime_inf n m p : Z.min n m <= p -> {n <= p} + {m <= p}.
+Proof. apply Z.min_case; auto. Qed.
 
+Lemma Zpos_min_1 p : Z.min 1 (Zpos p) = 1.
+Proof.
+ now destruct p.
+Qed.
diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v
index 5aebcc55..ce589e28 100644
--- a/theories/ZArith/Zminmax.v
+++ b/theories/ZArith/Zminmax.v
@@ -1,202 +1,22 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-Require Import Orders BinInt Zcompare Zorder ZOrderedType
- GenericMinMax.
-
-(** * Maximum and Minimum of two [Z] numbers *)
-
-Local Open Scope Z_scope.
-
-Unboxed Definition Zmax (n m:Z) :=
-  match n ?= m with
-    | Eq | Gt => n
-    | Lt => m
-  end.
-
-Unboxed Definition Zmin (n m:Z) :=
-  match n ?= m with
-    | Eq | Lt => n
-    | Gt => m
-  end.
-
-(** The functions [Zmax] and [Zmin] implement indeed
-    a maximum and a minimum *)
-
-Lemma Zmax_l : forall x y, y<=x -> Zmax x y = x.
-Proof.
- unfold Zle, Zmax. intros x y. rewrite <- (Zcompare_antisym x y).
- destruct (x ?= y); intuition.
-Qed.
-
-Lemma Zmax_r : forall x y, x<=y -> Zmax x y = y.
-Proof.
- unfold Zle, Zmax. intros x y. generalize (Zcompare_Eq_eq x y).
- destruct (x ?= y); intuition.
-Qed.
-
-Lemma Zmin_l : forall x y, x<=y -> Zmin x y = x.
-Proof.
- unfold Zle, Zmin. intros x y. generalize (Zcompare_Eq_eq x y).
- destruct (x ?= y); intuition.
-Qed.
-
-Lemma Zmin_r : forall x y, y<=x -> Zmin x y = y.
-Proof.
- unfold Zle, Zmin. intros x y.
- rewrite <- (Zcompare_antisym x y). generalize (Zcompare_Eq_eq x y).
- destruct (x ?= y); intuition.
-Qed.
-
-Module ZHasMinMax <: HasMinMax Z_as_OT.
- Definition max := Zmax.
- Definition min := Zmin.
- Definition max_l := Zmax_l.
- Definition max_r := Zmax_r.
- Definition min_l := Zmin_l.
- Definition min_r := Zmin_r.
-End ZHasMinMax.
-
-Module Z.
-
-(** We obtain hence all the generic properties of max and min. *)
-
-Include UsualMinMaxProperties Z_as_OT ZHasMinMax.
-
-(** * Properties specific to the [Z] domain *)
-
-(** Compatibilities (consequences of monotonicity) *)
-
-Lemma plus_max_distr_l : forall n m p, Zmax (p + n) (p + m) = p + Zmax n m.
-Proof.
- intros. apply max_monotone.
- intros x y. apply Zplus_le_compat_l.
-Qed.
-
-Lemma plus_max_distr_r : forall n m p, Zmax (n + p) (m + p) = Zmax n m + p.
-Proof.
- intros. rewrite (Zplus_comm n p), (Zplus_comm m p), (Zplus_comm _ p).
- apply plus_max_distr_l.
-Qed.
-
-Lemma plus_min_distr_l : forall n m p, Zmin (p + n) (p + m) = p + Zmin n m.
-Proof.
- intros. apply Z.min_monotone.
- intros x y. apply Zplus_le_compat_l.
-Qed.
-
-Lemma plus_min_distr_r : forall n m p, Zmin (n + p) (m + p) = Zmin n m + p.
-Proof.
- intros. rewrite (Zplus_comm n p), (Zplus_comm m p), (Zplus_comm _ p).
- apply plus_min_distr_l.
-Qed.
-
-Lemma succ_max_distr : forall n m, Zsucc (Zmax n m) = Zmax (Zsucc n) (Zsucc m).
-Proof.
- unfold Zsucc. intros. symmetry. apply plus_max_distr_r.
-Qed.
-
-Lemma succ_min_distr : forall n m, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m).
-Proof.
- unfold Zsucc. intros. symmetry. apply plus_min_distr_r.
-Qed.
-
-Lemma pred_max_distr : forall n m, Zpred (Zmax n m) = Zmax (Zpred n) (Zpred m).
-Proof.
- unfold Zpred. intros. symmetry. apply plus_max_distr_r.
-Qed.
-
-Lemma pred_min_distr : forall n m, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m).
-Proof.
- unfold Zpred. intros. symmetry. apply plus_min_distr_r.
-Qed.
-
-(** Anti-monotonicity swaps the role of [min] and [max] *)
-
-Lemma opp_max_distr : forall n m : Z, -(Zmax n m) = Zmin (- n) (- m).
-Proof.
- intros. symmetry. apply min_max_antimonotone.
- intros x x'. red. red. rewrite <- Zcompare_opp; auto.
-Qed.
-
-Lemma opp_min_distr : forall n m : Z, - (Zmin n m) = Zmax (- n) (- m).
-Proof.
- intros. symmetry. apply max_min_antimonotone.
- intros x x'. red. red. rewrite <- Zcompare_opp; auto.
-Qed.
-
-Lemma minus_max_distr_l : forall n m p, Zmax (p - n) (p - m) = p - Zmin n m.
-Proof.
- unfold Zminus. intros. rewrite opp_min_distr. apply plus_max_distr_l.
-Qed.
-
-Lemma minus_max_distr_r : forall n m p, Zmax (n - p) (m - p) = Zmax n m - p.
-Proof.
- unfold Zminus. intros. apply plus_max_distr_r.
-Qed.
-
-Lemma minus_min_distr_l : forall n m p, Zmin (p - n) (p - m) = p - Zmax n m.
-Proof.
- unfold Zminus. intros. rewrite opp_max_distr. apply plus_min_distr_l.
-Qed.
-
-Lemma minus_min_distr_r : forall n m p, Zmin (n - p) (m - p) = Zmin n m - p.
-Proof.
- unfold Zminus. intros. apply plus_min_distr_r.
-Qed.
-
-(** Compatibility with [Zpos] *)
-
-Lemma pos_max : forall p q, Zpos (Pmax p q) = Zmax (Zpos p) (Zpos q).
-Proof.
- intros; unfold Zmax, Pmax; simpl; generalize (Pcompare_Eq_eq p q).
- destruct Pcompare; auto.
- intro H; rewrite H; auto.
-Qed.
-
-Lemma pos_min : forall p q, Zpos (Pmin p q) = Zmin (Zpos p) (Zpos q).
-Proof.
- intros; unfold Zmin, Pmin; simpl; generalize (Pcompare_Eq_eq p q).
- destruct Pcompare; auto.
-Qed.
-
-Lemma pos_max_1 : forall p, Zmax 1 (Zpos p) = Zpos p.
-Proof.
-  intros; unfold Zmax; simpl; destruct p; simpl; auto.
-Qed.
-
-Lemma pos_min_1 : forall p, Zmin 1 (Zpos p) = 1.
-Proof.
-  intros; unfold Zmax; simpl; destruct p; simpl; auto.
-Qed.
-
-End Z.
-
-
-(** * Characterization of Pminus in term of Zminus and Zmax *)
-
-Lemma Zpos_minus : forall p q, Zpos (Pminus p q) = Zmax 1 (Zpos p - Zpos q).
-Proof.
-  intros; simpl. destruct (Pcompare p q Eq) as [ ]_eqn:H.
-  rewrite (Pcompare_Eq_eq _ _ H).
-  unfold Pminus; rewrite Pminus_mask_diag; reflexivity.
-  rewrite Pminus_Lt; auto.
-  symmetry. apply Z.pos_max_1.
-Qed.
+Require Import Orders BinInt Zcompare Zorder.
 
+(** THIS FILE IS DEPRECATED. *)
 
 (*begin hide*)
 (* Compatibility with names of the old Zminmax file *)
-Notation Zmin_max_absorption_r_r := Z.min_max_absorption (only parsing).
-Notation Zmax_min_absorption_r_r := Z.max_min_absorption (only parsing).
-Notation Zmax_min_distr_r := Z.max_min_distr (only parsing).
-Notation Zmin_max_distr_r := Z.min_max_distr (only parsing).
-Notation Zmax_min_modular_r := Z.max_min_modular (only parsing).
-Notation Zmin_max_modular_r := Z.min_max_modular (only parsing).
-Notation max_min_disassoc := Z.max_min_disassoc (only parsing).
-(*end hide*)
\ No newline at end of file
+Notation Zmin_max_absorption_r_r := Z.min_max_absorption (compat "8.3").
+Notation Zmax_min_absorption_r_r := Z.max_min_absorption (compat "8.3").
+Notation Zmax_min_distr_r := Z.max_min_distr (compat "8.3").
+Notation Zmin_max_distr_r := Z.min_max_distr (compat "8.3").
+Notation Zmax_min_modular_r := Z.max_min_modular (compat "8.3").
+Notation Zmin_max_modular_r := Z.min_max_modular (compat "8.3").
+Notation max_min_disassoc := Z.max_min_disassoc (compat "8.3").
+(*end hide*)
diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v
index a8872bd5..d0ec1916 100644
--- a/theories/ZArith/Zmisc.v
+++ b/theories/ZArith/Zmisc.v
@@ -1,91 +1,29 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zmisc.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import Wf_nat.
 Require Import BinInt.
 Require Import Zcompare.
 Require Import Zorder.
 Require Import Bool.
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 (**********************************************************************)
 (** Iterators *)
 
 (** [n]th iteration of the function [f] *)
 
-Fixpoint iter_pos (n:positive) (A:Type) (f:A -> A) (x:A) : A :=
-  match n with
-    | xH => f x
-    | xO n' => iter_pos n' A f (iter_pos n' A f x)
-    | xI n' => f (iter_pos n' A f (iter_pos n' A f x))
-  end.
-
-Definition iter (n:Z) (A:Type) (f:A -> A) (x:A) :=
-  match n with
-    | Z0 => x
-    | Zpos p => iter_pos p A f x
-    | Zneg p => x
-  end.
-
-Theorem iter_nat_of_P :
-  forall (p:positive) (A:Type) (f:A -> A) (x:A),
-    iter_pos p A f x = iter_nat (nat_of_P p) A f x.
-Proof.
-  intro n; induction n as [p H| p H| ];
-    [ intros; simpl in |- *; rewrite (H A f x);
-      rewrite (H A f (iter_nat (nat_of_P p) A f x));
-	rewrite (ZL6 p); symmetry  in |- *; apply f_equal with (f := f);
-	  apply iter_nat_plus
-      | intros; unfold nat_of_P in |- *; simpl in |- *; rewrite (H A f x);
-	rewrite (H A f (iter_nat (nat_of_P p) A f x));
-	  rewrite (ZL6 p); symmetry  in |- *; apply iter_nat_plus
-      | simpl in |- *; auto with arith ].
-Qed.
+Notation iter := @Z.iter (compat "8.3").
 
 Lemma iter_nat_of_Z : forall n A f x, 0 <= n ->
-  iter n A f x = iter_nat (Zabs_nat n) A f x.
+  Z.iter n f x = iter_nat (Z.abs_nat n) A f x.
+Proof.
 intros n A f x; case n; auto.
-intros p _; unfold iter, Zabs_nat; apply iter_nat_of_P.
+intros p _; unfold Z.iter, Z.abs_nat; apply Pos2Nat.inj_iter.
 intros p abs; case abs; trivial.
 Qed.
-
-Theorem iter_pos_plus :
-  forall (p q:positive) (A:Type) (f:A -> A) (x:A),
-    iter_pos (p + q) A f x = iter_pos p A f (iter_pos q A f x).
-Proof.
-  intros n m; intros.
-  rewrite (iter_nat_of_P m A f x).
-  rewrite (iter_nat_of_P n A f (iter_nat (nat_of_P m) A f x)).
-  rewrite (iter_nat_of_P (n + m) A f x).
-  rewrite (nat_of_P_plus_morphism n m).
-  apply iter_nat_plus.
-Qed.
-
-(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv],
-    then the iterates of [f] also preserve it. *)
-
-Theorem iter_nat_invariant :
-  forall (n:nat) (A:Type) (f:A -> A) (Inv:A -> Prop),
-    (forall x:A, Inv x -> Inv (f x)) ->
-    forall x:A, Inv x -> Inv (iter_nat n A f x).
-Proof.
-  simple induction n; intros;
-    [ trivial with arith
-      | simpl in |- *; apply H0 with (x := iter_nat n0 A f x); apply H;
-	trivial with arith ].
-Qed.
-
-Theorem iter_pos_invariant :
-  forall (p:positive) (A:Type) (f:A -> A) (Inv:A -> Prop),
-    (forall x:A, Inv x -> Inv (f x)) ->
-    forall x:A, Inv x -> Inv (iter_pos p A f x).
-Proof.
-  intros; rewrite iter_nat_of_P; apply iter_nat_invariant; trivial with arith.
-Qed.
diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v
index 9585b6f6..27b7e6a0 100644
--- a/theories/ZArith/Znat.v
+++ b/theories/ZArith/Znat.v
@@ -1,286 +1,1017 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Znat.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
 
 Require Export Arith_base.
-Require Import BinPos.
-Require Import BinInt.
-Require Import Zcompare.
-Require Import Zorder.
-Require Import Decidable.
-Require Import Peano_dec.
-Require Import Min Max Zmin Zmax.
-Require Export Compare_dec.
+Require Import BinPos BinInt BinNat Pnat Nnat.
+
+Local Open Scope Z_scope.
+
+(** Conversions between integers and natural numbers
+
+    Seven sections:
+    - chains of conversions (combining two conversions)
+    - module N2Z : from N to Z
+    - module Z2N : from Z to N (negative numbers rounded to 0)
+    - module Zabs2N : from Z to N (via the absolute value)
+    - module Nat2Z : from nat to Z
+    - module Z2Nat : from Z to nat (negative numbers rounded to 0)
+    - module Zabs2Nat : from Z to nat (via the absolute value)
+*)
+
+(** * Chains of conversions *)
+
+(** When combining successive conversions, we have the following
+    commutative diagram:
+<<
+      ---> Nat ----
+     |      ^      |
+     |      |      v
+    Pos ---------> Z
+     |      |      ^
+     |      v      |
+      ----> N -----
+>>
+*)
+
+Lemma nat_N_Z n : Z.of_N (N.of_nat n) = Z.of_nat n.
+Proof.
+ now destruct n.
+Qed.
 
-Open Local Scope Z_scope.
+Lemma N_nat_Z n : Z.of_nat (N.to_nat n) = Z.of_N n.
+Proof.
+ destruct n; trivial. simpl.
+ destruct (Pos2Nat.is_succ p) as (m,H).
+ rewrite H. simpl. f_equal. now apply SuccNat2Pos.inv.
+Qed.
 
-Definition neq (x y:nat) := x <> y.
+Lemma positive_nat_Z p : Z.of_nat (Pos.to_nat p) = Zpos p.
+Proof.
+ destruct (Pos2Nat.is_succ p) as (n,H).
+ rewrite H. simpl. f_equal. now apply SuccNat2Pos.inv.
+Qed.
+
+Lemma positive_N_Z p : Z.of_N (Npos p) = Zpos p.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma positive_N_nat p : N.to_nat (Npos p) = Pos.to_nat p.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma positive_nat_N p : N.of_nat (Pos.to_nat p) = Npos p.
+Proof.
+ destruct (Pos2Nat.is_succ p) as (n,H).
+ rewrite H. simpl. f_equal. now apply SuccNat2Pos.inv.
+Qed.
+
+Lemma Z_N_nat n : N.to_nat (Z.to_N n) = Z.to_nat n.
+Proof.
+ now destruct n.
+Qed.
+
+Lemma Z_nat_N n : N.of_nat (Z.to_nat n) = Z.to_N n.
+Proof.
+ destruct n; simpl; trivial. apply positive_nat_N.
+Qed.
+
+Lemma Zabs_N_nat n : N.to_nat (Z.abs_N n) = Z.abs_nat n.
+Proof.
+ now destruct n.
+Qed.
+
+Lemma Zabs_nat_N n : N.of_nat (Z.abs_nat n) = Z.abs_N n.
+Proof.
+ destruct n; simpl; trivial; apply positive_nat_N.
+Qed.
+
+
+(** * Conversions between [Z] and [N] *)
+
+Module N2Z.
+
+(** [Z.of_N] is a bijection between [N] and non-negative [Z],
+    with [Z.to_N] (or [Z.abs_N]) as reciprocal.
+    See [Z2N.id] below for the dual equation. *)
+
+Lemma id n : Z.to_N (Z.of_N n) = n.
+Proof.
+ now destruct n.
+Qed.
+
+(** [Z.of_N] is hence injective *)
+
+Lemma inj n m : Z.of_N n = Z.of_N m -> n = m.
+Proof.
+ destruct n, m; simpl; congruence.
+Qed.
+
+Lemma inj_iff n m : Z.of_N n = Z.of_N m <-> n = m.
+Proof.
+ split. apply inj. intros; now f_equal.
+Qed.
+
+(** [Z.of_N] produce non-negative integers *)
+
+Lemma is_nonneg n : 0 <= Z.of_N n.
+Proof.
+ now destruct n.
+Qed.
+
+(** [Z.of_N], basic equations *)
+
+Lemma inj_0 : Z.of_N 0 = 0.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma inj_pos p : Z.of_N (Npos p) = Zpos p.
+Proof.
+ reflexivity.
+Qed.
+
+(** [Z.of_N] and usual operations. *)
+
+Lemma inj_compare n m : (Z.of_N n ?= Z.of_N m) = (n ?= m)%N.
+Proof.
+ now destruct n, m.
+Qed.
+
+Lemma inj_le n m : (n<=m)%N <-> Z.of_N n <= Z.of_N m.
+Proof.
+ unfold Z.le. now rewrite inj_compare.
+Qed.
+
+Lemma inj_lt n m : (n<m)%N <-> Z.of_N n < Z.of_N m.
+Proof.
+ unfold Z.lt. now rewrite inj_compare.
+Qed.
+
+Lemma inj_ge n m : (n>=m)%N <-> Z.of_N n >= Z.of_N m.
+Proof.
+ unfold Z.ge. now rewrite inj_compare.
+Qed.
+
+Lemma inj_gt n m : (n>m)%N <-> Z.of_N n > Z.of_N m.
+Proof.
+ unfold Z.gt. now rewrite inj_compare.
+Qed.
+
+Lemma inj_abs_N z : Z.of_N (Z.abs_N z) = Z.abs z.
+Proof.
+ now destruct z.
+Qed.
+
+Lemma inj_add n m : Z.of_N (n+m) = Z.of_N n + Z.of_N m.
+Proof.
+ now destruct n, m.
+Qed.
+
+Lemma inj_mul n m : Z.of_N (n*m) = Z.of_N n * Z.of_N m.
+Proof.
+ now destruct n, m.
+Qed.
+
+Lemma inj_sub_max n m : Z.of_N (n-m) = Z.max 0 (Z.of_N n - Z.of_N m).
+Proof.
+ destruct n as [|n], m as [|m]; simpl; trivial.
+ rewrite Z.pos_sub_spec, Pos.compare_sub_mask. unfold Pos.sub.
+ now destruct (Pos.sub_mask n m).
+Qed.
+
+Lemma inj_sub n m : (m<=n)%N -> Z.of_N (n-m) = Z.of_N n - Z.of_N m.
+Proof.
+ intros H. rewrite inj_sub_max.
+ unfold N.le in H.
+ rewrite N.compare_antisym, <- inj_compare, Z.compare_sub in H.
+ destruct (Z.of_N n - Z.of_N m); trivial; now destruct H.
+Qed.
+
+Lemma inj_succ n : Z.of_N (N.succ n) = Z.succ (Z.of_N n).
+Proof.
+ destruct n. trivial. simpl. now rewrite Pos.add_1_r.
+Qed.
+
+Lemma inj_pred_max n : Z.of_N (N.pred n) = Z.max 0 (Z.pred (Z.of_N n)).
+Proof.
+ unfold Z.pred. now rewrite N.pred_sub, inj_sub_max.
+Qed.
+
+Lemma inj_pred n : (0<n)%N -> Z.of_N (N.pred n) = Z.pred (Z.of_N n).
+Proof.
+ intros H. unfold Z.pred. rewrite N.pred_sub, inj_sub; trivial.
+ now apply N.le_succ_l in H.
+Qed.
+
+Lemma inj_min n m : Z.of_N (N.min n m) = Z.min (Z.of_N n) (Z.of_N m).
+Proof.
+ unfold Z.min, N.min. rewrite inj_compare. now case N.compare.
+Qed.
+
+Lemma inj_max n m : Z.of_N (N.max n m) = Z.max (Z.of_N n) (Z.of_N m).
+Proof.
+ unfold Z.max, N.max. rewrite inj_compare.
+ case N.compare_spec; intros; subst; trivial.
+Qed.
+
+Lemma inj_div n m : Z.of_N (n/m) = Z.of_N n / Z.of_N m.
+Proof.
+ destruct m as [|m]. now destruct n.
+ apply Z.div_unique_pos with (Z.of_N (n mod (Npos m))).
+ split. apply is_nonneg. apply inj_lt. now apply N.mod_lt.
+ rewrite <- inj_mul, <- inj_add. f_equal. now apply N.div_mod.
+Qed.
+
+Lemma inj_mod n m : (m<>0)%N -> Z.of_N (n mod m) = (Z.of_N n) mod (Z.of_N m).
+Proof.
+ intros Hm.
+ apply Z.mod_unique_pos with (Z.of_N (n / m)).
+ split. apply is_nonneg. apply inj_lt. now apply N.mod_lt.
+ rewrite <- inj_mul, <- inj_add. f_equal. now apply N.div_mod.
+Qed.
+
+Lemma inj_quot n m : Z.of_N (n/m) = Z.of_N n ÷ Z.of_N m.
+Proof.
+ destruct m.
+ - now destruct n.
+ - rewrite Z.quot_div_nonneg, inj_div; trivial. apply is_nonneg. easy.
+Qed.
+
+Lemma inj_rem n m : Z.of_N (n mod m) = Z.rem (Z.of_N n) (Z.of_N m).
+Proof.
+ destruct m.
+ - now destruct n.
+ - rewrite Z.rem_mod_nonneg, inj_mod; trivial. easy. apply is_nonneg. easy.
+Qed.
+
+Lemma inj_div2 n : Z.of_N (N.div2 n) = Z.div2 (Z.of_N n).
+Proof.
+ destruct n as [|p]; trivial. now destruct p.
+Qed.
+
+Lemma inj_quot2 n : Z.of_N (N.div2 n) = Z.quot2 (Z.of_N n).
+Proof.
+ destruct n as [|p]; trivial. now destruct p.
+Qed.
+
+Lemma inj_pow n m : Z.of_N (n^m) = (Z.of_N n)^(Z.of_N m).
+Proof.
+ destruct n, m; trivial. now rewrite Z.pow_0_l. apply Pos2Z.inj_pow.
+Qed.
+
+Lemma inj_testbit a n :
+ Z.testbit (Z.of_N a) (Z.of_N n) = N.testbit a n.
+Proof. apply Z.Private_BootStrap.testbit_of_N. Qed.
+
+End N2Z.
+
+Module Z2N.
+
+(** [Z.to_N] is a bijection between non-negative [Z] and [N],
+    with [Pos.of_N] as reciprocal.
+    See [N2Z.id] above for the dual equation. *)
+
+Lemma id n : 0<=n -> Z.of_N (Z.to_N n) = n.
+Proof.
+ destruct n; (now destruct 1) || trivial.
+Qed.
+
+(** [Z.to_N] is hence injective for non-negative integers. *)
+
+Lemma inj n m : 0<=n -> 0<=m -> Z.to_N n = Z.to_N m -> n = m.
+Proof.
+ intros. rewrite <- (id n), <- (id m) by trivial. now f_equal.
+Qed.
+
+Lemma inj_iff n m : 0<=n -> 0<=m -> (Z.to_N n = Z.to_N m <-> n = m).
+Proof.
+ intros. split. now apply inj. intros; now subst.
+Qed.
+
+(** [Z.to_N], basic equations *)
+
+Lemma inj_0 : Z.to_N 0 = 0%N.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma inj_pos n : Z.to_N (Zpos n) = Npos n.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma inj_neg n : Z.to_N (Zneg n) = 0%N.
+Proof.
+ reflexivity.
+Qed.
+
+(** [Z.to_N] and operations *)
+
+Lemma inj_add n m : 0<=n -> 0<=m -> Z.to_N (n+m) = (Z.to_N n + Z.to_N m)%N.
+Proof.
+ destruct n, m; trivial; (now destruct 1) || (now destruct 2).
+Qed.
+
+Lemma inj_mul n m : 0<=n -> 0<=m -> Z.to_N (n*m) = (Z.to_N n * Z.to_N m)%N.
+Proof.
+ destruct n, m; trivial; (now destruct 1) || (now destruct 2).
+Qed.
+
+Lemma inj_succ n : 0<=n -> Z.to_N (Z.succ n) = N.succ (Z.to_N n).
+Proof.
+ unfold Z.succ. intros. rewrite inj_add by easy. apply N.add_1_r.
+Qed.
+
+Lemma inj_sub n m : 0<=m -> Z.to_N (n - m) = (Z.to_N n - Z.to_N m)%N.
+Proof.
+ destruct n as [|n|n], m as [|m|m]; trivial; try (now destruct 1).
+ intros _. simpl.
+ rewrite Z.pos_sub_spec, Pos.compare_sub_mask. unfold Pos.sub.
+ now destruct (Pos.sub_mask n m).
+Qed.
+
+Lemma inj_pred n : Z.to_N (Z.pred n) = N.pred (Z.to_N n).
+Proof.
+ unfold Z.pred. rewrite <- N.sub_1_r. now apply (inj_sub n 1).
+Qed.
+
+Lemma inj_compare n m : 0<=n -> 0<=m ->
+ (Z.to_N n ?= Z.to_N m)%N = (n ?= m).
+Proof.
+ intros Hn Hm. now rewrite <- N2Z.inj_compare, !id.
+Qed.
+
+Lemma inj_le n m : 0<=n -> 0<=m -> (n<=m <-> (Z.to_N n <= Z.to_N m)%N).
+Proof.
+ intros Hn Hm. unfold Z.le, N.le. now rewrite inj_compare.
+Qed.
+
+Lemma inj_lt n m : 0<=n -> 0<=m -> (n<m <-> (Z.to_N n < Z.to_N m)%N).
+Proof.
+ intros Hn Hm. unfold Z.lt, N.lt. now rewrite inj_compare.
+Qed.
+
+Lemma inj_min n m : Z.to_N (Z.min n m) = N.min (Z.to_N n) (Z.to_N m).
+Proof.
+ destruct n, m; simpl; trivial; unfold Z.min, N.min; simpl;
+  now case Pos.compare.
+Qed.
+
+Lemma inj_max n m : Z.to_N (Z.max n m) = N.max (Z.to_N n) (Z.to_N m).
+Proof.
+ destruct n, m; simpl; trivial; unfold Z.max, N.max; simpl.
+  case Pos.compare_spec; intros; subst; trivial.
+  now case Pos.compare.
+Qed.
+
+Lemma inj_div n m : 0<=n -> 0<=m -> Z.to_N (n/m) = (Z.to_N n / Z.to_N m)%N.
+Proof.
+ destruct n, m; trivial; intros Hn Hm;
+ (now destruct Hn) || (now destruct Hm) || clear.
+ simpl. rewrite <- (N2Z.id (_ / _)). f_equal. now rewrite N2Z.inj_div.
+Qed.
+
+Lemma inj_mod n m : 0<=n -> 0<m ->
+ Z.to_N (n mod m) = ((Z.to_N n) mod (Z.to_N m))%N.
+Proof.
+ destruct n, m; trivial; intros Hn Hm;
+ (now destruct Hn) || (now destruct Hm) || clear.
+ simpl. rewrite <- (N2Z.id (_ mod _)). f_equal. now rewrite N2Z.inj_mod.
+Qed.
+
+Lemma inj_quot n m : 0<=n -> 0<=m -> Z.to_N (n÷m) = (Z.to_N n / Z.to_N m)%N.
+Proof.
+ destruct m.
+ - now destruct n.
+ - intros. now rewrite Z.quot_div_nonneg, inj_div.
+ - now destruct 2.
+Qed.
+
+Lemma inj_rem n m :0<=n -> 0<=m ->
+ Z.to_N (Z.rem n m) = ((Z.to_N n) mod (Z.to_N m))%N.
+Proof.
+ destruct m.
+ - now destruct n.
+ - intros. now rewrite Z.rem_mod_nonneg, inj_mod.
+ - now destruct 2.
+Qed.
 
-(************************************************)
-(** Properties of the injection from nat into Z *)
+Lemma inj_div2 n : Z.to_N (Z.div2 n) = N.div2 (Z.to_N n).
+Proof.
+ destruct n as [|p|p]; trivial. now destruct p.
+Qed.
+
+Lemma inj_quot2 n : Z.to_N (Z.quot2 n) = N.div2 (Z.to_N n).
+Proof.
+ destruct n as [|p|p]; trivial; now destruct p.
+Qed.
+
+Lemma inj_pow n m : 0<=n -> 0<=m -> Z.to_N (n^m) = ((Z.to_N n)^(Z.to_N m))%N.
+Proof.
+ destruct m.
+ - trivial.
+ - intros. now rewrite <- (N2Z.id (_ ^ _)), N2Z.inj_pow, id.
+ - now destruct 2.
+Qed.
+
+Lemma inj_testbit a n : 0<=n ->
+ Z.testbit (Z.of_N a) n = N.testbit a (Z.to_N n).
+Proof. apply Z.Private_BootStrap.testbit_of_N'. Qed.
+
+End Z2N.
+
+Module Zabs2N.
+
+(** Results about [Z.abs_N], converting absolute values of [Z] integers
+    to [N]. *)
+
+Lemma abs_N_spec n : Z.abs_N n = Z.to_N (Z.abs n).
+Proof.
+ now destruct n.
+Qed.
+
+Lemma abs_N_nonneg n : 0<=n -> Z.abs_N n = Z.to_N n.
+Proof.
+ destruct n; trivial; now destruct 1.
+Qed.
+
+Lemma id_abs n : Z.of_N (Z.abs_N n) = Z.abs n.
+Proof.
+ now destruct n.
+Qed.
+
+Lemma id n : Z.abs_N (Z.of_N n) = n.
+Proof.
+ now destruct n.
+Qed.
+
+(** [Z.abs_N], basic equations *)
+
+Lemma inj_0 : Z.abs_N 0 = 0%N.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma inj_pos p : Z.abs_N (Zpos p) = Npos p.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma inj_neg p : Z.abs_N (Zneg p) = Npos p.
+Proof.
+ reflexivity.
+Qed.
+
+(** [Z.abs_N] and usual operations, with non-negative integers *)
+
+Lemma inj_opp n : Z.abs_N (-n) = Z.abs_N n.
+Proof.
+ now destruct n.
+Qed.
+
+Lemma inj_succ n : 0<=n -> Z.abs_N (Z.succ n) = N.succ (Z.abs_N n).
+Proof.
+ intros. rewrite !abs_N_nonneg; trivial. now apply Z2N.inj_succ.
+ now apply Z.le_le_succ_r.
+Qed.
+
+Lemma inj_add n m : 0<=n -> 0<=m -> Z.abs_N (n+m) = (Z.abs_N n + Z.abs_N m)%N.
+Proof.
+ intros. rewrite !abs_N_nonneg; trivial. now apply Z2N.inj_add.
+ now apply Z.add_nonneg_nonneg.
+Qed.
+
+Lemma inj_mul n m : Z.abs_N (n*m) = (Z.abs_N n * Z.abs_N m)%N.
+Proof.
+ now destruct n, m.
+Qed.
+
+Lemma inj_sub n m : 0<=m<=n -> Z.abs_N (n-m) = (Z.abs_N n - Z.abs_N m)%N.
+Proof.
+ intros (Hn,H). rewrite !abs_N_nonneg; trivial. now apply Z2N.inj_sub.
+ Z.order.
+ now apply Z.le_0_sub.
+Qed.
+
+Lemma inj_pred n : 0<n -> Z.abs_N (Z.pred n) = N.pred (Z.abs_N n).
+Proof.
+ intros. rewrite !abs_N_nonneg. now apply Z2N.inj_pred.
+ Z.order.
+ apply Z.lt_succ_r. now rewrite Z.succ_pred.
+Qed.
+
+Lemma inj_compare n m : 0<=n -> 0<=m ->
+ (Z.abs_N n ?= Z.abs_N m)%N = (n ?= m).
+Proof.
+ intros. rewrite !abs_N_nonneg by trivial. now apply Z2N.inj_compare.
+Qed.
+
+Lemma inj_le n m : 0<=n -> 0<=m -> (n<=m <-> (Z.abs_N n <= Z.abs_N m)%N).
+Proof.
+ intros Hn Hm. unfold Z.le, N.le. now rewrite inj_compare.
+Qed.
+
+Lemma inj_lt n m : 0<=n -> 0<=m -> (n<m <-> (Z.abs_N n < Z.abs_N m)%N).
+Proof.
+ intros Hn Hm. unfold Z.lt, N.lt. now rewrite inj_compare.
+Qed.
+
+Lemma inj_min n m : 0<=n -> 0<=m ->
+ Z.abs_N (Z.min n m) = N.min (Z.abs_N n) (Z.abs_N m).
+Proof.
+ intros. rewrite !abs_N_nonneg; trivial. now apply Z2N.inj_min.
+ now apply Z.min_glb.
+Qed.
+
+Lemma inj_max n m : 0<=n -> 0<=m ->
+ Z.abs_N (Z.max n m) = N.max (Z.abs_N n) (Z.abs_N m).
+Proof.
+ intros. rewrite !abs_N_nonneg; trivial. now apply Z2N.inj_max.
+ transitivity n; trivial. apply Z.le_max_l.
+Qed.
+
+Lemma inj_quot n m : Z.abs_N (n÷m) = ((Z.abs_N n) / (Z.abs_N m))%N.
+Proof.
+ assert (forall p q, Z.abs_N (Zpos p ÷ Zpos q) = (Npos p / Npos q)%N).
+  intros. rewrite abs_N_nonneg. now apply Z2N.inj_quot. now apply Z.quot_pos.
+ destruct n, m; trivial; simpl.
+ - trivial.
+ - now rewrite <- Pos2Z.opp_pos, Z.quot_opp_r, inj_opp.
+ - now rewrite <- Pos2Z.opp_pos, Z.quot_opp_l, inj_opp.
+ - now rewrite <- 2 Pos2Z.opp_pos, Z.quot_opp_opp.
+Qed.
+
+Lemma inj_rem n m : Z.abs_N (Z.rem n m) = ((Z.abs_N n) mod (Z.abs_N m))%N.
+Proof.
+ assert
+  (forall p q, Z.abs_N (Z.rem (Zpos p) (Zpos q)) = ((Npos p) mod (Npos q))%N).
+  intros. rewrite abs_N_nonneg. now apply Z2N.inj_rem. now apply Z.rem_nonneg.
+ destruct n, m; trivial; simpl.
+ - trivial.
+ - now rewrite <- Pos2Z.opp_pos, Z.rem_opp_r.
+ - now rewrite <- Pos2Z.opp_pos, Z.rem_opp_l, inj_opp.
+ - now rewrite <- 2 Pos2Z.opp_pos, Z.rem_opp_opp, inj_opp.
+Qed.
+
+Lemma inj_pow n m : 0<=m -> Z.abs_N (n^m) = ((Z.abs_N n)^(Z.abs_N m))%N.
+Proof.
+ intros Hm. rewrite abs_N_spec, Z.abs_pow, Z2N.inj_pow, <- abs_N_spec; trivial.
+ f_equal. symmetry; now apply abs_N_nonneg. apply Z.abs_nonneg.
+Qed.
+
+(** [Z.abs_N] and usual operations, statements with [Z.abs] *)
+
+Lemma inj_succ_abs n : Z.abs_N (Z.succ (Z.abs n)) = N.succ (Z.abs_N n).
+Proof.
+ destruct n; simpl; trivial; now rewrite Pos.add_1_r.
+Qed.
+
+Lemma inj_add_abs n m :
+ Z.abs_N (Z.abs n + Z.abs m) = (Z.abs_N n + Z.abs_N m)%N.
+Proof.
+ now destruct n, m.
+Qed.
+
+Lemma inj_mul_abs n m :
+ Z.abs_N (Z.abs n * Z.abs m) = (Z.abs_N n * Z.abs_N m)%N.
+Proof.
+ now destruct n, m.
+Qed.
+
+End Zabs2N.
+
+
+(** * Conversions between [Z] and [nat] *)
+
+Module Nat2Z.
+
+(** [Z.of_nat], basic equations *)
+
+Lemma inj_0 : Z.of_nat 0 = 0.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma inj_succ n : Z.of_nat (S n) = Z.succ (Z.of_nat n).
+Proof.
+ destruct n. trivial. simpl. apply Pos2Z.inj_succ.
+Qed.
+
+(** [Z.of_N] produce non-negative integers *)
+
+Lemma is_nonneg n : 0 <= Z.of_nat n.
+Proof.
+ now induction n.
+Qed.
+
+(** [Z.of_nat] is a bijection between [nat] and non-negative [Z],
+    with [Z.to_nat] (or [Z.abs_nat]) as reciprocal.
+    See [Z2Nat.id] below for the dual equation. *)
+
+Lemma id n : Z.to_nat (Z.of_nat n) = n.
+Proof.
+ now rewrite <- nat_N_Z, <- Z_N_nat, N2Z.id, Nat2N.id.
+Qed.
+
+(** [Z.of_nat] is hence injective *)
+
+Lemma inj n m : Z.of_nat n = Z.of_nat m -> n = m.
+Proof.
+ intros H. now rewrite <- (id n), <- (id m), H.
+Qed.
+
+Lemma inj_iff n m : Z.of_nat n = Z.of_nat m <-> n = m.
+Proof.
+ split. apply inj. intros; now f_equal.
+Qed.
+
+(** [Z.of_nat] and usual operations *)
+
+Lemma inj_compare n m : (Z.of_nat n ?= Z.of_nat m) = nat_compare n m.
+Proof.
+ now rewrite <-!nat_N_Z, N2Z.inj_compare, <- Nat2N.inj_compare.
+Qed.
+
+Lemma inj_le n m : (n<=m)%nat <-> Z.of_nat n <= Z.of_nat m.
+Proof.
+ unfold Z.le. now rewrite inj_compare, nat_compare_le.
+Qed.
+
+Lemma inj_lt n m : (n<m)%nat <-> Z.of_nat n < Z.of_nat m.
+Proof.
+ unfold Z.lt. now rewrite inj_compare, nat_compare_lt.
+Qed.
+
+Lemma inj_ge n m : (n>=m)%nat <-> Z.of_nat n >= Z.of_nat m.
+Proof.
+ unfold Z.ge. now rewrite inj_compare, nat_compare_ge.
+Qed.
+
+Lemma inj_gt n m : (n>m)%nat <-> Z.of_nat n > Z.of_nat m.
+Proof.
+ unfold Z.gt. now rewrite inj_compare, nat_compare_gt.
+Qed.
+
+Lemma inj_abs_nat z : Z.of_nat (Z.abs_nat z) = Z.abs z.
+Proof.
+ destruct z; simpl; trivial;
+  destruct (Pos2Nat.is_succ p) as (n,H); rewrite H; simpl; f_equal;
+   now apply SuccNat2Pos.inv.
+Qed.
+
+Lemma inj_add n m : Z.of_nat (n+m) = Z.of_nat n + Z.of_nat m.
+Proof.
+ now rewrite <- !nat_N_Z, Nat2N.inj_add, N2Z.inj_add.
+Qed.
+
+Lemma inj_mul n m : Z.of_nat (n*m) = Z.of_nat n * Z.of_nat m.
+Proof.
+ now rewrite <- !nat_N_Z, Nat2N.inj_mul, N2Z.inj_mul.
+Qed.
+
+Lemma inj_sub_max n m : Z.of_nat (n-m) = Z.max 0 (Z.of_nat n - Z.of_nat m).
+Proof.
+ now rewrite <- !nat_N_Z, Nat2N.inj_sub, N2Z.inj_sub_max.
+Qed.
 
-(** Injection and successor *)
+Lemma inj_sub n m : (m<=n)%nat -> Z.of_nat (n-m) = Z.of_nat n - Z.of_nat m.
+Proof.
+ rewrite nat_compare_le, Nat2N.inj_compare. intros.
+ now rewrite <- !nat_N_Z, Nat2N.inj_sub, N2Z.inj_sub.
+Qed.
+
+Lemma inj_pred_max n : Z.of_nat (pred n) = Z.max 0 (Z.pred (Z.of_nat n)).
+Proof.
+ now rewrite <- !nat_N_Z, Nat2N.inj_pred, N2Z.inj_pred_max.
+Qed.
+
+Lemma inj_pred n : (0<n)%nat -> Z.of_nat (pred n) = Z.pred (Z.of_nat n).
+Proof.
+ rewrite nat_compare_lt, Nat2N.inj_compare. intros.
+ now rewrite <- !nat_N_Z, Nat2N.inj_pred, N2Z.inj_pred.
+Qed.
+
+Lemma inj_min n m : Z.of_nat (min n m) = Z.min (Z.of_nat n) (Z.of_nat m).
+Proof.
+ now rewrite <- !nat_N_Z, Nat2N.inj_min, N2Z.inj_min.
+Qed.
 
-Theorem inj_0 : Z_of_nat 0 = 0%Z.
+Lemma inj_max n m : Z.of_nat (max n m) = Z.max (Z.of_nat n) (Z.of_nat m).
 Proof.
-  reflexivity.
+ now rewrite <- !nat_N_Z, Nat2N.inj_max, N2Z.inj_max.
 Qed.
 
-Theorem inj_S : forall n:nat, Z_of_nat (S n) = Zsucc (Z_of_nat n).
+End Nat2Z.
+
+Module Z2Nat.
+
+(** [Z.to_nat] is a bijection between non-negative [Z] and [nat],
+    with [Pos.of_nat] as reciprocal.
+    See [nat2Z.id] above for the dual equation. *)
+
+Lemma id n : 0<=n -> Z.of_nat (Z.to_nat n) = n.
 Proof.
-  intro y; induction y as [| n H];
-    [ unfold Zsucc in |- *; simpl in |- *; trivial with arith
-      | change (Zpos (Psucc (P_of_succ_nat n)) = Zsucc (Z_of_nat (S n))) in |- *;
-	rewrite Zpos_succ_morphism; trivial with arith ].
+ intros. now rewrite <- Z_N_nat, <- nat_N_Z, N2Nat.id, Z2N.id.
 Qed.
 
-(** Injection and equality. *)
+(** [Z.to_nat] is hence injective for non-negative integers. *)
 
-Theorem inj_eq : forall n m:nat, n = m -> Z_of_nat n = Z_of_nat m.
+Lemma inj n m : 0<=n -> 0<=m -> Z.to_nat n = Z.to_nat m -> n = m.
 Proof.
-  intros x y H; rewrite H; trivial with arith.
+ intros. rewrite <- (id n), <- (id m) by trivial. now f_equal.
 Qed.
 
-Theorem inj_neq : forall n m:nat, neq n m -> Zne (Z_of_nat n) (Z_of_nat m).
+Lemma inj_iff n m : 0<=n -> 0<=m -> (Z.to_nat n = Z.to_nat m <-> n = m).
 Proof.
-  unfold neq, Zne, not in |- *; intros x y H1 H2; apply H1; generalize H2;
-    case x; case y; intros;
-      [ auto with arith
-	| discriminate H0
-	| discriminate H0
-	| simpl in H0; injection H0;
-	  do 2 rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ;
-	    intros E; rewrite E; auto with arith ].
+ intros. split. now apply inj. intros; now subst.
 Qed.
 
-Theorem inj_eq_rev : forall n m:nat, Z_of_nat n = Z_of_nat m -> n = m.
+(** [Z.to_nat], basic equations *)
+
+Lemma inj_0 : Z.to_nat 0 = O.
 Proof.
-  intros x y H.
-  destruct (eq_nat_dec x y) as [H'|H']; auto.
-  exfalso.
-  exact (inj_neq _ _ H' H).
+ reflexivity.
 Qed.
 
-Theorem inj_eq_iff : forall n m:nat, n=m <-> Z_of_nat n = Z_of_nat m.
+Lemma inj_pos n : Z.to_nat (Zpos n) = Pos.to_nat n.
 Proof.
- split; [apply inj_eq | apply inj_eq_rev].
+ reflexivity.
 Qed.
 
+Lemma inj_neg n : Z.to_nat (Zneg n) = O.
+Proof.
+ reflexivity.
+Qed.
 
-(** Injection and order relations: *)
+(** [Z.to_nat] and operations *)
 
-(** One way ... *)
+Lemma inj_add n m : 0<=n -> 0<=m ->
+ Z.to_nat (n+m) = (Z.to_nat n + Z.to_nat m)%nat.
+Proof.
+ intros. now rewrite <- !Z_N_nat, Z2N.inj_add, N2Nat.inj_add.
+Qed.
 
-Theorem inj_le : forall n m:nat, (n <= m)%nat -> Z_of_nat n <= Z_of_nat m.
+Lemma inj_mul n m : 0<=n -> 0<=m ->
+ Z.to_nat (n*m) = (Z.to_nat n * Z.to_nat m)%nat.
 Proof.
-  intros x y; intros H; elim H;
-    [ unfold Zle in |- *; elim (Zcompare_Eq_iff_eq (Z_of_nat x) (Z_of_nat x));
-      intros H1 H2; rewrite H2; [ discriminate | trivial with arith ]
-      | intros m H1 H2; apply Zle_trans with (Z_of_nat m);
-	[ assumption | rewrite inj_S; apply Zle_succ ] ].
+ intros. now rewrite <- !Z_N_nat, Z2N.inj_mul, N2Nat.inj_mul.
 Qed.
 
-Theorem inj_lt : forall n m:nat, (n < m)%nat -> Z_of_nat n < Z_of_nat m.
+Lemma inj_succ n : 0<=n -> Z.to_nat (Z.succ n) = S (Z.to_nat n).
 Proof.
-  intros x y H; apply Zgt_lt; apply Zle_succ_gt; rewrite <- inj_S; apply inj_le;
-    exact H.
+ intros. now rewrite <- !Z_N_nat, Z2N.inj_succ, N2Nat.inj_succ.
 Qed.
 
-Theorem inj_ge : forall n m:nat, (n >= m)%nat -> Z_of_nat n >= Z_of_nat m.
+Lemma inj_sub n m : 0<=m -> Z.to_nat (n - m) = (Z.to_nat n - Z.to_nat m)%nat.
 Proof.
-  intros x y H; apply Zle_ge; apply inj_le; apply H.
+ intros. now rewrite <- !Z_N_nat, Z2N.inj_sub, N2Nat.inj_sub.
 Qed.
 
-Theorem inj_gt : forall n m:nat, (n > m)%nat -> Z_of_nat n > Z_of_nat m.
+Lemma inj_pred n : Z.to_nat (Z.pred n) = pred (Z.to_nat n).
 Proof.
-  intros x y H; apply Zlt_gt; apply inj_lt; exact H.
+ now rewrite <- !Z_N_nat, Z2N.inj_pred, N2Nat.inj_pred.
 Qed.
 
-(** The other way ... *)
+Lemma inj_compare n m : 0<=n -> 0<=m ->
+ nat_compare (Z.to_nat n) (Z.to_nat m) = (n ?= m).
+Proof.
+ intros Hn Hm. now rewrite <- Nat2Z.inj_compare, !id.
+Qed.
 
-Theorem inj_le_rev : forall n m:nat, Z_of_nat n <= Z_of_nat m -> (n <= m)%nat.
+Lemma inj_le n m : 0<=n -> 0<=m -> (n<=m <-> (Z.to_nat n <= Z.to_nat m)%nat).
 Proof.
-  intros x y H.
-  destruct (le_lt_dec x y) as [H0|H0]; auto.
-  exfalso.
-  assert (H1:=inj_lt _ _ H0).
-  red in H; red in H1.
-  rewrite <- Zcompare_antisym in H; rewrite H1 in H; auto.
+ intros Hn Hm. unfold Z.le. now rewrite nat_compare_le, inj_compare.
 Qed.
 
-Theorem inj_lt_rev : forall n m:nat, Z_of_nat n < Z_of_nat m -> (n < m)%nat.
+Lemma inj_lt n m : 0<=n -> 0<=m -> (n<m <-> (Z.to_nat n < Z.to_nat m)%nat).
 Proof.
-  intros x y H.
-  destruct (le_lt_dec y x) as [H0|H0]; auto.
-  exfalso.
-  assert (H1:=inj_le _ _ H0).
-  red in H; red in H1.
-  rewrite <- Zcompare_antisym in H1; rewrite H in H1; auto.
+ intros Hn Hm. unfold Z.lt. now rewrite nat_compare_lt, inj_compare.
 Qed.
 
-Theorem inj_ge_rev : forall n m:nat, Z_of_nat n >= Z_of_nat m -> (n >= m)%nat.
+Lemma inj_min n m : Z.to_nat (Z.min n m) = min (Z.to_nat n) (Z.to_nat m).
 Proof.
-  intros x y H.
-  destruct (le_lt_dec y x) as [H0|H0]; auto.
-  exfalso.
-  assert (H1:=inj_gt _ _ H0).
-  red in H; red in H1.
-  rewrite <- Zcompare_antisym in H; rewrite H1 in H; auto.
+ now rewrite <- !Z_N_nat, Z2N.inj_min, N2Nat.inj_min.
 Qed.
 
-Theorem inj_gt_rev : forall n m:nat, Z_of_nat n > Z_of_nat m -> (n > m)%nat.
+Lemma inj_max n m : Z.to_nat (Z.max n m) = max (Z.to_nat n) (Z.to_nat m).
 Proof.
-  intros x y H.
-  destruct (le_lt_dec x y) as [H0|H0]; auto.
-  exfalso.
-  assert (H1:=inj_ge _ _ H0).
-  red in H; red in H1.
-  rewrite <- Zcompare_antisym in H1; rewrite H in H1; auto.
+ now rewrite <- !Z_N_nat, Z2N.inj_max, N2Nat.inj_max.
 Qed.
 
-(* Both ways ... *)
+End Z2Nat.
 
-Theorem inj_le_iff : forall n m:nat, (n<=m)%nat <-> Z_of_nat n <= Z_of_nat m.
+Module Zabs2Nat.
+
+(** Results about [Z.abs_nat], converting absolute values of [Z] integers
+    to [nat]. *)
+
+Lemma abs_nat_spec n : Z.abs_nat n = Z.to_nat (Z.abs n).
 Proof.
- split; [apply inj_le | apply inj_le_rev].
+ now destruct n.
 Qed.
 
-Theorem inj_lt_iff : forall n m:nat, (n<m)%nat <-> Z_of_nat n < Z_of_nat m.
+Lemma abs_nat_nonneg n : 0<=n -> Z.abs_nat n = Z.to_nat n.
 Proof.
- split; [apply inj_lt | apply inj_lt_rev].
+ destruct n; trivial; now destruct 1.
 Qed.
 
-Theorem inj_ge_iff : forall n m:nat, (n>=m)%nat <-> Z_of_nat n >= Z_of_nat m.
+Lemma id_abs n : Z.of_nat (Z.abs_nat n) = Z.abs n.
 Proof.
- split; [apply inj_ge | apply inj_ge_rev].
+ rewrite <-Zabs_N_nat, N_nat_Z. apply Zabs2N.id_abs.
 Qed.
 
-Theorem inj_gt_iff : forall n m:nat, (n>m)%nat <-> Z_of_nat n > Z_of_nat m.
+Lemma id n : Z.abs_nat (Z.of_nat n) = n.
 Proof.
- split; [apply inj_gt | apply inj_gt_rev].
+ now rewrite <-Zabs_N_nat, <-nat_N_Z, Zabs2N.id, Nat2N.id.
 Qed.
 
-(** Injection and usual operations *)
+(** [Z.abs_nat], basic equations *)
 
-Theorem inj_plus : forall n m:nat, Z_of_nat (n + m) = Z_of_nat n + Z_of_nat m.
+Lemma inj_0 : Z.abs_nat 0 = 0%nat.
 Proof.
-  intro x; induction x as [| n H]; intro y; destruct y as [| m];
-    [ simpl in |- *; trivial with arith
-      | simpl in |- *; trivial with arith
-      | simpl in |- *; rewrite <- plus_n_O; trivial with arith
-      | change (Z_of_nat (S (n + S m)) = Z_of_nat (S n) + Z_of_nat (S m)) in |- *;
-	rewrite inj_S; rewrite H; do 2 rewrite inj_S; rewrite Zplus_succ_l;
-	  trivial with arith ].
+ reflexivity.
 Qed.
 
-Theorem inj_mult : forall n m:nat, Z_of_nat (n * m) = Z_of_nat n * Z_of_nat m.
+Lemma inj_pos p : Z.abs_nat (Zpos p) = Pos.to_nat p.
 Proof.
-  intro x; induction x as [| n H];
-    [ simpl in |- *; trivial with arith
-      | intro y; rewrite inj_S; rewrite <- Zmult_succ_l_reverse; rewrite <- H;
-	rewrite <- inj_plus; simpl in |- *; rewrite plus_comm;
-	  trivial with arith ].
+ reflexivity.
 Qed.
 
-Theorem inj_minus1 :
-  forall n m:nat, (m <= n)%nat -> Z_of_nat (n - m) = Z_of_nat n - Z_of_nat m.
+Lemma inj_neg p : Z.abs_nat (Zneg p) = Pos.to_nat p.
 Proof.
-  intros x y H; apply (Zplus_reg_l (Z_of_nat y)); unfold Zminus in |- *;
-    rewrite Zplus_permute; rewrite Zplus_opp_r; rewrite <- inj_plus;
-      rewrite <- (le_plus_minus y x H); rewrite Zplus_0_r;
-        trivial with arith.
+ reflexivity.
 Qed.
 
-Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z_of_nat (n - m) = 0.
+(** [Z.abs_nat] and usual operations, with non-negative integers *)
+
+Lemma inj_succ n : 0<=n -> Z.abs_nat (Z.succ n) = S (Z.abs_nat n).
 Proof.
-  intros x y H; rewrite not_le_minus_0;
-    [ trivial with arith | apply gt_not_le; assumption ].
+ intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_succ, N2Nat.inj_succ.
 Qed.
 
-Theorem inj_minus : forall n m:nat,
- Z_of_nat (minus n m) = Zmax 0 (Z_of_nat n - Z_of_nat m).
+Lemma inj_add n m : 0<=n -> 0<=m ->
+ Z.abs_nat (n+m) = (Z.abs_nat n + Z.abs_nat m)%nat.
 Proof.
- intros.
- rewrite Zmax_comm.
- unfold Zmax.
- destruct (le_lt_dec m n) as [H|H].
+ intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_add, N2Nat.inj_add.
+Qed.
+
+Lemma inj_mul n m : Z.abs_nat (n*m) = (Z.abs_nat n * Z.abs_nat m)%nat.
+Proof.
+ destruct n, m; simpl; trivial using Pos2Nat.inj_mul.
+Qed.
+
+Lemma inj_sub n m : 0<=m<=n ->
+ Z.abs_nat (n-m) = (Z.abs_nat n - Z.abs_nat m)%nat.
+Proof.
+ intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_sub, N2Nat.inj_sub.
+Qed.
 
- rewrite (inj_minus1 _ _ H).
- assert (H':=Zle_minus_le_0 _ _ (inj_le _ _ H)).
- unfold Zle in H'.
- rewrite <- Zcompare_antisym in H'.
- destruct Zcompare; simpl in *; intuition.
+Lemma inj_pred n : 0<n -> Z.abs_nat (Z.pred n) = pred (Z.abs_nat n).
+Proof.
+ intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_pred, N2Nat.inj_pred.
+Qed.
 
- rewrite (inj_minus2 _ _ H).
- assert (H':=Zplus_lt_compat_r _ _ (- Z_of_nat m) (inj_lt _ _ H)).
- rewrite Zplus_opp_r in H'.
- unfold Zminus; rewrite H'; auto.
+Lemma inj_compare n m : 0<=n -> 0<=m ->
+ nat_compare (Z.abs_nat n) (Z.abs_nat m) = (n ?= m).
+Proof.
+ intros. now rewrite <- !Zabs_N_nat, <- N2Nat.inj_compare, Zabs2N.inj_compare.
 Qed.
 
-Theorem inj_min : forall n m:nat,
-  Z_of_nat (min n m) = Zmin (Z_of_nat n) (Z_of_nat m).
+Lemma inj_le n m : 0<=n -> 0<=m -> (n<=m <-> (Z.abs_nat n <= Z.abs_nat m)%nat).
 Proof.
- induction n; destruct m; try (compute; auto; fail).
- simpl min.
- do 3 rewrite inj_S.
- rewrite <- Zsucc_min_distr; f_equal; auto.
+ intros Hn Hm. unfold Z.le. now rewrite nat_compare_le, inj_compare.
 Qed.
 
-Theorem inj_max : forall n m:nat,
-  Z_of_nat (max n m) = Zmax (Z_of_nat n) (Z_of_nat m).
+Lemma inj_lt n m : 0<=n -> 0<=m -> (n<m <-> (Z.abs_nat n < Z.abs_nat m)%nat).
 Proof.
- induction n; destruct m; try (compute; auto; fail).
- simpl max.
- do 3 rewrite inj_S.
- rewrite <- Zsucc_max_distr; f_equal; auto.
+ intros Hn Hm. unfold Z.lt. now rewrite nat_compare_lt, inj_compare.
 Qed.
 
-(** Composition of injections **)
+Lemma inj_min n m : 0<=n -> 0<=m ->
+ Z.abs_nat (Z.min n m) = min (Z.abs_nat n) (Z.abs_nat m).
+Proof.
+ intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_min, N2Nat.inj_min.
+Qed.
 
-Theorem Zpos_eq_Z_of_nat_o_nat_of_P :
-  forall p:positive, Zpos p = Z_of_nat (nat_of_P p).
+Lemma inj_max n m : 0<=n -> 0<=m ->
+ Z.abs_nat (Z.max n m) = max (Z.abs_nat n) (Z.abs_nat m).
 Proof.
-  intros x; elim x; simpl in |- *; auto.
-  intros p H; rewrite ZL6.
-  apply f_equal with (f := Zpos).
-  apply nat_of_P_inj.
-  rewrite nat_of_P_o_P_of_succ_nat_eq_succ; unfold nat_of_P in |- *;
-    simpl in |- *.
-  rewrite ZL6; auto.
-  intros p H; unfold nat_of_P in |- *; simpl in |- *.
-  rewrite ZL6; simpl in |- *.
-  rewrite inj_plus; repeat rewrite <- H.
-  rewrite Zpos_xO; simpl in |- *; rewrite Pplus_diag; reflexivity.
+ intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_max, N2Nat.inj_max.
 Qed.
 
-(** Misc *)
+(** [Z.abs_nat] and usual operations, statements with [Z.abs] *)
 
-Theorem intro_Z :
-  forall n:nat,  exists y : Z, Z_of_nat n = y /\ 0 <= y * 1 + 0.
+Lemma inj_succ_abs n : Z.abs_nat (Z.succ (Z.abs n)) = S (Z.abs_nat n).
 Proof.
-  intros x; exists (Z_of_nat x); split;
-    [ trivial with arith
-      | rewrite Zmult_comm; rewrite Zmult_1_l; rewrite Zplus_0_r;
-	unfold Zle in |- *; elim x; intros; simpl in |- *;
-          discriminate ].
+ now rewrite <- !Zabs_N_nat, Zabs2N.inj_succ_abs, N2Nat.inj_succ.
 Qed.
 
-Lemma Zpos_P_of_succ_nat : forall n:nat,
- Zpos (P_of_succ_nat n) = Zsucc (Z_of_nat n).
+Lemma inj_add_abs n m :
+ Z.abs_nat (Z.abs n + Z.abs m) = (Z.abs_nat n + Z.abs_nat m)%nat.
+Proof.
+ now rewrite <- !Zabs_N_nat, Zabs2N.inj_add_abs, N2Nat.inj_add.
+Qed.
+
+Lemma inj_mul_abs n m :
+ Z.abs_nat (Z.abs n * Z.abs m) = (Z.abs_nat n * Z.abs_nat m)%nat.
+Proof.
+ now rewrite <- !Zabs_N_nat, Zabs2N.inj_mul_abs, N2Nat.inj_mul.
+Qed.
+
+End Zabs2Nat.
+
+
+(** Compatibility *)
+
+Definition neq (x y:nat) := x <> y.
+
+Lemma inj_neq n m : neq n m -> Zne (Z.of_nat n) (Z.of_nat m).
+Proof. intros H H'. now apply H, Nat2Z.inj. Qed.
+
+Lemma Zpos_P_of_succ_nat n : Zpos (Pos.of_succ_nat n) = Z.succ (Z.of_nat n).
+Proof (Nat2Z.inj_succ n).
+
+(** For these one, used in omega, a Definition is necessary *)
+
+Definition inj_eq := (f_equal Z.of_nat).
+Definition inj_le n m := proj1 (Nat2Z.inj_le n m).
+Definition inj_lt n m := proj1 (Nat2Z.inj_lt n m).
+Definition inj_ge n m := proj1 (Nat2Z.inj_ge n m).
+Definition inj_gt n m := proj1 (Nat2Z.inj_gt n m).
+
+(** For the others, a Notation is fine *)
+
+Notation inj_0 := Nat2Z.inj_0 (compat "8.3").
+Notation inj_S := Nat2Z.inj_succ (compat "8.3").
+Notation inj_compare := Nat2Z.inj_compare (compat "8.3").
+Notation inj_eq_rev := Nat2Z.inj (compat "8.3").
+Notation inj_eq_iff := (fun n m => iff_sym (Nat2Z.inj_iff n m)) (compat "8.3").
+Notation inj_le_iff := Nat2Z.inj_le (compat "8.3").
+Notation inj_lt_iff := Nat2Z.inj_lt (compat "8.3").
+Notation inj_ge_iff := Nat2Z.inj_ge (compat "8.3").
+Notation inj_gt_iff := Nat2Z.inj_gt (compat "8.3").
+Notation inj_le_rev := (fun n m => proj2 (Nat2Z.inj_le n m)) (compat "8.3").
+Notation inj_lt_rev := (fun n m => proj2 (Nat2Z.inj_lt n m)) (compat "8.3").
+Notation inj_ge_rev := (fun n m => proj2 (Nat2Z.inj_ge n m)) (compat "8.3").
+Notation inj_gt_rev := (fun n m => proj2 (Nat2Z.inj_gt n m)) (compat "8.3").
+Notation inj_plus := Nat2Z.inj_add (compat "8.3").
+Notation inj_mult := Nat2Z.inj_mul (compat "8.3").
+Notation inj_minus1 := Nat2Z.inj_sub (compat "8.3").
+Notation inj_minus := Nat2Z.inj_sub_max (compat "8.3").
+Notation inj_min := Nat2Z.inj_min (compat "8.3").
+Notation inj_max := Nat2Z.inj_max (compat "8.3").
+
+Notation Z_of_nat_of_P := positive_nat_Z (compat "8.3").
+Notation Zpos_eq_Z_of_nat_o_nat_of_P :=
+  (fun p => eq_sym (positive_nat_Z p)) (compat "8.3").
+
+Notation Z_of_nat_of_N := N_nat_Z (compat "8.3").
+Notation Z_of_N_of_nat := nat_N_Z (compat "8.3").
+
+Notation Z_of_N_eq := (f_equal Z.of_N) (compat "8.3").
+Notation Z_of_N_eq_rev := N2Z.inj (compat "8.3").
+Notation Z_of_N_eq_iff := (fun n m => iff_sym (N2Z.inj_iff n m)) (compat "8.3").
+Notation Z_of_N_compare := N2Z.inj_compare (compat "8.3").
+Notation Z_of_N_le_iff := N2Z.inj_le (compat "8.3").
+Notation Z_of_N_lt_iff := N2Z.inj_lt (compat "8.3").
+Notation Z_of_N_ge_iff := N2Z.inj_ge (compat "8.3").
+Notation Z_of_N_gt_iff := N2Z.inj_gt (compat "8.3").
+Notation Z_of_N_le := (fun n m => proj1 (N2Z.inj_le n m)) (compat "8.3").
+Notation Z_of_N_lt := (fun n m => proj1 (N2Z.inj_lt n m)) (compat "8.3").
+Notation Z_of_N_ge := (fun n m => proj1 (N2Z.inj_ge n m)) (compat "8.3").
+Notation Z_of_N_gt := (fun n m => proj1 (N2Z.inj_gt n m)) (compat "8.3").
+Notation Z_of_N_le_rev := (fun n m => proj2 (N2Z.inj_le n m)) (compat "8.3").
+Notation Z_of_N_lt_rev := (fun n m => proj2 (N2Z.inj_lt n m)) (compat "8.3").
+Notation Z_of_N_ge_rev := (fun n m => proj2 (N2Z.inj_ge n m)) (compat "8.3").
+Notation Z_of_N_gt_rev := (fun n m => proj2 (N2Z.inj_gt n m)) (compat "8.3").
+Notation Z_of_N_pos := N2Z.inj_pos (compat "8.3").
+Notation Z_of_N_abs := N2Z.inj_abs_N (compat "8.3").
+Notation Z_of_N_le_0 := N2Z.is_nonneg (compat "8.3").
+Notation Z_of_N_plus := N2Z.inj_add (compat "8.3").
+Notation Z_of_N_mult := N2Z.inj_mul (compat "8.3").
+Notation Z_of_N_minus := N2Z.inj_sub_max (compat "8.3").
+Notation Z_of_N_succ := N2Z.inj_succ (compat "8.3").
+Notation Z_of_N_min := N2Z.inj_min (compat "8.3").
+Notation Z_of_N_max := N2Z.inj_max (compat "8.3").
+Notation Zabs_of_N := Zabs2N.id (compat "8.3").
+Notation Zabs_N_succ_abs := Zabs2N.inj_succ_abs (compat "8.3").
+Notation Zabs_N_succ := Zabs2N.inj_succ (compat "8.3").
+Notation Zabs_N_plus_abs := Zabs2N.inj_add_abs (compat "8.3").
+Notation Zabs_N_plus := Zabs2N.inj_add (compat "8.3").
+Notation Zabs_N_mult_abs := Zabs2N.inj_mul_abs (compat "8.3").
+Notation Zabs_N_mult := Zabs2N.inj_mul (compat "8.3").
+
+Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z.of_nat (n - m) = 0.
 Proof.
-  intros.
-  unfold Z_of_nat.
-  destruct n.
-  simpl; auto.
-  simpl (P_of_succ_nat (S n)).
-  apply Zpos_succ_morphism.
+ intros. rewrite not_le_minus_0; auto with arith.
 Qed.
diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v
index 26ff4251..c1e01451 100644
--- a/theories/ZArith/Znumtheory.v
+++ b/theories/ZArith/Znumtheory.v
@@ -1,349 +1,217 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Znumtheory.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 Require Import ZArith_base.
 Require Import ZArithRing.
 Require Import Zcomplements.
 Require Import Zdiv.
 Require Import Wf_nat.
-Open Local Scope Z_scope.
+
+(** For compatibility reasons, this Open Scope isn't local as it should *)
+
+Open Scope Z_scope.
 
 (** This file contains some notions of number theory upon Z numbers:
-     - a divisibility predicate [Zdivide]
+     - a divisibility predicate [Z.divide]
      - a gcd predicate [gcd]
      - Euclid algorithm [euclid]
      - a relatively prime predicate [rel_prime]
      - a prime predicate [prime]
-     - an efficient [Zgcd] function
+     - properties of the efficient [Z.gcd] function
 *)
 
-(** * Divisibility *)
+Notation Zgcd := Z.gcd (compat "8.3").
+Notation Zggcd := Z.ggcd (compat "8.3").
+Notation Zggcd_gcd := Z.ggcd_gcd (compat "8.3").
+Notation Zggcd_correct_divisors := Z.ggcd_correct_divisors (compat "8.3").
+Notation Zgcd_divide_l := Z.gcd_divide_l (compat "8.3").
+Notation Zgcd_divide_r := Z.gcd_divide_r (compat "8.3").
+Notation Zgcd_greatest := Z.gcd_greatest (compat "8.3").
+Notation Zgcd_nonneg := Z.gcd_nonneg (compat "8.3").
+Notation Zggcd_opp := Z.ggcd_opp (compat "8.3").
 
-Inductive Zdivide (a b:Z) : Prop :=
-    Zdivide_intro : forall q:Z, b = q * a -> Zdivide a b.
+(** The former specialized inductive predicate [Z.divide] is now
+    a generic existential predicate. *)
 
-(** Syntax for divisibility *)
+Notation Zdivide := Z.divide (compat "8.3").
 
-Notation "( a | b )" := (Zdivide a b) (at level 0) : Z_scope.
+(** Its former constructor is now a pseudo-constructor. *)
 
-(** Results concerning divisibility*)
+Definition Zdivide_intro a b q (H:b=q*a) : Z.divide a b := ex_intro _ q H.
 
-Lemma Zdivide_refl : forall a:Z, (a | a).
-Proof.
-  intros; apply Zdivide_intro with 1; ring.
-Qed.
-
-Lemma Zone_divide : forall a:Z, (1 | a).
-Proof.
-  intros; apply Zdivide_intro with a; ring.
-Qed.
-
-Lemma Zdivide_0 : forall a:Z, (a | 0).
-Proof.
-  intros; apply Zdivide_intro with 0; ring.
-Qed.
-
-Hint Resolve Zdivide_refl Zone_divide Zdivide_0: zarith.
-
-Lemma Zmult_divide_compat_l : forall a b c:Z, (a | b) -> (c * a | c * b).
-Proof.
-  simple induction 1; intros; apply Zdivide_intro with q.
-  rewrite H0; ring.
-Qed.
+(** Results concerning divisibility*)
 
-Lemma Zmult_divide_compat_r : forall a b c:Z, (a | b) -> (a * c | b * c).
-Proof.
-  intros a b c; rewrite (Zmult_comm a c); rewrite (Zmult_comm b c).
-  apply Zmult_divide_compat_l; trivial.
-Qed.
+Notation Zdivide_refl := Z.divide_refl (compat "8.3").
+Notation Zone_divide := Z.divide_1_l (compat "8.3").
+Notation Zdivide_0 := Z.divide_0_r (compat "8.3").
+Notation Zmult_divide_compat_l := Z.mul_divide_mono_l (compat "8.3").
+Notation Zmult_divide_compat_r := Z.mul_divide_mono_r (compat "8.3").
+Notation Zdivide_plus_r := Z.divide_add_r (compat "8.3").
+Notation Zdivide_minus_l := Z.divide_sub_r (compat "8.3").
+Notation Zdivide_mult_l := Z.divide_mul_l (compat "8.3").
+Notation Zdivide_mult_r := Z.divide_mul_r (compat "8.3").
+Notation Zdivide_factor_r := Z.divide_factor_l (compat "8.3").
+Notation Zdivide_factor_l := Z.divide_factor_r (compat "8.3").
 
-Hint Resolve Zmult_divide_compat_l Zmult_divide_compat_r: zarith.
+Lemma Zdivide_opp_r a b : (a | b) -> (a | - b).
+Proof. apply Z.divide_opp_r. Qed.
 
-Lemma Zdivide_plus_r : forall a b c:Z, (a | b) -> (a | c) -> (a | b + c).
-Proof.
-  simple induction 1; intros q Hq; simple induction 1; intros q' Hq'.
-  apply Zdivide_intro with (q + q').
-  rewrite Hq; rewrite Hq'; ring.
-Qed.
+Lemma Zdivide_opp_r_rev a b : (a | - b) -> (a | b).
+Proof. apply Z.divide_opp_r. Qed.
 
-Lemma Zdivide_opp_r : forall a b:Z, (a | b) -> (a | - b).
-Proof.
-  simple induction 1; intros; apply Zdivide_intro with (- q).
-  rewrite H0; ring.
-Qed.
+Lemma Zdivide_opp_l a b : (a | b) -> (- a | b).
+Proof. apply Z.divide_opp_l. Qed.
 
-Lemma Zdivide_opp_r_rev : forall a b:Z, (a | - b) -> (a | b).
-Proof.
-  intros; replace b with (- - b). apply Zdivide_opp_r; trivial. ring.
-Qed.
+Lemma Zdivide_opp_l_rev a b : (- a | b) -> (a | b).
+Proof. apply Z.divide_opp_l. Qed.
 
-Lemma Zdivide_opp_l : forall a b:Z, (a | b) -> (- a | b).
-Proof.
-  simple induction 1; intros; apply Zdivide_intro with (- q).
-  rewrite H0; ring.
-Qed.
+Theorem Zdivide_Zabs_l a b : (Z.abs a | b) -> (a | b).
+Proof. apply Z.divide_abs_l. Qed.
 
-Lemma Zdivide_opp_l_rev : forall a b:Z, (- a | b) -> (a | b).
-Proof.
-  intros; replace a with (- - a). apply Zdivide_opp_l; trivial. ring.
-Qed.
+Theorem Zdivide_Zabs_inv_l a b : (a | b) -> (Z.abs a | b).
+Proof. apply Z.divide_abs_l. Qed.
 
-Lemma Zdivide_minus_l : forall a b c:Z, (a | b) -> (a | c) -> (a | b - c).
-Proof.
-  simple induction 1; intros q Hq; simple induction 1; intros q' Hq'.
-  apply Zdivide_intro with (q - q').
-  rewrite Hq; rewrite Hq'; ring.
-Qed.
-
-Lemma Zdivide_mult_l : forall a b c:Z, (a | b) -> (a | b * c).
-Proof.
-  simple induction 1; intros q Hq; apply Zdivide_intro with (q * c).
-  rewrite Hq; ring.
-Qed.
-
-Lemma Zdivide_mult_r : forall a b c:Z, (a | c) -> (a | b * c).
-Proof.
-  simple induction 1; intros q Hq; apply Zdivide_intro with (q * b).
-  rewrite Hq; ring.
-Qed.
-
-Lemma Zdivide_factor_r : forall a b:Z, (a | a * b).
-Proof.
-  intros; apply Zdivide_intro with b; ring.
-Qed.
-
-Lemma Zdivide_factor_l : forall a b:Z, (a | b * a).
-Proof.
-  intros; apply Zdivide_intro with b; ring.
-Qed.
-
-Hint Resolve Zdivide_plus_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l
-  Zdivide_opp_l_rev Zdivide_minus_l Zdivide_mult_l Zdivide_mult_r
-  Zdivide_factor_r Zdivide_factor_l: zarith.
+Hint Resolve Z.divide_refl Z.divide_1_l Z.divide_0_r: zarith.
+Hint Resolve Z.mul_divide_mono_l Z.mul_divide_mono_r: zarith.
+Hint Resolve Z.divide_add_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l
+  Zdivide_opp_l_rev Z.divide_sub_r Z.divide_mul_l Z.divide_mul_r
+  Z.divide_factor_l Z.divide_factor_r: zarith.
 
 (** Auxiliary result. *)
 
-Lemma Zmult_one : forall x y:Z, x >= 0 -> x * y = 1 -> x = 1.
+Lemma Zmult_one x y : x >= 0 -> x * y = 1 -> x = 1.
 Proof.
-  intros x y H H0; destruct (Zmult_1_inversion_l _ _ H0) as [Hpos| Hneg].
-  assumption.
-  rewrite Hneg in H; simpl in H.
-  contradiction (Zle_not_lt 0 (-1)).
-    apply Zge_le; assumption.
-    apply Zorder.Zlt_neg_0.
+ Z.swap_greater. apply Z.eq_mul_1_nonneg.
 Qed.
 
 (** Only [1] and [-1] divide [1]. *)
 
-Lemma Zdivide_1 : forall x:Z, (x | 1) -> x = 1 \/ x = -1.
-Proof.
-  simple induction 1; intros.
-  elim (Z_lt_ge_dec 0 x); [ left | right ].
-  apply Zmult_one with q; auto with zarith; rewrite H0; ring.
-  assert (- x = 1); auto with zarith.
-  apply Zmult_one with (- q); auto with zarith; rewrite H0; ring.
-Qed.
+Notation Zdivide_1 := Z.divide_1_r (compat "8.3").
 
 (** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *)
 
-Lemma Zdivide_antisym : forall a b:Z, (a | b) -> (b | a) -> a = b \/ a = - b.
-Proof.
-  simple induction 1; intros.
-  inversion H1.
-  rewrite H0 in H2; clear H H1.
-  case (Z_zerop a); intro.
-  left; rewrite H0; rewrite e; ring.
-  assert (Hqq0 : q0 * q = 1).
-  apply Zmult_reg_l with a.
-  assumption.
-  ring_simplify.
-  pattern a at 2 in |- *; rewrite H2; ring.
-  assert (q | 1).
-  rewrite <- Hqq0; auto with zarith.
-  elim (Zdivide_1 q H); intros.
-  rewrite H1 in H0; left; omega.
-  rewrite H1 in H0; right; omega.
-Qed.
-
-Theorem Zdivide_trans: forall a b c, (a | b) -> (b | c) ->  (a | c).
-Proof.
-  intros a b c [d H1] [e H2]; exists (d * e); auto with zarith.
-  rewrite H2; rewrite H1; ring.
-Qed.
+Notation Zdivide_antisym := Z.divide_antisym (compat "8.3").
+Notation Zdivide_trans := Z.divide_trans (compat "8.3").
 
 (** If [a] divides [b] and [b<>0] then [|a| <= |b|]. *)
 
-Lemma Zdivide_bounds : forall a b:Z, (a | b) -> b <> 0 -> Zabs a <= Zabs b.
+Lemma Zdivide_bounds a b : (a | b) -> b <> 0 -> Z.abs a <= Z.abs b.
 Proof.
-  simple induction 1; intros.
-  assert (Zabs b = Zabs q * Zabs a).
-  subst; apply Zabs_Zmult.
-  rewrite H2.
-  assert (H3 := Zabs_pos q).
-  assert (H4 := Zabs_pos a).
-  assert (Zabs q * Zabs a >= 1 * Zabs a); auto with zarith.
-  apply Zmult_ge_compat; auto with zarith.
-  elim (Z_lt_ge_dec (Zabs q) 1); [ intros | auto with zarith ].
-  assert (Zabs q = 0).
-  omega.
-  assert (q = 0).
-  rewrite <- (Zabs_Zsgn q).
-  rewrite H5; auto with zarith.
-  subst q; omega.
+ intros H Hb.
+ rewrite <- Z.divide_abs_l, <- Z.divide_abs_r in H.
+ apply Z.abs_pos in Hb.
+ now apply Z.divide_pos_le.
 Qed.
 
-(** [Zdivide] can be expressed using [Zmod]. *)
+(** [Z.divide] can be expressed using [Z.modulo]. *)
 
 Lemma Zmod_divide : forall a b, b<>0 -> a mod b = 0 -> (b | a).
 Proof.
- intros a b NZ EQ.
- apply Zdivide_intro with (a/b).
- rewrite (Z_div_mod_eq_full a b NZ) at 1.
- rewrite EQ; ring.
+ apply Z.mod_divide.
 Qed.
 
 Lemma Zdivide_mod : forall a b, (b | a) -> a mod b = 0.
 Proof.
-  intros a b (c,->); apply Z_mod_mult.
-Qed.
-
-(** [Zdivide] is hence decidable *)
-
-Lemma Zdivide_dec : forall a b:Z, {(a | b)} + {~ (a | b)}.
-Proof.
-  intros a b; elim (Ztrichotomy_inf a 0).
-  (* a<0 *)
-  intros H; elim H; intros.
-  case (Z_eq_dec (b mod - a) 0).
-  left; apply Zdivide_opp_l_rev; apply Zmod_divide; auto with zarith.
-  intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith.
-  (* a=0 *)
-  case (Z_eq_dec b 0); intro.
-  left; subst; auto with zarith.
-  right; subst; intro H0; inversion H0; omega.
-  (* a>0 *)
-  intro H; case (Z_eq_dec (b mod a) 0).
-  left; apply Zmod_divide; auto with zarith.
-  intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith.
+ intros a b (c,->); apply Z_mod_mult.
 Qed.
 
-Theorem Zdivide_Zdiv_eq: forall a b : Z,
- 0 < a -> (a | b) ->  b = a * (b / a).
-Proof.
-  intros a b Hb Hc.
-  pattern b at 1; rewrite (Z_div_mod_eq b a); auto with zarith.
-  rewrite (Zdivide_mod b a); auto with zarith.
-Qed.
+(** [Z.divide] is hence decidable *)
 
-Theorem Zdivide_Zdiv_eq_2: forall a b c : Z,
- 0 < a -> (a | b) -> (c * b)/a = c * (b / a).
+Lemma Zdivide_dec a b : {(a | b)} + {~ (a | b)}.
 Proof.
-  intros a b c H1 H2.
-  inversion H2 as [z Hz].
-  rewrite Hz; rewrite Zmult_assoc.
-  repeat rewrite Z_div_mult; auto with zarith.
-Qed.
+ destruct (Z.eq_dec a 0) as [Ha|Ha].
+  destruct (Z.eq_dec b 0) as [Hb|Hb].
+   left; subst; apply Z.divide_0_r.
+   right. subst. contradict Hb. now apply Z.divide_0_l.
+  destruct (Z.eq_dec (b mod a) 0).
+   left. now apply Z.mod_divide.
+   right. now rewrite <- Z.mod_divide.
+Defined.
 
-Theorem Zdivide_Zabs_l: forall a b, (Zabs a | b) ->  (a | b).
+Theorem Zdivide_Zdiv_eq a b : 0 < a -> (a | b) ->  b = a * (b / a).
 Proof.
-  intros a b [x H]; subst b.
-  pattern (Zabs a); apply Zabs_intro.
-  exists (- x); ring.
-  exists x; ring.
+ intros Ha H.
+ rewrite (Z.div_mod b a) at 1; auto with zarith.
+ rewrite Zdivide_mod; auto with zarith.
 Qed.
 
-Theorem Zdivide_Zabs_inv_l: forall a b, (a | b) ->  (Zabs a | b).
+Theorem Zdivide_Zdiv_eq_2 a b c :
+ 0 < a -> (a | b) -> (c * b) / a = c * (b / a).
 Proof.
-  intros a b [x H]; subst b.
-  pattern (Zabs a); apply Zabs_intro.
-  exists (- x);  ring.
-  exists x; ring.
+ intros. apply Z.divide_div_mul_exact; auto with zarith.
 Qed.
 
 Theorem Zdivide_le: forall a b : Z,
  0 <= a -> 0 < b -> (a | b) ->  a <= b.
 Proof.
-  intros a b H1 H2 [q H3]; subst b.
-  case (Zle_lt_or_eq 0 a); auto with zarith; intros H3.
-  case (Zle_lt_or_eq 0 q); auto with zarith.
-  apply (Zmult_le_0_reg_r a); auto with zarith.
-  intros H4; apply Zle_trans with (1 * a); auto with zarith.
-  intros H4; subst q; omega.
+ intros. now apply Z.divide_pos_le.
 Qed.
 
-Theorem Zdivide_Zdiv_lt_pos: forall a b : Z,
+Theorem Zdivide_Zdiv_lt_pos a b :
  1 < a -> 0 < b -> (a | b) ->  0 < b / a < b .
 Proof.
-  intros a b H1 H2 H3; split.
-  apply Zmult_lt_reg_r with a; auto with zarith.
-  rewrite (Zmult_comm (Zdiv b a)); rewrite <- Zdivide_Zdiv_eq; auto with zarith.
-  apply Zmult_lt_reg_r with a; auto with zarith.
-  repeat rewrite (fun x => Zmult_comm x a); auto with zarith.
+  intros H1 H2 H3; split.
+  apply Z.mul_pos_cancel_l with a; auto with zarith.
   rewrite <- Zdivide_Zdiv_eq; auto with zarith.
-  pattern b at 1; replace b with (1 * b); auto with zarith.
-  apply Zmult_lt_compat_r; auto with zarith.
+  now apply Z.div_lt.
 Qed.
 
-Lemma Zmod_div_mod: forall n m a, 0 < n -> 0 < m ->
- (n | m) -> a mod n = (a mod m) mod n.
+Lemma Zmod_div_mod n m a:
+ 0 < n -> 0 < m -> (n | m) -> a mod n = (a mod m) mod n.
 Proof.
-  intros n m a H1 H2 H3.
-  pattern a at 1; rewrite (Z_div_mod_eq a m); auto with zarith.
-  case H3; intros q Hq; pattern m at 1; rewrite Hq.
-  rewrite (Zmult_comm q).
-  rewrite Zplus_mod; auto with zarith.
-  rewrite <- Zmult_assoc; rewrite Zmult_mod; auto with zarith.
-  rewrite Z_mod_same; try rewrite Zmult_0_l; auto with zarith.
-  rewrite (Zmod_small 0); auto with zarith.
-  rewrite Zplus_0_l; rewrite Zmod_mod; auto with zarith.
+  intros H1 H2 (p,Hp).
+  rewrite (Z.div_mod a m) at 1; auto with zarith.
+  rewrite Hp at 1.
+  rewrite Z.mul_shuffle0, Z.add_comm, Z.mod_add; auto with zarith.
 Qed.
 
-Lemma Zmod_divide_minus: forall a b c : Z, 0 < b ->
- a mod b = c -> (b | a - c).
+Lemma Zmod_divide_minus a b c:
+ 0 < b -> a mod b = c -> (b | a - c).
 Proof.
-  intros a b c H H1; apply Zmod_divide; auto with zarith.
+  intros H H1. apply Z.mod_divide; auto with zarith.
   rewrite Zminus_mod; auto with zarith.
-  rewrite H1; pattern c at 1; rewrite <- (Zmod_small c b); auto with zarith.
-  rewrite Zminus_diag; apply Zmod_small; auto with zarith.
-  subst; apply Z_mod_lt; auto with zarith.
+  rewrite H1. rewrite <- (Z.mod_small c b) at 1.
+  rewrite Z.sub_diag, Z.mod_0_l; auto with zarith.
+  subst. now apply Z.mod_pos_bound.
 Qed.
 
-Lemma Zdivide_mod_minus: forall a b c : Z, 0 <= c < b ->
- (b | a - c) -> a mod b = c.
+Lemma Zdivide_mod_minus a b c:
+ 0 <= c < b -> (b | a - c) -> a mod b = c.
 Proof.
-  intros a b c (H1, H2) H3; assert (0 < b); try apply Zle_lt_trans with c; auto.
+  intros (H1, H2) H3.
+  assert (0 < b) by Z.order.
   replace a with ((a - c) + c); auto with zarith.
-  rewrite Zplus_mod; auto with zarith.
-  rewrite (Zdivide_mod (a -c) b); try rewrite Zplus_0_l; auto with zarith.
-  rewrite Zmod_mod; try apply Zmod_small; auto with zarith.
+  rewrite Z.add_mod; auto with zarith.
+  rewrite (Zdivide_mod (a-c) b); try rewrite Z.add_0_l; auto with zarith.
+  rewrite Z.mod_mod; try apply Zmod_small; auto with zarith.
 Qed.
 
 (** * Greatest common divisor (gcd). *)
 
-(** There is no unicity of the gcd; hence we define the predicate [gcd a b d]
-     expressing that [d] is a gcd of [a] and [b].
-     (We show later that the [gcd] is actually unique if we discard its sign.) *)
+(** There is no unicity of the gcd; hence we define the predicate
+    [Zis_gcd a b g] expressing that [g] is a gcd of [a] and [b].
+    (We show later that the [gcd] is actually unique if we discard its sign.) *)
 
-Inductive Zis_gcd (a b d:Z) : Prop :=
-  Zis_gcd_intro :
-  (d | a) ->
-  (d | b) -> (forall x:Z, (x | a) -> (x | b) -> (x | d)) -> Zis_gcd a b d.
+Inductive Zis_gcd (a b g:Z) : Prop :=
+ Zis_gcd_intro :
+  (g | a) ->
+  (g | b) ->
+  (forall x, (x | a) -> (x | b) -> (x | g)) ->
+  Zis_gcd a b g.
 
 (** Trivial properties of [gcd] *)
 
-Lemma Zis_gcd_sym : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a d.
+Lemma Zis_gcd_sym : forall a b d, Zis_gcd a b d -> Zis_gcd b a d.
 Proof.
-  simple induction 1; constructor; intuition.
+  induction 1; constructor; intuition.
 Qed.
 
-Lemma Zis_gcd_0 : forall a:Z, Zis_gcd a 0 a.
+Lemma Zis_gcd_0 : forall a, Zis_gcd a 0 a.
 Proof.
   constructor; auto with zarith.
 Qed.
@@ -358,19 +226,18 @@ Proof.
   constructor; auto with zarith.
 Qed.
 
-Lemma Zis_gcd_minus : forall a b d:Z, Zis_gcd a (- b) d -> Zis_gcd b a d.
+Lemma Zis_gcd_minus : forall a b d, Zis_gcd a (- b) d -> Zis_gcd b a d.
 Proof.
-  simple induction 1; constructor; intuition.
+  induction 1; constructor; intuition.
 Qed.
 
-Lemma Zis_gcd_opp : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a (- d).
+Lemma Zis_gcd_opp : forall a b d, Zis_gcd a b d -> Zis_gcd b a (- d).
 Proof.
-  simple induction 1; constructor; intuition.
+  induction 1; constructor; intuition.
 Qed.
 
-Lemma Zis_gcd_0_abs : forall a:Z, Zis_gcd 0 a (Zabs a).
+Lemma Zis_gcd_0_abs a : Zis_gcd 0 a (Z.abs a).
 Proof.
-  intros a.
   apply Zabs_ind.
   intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto.
   intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto.
@@ -381,12 +248,10 @@ Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith.
 Theorem Zis_gcd_unique: forall a b c d : Z,
  Zis_gcd a b c -> Zis_gcd a b d ->  c = d \/ c = (- d).
 Proof.
-intros a b c d H1 H2.
-inversion_clear H1 as [Hc1 Hc2 Hc3].
-inversion_clear H2 as [Hd1 Hd2 Hd3].
-assert (H3: Zdivide c d); auto.
-assert (H4: Zdivide d c); auto.
-apply Zdivide_antisym; auto.
+intros a b c d [Hc1 Hc2 Hc3] [Hd1 Hd2 Hd3].
+assert (c|d) by auto.
+assert (d|c) by auto.
+apply Z.divide_antisym; auto.
 Qed.
 
 
@@ -429,7 +294,7 @@ Section extended_euclid_algorithm.
   (** The recursive part of Euclid's algorithm uses well-founded
       recursion of non-negative integers. It maintains 6 integers
       [u1,u2,u3,v1,v2,v3] such that the following invariant holds:
-      [u1*a+u2*b=u3] and [v1*a+v2*b=v3] and [gcd(u2,v3)=gcd(a,b)].
+      [u1*a+u2*b=u3] and [v1*a+v2*b=v3] and [gcd(u3,v3)=gcd(a,b)].
       *)
 
   Lemma euclid_rec :
@@ -440,7 +305,7 @@ Section extended_euclid_algorithm.
 	v1 * a + v2 * b = v3 ->
 	(forall d:Z, Zis_gcd u3 v3 d -> Zis_gcd a b d) -> Euclid.
   Proof.
-    intros v3 Hv3; generalize Hv3; pattern v3 in |- *.
+    intros v3 Hv3; generalize Hv3; pattern v3.
     apply Zlt_0_rec.
     clear v3 Hv3; intros.
     elim (Z_zerop x); intro.
@@ -454,8 +319,8 @@ Section extended_euclid_algorithm.
     apply Z_mod_lt; omega.
     assert (xpos : x > 0). omega.
     generalize (Z_div_mod_eq u3 x xpos).
-    unfold q in |- *.
-    intro eq; pattern u3 at 2 in |- *; rewrite eq; ring.
+    unfold q.
+    intro eq; pattern u3 at 2; rewrite eq; ring.
     apply (H (u3 - q * x) Hq (proj1 Hq) v1 v2 x (u1 - q * v1) (u2 - q * v2)).
     tauto.
     replace ((u1 - q * v1) * a + (u2 - q * v2) * b) with
@@ -492,7 +357,7 @@ Proof.
   intros H1 H2 H3; simple induction 1; intros.
   generalize (H3 d' H4 H5); intro Hd'd.
   generalize (H6 d H1 H2); intro Hdd'.
-  exact (Zdivide_antisym d d' Hdd' Hd'd).
+  exact (Z.divide_antisym d d' Hdd' Hd'd).
 Qed.
 
 (** * Bezout's coefficients *)
@@ -519,14 +384,15 @@ Qed.
 Lemma Zis_gcd_mult :
   forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d).
 Proof.
-  intros a b c d; simple induction 1; constructor; intuition.
-  elim (Zis_gcd_bezout a b d H). intros.
-  elim H3; intros.
-  elim H4; intros.
-  apply Zdivide_intro with (u * q + v * q0).
-  rewrite <- H5.
+  intros a b c d; simple induction 1. constructor; auto with zarith.
+  intros x Ha Hb.
+  elim (Zis_gcd_bezout a b d H). intros u v Huv.
+  elim Ha; intros a' Ha'.
+  elim Hb; intros b' Hb'.
+  apply Zdivide_intro with (u * a' + v * b').
+  rewrite <- Huv.
   replace (c * (u * a + v * b)) with (u * (c * a) + v * (c * b)).
-  rewrite H6; rewrite H7; ring.
+  rewrite Ha'; rewrite Hb'; ring.
   ring.
 Qed.
 
@@ -584,21 +450,21 @@ Lemma rel_prime_cross_prod :
     rel_prime c d -> b > 0 -> d > 0 -> a * d = b * c -> a = c /\ b = d.
 Proof.
   intros a b c d; intros.
-  elim (Zdivide_antisym b d).
+  elim (Z.divide_antisym b d).
   split; auto with zarith.
   rewrite H4 in H3.
-  rewrite Zmult_comm in H3.
-  apply Zmult_reg_l with d; auto with zarith.
+  rewrite Z.mul_comm in H3.
+  apply Z.mul_reg_l with d; auto with zarith.
   intros; omega.
   apply Gauss with a.
   rewrite H3.
   auto with zarith.
-  red in |- *; auto with zarith.
+  red; auto with zarith.
   apply Gauss with c.
-  rewrite Zmult_comm.
+  rewrite Z.mul_comm.
   rewrite <- H3.
   auto with zarith.
-  red in |- *; auto with zarith.
+  red; auto with zarith.
 Qed.
 
 (** After factorization by a gcd, the original numbers are relatively prime. *)
@@ -613,7 +479,7 @@ Proof.
   elim H1; intros.
   elim H4; intros.
   rewrite H2 in H6; subst b; omega.
-  unfold rel_prime in |- *.
+  unfold rel_prime.
   destruct H1.
   destruct H1 as (a',H1).
   destruct H3 as (b',H3).
@@ -625,14 +491,14 @@ Proof.
   exists a'; auto with zarith.
   exists b'; auto with zarith.
   intros x (xa,H5) (xb,H6).
-  destruct (H4 (x*g)).
-  exists xa; rewrite Zmult_assoc; rewrite <- H5; auto.
-  exists xb; rewrite Zmult_assoc; rewrite <- H6; auto.
-  replace g with (1*g) in H7; auto with zarith.
-  do 2 rewrite Zmult_assoc in H7.
-  generalize (Zmult_reg_r _ _ _ H2 H7); clear H7; intros.
-  rewrite Zmult_1_r in H7.
-  exists q; auto with zarith.
+  destruct (H4 (x*g)) as (x',Hx').
+  exists xa; rewrite Z.mul_assoc; rewrite <- H5; auto.
+  exists xb; rewrite Z.mul_assoc; rewrite <- H6; auto.
+  replace g with (1*g) in Hx'; auto with zarith.
+  do 2 rewrite Z.mul_assoc in Hx'.
+  apply Z.mul_reg_r in Hx'; trivial.
+  rewrite Z.mul_1_r in Hx'.
+  exists x'; auto with zarith.
 Qed.
 
 Theorem rel_prime_sym: forall a b, rel_prime a b -> rel_prime b a.
@@ -646,9 +512,9 @@ Theorem rel_prime_div: forall p q r,
 Proof.
   intros p q r H (u, H1); subst.
   inversion_clear H as [H1 H2 H3].
-  red; apply Zis_gcd_intro; try apply Zone_divide.
+  red; apply Zis_gcd_intro; try apply Z.divide_1_l.
   intros x H4 H5; apply H3; auto.
-  apply Zdivide_mult_r; auto.
+  apply Z.divide_mul_r; auto.
 Qed.
 
 Theorem rel_prime_1: forall n, rel_prime 1 n.
@@ -709,30 +575,29 @@ Lemma prime_divisors :
   forall p:Z,
     prime p -> forall a:Z, (a | p) -> a = -1 \/ a = 1 \/ a = p \/ a = - p.
 Proof.
-  simple induction 1; intros.
+  destruct 1; intros.
   assert
     (a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p).
-  assert (Zabs a <= Zabs p). apply Zdivide_bounds; [ assumption | omega ].
-  generalize H3.
-  pattern (Zabs a) in |- *; apply Zabs_ind; pattern (Zabs p) in |- *;
-    apply Zabs_ind; intros; omega.
+  { assert (Z.abs a <= Z.abs p) as H2.
+      apply Zdivide_bounds; [ assumption | omega ].
+    revert H2.
+    pattern (Z.abs a); apply Zabs_ind; pattern (Z.abs p); apply Zabs_ind;
+    intros; omega. }
   intuition idtac.
   (* -p < a < -1 *)
-  absurd (rel_prime (- a) p); intuition.
-  inversion H3.
-  assert (- a | - a); auto with zarith.
-  assert (- a | p); auto with zarith.
-  generalize (H8 (- a) H9 H10); intuition idtac.
-  generalize (Zdivide_1 (- a) H11); intuition.
+  - absurd (rel_prime (- a) p); intuition.
+    inversion H2.
+    assert (- a | - a) by auto with zarith.
+    assert (- a | p) by auto with zarith.
+    apply H7, Z.divide_1_r in H8; intuition.
   (* a = 0 *)
-  inversion H2. subst a; omega.
+  - inversion H1. subst a; omega.
   (* 1 < a < p *)
-  absurd (rel_prime a p); intuition.
-  inversion H3.
-  assert (a | a); auto with zarith.
-  assert (a | p); auto with zarith.
-  generalize (H8 a H9 H10); intuition idtac.
-  generalize (Zdivide_1 a H11); intuition.
+  - absurd (rel_prime a p); intuition.
+    inversion H2.
+    assert (a | a) by auto with zarith.
+    assert (a | p) by auto with zarith.
+    apply H7, Z.divide_1_r in H8; intuition.
 Qed.
 
 (** A prime number is relatively prime with any number it does not divide *)
@@ -757,7 +622,7 @@ Proof.
   intros a p Hp [H1 H2].
   apply rel_prime_sym; apply prime_rel_prime; auto.
   intros [q Hq]; subst a.
-  case (Zle_or_lt q 0); intros Hl.
+  case (Z.le_gt_cases q 0); intros Hl.
   absurd (q * p <= 0 * p); auto with zarith.
   absurd (1 * p <= q * p); auto with zarith.
 Qed.
@@ -787,87 +652,79 @@ Qed.
 Lemma prime_2: prime 2.
 Proof.
   apply prime_intro; auto with zarith.
-  intros n [H1 H2]; case Zle_lt_or_eq with ( 1 := H1 ); auto with zarith;
-   clear H1; intros H1.
-  contradict H2; auto with zarith.
-  subst n; red; auto with zarith.
-  apply Zis_gcd_intro; auto with zarith.
+  intros n (H,H'); Z.le_elim H; auto with zarith.
+  - contradict H'; auto with zarith.
+  - subst n. constructor; auto with zarith.
 Qed.
 
 Theorem prime_3: prime 3.
 Proof.
   apply prime_intro; auto with zarith.
-  intros n [H1 H2]; case Zle_lt_or_eq with ( 1 := H1 ); auto with zarith;
-   clear H1; intros H1.
-  case (Zle_lt_or_eq 2 n); auto with zarith; clear H1; intros H1.
-  contradict H2; auto with zarith.
-  subst n; red; auto with zarith.
-  apply Zis_gcd_intro; auto with zarith.
-  intros x [q1 Hq1] [q2 Hq2].
-  exists (q2 - q1).
-  apply trans_equal with (3 - 2); auto with zarith.
-  rewrite Hq1; rewrite Hq2; ring.
-  subst n; red; auto with zarith.
-  apply Zis_gcd_intro; auto with zarith.
+  intros n (H,H'); Z.le_elim H; auto with zarith.
+  - replace n with 2 by omega.
+    constructor; auto with zarith.
+    intros x (q,Hq) (q',Hq').
+    exists (q' - q). ring_simplify. now rewrite <- Hq, <- Hq'.
+  - replace n with 1 by trivial.
+    constructor; auto with zarith.
 Qed.
 
-Theorem prime_ge_2: forall p, prime p ->  2 <= p.
+Theorem prime_ge_2 p : prime p ->  2 <= p.
 Proof.
-  intros p Hp; inversion Hp; auto with zarith.
+  intros (Hp,_); auto with zarith.
 Qed.
 
 Definition prime' p := 1<p /\ (forall n, 1<n<p -> ~ (n|p)).
 
-Theorem prime_alt:
- forall p, prime' p <-> prime p.
+Lemma Z_0_1_more x : 0<=x -> x=0 \/ x=1 \/ 1<x.
 Proof.
-  split; destruct 1; intros.
-  (* prime -> prime' *)
-  constructor; auto; intros.
-  red; apply Zis_gcd_intro; auto with zarith; intros.
-  case (Zle_lt_or_eq 0 (Zabs x)); auto with zarith; intros H6.
-  case (Zle_lt_or_eq 1 (Zabs x)); auto with zarith; intros H7.
-  case (Zle_lt_or_eq (Zabs x) p); auto with zarith.
-  apply Zdivide_le; auto with zarith.
-  apply Zdivide_Zabs_inv_l; auto.
-  intros H8; case (H0 (Zabs x)); auto.
-  apply Zdivide_Zabs_inv_l; auto.
-  intros H8; subst p; absurd (Zabs x <= n); auto with zarith.
-  apply Zdivide_le; auto with zarith.
-  apply Zdivide_Zabs_inv_l; auto.
-  rewrite H7; pattern (Zabs x); apply Zabs_intro; auto with zarith.
-  absurd (0%Z = p); auto with zarith.
-  assert (x=0) by (destruct x; simpl in *; now auto).
-  subst x; elim H3; intro q; rewrite Zmult_0_r; auto.
-  (* prime' -> prime *)
-  split; auto; intros.
-  intros H2.
-  case (Zis_gcd_unique n p n 1); auto with zarith.
-  apply Zis_gcd_intro; auto with zarith.
-  apply H0; auto with zarith.
+ intros H. Z.le_elim H; auto.
+ apply Z.le_succ_l in H. change (1 <= x) in H. Z.le_elim H; auto.
+Qed.
+
+Theorem prime_alt p : prime' p <-> prime p.
+Proof.
+  split; intros (Hp,H).
+  - (* prime -> prime' *)
+    constructor; trivial; intros n Hn.
+    constructor; auto with zarith; intros x Hxn Hxp.
+    rewrite <- Z.divide_abs_l in Hxn, Hxp |- *.
+    assert (Hx := Z.abs_nonneg x).
+    set (y:=Z.abs x) in *; clearbody y; clear x; rename y into x.
+    destruct (Z_0_1_more x Hx) as [->|[->|Hx']].
+    + exfalso. apply Z.divide_0_l in Hxn. omega.
+    + now exists 1.
+    + elim (H x); auto.
+      split; trivial.
+      apply Z.le_lt_trans with n; auto with zarith.
+      apply Z.divide_pos_le; auto with zarith.
+  - (* prime' -> prime *)
+    constructor; trivial. intros n Hn Hnp.
+    case (Zis_gcd_unique n p n 1); auto with zarith.
+    constructor; auto with zarith.
+    apply H; auto with zarith.
 Qed.
 
 Theorem square_not_prime: forall a, ~ prime (a * a).
 Proof.
   intros a Ha.
-  rewrite <- (Zabs_square a) in Ha.
-  assert (0 <= Zabs a) by auto with zarith.
-  set (b:=Zabs a) in *; clearbody b.
-  rewrite <- prime_alt in Ha; destruct Ha.
-  case (Zle_lt_or_eq 0 b); auto with zarith; intros Hza1; [ | subst; omega].
-  case (Zle_lt_or_eq 1 b); auto with zarith; intros Hza2; [ | subst; omega].
-  assert (Hza3 := Zmult_lt_compat_r 1 b b Hza1 Hza2).
-  rewrite Zmult_1_l in Hza3.
-  elim (H1 _ (conj Hza2 Hza3)).
-  exists b; auto.
+  rewrite <- (Z.abs_square a) in Ha.
+  assert (H:=Z.abs_nonneg a).
+  set (b:=Z.abs a) in *; clearbody b; clear a; rename b into a.
+  rewrite <- prime_alt in Ha; destruct Ha as (Ha,Ha').
+  assert (H' : 1 < a) by now apply (Z.square_lt_simpl_nonneg 1).
+  apply (Ha' a).
+  + split; trivial.
+    rewrite <- (Z.mul_1_l a) at 1. apply Z.mul_lt_mono_pos_r; omega.
+  + exists a; auto.
 Qed.
 
 Theorem prime_div_prime: forall p q,
  prime p -> prime q -> (p | q) -> p = q.
 Proof.
   intros p q H H1 H2;
-  assert (Hp: 0 < p); try apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith.
-  assert (Hq: 0 < q); try apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith.
+  assert (Hp: 0 < p); try apply Z.lt_le_trans with 2; try apply prime_ge_2; auto with zarith.
+  assert (Hq: 0 < q); try apply Z.lt_le_trans with 2; try apply prime_ge_2; auto with zarith.
   case prime_divisors with (2 := H2); auto.
   intros H4; contradict Hp; subst; auto with zarith.
   intros [H4| [H4 | H4]]; subst; auto.
@@ -875,311 +732,101 @@ Proof.
   contradict Hp; auto with zarith.
 Qed.
 
+(** we now prove that [Z.gcd] is indeed a gcd in
+   the sense of [Zis_gcd]. *)
 
-(** We could obtain a [Zgcd] function via Euclid algorithm. But we propose
-  here a binary version of [Zgcd], faster and executable within Coq.
-
-   Algorithm:
-
-   gcd 0 b = b
-   gcd a 0 = a
-   gcd (2a) (2b) = 2(gcd a b)
-   gcd (2a+1) (2b) = gcd (2a+1) b
-   gcd (2a) (2b+1) = gcd a (2b+1)
-   gcd (2a+1) (2b+1) = gcd (b-a) (2*a+1)
-                    or gcd (a-b) (2*b+1), depending on whether a<b
-*)
-
-Open Scope positive_scope.
-
-Fixpoint Pgcdn (n: nat) (a b : positive) : positive :=
-  match n with
-    | O => 1
-    | S n =>
-      match a,b with
-	| xH, _ => 1
-	| _, xH => 1
-	| xO a, xO b => xO (Pgcdn n a b)
-	| a, xO b => Pgcdn n a b
-	| xO a, b => Pgcdn n a b
-	| xI a', xI b' =>
-          match Pcompare a' b' Eq with
-	    | Eq => a
-	    | Lt => Pgcdn  n (b'-a') a
-	    | Gt => Pgcdn n (a'-b') b
-          end
-      end
-  end.
-
-Definition Pgcd (a b: positive) := Pgcdn (Psize a + Psize b)%nat a b.
-
-Close Scope positive_scope.
-
-Definition Zgcd (a b : Z) : Z :=
-  match a,b with
-    | Z0, _ => Zabs b
-    | _, Z0 => Zabs a
-    | Zpos a, Zpos b => Zpos (Pgcd a b)
-    | Zpos a, Zneg b => Zpos (Pgcd a b)
-    | Zneg a, Zpos b => Zpos (Pgcd a b)
-    | Zneg a, Zneg b => Zpos (Pgcd a b)
-  end.
-
-Lemma Zgcd_is_pos : forall a b, 0 <= Zgcd a b.
-Proof.
-  unfold Zgcd; destruct a; destruct b; auto with zarith.
-Qed.
-
-Lemma Zis_gcd_even_odd : forall a b g, Zis_gcd (Zpos a) (Zpos (xI b)) g ->
-  Zis_gcd (Zpos (xO a)) (Zpos (xI b)) g.
-Proof.
-  intros.
-  destruct H.
-  constructor; auto.
-  destruct H as (e,H2); exists (2*e); auto with zarith.
-  rewrite Zpos_xO; rewrite H2; ring.
-  intros.
-  apply H1; auto.
-  rewrite Zpos_xO in H2.
-  rewrite Zpos_xI in H3.
-  apply Gauss with 2; auto.
-  apply bezout_rel_prime.
-  destruct H3 as (bb, H3).
-  apply Bezout_intro with bb (-Zpos b).
-  omega.
-Qed.
+Notation Zgcd_is_pos := Z.gcd_nonneg (compat "8.3").
 
-Lemma Pgcdn_correct : forall n a b, (Psize a + Psize b<=n)%nat ->
-  Zis_gcd (Zpos a) (Zpos b) (Zpos (Pgcdn n a b)).
+Lemma Zgcd_is_gcd : forall a b, Zis_gcd a b (Z.gcd a b).
 Proof.
-  intro n; pattern n; apply lt_wf_ind; clear n; intros.
-  destruct n.
-  simpl.
-  destruct a; simpl in *; try inversion H0.
-  destruct a.
-  destruct b; simpl.
-  case_eq (Pcompare a b Eq); intros.
-  (* a = xI, b = xI, compare = Eq *)
-  rewrite (Pcompare_Eq_eq _ _ H1); apply Zis_gcd_refl.
-  (* a = xI, b = xI, compare = Lt *)
-  apply Zis_gcd_sym.
-  apply Zis_gcd_for_euclid with 1.
-  apply Zis_gcd_sym.
-  replace (Zpos (xI b) - 1 * Zpos (xI a)) with (Zpos(xO (b - a))).
-  apply Zis_gcd_even_odd.
-  apply H; auto.
-  simpl in *.
-  assert (Psize (b-a) <= Psize b)%nat.
-  apply Psize_monotone.
-  change (Zpos (b-a) < Zpos b).
-  rewrite (Zpos_minus_morphism _ _ H1).
-  assert (0 < Zpos a) by (compute; auto).
-  omega.
-  omega.
-  rewrite Zpos_xO; do 2 rewrite Zpos_xI.
-  rewrite Zpos_minus_morphism; auto.
-  omega.
-  (* a = xI, b = xI, compare = Gt *)
-  apply Zis_gcd_for_euclid with 1.
-  replace (Zpos (xI a) - 1 * Zpos (xI b)) with (Zpos(xO (a - b))).
-  apply Zis_gcd_sym.
-  apply Zis_gcd_even_odd.
-  apply H; auto.
-  simpl in *.
-  assert (Psize (a-b) <= Psize a)%nat.
-  apply Psize_monotone.
-  change (Zpos (a-b) < Zpos a).
-  rewrite (Zpos_minus_morphism b a).
-  assert (0 < Zpos b) by (compute; auto).
-  omega.
-  rewrite ZC4; rewrite H1; auto.
-  omega.
-  rewrite Zpos_xO; do 2 rewrite Zpos_xI.
-  rewrite Zpos_minus_morphism; auto.
-  omega.
-  rewrite ZC4; rewrite H1; auto.
-  (* a = xI, b = xO *)
-  apply Zis_gcd_sym.
-  apply Zis_gcd_even_odd.
-  apply Zis_gcd_sym.
-  apply H; auto.
-  simpl in *; omega.
-  (* a = xI, b = xH *)
-  apply Zis_gcd_1.
-  destruct b; simpl.
-  (* a = xO, b = xI *)
-  apply Zis_gcd_even_odd.
-  apply H; auto.
-  simpl in *; omega.
-  (* a = xO, b = xO *)
-  rewrite (Zpos_xO a); rewrite (Zpos_xO b); rewrite (Zpos_xO (Pgcdn n a b)).
-  apply Zis_gcd_mult.
-  apply H; auto.
-  simpl in *; omega.
-  (* a = xO, b = xH *)
-  apply Zis_gcd_1.
-  (* a = xH *)
-  simpl; apply Zis_gcd_sym; apply Zis_gcd_1.
-Qed.
-
-Lemma Pgcd_correct : forall a b, Zis_gcd (Zpos a) (Zpos b) (Zpos (Pgcd a b)).
-Proof.
-  unfold Pgcd; intros.
-  apply Pgcdn_correct; auto.
-Qed.
-
-Lemma Zgcd_is_gcd : forall a b, Zis_gcd a b (Zgcd a b).
-Proof.
-  destruct a.
-  intros.
-  simpl.
-  apply Zis_gcd_0_abs.
-  destruct b; simpl.
-  apply Zis_gcd_0.
-  apply Pgcd_correct.
-  apply Zis_gcd_sym.
-  apply Zis_gcd_minus; simpl.
-  apply Pgcd_correct.
-  destruct b; simpl.
-  apply Zis_gcd_minus; simpl.
-  apply Zis_gcd_sym.
-  apply Zis_gcd_0.
-  apply Zis_gcd_minus; simpl.
-  apply Zis_gcd_sym.
-  apply Pgcd_correct.
-  apply Zis_gcd_sym.
-  apply Zis_gcd_minus; simpl.
-  apply Zis_gcd_minus; simpl.
-  apply Zis_gcd_sym.
-  apply Pgcd_correct.
+ constructor.
+ apply Z.gcd_divide_l.
+ apply Z.gcd_divide_r.
+ apply Z.gcd_greatest.
 Qed.
 
 Theorem Zgcd_spec : forall x y : Z, {z : Z | Zis_gcd x y z /\ 0 <= z}.
 Proof.
-  intros x y; exists (Zgcd x y).
-  split; [apply Zgcd_is_gcd  | apply Zgcd_is_pos].
+  intros x y; exists (Z.gcd x y).
+  split; [apply Zgcd_is_gcd  | apply Z.gcd_nonneg].
 Qed.
 
 Theorem Zdivide_Zgcd: forall p q r : Z,
- (p | q) -> (p | r) -> (p | Zgcd q r).
+ (p | q) -> (p | r) -> (p | Z.gcd q r).
 Proof.
-  intros p q r H1 H2.
-  assert (H3: (Zis_gcd q r (Zgcd q r))).
-  apply Zgcd_is_gcd.
-  inversion_clear H3; auto.
+ intros. now apply Z.gcd_greatest.
 Qed.
 
 Theorem Zis_gcd_gcd: forall a b c : Z,
- 0 <= c ->  Zis_gcd a b c -> Zgcd a b = c.
+ 0 <= c ->  Zis_gcd a b c -> Z.gcd a b = c.
 Proof.
   intros a b c H1 H2.
-  case (Zis_gcd_uniqueness_apart_sign a b c (Zgcd a b)); auto.
+  case (Zis_gcd_uniqueness_apart_sign a b c (Z.gcd a b)); auto.
   apply Zgcd_is_gcd; auto.
-  case Zle_lt_or_eq with (1 := H1); clear H1; intros H1; subst; auto.
-  intros H3; subst.
-  generalize (Zgcd_is_pos a b); auto with zarith.
-  case (Zgcd a b); simpl; auto; intros; discriminate.
-Qed.
-
-Theorem Zgcd_inv_0_l: forall x y, Zgcd x y = 0 -> x = 0.
-Proof.
-  intros x y H.
-  assert (F1: Zdivide 0 x).
-   rewrite <- H.
-   generalize (Zgcd_is_gcd x y); intros HH; inversion HH; auto.
-  inversion F1 as [z H1].
-  rewrite H1; ring.
+  Z.le_elim H1.
+  - generalize (Z.gcd_nonneg a b); auto with zarith.
+  - subst. now case (Z.gcd a b).
 Qed.
 
-Theorem Zgcd_inv_0_r: forall x y, Zgcd x y = 0 -> y = 0.
-Proof.
-  intros x y H.
-  assert (F1: Zdivide 0 y).
-   rewrite <- H.
-   generalize (Zgcd_is_gcd x y); intros HH; inversion HH; auto.
-  inversion F1 as [z H1].
-  rewrite H1; ring.
-Qed.
+Notation Zgcd_inv_0_l := Z.gcd_eq_0_l (compat "8.3").
+Notation Zgcd_inv_0_r := Z.gcd_eq_0_r (compat "8.3").
 
 Theorem Zgcd_div_swap0 : forall a b : Z,
- 0 < Zgcd a b ->
+ 0 < Z.gcd a b ->
  0 < b ->
- (a / Zgcd a b) * b = a * (b/Zgcd a b).
+ (a / Z.gcd a b) * b = a * (b/Z.gcd a b).
 Proof.
   intros a b Hg Hb.
   assert (F := Zgcd_is_gcd a b); inversion F as [F1 F2 F3].
-  pattern b at 2; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
-  repeat rewrite Zmult_assoc; f_equal.
-  rewrite Zmult_comm.
+  pattern b at 2; rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b); auto.
+  repeat rewrite Z.mul_assoc; f_equal.
+  rewrite Z.mul_comm.
   rewrite <- Zdivide_Zdiv_eq; auto.
 Qed.
 
 Theorem Zgcd_div_swap : forall a b c : Z,
- 0 < Zgcd a b ->
+ 0 < Z.gcd a b ->
  0 < b ->
- (c * a) / Zgcd a b * b = c * a * (b/Zgcd a b).
+ (c * a) / Z.gcd a b * b = c * a * (b/Z.gcd a b).
 Proof.
   intros a b c Hg Hb.
   assert (F := Zgcd_is_gcd a b); inversion F as [F1 F2 F3].
-  pattern b at 2; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
-  repeat rewrite Zmult_assoc; f_equal.
+  pattern b at 2; rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b); auto.
+  repeat rewrite Z.mul_assoc; f_equal.
   rewrite Zdivide_Zdiv_eq_2; auto.
-  repeat rewrite <- Zmult_assoc; f_equal.
-  rewrite Zmult_comm.
+  repeat rewrite <- Z.mul_assoc; f_equal.
+  rewrite Z.mul_comm.
   rewrite <- Zdivide_Zdiv_eq; auto.
 Qed.
 
-Lemma Zgcd_comm : forall a b, Zgcd a b = Zgcd b a.
-Proof.
-  intros.
-  apply Zis_gcd_gcd.
-  apply Zgcd_is_pos.
-  apply Zis_gcd_sym.
-  apply Zgcd_is_gcd.
-Qed.
+Notation Zgcd_comm := Z.gcd_comm (compat "8.3").
 
-Lemma Zgcd_ass : forall a b c, Zgcd (Zgcd a b) c = Zgcd a (Zgcd b c).
+Lemma Zgcd_ass a b c : Z.gcd (Z.gcd a b) c = Z.gcd a (Z.gcd b c).
 Proof.
-  intros.
-  apply Zis_gcd_gcd.
-  apply Zgcd_is_pos.
-  destruct (Zgcd_is_gcd a b).
-  destruct (Zgcd_is_gcd b c).
-  destruct (Zgcd_is_gcd a (Zgcd b c)).
-  constructor; eauto using Zdivide_trans.
+ symmetry. apply Z.gcd_assoc.
 Qed.
 
-Lemma Zgcd_Zabs : forall a b, Zgcd (Zabs a) b = Zgcd a b.
-Proof.
-  destruct a; simpl; auto.
-Qed.
-
-Lemma Zgcd_0 : forall a, Zgcd a 0 = Zabs a.
-Proof.
-  destruct a; simpl; auto.
-Qed.
+Notation Zgcd_Zabs := Z.gcd_abs_l (compat "8.3").
+Notation Zgcd_0 := Z.gcd_0_r (compat "8.3").
+Notation Zgcd_1 := Z.gcd_1_r (compat "8.3").
 
-Lemma Zgcd_1 : forall a, Zgcd a 1 = 1.
-Proof.
-  intros; apply Zis_gcd_gcd; auto with zarith; apply Zis_gcd_1.
-Qed.
-Hint Resolve Zgcd_0 Zgcd_1 : zarith.
+Hint Resolve Z.gcd_0_r Z.gcd_1_r : zarith.
 
 Theorem Zgcd_1_rel_prime : forall a b,
- Zgcd a b = 1 <-> rel_prime a b.
+ Z.gcd a b = 1 <-> rel_prime a b.
 Proof.
   unfold rel_prime; split; intro H.
   rewrite <- H; apply Zgcd_is_gcd.
-  case (Zis_gcd_unique a b (Zgcd a b) 1); auto.
+  case (Zis_gcd_unique a b (Z.gcd a b) 1); auto.
   apply Zgcd_is_gcd.
-  intros H2; absurd (0 <= Zgcd a b); auto with zarith.
-  generalize (Zgcd_is_pos a b); auto with zarith.
+  intros H2; absurd (0 <= Z.gcd a b); auto with zarith.
+  generalize (Z.gcd_nonneg a b); auto with zarith.
 Qed.
 
 Definition rel_prime_dec: forall a b,
  { rel_prime a b }+{ ~ rel_prime a b }.
 Proof.
-  intros a b; case (Z_eq_dec (Zgcd a b) 1); intros H1.
+  intros a b; case (Z.eq_dec (Z.gcd a b) 1); intros H1.
   left; apply -> Zgcd_1_rel_prime; auto.
   right; contradict H1; apply <- Zgcd_1_rel_prime; auto.
 Defined.
@@ -1197,25 +844,24 @@ Proof.
   intros x Hx IH; destruct IH as [F|E].
   destruct (rel_prime_dec x p) as [Y|N].
   left; intros n [HH1 HH2].
-  case (Zgt_succ_gt_or_eq x n); auto with zarith.
-  intros HH3; subst x; auto.
-  case (Z_lt_dec 1 x); intros HH1.
-  right; exists x; split; auto with zarith.
-  left; intros n [HHH1 HHH2]; contradict HHH1; auto with zarith.
-  right; destruct E as (n,((H0,H2),H3)); exists n; auto with zarith.
+  rewrite Z.lt_succ_r in HH2.
+  Z.le_elim HH2; subst; auto with zarith.
+  - case (Z_lt_dec 1 x); intros HH1.
+    * right; exists x; split; auto with zarith.
+    * left; intros n [HHH1 HHH2]; contradict HHH1; auto with zarith.
+  - right; destruct E as (n,((H0,H2),H3)); exists n; auto with zarith.
 Defined.
 
 Definition prime_dec: forall p, { prime p }+{ ~ prime p }.
 Proof.
   intros p; case (Z_lt_dec 1 p); intros H1.
-  case (prime_dec_aux p p); intros H2.
-  left; apply prime_intro; auto.
-  intros n [Hn1 Hn2]; case Zle_lt_or_eq with ( 1 := Hn1 ); auto.
-  intros HH; subst n.
-  red; apply Zis_gcd_intro; auto with zarith.
-  right; intros H3; inversion_clear H3 as [Hp1 Hp2].
-  case H2; intros n [Hn1 Hn2]; case Hn2; auto with zarith.
-  right; intros H3; inversion_clear H3 as [Hp1 Hp2]; case H1; auto.
+  + case (prime_dec_aux p p); intros H2.
+    * left; apply prime_intro; auto.
+      intros n (Hn1,Hn2). Z.le_elim Hn1; auto; subst n.
+      constructor; auto with zarith.
+    * right; intros H3; inversion_clear H3 as [Hp1 Hp2].
+      case H2; intros n [Hn1 Hn2]; case Hn2; auto with zarith.
+  + right; intros H3; inversion_clear H3 as [Hp1 Hp2]; case H1; auto.
 Defined.
 
 Theorem not_prime_divide:
@@ -1223,193 +869,16 @@ Theorem not_prime_divide:
 Proof.
   intros p Hp Hp1.
   case (prime_dec_aux p p); intros H1.
-  elim Hp1; constructor; auto.
-  intros n [Hn1 Hn2].
-  case Zle_lt_or_eq with ( 1 := Hn1 ); auto with zarith.
-  intros H2; subst n; red; apply Zis_gcd_intro; auto with zarith.
-  case H1; intros n [Hn1 Hn2].
-  generalize (Zgcd_is_pos n p); intros Hpos.
-  case (Zle_lt_or_eq 0 (Zgcd n p)); auto with zarith; intros H3.
-  case (Zle_lt_or_eq 1 (Zgcd n p)); auto with zarith; intros H4.
-  exists (Zgcd n p); split; auto.
-  split; auto.
-  apply Zle_lt_trans with n; auto with zarith.
-  generalize (Zgcd_is_gcd n p); intros tmp; inversion_clear tmp as [Hr1 Hr2 Hr3].
-  case Hr1; intros q Hq.
-  case (Zle_or_lt q 0); auto with zarith; intros Ht.
-  absurd (n <= 0 * Zgcd n p) ; auto with zarith.
-  pattern n at 1; rewrite Hq; auto with zarith.
-  apply Zle_trans with (1 * Zgcd n p); auto with zarith.
-  pattern n at 2; rewrite Hq; auto with zarith.
-  generalize (Zgcd_is_gcd n p); intros Ht; inversion Ht; auto.
-  case Hn2; red.
-  rewrite H4; apply Zgcd_is_gcd.
-  generalize (Zgcd_is_gcd n p); rewrite <- H3; intros tmp;
-  inversion_clear tmp as [Hr1 Hr2 Hr3].
-  absurd (n = 0); auto with zarith.
-  case Hr1; auto with zarith.
-Qed.
-
-(** A Generalized Gcd that also computes Bezout coefficients.
-   The algorithm is the same as for Zgcd. *)
-
-Open Scope positive_scope.
-
-Fixpoint Pggcdn (n: nat) (a b : positive) : (positive*(positive*positive)) :=
-  match n with
-    | O => (1,(a,b))
-    | S n =>
-      match a,b with
-	| xH, b => (1,(1,b))
-	| a, xH => (1,(a,1))
-	| xO a, xO b =>
-           let (g,p) := Pggcdn n a b in
-           (xO g,p)
-	| a, xO b =>
-           let (g,p) := Pggcdn n a b in
-           let (aa,bb) := p in
-           (g,(aa, xO bb))
-	| xO a, b =>
-           let (g,p) := Pggcdn n a b in
-           let (aa,bb) := p in
-           (g,(xO aa, bb))
-	| xI a', xI b' =>
-           match Pcompare a' b' Eq with
-	     | Eq => (a,(1,1))
-	     | Lt =>
-	        let (g,p) := Pggcdn n (b'-a') a in
-	        let (ba,aa) := p in
-	        (g,(aa, aa + xO ba))
-	     | Gt =>
-		let (g,p) := Pggcdn n (a'-b') b in
-		let (ab,bb) := p in
-		(g,(bb+xO ab, bb))
-	   end
-      end
-  end.
-
-Definition Pggcd (a b: positive) := Pggcdn (Psize a + Psize b)%nat a b.
-
-Open Scope Z_scope.
-
-Definition Zggcd (a b : Z) : Z*(Z*Z) :=
-  match a,b with
-    | Z0, _ => (Zabs b,(0, Zsgn b))
-    | _, Z0 => (Zabs a,(Zsgn a, 0))
-    | Zpos a, Zpos b =>
-       let (g,p) := Pggcd a b in
-       let (aa,bb) := p in
-       (Zpos g, (Zpos aa, Zpos bb))
-    | Zpos a, Zneg b =>
-       let (g,p) := Pggcd a b in
-       let (aa,bb) := p in
-       (Zpos g, (Zpos aa, Zneg bb))
-    | Zneg a, Zpos b =>
-       let (g,p) := Pggcd a b in
-       let (aa,bb) := p in
-       (Zpos g, (Zneg aa, Zpos bb))
-    | Zneg a, Zneg b =>
-       let (g,p) := Pggcd a b in
-       let (aa,bb) := p in
-       (Zpos g, (Zneg aa, Zneg bb))
-  end.
-
-
-Lemma Pggcdn_gcdn : forall n a b,
-  fst (Pggcdn n a b) = Pgcdn n a b.
-Proof.
-  induction n.
-  simpl; auto.
-  destruct a; destruct b; simpl; auto.
-  destruct (Pcompare a b Eq); simpl; auto.
-  rewrite <- IHn; destruct (Pggcdn n (b-a) (xI a)) as (g,(aa,bb)); simpl; auto.
-  rewrite <- IHn; destruct (Pggcdn n (a-b) (xI b)) as (g,(aa,bb)); simpl; auto.
-  rewrite <- IHn; destruct (Pggcdn n (xI a) b) as (g,(aa,bb)); simpl; auto.
-  rewrite <- IHn; destruct (Pggcdn n a (xI b)) as (g,(aa,bb)); simpl; auto.
-  rewrite <- IHn; destruct (Pggcdn n a b) as (g,(aa,bb)); simpl; auto.
-Qed.
-
-Lemma Pggcd_gcd : forall a b, fst (Pggcd a b) = Pgcd a b.
-Proof.
-  intros; exact (Pggcdn_gcdn (Psize a+Psize b)%nat a b).
-Qed.
-
-Lemma Zggcd_gcd : forall a b, fst (Zggcd a b) = Zgcd a b.
-Proof.
-  destruct a; destruct b; simpl; auto; rewrite <- Pggcd_gcd;
-    destruct (Pggcd p p0) as (g,(aa,bb)); simpl; auto.
-Qed.
-
-Open Scope positive_scope.
-
-Lemma Pggcdn_correct_divisors : forall n a b,
-  let (g,p) := Pggcdn n a b in
-  let (aa,bb):=p in
-  (a=g*aa) /\ (b=g*bb).
-Proof.
-  induction n.
-  simpl; auto.
-  destruct a; destruct b; simpl; auto.
-  case_eq (Pcompare a b Eq); intros.
-  (* Eq *)
-  rewrite Pmult_comm; simpl; auto.
-  rewrite (Pcompare_Eq_eq _ _ H); auto.
-  (* Lt *)
-  generalize (IHn (b-a) (xI a)); destruct (Pggcdn n (b-a) (xI a)) as (g,(ba,aa)); simpl.
-  intros (H0,H1); split; auto.
-  rewrite Pmult_plus_distr_l.
-  rewrite Pmult_xO_permute_r.
-  rewrite <- H1; rewrite <- H0.
-  simpl; f_equal; symmetry.
-  apply Pplus_minus; auto.
-  rewrite ZC4; rewrite H; auto.
-  (* Gt *)
-  generalize (IHn (a-b) (xI b)); destruct (Pggcdn n (a-b) (xI b)) as (g,(ab,bb)); simpl.
-  intros (H0,H1); split; auto.
-  rewrite Pmult_plus_distr_l.
-  rewrite Pmult_xO_permute_r.
-  rewrite <- H1; rewrite <- H0.
-  simpl; f_equal; symmetry.
-  apply Pplus_minus; auto.
-  (* Then... *)
-  generalize (IHn (xI a) b); destruct (Pggcdn n (xI a) b) as (g,(ab,bb)); simpl.
-  intros (H0,H1); split; auto.
-  rewrite Pmult_xO_permute_r; rewrite H1; auto.
-  generalize (IHn a (xI b)); destruct (Pggcdn n a (xI b)) as (g,(ab,bb)); simpl.
-  intros (H0,H1); split; auto.
-  rewrite Pmult_xO_permute_r; rewrite H0; auto.
-  generalize (IHn a b); destruct (Pggcdn n a b) as (g,(ab,bb)); simpl.
-  intros (H0,H1); split; subst; auto.
-Qed.
-
-Lemma Pggcd_correct_divisors : forall a b,
-  let (g,p) := Pggcd a b in
-  let (aa,bb):=p in
-  (a=g*aa) /\ (b=g*bb).
-Proof.
-  intros a b; exact (Pggcdn_correct_divisors (Psize a + Psize b)%nat a b).
-Qed.
-
-Close Scope positive_scope.
-
-Lemma Zggcd_correct_divisors : forall a b,
-  let (g,p) := Zggcd a b in
-  let (aa,bb):=p in
-  (a=g*aa) /\ (b=g*bb).
-Proof.
-  destruct a; destruct b; simpl; auto; try solve [rewrite Pmult_comm; simpl; auto];
-    generalize (Pggcd_correct_divisors p p0); destruct (Pggcd p p0) as (g,(aa,bb));
-      destruct 1; subst; auto.
-Qed.
-
-Theorem Zggcd_opp: forall x y,
-  Zggcd (-x) y = let (p1,p) := Zggcd x y in
-                 let (p2,p3) := p in
-                 (p1,(-p2,p3)).
-Proof.
-intros [|x|x] [|y|y]; unfold Zggcd, Zopp; auto.
-case Pggcd; intros p1 (p2, p3); auto.
-case Pggcd; intros p1 (p2, p3); auto.
-case Pggcd; intros p1 (p2, p3); auto.
-case Pggcd; intros p1 (p2, p3); auto.
+  - elim Hp1; constructor; auto.
+    intros n (Hn1,Hn2).
+    Z.le_elim Hn1; auto with zarith.
+    subst n; constructor; auto with zarith.
+  - case H1; intros n (Hn1,Hn2).
+    destruct (Z_0_1_more _ (Z.gcd_nonneg n p)) as [H|[H|H]].
+    + exfalso. apply Z.gcd_eq_0_l in H. omega.
+    + elim Hn2. red. rewrite <- H. apply Zgcd_is_gcd.
+    + exists (Z.gcd n p); split; [ split; auto | apply Z.gcd_divide_r ].
+      apply Z.le_lt_trans with n; auto with zarith.
+      apply Z.divide_pos_le; auto with zarith.
+      apply Z.gcd_divide_l.
 Qed.
diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v
index 91c16929..b1d1f8b5 100644
--- a/theories/ZArith/Zorder.v
+++ b/theories/ZArith/Zorder.v
@@ -1,337 +1,202 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zorder.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
 
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
+(** Binary Integers : results about order predicates *)
+(** Initial author : Pierre Crégut (CNET, Lannion, France) *)
 
-Require Import BinPos.
-Require Import BinInt.
-Require Import Arith_base.
-Require Import Decidable.
-Require Import Zcompare.
+(** THIS FILE IS DEPRECATED.
+    It is now almost entirely made of compatibility formulations
+    for results already present in BinInt.Z. *)
 
-Open Local Scope Z_scope.
+Require Import BinPos BinInt Decidable Zcompare.
+Require Import Arith_base. (* Useless now, for compatibility only *)
 
-Implicit Types x y z : Z.
+Local Open Scope Z_scope.
 
 (*********************************************************)
 (** Properties of the order relations on binary integers *)
 
 (** * Trichotomy *)
 
-Theorem Ztrichotomy_inf : forall n m:Z, {n < m} + {n = m} + {n > m}.
+Theorem Ztrichotomy_inf n m : {n < m} + {n = m} + {n > m}.
 Proof.
-  unfold Zgt, Zlt in |- *; intros m n; assert (H := refl_equal (m ?= n)).
-  set (x := m ?= n) in H at 2 |- *.
-  destruct x;
-    [ left; right; rewrite Zcompare_Eq_eq with (1 := H) | left; left | right ];
-    reflexivity.
-Qed.
+  unfold ">", "<". generalize (Z.compare_eq n m).
+  destruct (n ?= m); [ left; right | left; left | right]; auto.
+Defined.
 
-Theorem Ztrichotomy : forall n m:Z, n < m \/ n = m \/ n > m.
+Theorem Ztrichotomy n m : n < m \/ n = m \/ n > m.
 Proof.
-  intros m n; destruct (Ztrichotomy_inf m n) as [[Hlt| Heq]| Hgt];
-    [ left | right; left | right; right ]; assumption.
+  Z.swap_greater. apply Z.lt_trichotomy.
 Qed.
 
 (**********************************************************************)
 (** * Decidability of equality and order on Z *)
 
-Theorem dec_eq : forall n m:Z, decidable (n = m).
-Proof.
-  intros x y; unfold decidable in |- *; elim (Zcompare_Eq_iff_eq x y);
-    intros H1 H2; elim (Dcompare (x ?= y));
-      [ tauto
-	| intros H3; right; unfold not in |- *; intros H4; elim H3; rewrite (H2 H4);
-	  intros H5; discriminate H5 ].
-Qed.
-
-Theorem dec_Zne : forall n m:Z, decidable (Zne n m).
-Proof.
-  intros x y; unfold decidable, Zne in |- *; elim (Zcompare_Eq_iff_eq x y).
-  intros H1 H2; elim (Dcompare (x ?= y));
-    [ right; rewrite H1; auto
-      | left; unfold not in |- *; intro; absurd ((x ?= y) = Eq);
-	[ elim H; intros HR; rewrite HR; discriminate | auto ] ].
-Qed.
+Notation dec_eq := Z.eq_decidable (compat "8.3").
+Notation dec_Zle := Z.le_decidable (compat "8.3").
+Notation dec_Zlt := Z.lt_decidable (compat "8.3").
 
-Theorem dec_Zle : forall n m:Z, decidable (n <= m).
+Theorem dec_Zne n m : decidable (Zne n m).
 Proof.
-  intros x y; unfold decidable, Zle in |- *; elim (x ?= y);
-    [ left; discriminate
-      | left; discriminate
-      | right; unfold not in |- *; intros H; apply H; trivial with arith ].
+  destruct (Z.eq_decidable n m); [right|left]; subst; auto.
 Qed.
 
-Theorem dec_Zgt : forall n m:Z, decidable (n > m).
+Theorem dec_Zgt n m : decidable (n > m).
 Proof.
-  intros x y; unfold decidable, Zgt in |- *; elim (x ?= y);
-    [ right; discriminate | right; discriminate | auto with arith ].
+  destruct (Z.lt_decidable m n); [left|right]; Z.swap_greater; auto.
 Qed.
 
-Theorem dec_Zge : forall n m:Z, decidable (n >= m).
+Theorem dec_Zge n m : decidable (n >= m).
 Proof.
-  intros x y; unfold decidable, Zge in |- *; elim (x ?= y);
-    [ left; discriminate
-      | right; unfold not in |- *; intros H; apply H; trivial with arith
-      | left; discriminate ].
+  destruct (Z.le_decidable m n); [left|right]; Z.swap_greater; auto.
 Qed.
 
-Theorem dec_Zlt : forall n m:Z, decidable (n < m).
+Theorem not_Zeq n m : n <> m -> n < m \/ m < n.
 Proof.
-  intros x y; unfold decidable, Zlt in |- *; elim (x ?= y);
-    [ right; discriminate | auto with arith | right; discriminate ].
-Qed.
-
-Theorem not_Zeq : forall n m:Z, n <> m -> n < m \/ m < n.
-Proof.
-  intros x y; elim (Dcompare (x ?= y));
-    [ intros H1 H2; absurd (x = y);
-      [ assumption | elim (Zcompare_Eq_iff_eq x y); auto with arith ]
-      | unfold Zlt in |- *; intros H; elim H; intros H1;
-	[ auto with arith
-	  | right; elim (Zcompare_Gt_Lt_antisym x y); auto with arith ] ].
+  apply Z.lt_gt_cases.
 Qed.
 
 (** * Relating strict and large orders *)
 
-Lemma Zgt_lt : forall n m:Z, n > m -> m < n.
-Proof.
-  unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym m n);
-    auto with arith.
-Qed.
+Notation Zgt_lt := Z.gt_lt (compat "8.3").
+Notation Zlt_gt := Z.lt_gt (compat "8.3").
+Notation Zge_le := Z.ge_le (compat "8.3").
+Notation Zle_ge := Z.le_ge (compat "8.3").
+Notation Zgt_iff_lt := Z.gt_lt_iff (compat "8.3").
+Notation Zge_iff_le := Z.ge_le_iff (compat "8.3").
 
-Lemma Zlt_gt : forall n m:Z, n < m -> m > n.
+Lemma Zle_not_lt n m : n <= m -> ~ m < n.
 Proof.
-  unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym n m);
-    auto with arith.
+ apply Z.le_ngt.
 Qed.
 
-Lemma Zge_le : forall n m:Z, n >= m -> m <= n.
+Lemma Zlt_not_le n m : n < m -> ~ m <= n.
 Proof.
-  intros m n; change (~ m < n -> ~ n > m) in |- *; unfold not in |- *;
-    intros H1 H2; apply H1; apply Zgt_lt; assumption.
+ apply Z.lt_nge.
 Qed.
 
-Lemma Zle_ge : forall n m:Z, n <= m -> m >= n.
-Proof.
-  intros m n; change (~ m > n -> ~ n < m) in |- *; unfold not in |- *;
-    intros H1 H2; apply H1; apply Zlt_gt; assumption.
-Qed.
-
-Lemma Zle_not_gt : forall n m:Z, n <= m -> ~ n > m.
+Lemma Zle_not_gt n m : n <= m -> ~ n > m.
 Proof.
   trivial.
 Qed.
 
-Lemma Zgt_not_le : forall n m:Z, n > m -> ~ n <= m.
-Proof.
-  intros n m H1 H2; apply H2; assumption.
-Qed.
-
-Lemma Zle_not_lt : forall n m:Z, n <= m -> ~ m < n.
-Proof.
-  intros n m H1 H2.
-  assert (H3 := Zlt_gt _ _ H2).
-  apply Zle_not_gt with n m; assumption.
-Qed.
-
-Lemma Zlt_not_le : forall n m:Z, n < m -> ~ m <= n.
-Proof.
-  intros n m H1 H2.
-  apply Zle_not_lt with m n; assumption.
-Qed.
-
-Lemma Znot_ge_lt : forall n m:Z, ~ n >= m -> n < m.
+Lemma Zgt_not_le n m : n > m -> ~ n <= m.
 Proof.
-  unfold Zge, Zlt in |- *; intros x y H; apply dec_not_not;
-    [ exact (dec_Zlt x y) | assumption ].
+  Z.swap_greater. apply Z.lt_nge.
 Qed.
 
-Lemma Znot_lt_ge : forall n m:Z, ~ n < m -> n >= m.
+Lemma Znot_ge_lt n m : ~ n >= m -> n < m.
 Proof.
-  unfold Zlt, Zge in |- *; auto with arith.
+  Z.swap_greater. apply Z.nle_gt.
 Qed.
 
-Lemma Znot_gt_le : forall n m:Z, ~ n > m -> n <= m.
+Lemma Znot_lt_ge n m : ~ n < m -> n >= m.
 Proof.
   trivial.
 Qed.
 
-Lemma Znot_le_gt : forall n m:Z, ~ n <= m -> n > m.
+Lemma Znot_gt_le n m: ~ n > m -> n <= m.
 Proof.
-  unfold Zle, Zgt in |- *; intros x y H; apply dec_not_not;
-    [ exact (dec_Zgt x y) | assumption ].
+  trivial.
 Qed.
 
-Lemma Zge_iff_le : forall n m:Z, n >= m <-> m <= n.
+Lemma Znot_le_gt n m : ~ n <= m -> n > m.
 Proof.
-  intros x y; intros. split. intro. apply Zge_le. assumption.
-  intro. apply Zle_ge. assumption.
+  Z.swap_greater. apply Z.nle_gt.
 Qed.
 
-Lemma Zgt_iff_lt : forall n m:Z, n > m <-> m < n.
+Lemma not_Zne n m : ~ Zne n m -> n = m.
 Proof.
-  intros x y. split. intro. apply Zgt_lt. assumption.
-  intro. apply Zlt_gt. assumption.
+  intros H.
+  destruct (Z.eq_decidable n m); [assumption|now elim H].
 Qed.
 
 (** * Equivalence and order properties *)
 
 (** Reflexivity *)
 
-Lemma Zle_refl : forall n:Z, n <= n.
-Proof.
-  intros n; unfold Zle in |- *; rewrite (Zcompare_refl n); discriminate.
-Qed.
-
-Lemma Zeq_le : forall n m:Z, n = m -> n <= m.
-Proof.
-  intros; rewrite H; apply Zle_refl.
-Qed.
+Notation Zle_refl := Z.le_refl (compat "8.3").
+Notation Zeq_le := Z.eq_le_incl (compat "8.3").
 
-Hint Resolve Zle_refl: zarith.
+Hint Resolve Z.le_refl: zarith.
 
 (** Antisymmetry *)
 
-Lemma Zle_antisym : forall n m:Z, n <= m -> m <= n -> n = m.
-Proof.
-  intros n m H1 H2; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]].
-  absurd (m > n); [ apply Zle_not_gt | apply Zlt_gt ]; assumption.
-  assumption.
-  absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption.
-Qed.
+Notation Zle_antisym := Z.le_antisymm (compat "8.3").
 
 (** Asymmetry *)
 
-Lemma Zgt_asym : forall n m:Z, n > m -> ~ m > n.
-Proof.
-  unfold Zgt in |- *; intros n m H; elim (Zcompare_Gt_Lt_antisym n m);
-    intros H1 H2; rewrite H1; [ discriminate | assumption ].
-Qed.
+Notation Zlt_asym := Z.lt_asymm (compat "8.3").
 
-Lemma Zlt_asym : forall n m:Z, n < m -> ~ m < n.
+Lemma Zgt_asym n m : n > m -> ~ m > n.
 Proof.
-  intros n m H H1; assert (H2 : m > n). apply Zlt_gt; assumption.
-  assert (H3 : n > m). apply Zlt_gt; assumption.
-  apply Zgt_asym with m n; assumption.
+  Z.swap_greater. apply Z.lt_asymm.
 Qed.
 
 (** Irreflexivity *)
 
-Lemma Zgt_irrefl : forall n:Z, ~ n > n.
-Proof.
-  intros n H; apply (Zgt_asym n n H H).
-Qed.
+Notation Zlt_irrefl := Z.lt_irrefl (compat "8.3").
+Notation Zlt_not_eq := Z.lt_neq (compat "8.3").
 
-Lemma Zlt_irrefl : forall n:Z, ~ n < n.
+Lemma Zgt_irrefl n : ~ n > n.
 Proof.
-  intros n H; apply (Zlt_asym n n H H).
-Qed.
-
-Lemma Zlt_not_eq : forall n m:Z, n < m -> n <> m.
-Proof.
-  unfold not in |- *; intros x y H H0.
-  rewrite H0 in H.
-  apply (Zlt_irrefl _ H).
+  Z.swap_greater. apply Z.lt_irrefl.
 Qed.
 
 (** Large = strict or equal *)
 
-Lemma Zlt_le_weak : forall n m:Z, n < m -> n <= m.
-Proof.
-  intros n m Hlt; apply Znot_gt_le; apply Zgt_asym; apply Zlt_gt; assumption.
-Qed.
+Notation Zlt_le_weak := Z.lt_le_incl (compat "8.3").
+Notation Zle_lt_or_eq_iff := Z.lt_eq_cases (compat "8.3").
 
-Lemma Zle_lt_or_eq : forall n m:Z, n <= m -> n < m \/ n = m.
+Lemma Zle_lt_or_eq n m : n <= m -> n < m \/ n = m.
 Proof.
-  intros n m H; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]];
-    [ left; assumption
-      | right; assumption
-      | absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption ].
-Qed.
-
-Lemma Zle_lt_or_eq_iff : forall n m, n <= m <-> n < m \/ n = m.
-Proof.
-  unfold Zle, Zlt. intros.
-  generalize (Zcompare_Eq_iff_eq n m).
-  destruct (n ?= m); intuition; discriminate.
+  apply Z.lt_eq_cases.
 Qed.
 
 (** Dichotomy *)
 
-Lemma Zle_or_lt : forall n m:Z, n <= m \/ m < n.
-Proof.
-  intros n m; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]];
-    [ left; apply Znot_gt_le; intro Hgt; assert (Hgt' := Zlt_gt _ _ Hlt);
-      apply Zgt_asym with m n; assumption
-      | left; rewrite Heq; apply Zle_refl
-      | right; apply Zgt_lt; assumption ].
-Qed.
+Notation Zle_or_lt := Z.le_gt_cases (compat "8.3").
 
 (** Transitivity of strict orders *)
 
-Lemma Zgt_trans : forall n m p:Z, n > m -> m > p -> n > p.
-Proof.
-  exact Zcompare_Gt_trans.
-Qed.
+Notation Zlt_trans := Z.lt_trans (compat "8.3").
 
-Lemma Zlt_trans : forall n m p:Z, n < m -> m < p -> n < p.
+Lemma Zgt_trans n m p : n > m -> m > p -> n > p.
 Proof.
-  exact Zcompare_Lt_trans.
+  Z.swap_greater. intros; now transitivity m.
 Qed.
 
 (** Mixed transitivity *)
 
-Lemma Zle_gt_trans : forall n m p:Z, m <= n -> m > p -> n > p.
-Proof.
-  intros n m p H1 H2; destruct (Zle_lt_or_eq m n H1) as [Hlt| Heq];
-    [ apply Zgt_trans with m; [ apply Zlt_gt; assumption | assumption ]
-      | rewrite <- Heq; assumption ].
-Qed.
+Notation Zlt_le_trans := Z.lt_le_trans (compat "8.3").
+Notation Zle_lt_trans := Z.le_lt_trans (compat "8.3").
 
-Lemma Zgt_le_trans : forall n m p:Z, n > m -> p <= m -> n > p.
+Lemma Zle_gt_trans n m p : m <= n -> m > p -> n > p.
 Proof.
-  intros n m p H1 H2; destruct (Zle_lt_or_eq p m H2) as [Hlt| Heq];
-    [ apply Zgt_trans with m; [ assumption | apply Zlt_gt; assumption ]
-      | rewrite Heq; assumption ].
-Qed.
-
-Lemma Zlt_le_trans : forall n m p:Z, n < m -> m <= p -> n < p.
-  intros n m p H1 H2; apply Zgt_lt; apply Zle_gt_trans with (m := m);
-    [ assumption | apply Zlt_gt; assumption ].
+  Z.swap_greater. Z.order.
 Qed.
 
-Lemma Zle_lt_trans : forall n m p:Z, n <= m -> m < p -> n < p.
+Lemma Zgt_le_trans n m p : n > m -> p <= m -> n > p.
 Proof.
-  intros n m p H1 H2; apply Zgt_lt; apply Zgt_le_trans with (m := m);
-    [ apply Zlt_gt; assumption | assumption ].
+  Z.swap_greater. Z.order.
 Qed.
 
 (** Transitivity of large orders *)
 
-Lemma Zle_trans : forall n m p:Z, n <= m -> m <= p -> n <= p.
-Proof.
-  intros n m p H1 H2; apply Znot_gt_le.
-  intro Hgt; apply Zle_not_gt with n m. assumption.
-  exact (Zgt_le_trans n p m Hgt H2).
-Qed.
+Notation Zle_trans := Z.le_trans (compat "8.3").
 
-Lemma Zge_trans : forall n m p:Z, n >= m -> m >= p -> n >= p.
+Lemma Zge_trans n m p : n >= m -> m >= p -> n >= p.
 Proof.
-  intros n m p H1 H2.
-  apply Zle_ge.
-  apply Zle_trans with m; apply Zge_le; trivial.
+  Z.swap_greater. Z.order.
 Qed.
 
-Hint Resolve Zle_trans: zarith.
-
+Hint Resolve Z.le_trans: zarith.
 
 (** * Compatibility of order and operations on Z *)
 
@@ -339,700 +204,448 @@ Hint Resolve Zle_trans: zarith.
 
 (** Compatibility of successor wrt to order *)
 
-Lemma Zsucc_le_compat : forall n m:Z, m <= n -> Zsucc m <= Zsucc n.
+Lemma Zsucc_le_compat n m : m <= n -> Z.succ m <= Z.succ n.
 Proof.
-  unfold Zle, not in |- *; intros m n H1 H2; apply H1;
-    rewrite <- (Zcompare_plus_compat n m 1); do 2 rewrite (Zplus_comm 1);
-      exact H2.
+  apply Z.succ_le_mono.
 Qed.
 
-Lemma Zsucc_gt_compat : forall n m:Z, m > n -> Zsucc m > Zsucc n.
+Lemma Zsucc_lt_compat n m : n < m -> Z.succ n < Z.succ m.
 Proof.
-  unfold Zgt in |- *; intros n m H; rewrite Zcompare_succ_compat;
-    auto with arith.
+  apply Z.succ_lt_mono.
 Qed.
 
-Lemma Zsucc_lt_compat : forall n m:Z, n < m -> Zsucc n < Zsucc m.
+Lemma Zsucc_gt_compat n m : m > n -> Z.succ m > Z.succ n.
 Proof.
-  intros n m H; apply Zgt_lt; apply Zsucc_gt_compat; apply Zlt_gt; assumption.
+  Z.swap_greater. apply Z.succ_lt_mono.
 Qed.
 
 Hint Resolve Zsucc_le_compat: zarith.
 
 (** Simplification of successor wrt to order *)
 
-Lemma Zsucc_gt_reg : forall n m:Z, Zsucc m > Zsucc n -> m > n.
+Lemma Zsucc_gt_reg n m : Z.succ m > Z.succ n -> m > n.
 Proof.
-  unfold Zsucc, Zgt in |- *; intros n p;
-    do 2 rewrite (fun m:Z => Zplus_comm m 1);
-      rewrite (Zcompare_plus_compat p n 1); trivial with arith.
+  Z.swap_greater. apply Z.succ_lt_mono.
 Qed.
 
-Lemma Zsucc_le_reg : forall n m:Z, Zsucc m <= Zsucc n -> m <= n.
+Lemma Zsucc_le_reg n m : Z.succ m <= Z.succ n -> m <= n.
 Proof.
-  unfold Zle, not in |- *; intros m n H1 H2; apply H1; unfold Zsucc in |- *;
-    do 2 rewrite <- (Zplus_comm 1); rewrite (Zcompare_plus_compat n m 1);
-      assumption.
+  apply Z.succ_le_mono.
 Qed.
 
-Lemma Zsucc_lt_reg : forall n m:Z, Zsucc n < Zsucc m -> n < m.
+Lemma Zsucc_lt_reg n m : Z.succ n < Z.succ m -> n < m.
 Proof.
-  intros n m H; apply Zgt_lt; apply Zsucc_gt_reg; apply Zlt_gt; assumption.
+  apply Z.succ_lt_mono.
 Qed.
 
 (** Special base instances of order *)
 
-Lemma Zgt_succ : forall n:Z, Zsucc n > n.
-Proof.
-  exact Zcompare_succ_Gt.
-Qed.
-
-Lemma Znot_le_succ : forall n:Z, ~ Zsucc n <= n.
-Proof.
-  intros n; apply Zgt_not_le; apply Zgt_succ.
-Qed.
+Notation Zlt_succ := Z.lt_succ_diag_r (compat "8.3").
+Notation Zlt_pred := Z.lt_pred_l (compat "8.3").
 
-Lemma Zlt_succ : forall n:Z, n < Zsucc n.
+Lemma Zgt_succ n : Z.succ n > n.
 Proof.
-  intro n; apply Zgt_lt; apply Zgt_succ.
+  Z.swap_greater. apply Z.lt_succ_diag_r.
 Qed.
 
-Lemma Zlt_pred : forall n:Z, Zpred n < n.
+Lemma Znot_le_succ n : ~ Z.succ n <= n.
 Proof.
-  intros n; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; apply Zlt_succ.
+  apply Z.lt_nge, Z.lt_succ_diag_r.
 Qed.
 
 (** Relating strict and large order using successor or predecessor *)
 
-Lemma Zgt_le_succ : forall n m:Z, m > n -> Zsucc n <= m.
-Proof.
-  unfold Zgt, Zle in |- *; intros n p H; elim (Zcompare_Gt_not_Lt p n);
-    intros H1 H2; unfold not in |- *; intros H3; unfold not in H1;
-      apply H1;
-	[ assumption
-	  | elim (Zcompare_Gt_Lt_antisym (n + 1) p); intros H4 H5; apply H4; exact H3 ].
-Qed.
+Notation Zlt_succ_r := Z.lt_succ_r (compat "8.3").
+Notation Zle_succ_l := Z.le_succ_l (compat "8.3").
 
-Lemma Zle_gt_succ : forall n m:Z, n <= m -> Zsucc m > n.
+Lemma Zgt_le_succ n m : m > n -> Z.succ n <= m.
 Proof.
-  intros n p H; apply Zgt_le_trans with p.
-  apply Zgt_succ.
-  assumption.
+  Z.swap_greater. apply Z.le_succ_l.
 Qed.
 
-Lemma Zle_lt_succ : forall n m:Z, n <= m -> n < Zsucc m.
+Lemma Zle_gt_succ n m : n <= m -> Z.succ m > n.
 Proof.
-  intros n m H; apply Zgt_lt; apply Zle_gt_succ; assumption.
+  Z.swap_greater. apply Z.lt_succ_r.
 Qed.
 
-Lemma Zlt_le_succ : forall n m:Z, n < m -> Zsucc n <= m.
+Lemma Zle_lt_succ n m : n <= m -> n < Z.succ m.
 Proof.
-  intros n p H; apply Zgt_le_succ; apply Zlt_gt; assumption.
+  apply Z.lt_succ_r.
 Qed.
 
-Lemma Zgt_succ_le : forall n m:Z, Zsucc m > n -> n <= m.
+Lemma Zlt_le_succ n m : n < m -> Z.succ n <= m.
 Proof.
-  intros n p H; apply Zsucc_le_reg; apply Zgt_le_succ; assumption.
+  apply Z.le_succ_l.
 Qed.
 
-Lemma Zlt_succ_le : forall n m:Z, n < Zsucc m -> n <= m.
+Lemma Zgt_succ_le n m : Z.succ m > n -> n <= m.
 Proof.
-  intros n m H; apply Zgt_succ_le; apply Zlt_gt; assumption.
+  Z.swap_greater. apply Z.lt_succ_r.
 Qed.
 
-Lemma Zle_succ_gt : forall n m:Z, Zsucc n <= m -> m > n.
+Lemma Zlt_succ_le n m : n < Z.succ m -> n <= m.
 Proof.
-  intros n m H; apply Zle_gt_trans with (m := Zsucc n);
-    [ assumption | apply Zgt_succ ].
+  apply Z.lt_succ_r.
 Qed.
 
-Lemma Zlt_succ_r : forall n m, n < Zsucc m <-> n <= m.
+Lemma Zle_succ_gt n m : Z.succ n <= m -> m > n.
 Proof.
-  split; [apply Zlt_succ_le | apply Zle_lt_succ].
+  Z.swap_greater. apply Z.le_succ_l.
 Qed.
 
 (** Weakening order *)
 
-Lemma Zle_succ : forall n:Z, n <= Zsucc n.
-Proof.
-  intros n; apply Zgt_succ_le; apply Zgt_trans with (m := Zsucc n);
-    apply Zgt_succ.
-Qed.
-
-Hint Resolve Zle_succ: zarith.
+Notation Zle_succ := Z.le_succ_diag_r (compat "8.3").
+Notation Zle_pred := Z.le_pred_l (compat "8.3").
+Notation Zlt_lt_succ := Z.lt_lt_succ_r (compat "8.3").
+Notation Zle_le_succ := Z.le_le_succ_r (compat "8.3").
 
-Lemma Zle_pred : forall n:Z, Zpred n <= n.
+Lemma Zle_succ_le n m : Z.succ n <= m -> n <= m.
 Proof.
-  intros n; pattern n at 2 in |- *; rewrite Zsucc_pred; apply Zle_succ.
+  intros. now apply Z.lt_le_incl, Z.le_succ_l.
 Qed.
 
-Lemma Zlt_lt_succ : forall n m:Z, n < m -> n < Zsucc m.
-  intros n m H; apply Zgt_lt; apply Zgt_trans with (m := m);
-    [ apply Zgt_succ | apply Zlt_gt; assumption ].
-Qed.
-
-Lemma Zle_le_succ : forall n m:Z, n <= m -> n <= Zsucc m.
-Proof.
-  intros x y H.
-  apply Zle_trans with y; trivial with zarith.
-Qed.
-
-Lemma Zle_succ_le : forall n m:Z, Zsucc n <= m -> n <= m.
-Proof.
-  intros n m H; apply Zle_trans with (m := Zsucc n);
-    [ apply Zle_succ | assumption ].
-Qed.
-
-Hint Resolve Zle_le_succ: zarith.
+Hint Resolve Z.le_succ_diag_r: zarith.
+Hint Resolve Z.le_le_succ_r: zarith.
 
 (** Relating order wrt successor and order wrt predecessor *)
 
-Lemma Zgt_succ_pred : forall n m:Z, m > Zsucc n -> Zpred m > n.
+Lemma Zgt_succ_pred n m : m > Z.succ n -> Z.pred m > n.
 Proof.
-  unfold Zgt, Zsucc, Zpred in |- *; intros n p H;
-    rewrite <- (fun x y => Zcompare_plus_compat x y 1);
-      rewrite (Zplus_comm p); rewrite Zplus_assoc;
-	rewrite (fun x => Zplus_comm x n); simpl in |- *;
-	  assumption.
+  Z.swap_greater. apply Z.lt_succ_lt_pred.
 Qed.
 
-Lemma Zlt_succ_pred : forall n m:Z, Zsucc n < m -> n < Zpred m.
+Lemma Zlt_succ_pred n m : Z.succ n < m -> n < Z.pred m.
 Proof.
-  intros n p H; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; assumption.
+  apply Z.lt_succ_lt_pred.
 Qed.
 
 (** Relating strict order and large order on positive *)
 
-Lemma Zlt_0_le_0_pred : forall n:Z, 0 < n -> 0 <= Zpred n.
+Lemma Zlt_0_le_0_pred n : 0 < n -> 0 <= Z.pred n.
 Proof.
-  intros x H.
-  rewrite (Zsucc_pred x) in H.
-  apply Zgt_succ_le.
-  apply Zlt_gt.
-  assumption.
+  apply Z.lt_le_pred.
 Qed.
 
-Lemma Zgt_0_le_0_pred : forall n:Z, n > 0 -> 0 <= Zpred n.
+Lemma Zgt_0_le_0_pred n : n > 0 -> 0 <= Z.pred n.
 Proof.
-  intros; apply Zlt_0_le_0_pred; apply Zgt_lt. assumption.
+  Z.swap_greater. apply Z.lt_le_pred.
 Qed.
 
-
 (** Special cases of ordered integers *)
 
-Lemma Zlt_0_1 : 0 < 1.
-Proof.
-  change (0 < Zsucc 0) in |- *. apply Zlt_succ.
-Qed.
-
-Lemma Zle_0_1 : 0 <= 1.
-Proof.
-  change (0 <= Zsucc 0) in |- *. apply Zle_succ.
-Qed.
+Notation Zlt_0_1 := Z.lt_0_1 (compat "8.3").
+Notation Zle_0_1 := Z.le_0_1 (compat "8.3").
 
 Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q.
 Proof.
-  intros p; red in |- *; simpl in |- *; red in |- *; intros H; discriminate.
+  easy.
 Qed.
 
 Lemma Zgt_pos_0 : forall p:positive, Zpos p > 0.
 Proof.
-  unfold Zgt in |- *; trivial.
+  easy.
 Qed.
 
-(* weaker but useful (in [Zpower] for instance) *)
+(* weaker but useful (in [Z.pow] for instance) *)
 Lemma Zle_0_pos : forall p:positive, 0 <= Zpos p.
 Proof.
-  intro; unfold Zle in |- *; discriminate.
+ easy.
 Qed.
 
 Lemma Zlt_neg_0 : forall p:positive, Zneg p < 0.
 Proof.
-  unfold Zlt in |- *; trivial.
+ easy.
 Qed.
 
-Lemma Zle_0_nat : forall n:nat, 0 <= Z_of_nat n.
+Lemma Zle_0_nat : forall n:nat, 0 <= Z.of_nat n.
 Proof.
-  simple induction n; simpl in |- *; intros;
-    [ apply Zle_refl | unfold Zle in |- *; simpl in |- *; discriminate ].
+  induction n; simpl; intros. apply Z.le_refl. easy.
 Qed.
 
-Hint Immediate Zeq_le: zarith.
-
-(** Transitivity using successor *)
-
-Lemma Zgt_trans_succ : forall n m p:Z, Zsucc n > m -> m > p -> n > p.
-Proof.
-  intros n m p H1 H2; apply Zle_gt_trans with (m := m);
-    [ apply Zgt_succ_le; assumption | assumption ].
-Qed.
+Hint Immediate Z.eq_le_incl: zarith.
 
 (** Derived lemma *)
 
-Lemma Zgt_succ_gt_or_eq : forall n m:Z, Zsucc n > m -> n > m \/ m = n.
+Lemma Zgt_succ_gt_or_eq n m : Z.succ n > m -> n > m \/ m = n.
 Proof.
-  intros n m H.
-  assert (Hle : m <= n).
-  apply Zgt_succ_le; assumption.
-  destruct (Zle_lt_or_eq _ _ Hle) as [Hlt| Heq].
-  left; apply Zlt_gt; assumption.
-  right; assumption.
+  Z.swap_greater. intros. now apply Z.lt_eq_cases, Z.lt_succ_r.
 Qed.
 
 (** ** Addition *)
 (** Compatibility of addition wrt to order *)
 
-Lemma Zplus_gt_compat_l : forall n m p:Z, n > m -> p + n > p + m.
-Proof.
-  unfold Zgt in |- *; intros n m p H; rewrite (Zcompare_plus_compat n m p);
-    assumption.
-Qed.
-
-Lemma Zplus_gt_compat_r : forall n m p:Z, n > m -> n + p > m + p.
-Proof.
-  intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p);
-    apply Zplus_gt_compat_l; trivial.
-Qed.
-
-Lemma Zplus_le_compat_l : forall n m p:Z, n <= m -> p + n <= p + m.
-Proof.
-  intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1;
-    rewrite <- (Zcompare_plus_compat n m p); assumption.
-Qed.
+Notation Zplus_lt_le_compat := Z.add_lt_le_mono (compat "8.3").
+Notation Zplus_le_lt_compat := Z.add_le_lt_mono (compat "8.3").
+Notation Zplus_le_compat := Z.add_le_mono (compat "8.3").
+Notation Zplus_lt_compat := Z.add_lt_mono (compat "8.3").
 
-Lemma Zplus_le_compat_r : forall n m p:Z, n <= m -> n + p <= m + p.
+Lemma Zplus_gt_compat_l n m p : n > m -> p + n > p + m.
 Proof.
-  intros a b c; do 2 rewrite (fun n:Z => Zplus_comm n c);
-    exact (Zplus_le_compat_l a b c).
+  Z.swap_greater. apply Z.add_lt_mono_l.
 Qed.
 
-Lemma Zplus_lt_compat_l : forall n m p:Z, n < m -> p + n < p + m.
+Lemma Zplus_gt_compat_r n m p : n > m -> n + p > m + p.
 Proof.
-  unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat;
-    trivial with arith.
+  Z.swap_greater. apply Z.add_lt_mono_r.
 Qed.
 
-Lemma Zplus_lt_compat_r : forall n m p:Z, n < m -> n + p < m + p.
+Lemma Zplus_le_compat_l n m p : n <= m -> p + n <= p + m.
 Proof.
-  intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p);
-    apply Zplus_lt_compat_l; trivial.
+  apply Z.add_le_mono_l.
 Qed.
 
-Lemma Zplus_lt_le_compat : forall n m p q:Z, n < m -> p <= q -> n + p < m + q.
+Lemma Zplus_le_compat_r n m p : n <= m -> n + p <= m + p.
 Proof.
-  intros a b c d H0 H1.
-  apply Zlt_le_trans with (b + c).
-  apply Zplus_lt_compat_r; trivial.
-  apply Zplus_le_compat_l; trivial.
+  apply Z.add_le_mono_r.
 Qed.
 
-Lemma Zplus_le_lt_compat : forall n m p q:Z, n <= m -> p < q -> n + p < m + q.
+Lemma Zplus_lt_compat_l n m p : n < m -> p + n < p + m.
 Proof.
-  intros a b c d H0 H1.
-  apply Zle_lt_trans with (b + c).
-  apply Zplus_le_compat_r; trivial.
-  apply Zplus_lt_compat_l; trivial.
+  apply Z.add_lt_mono_l.
 Qed.
 
-Lemma Zplus_le_compat : forall n m p q:Z, n <= m -> p <= q -> n + p <= m + q.
+Lemma Zplus_lt_compat_r n m p : n < m -> n + p < m + p.
 Proof.
-  intros n m p q; intros H1 H2; apply Zle_trans with (m := n + q);
-    [ apply Zplus_le_compat_l; assumption
-      | apply Zplus_le_compat_r; assumption ].
-Qed.
-
-
-Lemma Zplus_lt_compat : forall n m p q:Z, n < m -> p < q -> n + p < m + q.
-  intros; apply Zplus_le_lt_compat. apply Zlt_le_weak; assumption. assumption.
+  apply Z.add_lt_mono_r.
 Qed.
 
-
 (** Compatibility of addition wrt to being positive *)
 
-Lemma Zplus_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n + m.
-Proof.
-  intros x y H1 H2; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat; assumption.
-Qed.
+Notation Zplus_le_0_compat := Z.add_nonneg_nonneg (compat "8.3").
 
 (** Simplification of addition wrt to order *)
 
-Lemma Zplus_gt_reg_l : forall n m p:Z, p + n > p + m -> n > m.
+Lemma Zplus_le_reg_l n m p : p + n <= p + m -> n <= m.
 Proof.
-  unfold Zgt in |- *; intros n m p H; rewrite <- (Zcompare_plus_compat n m p);
-    assumption.
+ apply Z.add_le_mono_l.
 Qed.
 
-Lemma Zplus_gt_reg_r : forall n m p:Z, n + p > m + p -> n > m.
+Lemma Zplus_le_reg_r n m p : n + p <= m + p -> n <= m.
 Proof.
-  intros n m p H; apply Zplus_gt_reg_l with p.
-  rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
+ apply Z.add_le_mono_r.
 Qed.
 
-Lemma Zplus_le_reg_l : forall n m p:Z, p + n <= p + m -> n <= m.
+Lemma Zplus_lt_reg_l n m p : p + n < p + m -> n < m.
 Proof.
-  intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1;
-    rewrite (Zcompare_plus_compat n m p); assumption.
+ apply Z.add_lt_mono_l.
 Qed.
 
-Lemma Zplus_le_reg_r : forall n m p:Z, n + p <= m + p -> n <= m.
+Lemma Zplus_lt_reg_r n m p : n + p < m + p -> n < m.
 Proof.
-  intros n m p H; apply Zplus_le_reg_l with p.
-  rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
+ apply Z.add_lt_mono_r.
 Qed.
 
-Lemma Zplus_lt_reg_l : forall n m p:Z, p + n < p + m -> n < m.
+Lemma Zplus_gt_reg_l n m p : p + n > p + m -> n > m.
 Proof.
-  unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat;
-    trivial with arith.
+ Z.swap_greater. apply Z.add_lt_mono_l.
 Qed.
 
-Lemma Zplus_lt_reg_r : forall n m p:Z, n + p < m + p -> n < m.
+Lemma Zplus_gt_reg_r n m p : n + p > m + p -> n > m.
 Proof.
-  intros n m p H; apply Zplus_lt_reg_l with p.
-  rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
+ Z.swap_greater. apply Z.add_lt_mono_r.
 Qed.
 
 (** ** Multiplication *)
 (** Compatibility of multiplication by a positive wrt to order *)
 
-Lemma Zmult_le_compat_r : forall n m p:Z, n <= m -> 0 <= p -> n * p <= m * p.
+Lemma Zmult_le_compat_r n m p : n <= m -> 0 <= p -> n * p <= m * p.
 Proof.
-  intros a b c H H0; destruct c.
-  do 2 rewrite Zmult_0_r; assumption.
-  rewrite (Zmult_comm a); rewrite (Zmult_comm b).
-  unfold Zle in |- *; rewrite Zcompare_mult_compat; assumption.
-  unfold Zle in H0; contradiction H0; reflexivity.
+ intros. now apply Z.mul_le_mono_nonneg_r.
 Qed.
 
-Lemma Zmult_le_compat_l : forall n m p:Z, n <= m -> 0 <= p -> p * n <= p * m.
+Lemma Zmult_le_compat_l n m p : n <= m -> 0 <= p -> p * n <= p * m.
 Proof.
-  intros a b c H1 H2; rewrite (Zmult_comm c a); rewrite (Zmult_comm c b).
-  apply Zmult_le_compat_r; trivial.
+ intros. now apply Z.mul_le_mono_nonneg_l.
 Qed.
 
-Lemma Zmult_lt_compat_r : forall n m p:Z, 0 < p -> n < m -> n * p < m * p.
+Lemma Zmult_lt_compat_r n m p : 0 < p -> n < m -> n * p < m * p.
 Proof.
-  intros x y z H H0; destruct z.
-  contradiction (Zlt_irrefl 0).
-  rewrite (Zmult_comm x); rewrite (Zmult_comm y).
-  unfold Zlt in |- *; rewrite Zcompare_mult_compat; assumption.
-  discriminate H.
+ apply Z.mul_lt_mono_pos_r.
 Qed.
 
-Lemma Zmult_gt_compat_r : forall n m p:Z, p > 0 -> n > m -> n * p > m * p.
+Lemma Zmult_gt_compat_r n m p : p > 0 -> n > m -> n * p > m * p.
 Proof.
-  intros x y z; intros; apply Zlt_gt; apply Zmult_lt_compat_r; apply Zgt_lt;
-    assumption.
+ Z.swap_greater. apply Z.mul_lt_mono_pos_r.
 Qed.
 
-Lemma Zmult_gt_0_lt_compat_r :
-  forall n m p:Z, p > 0 -> n < m -> n * p < m * p.
+Lemma Zmult_gt_0_lt_compat_r n m p : p > 0 -> n < m -> n * p < m * p.
 Proof.
-  intros x y z; intros; apply Zmult_lt_compat_r;
-    [ apply Zgt_lt; assumption | assumption ].
+ Z.swap_greater. apply Z.mul_lt_mono_pos_r.
 Qed.
 
-Lemma Zmult_gt_0_le_compat_r :
-  forall n m p:Z, p > 0 -> n <= m -> n * p <= m * p.
+Lemma Zmult_gt_0_le_compat_r n m p : p > 0 -> n <= m -> n * p <= m * p.
 Proof.
-  intros x y z Hz Hxy.
-  elim (Zle_lt_or_eq x y Hxy).
-  intros; apply Zlt_le_weak.
-  apply Zmult_gt_0_lt_compat_r; trivial.
-  intros; apply Zeq_le.
-  rewrite H; trivial.
+ Z.swap_greater. apply Z.mul_le_mono_pos_r.
 Qed.
 
-Lemma Zmult_lt_0_le_compat_r :
-  forall n m p:Z, 0 < p -> n <= m -> n * p <= m * p.
+Lemma Zmult_lt_0_le_compat_r n m p : 0 < p -> n <= m -> n * p <= m * p.
 Proof.
-  intros x y z; intros; apply Zmult_gt_0_le_compat_r; try apply Zlt_gt;
-    assumption.
+ apply Z.mul_le_mono_pos_r.
 Qed.
 
-Lemma Zmult_gt_0_lt_compat_l :
-  forall n m p:Z, p > 0 -> n < m -> p * n < p * m.
+Lemma Zmult_gt_0_lt_compat_l n m p : p > 0 -> n < m -> p * n < p * m.
 Proof.
-  intros x y z; intros.
-  rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
-    apply Zmult_gt_0_lt_compat_r; assumption.
+ Z.swap_greater. apply Z.mul_lt_mono_pos_l.
 Qed.
 
-Lemma Zmult_lt_compat_l : forall n m p:Z, 0 < p -> n < m -> p * n < p * m.
+Lemma Zmult_lt_compat_l n m p : 0 < p -> n < m -> p * n < p * m.
 Proof.
-  intros x y z; intros.
-  rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
-    apply Zmult_gt_0_lt_compat_r; try apply Zlt_gt; assumption.
+ apply Z.mul_lt_mono_pos_l.
 Qed.
 
-Lemma Zmult_gt_compat_l : forall n m p:Z, p > 0 -> n > m -> p * n > p * m.
+Lemma Zmult_gt_compat_l n m p : p > 0 -> n > m -> p * n > p * m.
 Proof.
-  intros x y z; intros; rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
-    apply Zmult_gt_compat_r; assumption.
+ Z.swap_greater. apply Z.mul_lt_mono_pos_l.
 Qed.
 
-Lemma Zmult_ge_compat_r : forall n m p:Z, n >= m -> p >= 0 -> n * p >= m * p.
+Lemma Zmult_ge_compat_r n m p : n >= m -> p >= 0 -> n * p >= m * p.
 Proof.
-  intros a b c H1 H2; apply Zle_ge.
-  apply Zmult_le_compat_r; apply Zge_le; trivial.
+ Z.swap_greater. intros. now apply Z.mul_le_mono_nonneg_r.
 Qed.
 
-Lemma Zmult_ge_compat_l : forall n m p:Z, n >= m -> p >= 0 -> p * n >= p * m.
+Lemma Zmult_ge_compat_l n m p : n >= m -> p >= 0 -> p * n >= p * m.
 Proof.
-  intros a b c H1 H2; apply Zle_ge.
-  apply Zmult_le_compat_l; apply Zge_le; trivial.
+ Z.swap_greater. intros. now apply Z.mul_le_mono_nonneg_l.
 Qed.
 
-Lemma Zmult_ge_compat :
-  forall n m p q:Z, n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q.
+Lemma Zmult_ge_compat n m p q :
+  n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q.
 Proof.
-  intros a b c d H0 H1 H2 H3.
-  apply Zge_trans with (a * d).
-  apply Zmult_ge_compat_l; trivial.
-  apply Zge_trans with c; trivial.
-  apply Zmult_ge_compat_r; trivial.
+ Z.swap_greater. intros. now apply Z.mul_le_mono_nonneg.
 Qed.
 
-Lemma Zmult_le_compat :
-  forall n m p q:Z, n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q.
+Lemma Zmult_le_compat n m p q :
+  n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q.
 Proof.
-  intros a b c d H0 H1 H2 H3.
-  apply Zle_trans with (c * b).
-  apply Zmult_le_compat_r; assumption.
-  apply Zmult_le_compat_l.
-  assumption.
-  apply Zle_trans with a; assumption.
+ intros. now apply Z.mul_le_mono_nonneg.
 Qed.
 
 (** Simplification of multiplication by a positive wrt to being positive *)
 
-Lemma Zmult_gt_0_lt_reg_r : forall n m p:Z, p > 0 -> n * p < m * p -> n < m.
+Lemma Zmult_gt_0_lt_reg_r n m p : p > 0 -> n * p < m * p -> n < m.
 Proof.
-  intros x y z; intros; destruct z.
-  contradiction (Zgt_irrefl 0).
-  rewrite (Zmult_comm x) in H0; rewrite (Zmult_comm y) in H0.
-  unfold Zlt in H0; rewrite Zcompare_mult_compat in H0; assumption.
-  discriminate H.
+ Z.swap_greater. apply Z.mul_lt_mono_pos_r.
 Qed.
 
-Lemma Zmult_lt_reg_r : forall n m p:Z, 0 < p -> n * p < m * p -> n < m.
+Lemma Zmult_lt_reg_r n m p : 0 < p -> n * p < m * p -> n < m.
 Proof.
-  intros a b c H0 H1.
-  apply Zmult_gt_0_lt_reg_r with c; try apply Zlt_gt; assumption.
+ apply Z.mul_lt_mono_pos_r.
 Qed.
 
-Lemma Zmult_le_reg_r : forall n m p:Z, p > 0 -> n * p <= m * p -> n <= m.
+Lemma Zmult_le_reg_r n m p : p > 0 -> n * p <= m * p -> n <= m.
 Proof.
-  intros x y z Hz Hxy.
-  elim (Zle_lt_or_eq (x * z) (y * z) Hxy).
-  intros; apply Zlt_le_weak.
-  apply Zmult_gt_0_lt_reg_r with z; trivial.
-  intros; apply Zeq_le.
-  apply Zmult_reg_r with z.
-  intro. rewrite H0 in Hz. contradiction (Zgt_irrefl 0).
-  assumption.
+ Z.swap_greater. apply Z.mul_le_mono_pos_r.
 Qed.
 
-Lemma Zmult_lt_0_le_reg_r : forall n m p:Z, 0 < p -> n * p <= m * p -> n <= m.
+Lemma Zmult_lt_0_le_reg_r n m p : 0 < p -> n * p <= m * p -> n <= m.
 Proof.
-  intros x y z; intros; apply Zmult_le_reg_r with z.
-  try apply Zlt_gt; assumption.
-  assumption.
+ apply Z.mul_le_mono_pos_r.
 Qed.
 
-
-Lemma Zmult_ge_reg_r : forall n m p:Z, p > 0 -> n * p >= m * p -> n >= m.
+Lemma Zmult_ge_reg_r n m p : p > 0 -> n * p >= m * p -> n >= m.
 Proof.
-  intros a b c H1 H2; apply Zle_ge; apply Zmult_le_reg_r with c; trivial.
-  apply Zge_le; trivial.
+ Z.swap_greater. apply Z.mul_le_mono_pos_r.
 Qed.
 
-Lemma Zmult_gt_reg_r : forall n m p:Z, p > 0 -> n * p > m * p -> n > m.
+Lemma Zmult_gt_reg_r n m p : p > 0 -> n * p > m * p -> n > m.
 Proof.
-  intros a b c H1 H2; apply Zlt_gt; apply Zmult_gt_0_lt_reg_r with c; trivial.
-  apply Zgt_lt; trivial.
+ Z.swap_greater. apply Z.mul_lt_mono_pos_r.
 Qed.
 
-
-(** Compatibility of multiplication by a positive wrt to being positive *)
-
-Lemma Zmult_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n * m.
+Lemma Zmult_lt_compat n m p q :
+  0 <= n < p -> 0 <= m < q -> n * m < p * q.
 Proof.
-  intros x y; case x.
-  intros; rewrite Zmult_0_l; trivial.
-  intros p H1; unfold Zle in |- *.
-  pattern 0 at 2 in |- *; rewrite <- (Zmult_0_r (Zpos p)).
-  rewrite Zcompare_mult_compat; trivial.
-  intros p H1 H2; absurd (0 > Zneg p); trivial.
-  unfold Zgt in |- *; simpl in |- *; auto with zarith.
+ intros (Hn,Hnp) (Hm,Hmq). now apply Z.mul_lt_mono_nonneg.
 Qed.
 
-Lemma Zmult_gt_0_compat : forall n m:Z, n > 0 -> m > 0 -> n * m > 0.
+Lemma Zmult_lt_compat2 n m p q :
+  0 < n <= p -> 0 < m < q -> n * m < p * q.
 Proof.
-  intros x y; case x.
-  intros H; discriminate H.
-  intros p H1; unfold Zgt in |- *; pattern 0 at 2 in |- *;
-    rewrite <- (Zmult_0_r (Zpos p)).
-  rewrite Zcompare_mult_compat; trivial.
-  intros p H; discriminate H.
+  intros (Hn, Hnp) (Hm,Hmq).
+  apply Z.le_lt_trans with (p * m).
+   apply Z.mul_le_mono_pos_r; trivial.
+   apply Z.mul_lt_mono_pos_l; Z.order.
 Qed.
 
-Lemma Zmult_lt_0_compat : forall n m:Z, 0 < n -> 0 < m -> 0 < n * m.
+(** Compatibility of multiplication by a positive wrt to being positive *)
+
+Notation Zmult_le_0_compat := Z.mul_nonneg_nonneg (compat "8.3").
+Notation Zmult_lt_0_compat := Z.mul_pos_pos (compat "8.3").
+Notation Zmult_lt_O_compat := Z.mul_pos_pos (compat "8.3").
+
+Lemma Zmult_gt_0_compat n m : n > 0 -> m > 0 -> n * m > 0.
 Proof.
-  intros a b apos bpos.
-  apply Zgt_lt.
-  apply Zmult_gt_0_compat; try apply Zlt_gt; assumption.
+ Z.swap_greater. apply Z.mul_pos_pos.
 Qed.
 
-(** For compatibility *)
-Notation Zmult_lt_O_compat := Zmult_lt_0_compat (only parsing).
+(* To remove someday ... *)
 
-Lemma Zmult_gt_0_le_0_compat : forall n m:Z, n > 0 -> 0 <= m -> 0 <= m * n.
+Lemma Zmult_gt_0_le_0_compat n m : n > 0 -> 0 <= m -> 0 <= m * n.
 Proof.
-  intros x y H1 H2; apply Zmult_le_0_compat; trivial.
-  apply Zlt_le_weak; apply Zgt_lt; trivial.
+ Z.swap_greater. intros. apply Z.mul_nonneg_nonneg. trivial.
+  now apply Z.lt_le_incl.
 Qed.
 
 (** Simplification of multiplication by a positive wrt to being positive *)
 
-Lemma Zmult_le_0_reg_r : forall n m:Z, n > 0 -> 0 <= m * n -> 0 <= m.
+Lemma Zmult_le_0_reg_r n m : n > 0 -> 0 <= m * n -> 0 <= m.
 Proof.
-  intros x y; case x;
-    [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H
-      | intros p H1; unfold Zle in |- *; rewrite Zmult_comm;
-	pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p));
-	  rewrite Zcompare_mult_compat; auto with arith
-      | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ].
+ Z.swap_greater. apply Z.mul_nonneg_cancel_r.
 Qed.
 
-Lemma Zmult_gt_0_lt_0_reg_r : forall n m:Z, n > 0 -> 0 < m * n -> 0 < m.
+Lemma Zmult_lt_0_reg_r n m : 0 < n -> 0 < m * n -> 0 < m.
 Proof.
-  intros x y; case x;
-    [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H
-      | intros p H1; unfold Zlt in |- *; rewrite Zmult_comm;
-	pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p));
-	  rewrite Zcompare_mult_compat; auto with arith
-      | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ].
+ apply Z.mul_pos_cancel_r.
 Qed.
 
-Lemma Zmult_lt_0_reg_r : forall n m:Z, 0 < n -> 0 < m * n -> 0 < m.
+Lemma Zmult_gt_0_lt_0_reg_r n m : n > 0 -> 0 < m * n -> 0 < m.
 Proof.
-  intros x y; intros; eapply Zmult_gt_0_lt_0_reg_r with x; try apply Zlt_gt;
-    assumption.
+ Z.swap_greater. apply Z.mul_pos_cancel_r.
 Qed.
 
-Lemma Zmult_gt_0_reg_l : forall n m:Z, n > 0 -> n * m > 0 -> m > 0.
+Lemma Zmult_gt_0_reg_l n m : n > 0 -> n * m > 0 -> m > 0.
 Proof.
-  intros x y; case x.
-  intros H; discriminate H.
-  intros p H1; unfold Zgt in |- *.
-  pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)).
-  rewrite Zcompare_mult_compat; trivial.
-  intros p H; discriminate H.
+ Z.swap_greater. apply Z.mul_pos_cancel_l.
 Qed.
 
 (** ** Square *)
 (** Simplification of square wrt order *)
 
-Lemma Zgt_square_simpl :
-  forall n m:Z, n >= 0 -> n * n > m * m -> n > m.
+Lemma Zlt_square_simpl n m : 0 <= n -> m * m < n * n -> m < n.
 Proof.
-  intros n m H0 H1.
-  case (dec_Zlt m n).
-  intro; apply Zlt_gt; trivial.
-  intros H2; cut (m >= n).
-  intros H.
-  elim Zgt_not_le with (1 := H1).
-  apply Zge_le.
-  apply Zmult_ge_compat; auto.
-  apply Znot_lt_ge; trivial.
+ apply Z.square_lt_simpl_nonneg.
 Qed.
 
-Lemma Zlt_square_simpl :
-  forall n m:Z, 0 <= n -> m * m < n * n -> m < n.
+Lemma Zgt_square_simpl n m : n >= 0 -> n * n > m * m -> n > m.
 Proof.
-  intros x y H0 H1.
-  apply Zgt_lt.
-  apply Zgt_square_simpl; try apply Zle_ge; try apply Zlt_gt; assumption.
+ Z.swap_greater. apply Z.square_lt_simpl_nonneg.
 Qed.
 
 (** * Equivalence between inequalities *)
 
-Lemma Zle_plus_swap : forall n m p:Z, n + p <= m <-> n <= m - p.
-Proof.
-  intros x y z; intros. split. intro. rewrite <- (Zplus_0_r x). rewrite <- (Zplus_opp_r z).
-  rewrite Zplus_assoc. exact (Zplus_le_compat_r _ _ _ H).
-  intro. rewrite <- (Zplus_0_r y). rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc.
-  apply Zplus_le_compat_r. assumption.
-Qed.
-
-Lemma Zlt_plus_swap : forall n m p:Z, n + p < m <-> n < m - p.
-Proof.
-  intros x y z; intros. split. intro. unfold Zminus in |- *. rewrite Zplus_comm. rewrite <- (Zplus_0_l x).
-  rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm.
-  assumption.
-  intro. rewrite Zplus_comm. rewrite <- (Zplus_0_l y). rewrite <- (Zplus_opp_r z).
-  rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. assumption.
-Qed.
-
-Lemma Zeq_plus_swap : forall n m p:Z, n + p = m <-> n = m - p.
-Proof.
-  intros x y z; intros. split. intro. apply Zplus_minus_eq. symmetry  in |- *. rewrite Zplus_comm.
-  assumption.
-  intro. rewrite H. unfold Zminus in |- *. rewrite Zplus_assoc_reverse.
-  rewrite Zplus_opp_l. apply Zplus_0_r.
-Qed.
-
-Lemma Zlt_minus_simpl_swap : forall n m:Z, 0 < m -> n - m < n.
-Proof.
-  intros n m H; apply Zplus_lt_reg_l with (p := m); rewrite Zplus_minus;
-    pattern n at 1 in |- *; rewrite <- (Zplus_0_r n);
-      rewrite (Zplus_comm m n); apply Zplus_lt_compat_l;
-	assumption.
-Qed.
-
-Lemma Zlt_0_minus_lt : forall n m:Z, 0 < n - m -> m < n.
-Proof.
-  intros n m H; apply Zplus_lt_reg_l with (p := - m); rewrite Zplus_opp_l;
-    rewrite Zplus_comm; exact H.
-Qed.
+Notation Zle_plus_swap := Z.le_add_le_sub_r (compat "8.3").
+Notation Zlt_plus_swap := Z.lt_add_lt_sub_r (compat "8.3").
+Notation Zlt_minus_simpl_swap := Z.lt_sub_pos (compat "8.3").
 
-Lemma Zle_0_minus_le : forall n m:Z, 0 <= n - m -> m <= n.
+Lemma Zeq_plus_swap n m p : n + p = m <-> n = m - p.
 Proof.
-  intros n m H; apply Zplus_le_reg_l with (p := - m); rewrite Zplus_opp_l;
-    rewrite Zplus_comm; exact H.
+ apply Z.add_move_r.
 Qed.
 
-Lemma Zle_minus_le_0 : forall n m:Z, m <= n -> 0 <= n - m.
+Lemma Zlt_0_minus_lt n m : 0 < n - m -> m < n.
 Proof.
-  intros n m H; unfold Zminus; apply Zplus_le_reg_r with (p := m);
-    rewrite <- Zplus_assoc; rewrite Zplus_opp_l; rewrite Zplus_0_r; exact H.
+ apply Z.lt_0_sub.
 Qed.
 
-Lemma Zmult_lt_compat:
-  forall n m p q : Z, 0 <= n < p -> 0 <= m < q -> n * m < p * q.
+Lemma Zle_0_minus_le n m : 0 <= n - m -> m <= n.
 Proof.
-  intros n m p q (H1, H2) (H3,H4).
-  assert (0<p) by (apply Zle_lt_trans with n; auto).
-  assert (0<q) by (apply Zle_lt_trans with m; auto).
-  case Zle_lt_or_eq with (1 := H1); intros H5; auto with zarith.
-  case Zle_lt_or_eq with (1 := H3); intros H6; auto with zarith.
-  apply Zlt_trans with (n * q).
-  apply Zmult_lt_compat_l; auto.
-  apply Zmult_lt_compat_r; auto with zarith.
-  rewrite <- H6; rewrite Zmult_0_r; apply Zmult_lt_0_compat; auto with zarith.
-  rewrite <- H5; simpl; apply Zmult_lt_0_compat; auto with zarith.
+ apply Z.le_0_sub.
 Qed.
 
-Lemma Zmult_lt_compat2:
-  forall n m p q : Z, 0 < n <= p -> 0 < m < q -> n * m < p * q.
+Lemma Zle_minus_le_0 n m : m <= n -> 0 <= n - m.
 Proof.
-  intros n m p q (H1, H2) (H3, H4).
-  apply Zle_lt_trans with (p * m).
-  apply Zmult_le_compat_r; auto.
-  apply Zlt_le_weak; auto.
-  apply Zmult_lt_compat_l; auto.
-  apply Zlt_le_trans with n; auto.
+ apply Z.le_0_sub.
 Qed.
 
 (** For compatibility *)
diff --git a/theories/ZArith/Zpow_alt.v b/theories/ZArith/Zpow_alt.v
new file mode 100644
index 00000000..f3eb63a8
--- /dev/null
+++ b/theories/ZArith/Zpow_alt.v
@@ -0,0 +1,83 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import BinInt.
+Local Open Scope Z_scope.
+
+(** An alternative power function for Z *)
+
+(** This [Zpower_alt] is extensionnaly equal to [Z.pow],
+    but not convertible with it. The number of
+    multiplications is logarithmic instead of linear, but
+    these multiplications are bigger. Experimentally, it seems
+    that [Zpower_alt] is slightly quicker than [Z.pow] on average,
+    but can be quite slower on powers of 2.
+*)
+
+Definition Zpower_alt n m :=
+  match m with
+    | Z0 => 1
+    | Zpos p => Pos.iter_op Z.mul p n
+    | Zneg p => 0
+  end.
+
+Infix "^^" := Zpower_alt (at level 30, right associativity) : Z_scope.
+
+Lemma Piter_mul_acc : forall f,
+ (forall x y:Z, (f x)*y = f (x*y)) ->
+ forall p k, Pos.iter p f k = (Pos.iter p f 1)*k.
+Proof.
+ intros f Hf.
+ induction p; simpl; intros.
+ - set (g := Pos.iter p f 1) in *. now rewrite !IHp, Hf, Z.mul_assoc.
+ - set (g := Pos.iter p f 1) in *. now rewrite !IHp, Z.mul_assoc.
+ - now rewrite Hf, Z.mul_1_l.
+Qed.
+
+Lemma Piter_op_square : forall p a,
+ Pos.iter_op Z.mul p (a*a) = (Pos.iter_op Z.mul p a)*(Pos.iter_op Z.mul p a).
+Proof.
+ induction p; simpl; intros; trivial. now rewrite IHp, Z.mul_shuffle1.
+Qed.
+
+Lemma Zpower_equiv a b : a^^b = a^b.
+Proof.
+ destruct b as [|p|p]; trivial.
+ unfold Zpower_alt, Z.pow, Z.pow_pos.
+ revert a.
+ induction p; simpl; intros.
+ - f_equal.
+   rewrite Piter_mul_acc.
+   now rewrite Piter_op_square, IHp.
+   intros. symmetry; apply Z.mul_assoc.
+ - rewrite Piter_mul_acc.
+   now rewrite Piter_op_square, IHp.
+   intros. symmetry; apply Z.mul_assoc.
+ - now Z.nzsimpl.
+Qed.
+
+Lemma Zpower_alt_0_r n : n^^0 = 1.
+Proof. reflexivity. Qed.
+
+Lemma Zpower_alt_succ_r a b : 0<=b -> a^^(Z.succ b) = a * a^^b.
+Proof.
+ destruct b as [|b|b]; intros Hb; simpl.
+ - now Z.nzsimpl.
+ - now rewrite Pos.add_1_r, Pos.iter_op_succ by apply Z.mul_assoc.
+ - now elim Hb.
+Qed.
+
+Lemma Zpower_alt_neg_r a b : b<0 -> a^^b = 0.
+Proof.
+ now destruct b.
+Qed.
+
+Lemma Zpower_alt_Ppow p q : (Zpos p)^^(Zpos q) = Zpos (p^q).
+Proof.
+ now rewrite Zpower_equiv, Pos2Z.inj_pow.
+Qed.
diff --git a/theories/ZArith/Zpow_def.v b/theories/ZArith/Zpow_def.v
index 620d6324..a1c60bf2 100644
--- a/theories/ZArith/Zpow_def.v
+++ b/theories/ZArith/Zpow_def.v
@@ -1,27 +1,31 @@
-Require Import ZArith_base.
-Require Import Ring_theory.
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
 
-Open Local Scope Z_scope.
+Require Import BinInt Ring_theory.
+Local Open Scope Z_scope.
 
-(** [Zpower_pos z n] is the n-th power of [z] when [n] is an binary
-      integer (type [positive]) and [z] a signed integer (type [Z]) *)
-Definition Zpower_pos (z:Z) (n:positive) := iter_pos n Z (fun x:Z => z * x) 1.
+(** * Power functions over [Z] *)
 
-Definition Zpower (x y:Z) :=
-    match y with
-      | Zpos p => Zpower_pos x p
-      | Z0 => 1
-      | Zneg p => 0
-    end.
+(** Nota : this file is mostly deprecated. The definition of [Z.pow]
+    and its usual properties are now provided by module [BinInt.Z]. *)
 
-Lemma Zpower_theory : power_theory 1 Zmult (eq (A:=Z)) Z_of_N Zpower.
+Notation Zpower_pos := Z.pow_pos (compat "8.3").
+Notation Zpower := Z.pow (compat "8.3").
+Notation Zpower_0_r := Z.pow_0_r (compat "8.3").
+Notation Zpower_succ_r := Z.pow_succ_r (compat "8.3").
+Notation Zpower_neg_r := Z.pow_neg_r (compat "8.3").
+Notation Zpower_Ppow := Pos2Z.inj_pow (compat "8.3").
+
+Lemma Zpower_theory : power_theory 1 Z.mul (@eq Z) Z.of_N Z.pow.
 Proof.
  constructor. intros.
  destruct n;simpl;trivial.
- unfold Zpower_pos.
- assert (forall k, iter_pos p Z (fun x : Z => r * x) k = pow_pos Zmult r p*k).
- induction p;simpl;intros;repeat rewrite IHp;trivial;
-   repeat rewrite Zmult_assoc;trivial.
- rewrite H;rewrite Zmult_1_r;trivial.
+ unfold Z.pow_pos.
+ rewrite <- (Z.mul_1_r (pow_pos _ _ _)). generalize 1.
+ induction p; simpl; intros; rewrite ?IHp, ?Z.mul_assoc; trivial.
 Qed.
-
diff --git a/theories/ZArith/Zpow_facts.v b/theories/ZArith/Zpow_facts.v
index 7879fe42..8ff641a3 100644
--- a/theories/ZArith/Zpow_facts.v
+++ b/theories/ZArith/Zpow_facts.v
@@ -1,298 +1,112 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zpow_facts.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import ZArith_base.
-Require Import ZArithRing.
-Require Import Zcomplements.
+Require Import ZArith_base ZArithRing Zcomplements Zdiv Znumtheory.
 Require Export Zpower.
-Require Import Zdiv.
-Require Import Znumtheory.
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
-Lemma Zpower_pos_1_r: forall x, Zpower_pos x 1 = x.
-Proof.
-  intros x; unfold Zpower_pos; simpl; auto with zarith.
-Qed.
+(** Properties of the power function over [Z] *)
 
-Lemma Zpower_pos_1_l: forall p, Zpower_pos 1 p = 1.
-Proof.
-  induction p.
-  (* xI *)
-  rewrite xI_succ_xO, <-Pplus_diag, Pplus_one_succ_l.
-  repeat rewrite Zpower_pos_is_exp.
-  rewrite Zpower_pos_1_r, IHp; auto.
-  (* xO *)
-  rewrite <- Pplus_diag.
-  repeat rewrite Zpower_pos_is_exp.
-  rewrite IHp; auto.
-  (* xH *)
-  rewrite Zpower_pos_1_r; auto.
-Qed.
+(** Nota: the usual properties of [Z.pow] are now already provided
+    by [BinInt.Z]. Only remain here some compatibility elements,
+    as well as more specific results about power and modulo and/or
+    primality. *)
 
-Lemma Zpower_pos_0_l: forall p, Zpower_pos 0 p = 0.
-Proof.
-  induction p.
-  change (xI p) with (1 + (xO p))%positive.
-  rewrite Zpower_pos_is_exp, Zpower_pos_1_r; auto.
-  rewrite <- Pplus_diag.
-  rewrite Zpower_pos_is_exp, IHp; auto.
-  rewrite Zpower_pos_1_r; auto.
-Qed.
+Lemma Zpower_pos_1_r x : Z.pow_pos x 1 = x.
+Proof (Z.pow_1_r x).
 
-Lemma Zpower_pos_pos: forall x p,
-  0 < x -> 0 < Zpower_pos x p.
-Proof.
-  induction p; intros.
-  (* xI *)
-  rewrite xI_succ_xO, <-Pplus_diag, Pplus_one_succ_l.
-  repeat rewrite Zpower_pos_is_exp.
-  rewrite Zpower_pos_1_r.
-  repeat apply Zmult_lt_0_compat; auto.
-  (* xO *)
-  rewrite <- Pplus_diag.
-  repeat rewrite Zpower_pos_is_exp.
-  repeat apply Zmult_lt_0_compat; auto.
-  (* xH *)
-  rewrite Zpower_pos_1_r; auto.
-Qed.
+Lemma Zpower_pos_1_l p : Z.pow_pos 1 p = 1.
+Proof. now apply (Z.pow_1_l (Zpos p)). Qed.
 
+Lemma Zpower_pos_0_l p : Z.pow_pos 0 p = 0.
+Proof. now apply (Z.pow_0_l (Zpos p)). Qed.
 
-Theorem Zpower_1_r: forall z, z^1 = z.
-Proof.
-  exact Zpower_pos_1_r.
-Qed.
-
-Theorem Zpower_1_l: forall z, 0 <= z -> 1^z = 1.
-Proof.
-  destruct z; simpl; auto.
-  intros; apply Zpower_pos_1_l.
-  intros; compute in H; elim H; auto.
-Qed.
+Lemma Zpower_pos_pos x p : 0 < x -> 0 < Z.pow_pos x p.
+Proof. intros. now apply (Z.pow_pos_nonneg x (Zpos p)). Qed.
 
-Theorem Zpower_0_l: forall z, z<>0 -> 0^z = 0.
-Proof.
-  destruct z; simpl; auto with zarith.
-  intros; apply Zpower_pos_0_l.
-Qed.
+Notation Zpower_1_r := Z.pow_1_r (compat "8.3").
+Notation Zpower_1_l := Z.pow_1_l (compat "8.3").
+Notation Zpower_0_l := Z.pow_0_l' (compat "8.3").
+Notation Zpower_0_r := Z.pow_0_r (compat "8.3").
+Notation Zpower_2 := Z.pow_2_r (compat "8.3").
+Notation Zpower_gt_0 := Z.pow_pos_nonneg (compat "8.3").
+Notation Zpower_ge_0 := Z.pow_nonneg (compat "8.3").
+Notation Zpower_Zabs := Z.abs_pow (compat "8.3").
+Notation Zpower_Zsucc := Z.pow_succ_r (compat "8.3").
+Notation Zpower_mult := Z.pow_mul_r (compat "8.3").
+Notation Zpower_le_monotone2 := Z.pow_le_mono_r (compat "8.3").
 
-Theorem Zpower_0_r: forall z, z^0 = 1.
-Proof.
-  simpl; auto.
-Qed.
-
-Theorem Zpower_2: forall z, z^2 = z * z.
-Proof.
-  intros; ring.
-Qed.
-
-Theorem Zpower_gt_0: forall x y,
-  0 < x -> 0 <= y -> 0 < x^y.
-Proof.
-  destruct y; simpl; auto with zarith.
-  intros; apply Zpower_pos_pos; auto.
-  intros; compute in H0; elim H0; auto.
-Qed.
-
-Theorem Zpower_Zabs: forall a b,  Zabs (a^b) = (Zabs a)^b.
-Proof.
-  intros a b; case (Zle_or_lt 0 b).
-  intros Hb; pattern b; apply natlike_ind; auto with zarith.
-  intros x Hx Hx1; unfold Zsucc.
-  (repeat rewrite Zpower_exp); auto with zarith.
-  rewrite Zabs_Zmult; rewrite Hx1.
-  f_equal; auto.
-  replace (a ^ 1) with a; auto.
-  simpl; unfold Zpower_pos; simpl; rewrite Zmult_1_r; auto.
-  simpl; unfold Zpower_pos; simpl; rewrite Zmult_1_r; auto.
-  case b; simpl; auto with zarith.
-  intros p Hp; discriminate.
-Qed.
-
-Theorem Zpower_Zsucc: forall p n, 0 <= n -> p^(Zsucc n) = p * p^n.
-Proof.
-  intros p n H.
-  unfold Zsucc; rewrite Zpower_exp; auto with zarith.
-  rewrite Zpower_1_r; apply Zmult_comm.
-Qed.
-
-Theorem Zpower_mult: forall p q r, 0 <= q -> 0 <= r -> p^(q*r) = (p^q)^r.
-Proof.
-  intros p q r H1 H2; generalize H2; pattern r; apply natlike_ind; auto.
-  intros H3; rewrite Zmult_0_r; repeat rewrite Zpower_exp_0; auto.
-  intros r1 H3 H4 H5.
-  unfold Zsucc; rewrite Zpower_exp; auto with zarith.
-  rewrite <- H4; try rewrite Zpower_1_r; try rewrite <- Zpower_exp; try f_equal; auto with zarith.
-  ring.
-  apply Zle_ge; replace 0 with (0 * r1); try apply Zmult_le_compat_r; auto.
-Qed.
-
-Theorem Zpower_le_monotone: forall a b c,
+Theorem Zpower_le_monotone a b c :
  0 < a -> 0 <= b <= c -> a^b <= a^c.
-Proof.
-  intros a b c H (H1, H2).
-  rewrite <- (Zmult_1_r (a ^ b)); replace c with (b + (c - b)); auto with zarith.
-  rewrite Zpower_exp; auto with zarith.
-  apply Zmult_le_compat_l; auto with zarith.
-  assert (0 < a ^ (c - b)); auto with zarith.
-  apply Zpower_gt_0; auto with zarith.
-  apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith.
-Qed.
+Proof. intros. now apply Z.pow_le_mono_r. Qed.
 
-Theorem Zpower_lt_monotone: forall a b c,
+Theorem Zpower_lt_monotone a b c :
  1 < a -> 0 <= b < c -> a^b < a^c.
-Proof.
-  intros a b c H (H1, H2).
-  rewrite <- (Zmult_1_r (a ^ b)); replace c with (b + (c - b)); auto with zarith.
-  rewrite Zpower_exp; auto with zarith.
-  apply Zmult_lt_compat_l; auto with zarith.
-  apply Zpower_gt_0; auto with zarith.
-  assert (0 < a ^ (c - b)); auto with zarith.
-  apply Zpower_gt_0; auto with zarith.
-  apply Zlt_le_trans with (a ^1); auto with zarith.
-  rewrite Zpower_1_r; auto with zarith.
-  apply Zpower_le_monotone; auto with zarith.
-Qed.
-
-Theorem Zpower_gt_1 : forall x y,
-  1 < x -> 0 < y -> 1 < x^y.
-Proof.
-  intros x y H1 H2.
-  replace 1 with (x ^ 0) by apply Zpower_0_r.
-  apply Zpower_lt_monotone; auto with zarith.
-Qed.
+Proof. intros. apply Z.pow_lt_mono_r; auto with zarith. Qed.
 
-Theorem Zpower_ge_0: forall x y, 0 <= x -> 0 <= x^y.
-Proof.
-  intros x y; case y; auto with zarith.
-  simpl ; auto with zarith.
-  intros p H1; assert (H: 0 <= Zpos p); auto with zarith.
-  generalize H; pattern (Zpos p); apply natlike_ind; auto with zarith.
-  intros p1 H2 H3 _; unfold Zsucc; rewrite Zpower_exp; simpl; auto with zarith.
-  apply Zmult_le_0_compat; auto with zarith.
-  generalize H1; case x; compute; intros; auto; try discriminate.
-Qed.
-
-Theorem Zpower_le_monotone2:
-   forall a b c, 0 < a -> b <= c -> a^b <= a^c.
-Proof.
-  intros a b c H H2.
-  destruct (Z_le_gt_dec 0 b).
-  apply Zpower_le_monotone; auto.
-  replace (a^b) with 0.
-  destruct (Z_le_gt_dec 0 c).
-  destruct (Zle_lt_or_eq _ _ z0).
-  apply Zlt_le_weak;apply Zpower_gt_0;trivial.
-  rewrite <- H0;simpl;auto with zarith.
-  replace (a^c) with 0. auto with zarith.
-  destruct c;trivial;unfold Zgt in z0;discriminate z0.
-  destruct b;trivial;unfold Zgt in z;discriminate z.
-Qed.
+Theorem Zpower_gt_1 x y : 1 < x -> 0 < y -> 1 < x^y.
+Proof. apply Z.pow_gt_1. Qed.
 
-Theorem Zmult_power: forall p q r, 0 <= r ->
-  (p*q)^r = p^r * q^r.
-Proof.
-  intros p q r H1; generalize H1; pattern r; apply natlike_ind; auto.
-  clear r H1; intros r H1 H2 H3.
-  unfold Zsucc; rewrite Zpower_exp; auto with zarith.
-  rewrite H2; repeat rewrite Zpower_exp; auto with zarith; ring.
-Qed.
+Theorem Zmult_power p q r : 0 <= r -> (p*q)^r = p^r * q^r.
+Proof. intros. apply Z.pow_mul_l. Qed.
 
-Hint Resolve Zpower_ge_0 Zpower_gt_0: zarith.
+Hint Resolve Z.pow_nonneg Z.pow_pos_nonneg : zarith.
 
-Theorem Zpower_le_monotone3: forall a b c,
+Theorem Zpower_le_monotone3 a b c :
  0 <= c -> 0 <= a <= b -> a^c <= b^c.
-Proof.
-  intros a b c H (H1, H2).
-  generalize H; pattern c; apply natlike_ind; auto.
-  intros x HH HH1 _; unfold Zsucc; repeat rewrite Zpower_exp; auto with zarith.
-  repeat rewrite Zpower_1_r.
-  apply Zle_trans with (a^x * b); auto with zarith.
-Qed.
+Proof. intros. now apply Z.pow_le_mono_l. Qed.
 
-Lemma Zpower_le_monotone_inv: forall a b c,
+Lemma Zpower_le_monotone_inv a b c :
   1 < a -> 0 < b -> a^b <= a^c -> b <= c.
 Proof.
-  intros a b c H H0 H1.
-  destruct (Z_le_gt_dec b c);trivial.
-  assert (2 <= a^b).
-   apply Zle_trans with (2^b).
-   pattern 2 at 1;replace 2 with (2^1);trivial.
-   apply Zpower_le_monotone;auto with zarith.
-   apply Zpower_le_monotone3;auto with zarith.
-  assert (c > 0).
-  destruct (Z_le_gt_dec 0 c);trivial.
-  destruct (Zle_lt_or_eq _ _ z0);auto with zarith.
-  rewrite <- H3 in H1;simpl in H1; exfalso;omega.
-  destruct c;try discriminate z0. simpl in H1. exfalso;omega.
-  assert (H4 := Zpower_lt_monotone a c b H). exfalso;omega.
+ intros Ha Hb H. apply (Z.pow_le_mono_r_iff a); trivial.
+ apply Z.lt_le_incl; apply (Z.pow_gt_1 a); trivial.
+ apply Z.lt_le_trans with (a^b); trivial. now apply Z.pow_gt_1.
 Qed.
 
-Theorem Zpower_nat_Zpower: forall p q, 0 <= q ->
- p^q = Zpower_nat p (Zabs_nat q).
-Proof.
-  intros p1 q1; case q1; simpl.
-  intros _; exact (refl_equal _).
-  intros p2 _; apply Zpower_pos_nat.
-  intros p2 H1; case H1; auto.
-Qed.
+Notation Zpower_nat_Zpower := Zpower_nat_Zpower (only parsing).
 
-Theorem Zpower2_lt_lin: forall n, 0 <= n -> n < 2^n.
-Proof.
-  intros n; apply (natlike_ind (fun n => n < 2 ^n)); clear n.
-  simpl; auto with zarith.
-  intros n H1 H2; unfold Zsucc.
-  case (Zle_lt_or_eq _ _ H1); clear H1; intros H1.
-  apply Zle_lt_trans with (n + n); auto with zarith.
-  rewrite Zpower_exp; auto with zarith.
-  rewrite Zpower_1_r.
-  assert (tmp: forall p, p * 2 = p + p); intros; try ring;
-  rewrite tmp; auto with zarith.
-  subst n; simpl; unfold Zpower_pos; simpl; auto with zarith.
-Qed.
+Theorem Zpower2_lt_lin n : 0 <= n -> n < 2^n.
+Proof. intros. now apply Z.pow_gt_lin_r. Qed.
 
-Theorem Zpower2_le_lin: forall n, 0 <= n -> n <= 2^n.
-Proof.
-  intros; apply Zlt_le_weak; apply Zpower2_lt_lin; auto.
-Qed.
+Theorem Zpower2_le_lin n : 0 <= n -> n <= 2^n.
+Proof. intros. apply Z.lt_le_incl. now apply Z.pow_gt_lin_r. Qed.
 
-Lemma Zpower2_Psize :
-  forall n p, Zpos p < 2^(Z_of_nat n) <-> (Psize p <= n)%nat.
+Lemma Zpower2_Psize n p :
+  Zpos p < 2^(Z.of_nat n) <-> (Pos.size_nat p <= n)%nat.
 Proof.
-  induction n.
-  destruct p; split; intros H; discriminate H || inversion H.
-  destruct p; simpl Psize.
-  rewrite inj_S, Zpower_Zsucc; auto with zarith.
-  rewrite Zpos_xI; specialize IHn with p; omega.
-  rewrite inj_S, Zpower_Zsucc; auto with zarith.
-  rewrite Zpos_xO; specialize IHn with p; omega.
-  split; auto with arith.
-  intros _; apply Zpower_gt_1; auto with zarith.
-  rewrite inj_S; generalize (Zle_0_nat n); omega.
+  revert p; induction n.
+  destruct p; now split.
+  assert (Hn := Nat2Z.is_nonneg n).
+  destruct p; simpl Pos.size_nat.
+  - specialize IHn with p.
+    rewrite Pos2Z.inj_xI, Nat2Z.inj_succ, Z.pow_succ_r; omega.
+  - specialize IHn with p.
+    rewrite Pos2Z.inj_xO, Nat2Z.inj_succ, Z.pow_succ_r; omega.
+  - split; auto with zarith.
+    intros _. apply Z.pow_gt_1. easy.
+    now rewrite Nat2Z.inj_succ, Z.lt_succ_r.
 Qed.
 
-(** * Zpower and modulo *)
+(** * Z.pow and modulo *)
 
-Theorem Zpower_mod: forall p q n, 0 < n ->
- (p^q) mod n = ((p mod n)^q) mod n.
+Theorem Zpower_mod p q n :
+  0 < n -> (p^q) mod n = ((p mod n)^q) mod n.
 Proof.
-  intros p q n Hn; case (Zle_or_lt 0 q); intros H1.
-  generalize H1; pattern q; apply natlike_ind; auto.
-  intros q1 Hq1 Rec _; unfold Zsucc; repeat rewrite Zpower_exp; repeat rewrite Zpower_1_r; auto with zarith.
-  rewrite (fun x => (Zmult_mod x p)); try rewrite Rec; auto with zarith.
-  rewrite (fun x y => (Zmult_mod (x ^y))); try f_equal; auto with zarith.
-  f_equal; auto; apply sym_equal; apply Zmod_mod; auto with zarith.
-  generalize H1; case q; simpl; auto.
-  intros; discriminate.
+  intros Hn; destruct (Z.le_gt_cases 0 q) as [H1|H1].
+  - pattern q; apply natlike_ind; trivial.
+    clear q H1. intros q Hq Rec. rewrite !Z.pow_succ_r; trivial.
+    rewrite Z.mul_mod_idemp_l; auto with zarith.
+    rewrite Z.mul_mod, Rec, <- Z.mul_mod; auto with zarith.
+  - rewrite !Z.pow_neg_r; auto with zarith.
 Qed.
 
-(** A direct way to compute Zpower modulo **)
+(** A direct way to compute Z.pow modulo **)
 
 Fixpoint Zpow_mod_pos (a: Z)(m: positive)(n : Z) : Z :=
   match m with
@@ -313,153 +127,113 @@ Fixpoint Zpow_mod_pos (a: Z)(m: positive)(n : Z) : Z :=
 
 Definition Zpow_mod a m n :=
   match m with
-   | 0 => 1
+   | 0 => 1 mod n
    | Zpos p => Zpow_mod_pos a p n
    | Zneg p => 0
   end.
 
-Theorem Zpow_mod_pos_correct: forall a m n, 0 < n ->
- Zpow_mod_pos a m n = (Zpower_pos a m) mod n.
+Theorem Zpow_mod_pos_correct a m n :
+ n <> 0 -> Zpow_mod_pos a m n = (Z.pow_pos a m) mod n.
 Proof.
-  intros a m; elim m; simpl; auto.
-  intros p Rec n H1; rewrite xI_succ_xO, Pplus_one_succ_r, <-Pplus_diag; auto.
-  repeat rewrite Zpower_pos_is_exp; auto.
-  repeat rewrite Rec; auto.
-  rewrite Zpower_pos_1_r.
-  repeat rewrite (fun x => (Zmult_mod x a)); auto with zarith.
-  rewrite (Zmult_mod (Zpower_pos a p)); auto with zarith.
-  case (Zpower_pos a p mod n); auto.
-  intros p Rec n H1; rewrite <- Pplus_diag; auto.
-  repeat rewrite Zpower_pos_is_exp; auto.
-  repeat rewrite Rec; auto.
-  rewrite (Zmult_mod (Zpower_pos a p)); auto with zarith.
-  case (Zpower_pos a p mod n); auto.
-  unfold Zpower_pos; simpl; rewrite Zmult_1_r; auto with zarith.
+  intros Hn. induction m.
+  - rewrite Pos.xI_succ_xO at 2. rewrite <- Pos.add_1_r, <- Pos.add_diag.
+    rewrite 2 Zpower_pos_is_exp, Zpower_pos_1_r.
+    rewrite Z.mul_mod, (Z.mul_mod (Z.pow_pos a m)) by trivial.
+    rewrite <- IHm, <- Z.mul_mod by trivial.
+    simpl. now destruct (Zpow_mod_pos a m n).
+  - rewrite <- Pos.add_diag at 2.
+    rewrite Zpower_pos_is_exp.
+    rewrite Z.mul_mod by trivial.
+    rewrite <- IHm.
+    simpl. now destruct (Zpow_mod_pos a m n).
+  - now rewrite Zpower_pos_1_r.
 Qed.
 
-Theorem Zpow_mod_correct: forall a m n, 1 < n -> 0 <= m ->
- Zpow_mod a m n = (a ^ m) mod n.
+Theorem Zpow_mod_correct a m n :
+ n <> 0 -> Zpow_mod a m n = (a ^ m) mod n.
 Proof.
-  intros a m n; case m; simpl.
-  intros; apply sym_equal; apply Zmod_small; auto with zarith.
-  intros; apply Zpow_mod_pos_correct; auto with zarith.
-  intros p H H1; case H1; auto.
+  intros Hn. destruct m; simpl.
+  - trivial.
+  - apply Zpow_mod_pos_correct; auto with zarith.
+  - rewrite Z.mod_0_l; auto with zarith.
 Qed.
 
 (* Complements about power and number theory. *)
 
-Lemma Zpower_divide: forall p q, 0 < q -> (p | p ^ q).
+Lemma Zpower_divide p q : 0 < q -> (p | p ^ q).
 Proof.
-  intros p q H; exists (p ^(q - 1)).
-  pattern p at 3; rewrite <- (Zpower_1_r p); rewrite <- Zpower_exp; try f_equal; auto with zarith.
+  exists (p^(q - 1)).
+  rewrite Z.mul_comm, <- Z.pow_succ_r; f_equal; auto with zarith.
 Qed.
 
-Theorem rel_prime_Zpower_r: forall i p q, 0 < i ->
- rel_prime p q -> rel_prime p (q^i).
+Theorem rel_prime_Zpower_r i p q :
+ 0 <= i -> rel_prime p q -> rel_prime p (q^i).
 Proof.
-  intros i p q Hi Hpq; generalize Hi; pattern i; apply natlike_ind; auto with zarith; clear i Hi.
-  intros H; contradict H; auto with zarith.
-  intros i Hi Rec _; rewrite Zpower_Zsucc; auto.
+  intros Hi Hpq; pattern i; apply natlike_ind; auto with zarith.
+  simpl. apply rel_prime_sym, rel_prime_1.
+  clear i Hi. intros i Hi Rec; rewrite Z.pow_succ_r; auto.
   apply rel_prime_mult; auto.
-  case Zle_lt_or_eq with (1 := Hi); intros Hi1; subst; auto.
-  rewrite Zpower_0_r; apply rel_prime_sym; apply rel_prime_1.
 Qed.
 
-Theorem rel_prime_Zpower: forall i j p q, 0 <= i ->  0 <= j ->
- rel_prime p q -> rel_prime (p^i) (q^j).
+Theorem rel_prime_Zpower i j p q :
+ 0 <= i ->  0 <= j -> rel_prime p q -> rel_prime (p^i) (q^j).
 Proof.
-  intros i j p q Hi; generalize Hi j p q; pattern i; apply natlike_ind; auto with zarith; clear i Hi j p q.
-  intros _ j p q H H1; rewrite Zpower_0_r; apply rel_prime_1.
-  intros n Hn Rec _ j p q Hj Hpq.
-  rewrite Zpower_Zsucc; auto.
-  case Zle_lt_or_eq with (1 := Hj); intros Hj1; subst.
-  apply rel_prime_sym; apply rel_prime_mult; auto.
-  apply rel_prime_sym; apply rel_prime_Zpower_r; auto with arith.
-  apply rel_prime_sym; apply Rec; auto.
-  rewrite Zpower_0_r; apply rel_prime_sym; apply rel_prime_1.
+ intros Hi Hj H. apply rel_prime_Zpower_r; trivial.
+ apply rel_prime_sym. apply rel_prime_Zpower_r; trivial.
+ now apply rel_prime_sym.
 Qed.
 
-Theorem prime_power_prime: forall p q n, 0 <= n ->
- prime p -> prime q -> (p | q^n)  -> p = q.
+Theorem prime_power_prime p q n :
+ 0 <= n -> prime p -> prime q -> (p | q^n) -> p = q.
 Proof.
-  intros p q n Hn Hp Hq; pattern n; apply natlike_ind; auto; clear n Hn.
-  rewrite Zpower_0_r; intros.
-  assert (2<=p) by (apply prime_ge_2; auto).
-  assert (p<=1) by (apply Zdivide_le; auto with zarith).
-  omega.
-  intros n1 H H1.
-  unfold Zsucc; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith.
-  assert (2<=p) by (apply prime_ge_2; auto).
-  assert (2<=q) by (apply prime_ge_2; auto).
-  intros H3; case prime_mult with (2 := H3); auto.
-  intros; apply prime_div_prime; auto.
+  intros Hn Hp Hq; pattern n; apply natlike_ind; auto; clear n Hn.
+  - simpl; intros.
+    assert (2<=p) by (apply prime_ge_2; auto).
+    assert (p<=1) by (apply Z.divide_pos_le; auto with zarith).
+    omega.
+  - intros n Hn Rec.
+    rewrite Z.pow_succ_r by trivial. intros.
+    assert (2<=p) by (apply prime_ge_2; auto).
+    assert (2<=q) by (apply prime_ge_2; auto).
+    destruct prime_mult with (2 := H); auto.
+    apply prime_div_prime; auto.
 Qed.
 
-Theorem Zdivide_power_2: forall x p n, 0 <= n -> 0 <= x -> prime p ->
- (x | p^n) -> exists m, x = p^m.
+Theorem Zdivide_power_2 x p n :
+ 0 <= n -> 0 <= x -> prime p -> (x | p^n) -> exists m, x = p^m.
 Proof.
-  intros x p n Hn Hx; revert p n Hn; generalize Hx.
+  intros Hn Hx; revert p n Hn. generalize Hx.
   pattern x; apply Z_lt_induction; auto.
   clear x Hx; intros x IH Hx p n Hn Hp H.
-  case Zle_lt_or_eq with (1 := Hx); auto; clear Hx; intros Hx; subst.
-  case (Zle_lt_or_eq 1 x); auto with zarith; clear Hx; intros Hx; subst.
+  Z.le_elim Hx; subst.
+  apply Z.le_succ_l in Hx; simpl in Hx.
+  Z.le_elim Hx; subst.
   (* x > 1 *)
-  case (prime_dec x); intros H2.
-  exists 1; rewrite Zpower_1_r; apply prime_power_prime with n; auto.
-  case not_prime_divide with (2 := H2); auto.
-  intros p1 ((H3, H4), (q1, Hq1)); subst.
-  case (IH p1) with p n; auto with zarith.
-  apply Zdivide_trans with (2 := H); exists q1; auto with zarith.
-  intros r1 Hr1.
-  case (IH q1) with p n; auto with zarith.
-  case (Zle_lt_or_eq 0 q1).
-  apply Zmult_le_0_reg_r with p1; auto with zarith.
+  case (prime_dec x); intros Hpr.
+  exists 1; rewrite Z.pow_1_r; apply prime_power_prime with n; auto.
+  case not_prime_divide with (2 := Hpr); auto.
+  intros p1 ((Hp1, Hpq1),(q1,->)).
+  assert (Hq1 : 0 < q1) by (apply Z.mul_lt_mono_pos_r with p1; auto with zarith).
+  destruct (IH p1) with p n as (r1,Hr1); auto with zarith.
+  transitivity (q1 * p1); trivial. exists q1; auto with zarith.
+  destruct (IH q1) with p n as (r2,Hr2); auto with zarith.
   split; auto with zarith.
-  pattern q1 at 1; replace q1 with (q1 * 1); auto with zarith.
-  apply Zmult_lt_compat_l; auto with zarith.
-  intros H5; subst; contradict Hx; auto with zarith.
-  apply Zmult_le_0_reg_r with p1; auto with zarith.
-  apply Zdivide_trans with (2 := H); exists p1; auto with zarith.
-  intros r2 Hr2; exists (r2 + r1); subst.
-  apply sym_equal; apply Zpower_exp.
-  generalize Hx; case r2; simpl; auto with zarith.
-  intros; red; simpl; intros; discriminate.
-  generalize H3; case r1; simpl; auto with zarith.
-  intros; red; simpl; intros; discriminate.
+  rewrite <- (Z.mul_1_r q1) at 1.
+  apply Z.mul_lt_mono_pos_l; auto with zarith.
+  transitivity (q1 * p1); trivial. exists p1; auto with zarith.
+  exists (r2 + r1); subst.
+  symmetry. apply Z.pow_add_r.
+  generalize Hq1; case r2; now auto with zarith.
+  generalize Hp1; case r1; now auto with zarith.
   (* x = 1 *)
-  exists 0; rewrite Zpower_0_r; auto.
+  exists 0; rewrite Z.pow_0_r; auto.
   (* x = 0 *)
-  exists n; destruct H; rewrite Zmult_0_r in H; auto.
+  exists n; destruct H; rewrite Z.mul_0_r in H; auto.
 Qed.
 
-(** * Zsquare: a direct definition of [z^2] *)
-
-Fixpoint Psquare (p: positive): positive :=
-  match p with
-   | xH => xH
-   | xO p => xO (xO (Psquare p))
-   | xI p => xI (xO (Pplus (Psquare p) p))
-  end.
-
-Definition Zsquare p :=
-  match p with
-   | Z0 => Z0
-   | Zpos p => Zpos (Psquare p)
-   | Zneg p => Zpos (Psquare p)
-  end.
-
-Theorem Psquare_correct: forall p, Psquare p = (p * p)%positive.
-Proof.
-  induction p; simpl; auto; f_equal; rewrite IHp.
-  apply trans_equal with (xO p + xO (p*p))%positive; auto.
-  rewrite (Pplus_comm (xO p)); auto.
-  rewrite Pmult_xI_permute_r; rewrite Pplus_assoc.
-  f_equal; auto.
-  symmetry; apply Pplus_diag.
-  symmetry; apply Pmult_xO_permute_r.
-Qed.
+(** * Z.square: a direct definition of [z^2] *)
 
-Theorem Zsquare_correct: forall p, Zsquare p = p * p.
-Proof.
-  intro p; case p; simpl; auto; intros p1; rewrite Psquare_correct; auto.
-Qed.
+Notation Psquare := Pos.square (compat "8.3").
+Notation Zsquare := Z.square (compat "8.3").
+Notation Psquare_correct := Pos.square_spec (compat "8.3").
+Notation Zsquare_correct := Z.square_spec (compat "8.3").
diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v
index 038748b5..0d9b08d6 100644
--- a/theories/ZArith/Zpower.v
+++ b/theories/ZArith/Zpower.v
@@ -1,79 +1,89 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zpower.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
-Require Import Wf_nat.
-Require Import ZArith_base.
+Require Import Wf_nat ZArith_base Omega Zcomplements.
 Require Export Zpow_def.
-Require Import Omega.
-Require Import Zcomplements.
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
+
+(** * Power functions over [Z] *)
 
-Infix "^" := Zpower : Z_scope.
+(** Nota : this file is mostly deprecated. The definition of [Z.pow]
+    and its usual properties are now provided by module [BinInt.Z].
+    Powers of 2 are also available there (see [Z.shiftl] and [Z.shiftr]).
+    Only remain here:
+     - [Zpower_nat] : a power function with a [nat] exponent
+     - old-style powers of two, such as [two_p]
+     - [Zdiv_rest] : a division + modulo when the divisor is a power of 2
+*)
 
-(** * Definition of powers over [Z]*)
 
 (** [Zpower_nat z n] is the n-th power of [z] when [n] is an unary
     integer (type [nat]) and [z] a signed integer (type [Z]) *)
 
-Definition Zpower_nat (z:Z) (n:nat) := iter_nat n Z (fun x:Z => z * x) 1.
+Definition Zpower_nat (z:Z) (n:nat) := nat_iter n (Z.mul z) 1.
+
+Lemma Zpower_nat_0_r z : Zpower_nat z 0 = 1.
+Proof. reflexivity. Qed.
+
+Lemma Zpower_nat_succ_r n z : Zpower_nat z (S n) = z * (Zpower_nat z n).
+Proof. reflexivity. Qed.
 
 (** [Zpower_nat_is_exp] says [Zpower_nat] is a morphism for
-    [plus : nat->nat] and [Zmult : Z->Z] *)
+    [plus : nat->nat->nat] and [Z.mul : Z->Z->Z] *)
 
 Lemma Zpower_nat_is_exp :
   forall (n m:nat) (z:Z),
     Zpower_nat z (n + m) = Zpower_nat z n * Zpower_nat z m.
 Proof.
-  intros; elim n;
-   [ simpl in |- *; elim (Zpower_nat z m); auto with zarith
-     | unfold Zpower_nat in |- *; intros; simpl in |- *; rewrite H;
-       apply Zmult_assoc ].
+ induction n.
+ - intros. now rewrite Zpower_nat_0_r, Z.mul_1_l.
+ - intros. simpl. now rewrite 2 Zpower_nat_succ_r, IHn, Z.mul_assoc.
+Qed.
+
+(** Conversions between powers of unary and binary integers *)
+
+Lemma Zpower_pos_nat (z : Z) (p : positive) :
+  Z.pow_pos z p = Zpower_nat z (Pos.to_nat p).
+Proof.
+  apply Pos2Nat.inj_iter.
 Qed.
 
-(** This theorem shows that powers of unary and binary integers
-   are the same thing, modulo the function convert : [positive -> nat] *)
+Lemma Zpower_nat_Z (z : Z) (n : nat) :
+  Zpower_nat z n = z ^ (Z.of_nat n).
+Proof.
+ induction n. trivial.
+ rewrite Zpower_nat_succ_r, Nat2Z.inj_succ, Z.pow_succ_r.
+ now f_equal.
+ apply Nat2Z.is_nonneg.
+Qed.
 
-Lemma Zpower_pos_nat :
-  forall (z:Z) (p:positive), Zpower_pos z p = Zpower_nat z (nat_of_P p).
+Theorem Zpower_nat_Zpower z n : 0 <= n ->
+ z^n = Zpower_nat z (Z.abs_nat n).
 Proof.
-  intros; unfold Zpower_pos in |- *; unfold Zpower_nat in |- *;
-    apply iter_nat_of_P.
+ intros. now rewrite Zpower_nat_Z, Zabs2Nat.id_abs, Z.abs_eq.
 Qed.
 
-(** Using the theorem [Zpower_pos_nat] and the lemma [Zpower_nat_is_exp] we
-   deduce that the function [[n:positive](Zpower_pos z n)] is a morphism
-   for [add : positive->positive] and [Zmult : Z->Z] *)
+(** The function [(Z.pow_pos z)] is a morphism
+   for [Pos.add : positive->positive->positive] and [Z.mul : Z->Z->Z] *)
 
-Lemma Zpower_pos_is_exp :
-  forall (n m:positive) (z:Z),
-    Zpower_pos z (n + m) = Zpower_pos z n * Zpower_pos z m.
+Lemma Zpower_pos_is_exp (n m : positive)(z:Z) :
+  Z.pow_pos z (n + m) = Z.pow_pos z n * Z.pow_pos z m.
 Proof.
-  intros.
-  rewrite (Zpower_pos_nat z n).
-  rewrite (Zpower_pos_nat z m).
-  rewrite (Zpower_pos_nat z (n + m)).
-  rewrite (nat_of_P_plus_morphism n m).
-  apply Zpower_nat_is_exp.
+ now apply (Z.pow_add_r z (Zpos n) (Zpos m)).
 Qed.
 
 Hint Immediate Zpower_nat_is_exp Zpower_pos_is_exp : zarith.
-Hint Unfold Zpower_pos Zpower_nat: zarith.
+Hint Unfold Z.pow_pos Zpower_nat: zarith.
 
-Theorem Zpower_exp :
-  forall x n m:Z, n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m.
+Theorem Zpower_exp x n m :
+  n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m.
 Proof.
-  destruct n; destruct m; auto with zarith.
-  simpl; intros; apply Zred_factor0.
-  simpl; auto with zarith.
-  intros; compute in H0; elim H0; auto.
-  intros; compute in H; elim H; auto.
+ Z.swap_greater. apply Z.pow_add_r.
 Qed.
 
 Section Powers_of_2.
@@ -81,178 +91,137 @@ Section Powers_of_2.
   (** * Powers of 2 *)
 
   (** For the powers of two, that will be widely used, a more direct
-      calculus is possible. We will also prove some properties such
-      as [(x:positive) x < 2^x] that are true for all integers bigger
-      than 2 but more difficult to prove and useless. *)
-
-  (** [shift n m] computes [2^n * m], or [m] shifted by [n] positions *)
+      calculus is possible. [shift n m] computes [2^n * m], i.e.
+      [m] shifted by [n] positions *)
 
-  Definition shift_nat (n:nat) (z:positive) := iter_nat n positive xO z.
-  Definition shift_pos (n z:positive) := iter_pos n positive xO z.
+  Definition shift_nat (n:nat) (z:positive) := nat_iter n xO z.
+  Definition shift_pos (n z:positive) := Pos.iter n xO z.
   Definition shift (n:Z) (z:positive) :=
     match n with
       | Z0 => z
-      | Zpos p => iter_pos p positive xO z
+      | Zpos p => Pos.iter p xO z
       | Zneg p => z
     end.
 
   Definition two_power_nat (n:nat) := Zpos (shift_nat n 1).
   Definition two_power_pos (x:positive) := Zpos (shift_pos x 1).
 
-  Lemma two_power_nat_S :
-    forall n:nat, two_power_nat (S n) = 2 * two_power_nat n.
+  Definition two_p (x:Z) :=
+    match x with
+      | Z0 => 1
+      | Zpos y => two_power_pos y
+      | Zneg y => 0
+    end.
+
+  (** Equivalence with notions defined in BinInt *)
+
+  Lemma shift_nat_equiv n p : shift_nat n p = Pos.shiftl_nat p n.
+  Proof. reflexivity. Qed.
+
+  Lemma shift_pos_equiv n p : shift_pos n p = Pos.shiftl p (Npos n).
+  Proof. reflexivity. Qed.
+
+  Lemma shift_equiv n p : 0<=n -> Zpos (shift n p) = Z.shiftl (Zpos p) n.
   Proof.
-    intro; simpl in |- *; apply refl_equal.
+   destruct n.
+   - trivial.
+   - simpl; intros. now apply Pos.iter_swap_gen.
+   - now destruct 1.
   Qed.
 
-  Lemma shift_nat_plus :
-    forall (n m:nat) (x:positive),
-      shift_nat (n + m) x = shift_nat n (shift_nat m x).
+  Lemma two_power_nat_equiv n : two_power_nat n = 2 ^ (Z.of_nat n).
   Proof.
-    intros; unfold shift_nat in |- *; apply iter_nat_plus.
+   induction n.
+   - trivial.
+   - now rewrite Nat2Z.inj_succ, Z.pow_succ_r, <- IHn by apply Nat2Z.is_nonneg.
   Qed.
 
-  Theorem shift_nat_correct :
-    forall (n:nat) (x:positive), Zpos (shift_nat n x) = Zpower_nat 2 n * Zpos x.
+  Lemma two_power_pos_equiv p : two_power_pos p = 2 ^ Zpos p.
   Proof.
-    unfold shift_nat in |- *; simple induction n;
-      [ simpl in |- *; trivial with zarith
-	| intros; replace (Zpower_nat 2 (S n0)) with (2 * Zpower_nat 2 n0);
-	  [ rewrite <- Zmult_assoc; rewrite <- (H x); simpl in |- *; reflexivity
-	    | auto with zarith ] ].
+   now apply Pos.iter_swap_gen.
   Qed.
 
-  Theorem two_power_nat_correct :
-    forall n:nat, two_power_nat n = Zpower_nat 2 n.
+  Lemma two_p_equiv x : two_p x = 2 ^ x.
   Proof.
-    intro n.
-    unfold two_power_nat in |- *.
-    rewrite (shift_nat_correct n).
-    omega.
+   destruct x; trivial. apply two_power_pos_equiv.
   Qed.
 
-  (** Second we show that [two_power_pos] and [two_power_nat] are the same *)
-  Lemma shift_pos_nat :
-    forall p x:positive, shift_pos p x = shift_nat (nat_of_P p) x.
+  (** Properties of these old versions of powers of two *)
+
+  Lemma two_power_nat_S n : two_power_nat (S n) = 2 * two_power_nat n.
+  Proof. reflexivity. Qed.
+
+  Lemma shift_nat_plus n m x :
+    shift_nat (n + m) x = shift_nat n (shift_nat m x).
   Proof.
-    unfold shift_pos in |- *.
-    unfold shift_nat in |- *.
-    intros; apply iter_nat_of_P.
+   apply iter_nat_plus.
   Qed.
 
-  Lemma two_power_pos_nat :
-    forall p:positive, two_power_pos p = two_power_nat (nat_of_P p).
+  Theorem shift_nat_correct n x :
+    Zpos (shift_nat n x) = Zpower_nat 2 n * Zpos x.
   Proof.
-    intro; unfold two_power_pos in |- *; unfold two_power_nat in |- *.
-    apply f_equal with (f := Zpos).
-    apply shift_pos_nat.
+   induction n.
+   - trivial.
+   - now rewrite Zpower_nat_succ_r, <- Z.mul_assoc, <- IHn.
   Qed.
 
-  (** Then we deduce that [two_power_pos] is also correct *)
+  Theorem two_power_nat_correct n : two_power_nat n = Zpower_nat 2 n.
+  Proof.
+   now rewrite two_power_nat_equiv, Zpower_nat_Z.
+  Qed.
 
-  Theorem shift_pos_correct :
-    forall p x:positive, Zpos (shift_pos p x) = Zpower_pos 2 p * Zpos x.
+  Lemma shift_pos_nat p x : shift_pos p x = shift_nat (Pos.to_nat p) x.
   Proof.
-    intros.
-    rewrite (shift_pos_nat p x).
-    rewrite (Zpower_pos_nat 2 p).
-    apply shift_nat_correct.
+   apply Pos2Nat.inj_iter.
   Qed.
 
-  Theorem two_power_pos_correct :
-    forall x:positive, two_power_pos x = Zpower_pos 2 x.
+  Lemma two_power_pos_nat p : two_power_pos p = two_power_nat (Pos.to_nat p).
   Proof.
-    intro.
-    rewrite two_power_pos_nat.
-    rewrite Zpower_pos_nat.
-    apply two_power_nat_correct.
+   unfold two_power_pos. now rewrite shift_pos_nat.
   Qed.
 
-  (** Some consequences *)
+  Theorem shift_pos_correct p x :
+    Zpos (shift_pos p x) = Z.pow_pos 2 p * Zpos x.
+  Proof.
+   now rewrite shift_pos_nat, Zpower_pos_nat, shift_nat_correct.
+  Qed.
 
-  Theorem two_power_pos_is_exp :
-    forall x y:positive,
-      two_power_pos (x + y) = two_power_pos x * two_power_pos y.
+  Theorem two_power_pos_correct x : two_power_pos x = Z.pow_pos 2 x.
   Proof.
-    intros.
-    rewrite (two_power_pos_correct (x + y)).
-    rewrite (two_power_pos_correct x).
-    rewrite (two_power_pos_correct y).
-    apply Zpower_pos_is_exp.
+   apply two_power_pos_equiv.
   Qed.
 
-  (** The exponentiation [z -> 2^z] for [z] a signed integer.
-      For convenience, we assume that [2^z = 0] for all [z < 0]
-      We could also define a inductive type [Log_result] with
-      3 contructors [ Zero | Pos positive -> | minus_infty]
-      but it's more complexe and not so useful. *)
+  Theorem two_power_pos_is_exp x y :
+   two_power_pos (x + y) = two_power_pos x * two_power_pos y.
+  Proof.
+    rewrite 3 two_power_pos_equiv. now apply (Z.pow_add_r 2 (Zpos x) (Zpos y)).
+  Qed.
 
-  Definition two_p (x:Z) :=
-    match x with
-      | Z0 => 1
-      | Zpos y => two_power_pos y
-      | Zneg y => 0
-    end.
+  Lemma two_p_correct x : two_p x = 2^x.
+  Proof (two_p_equiv x).
 
-  Theorem two_p_is_exp :
-    forall x y:Z, 0 <= x -> 0 <= y -> two_p (x + y) = two_p x * two_p y.
+  Theorem two_p_is_exp x y :
+    0 <= x -> 0 <= y -> two_p (x + y) = two_p x * two_p y.
   Proof.
-    simple induction x;
-      [ simple induction y; simpl in |- *; auto with zarith
-	| simple induction y;
-	  [ unfold two_p in |- *; rewrite (Zmult_comm (two_power_pos p) 1);
-	    rewrite (Zmult_1_l (two_power_pos p)); auto with zarith
-	    | unfold Zplus in |- *; unfold two_p in |- *; intros;
-	      apply two_power_pos_is_exp
-	    | intros; unfold Zle in H0; unfold Zcompare in H0;
-	      absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ]
-	| simple induction y;
-	  [ simpl in |- *; auto with zarith
-	    | intros; unfold Zle in H; unfold Zcompare in H;
-	      absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith
-	    | intros; unfold Zle in H; unfold Zcompare in H;
-	      absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] ].
+    rewrite !two_p_equiv. apply Z.pow_add_r.
   Qed.
 
-  Lemma two_p_gt_ZERO : forall x:Z, 0 <= x -> two_p x > 0.
+  Lemma two_p_gt_ZERO x : 0 <= x -> two_p x > 0.
   Proof.
-    simple induction x; intros;
-      [ simpl in |- *; omega
-	| simpl in |- *; unfold two_power_pos in |- *; apply Zorder.Zgt_pos_0
-	| absurd (0 <= Zneg p);
-	  [ simpl in |- *; unfold Zle in |- *; unfold Zcompare in |- *;
-	    do 2 unfold not in |- *; auto with zarith
-	    | assumption ] ].
+   Z.swap_greater. rewrite two_p_equiv. now apply Z.pow_pos_nonneg.
   Qed.
 
-  Lemma two_p_S : forall x:Z, 0 <= x -> two_p (Zsucc x) = 2 * two_p x.
+  Lemma two_p_S x : 0 <= x -> two_p (Z.succ x) = 2 * two_p x.
   Proof.
-    intros; unfold Zsucc in |- *.
-    rewrite (two_p_is_exp x 1 H (Zorder.Zle_0_pos 1)).
-    apply Zmult_comm.
+   rewrite !two_p_equiv. now apply Z.pow_succ_r.
   Qed.
 
-  Lemma two_p_pred : forall x:Z, 0 <= x -> two_p (Zpred x) < two_p x.
+  Lemma two_p_pred x : 0 <= x -> two_p (Z.pred x) < two_p x.
   Proof.
-    intros; apply natlike_ind with (P := fun x:Z => two_p (Zpred x) < two_p x);
-      [ simpl in |- *; unfold Zlt in |- *; auto with zarith
-	| intros; elim (Zle_lt_or_eq 0 x0 H0);
-	  [ intros;
-	    replace (two_p (Zpred (Zsucc x0))) with (two_p (Zsucc (Zpred x0)));
-	      [ rewrite (two_p_S (Zpred x0));
-		[ rewrite (two_p_S x0); [ omega | assumption ]
-		  | apply Zorder.Zlt_0_le_0_pred; assumption ]
-		| rewrite <- (Zsucc_pred x0); rewrite <- (Zpred_succ x0);
-		  trivial with zarith ]
-	    | intro Hx0; rewrite <- Hx0; simpl in |- *; unfold Zlt in |- *;
-	      auto with zarith ]
-	| assumption ].
+   rewrite !two_p_equiv. intros. apply Z.pow_lt_mono_r; auto with zarith.
   Qed.
 
-  Lemma Zlt_lt_double : forall x y:Z, 0 <= x < y -> x < 2 * y.
-    intros; omega. Qed.
-
-  End Powers_of_2.
+End Powers_of_2.
 
 Hint Resolve two_p_gt_ZERO: zarith.
 Hint Immediate two_p_pred two_p_S: zarith.
@@ -261,100 +230,88 @@ Section power_div_with_rest.
 
   (** * Division by a power of two. *)
 
-  (** To [n:Z] and [p:positive], [q],[r] are associated such that
-      [n = 2^p.q + r] and [0 <= r < 2^p] *)
+  (** To [x:Z] and [p:positive], [q],[r] are associated such that
+      [x = 2^p.q + r] and [0 <= r < 2^p] *)
 
-  (** Invariant: [d*q + r = d'*q + r /\ d' = 2*d /\ 0<= r < d /\ 0 <= r' < d'] *)
+  (** Invariant: [d*q + r = d'*q + r /\ d' = 2*d /\ 0<=r<d /\ 0<=r'<d'] *)
   Definition Zdiv_rest_aux (qrd:Z * Z * Z) :=
-    let (qr, d) := qrd in
-      let (q, r) := qr in
-	(match q with
-	   | Z0 => (0, r)
-	   | Zpos xH => (0, d + r)
-	   | Zpos (xI n) => (Zpos n, d + r)
-	   | Zpos (xO n) => (Zpos n, r)
-	   | Zneg xH => (-1, d + r)
-	   | Zneg (xI n) => (Zneg n - 1, d + r)
-	   | Zneg (xO n) => (Zneg n, r)
-	 end, 2 * d).
+    let '(q,r,d) := qrd in
+      (match q with
+	 | Z0 => (0, r)
+	 | Zpos xH => (0, d + r)
+	 | Zpos (xI n) => (Zpos n, d + r)
+	 | Zpos (xO n) => (Zpos n, r)
+	 | Zneg xH => (-1, d + r)
+	 | Zneg (xI n) => (Zneg n - 1, d + r)
+	 | Zneg (xO n) => (Zneg n, r)
+       end, 2 * d).
 
   Definition Zdiv_rest (x:Z) (p:positive) :=
-    let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in qr.
+    let (qr, d) := Pos.iter p Zdiv_rest_aux (x, 0, 1) in qr.
 
-  Lemma Zdiv_rest_correct1 :
-    forall (x:Z) (p:positive),
-      let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in d = two_power_pos p.
+  Lemma Zdiv_rest_correct1 (x:Z) (p:positive) :
+    let (_, d) := Pos.iter p Zdiv_rest_aux (x, 0, 1) in
+    d = two_power_pos p.
   Proof.
-    intros x p; rewrite (iter_nat_of_P p _ Zdiv_rest_aux (x, 0, 1));
-      rewrite (two_power_pos_nat p); elim (nat_of_P p);
-	simpl in |- *;
-	  [ trivial with zarith
-	    | intro n; rewrite (two_power_nat_S n); unfold Zdiv_rest_aux at 2 in |- *;
-	      elim (iter_nat n (Z * Z * Z) Zdiv_rest_aux (x, 0, 1));
-		destruct a; intros; apply f_equal with (f := fun z:Z => 2 * z);
-		  assumption ].
+   rewrite Pos2Nat.inj_iter, two_power_pos_nat.
+   induction (Pos.to_nat p); simpl; trivial.
+   destruct (nat_iter n Zdiv_rest_aux (x,0,1)) as ((q,r),d).
+   unfold Zdiv_rest_aux. rewrite two_power_nat_S; now f_equal.
   Qed.
 
-  Lemma Zdiv_rest_correct2 :
-    forall (x:Z) (p:positive),
-      let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in
-	let (q, r) := qr in x = q * d + r /\ 0 <= r < d.
+  Lemma Zdiv_rest_correct2 (x:Z) (p:positive) :
+    let '(q,r,d) := Pos.iter p Zdiv_rest_aux (x, 0, 1) in
+    x = q * d + r /\ 0 <= r < d.
   Proof.
-    intros;
-      apply iter_pos_invariant with
-	(f := Zdiv_rest_aux)
-	(Inv := fun qrd:Z * Z * Z =>
-          let (qr, d) := qrd in
-            let (q, r) := qr in x = q * d + r /\ 0 <= r < d);
-	[ intro x0; elim x0; intro y0; elim y0; intros q r d;
-	  unfold Zdiv_rest_aux in |- *; elim q;
-	    [ omega
-	      | destruct p0;
-		[ rewrite BinInt.Zpos_xI; intro; elim H; intros; split;
-		  [ rewrite H0; rewrite Zplus_assoc; rewrite Zmult_plus_distr_l;
-		    rewrite Zmult_1_l; rewrite Zmult_assoc;
-		      rewrite (Zmult_comm (Zpos p0) 2); apply refl_equal
-		    | omega ]
-		  | rewrite BinInt.Zpos_xO; intro; elim H; intros; split;
-		    [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zpos p0) 2);
-		      apply refl_equal
-		      | omega ]
-		  | omega ]
-	      | destruct p0;
-		[ rewrite BinInt.Zneg_xI; unfold Zminus in |- *; intro; elim H; intros;
-		  split;
-		    [ rewrite H0; rewrite Zplus_assoc;
-		      apply f_equal with (f := fun z:Z => z + r);
-			do 2 rewrite Zmult_plus_distr_l; rewrite Zmult_assoc;
-			  rewrite (Zmult_comm (Zneg p0) 2); rewrite <- Zplus_assoc;
-			    apply f_equal with (f := fun z:Z => 2 * Zneg p0 * d + z);
-			      omega
-		      | omega ]
-		  | rewrite BinInt.Zneg_xO; unfold Zminus in |- *; intro; elim H; intros;
-		    split;
-		      [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zneg p0) 2);
-			apply refl_equal
-			| omega ]
-		  | omega ] ]
-	  | omega ].
+   apply Pos.iter_invariant; [|omega].
+   intros ((q,r),d) (H,H'). unfold Zdiv_rest_aux.
+   destruct q as [ |[q|q| ]|[q|q| ]]; try omega.
+   - rewrite Pos2Z.inj_xI, Z.mul_add_distr_r in H.
+     rewrite Z.mul_shuffle3, Z.mul_assoc. omega.
+   - rewrite Pos2Z.inj_xO in H.
+     rewrite Z.mul_shuffle3, Z.mul_assoc. omega.
+   - rewrite Pos2Z.neg_xI, Z.mul_sub_distr_r in H.
+     rewrite Z.mul_sub_distr_r, Z.mul_shuffle3, Z.mul_assoc. omega.
+   - rewrite Pos2Z.neg_xO in H.
+     rewrite Z.mul_shuffle3, Z.mul_assoc. omega.
   Qed.
 
+  (** Old-style rich specification by proof of existence *)
+
   Inductive Zdiv_rest_proofs (x:Z) (p:positive) : Set :=
     Zdiv_rest_proof :
     forall q r:Z,
       x = q * two_power_pos p + r ->
       0 <= r -> r < two_power_pos p -> Zdiv_rest_proofs x p.
 
-  Lemma Zdiv_rest_correct : forall (x:Z) (p:positive), Zdiv_rest_proofs x p.
+  Lemma Zdiv_rest_correct (x:Z) (p:positive) : Zdiv_rest_proofs x p.
   Proof.
-    intros x p.
     generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p).
-    elim (iter_pos p (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)).
-    simple induction a.
-    intros.
-    elim H; intros H1 H2; clear H.
-    rewrite H0 in H1; rewrite H0 in H2; elim H2; intros;
-      apply Zdiv_rest_proof with (q := a0) (r := b); assumption.
+    destruct (Pos.iter p Zdiv_rest_aux (x, 0, 1)) as ((q,r),d).
+    intros (H1,(H2,H3)) ->. now exists q r.
+  Qed.
+
+  (** Direct correctness of [Zdiv_rest] *)
+
+  Lemma Zdiv_rest_ok x p :
+    let (q,r) := Zdiv_rest x p in
+    x = q * 2^(Zpos p) + r /\ 0 <= r < 2^(Zpos p).
+  Proof.
+   unfold Zdiv_rest.
+   generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p).
+   destruct (Pos.iter p Zdiv_rest_aux (x, 0, 1)) as ((q,r),d).
+   intros H ->. now rewrite two_power_pos_equiv in H.
+  Qed.
+
+  (** Equivalence with [Z.shiftr] *)
+
+  Lemma Zdiv_rest_shiftr x p :
+   fst (Zdiv_rest x p) = Z.shiftr x (Zpos p).
+  Proof.
+   generalize (Zdiv_rest_ok x p). destruct (Zdiv_rest x p) as (q,r).
+   intros (H,H'). simpl.
+   rewrite Z.shiftr_div_pow2 by easy.
+   apply Z.div_unique_pos with r; trivial. now rewrite Z.mul_comm.
   Qed.
 
 End power_div_with_rest.
diff --git a/theories/ZArith/Zquot.v b/theories/ZArith/Zquot.v
new file mode 100644
index 00000000..c02f0ae6
--- /dev/null
+++ b/theories/ZArith/Zquot.v
@@ -0,0 +1,453 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Nnat ZArith_base ROmega ZArithRing Zdiv Morphisms.
+
+Local Open Scope Z_scope.
+
+(** This file provides results about the Round-Toward-Zero Euclidean
+  division [Z.quotrem], whose projections are [Z.quot] (noted ÷)
+  and [Z.rem].
+
+  This division and [Z.div] agree only on positive numbers.
+  Otherwise, [Z.div] performs Round-Toward-Bottom (a.k.a Floor).
+
+  This [Z.quot] is compatible with the division of usual
+  programming languages such as Ocaml. In addition, it has nicer
+  properties with respect to opposite and other usual operations.
+
+  The definition of this division is now in file [BinIntDef],
+  while most of the results about here are now in the main module
+  [BinInt.Z], thanks to the generic "Numbers" layer. Remain here:
+
+  - some compatibility notation for old names.
+
+  - some extra results with less preconditions (in particular
+      exploiting the arbitrary value of division by 0).
+*)
+
+Notation Ndiv_Zquot := N2Z.inj_quot (compat "8.3").
+Notation Nmod_Zrem := N2Z.inj_rem (compat "8.3").
+Notation Z_quot_rem_eq := Z.quot_rem' (compat "8.3").
+Notation Zrem_lt := Z.rem_bound_abs (compat "8.3").
+Notation Zquot_unique := Z.quot_unique (compat "8.3").
+Notation Zrem_unique := Z.rem_unique (compat "8.3").
+Notation Zrem_1_r := Z.rem_1_r (compat "8.3").
+Notation Zquot_1_r := Z.quot_1_r (compat "8.3").
+Notation Zrem_1_l := Z.rem_1_l (compat "8.3").
+Notation Zquot_1_l := Z.quot_1_l (compat "8.3").
+Notation Z_quot_same := Z.quot_same (compat "8.3").
+Notation Z_quot_mult := Z.quot_mul (compat "8.3").
+Notation Zquot_small := Z.quot_small (compat "8.3").
+Notation Zrem_small := Z.rem_small (compat "8.3").
+Notation Zquot2_quot := Zquot2_quot (compat "8.3").
+
+(** Particular values taken for [a÷0] and [(Z.rem a 0)].
+    We avise to not rely on these arbitrary values. *)
+
+Lemma Zquot_0_r a : a ÷ 0 = 0.
+Proof. now destruct a. Qed.
+
+Lemma Zrem_0_r a : Z.rem a 0 = a.
+Proof. now destruct a. Qed.
+
+(** The following results are expressed without the [b<>0] condition
+    whenever possible. *)
+
+Lemma Zrem_0_l a : Z.rem 0 a = 0.
+Proof. now destruct a. Qed.
+
+Lemma Zquot_0_l a : 0÷a = 0.
+Proof. now destruct a. Qed.
+
+Hint Resolve Zrem_0_l Zrem_0_r Zquot_0_l Zquot_0_r Z.quot_1_r Z.rem_1_r
+ : zarith.
+
+Ltac zero_or_not a :=
+  destruct (Z.eq_decidable a 0) as [->|?];
+  [rewrite ?Zquot_0_l, ?Zrem_0_l, ?Zquot_0_r, ?Zrem_0_r;
+   auto with zarith|].
+
+Lemma Z_rem_same a : Z.rem a a = 0.
+Proof. zero_or_not a. now apply Z.rem_same. Qed.
+
+Lemma Z_rem_mult a b : Z.rem (a*b) b = 0.
+Proof. zero_or_not b. now apply Z.rem_mul. Qed.
+
+(** * Division and Opposite *)
+
+(* The precise equalities that are invalid with "historic" Zdiv. *)
+
+Theorem Zquot_opp_l a b : (-a)÷b = -(a÷b).
+Proof. zero_or_not b. now apply Z.quot_opp_l. Qed.
+
+Theorem Zquot_opp_r a b : a÷(-b) = -(a÷b).
+Proof. zero_or_not b. now apply Z.quot_opp_r. Qed.
+
+Theorem Zrem_opp_l a b : Z.rem (-a) b = -(Z.rem a b).
+Proof. zero_or_not b. now apply Z.rem_opp_l. Qed.
+
+Theorem Zrem_opp_r a b : Z.rem a (-b) = Z.rem a b.
+Proof. zero_or_not b. now apply Z.rem_opp_r. Qed.
+
+Theorem Zquot_opp_opp a b : (-a)÷(-b) = a÷b.
+Proof. zero_or_not b. now apply Z.quot_opp_opp. Qed.
+
+Theorem Zrem_opp_opp a b : Z.rem (-a) (-b) = -(Z.rem a b).
+Proof. zero_or_not b. now apply Z.rem_opp_opp. Qed.
+
+(** The sign of the remainder is the one of [a]. Due to the possible
+   nullity of [a], a general result is to be stated in the following form:
+*)
+
+Theorem Zrem_sgn a b : 0 <= Z.sgn (Z.rem a b) * Z.sgn a.
+Proof.
+  zero_or_not b.
+  - apply Z.square_nonneg.
+  - zero_or_not (Z.rem a b).
+    rewrite Z.rem_sign_nz; trivial. apply Z.square_nonneg.
+Qed.
+
+(** This can also be said in a simplier way: *)
+
+Theorem Zrem_sgn2 a b : 0 <= (Z.rem a b) * a.
+Proof.
+  zero_or_not b.
+  - apply Z.square_nonneg.
+  - now apply Z.rem_sign_mul.
+Qed.
+
+(** Reformulation of [Z.rem_bound_abs] in 2 then 4 particular cases. *)
+
+Theorem Zrem_lt_pos a b : 0<=a -> b<>0 -> 0 <= Z.rem a b < Z.abs b.
+Proof.
+  intros; generalize (Z.rem_nonneg a b) (Z.rem_bound_abs a b);
+   romega with *.
+Qed.
+
+Theorem Zrem_lt_neg a b : a<=0 -> b<>0 -> -Z.abs b < Z.rem a b <= 0.
+Proof.
+  intros; generalize (Z.rem_nonpos a b) (Z.rem_bound_abs a b);
+   romega with *.
+Qed.
+
+Theorem Zrem_lt_pos_pos a b : 0<=a -> 0<b -> 0 <= Z.rem a b < b.
+Proof.
+  intros; generalize (Zrem_lt_pos a b); romega with *.
+Qed.
+
+Theorem Zrem_lt_pos_neg a b : 0<=a -> b<0 -> 0 <= Z.rem a b < -b.
+Proof.
+  intros; generalize (Zrem_lt_pos a b); romega with *.
+Qed.
+
+Theorem Zrem_lt_neg_pos a b : a<=0 -> 0<b -> -b < Z.rem a b <= 0.
+Proof.
+  intros; generalize (Zrem_lt_neg a b); romega with *.
+Qed.
+
+Theorem Zrem_lt_neg_neg a b : a<=0 -> b<0 -> b < Z.rem a b <= 0.
+Proof.
+  intros; generalize (Zrem_lt_neg a b); romega with *.
+Qed.
+
+
+(** * Unicity results *)
+
+Definition Remainder a b r :=
+  (0 <= a /\ 0 <= r < Z.abs b) \/ (a <= 0 /\ -Z.abs b < r <= 0).
+
+Definition Remainder_alt a b r :=
+  Z.abs r < Z.abs b /\ 0 <= r * a.
+
+Lemma Remainder_equiv : forall a b r,
+ Remainder a b r <-> Remainder_alt a b r.
+Proof.
+  unfold Remainder, Remainder_alt; intuition.
+  - romega with *.
+  - romega with *.
+  - rewrite <-(Z.mul_opp_opp). apply Z.mul_nonneg_nonneg; romega.
+  - assert (0 <= Z.sgn r * Z.sgn a).
+    { rewrite <-Z.sgn_mul, Z.sgn_nonneg; auto. }
+    destruct r; simpl Z.sgn in *; romega with *.
+Qed.
+
+Theorem Zquot_mod_unique_full a b q r :
+  Remainder a b r -> a = b*q + r -> q = a÷b /\ r = Z.rem a b.
+Proof.
+  destruct 1 as [(H,H0)|(H,H0)]; intros.
+  apply Zdiv_mod_unique with b; auto.
+  apply Zrem_lt_pos; auto.
+  romega with *.
+  rewrite <- H1; apply Z.quot_rem'.
+
+  rewrite <- (Z.opp_involutive a).
+  rewrite Zquot_opp_l, Zrem_opp_l.
+  generalize (Zdiv_mod_unique b (-q) (-a÷b) (-r) (Z.rem (-a) b)).
+  generalize (Zrem_lt_pos (-a) b).
+  rewrite <-Z.quot_rem', Z.mul_opp_r, <-Z.opp_add_distr, <-H1.
+  romega with *.
+Qed.
+
+Theorem Zquot_unique_full a b q r :
+  Remainder a b r -> a = b*q + r -> q = a÷b.
+Proof.
+ intros; destruct (Zquot_mod_unique_full a b q r); auto.
+Qed.
+
+Theorem Zrem_unique_full a b q r :
+  Remainder a b r -> a = b*q + r -> r = Z.rem a b.
+Proof.
+ intros; destruct (Zquot_mod_unique_full a b q r); auto.
+Qed.
+
+(** * Order results about Zrem and Zquot *)
+
+(* Division of positive numbers is positive. *)
+
+Lemma Z_quot_pos a b : 0 <= a -> 0 <= b -> 0 <= a÷b.
+Proof. intros. zero_or_not b. apply Z.quot_pos; auto with zarith. Qed.
+
+(** As soon as the divisor is greater or equal than 2,
+    the division is strictly decreasing. *)
+
+Lemma Z_quot_lt a b : 0 < a -> 2 <= b -> a÷b < a.
+Proof. intros. apply Z.quot_lt; auto with zarith. Qed.
+
+(** [<=] is compatible with a positive division. *)
+
+Lemma Z_quot_monotone a b c : 0<=c -> a<=b -> a÷c <= b÷c.
+Proof. intros. zero_or_not c. apply Z.quot_le_mono; auto with zarith. Qed.
+
+(** With our choice of division, rounding of (a÷b) is always done toward 0: *)
+
+Lemma Z_mult_quot_le a b : 0 <= a -> 0 <= b*(a÷b) <= a.
+Proof. intros. zero_or_not b. apply Z.mul_quot_le; auto with zarith. Qed.
+
+Lemma Z_mult_quot_ge a b : a <= 0 -> a <= b*(a÷b) <= 0.
+Proof. intros. zero_or_not b. apply Z.mul_quot_ge; auto with zarith. Qed.
+
+(** The previous inequalities between [b*(a÷b)] and [a] are exact
+    iff the modulo is zero. *)
+
+Lemma Z_quot_exact_full a b : a = b*(a÷b) <-> Z.rem a b = 0.
+Proof. intros. zero_or_not b. intuition. apply Z.quot_exact; auto. Qed.
+
+(** A modulo cannot grow beyond its starting point. *)
+
+Theorem Zrem_le a b : 0 <= a -> 0 <= b -> Z.rem a b <= a.
+Proof. intros. zero_or_not b. apply Z.rem_le; auto with zarith. Qed.
+
+(** Some additionnal inequalities about Zdiv. *)
+
+Theorem Zquot_le_upper_bound:
+  forall a b q, 0 < b -> a <= q*b -> a÷b <= q.
+Proof. intros a b q; rewrite Z.mul_comm; apply Z.quot_le_upper_bound. Qed.
+
+Theorem Zquot_lt_upper_bound:
+  forall a b q, 0 <= a -> 0 < b -> a < q*b -> a÷b < q.
+Proof. intros a b q; rewrite Z.mul_comm; apply Z.quot_lt_upper_bound. Qed.
+
+Theorem Zquot_le_lower_bound:
+  forall a b q, 0 < b -> q*b <= a -> q <= a÷b.
+Proof. intros a b q; rewrite Z.mul_comm; apply Z.quot_le_lower_bound. Qed.
+
+Theorem Zquot_sgn: forall a b,
+  0 <= Z.sgn (a÷b) * Z.sgn a * Z.sgn b.
+Proof.
+  destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith;
+  unfold Z.quot; simpl; destruct N.pos_div_eucl; simpl; destruct n; simpl; auto with zarith.
+Qed.
+
+(** * Relations between usual operations and Zmod and Zdiv *)
+
+(** First, a result that used to be always valid with Zdiv,
+    but must be restricted here.
+    For instance, now (9+(-5)*2) rem 2 = -1 <> 1 = 9 rem 2 *)
+
+Lemma Z_rem_plus : forall a b c:Z,
+ 0 <= (a+b*c) * a ->
+ Z.rem (a + b * c) c = Z.rem a c.
+Proof. intros. zero_or_not c. apply Z.rem_add; auto with zarith. Qed.
+
+Lemma Z_quot_plus : forall a b c:Z,
+ 0 <= (a+b*c) * a -> c<>0 ->
+ (a + b * c) ÷ c = a ÷ c + b.
+Proof. intros. apply Z.quot_add; auto with zarith. Qed.
+
+Theorem Z_quot_plus_l: forall a b c : Z,
+ 0 <= (a*b+c)*c -> b<>0 ->
+ b<>0 -> (a * b + c) ÷ b = a + c ÷ b.
+Proof. intros. apply Z.quot_add_l; auto with zarith. Qed.
+
+(** Cancellations. *)
+
+Lemma Zquot_mult_cancel_r : forall a b c:Z,
+ c<>0 -> (a*c)÷(b*c) = a÷b.
+Proof. intros. zero_or_not b. apply Z.quot_mul_cancel_r; auto. Qed.
+
+Lemma Zquot_mult_cancel_l : forall a b c:Z,
+ c<>0 -> (c*a)÷(c*b) = a÷b.
+Proof.
+ intros. rewrite (Z.mul_comm c b). zero_or_not b.
+ rewrite (Z.mul_comm b c). apply Z.quot_mul_cancel_l; auto.
+Qed.
+
+Lemma Zmult_rem_distr_l: forall a b c,
+  Z.rem (c*a) (c*b) = c * (Z.rem a b).
+Proof.
+ intros. zero_or_not c. rewrite (Z.mul_comm c b). zero_or_not b.
+ rewrite (Z.mul_comm b c). apply Z.mul_rem_distr_l; auto.
+Qed.
+
+Lemma Zmult_rem_distr_r: forall a b c,
+  Z.rem (a*c) (b*c) = (Z.rem a b) * c.
+Proof.
+ intros. zero_or_not b. rewrite (Z.mul_comm b c). zero_or_not c.
+ rewrite (Z.mul_comm c b). apply Z.mul_rem_distr_r; auto.
+Qed.
+
+(** Operations modulo. *)
+
+Theorem Zrem_rem: forall a n, Z.rem (Z.rem a n) n = Z.rem a n.
+Proof. intros. zero_or_not n. apply Z.rem_rem; auto. Qed.
+
+Theorem Zmult_rem: forall a b n,
+ Z.rem (a * b) n = Z.rem (Z.rem a n * Z.rem b n) n.
+Proof. intros. zero_or_not n. apply Z.mul_rem; auto. Qed.
+
+(** addition and modulo
+
+  Generally speaking, unlike with Zdiv, we don't have
+       (a+b) rem n = (a rem n + b rem n) rem n
+  for any a and b.
+  For instance, take (8 + (-10)) rem 3 = -2 whereas
+  (8 rem 3 + (-10 rem 3)) rem 3 = 1. *)
+
+Theorem Zplus_rem: forall a b n,
+ 0 <= a * b ->
+ Z.rem (a + b) n = Z.rem (Z.rem a n + Z.rem b n) n.
+Proof. intros. zero_or_not n. apply Z.add_rem; auto. Qed.
+
+Lemma Zplus_rem_idemp_l: forall a b n,
+ 0 <= a * b ->
+ Z.rem (Z.rem a n + b) n = Z.rem (a + b) n.
+Proof. intros. zero_or_not n. apply Z.add_rem_idemp_l; auto. Qed.
+
+Lemma Zplus_rem_idemp_r: forall a b n,
+ 0 <= a*b ->
+ Z.rem (b + Z.rem a n) n = Z.rem (b + a) n.
+Proof.
+ intros. zero_or_not n. apply Z.add_rem_idemp_r; auto.
+ rewrite Z.mul_comm; auto.
+Qed.
+
+Lemma Zmult_rem_idemp_l: forall a b n, Z.rem (Z.rem a n * b) n = Z.rem (a * b) n.
+Proof. intros. zero_or_not n. apply Z.mul_rem_idemp_l; auto. Qed.
+
+Lemma Zmult_rem_idemp_r: forall a b n, Z.rem (b * Z.rem a n) n = Z.rem (b * a) n.
+Proof. intros. zero_or_not n. apply Z.mul_rem_idemp_r; auto. Qed.
+
+(** Unlike with Zdiv, the following result is true without restrictions. *)
+
+Lemma Zquot_Zquot : forall a b c, (a÷b)÷c = a÷(b*c).
+Proof.
+ intros. zero_or_not b. rewrite Z.mul_comm. zero_or_not c.
+ rewrite Z.mul_comm. apply Z.quot_quot; auto.
+Qed.
+
+(** A last inequality: *)
+
+Theorem Zquot_mult_le:
+ forall a b c, 0<=a -> 0<=b -> 0<=c -> c*(a÷b) <= (c*a)÷b.
+Proof. intros. zero_or_not b. apply Z.quot_mul_le; auto with zarith. Qed.
+
+(** Z.rem is related to divisibility (see more in Znumtheory) *)
+
+Lemma Zrem_divides : forall a b,
+ Z.rem a b = 0 <-> exists c, a = b*c.
+Proof.
+ intros. zero_or_not b. firstorder.
+ rewrite Z.rem_divide; trivial.
+ split; intros (c,Hc); exists c; subst; auto with zarith.
+Qed.
+
+(** Particular case : dividing by 2 is related with parity *)
+
+Lemma Zquot2_odd_remainder : forall a,
+ Remainder a 2 (if Z.odd a then Z.sgn a else 0).
+Proof.
+ intros [ |p|p]. simpl.
+ left. simpl. auto with zarith.
+ left. destruct p; simpl; auto with zarith.
+ right. destruct p; simpl; split; now auto with zarith.
+Qed.
+
+Lemma Zrem_odd : forall a, Z.rem a 2 = if Z.odd a then Z.sgn a else 0.
+Proof.
+ intros. symmetry.
+ apply Zrem_unique_full with (Z.quot2 a).
+ apply Zquot2_odd_remainder.
+ apply Zquot2_odd_eqn.
+Qed.
+
+Lemma Zrem_even : forall a, Z.rem a 2 = if Z.even a then 0 else Z.sgn a.
+Proof.
+ intros a. rewrite Zrem_odd, Zodd_even_bool. now destruct Z.even.
+Qed.
+
+Lemma Zeven_rem : forall a, Z.even a = Z.eqb (Z.rem a 2) 0.
+Proof.
+ intros a. rewrite Zrem_even.
+ destruct a as [ |p|p]; trivial; now destruct p.
+Qed.
+
+Lemma Zodd_rem : forall a, Z.odd a = negb (Z.eqb (Z.rem a 2) 0).
+Proof.
+ intros a. rewrite Zrem_odd.
+ destruct a as [ |p|p]; trivial; now destruct p.
+Qed.
+
+(** * Interaction with "historic" Zdiv *)
+
+(** They agree at least on positive numbers: *)
+
+Theorem Zquotrem_Zdiv_eucl_pos : forall a b:Z, 0 <= a -> 0 < b ->
+  a÷b = a/b /\ Z.rem a b = a mod b.
+Proof.
+  intros.
+  apply Zdiv_mod_unique with b.
+  apply Zrem_lt_pos; auto with zarith.
+  rewrite Z.abs_eq; auto with *; apply Z_mod_lt; auto with *.
+  rewrite <- Z_div_mod_eq; auto with *.
+  symmetry; apply Z.quot_rem; auto with *.
+Qed.
+
+Theorem Zquot_Zdiv_pos : forall a b, 0 <= a -> 0 <= b ->
+  a÷b = a/b.
+Proof.
+ intros a b Ha Hb. Z.le_elim Hb.
+ - generalize (Zquotrem_Zdiv_eucl_pos a b Ha Hb); intuition.
+ - subst; now rewrite Zquot_0_r, Zdiv_0_r.
+Qed.
+
+Theorem Zrem_Zmod_pos : forall a b, 0 <= a -> 0 < b ->
+  Z.rem a b = a mod b.
+Proof.
+ intros a b Ha Hb; generalize (Zquotrem_Zdiv_eucl_pos a b Ha Hb);
+ intuition.
+Qed.
+
+(** Modulos are null at the same places *)
+
+Theorem Zrem_Zmod_zero : forall a b, b<>0 ->
+ (Z.rem a b = 0 <-> a mod b = 0).
+Proof.
+ intros.
+ rewrite Zrem_divides, Zmod_divides; intuition.
+Qed.
diff --git a/theories/ZArith/Zsqrt.v b/theories/ZArith/Zsqrt_compat.v
index 1a67bbb2..a6c83241 100644
--- a/theories/ZArith/Zsqrt.v
+++ b/theories/ZArith/Zsqrt_compat.v
@@ -1,17 +1,26 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Zsqrt.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Import ZArithRing.
 Require Import Omega.
 Require Export ZArith_base.
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
+
+(**  THIS FILE IS DEPRECATED
+
+    Instead of the various [Zsqrt] defined here, please use rather
+    [Z.sqrt] (or [Z.sqrtrem]). The latter are pure functions without
+    proof parts, and more results are available about them.
+    Some equivalence proofs between the old and the new versions
+    can be found below. Importing ZArith will provides by default
+    the new versions.
+
+*)
 
 (**********************************************************************)
 (** Definition and properties of square root on Z *)
@@ -23,12 +32,12 @@ Ltac compute_POS :=
     |  |- context [(Zpos (xI ?X1))] =>
       match constr:X1 with
 	| context [1%positive] => fail 1
-	| _ => rewrite (BinInt.Zpos_xI X1)
+	| _ => rewrite (Pos2Z.inj_xI X1)
       end
     |  |- context [(Zpos (xO ?X1))] =>
       match constr:X1 with
 	| context [1%positive] => fail 1
-	| _ => rewrite (BinInt.Zpos_xO X1)
+	| _ => rewrite (Pos2Z.inj_xO X1)
       end
   end.
 
@@ -106,7 +115,7 @@ Definition Zsqrt :
           fun h =>
             match sqrtrempos p with
               | c_sqrt s r Heq Hint =>
-		existS
+		existT
                 (fun s:Z =>
                   {r : Z |
                     Zpos p = s * s + r /\ s * s <= Zpos p < (s + 1) * (s + 1)})
@@ -122,10 +131,10 @@ Definition Zsqrt :
             {s : Z &
               {r : Z |
 		Zneg p = s * s + r /\ s * s <= Zneg p < (s + 1) * (s + 1)}}
-            (h (refl_equal Datatypes.Gt))
+            (h (eq_refl Datatypes.Gt))
 	| Z0 =>
           fun h =>
-            existS
+            existT
             (fun s:Z =>
               {r : Z | 0 = s * s + r /\ s * s <= 0 < (s + 1) * (s + 1)}) 0
             (exist
@@ -140,8 +149,8 @@ Defined.
 Definition Zsqrt_plain (x:Z) : Z :=
   match x with
     | Zpos p =>
-      match Zsqrt (Zpos p) (Zorder.Zle_0_pos p) with
-	| existS s _ => s
+      match Zsqrt (Zpos p) (Pos2Z.is_nonneg p) with
+	| existT s _ => s
       end
     | Zneg p => 0
     | Z0 => 0
@@ -155,12 +164,11 @@ Theorem Zsqrt_interval :
     Zsqrt_plain n * Zsqrt_plain n <= n <
     (Zsqrt_plain n + 1) * (Zsqrt_plain n + 1).
 Proof.
-  intros x; case x.
-  unfold Zsqrt_plain in |- *; omega.
-  intros p; unfold Zsqrt_plain in |- *;
-    case (Zsqrt (Zpos p) (Zorder.Zle_0_pos p)).
-  intros s [r [Heq Hint]] Hle; assumption.
-  intros p Hle; elim Hle; auto.
+  intros [|p|p] Hp.
+  - now compute.
+  - unfold Zsqrt_plain.
+    now destruct Zsqrt as (s & r & Heq & Hint).
+  - now elim Hp.
 Qed.
 
 (** Positivity *)
@@ -168,9 +176,9 @@ Qed.
 Theorem Zsqrt_plain_is_pos: forall n, 0 <= n ->  0 <= Zsqrt_plain n.
 Proof.
   intros n m; case (Zsqrt_interval n); auto with zarith.
-  intros H1 H2; case (Zle_or_lt 0 (Zsqrt_plain n)); auto.
-  intros H3; contradict H2; auto; apply Zle_not_lt.
-  apply Zle_trans with ( 2 := H1 ).
+  intros H1 H2; case (Z.le_gt_cases 0 (Zsqrt_plain n)); auto.
+  intros H3; contradict H2; auto; apply Z.le_ngt.
+  apply Z.le_trans with ( 2 := H1 ).
   replace ((Zsqrt_plain n + 1) * (Zsqrt_plain n + 1))
      with (Zsqrt_plain n * Zsqrt_plain n + (2 * Zsqrt_plain n + 1));
   auto with zarith.
@@ -185,13 +193,13 @@ Proof.
   generalize (Zsqrt_plain_is_pos (a * a)); auto with zarith; intros Haa.
   case (Zsqrt_interval (a * a)); auto with zarith.
   intros H1 H2.
-  case (Zle_or_lt a (Zsqrt_plain (a * a))); intros H3; auto.
-  case Zle_lt_or_eq with (1:=H3); auto; clear H3; intros H3.
-  contradict H1; auto; apply Zlt_not_le; auto with zarith.
-  apply Zle_lt_trans with (a * Zsqrt_plain (a * a)); auto with zarith.
-  apply Zmult_lt_compat_r; auto with zarith.
-  contradict H2; auto; apply Zle_not_lt; auto with zarith.
-  apply Zmult_le_compat; auto with zarith.
+  case (Z.le_gt_cases a (Zsqrt_plain (a * a))); intros H3.
+  - Z.le_elim H3; auto.
+    contradict H1; auto; apply Z.lt_nge; auto with zarith.
+    apply Z.le_lt_trans with (a * Zsqrt_plain (a * a)); auto with zarith.
+    apply Z.mul_lt_mono_pos_r; auto with zarith.
+  - contradict H2; auto; apply Z.le_ngt; auto with zarith.
+    apply Z.mul_le_mono_nonneg; auto with zarith.
 Qed.
 
 (** [Zsqrt_plain] is increasing *)
@@ -199,17 +207,26 @@ Qed.
 Theorem Zsqrt_le:
  forall p q, 0 <= p <= q  ->  Zsqrt_plain p <= Zsqrt_plain q.
 Proof.
-  intros p q [H1 H2]; case Zle_lt_or_eq with (1:=H2); clear H2; intros H2;
-  [ | subst q; auto with zarith].
-  case (Zle_or_lt (Zsqrt_plain p) (Zsqrt_plain q)); auto; intros H3.
+  intros p q [H1 H2].
+  Z.le_elim H2; [ | subst q; auto with zarith].
+  case (Z.le_gt_cases (Zsqrt_plain p) (Zsqrt_plain q)); auto; intros H3.
   assert (Hp: (0 <= Zsqrt_plain q)).
-   apply Zsqrt_plain_is_pos; auto with zarith.
+  { apply Zsqrt_plain_is_pos; auto with zarith. }
   absurd (q <= p); auto with zarith.
-  apply Zle_trans with ((Zsqrt_plain q + 1) * (Zsqrt_plain q + 1)).
+  apply Z.le_trans with ((Zsqrt_plain q + 1) * (Zsqrt_plain q + 1)).
   case (Zsqrt_interval q); auto with zarith.
-  apply Zle_trans with (Zsqrt_plain p * Zsqrt_plain p); auto with zarith.
-  apply Zmult_le_compat; auto with zarith.
+  apply Z.le_trans with (Zsqrt_plain p * Zsqrt_plain p); auto with zarith.
+  apply Z.mul_le_mono_nonneg; auto with zarith.
   case (Zsqrt_interval p); auto with zarith.
 Qed.
 
 
+(** Equivalence between Zsqrt_plain and [Z.sqrt] *)
+
+Lemma Zsqrt_equiv : forall n, Zsqrt_plain n = Z.sqrt n.
+Proof.
+ intros. destruct (Z_le_gt_dec 0 n).
+ symmetry. apply Z.sqrt_unique; trivial.
+ now apply Zsqrt_interval.
+ now destruct n.
+Qed.
\ No newline at end of file
diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v
index 53f167e8..e07fc715 100644
--- a/theories/ZArith/Zwf.v
+++ b/theories/ZArith/Zwf.v
@@ -1,17 +1,15 @@
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Zwf.v 14641 2011-11-06 11:59:10Z herbelin $ *)
-
 Require Import ZArith_base.
 Require Export Wf_nat.
 Require Import Omega.
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 (** Well-founded relations on Z. *)
 
@@ -31,28 +29,28 @@ Section wf_proof.
   (** The proof of well-foundness is classic: we do the proof by induction
       on a measure in nat, which is here [|x-c|] *)
 
-  Let f (z:Z) := Zabs_nat (z - c).
+  Let f (z:Z) := Z.abs_nat (z - c).
 
   Lemma Zwf_well_founded : well_founded (Zwf c).
-    red in |- *; intros.
+    red; intros.
     assert (forall (n:nat) (a:Z), (f a < n)%nat \/ a < c -> Acc (Zwf c) a).
     clear a; simple induction n; intros.
   (** n= 0 *)
     case H; intros.
     case (lt_n_O (f a)); auto.
-    apply Acc_intro; unfold Zwf in |- *; intros.
+    apply Acc_intro; unfold Zwf; intros.
     assert False; omega || contradiction.
   (** inductive case *)
     case H0; clear H0; intro; auto.
     apply Acc_intro; intros.
     apply H.
     unfold Zwf in H1.
-    case (Zle_or_lt c y); intro; auto with zarith.
+    case (Z.le_gt_cases c y); intro; auto with zarith.
     left.
     red in H0.
     apply lt_le_trans with (f a); auto with arith.
-    unfold f in |- *.
-    apply Zabs.Zabs_nat_lt; omega.
+    unfold f.
+    apply Zabs2Nat.inj_lt; omega.
     apply (H (S (f a))); auto.
   Qed.
 
@@ -77,18 +75,15 @@ Section wf_proof_up.
   (** The proof of well-foundness is classic: we do the proof by induction
       on a measure in nat, which is here [|c-x|] *)
 
-  Let f (z:Z) := Zabs_nat (c - z).
+  Let f (z:Z) := Z.abs_nat (c - z).
 
   Lemma Zwf_up_well_founded : well_founded (Zwf_up c).
   Proof.
     apply well_founded_lt_compat with (f := f).
-    unfold Zwf_up, f in |- *.
+    unfold Zwf_up, f.
     intros.
-    apply Zabs.Zabs_nat_lt.
-    unfold Zminus in |- *. split.
-    apply Zle_left; intuition.
-    apply Zplus_lt_compat_l; unfold Zlt in |- *; rewrite <- Zcompare_opp;
-      intuition.
+    apply Zabs2Nat.inj_lt; try (apply Z.le_0_sub; intuition).
+    now apply Z.sub_lt_mono_l.
   Qed.
 
 End wf_proof_up.
diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v
index ade35bef..af7d5a2e 100644
--- a/theories/ZArith/auxiliary.v
+++ b/theories/ZArith/auxiliary.v
@@ -1,14 +1,12 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: auxiliary.v 14641 2011-11-06 11:59:10Z herbelin $ i*)
-
 (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
 
 Require Export Arith_base.
@@ -18,96 +16,79 @@ Require Import Decidable.
 Require Import Peano_dec.
 Require Export Compare_dec.
 
-Open Local Scope Z_scope.
+Local Open Scope Z_scope.
 
 (***************************************************************)
 (** * Moving terms from one side to the other of an inequality *)
 
-Theorem Zne_left : forall n m:Z, Zne n m -> Zne (n + - m) 0.
+Theorem Zne_left n m : Zne n m -> Zne (n + - m) 0.
 Proof.
-  intros x y; unfold Zne in |- *; unfold not in |- *; intros H1 H2; apply H1;
-    apply Zplus_reg_l with (- y); rewrite Zplus_opp_l;
-      rewrite Zplus_comm; trivial with arith.
+ unfold Zne. now rewrite <- Z.sub_move_0_r.
 Qed.
 
-Theorem Zegal_left : forall n m:Z, n = m -> n + - m = 0.
+Theorem Zegal_left n m : n = m -> n + - m = 0.
 Proof.
-  intros x y H; apply (Zplus_reg_l y); rewrite Zplus_permute;
-    rewrite Zplus_opp_r; do 2 rewrite Zplus_0_r; assumption.
+ apply Z.sub_move_0_r.
 Qed.
 
-Theorem Zle_left : forall n m:Z, n <= m -> 0 <= m + - n.
+Theorem Zle_left n m : n <= m -> 0 <= m + - n.
 Proof.
-  intros x y H; replace 0 with (x + - x).
-  apply Zplus_le_compat_r; trivial.
-  apply Zplus_opp_r.
+ apply Z.le_0_sub.
 Qed.
 
-Theorem Zle_left_rev : forall n m:Z, 0 <= m + - n -> n <= m.
+Theorem Zle_left_rev n m : 0 <= m + - n -> n <= m.
 Proof.
-  intros x y H; apply Zplus_le_reg_r with (- x).
-  rewrite Zplus_opp_r; trivial.
+ apply Z.le_0_sub.
 Qed.
 
-Theorem Zlt_left_rev : forall n m:Z, 0 < m + - n -> n < m.
+Theorem Zlt_left_rev n m : 0 < m + - n -> n < m.
 Proof.
-  intros x y H; apply Zplus_lt_reg_r with (- x).
-  rewrite Zplus_opp_r; trivial.
+ apply Z.lt_0_sub.
 Qed.
 
-Theorem Zlt_left : forall n m:Z, n < m -> 0 <= m + -1 + - n.
+Theorem Zlt_left_lt n m : n < m -> 0 < m + - n.
 Proof.
-  intros x y H; apply Zle_left; apply Zsucc_le_reg;
-    change (Zsucc x <= Zsucc (Zpred y)) in |- *; rewrite <- Zsucc_pred;
-      apply Zlt_le_succ; assumption.
+ apply Z.lt_0_sub.
 Qed.
 
-Theorem Zlt_left_lt : forall n m:Z, n < m -> 0 < m + - n.
+Theorem Zlt_left n m : n < m -> 0 <= m + -1 + - n.
 Proof.
-  intros x y H; replace 0 with (x + - x).
-  apply Zplus_lt_compat_r; trivial.
-  apply Zplus_opp_r.
+ intros. rewrite Z.add_shuffle0. change (-1) with (- Z.succ 0).
+ now apply Z.le_0_sub, Z.le_succ_l, Z.lt_0_sub.
 Qed.
 
-Theorem Zge_left : forall n m:Z, n >= m -> 0 <= n + - m.
+Theorem Zge_left n m : n >= m -> 0 <= n + - m.
 Proof.
-  intros x y H; apply Zle_left; apply Zge_le; assumption.
+ Z.swap_greater. apply Z.le_0_sub.
 Qed.
 
-Theorem Zgt_left : forall n m:Z, n > m -> 0 <= n + -1 + - m.
+Theorem Zgt_left n m : n > m -> 0 <= n + -1 + - m.
 Proof.
-  intros x y H; apply Zlt_left; apply Zgt_lt; assumption.
+ Z.swap_greater. apply Zlt_left.
 Qed.
 
-Theorem Zgt_left_gt : forall n m:Z, n > m -> n + - m > 0.
+Theorem Zgt_left_gt n m : n > m -> n + - m > 0.
 Proof.
-  intros x y H; replace 0 with (y + - y).
-  apply Zplus_gt_compat_r; trivial.
-  apply Zplus_opp_r.
+ Z.swap_greater. apply Z.lt_0_sub.
 Qed.
 
-Theorem Zgt_left_rev : forall n m:Z, n + - m > 0 -> n > m.
+Theorem Zgt_left_rev n m : n + - m > 0 -> n > m.
 Proof.
-  intros x y H; apply Zplus_gt_reg_r with (- y).
-  rewrite Zplus_opp_r; trivial.
+ Z.swap_greater. apply Z.lt_0_sub.
 Qed.
 
-Theorem Zle_mult_approx :
-  forall n m p:Z, n > 0 -> p > 0 -> 0 <= m -> 0 <= m * n + p.
+Theorem Zle_mult_approx n m p :
+  n > 0 -> p > 0 -> 0 <= m -> 0 <= m * n + p.
 Proof.
-  intros x y z H1 H2 H3; apply Zle_trans with (m := y * x);
-    [ apply Zmult_gt_0_le_0_compat; assumption
-      | pattern (y * x) at 1 in |- *; rewrite <- Zplus_0_r;
-	apply Zplus_le_compat_l; apply Zlt_le_weak; apply Zgt_lt;
-	  assumption ].
+ Z.swap_greater. intros. Z.order_pos.
 Qed.
 
-Theorem Zmult_le_approx :
-  forall n m p:Z, n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m.
+Theorem Zmult_le_approx n m p :
+  n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m.
 Proof.
-  intros x y z H1 H2 H3; apply Zlt_succ_le; apply Zmult_gt_0_lt_0_reg_r with x;
-    [ assumption
-      | apply Zle_lt_trans with (1 := H3); rewrite <- Zmult_succ_l_reverse;
-	apply Zplus_lt_compat_l; apply Zgt_lt; assumption ].
+ Z.swap_greater. intros. apply Z.lt_succ_r.
+ apply Z.mul_pos_cancel_r with n; trivial. Z.nzsimpl.
+ apply Z.le_lt_trans with (m*n+p); trivial.
+ now apply Z.add_lt_mono_l.
 Qed.
 
diff --git a/theories/ZArith/vo.itarget b/theories/ZArith/vo.itarget
index 3efa7055..88751cc0 100644
--- a/theories/ZArith/vo.itarget
+++ b/theories/ZArith/vo.itarget
@@ -1,4 +1,5 @@
 auxiliary.vo
+BinIntDef.vo
 BinInt.vo
 Int.vo
 Wf_Z.vo
@@ -13,6 +14,7 @@ Zcomplements.vo
 Zdiv.vo
 Zeven.vo
 Zgcd_alt.vo
+Zpow_alt.vo
 Zhints.vo
 Zlogarithm.vo
 Zmax.vo
@@ -23,10 +25,11 @@ Znat.vo
 Znumtheory.vo
 ZOdiv_def.vo
 ZOdiv.vo
+Zquot.vo
 Zorder.vo
 Zpow_def.vo
 Zpower.vo
 Zpow_facts.vo
-Zsqrt.vo
+Zsqrt_compat.vo
 Zwf.vo
-ZOrderedType.vo
+Zeuclid.vo
diff --git a/theories/theories.itarget b/theories/theories.itarget
index afc3554b..3a87d8cf 100644
--- a/theories/theories.itarget
+++ b/theories/theories.itarget
@@ -6,7 +6,9 @@ MSets/vo.otarget
 Structures/vo.otarget
 Init/vo.otarget
 Lists/vo.otarget
+Vectors/vo.otarget
 Logic/vo.otarget
+PArith/vo.otarget
 NArith/vo.otarget
 Numbers/vo.otarget
 Program/vo.otarget